Google
 

Trailing-Edge - PDP-10 Archives - bb-bt99l-bb - plrlbp.x18
There is 1 other file named plrlbp.x18 in the archive. Click here to see a list.
	TITLE	PLRLBP - Label Processing Module
	SUBTTL	Author: Cliff Romash/Dave Cornelius/WLH/DPM 3-Aug-83

;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975,1976,1977,1978,1979,
;1980,1981,1982,1983,1984,1985,1986,1987.  ALL RIGHTS RESERVED.
;
;     THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;     AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
;     AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS
;     SOFTWARE  OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
;     OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO  TITLE  TO
;     AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;     THE INFORMATION  IN  THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE
;     WITHOUT  NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;     BY DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
;     OF  ITS  SOFTWARE  ON  EQUIPMENT  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.

	SEARCH	GLXMAC			;Get the GALAXY library
	SEARCH	PLRMAC			;SEARCH UNIVERSAL FILE
	SEARCH	ORNMAC			;Get WTO symbols
	SEARCH	QSRMAC			;For message block definitions
	PROLOG	(PLRLBP)		;SEARCH OTHER NEEDED FILES

;THIS MODULE IS THE HEART OF THE TAPE LABEL PROCESSOR. MOST GLOBAL ENTRY 
;POINTS ARE CALLED BY THE MESSAGE DISPATCHER ON A MESSAGE FROM 
;[SYSTEM]IPCC TO DO THE ACTUAL LABEL PROCESSING. L$XXXX ROUTINES ARE
;CALLED WITH M POINTING TO THE TAPE LABELLING MESSAGE AND HAVE
;ALL AC'S AVAILABLE

	GLOB	NUMBER			;For ITEXT "<number>"
SUBTTL	Directory for PLRLBP
SUBTTL	Constants for verifying labels


;EIGHT BIT ASCII CONSTANTS USED TO CHECK ALL LABEL

	ASCII8(VOL1,VOL1WD,VL1PTR)		;'VOL1'
	ASCII8(VOL2,VOL2WD,VL2PTR)		;'VOL2'
	ASCII8(UVL1,UVL1WD,UVLPTR)		;'UVL1'
	ASCII8(D%A,D10WD,D10PTR)		;'D%A' TO SEE IF DECSYSTEM-10 LABEL
	ASCII8(HDR1,HDR1WD,HD1PTR)		;'HDR1'
	ASCII8(DEC,DECWD,DECPTR)		;'DEC' TO CHECK IF DIGITAL HDR LABEL
	ASCII8(HDR2,HDR2WD,HD2PTR)		;'HDR2'
	ASCII8(EOF1,EOF1WD,EF1PTR)		;'EOF1'
	ASCII8(EOF2,EOF2WD,EF2PTR)		;'EOF2'
	ASCII8(EOV1,EOV1WD,EV1PTR)		;'EOV1'
	ASCII8(EOV2,EOV2WD,EV2PTR)		;'EOV2'
	ASCII8(DECSYSTEM10         ,S10WD,S10PTR) ;'DECSYSTEM10' TO GO IN SYSTEM CODE IN HDR1 LABEL
;	ASCII8(SCRTCH,SCRTWD,SCRPTR)		;'SCRTCH' FOR VOLID
	ASCII8(FILE.,FILWD,FILPTR)		;'FILE' FOR DUMMY NAME IN HDR1 LABEL
	ASCII8(      ,BNKWD,BNKPTR)		;SIX EIGHT BIT ASCII BLANKS
						;FOR A BLANK VOLUME ID
	INTERNAL BNKWD				;Make the blanks externally referenceable

IBMVL1:	XWD	713533,237420			;VOL1 IN EBCDIC

RECFMT:	$BUILD	(.TRFMX+1)
	$SET	(.TRFDF,,"U")		;NO MATCH FOR ZERO (SHOULD NOT BE USED)
	$SET	(.TRFFX,,"F")		;FIXED RECORDS
	$SET	(.TRFVR,,"D")		;VARIABLE RECORDS
	$SET	(.TRFSP,,"S")		;SPANNED RECORDS
	$SET	(.TRFUN,,"U")		;UNDEFINED RECORDS
	$EOB

RECFRM:	$BUILD	(.TFCMX+1)
	$SET	(0,," ")		;Assume no form control
	$SET	(.TFCNO,," ")		;No form control in records
	$SET	(.TFCAS,,"A")		;1st char of record is form control
	$SET	(.TFCAM,,"M")		;Record contains all form control
	$EOB
SUBTTL	L$INIT - Initialization For The Label Processor

L$INIT::MOVEI	S1,0			;GET SEQUENCE ERROR CHECK CODE
	MOVEM	S1,G$SEQC##		;SET IT (DEBUGGING HACK IF NON-ZERO)
	POPJ	P,			;RETURN
SUBTTL	L$MDC -	Routine to Process the MDC message

	ENTRY	L$MDC

;This routine is invoked to read the labels on  a
; unit which has just come on-line.
;All this routine does is read the VOL1 label to see if the tape
;is labeled.  No attempt is made to give this new volume away to a 
;waiting TCB.  The status of the drive is given to MDA via O$STAT

;CALLED WITH B POINTING TO THE TCB

L$MDC:	$TRACE	(L$MCD,1)		;ENTRY
	PUSHJ	P,T$OPEN##		;Grab the tape
	JUMPF	.POPJ			;Can't, so quit
	PUSHJ	P,L$RVOL		;Read the VOL1
	JUMPF	MDC.5			;Can't, so complain
	CAXN	LT,LT.NL		;Is it unlabeled?
	JRST	MDC.4			;Yes, set that up
	MOVE	T1,[CPTRI ^D5,0(BUF)]	;Aim at VOLID portion of label (CP 5-10)
	MOVE	T2,[POINT 8,TCB.VL(B)]	;AND IN TCB
	HRRZI	T3,6			;SIX CHARACTERS
	HRL	T3,CVTTAB(LT)		;GET CONVERSION ROUTINE ADDR
	PUSHJ	P,STGSTR		;SAVE IT AWAY
	JUMPF	MDC.5			;DIDN'T WORK, TELL OPR OF ERROR
	MOVEI	S1,TCB.VL(B)		;AND POINT AT THIS VOLID
	PUSHJ	P,I$RLID##		;SET REELID AND RETURN
	JUMPF	MDC.4			;ILLEGAL VOLUME ID (TREAT UNLABELED)
	PUSHJ	P,O$STAT##		;Update staus to MDA
	$RETT				;RETURN

;Here when we have read the label area, and there is no VOL1
;Therefore, the tape is unlabeled.
MDC.4:					;FOUND AN UNLABELED TAPE VIA AVR
	MOVX	LT,LT.NL		;Get code for no labels
	STORE	LT,TCB.LT(B)		;Save in TCB
	MOVEI	S1,'REW'		;GET THE REWIND COMMAND
MDC.4B:	PUSHJ	P,T$POS##		;LEAVE IT AT BOT (OR UNLOAD IT)
	DMOVE	S1,BNKWD		;Get both pieces of volid
	DMOVEM	S1,TCB.VL(B)		;Store it to send back
	MOVEI	S1,BNKWD		;GET SOME BLANKS FOR A REEL ID
	PUSHJ	P,I$RLID##		;SET IT IN THE MONITOR
	PJRST	O$STAT##		;Send updated status to MDA

;Here when we cannot read the labels due to parity errs, or density errs
;We don't know that the tape is unlabeled, since it may be written
;at a density which this drive does not support

MDC.5:	ZERO	TCB.PS(B),TP.DEN	;SET DEFAULT DENSITY
	PUSHJ	P,I$NDEN##		;SETUP A NEW DENSITY
	MOVEI	S1,[ITEXT(Can't read this tape's labels on this drive)]
	MOVEI	S2,[ITEXT(<Type 'RESPOND ^I/number/ ABORT' to unload the tape on ^W/TCB.DV(B)/
Type 'RESPOND ^I/number/ PROCEED' to treat the tape on ^W/TCB.DV(B)/ as unlabled>)]
	PUSHJ	P,O$LERT##		;Ask the OPR what to do
	JUMPT	MDC.4			;Proceed, treat as unlabeled
	MOVX	S1,'UNL'		;Get code to throw away this tape
	JRST	MDC.4B			;Get it out of here
	SUBTTL	L$RVOL - Read the VOL1 label

;This routine will read the first record on the tape
; and try to determine what type of labels this tape has.
; If there are any data errors, this routine will try all the
; densities that the drive supports.
;Call -
;	B/	TCB adrs
;Returns -
;	FALSE	If no data can be read without errors
;	TRUE,
;		TCB.LT, LT/	Label type

L$RVOL::
	PUSHJ	P,L$CLEF		;Clear out any errors
	PUSHJ	P,T$OPEN##		;NO, OPEN THE TAPE FOR I/O
	JUMPF	.RETF			;CAN'T
	$CALL	.SAVE1			;GET A SCRATCH REGISTER
	MOVEI	P1,.TFD00		;ASSUME WE'LL SET DEFAULT DENSITY
	MOVEI	BUF,TCB.IB(B)		;GET INPUT BUFFER ADDRESS
	MOVX	S1,TS.INI		;Get the initializing bit
	ANDM	S1,TCB.ST(B)		;Clear all but that bit
	PUSHJ	P,I$PDEN##		;PICK A STARTING DENSITY
RVOL.1:	MOVEI	S1,'REW'		;OK, SET UP TO REWIND THE TAPE
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.POPJ			;ERROR ON REWIND
	PUSHJ	P,T$WRCK##		;GET THE WRITE STATUS
	STORE	S2,TCB.PT(B),TP.RWL	;STORE THE WRITE STATUS
	PUSHJ	P,T$RDRC##		;READ A RECORD
	JUMPF	RVOL.2			;Couldn't go see why
	MOVE	T1,(BUF)		;GET FIRST WORD FROM LABEL
	SETZ	LT,			;DON'T KNOW THE LABEL TYPE YET
	TRZ	T1,17			;CLEAR UNNEEDED LOW ORDER 4 BITS
	CAMN	T1,VOL1WD		;IS IT 'VOL1' IN ASCII
	MOVEI	LT,LT.SL		;YES, LABEL TYPE IS STANDARD
	CAMN	T1,IBMVL1		;IS IT 'VOL1' IN EBCDIC?
	MOVEI	LT,LT.IL		;YES, LABEL TYPE IS IBM
	JUMPN	LT,RVOL.4		;Any match?
	JRST	RVOL.5			;TRY THE NEXT DENSITY
RVOL.2:	MOVE	S1,G$TERM##		;GET THE TERMINATION WORD
	CAIE	S1,LE.DTE		;TAPE PARITY ERROR
	CAIN	S1,LE.DER		;OR DEVICE ERROR (TU45'S)
	JRST	RVOL.5			;TRY A DIFFERENT DENSITY
	MOVEI	S1,'REW'		;REWIND CODE
	PUSHJ	P,T$POS##		;DO IT
	$RETF				;RETURN (UNKNOWN LABELS)
RVOL.5:	JUMPL	P1,RVOL5A		;ONLY DO THIS ONCE
	LOAD	S2,TCB.PS(B),TP.DEN	;GET DENSITY WE TRIED TO READ AT
	PUSHJ	P,I$GDEN##		;NOW GET DENSITY WE READ AT
	CAIE	S1,(S2)			;SAME?
	HRROI	P1,(S1)			;NO--DRIVE DID AUTO DENSITY DETECTION
	STORE	S2,TCB.PS(B),TP.DEN	;REPLACE
RVOL5A:	PUSHJ	P,I$NDEN##		;TRY A DIFFERENT DENSITY
	JUMPF	RVOL.6			;TRIED ALL DENSITIES !!!
	SETZM	G$TERM##		;CLEAR THE ERROR FLAGS
	JRST	RVOL.1			;AND TRY AGAIN
RVOL.6:	MOVEI	S1,(P1)			;SET DEFAULT DENSITY BECAUSE SOME
	PUSHJ	P,I$SDEN##		; DRIVE DONT DO AUTO-DENSITY DETECT
	JRST	RVOL.3			;FINISH UP

;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE

;If we get here we have an unlabeled tape.

RVOL.3:	MOVX	LT,LT.NL		;Must be unlabeled
RVOL.4:	PUSHJ	P,I$GDEN##		;Get the default density
	STORE	LT,TCB.LT(B)		;STORE THE LABEL TYPE
	MOVE	T1,[2,,S1]		;Set up AC
	MOVX	S1,.TFCEC		;Function code
	MOVE	S2,TCB.DV(B)		;Get device name
	TAPOP.	T1,			;Clear hard and soft error counters
	  JFCL				;Ignore errors
	MOVEI	S1,'REW'		;REWIND CODE
	PUSHJ	P,T$POS##		;DO IT
	$RETT				;AND RETURN
SUBTTL	L$RUVL - Read UVL1 record


; This routine is used by PLRINI to read the owner and protection
; information stored in the UVL1 record.  This is needed when tapes
; will be re-initialized (/NEW-VOLUME processing).

L$RUVL::PUSHJ	P,L$CLEF		;CLEAR PENDING ERRORS
	PUSHJ	P,T$OPEN##		;OPEN
	JUMPF	.POPJ			;RETURN ON FAILURES
	CAIE	LT,LT.SL		;ANSI?
	CAIN	LT,LT.SUL		;ANSI WITH USER LABELS?
	SKIPA				;YES
	$RETT				;NO USEFUL INFO ON THIS TAPE
	PUSHJ	P,T$RDRC##		;READ A RECORD
	JUMPF	.POPJ			;RETURN ON FAILURES
	MOVE	T1,[CPTRI ^D1,0(BUF)]	;CHECK LABEL IDENTIFIER (CP 1-4)
	MOVE	T2,UVLPTR		;POINT TO "UVL1"
	HRRZI	T3,4			;4 CHARACTERS
	HRL	T3,CVTTAB(LT)		;CONVERSION ROUTINE
	PUSHJ	P,STRCMP		;COMPARE
	JUMPT	RUVL1			;UVL1, PROCEED
	MOVEI	S1,'BBL'		;NO MATCH
	PUSHJ	P,T$POS##		;BACKUP THE TAPE
	JUMPF	.POPJ			;RETURN ON FAILURES
	$RETT				;DONE HERE

; Protection
RUVL1:	MOVE	T1,[CPTRI ^D5,0(BUF)]	;POINT AT PROT (CP 5-10)
	HRRZI	T2,6			;6 CHARS, NO CONVERT
	HRL	T2,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STROCT		;MAKE IT A NUMBER
	SKIPT				;CHECK FOR JUNK IN LABELS
	MOVE	S2,G$PSTP##		;DEFAULT TO STANDARD FILE PROTECTION
	SKIPGE	S1,TCB.IP(B)		;WAS ONE SPECIFIED?
	MOVE	S1,S2			;OLD TAPE PROT WILL BE USED
	CAILE	S1,777			;IT MUST BE REASONABLE
	MOVE	S1,G$PSTP##		;USE STANDARD FILE PROTECTION
	MOVEM	S1,TCB.IP(B)		;STORE PROTECTION CODE

; PPN
RUVL2:	MOVE	T1,[CPTRI ^D11,0(BUF)]	;POINT AT PROJ # (CP 11-16)
	HRRZI	T2,6			;6 CHARS, NO CONVERT
	HRL	T2,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STROCT		;GET A #
	JUMPF	.RETT			;NOT A NUMBER?
	MOVE	P2,S2			;SAVE PROJ # IN P2 FOR NOW
	MOVE	T1,[CPTRI ^D17,0(BUF)]	;POINT AT PROG # (CP 17-22)
	HRRZI	T2,6			;6 CHARS, NO CONVERSION
	HRL	T2,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STROCT		;CHANGE STRING TO OCTAL NUMBER
	JUMPF	.RETT			;NOT A NUMBER
	MOVE	T1,P1			;GET PROT IN T1
	HRRZ	T2,S2			;AND MAKE T2=PPN
	HRL	T2,P2			;...
	MOVEM	T2,TCB.VO(B)		;STORE OWNER (PPN) FOR LATER REFERENCE
	$RETT				;RETURN
SUBTTL	L$MOUN - Routine to Process Mount Message

	ENTRY	L$MOUN

;This routine is the running intialization routine
; for a newly mounted tape

L$MOUNT:	$TRACE	(L$MOUNT,1)
	PUSHJ	P,T$OPEN##		;Open up the drive
	JUMPF	.RETF			;Can't... too bad
	PUSHJ	P,L$CLEF		;CLEAR ERRORS
	MOVEI	S1,TCB.VL(B)		;Get the addrs of the volid
	PUSHJ	P,I$RLID##		;Set the reelid, and the label type
	MOVX	S1,TS.SLR		;BIT TO SKIP LABEL RELEASE
	IORM	S1,TCB.ST(B)		;DON'T UNINTENTIONALLY START JOB
	MOVEI	S1,1			;SET INITIAL FILE
	STORE	S1,TCB.PS(B),TP.POS	; SEQUENCE NUMBER TO ONE
	PJRST	I$CLLP##		;AND ZAP THE LABEL PARAMETER BLOCK
SUBTTL	L$FINP - Routine To Handle Call On First Input

	ENTRY	L$FINPUT

L$FINP:	MOVEI	S1,1			;RESET THE FILE SECTION NUMBER
	STORE	S1,TCB.SN(B)		;EVERY TIME USER OPENS A FILE

;Internal Entry point for volume switching

L$FINT:	$TRACE	(L$FINPUT,2)
	PUSHJ	P,T$OPEN##		;OPEN THE TAPE FOR IO
	JUMPF	.RETF			;COULDN'T?????
	PUSHJ	P,INPCHK		;CHECK IF ITS OK TO DO INPUT
	JUMPF	.RETF			;RETURN IF NOT
	MOVEI	BUF,TCB.IB(B)		;GET INPUT BUFFER ADDRESS
	MOVX	P2,TS.NFI		;GET BIT WHICH SAYS THIS IS DONE
	TDNN	P2,TCB.ST(B)		;IS IT SET?
	JRST	FINP.1			;NO, JUST PROCEED
	ANDCAM	P2,TCB.ST(B)		;CLEAR THE BIT
	PJRST	SETIUD			;SET 'IN USER DATA' AND RETURN

FINP.1:	PUSHJ	P,VERVOL		;NO, VERIFY THE VOLUME LABELS
	JUMPF	.RETF			;VOLUME LABELS FAILED, RETURN BAD

FINP.2:	MOVX	P2,TS.INP		;TAPE DOING INPUT BIT
	IORB	P2,TCB.ST(B)		;TURN IT ON AND GET STATUS IN P2
	JMPUNL	LT,SETIUD		;UNLABELED,,SET 'IN USER DATA' & RETURN
	TXNE	P2,TS.IHL		;ARE WE IN HEADER LABELS
	JRST	FINP.3			;;YES, JUST READ LABELS
	TXNN	P2,TS.ATM		;AT A TAPE MARK?
	JRST	FINP.5			;NO, POSITION TO LABELS
	TXC	P2,TS.ATM!TS.IHL	;CHANGE TO SAY IN HEADER LABELS
FINP.3:	LOAD	S1,TCB.SN(B)		;GET THE FILE SECTION NUMBER
	CAIE	S1,1			;FILRST FILE SECTION
	JRST	FINP.4			;NO, IGNORE PARAMETERS
	PUSHJ	P,I$RDLP##		;YES, READ THE LABEL PARAMETERS
	PUSHJ	P,POSTAP		;POSITION THE TAPE
	JUMPF	.RETF			;OOPS, POSITIONING FAILED, RETURN
FINP.4:	PUSHJ	P,T$RDRC##		;GO READ A RECORD
	JUMPF	.RETF			;ERROR READING HDR1 LABEL, RETURN
	LOAD	P1,TCB.IO(B)		;GET IO STATUS
	TXNE	P1,TI.EOF		;LAST READ SAW EOF?
	JRST	FINP.6			;YES, JUST BACK UP AND RETURN EOF
					;  SINCE WE ARE AT LEOT
	PUSHJ	P,VERHDR		;NOW VERIFY HEADER LABELS
	JUMPF	.RETF			;LOST, GIVE BAD RETURN
	LOAD	S1,TCB.SN(B)		;GET THE FILE SECTION NUMBER
	CAIN	S1,1			;SET ONLY FOR FIRST SECTION
	PUSHJ	P,I$STLP##		;SET LABEL PARAMS FOR USER TO READ
	MOVE	S1,TCB.IN(B)		;GET FUNCTION CODE WORD
	CAIE	S1,77			;IS IT 'READ LABEL PARMS' ???
	PJRST	SETIUD			;SET 'IN USER DATA' AND RETURN
	PUSHJ	P,FNDHD1		;YES,,FIND THE HDR1 RECORD
	JUMPF	.RETF			;NO,,LOSE !!!
	MOVEI	S1,'BBL'		;GET 'BACKSPACE A RECORD' FUNCTION
	PUSHJ	P,T$POS##		;POSITION BEFORE HDR1
	MOVE	S1,TCB.ST(B)		;GET STATUS WORD
	TXZ	S1,TS.INP+TS.NFI+TS.IHL	;CLEAR INPUT AND HDR LABELS BITS
	TXO	S1,TS.ATM		;SET AFTER TAPE MARK
	MOVEM	S1,TCB.ST(B)		;UPDATE STATUS
	SETZM	TCB.IN(B)		;ZAP FUNCTION WORD
	$RETT				;AND RETURN

FINP.5:	PUSHJ	P,NXTFIL		;SKIP TO NEXT FILE IF POSSIBLE
	JUMPF	.RETF			;WE WERE IN A BAD SPOT
	JRST	FINP.2			;OK,,TRY AGAIN !!!
FINP.6:	MOVX	S1,LE.EOF		;GET ERROR CODE TO SAY EOF
	MOVEM	S1,G$TERM##		;STORE FOR RELEASE
	LOAD	P2,TCB.ST(B)		;GET STATUS FROM TCB
	TXZ	P2,TS.POS		;CLEAR POSITION INFO
	TXO	P2,TS.ATM		;FLAG AFTER TAPE MARK
	STORE	P2,TCB.ST(B)		;STORE IT IN TCB
	MOVEI	S1,'BBL'		;SET TO BACK OVER LAST TAPE MARK
	PJRST	T$POS##			;DO IT AND RETURN
SUBTTL	L$FOUT - Routine to Process First Output Message

	ENTRY	L$FOUTPUT

L$FOUT:	MOVEI	S1,1			;RESET THE FILE SECTION NUMBER
	STORE	S1,TCB.SN(B)		;EVERY TIME USER WRITES A FILE

;Internal Entry for volume switching

L$FOUI:	$TRACE	(L$FOUTPUT,2)
	PUSHJ P,T$OPEN##		;OPEN THE TAPE FOR I/O
	JUMPF	FOUT.8			;COULDN'T, RETURN BAD
	LOAD	S1,TCB.PT(B),TP.RWL	;USER SAID /WL?
	JUMPN	S1,FOUT.9		;YES, GIVE WRITE LOCK ERROR
	MOVEI	BUF,TCB.IB(B)		;GET INPUT BUFFER ADDRESS
	MOVX	P2,TS.NFO		;GET NO FIRST OUTPUT FLAG
	TDNN	P2,TCB.ST(B)		;IS IT ON?
	JRST	FOUT.0			;NO, PROCEED
	ANDCAM	P2,TCB.ST(B)		;CLEAR IT
	PJRST	SETIUD			;SET 'IN USER DATA' AND RETURN

FOUT.0:	PUSHJ	P,VERVOL		;NO, NOW'S THE TIME
	JUMPF	FOUT.8			;THEY DIDN'T VERIFY, RETURN
	MOVX	P2,TS.OUT		;TAPE DOING OUTPUT BIT
	IORB	P2,TCB.ST(B)		;TURN IT ON AND GET STATUS IN P2
	JMPUNL	LT,SETIUD		;UNLABELED,,SET 'IN USER DATA' & RETURN

	;Here if appending to the tape

	TXNN	P2,TS.IUD		;ARE WE IN THE USERS DATA ???
	JRST	FOU.0A			;NO,,HE IS NOT APPENDING.....
	TXNN	P2,TS.NOW!TS.EXP!TS.WLK	;DOES USER HAVE ACCESS ???
	$RETT				;YES,,LETERRIP !!!
	TXNE	P2,TS.NOW		;WHOLE TAPE WRITE-PROTECTED?
	JRST	[PUSHJ	P,VPCCHK	;YES--CHECK WITH OPERATOR
		 JUMPF	FOUT.8		;OPR SAID ABORT
		 $RETT]			;DONE
	TXNE	P2,TS.EXP		;IS IT UNEXPIRED FILE ???
	MOVEI	S1,[ITEXT (<Output to unexpired file>)]
	TXNE	P2,TS.WLK		;IS IT FILE PROTECTION ERROR
	MOVEI	S1,[ITEXT (<File protection prohibits output>)]
	PUSHJ	P,O$LERR##		;ASK OPR WHAT TO DO
	JUMPF	FOUT.7			;OPR SAID ABORT,,SO GIVE'M THE GONG
	$RETT				;WIN,,RETURN NOW

FOU.0A:	TXNN	P2,TS.NOW		;IS WHOLE TAPE WRITE-PROTECTED?
	JRST	FOUT.1			;NO, PROCEED
	PUSHJ	P,VPCCHK		;QUERY OPERATOR IF NECESSARY
	JUMPF	FOUT.8			;GO ABORT (TERMINATION CODE SET)
					;ELSE PROCEED (TERMINATION CODE ZEROED)
FOUT.1:	MOVE	P2,TCB.ST(B)		;RELOAD THE STATUS BITS
	TXNN	P2,TS.ATM!TS.IHL	;AFTER A TAPE MARK OR IN HEADER LABELS?
	JRST	FOUT.6			;NO, GIVE ERROR
	LOAD	S1,TCB.SN(B)		;GET FILE SECTION NUMBER
	CAIE	S1,1			;IF FIRST FILE SECTION, READ LABEL PARAMS
	JRST	FOUT.A			;DON'T READ UNLESS FIRST SECTION
	PUSHJ	P,I$RDLP##		;READ THE LABEL PARAMETERS
	PUSHJ	P,POSTAP		;SEE IF A POSITIONING REQUEST
	JUMPF	FOUT.8			;ERROR ON  POSITIONING
FOUT.A:	PUSHJ	P,T$RDRC##		;GO READ A RECORD
	JUMPF	FOUT.8			;ERROR, RETURN
	MOVE	P1,TCB.IO(B)		;GET THE IO STATUS
	TXNE	P1,TI.EOF		;DIR LAST READ HIT EOF?
	JRST	FOUT.4			;YES, BACK OVER IT AND WRITE HDR
	PUSHJ	P,VERHDR		;NO, CHECK AS HDR LABELS
	JUMPF	FOUT.8			;DIDN'T CHECK, RETURN ERROR
	LOAD	P2,TCB.ST(B)		;GET TAPE STATUS
	TXNN	P2,TS.EXP		;FILE NOT EXPIRED?
	JRST	FOUT.2			;NO, TRY PROTECTED
	MOVEI	S1,[ITEXT (<Output to unexpired file>)]
	PUSHJ	P,O$LERR##		;TELL OPR,,WAIT FOR RESPONSE
	JUMPF	FOUT.7			;HE SAID ABORT

FOUT.2:	TXNN	P2,TS.WLK		;WRITE PROTECTED FILE?
	JRST	FOUT.3			;NO,,THIS GUY WINS...
	MOVEI	S1,[ITEXT (<File protection prohibits output>)]
	PUSHJ	P,O$LERR##		;TELL OPR,,WAIT FOR RESPONSE
	JUMPF	FOUT.7			;HE SAID ABORT

FOUT.3:	PUSHJ	P,FNDHD1		;BACK UP AND FIND HDR1
	JUMPF	FOUT.8			;COULDN'T, GIVE ERROR
	PUSHJ	P,I$RDLP##		;Re-read label parms (VERHDR zapped 'em)
	MOVX	S1,TS.PSN+TS.PSF	;GET 'POSITION REQ'D' BITS
	ANDCAM	S1,TCB.ST(B)		;AND CLEAR THEM SO WE'RE NOT RECURSIVE
FOUT.4:	MOVEI	S1,'BBL'		;ARG TO BACK UP RECORD
	PUSHJ	P,T$POS##		;GO POSITION
	JUMPF	FOUT.8			;ERROR WHILE POSITIONING
	SETZM	TCB.BC(B)		;CLEAR BLOCK COUNT
	MOVEI	BUF,TCB.WB(B)		;GET OUTPUT BUFFER ADDRESS
	PUSHJ	P,WRTHDR		;NO GO WRITE HDR LABELS
	JUMPF	FOUT.8			;ERROR WRITING LABELS
	LOAD	S1,TCB.SN(B)		;GET THE FILE SECTION NUMBER
	CAIN	S1,1			;FIRST SECTION
	PUSHJ	P,I$STLP##		;YES, SET THE LABEL PARAMETERS
	LOAD	P1,TCB.IO(B)		;GET THE IO STATUS BACK
	TXNE	P1,TI.EOT		;ARE WE PAST EOT?
	PJRST	L$EOT			;YES, DON'T WRITE ANY DATA, GET NEXT 
					; VOLUME NOW
	PJRST	SETIUD			;SET 'IN USER DATA' AND RETURN

FOUT.6:	MOVEI	S1,LE.IOP		;ILLEGAL OPERATION
	MOVEM	S1,G$TERM##		;SET TERMINATION CODE
	JRST	FOUT.8			;FINISH UP
FOUT.7:	MOVEI	S1,LE.VPF		;ASSUME VOLUME PROTECTION FAILURE
	TXNE	P2,TS.EXP		;IS IT UNEXPIRED FILE ???
	MOVEI	S1,LE.UEF		;YES
	TXNE	P2,TS.WLK		;IS IT WRITE-LOCKED?
FOUT.9:	MOVEI	S1,LE.WLK		;YES
	MOVEM	S1,G$TERM##		;AS TERMINATION CODE
FOUT.8:	MOVX	S1,TS.OUT+TS.NFI+TS.NFO	;GET OUTPUT+NO INPUT+NO OUTPUT
	ANDCAM	S1,TCB.ST(B)		;CLEAR THEM
	$RETF				;AND GIVE BAD RETURN
SUBTTL	L$CLIN - Routine to Process Input Close

	ENTRY	L$CLIN

L$CLIN:	$TRACE	(L$CLIN,2)
	PUSHJ	P,T$OPEN##		;OPEN THE TAPE FOR I/O
	JUMPF	.RETF			;COULDN'T?????
	SKIPN	TCB.IN(B)		;DID MONITOR SEE A TAPE MARK OR EOF?
	JRST	CLOSIN			;NO
	MOVX	S1,TS.ATM		;IF WE'VE ALREADY SEEN A TAPE MARK,
	TDNN	S1,TCB.ST(B)		; THEN WE DON'T WANT TO TRY TO PROCESS
	PJRST	L$TMAR			; ANOTHER ONE.

CLOSIN:	SETZM	TCB.IN(B)		;CLEAR 'TAPE MARK SEEN BY MONITOR' FLAG
	MOVX	S1,TS.NFI!TS.NFO!TS.INP	;GET SUPPRESS FINP+FOUT, DOING INPUT
	ANDCAM	S1,TCB.ST(B)		;CLEAR THEM
	JMPUNL	LT,.RETT		;Unlabeled, just return
	PUSHJ	P,INPCHK		;CHECK IF INPUT OPERATIONS ARE LEGAL
	JUMPF	.RETF			;THEY ARE NOT, RETURN NOW
	MOVEI	S1,1			;SET THE FILE SECION NUMBER
	STORE	S1,TCB.SN(B)		;FOR THE NEXT FILE
	PJRST	I$CLLP##		;CLEAR THE PARAMETER BLOCK
SUBTTL	L$CLOU - Routine to Process Close Output

	ENTRY	L$CLOU

L$CLOU:	$TRACE	(L$CLOU,2)
	PUSHJ	P,T$OPEN##		;OPEN THE TAPE FOR I/O
	JUMPF	.RETF			;COULDN'T?????
	MOVX	P2,TS.NFI!TS.NFO	;GET SUPPRESS FINP+FOUT
	ANDCAB	P2,TCB.ST(B)		;CLEAR THEM AND LOAD STATUS
	TXNE	P2,TS.OUT		;IS TAPE DOING OUTPUT
					;CLOSE OUT ON INP ONLY TAPE IS A NOOP
	TXNN	P2,TS.IUD		;ARE WE IN USER DATA?
	$RETT				;CLOSE OUT WHILE NOT IN DATA
	JMPUNL	LT,CLOU.1		;Unlabeled, hadled differently
	MOVEI	BUF,TCB.WB(B)		;GET OUTPUT BUFFER ADDRESS
	PUSHJ	P,I$BCNT##		;COMPUTE FILE BLOCK COUNT
	ADDM	S1,TCB.BC(B)		;SAVE IT IN TCB
	PUSHJ	P,T$WRTM##		;WRITE A TAPE MARK
	JUMPF	.RETF			;ERROR WRITING TAPE MARK
	PUSHJ	P,WRTEOF		;WRITE EOF LABEL
	JUMPF	.RETF			;ERROR WRITING LABELS
	INCR	TCB.PS(B),TP.POS	;ADJUST THE POSITION
	PUSHJ	P,I$CLLP##		;CLEAR LABEL PARAMS AREAS
	MOVX	P2,TS.OUT		;GET BIT WHICH SAYS DOING OUTPUT
	ANDCAM	P2,TCB.ST(B)		;CLEAR IT IN THE TCB
	MOVEI	S1,1			;GET A 1
	STORE	S1,TCB.SN(B)		;SAVE AS FILE SECTION NUMBER
	$RETT				;RETURN

CLOU.1:	PUSHJ	P,T$WRTM##		;WRITE A TAPE MARK
	JUMPF	.RETF			;OOPS
	PUSHJ	P,T$WRTM##		;AND ANOTHER
	JUMPF	.RETF			;OOPS
	MOVEI	S1,'BFL'		;BACK OVER LAST TAPE MARK
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;...
	LOAD	P2,TCB.ST(B)		;GET STATUS
	TXZ	P2,TS.OUT!TS.POS	;NOT WRITING, CLEAR POSITION
	TXO	P2,TS.ATM		;FLAG AFTER TAPE MARK
	STORE	P2,TCB.ST(B)		;SAVE IN TCB
	$RETT				;AND GIVE GOOD RETURN
SUBTTL	L$EOT - Routine to Process EOT

;This routine gets control when the user is writing data and
; rolls past the EOT sticker.

L$EOT::	$TRACE	(L$EOT,2)
	PUSHJ	P,T$OPEN##		;OPEN THE TAPE
	JUMPF	.RETF			;COULDN'T
	JMPUNL	LT,EOV.NL		;Unlabeled, do it another way
	MOVEI	BUF,TCB.WB(B)		;GET OUTPUT BUFFER ADDRESS
	PUSHJ	P,I$BCNT##		;COMPUTE FILE BLOCK COUNT
	ADDM	S1,TCB.BC(B)		;STORE IT IN THE TCB
	PUSHJ	P,T$WRTM##		;WRITE A TAPE MARK
	JUMPF	.RETF			;WE LOST
	PUSHJ	P,WRTEOV		;WRITE EOV LABELS
	JUMPF	.RETF			;WE LOST
	INCR	TCB.SN(B)		;BUMP THE FILE SECTION NUMBER
EOV.1:	PUSHJ	P,NXTVOU		;NOW MOUNT NEXT VOLUME FOR OUTPUT
	JUMPF	.RETF			;THAT LOST, OH WELL (MAYBE EOF!)
	MOVX	S1,TS.FFF		;GET FIRST FILE FLAG
	IORM	S1,TCB.ST(B)		;SET TO BYPASS SEQ # AND SECTION # CHECK
	PJRST	L$FOUI			;AND ACT AS IF FIRST OUTPUT
					;But don't reset file section #

;Here when we hit EOT for an unlabeled tape
EOV.NL:	CAXN	LT,LT.NLV		;User processed EOV already?
	JRST	EOV.1			;Yes, just get the next volume
					;Note: We can only get here
					; on an internal call from FEOV,
					; since the monitor does NOT
					; notify us of EOT on NLV tape.
	PUSHJ	P,T$WRTM##		;Write a tape mark
	JUMPF	.RETF			;Too bad
	PUSHJ	P,T$WRTM##		;Mark eot for next reader of the tape
	JUMPF	.RETF			;Bad day!
	MOVEI	S1,'BBL'		;Then back up over
	PUSHJ	P,T$POS##		;the first... (Stay between marks)
	JRST	EOV.1			;And then get the next tape up
SUBTTL	L$FEOV - Process User Request to Force End Of Volume

L$FEOV:: $TRACE	(L$FEOV,2)
	MOVE	P2,TCB.ST(B)		;GET THE STATUS
	TXNE	P2,TS.OUT		;IS THE TAPE DOING OUTPUT
	PJRST	L$EOT			;YES,,JUST DO LEOT IF OUTPUT

	;HERE ON FEOV ON INPUT

	PUSHJ	P,T$OPEN		;GO OPEN THE TAPE
	JUMPF	.RETF			;COULDN'T, RETURN
	MOVEI	BUF,TCB.IB(B)		;GET INPUT BUFFER ADDRESS
	PUSHJ	P,NXTVIN		;GET NEXT VOLUME MOUNTED FOR INPUT
	JUMPF	.RETF			;CAN'T
	JMPUNL	LT,L$FINP		;UNLABELED,,ACT AS FIRST INPUT
	AOS	TCB.SN(B)		;LABELED,,BUMP SECTION NUMBER
	PJRST	L$FINT			;ACT AS FIRST INPUT,,NEW SECTION NUMBER
	SUBTTL	L$TMAR - Routine Called On Encountering a Tape Mark


L$TMAR::$TRACE	(L$TMARK,2)
	PUSHJ	P,T$OPEN##		;OPEN THE TAPE
	JUMPF	.RETF			;COULDN'T?
	MOVX	S1,TS.NFI!TS.NFO	;GET SUPPRESS FINP+FOUT
	ANDCAM	S1,TCB.ST(B)		;CLEAR THEM
	MOVEI	BUF,TCB.IB(B)		;GET INPUT BUFFER ADDRESS
	CAIN	LT,LT.NL		;NOLABELES?
	JRST	TMAR.N			;A CROSS BETWEEN LABELD AND UNLABELED
	JMPUNL	LT,TMAR.U		;UNLABELED TAPES GO HERE
	JRST	TMAR.L			;LABELED TAPE GO HERE


; Common exit code for tape mark processing.  Sets EOF and gets user
; out of Event Wait.  All routines should PJRST to here.
TMAR.X:	MOVX	T1,LE.EOF		;CODE TO SAY EOF
	STORE	T1,G$TERM##		;SAVE AS TERMONATION CODE
	MOVE	P2,TCB.ST(B)		;GET STATUS
	TXZ	P2,TS.POS		;CLEAR POSITION INFO
	TXO	P2,TS.ATM		;FLAG AFTER TAPE MARK
	STORE	P2,TCB.ST(B)		;SAVE STATUS
	PJRST	CLOSIN			;DO INPUT CLOSE
; Here for labeled tapes
TMAR.L:	PUSHJ	P,T$RDRC##		;READ A RECORD
	JUMPF	.RETF			;ERROR, RETURN
	PUSHJ	P,CHKEF1		;CHECK FIRST 4 CHARS AS EOF1
	JUMPF	TMAL.1			;THE'RE NOT, TRY AS EOV1
	PUSHJ	P,VEREOF		;VERIFY AS EOF LABELS
	JUMPF	.RETF			;THEY DON'T
	PJRST	TMAR.X			;RETURN EOF

; Here if EOV1 label seen -- must switch volumes
TMAL.1:	PUSHJ	P,VEREOV		;VERIFY AS EOV LABELS
	JUMPF	.RETF			;NOT, RETURN ERROR CODE
	PUSHJ	P,NXTVIN		;MOUNT NEXT INPUT VOLUME
	JUMPF	TMAL.2			;ERROR SWITCHING VOLUMES
	LOAD	S1,TCB.SN(B)		;GET THE FILE SECTION NUMBER
	AOS	S1			;INCREASE TO THE NEXT SECTION
	STORE	S1,TCB.SN(B)		;STORE AWAY
	PJRST	L$FINT			;ACT AS FIRST INPUT

TMAL.2:	MOVX	S1,<TI.LET>		;GET THE LEOT BIT
	IORM	S1,TCB.IO(B)		;LIGHT IT
	PJRST	TMAR.X			;GO RETURN EOF
; Here for NOLABELS tapes
TMAR.N:	MOVX	S1,TI.LTP		;GET LAST TAPE IN VOLUME-SET BIT
	ANDCAB	S1,TCB.IO(B)		;CLEAR IT
	TXNE	S1,TI.LET		;PREVENT POSSIBLE HUNG DEVICE BY NOT
	PJRST	TMAR.X			; READING PAST LEOT AND RETURNING EOF
	JRST	TMA.3B			;OK--GO TEST FOR LEOT NOW


; Here for unlabeled tapes
TMAR.U:	MOVX	S1,TS.IUD		;GET IN USER DATA FLAG
	TDNE	S1,TCB.ST(B)		;UNLABELED AND IN USER DATA?
	PJRST	TMAR.X			;RETURN EOF
TMA.3B:	SKIPN	TCB.IN(B)		;TAPE MARK? (CALLED BY L$CLIN)
	JRST	TMAR.9			;NO
	PUSHJ	P,T$RDRC##		;READ NEXT RECORD
	SKIPF				;TURN I/O ERRORS INTO EOF SO PROGRAMS
	TDZA	S1,S1			; CAN READ PAST BAD SPOTS ON TAPE
	MOVX	S1,TI.EOF		; (IN PARTICULAR, DIRECT NEEDS THIS)
	IORB	S1,TCB.IO(B)		;GET I/O STATUS
	TXNE	S1,TI.EOF		;EOF AGAIN?
	TXO	S1,TI.LET		;YES--POSITIONED AT LEOT
	MOVEM	S1,TCB.IO(B)		;UPDATE I/O STATUS
	TXNE	S1,TI.LET		;AT LEOT NOW?
	CAIE	LT,LT.NL		;AND NOLABELS?
	JRST	TMAR.6			;NO--JUST BACKUP 1 BLOCK AND RETURN EOF
	JRST	TMAR.5			;TRY TO GET THE NEXT REEL IN VOLUME SET

TMAR.9:	MOVEI	S1,'BBL'		;MUST MOVE BACK
	PUSHJ	P,T$POS##		;TWO BLOCK IN ORDER
	MOVEI	S1,'BBL'		;TO CHECK FOR LOGICAL
	PUSHJ	P,T$POS##		;END OF TAPE
	PUSHJ	P,T$RDRC##		;READ A RECORD BEFORE THE EOF
	JUMPF	TMAR.4			;ERROR NO EOF BEFORE THIS ONE
	LOAD	S1,TCB.IO(B),TI.EOF	;GET THE EOF BIT
	JUMPN	S1,TMAR.5		;YES, LOGICAL EOT

;Here if the thing before the tape mark is not tape mark
;Position is before the 'current' tape mark
TMAR.4:	MOVEI	S1,'SBL'		;SKIP THE CURRENT EOF
	PUSHJ	P,T$POS##		;WE KNOW IT IS THERE
	PUSHJ	P,T$RDRC##		;READ THE NEXT RECORD
	JUMPF	TMAR.6			;ERROR
	LOAD	S1,TCB.IO(B),TI.EOF	;GET THE EOF BIT
	JUMPE	S1,TMAR.6		;NOT EOF THEREFORE NOT AT EOT
	MOVEI	S1,'BBL'		;POSITION INCASE NXTVOL FAILS
	PUSHJ	P,T$POS##		;AND THE USER READS AGAIN

;Here when we have seen 2 tape marks
;Position is between the tape marks
TMAR.5:	CAIN	LT,LT.NLV		;NO LABELS??
	JRST	TMAR.7			;NO--JUST RETURN EOF
	CAIE	LT,LT.NL		;IS IT USER-EOT ???
	PJRST	TMAR.X			;YES,,RETURN EOF TO THE USER
	PUSHJ	P,NXTVIN		;DOUBLE EOF  GET NEXT VOLUME
	JUMPT	L$FINP			;GO PROCESS FIRST INPUT REQUEST
	MOVX	S1,TI.LTP		;LAST TAPE IN VOLUME SET
	IORM	S1,TCB.IO(B)		;SAVE FOR POSITIONING CODE

TMAR.7:	LOAD	S1,TCB.IO(B)		;GET THE I/O STATUS WORD
	TXNN	S1,TI.LET		;WERE WE AT LEOT BEFORE THIS?
	JRST	TMAR.8			;GO RETURN
	MOVEI	S1,'SBL'		;FORWARD SPACE OVER THE TAPE MARK
	PUSHJ	P,T$POS##		;DO IT
	MOVX	S1,TI.LET		;GET THE BIT THAT WE WERE HERE BEFORE
	ANDCAM	S1,TCB.IO(B)		;CLEAR IT
	PJRST	TMAR.X			;RETURN EOF

TMAR.8:	TXO	S1,TI.LET		;TURN ON THE BEEN HERE BIT
	STORE	S1,TCB.IO(B)		;TELL WE ARE NOW
	JRST	TMAR.X			;RETURN EOF

;Here when we don't have 2 tape marks in a row
TMAR.6:	MOVEI	S1,'BBL'		;BACKSPACE A BLOCK (MUST BE USER'S DATA)
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;ERROR
	PJRST	TMAR.X			;RETURN EOF
SUBTTL	L$POSI - MTAPE and TAPOP. Positioning functions

L$POSI:: PUSHJ	P,.SAVE1		;SAVE P1
	$TRACE	(L$POSITION,2)
	MOVNI	P1,1			;INIT FLAG
POS.0:	PUSHJ P,T$OPEN##		;OPEN THE TAPE FOR IO
	JUMPT	POS.1			;Got it, keep going
	LOAD	S1,TCB.IN(B)		;COULDN'T,Get request code
	MOVE	S2,G$TERM##		;Get the error reason
	CAIE	S1,POSREW		;WAS IT REWIND?
	CAIN	S2,LE.IOP		;TRYING TO UNDO ERROR?
	SKIPA				;YES--LET HIM THROUGH
	$RETF				;Neither, Too bad!
	PUSHJ	P,L$CLEF		;CLEAR ERROR
	SETZM	G$TERM##		;CLEAR TERMINATION CODE
	AOJE	P1,POS.0		;AND TRY AGAIN IF THE FIRST TIME
	MOVEI	S1,LE.IOP		;OTHERWISE RETURN ILLEGAL POSITIONING
	MOVEM	S1,G$TERM##		; REQUESTED AND WE'RE DONE WITH THIS
	$RETF				; MONITOR REQUEST

POS.1:	MOVX	S1,TS.ILC		;ZAP THE INHIBIT
	ANDCAB	S1,TCB.ST(B)		; LABEL CLEAR BIT
	TXNE	S1,TS.NTP		;Is there a tape?
	PJRST	PS.BAD			;No, forget it but release the user
	MOVEI	BUF,TCB.IB(B)		;GET INPUT BUFFER ADDRESS
	MOVE	P1,TCB.IN(B)		;GET SAVED INFO FROM MESSAGE
	CAIN	P1,.TFWLE+40		;WRITE LOGICAL EOT?
	MOVX	P1,-2			;YES
	CAIN	P1,.TFDSE+40		;DATA SECURITY ERASE?
	MOVX	P1,-1			;YES

; We know that the monitor won't give is a negative function code
; so we won't check for it. Besides, MACRO can't handle the following
; instruction because of the forward references and I don't feel line
; moving the positioning dispatch table.
;	CAML	P1,[POSMIN]		;OFF THE LOWER END OF THE TABLE?

	 CAILE	P1,POSLEN		;OR GREATER THAN MAX?
	  PJRST	PS.ILF			;Yes,,return Illegal Operation
	MOVX	S1,TS.NFI!TS.NFO	;Get first in or out suppress bits
	ANDCAM	S1,TCB.ST(B)		;Clear out, since we're moving the tape
IFN FTTRACE,<
	SKIPE	G$DEBUG			;Debugging?
	$TEXT	(,<^I/@POSMSG(P1)/>)	;Yes, type a note
>;END IFN FTTRACE
	CAXE	P1,POSREW		;Was it rewind?
	PUSHJ	P,VERVOL		;No,,Validate the VOL labels
	JUMPF	.RETF			;  Failed !!!!
	SKIPGE	POSREQ(P1)		;Do we want to intervene?
	JRST	POS.2			;Yes, do the work
	CAIN	LT,LT.NL		;NOLABELS?
	JRST	POS.2			;YES--IT'S KINDA LIKE A LABELED TAPE
	JMPUNL	LT,POS.3		;May need help, but not if unlabeled
POS.2:	PUSHJ	P,@POSREQ(P1)		;FUNCTION IN RANGE, DISPATCH
	MOVX	S1,TS.ILC		;BIT TO TEST
	TDNN	S1,TCB.ST(B)		;INHIBIT LABEL PARAMETER CLEARING?
	PUSHJ	P,I$CLLP##		;CLEAR THE PARAMETER BLOCK
	$RETT				;BYE

	;Here for Unlabeled tapes

POS.3:	MOVEI	S1,LE.CON		;GET CODE TO ASK MONITOR TO DO IT
	MOVEM	S1,G$TERM##		;STORE IT AS TERMINATION CODE
	POPJ	P,			;RETURN
					; WILL TELL MONITOR TO DO
					; IT -- MONITOR WILL GIVE USER
					; APPROPRIATE ERROR

;Sign bit is set for operations on unlabeled tapes
;	which require some action on our part
POSMIN==.-POSREQ			;LOWER LIMIT
	PS.WLE				;(-2) WRITE LOGICAL END OF TAPE
	PS.DSE				;(-1) DATA SECURITY ERASE
POSREQ:	PS.ILF				;0-ILLEGAL FUNCTION
POSREW==.-POSREQ			;Offset for rewind function
	400000,,PS.REW			;1-REWIND
	PS.ILF				;2-ILLEGAL FUNCTION
	PS.WTM				;3-WRITE A TAPE MARK
	PS.ILF				;4-ILLEGAL FUNCTION
	PS.ILF				;5-ILLEGAL FUNCTION
	PS.SKR				;6-SKIP A RECORD
	PS.BSR				;7-BACKSPACE A RECORD
	PS.SET				;10-SKIP TO LEOT
	400000,,PS.UNL			;11-UNLOAD
	PS.ILF				;12-ILLEGAL FUNCTION
POSWBT==.-POSREQ			;Code to write gap
	PS.WBT				;13-WRITE BLANK TAPE
	PS.ILF				;14-ILLEGAL FUNCTION
	PS.ILF				;15-ILLEGAL FUNCTION
	PS.SKF				;16-SKIP A FILE
	PS.BSF				;17-BACKSPACE A FILE
POSLEN==.-POSREQ

IFN FTTRACE,<
	[ITEXT	(Write logical EOT)]
	[ITEXT	(Data security erase)]
POSMSG:	@ILLMSG
	[ITEXT	(Rewind)]
	@ILLMSG
	[ITEXT	(Write tape mark)]
	@ILLMSG
	@ILLMSG
	[ITEXT	(Skip a record)]
	[ITEXT	(Backspace a record)]
	[ITEXT	(Skip to LEOT)]
	[ITEXT	(Unload)]
	@ILLMSG
	[ITEXT	(Write blank tape)]
	@ILLMSG
	@ILLMSG
	[ITEXT	(Skip a file)]
	[ITEXT	(Backspace a file)]
ILLMSG:	[ITEXT	(Illegal positioning request code ^O/T1/)]
>;END IFN FTTRACE

	;Here for Illegal function

PS.ILF:	MOVEI	S1,LE.IOP		;GET CODE FOR ILLEGAL OPERATION
	MOVEM	S1,G$TERM##		;SAVE AS TERMINATION CODE
	$RETF				;Return

	;Here if Positioning failed

PS.BAD:	MOVEI	S1,LE.PSE		;GET CODE FOR POSITIONING ERROR
	MOVEM	S1,G$TERM##		;AND SAVE FOR RETURN
	$RETF				;Return


; HERE TO STORE TERMINATION CODE AND INHIBIT LABEL PARAMETER CLEAR
PS.TRM:	MOVEM	S1,G$TERM##		;SAVE TERMINATION CODE
PS.ILC:	MOVX	S1,TS.ILC		;INHIBIT LABEL PARAMETER BLOCK CLEARING
	IORM	S1,TCB.ST(B)		;DURING POST-POSITIONING CLEANUP
	POPJ	P,			;RETURN
	;Here to perform an UNLOAD function

PS.UNL:		;Fall into rewind, but DON'T unload anything!

	;Here to perform a REWIND function

PS.REW:	LOAD	T1,TCB.ST(B)		;GET TAPE STATUS
	TXNN	T1,TS.OUT		;DOING OUTPUT?
	JRST	REW.1			;NO, PROCEED
	PUSHJ	P,L$CLOU		;YES, DO A CLOSE FIRST
	JUMPF	.RETF			;ERROR, EXIT
REW.1:	PUSHJ	P,FIRVOL		;GET FIRST TAPE IN SET
	JUMPF	.RETF			;CAN'T GET FIRST VOLUME
	MOVX	S1,LE.BOT		;TERM CODE TO RETURN BOT AND SET FSTOP
	MOVEM	S1,G$TERM##		;SAVE FOR RETURN
	MOVEI	S1,'REW'		;GET CODE TO REQUEST REWIND
	PUSHJ	P,T$POS##		;DO THE REWIND
	JUMPF	.RETF			;ERROR ON REWIND?
	MOVEI	S1,1			;FILE COUNT TO FIRST FILE
	STORE	S1,TCB.PS(B),TP.POS	;CLEAR THE FILE COUNT
	MOVX	S1,TS.FFF		;GET FIRST FILE FLAG
	IORM	S1,TCB.ST(B)		;INDICATE IN FIRST FILE ON TAPE
	MOVX	S1,TS.INP!TS.NFI!TS.OUT!TS.NFO!TS.VLV!TS.POS ;GET LOTS OF BITS
	ANDCAM	S1,TCB.ST(B)		;   AND CLEAR THEM
	$RETT				;RETURN
	;Here to perform a WRITE TAPE MARK function

PS.WTM:	MOVE	P2,TCB.ST(B)		;GET STATUS
	TXNN	P2,TS.OUT		;DOING OUTPUT
	JRST	WTM.1			;NO
	TXNE	P2,TS.IUD		;IN USERS DATA?
	JRST	WTM.2			;YES--JUST SIMULATE CLOSE OUTPUT

WTM.1:	PUSHJ	P,L$FOUT		;DO FIRST OUTPUT PROCESSING
	JUMPF	.RETF			;CHECK FOR ERRORS

WTM.2:	PUSHJ	P,L$CLOU		;FIRST FINISH UP WITH CLOSE OUT
	JUMPF	.RETF			;DIDN'T MAKE IT
	MOVEI	S1,LE.EOF		;EOF CODE
	STORE	S1,G$TERM		;SET FOR LABEL RELEASE
	$RETT				;ALL DONE

	;Here to perform a SKIP RECORD function

PS.SKR:	LOAD	S1,TCB.IO(B)		;Get the I/O Flags
	TXNE	S1,<TI.LET>		;Are we aready at LEOT
	$RETT				;Assume we're done
	LOAD	P2,TCB.ST(B)		;GET THE STATUS
	TXNE	P2,TS.OUT		;ARE WE DOING OUTPUT?
	PJRST	PS.IOP			;YES-CAN'T DO THIS
	TXNN	P2,TS.IUD		;ARE WE IN USER DATA?
	JRST	SKR.2			;NO,DO THIS DIFFERENTLY

SKR.1:	STORE	P2,TCB.ST(B)		;STORE THE STATUS
	MOVEI	S1,'SBL'		;CODE TO SKIP A BLOCK
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;ERROR RETURN
	LOAD	P1,TCB.IO(B)		;GET THE STATUS
	TXNN	P1,TI.EOF		;DID SKIP HIT EOF?
	$RETT				;NO, JUST RETURN
	PJRST	L$TMARK			;ACT LIKE TAPE MARK SEEN

SKR.2:	TXNN	P2,TS.VLV!TS.ATM!TS.IHL	;VOL LABELS VERIFIED, OR IN HEADER
					; GROUP OR AFTER TAPE MARK
	STOPCD	(SSR,HALT,,<Strange skip record>)
	PUSHJ	P,L$FINP		;DO FIRST INPUT STUFF
	JUMPF	.RETF			;IT DIDN'T WORK
	MOVX	S1,TS.ATM		;GET BIT INDICATING LEOT
	TDNE	S1,TCB.ST(B)		;IF INPUT SAYS NO MORE TAPE,..
	$RETT				; ...  THEN SKIP REC IS A NOOP.
	TXO	P2,TS.NFI		;FLAG NO FIRST INPUT
	JRST	SKR.1			;OK, NOW SKIP THE RECORD
	;Here to perform a BACKSPACE RECORD function

PS.BSR:	LOAD	P2,TCB.ST(B)		;GET THE STATUS
	TXNN	P2,TS.VLV		;VOL LABELS VERIFIED?
	$RETT				;RETURN TRUE
	TXNN	P2,TS.OUT		;DOING OUTPUT?
	JRST	BSR.1			;NO, PROCEED
	PUSHJ	P,L$CLOU		;DO A CLOSE OUTPUT
	JUMPF	.RETF			;ERROR, RETURN
	PUSHJ	P,PS.BSF		;THEN A BACKSPACE FILE
	JUMPF	.RETF			;ERROR , RETURN
	SETZM	G$TERM##		;CLEAR G$TERM, SINCE BSF SETS EOF!

BSR.1:	TXNE	P2,TS.IUD		;IN THE USER DATA
	JRST	BSR.2			;YES
	TXNN	P2,TS.VLV!TS.ATM!TS.IHL	;VOL LABELS VERIFIED, OR IN HEADER
	STOPCD	(BBR,HALT,,<Bad backspace record>)
	PUSHJ	P,L$FINP		;DO FIRST INPUT
	JUMPF	.RETF			;ERROR
	MOVX	P2,TS.NFI		;GET NOT FIRST INPUT
	IORB	P2,TCB.ST(B)		;SET IT ON
	TXZ	P2,TS.ATM		;CLEAR AFTER TAPE MARK
	TXO	P2,TS.IUD		;WILL BE IN USER DATA
	MOVEM	P2,TCB.ST(B)		;UPDATE

	JMPUNL	LT,BSR.2		;ONWARD IF UNLABELED
	MOVEI	S1,'BFL'		;NEED TO BACKSPACE
	PUSHJ	P,T$POS##		; OVER THE EOF RECORDS
	JUMPF	.RETF			;CHECK FOR ERRORS
	MOVEI	S1,'BFL'		;AND BACKUP OVER
	PUSHJ	P,T$POS##		; THE TAPE MARK TOO
	JUMPF	.RETF			;CHECK FOR ERRORS
	MOVEI	S1,'SBL'
	PUSHJ	P,T$POS##
	JUMPF	.RETF
	PUSHJ	P,T$RDRC##		;READ EOF1 LABEL
	JUMPF	.RETF			;CAN'T
	PUSHJ	P,VEREOF		;VERRIFY EOF, GET FILE NAME, ETC.
	JUMPF	.RETF			;NO GOOD
	LOAD	S1,TCB.PS(B),TP.POS	;GET POSITION
	SUBI	S1,2			;ACCOUNT FOR EOF CHECK AND FORWARD SKIP
	STORE	S1,TCB.PS(B),TP.POS	;UPDATE
	PUSHJ	P,I$STLP##		;SET LABEL PARAMETERS IN THE MONITOR
	MOVEI	S1,'BBL'		;BACKSPACE OVER
	PUSHJ	P,T$POS##		; THE TAPE MARK
	JUMPF	.RETF			;CAN'T
	MOVEI	S1,'BFL'		;BACKSPACE OVER
	PUSHJ	P,T$POS##		; THE EOF RECORDS
	JUMPF	.RETF			;CAN'T
	MOVE	S1,TCB.ST(B)		;GET STATUS WORD
	TXZ	S1,TS.ATM		;NO LONGER AFTER A TAPE MARK
	TXO	S1,TS.IUD		;POSITIONED IN USER DATA
	MOVEM	S1,TCB.ST(B)		;UPDATE
	PUSHJ	P,PS.ILC		;INHIBIT LABEL CLEAR
	$RETT				;RETURN AND LET USER APPEND TO THE FILE

BSR.2:	MOVEI	S1,'BBL'		;JUST TRY TO BACK UP A BLOCK
	PUSHJ	P,T$POS##		;...
	JUMPF	.RETF			;ERROR DOING IT
	LOAD	P1,TCB.IO(B)		;GET IO STATUS
	CAIN	LT,LT.NL		;NOLABELS?
	JRST	BSR.5			;MUST CHECK FOR REEL SWITCH DIFFERENTLY

; Here for labeled tapes
BSR.3:	TXNN	P1,TI.EOF		;BBL SAW EOF?
	JRST	[PUSHJ	P,PS.ILC	;LIGHT INHIBIT LABEL CLEAR
		 $RETT]			;RETURN
	MOVEI	S1,'SBL'		;SKIP BACK OVER THE TAPE MARK
	PUSHJ	P,T$POS##		;CAUSE FNDHD1 EXPECTS TO BE AFTER IT
	JUMPF	.RETF			;CAN'T SKIP THE TAPE MARK???
	PUSHJ	P,FNDHD1		;GO FIND THE HDR1 LABEL
	JUMPF	.RETF			;COULDN'T
	PUSHJ	P,@GETFSN(LT)		;NO GET THE FILE SECTION NUMBER
	JUMPF	.RETF			;THATS RATHER STRANGE?
	CAIN	S2,1			;IS THIS THE FIRST FILE SECTION?
	JRST	BSR.4			;YES, DO SPECIAL STUFF
	PUSHJ	P,LSTVOL		;;NO, FIND END OF PRECEDING VOL
					; AND VER EOV LBLS.
	JUMPF	.RETF			;COULDN'T HACK IT
	JRST	BSR.1			;NOW TRY TO BACKSPACE THE BLOCK

BSR.4:	MOVEI	S1,'SFL'		;SET UP TO SKIP REST OF LABEL GROUP
	PUSHJ	P,T$POS##		;PUTS US AT START OF USER FILE
	JUMPF	.RETF			;ONLY IF IT WORKED
	PJRST	PS.BSF			;DO LIKE BACKSPACE FILE

; Here for NOLABELS tapes
BSR.5:	TXNN	P1,TI.BOT		;AT BOT?
	$RETT				;NO--DONE
	PUSHJ	P,LSTVOL		;GET PREVIOUS REEL
	JUMPF	.RETF			;CAN'T
	MOVEI	S1,'EOT'		;NOW POSITION TO
	PUSHJ	P,T$POS##		; PHYSICAL END OF TAPE
	JUMPF	.RETF			;CAN'T
	MOVEI	S1,'BBL'		;BACKSPACE OVER
	PUSHJ	P,T$POS##		; A TAPE MARK
	JUMPF	.RETF			;CAN'T
	JRST	BSR.1			;AND FINALLY BACKSPACE OVER THE RECORD
	;Here to perform SKIP TO LEOT function

PS.SET:	SETZM	TCB.IN(B)		;CLEAR REQUEST CODE (CONFUSES L$TMAR)
	LOAD	P2,TCB.ST(B)		;GET TCB STATUS WORD
	TXNE	P2,TS.OUT		;DOING OUTPUT?
	PJRST	PS.IOP			;YES, ILLEGAL
	MOVX	S1,TI.LET		;GET LEOT BIT
	TDNE	S1,TCB.IO(B)		;ARE WE AT TAPE'S END?
	JRST	SET.3			;YES, GO FINISH UP
	TXNE	P2,TS.IUD		;IN USER DATA?
	JRST	SET.2			;YES,START BY SKIPPING IT
	TXNN	P2,TS.ATM!TS.IHL	;ARE WE AFTER A TAPE MARK??
	PUSHJ	P,PS.BAD		;BAD TAPE, GIVE STOPCD

SET.1:	PUSHJ	P,T$RDRC##		;READ A RECORD
	JUMPF	.RETF			;CAN'T
	LOAD	P1,TCB.IO(B)		;GET IO STATUS
	TXNE	P1,TI.EOF		;SAW EOF??
	JRST	SET.3			;YES, ALL DONE
	PUSHJ	P,VERHDR		;CHECK HDR LABELS
	JUMPF	.RETF			;COULDN'T, ERROR

SET.2:	PUSHJ	P,G$OJOB##		;GO CHECK SCHEDULER
	MOVEI	S1,'SFL'		;SET TO SKIP FILE
	PUSHJ	P,T$POS##		;SKIP OVER USERS DATA
	JUMPF	.RETF			;CAN'T
	MOVX	S1,TS.ATM		;NOW WE'RE POSITIONED
	IORM	S1,TCB.ST(B)		; AFTER A TAPE MARK
	PUSHJ	P,L$TMAR		;DO LIKE USER SAW TAPE MARK
	JUMPF	.RETF			;OOPS
	MOVE	S1,TCB.IO(B)		;GET I/O STATUS
	MOVE	S2,S1			;COPY IT
	TXZ	S2,TI.LTP		;CLEAR LAST TAPE BIT
	MOVEM	S2,TCB.IO(B)		;UPDATE
	TXNE	S1,TI.LTP		;LAST TAPE IN VOLUME SET?
	JRST	SET.1			;YES
	MOVE	P2,TCB.ST(B)		;GET THE STATUS
	CAIE	LT,LT.NL		;NOLABELS?
	TXNE	P2,TS.IUD		;IN USER DATA?
	JRST	SET.2			;YES, SKIP REST OF USER'S FILE
	JRST	SET.1			;NO, TRY FOR HDR LABELS

SET.3:	MOVEI	S1,LE.EOF		;RETURN EOF
	MOVEM	S1,G$TERM##		;ON THE RELEASE
	MOVEI	S1,'BFL'		;BACK UP OVER THE TAPE MARK
	PJRST	T$POS##			;AND RETURN WHEN DONE
	;Here to perform a WRITE BLANK TAPE function

PS.WBT:	LOAD	P2,TCB.ST(B)		;GET DRIVE STATUS
	TXNN	P2,TS.OUT		;TAPE DOING OUTPUT?
	JRST	WBT.1			;NO, TRY TO CHECK HDR LBLS
	TXNE	P2,TS.IUD		;IN USER'S DATA??
	JRST	WBT.3			;YES, JUST LET MONITOR DO IT
WBT.1:	CAIN	LT,LT.NL		;NOLABELS?
	JRST	WBT.2			;MEANS NO HEADER RECORDS
	TXNN	P2,TS.ATM!TS.IHL	;IN HEADERS OR AFTER TM?
	JRST	WBT.4			;NO, ITS A STRANGE TAPE

WBT.2:	PUSHJ	P,L$FOUT		;DO LIKE FIRST OUTPUT
	JUMPF	.RETF			;ERROR
	MOVX	S1,TS.NFO		;REMEMBER THAT WE
	IORM	S1,TCB.ST(B)		; HAVE ALREADY DONE FIRST OUT

WBT.3:	MOVEI	S1,LE.CON		;LET THE MONITOR DO IT
	PUSHJ	P,PS.TRM		;SAVE AND INHIBIT LABEL CLEAR
	$RETT				;GIVE GOOD RETURN

WBT.4:	MOVEI	S1,LE.PSE		;POSITIONING ERROR
	PUSHJ	P,PS.TRM		;SAVE AND INHIBIT LABEL CLEAR
	$RETF			
	;Here to perform SKIP A FILE function

PS.SKF:	LOAD	S1,TCB.IO(B)		;GET THE I/O FLAGS
	TXNE	S1,TI.LET		;ARE WE AREADY AT LEOT
	$RETT				;ASSUME WE'RE DONE
	LOAD	P2,TCB.ST(B)		;GET THE STATUS
	TXNE	P2,TS.OUT		;ARE WE DOING OUTPUT?
	PJRST	PS.IOP			;YES-CAN'T DO THIS
	TXNE	P2,TS.IUD		;IN USER'S DATA?
	JRST	SKF.2			;YES, JUST SKIP TO END OF FILE
	TXNN	P2,TS.ATM!TS.IHL	;AFTER A TAPE MARK OR IN HEADER LABELS?
	PUSHJ	P,PS.BAD		;GIVE STOPCD FOR ILLEGAL TAPE POSITION
	PUSHJ	P,L$FINP		;DO FIRST INPUT PROCESSING
	JUMPF	.RETF			;FAILED
	MOVX	S1,TS.ATM		;GET BIT WHICH SAYS FINP SAW LEOT
	TDNE	S1,TCB.ST(B)		;IF INPUT SAW END OF TAPE, THEN
	$RETT				; ... SKIP FILE IS A NOOP
	MOVX	P2,TS.NFI		;INDICATE FIRST INPUT
	IORB	P2,TCB.ST(B)		; PROCESSING NOT NEEDED NEXT TIME
	JRST	SKF.2			;ONWARD

SKF.1:	PUSHJ	P,G$OJOB##		;GO CHECK SCHEDULER

SKF.2:	MOVEI	S1,'SFL'		;SET TO SKIP FILE
	PUSHJ	P,T$POS##		;SKIP TO END OF USER'S FILE
	JUMPF	.RETF			;COULDN'T
	PUSHJ	P,L$TMARK		;OK, NOW JUST ACT LIKE WE SAW EOF
	JUMPF	.RETF			;DIDN'T WORK
	LOAD	P2,TCB.ST(B)		;GET THE STATUS
	TXNE	P2,TS.IUD		;TAPE MARK CODE LEAVE US IN USER DATA?
	JRST	SKF.1			;YES, MUST HAVE SWITCHED VOLUMES
	$RETT				;NO,WE'RE ALL DONE
	;Here to perform BACKSPACE A FILE function

PS.BSF:	LOAD	P2,TCB.ST(B)		;GET THE STATUS
	TXNN	P2,TS.VLV		;VOL LABELS VERIFIED?
	JRST	BSF.6			;NO, JUST RETURN BOT
	TXNN	P2,TS.OUT		;DOING OUTPUT?
	JRST	BSF.1			;NO, JUST PROCEED
	PUSHJ	P,L$CLOU		;YES, FORCE A CLOSE OUTPUT
	JUMPF	.RETF			;IT DIDN'T WORK
	MOVEI	S1,'BFL'		;SET TO BACKSPACE INTO EOF LABELS
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;ERROR BACKSPACING
	MOVEI	S1,'BFL'		;NOW BACK INTO USER'S DATA
	PUSHJ	P,T$POS##		;...
	JUMPF	.RETF			;CAN'T DO IT
	TXZ	P2,TS.POS		;CLEAR THE POSITIONING INFO
	TXO	P2,TS.IUD		;AND FLAG IN USER DATA
	STORE	P2,TCB.ST(B)		;MAKE SURE TCB IS RIGHT
BSF.1:	CAIN	LT,LT.NL		;NOLABELS?
	JRST	BSF.7			;HANDLE DIFFERENTLY
	TXNE	P2,TS.IUD		;ARE WE IN USER DATA?
	JRST	BSF.2			;YES, SIMPLE CASE
	TXNN	P2,TS.VLV!TS.ATM!TS.IHL	;VOL LABELS VERIFIED, OR IN HEADER
	STOPCD	(BBF,HALT,,<Bad backspace file>)
	PUSHJ	P,L$FINP		;DO FIRST INPUT
	JUMPF	.RETF			;ERROR
	MOVX	P2,TS.NFI		;GET NOT FIRST INPUT
	IORB	P2,TCB.ST(B)		;SET IT ON
	TXNN	P2,TS.ATM		;EOT
	JRST	BSF.2			;NO IN THE USER DATA
	MOVEI	S1,'BFL'		;BACK INTO EOF LABELS
	PUSHJ	P,T$POS##		;...
	JUMPF	.RETF			;CAN'T
	JRST	BSF.3			;NOW FINISH UP LIKE NORMAL CASE
BSF.2:	PUSHJ	P,FNDHD1		;GO FIND THE HDR1 LABEL
	JUMPF	.RETF			;CAN'T--MUST NOT BE GOOD LABEL
	PUSHJ	P,@GETFSN(LT)		;GET THE FILE SECTION NUMBER
	JUMPF	.RETF			;CAN'T--MUST NOT BE GOOD LABEL
	CAIE	S2,1			;FIRST FILE SECTION?
	JRST	BSF.5			;NO, MUST SWITCH VOLUMES
	MOVEI	S1,'BFL'		;YES, WE WANT ONE FILE BACK
	PUSHJ	P,T$POS##		;GET TO ITS EOF LABELS
	JUMPF	.RETF			;CAN'T
	LOAD	P1,TCB.IO(B)		;GET IO STATUS
	TXNN	P1,TI.EOF		;BACKSPACE SAW TAPE MARK?
	JRST	BSF.6			;NO, MUST BE AT BOT
BSF.3:	MOVEI	S1,'BFL'		;BACKSPACE OVER EOF LABELS
	PUSHJ	P,T$POS##		;NOW BEFORE TM AT EOND OF USER'S DATA
	JUMPF	.RETF			;DIDN'T MAKE IT
	MOVEI	S1,'SBL'		;SKIP BACK OVER TAPE MARK
	PUSHJ	P,T$POS##		;TO START OF END OF FILE LABEL GROUP
	JUMPF	.RETF			;CAN'T SKIP A TAPE MARK?
	PUSHJ	P,T$RDRC##		;READ THE RECORD
	JUMPF	.RETF			;CAN'T, GIVE UP
	DECR	TCB.PS(B),TP.POS	;BACK UP FILE POSITION ONE
	STORE	LT,TCB.LT(B)		;STORE BEST GUESS IN TCB
	PUSHJ	P,VEREOF		;BETTER BE EOF LABELS
	JUMPF	.RETF			;NOPE, ERROR
	DECR	TCB.PS(B),TP.POS	;BACK FILE COUNT UP AGAIN
					; SINCE VEREOF COUNTED IT UP AGAIN
	MOVEI	S1,'BFL'		;BACK TO EOF LABELS
	PUSHJ	P,T$POS##		;SINCE VEREOF LEAVES US ATM
	JUMPF	.RETF			;CAN'T
	MOVEI	S1,'BFL'		;AND NOW BACK TO USER'S DATA
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;CAN'T
	TXZ	P2,TS.POS		;CLEAR POSITIONING INFO
	TXO	P2,TS.IUD!TS.NFI	;FLAG IN USER DATA AND NO FIRST INPUT
	STORE	P2,TCB.ST(B)		;SAVE IN TCB
	$RETT				;GIVE GOOD RETURN
BSF.5:	MOVEI	S1,'BFL'		;BACK OVER HEADER LABELS
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;SIGH
	LOAD	P1,TCB.IO(B)		;PICK UP THE IO STATUS
	TXNE	P1,TI.EOF		;HIT EOF
	  PJRST	PS.BAD			;FILE SECTION .GT. 1 NOT AT BOT IS BAD
	PUSHJ	P,LSTVOL		;BACK UP A VOLUME AND CHECK EOV LABELS
	JUMPF	.RETF			;SOMETHING DIDN'T WORK
	JRST	BSF.1			;NOW START FROM SCRATCH
BSF.6:	MOVX	S1,LE.BOT		;TERMINATION CODE FOR BOT
	MOVEM	S1,G$TERM##		;TO STORE FOR USER
	MOVEI	S1,1			;Mark file position number
	STORE	S1,TCB.PS(B),TP.POS	;  as first.
	ZERO	TCB.ST(B)		;AND CLEAR STATUS
	MOVX	S1,TS.FFF		;GET FIRST FILE FLAG
	IORM	S1,TCB.ST(B)		;INDICATE IN FIRST FILE ON TAPE
	$RETT				;GIVE GOOD RETURN

BSF.7:	PUSHJ	P,L$FINP		;DO FIRST INPUT PROCESSING
	JUMPF	.RETF			;ERRORS
	MOVEI	S1,'BFL'		;BACKSPACE TO
	PUSHJ	P,T$POS##		; BEGINING OF FILE
	JUMPF	.RETF			;ERRORS
	MOVE	S1,TCB.IO(B)		;GET I/O STATUS
	TXNN	S1,TI.BOT		;HIT BOT?
	JRST	BSF.9			;NO
	PUSHJ	P,LSTVOL		;GET PREVIOUS REEL IN VOLUME-SE
	JUMPF	BSF.8			;FAILED--MAYBE ON THE FIRST REEL
	MOVEI	S1,'EOT'		;NOW POSITION TO
	PUSHJ	P,T$POS##		; LOGICAL END OF TAPE
	JUMPF	.RETF			;ERRORS
	JRST	BSF.7			;LOOP BACK AND TRY AGAIN
BSF.8:	PUSHJ	P,CKFIRV		;IS THIS THE FIRST REEL?
	JUMPF	.RETF			;NO--PROPAGATE ERRORS BACK
	MOVEI	S1,LE.BOT		;SET TERMINATION CODE
	MOVEM	S1,G$TERM##		; TO BEGINING OF TAPE
BSF.9:	PJRST	SETIUD			;SET IN USER DATA AND RETURN
; Here to write logical EOT
;
PS.WLE:	PUSHJ	P,L$FOUT		;DO FIRST OUTPUT LABEL CHECKING
	  JUMPF	WLE.1			;FAILED
	PUSHJ	P,L$CLOU		;CLOSE OUTPUT
	  JUMPF	WLE.1			;FAILED
	MOVEI	S1,'SBL'		;CODE TO SKIP A BLOCK
	PUSHJ	P,T$POS##		;SKIP OVER THE LABELS WE JUST WROTE
	  JUMPF	WLE.2			;CAN'T
	MOVEI	S1,LE.CON		;LET THE MONITOR DO THE ERASE
	MOVEM	S1,G$TERM##		; SINCE IT TAKES A LONG TIME
	$RETT				;GIVE GOOD RETURN

WLE.1:	SKIPA	S1,[LE.VLE]		;VOLUME LABEL ERROR
WLE.2:	MOVEI	S1,LE.PSE		;POSITIONING ERROR
	MOVEM	S1,G$TERM##		;STORE TERMINATION CODE
	$RETF				;RETURN
; Here to do a data security erase
; *** Note ***
; 1.	This could tie up PULSAR for a long time.
; 2.	Data security erase is really an output function because the tape
;	is written.  If we call NXTVOU to get the next volume for output,
;	the operator will repeatedly be asked to mount a scratch tape.
;	This is because QUASAR will very happily keep extending the volume
;	set for the user.  Instead, we will call NXTVIN to get the next reel.
;	Conceptually, this is wrong, but it saves alot of chatter to and from
;	QUASAR and lots of operator grief too.

PS.DSE:	MOVNI	P1,1			;INIT FLAG

DSE.1:	CAIN	LT,LT.NL		;NOLABELS?
	JRST	DSE.4			;HANDLE DIFFERENTLY
	AOJN	P1,DSE.3		;JUMP IF BEYOND THE FIRST REEL
	MOVE	S1,TCB.ST(B)		;GET THE STATUS
	TXNE	S1,TS.VLV		;VOLUME LABELS VERIFIED?
	TXNN	S1,TS.OUT		;AND DOING OUTPUT?
	JRST	DSE.2			;NO
	TXNN	S1,TS.IUD		;IN USER DATA?
	JRST	DSE.2			;NO
	TXZ	S1,TS.FFF		;CLEAR FIRST FILE FLAG
	MOVEM	S1,TCB.ST(B)		;UPDATE STATUS
	PUSHJ	P,L$CLOU		;CLOSE OUTPUT
	JUMPF	DSE.E1			;FAILED
	MOVX	S1,TS.FFF		;GET FIRST FILE ON REEL BIT
	ANDCAM	S1,TCB.ST(B)		;CLEAR SO WE DON'T WRITE VOL1 LABELS
	JRST	DSE.3			;NOW WRITE A DUMMY FILE

DSE.2:	PUSHJ	P,L$FOUT		;MAKE SURE USER CAN WRITE THIS TAPE
	JUMPF	DSE.E1			;CAN'T
	MOVEI	S1,'BBL'		;BACKSPACE OVER
	PUSHJ	P,T$POS##		; THE TAPE MARK
	JUMPF	DSE.E2			;POSITIONING ERROR
	MOVEI	S1,'BBL'		;BACKSPACE OVER
	PUSHJ	P,T$POS##		; THE HDR2 RECORD
	JUMPF	DSE.E2			;POSITIONING ERROR
	MOVEI	S1,'BBL'		;BACKSPACE OVER
	PUSHJ	P,T$POS##		; THE HDR1 RECORD
	JUMPF	DSE.E2			;POSITIONING ERROR

DSE.3:	PUSHJ	P,V$FILE##		;WRITE A DUMMY FILE
	JUMPF	DSE.E1			;CHECK FOR ERRORS
	JRST	DSE.5			;ALMOST DONE

DSE.4:	MOVX	S1,TS.ATM		;SEE IF POSITIONED
	TDNN	S1,TCB.ST(B)		; AFTER A TAPE MARK
	PUSHJ	P,T$WRTM##		;NO--WRITE EOF
	JUMPF	DSE.E1			;VOLUME LABEL ERRORS

DSE.5:	PUSHJ	P,T$WRTM##		;WRITE A TAPE MARK TO END TAPE
	JUMPF	DSE.E1			;VOLUME LABEL ERRORS
	MOVEI	S1,'DSE'		;CODE TO DO A DATA SECURITY ERASE
	PUSHJ	P,T$POS##		;ZAP TAPE (SOME DRIVES CAN'T DO IT)
	PUSHJ	P,NXTVIN		;GET NEXT VOLUME FOR INPUT
	JUMPF	DSE.6			;CHECK FOR ERRORS
	MOVX	S1,TS.FFF		;GET FIRST FILE BIT
	IORM	S1,TCB.ST(B)		;SET IT
	JRST	DSE.1			;GO BLANK ANOTHER TAPE
	$RETT				;RETURN

DSE.6:	MOVE	S1,G$TERM##		;GET TERMINATION CODE
	CAIN	S1,LE.EOF		;NO MORE REELS IN VOLUME-SET?
	$RETT				;DONE WITH DATA SECURITY ERASE
	$RETF				;ELSE PROPAGATE ERROR BACK TO USER

DSE.E1:	SKIPA	S1,[LE.VLE]		;VOLUME LABEL ERROR
DSE.E2:	MOVEI	S1,LE.IOP		;POSITIONING ERROR
	MOVEM	S1,G$TERM##		;STORE TERMINATION CODE
	$RETF				;RETURN
SUBTTL	L$USRQ - Routine to Handle Label Request TAPOP.

L$USRQ:: $TRACE	(L$USRQ,2)
	LOAD	S1,TCB.IN(B)		;GET THE EXTRA INFO FIELD
	CAXN	S1,TF.CLE		;CLEAR ERROR FUNCTION?
	JRST	USRQ.1			;YES,
	PUSHJ	P,T$OPEN##		;GET TAPE SO WE'LL RELEASE USER
	MOVX	S1,LE.IOP		;NO, THIS IS ILLEGAL
	MOVEM	S1,G$TERM##		;SAVE ERROR CODE FOR USER
	$RETF				;RETURN WITH ERROR

USRQ.1:	PUSHJ	P,L$CLEF		;Clear the error bits
	PUSHJ	P,T$OPEN##		;OPEN THE TAPE
	JUMPF	.RETF			;CAN'T
	$RETT				;GOOD RETURN
	SUBTTL	L$CLEF - Clear error interlock

;This routine will clear the label error interlock for a given
;TCB.  The tape need not be OPEN.
;Call with the TCB adr in B

L$CLEF::MOVX	S1,TS.INI		;Get initialization bit
	ANDM	S1,TCB.ST(B)		;Clear all status bits - force restart
	ZERO	TCB.EC(B),TE.TRM	;Clear termination code
	$RETT
SUBTTL	L$ABOR - Monitor request to abort current labeling operation


; Here when the user types ^C while waiting for some tape labeler function
; to complete, or when the monitor feels malicious and wants to screw some
; unsuspecting user.  The intent of this code is to gracefully unwind the
; TCB and get the user's job of event wait for the labeler.  Under extreme
; circumstances, this might not work (hardware hangs, etc.).  For each type
; of pending labeler request and TCB wait state, we'll attempt to unwind in
; a safe fashion.

L$ABOR::PUSHJ	P,T$OPEN##		;SO WE CAN DO A LABEL RELEASE
	JUMPF	.RETF			;FAILED
	MOVE	S1,TCB.WS(B)		;GET WAIT STATE CODE
	PUSHJ	P,@ABOTAB(S1)		;DO SPECIAL PRE-ABORT PROCESSING FIRST
	JUMPF	.RETF			;HMMM
	SETZM	TCB.WS(B)		;MARK TCB IDLE
	MOVX	S1,TI.ABO		;GET ABORT FLAG
	ANDCAM	S1,TCB.IO(B)		;CLEAR IT
	MOVEI	S1,LE.LRA		;LABELER REQUEST ABORTED BY RESET UUO
	MOVEM	S1,G$TERM##		;STORE TERMINATION CODE
	PJRST	T$RELE##		;CLEAR LABELER WAIT AND RETURN

ABOSTP:	STOPCD	(AIC,HALT,,<Abort labeler request from illegal context>)

	EXP	.RETT			;WAITING TO RUN
ABOTAB:	EXP	.RETT			;IGNORE
	EXP	ABOMNT			;MOUNT WAIT
	EXP	ABOLBL			;LABEL FAILURE (OPR INTERVENTION) WAIT
	EXP	.RETT			;OFFLINE WAIT
	EXP	ABOSTP			;WAITING FOR ANOTHER TCB
	EXP	ABOSTP			;NEW TAPE WAIT OR OPR RESPONSE
ABOMAX==.-ABOTAB			;LENGTH OF TABLE

IFN <TW.MAX-ABOMAX>,<
	PRINTX ? Missing abort code for labeler function(s)
	PASS2
	END
>
; TCB waiting for a mount
ABOMNT:	PUSHJ	P,CANMDA		;CANCEL PENDING REEL SWITCH REQUEST
	$RETT				;RETURN


; TCB waiting for operator intervention on a label failure
ABOLBL:	MOVX	S1,TS.FSE		;GET A BIT
	ANDCAM	S1,TCB.S2(B)		;CLEAR FILE SEQUENCE ERROR PROCESSING
	MOVEI	S1,ABOTXT		;POINT TO REASON TEXT
	PJRST	O$KWTO##		;CANCEL WTOR AND RETURN

ABOTXT:	ASCIZ	|Labeler operation aborted by a RESET UUO|
	SUBTTL	Volume Label Verification

VERVOL:	$TRACE	(VERVOL,3)
	MOVX	T1,TS.VLV		;GET VOL LABELS VERIFIED BIT
	TDNE	T1,TCB.ST(B)		;HAVE THEY BEEN VERIFIED ALREADY?
	$RETT				;YES, JUST GIVE GOOD RETURN
	ZERO	TCB.ST(B),TS.POS	;CLEAR POSITION INFO
	MOVEI	S1,'REW'		;SET UP TO REWIND THE TAPE
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;CAN'T,  RETURN ERROR
	PUSHJ	P,T$WRCK##		;CHECK WRITE STATUS (RING)
	LOAD	T1,TCB.PT(B),TP.RWL	;GET REQUESTED STATUS
	CAME	T1,S2			;REQUESTED = ACTUAL ?
	SKIPE	T1			;NO, WANT WRITE LOCK
	JRST	VERV.1			;MATCH, OF SOFT WRITE LOCK
	MOVEI	S1,LE.WLK		;CAN'T SOFTWARE WRITE-ENABLE
	MOVEM	S1,G$TERM		;STASH IN GLOBAL ERROR
	$RETF				;AND GIVE FALSE BACK

;Here when the ring status is all set

VERV.1:	PUSHJ	P,I$GDEN##		;ASK THE MONITOR FOR DRIVE DENSITY
	LOAD	LT,TCB.LT(B)		;GET THE LABEL TYPE FROM THE TCB
	PUSHJ	P,T$RDRC##		;READ A RECORD
	PUSH	P,TF			;SAVE THE READ STATUS
	LOAD	S1,TCB.PS(B),TP.DEN	;GET THE REAL DENSITY OF THE DRIVE
	PUSHJ	P,I$SDEN##		;RESET IT
	 JUMPF	S..CCD##		;CAN'T CHANGE DENSITY??
	POP	P,TF			;RESTORE TRUE/FALSE FLAG
	JUMPF	VERV.6			;CAN'T,,CHECK LABEL TYPE
	CAXN	LT,LT.NSL		;NONSTANDARD LABELS?
	JRST	VERV.4			;YES, LABEL TYPE ERROR
	PUSHJ	P,@VOLLBL(LT)		;VERIFY THAT LABEL IS 'VOL1'
	JUMPF	VERV.5			;ITS NOT, GIVE ERROR
	PUSHJ	P,@VOLSER(LT)		;CHECK THE VOLUME SERIAL NUMBER
	JUMPF	VERV.5			;DOESN'T  CHECK, GIVE ERROR
	PUSHJ	P,I$PRIV##		;CHECK FOR [1,2] OR JACCT PRIVS
	JUMPT	VERV.2			;GOT THEM - SKIP PROTECTION CHECK
	PUSHJ	P,@VOLACC(LT)		;CHECK ACCESSIBILITY
	JUMPF	.RETF			;CAN'T TOUCH TAPE
VERV.2:	PUSHJ	P,@VOLDEP(LT)		;NOW GO DO LABEL TYPE DEPENDENT CHECKS
	JUMPF	VERV.5			;LABELS DIDN'T VERIFY
	MOVX	T1,TS.VLV!TS.IUD	; Assume unlabeled flags
	JMPUNL	LT,VERV.3		;Jump if assumption correct
	MOVX	T1,TS.VLV!TS.IHL	;FLAG THAT THEY VERIFIED
VERV.3:	IORM	T1,TCB.ST(B)		;IN THE TCB
	$RETT				;AND GIVE GOOD RETURN

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

VERV.4:	MOVEI	T1,LE.LTE		;CODE FOR LABEL TYPE ERROR
	MOVEM	T1,G$TERM##		;SAVE IN TERMINATION WORD
	$RETF				;GIVE FALSE RETURN

VERV.5:	MOVEI	T1,LE.VLE		;GET CODE FOR VOLUME LABEL ERROR
	MOVEM	T1,G$TERM##		;SAVE IT IN TERMINATION CODE WORD
	$RETF				;AND RETURN FALSE

;Here if we can't read the label record

VERV.6:	JMPUNL	LT,VERV.7		;If we can't re-read unlabeled labels,
	$RETF				;Continue. Return false if we're labeled
VERV.7:	SETZM	G$TERM##		;YES, CLEAR ANY ERRORS, IGNORE THE READ
	MOVX	T1,TS.VLV!TS.IUD	; Assume unlabeled flags
	IORM	T1,TCB.ST(B)		;IN THE TCB
	MOVEI	S1,'REW'		;REPOSITION TO BOT
	PJRST	T$POS##			;ALL IS WELL
VOLLBL:	BLPDSP				;BYPASS LABELS-- SHOULD NEVER GET HERE
	VLL.AS				;ANSI LABELS
	VLL.AS				;  "
	VLL.IL				;  IBM LABELS
	VLL.IL				;  "
	VLL.LT				;LEADING TAPE MARK ????
	.RETF				;NON-STANDARD LABELS
	VLL.NL				;NO LABELS
	.RETT				;FOR COBOL LABELS
	.RETT				;FOR COBOL LABELS
	VLL.NL				;NO LABELS

VLL.IL:
VLL.AS:	MOVE	T1,[CPTRI ^D1,0(BUF)]	;POINT AT WHERE LABEL ID IS (CP 1-4)
	MOVE	T2,VL1PTR		;POINT AT STANDARD LABEL ID
	MOVEI	T3,4			;LENGTH
	HRL	T3,CVTTAB(LT)		;CONVERSION ROUTINE IF ANY
	PJRST	STRCMP			;COMPARE THEM

VLL.LT:	LOAD	P1,TCB.IO(B)		;GET IO STATUS FROM TCB
	TXNN	P1,TI.EOF		;LAST OP SAW EOF?
	$RETF				;YES, ERROR
	$RETT				;ELSE ALL IS WELL

VLL.NL:	MOVE	T1,(BUF)		;GET FIRST 4 CHARS FROM TAPE
	CAMN	T1,VOL1WD		;ASCII "VOL1"?
	$RETF				;YES, ERROR
	CAMN	T1,IBMVL1		;IBM "VOL1"?
	$RETF				;YES, ERROR
	MOVEI	S1,'REW'		;REPOSITION TO BOT
	PJRST	T$POS##			;ALL IS WELL
VOLSER:	BLPDSP
	VLS.AS
	VLS.AS
	VLS.IL
	VLS.IL
	.RETT
	.RETF	
	.RETT
	.RETT
	.RETT
	.RETT

VLS.IL:
VLS.AS:	MOVE	T1,[CPTRI ^D5,0(BUF)]	;POINT AT VOLID (CP 5-10)
	MOVE	T2,[POINT 8,TCB.VL(B)]	;POINT AT CURRENT VOLID IN TCB
	HRRZI	T3,6			;LENGTH OF 6
	HRL	T3,CVTTAB(LT)		;ADDR OF CONVERSION ROUTINE IF ANY
	PJRST	STRCMP			;COMPARE THE VOLIDS
VOLACC:	BLPDSP
	VLA.AS
	VLA.AS
	VLA.IL
	VLA.IL
	.RETT
	.RETF	
	.RETT
	.RETT
	.RETT
	.RETT

VLA.IL:	MOVX	S1,TS.D1A		;NEVER DO DECSYSTEM10 ACCESSESS
	ANDCAM	S1,TCB.ST(B)		; CHECKING ON AN IBM LABELED TAPE
	MOVE	T2,[POINT 7,[ASCIZ/0/]]	;POINT AT ALL ACCESS ALLOWED CHAR
	MOVE	T1,[CPTRI ^D11,0(BUF)]	;AIM AT ACCESS CHARACTER (CP 11)
	MOVEI	T3,1			;ONE CHARACTER LONG
	HRL	T3,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STRCMP		;COMPARE
	JUMPT	.RETT			;IT MUST BE A ZERO
	MOVE	T2,[POINT 7,[ASCIZ/ /]]	;POINT AT ACCESS ALLOWED CHAR
	MOVE	T1,[CPTRI ^D11,0(BUF)]	;AIM AT ACCESS CHARACTER (CP 11)
	MOVEI	T3,1			;ONE CHARACTER LONG
	HRL	T3,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STRCMP		;COMPARE
	JUMPT	.RETT			;IT MUST BE A SPACE
	PJRST	VLA.1			;COMPLAIN TO OPR, GET RESPONSE

VLA.AS:	MOVE	T2,BNKPTR		;POINT AT ALL ACCESS ALLOWED CHAR
	MOVX	S1,TS.D1A		;GET BIT TO CLEAR
	ANDCAM	S1,TCB.ST(B)		;CLEAR IT IN THE TCB
	MOVE	T1,[CPTRI ^D11,0(BUF)]	;Aim at access character (CP 11)
	MOVEI	T3,1			;ONE CHARACTER LONG
	HRL	T3,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STRCMP		;COMPARE
	JUMPT	.RETT			;ALL ACCESS ALLOWED
	MOVE	T1,[CPTRI ^D38,0(BUF)]	;POINT AT OWNER ID (CP 38-40)
	MOVE	T2,D10PTR		;AND COMPARE OF PDP-10
	HRRZI	T3,3			;3 CHARS, NO CONVRT
	HRL	T3,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STRCMP		;DO COMPARE
	JUMPF	.RETT			;Not a DEC-10 tape, let anyone in,
					;since we don't know the access
					;protection scheme of the writer
	MOVE	T1,[CPTRI ^D11,0(BUF)]	;Aim at access char for DEC-10 (CP 11)
	MOVE	T2,[POINT 7,[ASCIZ/1/]]	;RESTRICTED ACCESS CHAR FOR DEC-10
	MOVEI	T3,1			;ONE CHARACTER LONG
	HRL	T3,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STRCMP		;COMPARE
	JUMPF	VLA.1			;NOT SPECIAL CHAR, NO ACCESS
	MOVX	S1,TS.D1A		;FLAG DEC-10 ACCESS CHECKING
	IORM	S1,TCB.ST(B)		;TURN ON FLAG IN TCB
	$RETT				;AND GIVE GOOD RETURN

VLA.1:	MOVEI	S1,[ITEXT (<Volume Accessibility Prohibits Access>)]
	PJRST	O$LERR##		;TELL OPR
					;WAIT FOR ANSWER
VOLDEP:	BLPDSP
	VLD.AS
	VLD.AS
	VLD.IL
	VLD.IL
	.RETT
	.RETF	
	.RETT
	.RETT
	.RETT
	.RETT

VLD.IL:
VLD.AS:
IFE FTVPRO,<				;If we don't do volume protection
	JRST	VOLBYP			;Just skip to end of label group
>;End IFE FTVPRO

IFN FTVPRO,<				;If we do volume protection
	$CALL	.SAVE2			;SAVE SOME REGS
	LOAD	S1,TCB.ST(B)		;GET STATUS
	TXNN	S1,TS.D1A		;DEC-10 ACCESS CHECKING?
	JRST	VOLBYP			;NO, JRST GET TO THE END OF THE VOLUME LABELS
	PUSHJ	P,T$RDRC##		;READ A RECORD
	JUMPF	.RETF			;I/O ERROR
	MOVE	T1,[CPTRI ^D1,0(BUF)]	;Point to start of label record (CP 1-4)
	MOVE	T2,VL2PTR		;IS IT VOL2 ?
	HRRZI	T3,4			;4 CHRS, NO CONVERT
	HRL	T3,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STRCMP		;COMPARE
	JUMPT	VLD.A1			;VOL2, PROCEED
IFN FTUPRO,<				;If we do volume protection by UVL1,
					;Then check for that flavor of label
	MOVE	T1,[CPTRI ^D1,0(BUF)]	;Point to start of label record (CP 1-4)
	MOVE	T2,UVLPTR		;IS IT UVL1 ?
	HRRZI	T3,4			;4 CHRS, NO CONVERT
	HRL	T3,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STRCMP		;COMPARE
	JUMPT	VLD.A1			;UVL1, PROCEED
>;End IFN FTUPRO
	MOVEI	S1,[ITEXT (<No DEC-10 protection label (VOL2/UVL1)>)]
	PUSHJ	P,O$LERR##		;TYPE DEVICE+MESSAGE
					;WAIT FOR OPR
	JUMPF	.RETF			;HE SAID NO

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

;Here when the volume protection label (either UVL1 or VOL2)
; for a DEC-10 tape has been read.
VLD.A1:	MOVE	T1,[CPTRI ^D5,0(BUF)]	;POINT AT PROT (CP 5-10)
	HRRZI	T2,6			;6 CHARS, NO CONVERT
	HRL	T2,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STROCT		;MAKE IT A NUMBER
	JUMPF	VLD.A4			;OOPS, RETURN
	MOVE	P1,S2			;SAVE PROT
	LOAD	S1,TCB.PT(B),TP.PRT	;Get protection from MOUNT
	SKIPN	S1			;Was one specified?
	STORE	P1,TCB.PT(B),TP.PRT	;No, save it as a default
	MOVE	T1,[CPTRI ^D11,0(BUF)]	;POINT AT PROJ # (CP 11-16)
	HRRZI	T2,6			;6 CHARS, NO CONVERT
	HRL	T2,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STROCT		;GET A #
	JUMPF	VLD.A4			;NOT A NUMBER?
	MOVE	P2,S2			;SAVE PROJ # IN P2 FOR NOW
	MOVE	T1,[CPTRI ^D17,0(BUF)]	;POINT AT PROG # (CP 17-22)
	HRRZI	T2,6			;6 CHARS, NO CONVERSION
	HRL	T2,CVTTAB(LT)		;CONVERSION IF NECESSARY
	PUSHJ	P,STROCT		;CHANGE STRING TO OCTAL NUMBER
	JUMPF	VLD.A4			;NOT A NUMBER
	MOVE	T1,P1			;GET PROT IN T1
	HRRZ	T2,S2			;AND MAKE T2=PPN
	HRL	T2,P2			;...
	MOVEM	T2,TCB.VO(B)		;STORE OWNER (PPN) FOR LATER REFERENCE
	LOAD	T3,TCB.OW(B)		;GET USER'S PPN FROM TCB
	PUSHJ	P,I$CKAC##		;CHECK ACCESS
	JUMPL	S2,VLD.A5		;IF NO ACCESS AT ALL, TELL OPR NOW
	MOVX	S1,TS.NOW		;GET 'VOLUME WRITE PROTECTED' BIT
	SKIPG	S2			;CAN USER WRITE?
	IORM	S1,TCB.ST(B)		;YES, SET THE BIT IN THE TCB
	JRST	VOLBYP

VLD.A4:	MOVEI	S1,[ITEXT (<Invalid character in volume PPN or protection>)]
	PUSHJ	P,O$LERR##		;TYPE DRIVE NAME AND ERROR
					;AND WAIT FOR OPR RESPONSE
	JUMPF	.RETF			;IF ERROR, RETURN NOW
	JRST	VOLBYP			;IF PROCEED, FINISH UP VOL LBL STUFF

VLD.A5:	PUSHJ	P,VPCCHK		;TELL OPR ABOUT VOL PROT FAILURE
	JUMPF	.RETF			;RESPONSE WAS ABORT
	JRST	VOLBYP			;ELSE CHARGE ONWARD
>;End IFN FTVPRO

SUBTTL	VOLBYP - Bypass VOL2-VOLn, UVLn

VOLBYP:	PUSHJ	P,T$RDRC##		;GO READ A RECORD
	JUMPF	.RETF			;COULDN'T, LOSE
	LOAD	T1,TCB.IO(B),TI.EOF	;LAST OP SAW EOF?
	JUMPN	T1,VOLB.3		;BACKSPACE AND QUIT NOW IF TRUE
	MOVE	T1,[CPTRI ^D1,0(BUF)]	;POINT AT LABEL ID FIELD (CP 1-3)
	MOVE	T2,VL1PTR		;COMPARE AGAINST VOL(n)
	HRRZI	T3,3			;NO CONVERSION, 3 CHARACTERS
	HRL	T3,CVTTAB(LT)		;GET RIGHT CONVERSION ROUTINE ADDRESS
	PUSHJ	P,STRCMP		;COMPARE IT
	JUMPT	VOLBYP			;IF IT WAS, GO READ NEXT RECORD
	JRST	UVLB.1			;Jump into the UVL bypass loop

;Here to skip over UVL records
UVLBYP:	PUSHJ	P,T$RDRC##		;GO READ A RECORD
	JUMPF	.RETF			;COULDN'T, LOSE
	LOAD	T1,TCB.IO(B),TI.EOF	;LAST OP SAW EOF?
	JUMPN	T1,VOLB.3		;BACKSPACE AND QUIT NOW IF TRUE
UVLB.1:	MOVE	T1,[CPTRI ^D1,0(BUF)]	;POINT AT LABEL ID FIELD (CP 1-3)
	MOVE	T2,UVLPTR		;COMPARE AGAINST UVL(n)
	HRRZI	T3,3			;NO CONVERSION, 3 CHARACTERS
	HRL	T3,CVTTAB(LT)		;GET RIGHT CONVERSION ROUTINE ADDRESS
	PUSHJ	P,STRCMP		;COMPARE IT
	JUMPT	UVLBYP			;IF IT WAS, GO READ NEXT RECORD
					;Otherwise, just back up over it

VOLB.3:	MOVEI	S1,'BBL'		;Code for Backspace Block
	PJRST	T$POS##			;Back over EOF, and return
SUBTTL	Header Label Verification

VERHDR:	CAIN	LT,LT.NL		;NOLABELS?
	JRST	VERH.1			;YES--NO HEADERS TO CHECK
	PUSHJ	P,@HDRLBL(LT)		;GO CHECK FOR HDR1
	JUMPF	VERH.2			;NOT THERE, ERROR
	PUSHJ	P,@HDRSEQ(LT)		;NOW PROCESS SEQUENCE NUMBER
	JUMPF	VERH.2			;ITS WRONG
;	PUSHJ	P,@HDRSEC(LT)		;MAKE SURE WE HAVE THE RIGHT PIECE
;	JUMPF	VERH.2			; OF FILE SECTION NUMBER
	PUSHJ	P,@HDREXP(LT)		;CHECK EXPIRADION DATE IF OUTPUT
	JUMPF	VERH.2			;NOT PAST, ERROR
	PUSHJ	P,@HDRACC(LT)		;CHECK ACCESSIBILITY
	JUMPF	VERH.2			;NO ACCESS ALLOWED
	PUSHJ	P,@HDRDEP(LT)		;AND GO DO LABEL TYPE DEPENDENT CODE
	JUMPF	VERH.2			;DIDN'T WORK

VERH.1:	MOVX	P2,TS.POS		;GET STATUS POSITION FIELS
	ANDCAB	P2,TCB.ST(B)		;CLEAR IN TCB AND GET STATUS IN P2
	TXNN	P2,TS.OUT		;THIS FILE DOING OUTPUT?
	TXZ	P2,TS.FFF		;NO, TURN OFF FIRST FILE FLAG
	TXO	P2,TS.IUD		;GET FLAG FOR IN USER DATA
	MOVEM	P2,TCB.ST(B)		;IN BOTH AC AND TCB
	$RETT				;GIVE GOOD RETURN


;HERE TO RETURN HEADER LABEL ERROR
VERH.2:	MOVEI	S1,LE.HDE		;GET CODE FOR HEADER LABEL ERROR
	MOVEM	S1,G$TERM##		;AND STORE IN TERMINATION CODE WORD
	$RETF				;AND RETURN ERROR
	SUBTTL	L$HDEX - Check for expiration during intialization

;This routine is used when initializing a tape to make
; sure that the operator is not trying to initialize an un-expired
; tape.

;Call -
;	LT/	label type of this tape.
;Returns -
;	T/	OK to write on this tape
;	F/	Tape is 'unexpired'

L$HDEX::
	JMPUNL	LT,.RETT		;If unlabeled, no expiration checking
	PUSHJ	P,FNDHD1		;Get to the HDR1 label
	JUMPF	.POPJ			;No HDR1, say unexpired
	PUSHJ	P,@HDREXP(LT)		;Check expiration
	MOVX	S1,TS.EXP		;Get the un-expired bit
	TDNN	S1,TCB.ST(B)		;Is file unexpired?
	$RETT				;No
	$RETF				;Yes, say so
HDRLBL:	BLPDSP
	HLB.AS
	HLB.AS
	HLB.IL
	HLB.IL
	.RETF
	.RETF
	.RETF
	HLB.CA
	HLB.CA
	.RETF

HLB.CA:

HLB.IL:
HLB.AS:	MOVE	T1,[CPTRI ^D1,0(BUF)]	;POINT AT HDR1 IN LABEL (CP 1-4)
HLB.A1:	MOVE	T2,HD1PTR		;AND AT CANONICAL FORM
	HRRZI	T3,4			;4 CHARS
	HRL	T3,CVTTAB(LT)		;GET POINTER TO CONVERT ROUTINE
	PUSHJ	P,STRCMP		;COMPARE THEM
	JUMPF	HLB.1			;NOT HDR1
	MOVX	S1,TS.OUT		;GET OUTPUT FLAG
	TDNE	S1,TCB.ST(B)		;DON'T COPY FILE NAME ON OUTPUT
	$RETT				;EXIT ON OUTPUT
	MOVE	T1,[CPTRI ^D5,0(BUF)]	;POINTER TO THE FILE NAME (CP 5-21)
	MOVE	T2,[POINT 7,TCB.FN(B)]	;WHERE TO STORE THE FILE NAME
	MOVEI	T3,^D17			;SEVENTEEN CHARACTERS
	HRL	T3,CVTTAB(LT)		;CONVERSION TYPE
	PUSHJ	P,STGSTR		;COPY THE STRING
	JUMPT	.RETT			;OK RETURN
HLB.0:	MOVEI	S1,[ITEXT (<Illegal character(s) in the file name>)]
	PJRST	O$LERR##		;TELL THE OPERATOR
					;WAIT FOR THE RESPONSE
HLB.1:	MOVEI	S1,[ITEXT (<Expected HDR1 label is not HDR1>)]
	PJRST	O$LERR##		;TYPE DRIVE+ERROR
					;WAIT FOR OPR RESPONSE
HDRACC:	BLPDSP
	HDA.AS
	HDA.AS
	HDA.IL
	HDA.IL
	.RETF	
	.RETF	
	.RETF	
	.RETT
	.RETT
	.RETF	

HDA.IL:	SKIPA	T2,[POINT 7,[ASCIZ/0/]]	;POINT AT A ZERO
HDA.AS:	MOVE	T2,BNKPTR		;OR AT A BLANK
	MOVE	T1,[CPTRI ^D54,0(BUF)]	;POINT AT CHAR IN LABEL (CP 54)
	MOVEI	T3,1			;CHARS TO COMPARE
	HRL	T3,CVTTAB(LT)		;GET CONVERSION ROUTINE ADDR
	MOVX	S1,TS.D1A		;GET BIT TO CLEAR
	ANDCAM	S1,TCB.ST(B)		;CLEAR IT IN THE TCB
	PUSHJ	P,STRCMP		;COMPARE THE CHARACTERS
	JUMPT	.RETT			;RETURN NOW IF OK
	MOVE	T1,[CPTRI ^D61,0(BUF)]	;POINT AT SYSTEM CODE (CP 61-73)
	MOVE	T2,S10PTR		;POINTER TO 'DECSYSTEM10'
	MOVEI	T3,^D13			;LENGTH TO CHECK
	HRL	T3,CVTTAB(LT)		;CONVERSION IF ANY
	PUSHJ	P,STRCMP		;IS THIS A DEC-10 TAPE?
	JUMPF	HDA.1			;NO, TELL OPR OF FAILURE NOW
	MOVE	T1,[CPTRI ^D54,0(BUF)]	;POINT AT ACCESS CHAR AGAIN (CP 54)
	MOVE	T2,[POINT 7,[ASCIZ/1/]]	;AND AT SPECIAL CHAR USED BY 10
	MOVEI	T3,1			;ONE CHAR
	HRL	T3,CVTTAB(LT)		;CONVERSION ROUTINE ADDR
	PUSHJ	P,STRCMP		;IS IT SPECIAL DEC-10 CHAR?
	JUMPF	HDA.1			;IF NOT, TELL OPR ABOUT ACC FAILURE
	MOVX	S1,TS.D1A		;ELSE GET BIT TO FLAG DEC-10 ACCESS CHECKING
	IORM	S1,TCB.ST(B)		;AND FLAG IT IN TCB
	$RETT				;AND RETURN GOOD FOR NOW

HDA.1:	MOVEI	S1,[ITEXT (<File Accessibility Prohibits Access>)]
	PJRST	O$LERR##		;TELL OPR DRIVE AND FAILURE
					;WAIT FOR HIS ANSWER
	SUBTTL	HDRSEQ - Verify file sequence number
HDRSEQ:	BLPDSP
	HDS.AS
	HDS.AS
	HDS.IL
	HDS.IL
	.RETF	
	.RETF	
	.RETF	
	HDS.CA
	HDS.CS
	.RETF	

HDS.CA:	MOVE	T1,[POINT 7,6(BUF),6]	;POINT AT SEQUENCE NUMBER IN LABEL
	JRST	HDS.A1			;AND DO REST LIKE ASCII

HDS.CS:	MOVE	T1,[POINT 6,5(BUF),5]	;POINT AT SEQUENCE NUMBER IN LABEL
	JRST	HDS.A1			;AND DO REST LIKE ASCII

HDS.IL:					;IBM ARE JUST LIKE ASCII
HDS.AS:	MOVE	T1,[CPTRI ^D32,0(BUF)]	;POINT AT THE SEQUENCE NUMBER (CP 32-35)
HDS.A1:	HRRZI	T2,4			;IT IS 4 CHARS LONG
	HRL	T2,CVTTAB(LT)		;GET CONVERSION ROUTINE ADDR
	PUSHJ	P,STRNUM		;GET IT AS A NUMBER
	JUMPF	HDS.3			;NOT A NUMBER?
	LOAD	T2,TCB.PS(B),TP.POS	;NOW PICK UP CURRENT POSITION
	SKIPN	T2			;IS IT ZERO?
	MOVEI	T2,1			;YES, USE START OF 1
	LOAD	S1,TCB.ST(B)		;GET UNIT STATUS
	TXC	S1,TS.FFF!TS.OUT	;COMPLEMENT FIRST FILE+DOING OUTPUT
	TXNN	S1,TS.FFF!TS.OUT	;WERE BOTH ON ?
	JRST	HDS.1			;YES, JUST SAVE POSITION FROM TCB
	CAIN	T2,1			;ARE WE EXPECTING FIRST SECTION?
	MOVE	T2,S2			;YES, EXPECT ANYTHING
	CAMN	T2,S2			;DO LABEL AND TCB AGREE?
	JRST	HDS.1			;ALL IS WELL
	SKIPE	G$SEQC##		;HAVE WE ASKED THE OPERATOR?
	$WTO	(<HDR file sequence warning>,<Label says ^D/S2/ when looking for ^D/T2/>,TCB.OB(B),$WTFLG(WT.SJI))
HDS.1:	STORE	T2,TCB.PS(B),TP.POS	;GOOD NUMBER, STORE IT (MAKES 0 INTO 1)
	$RETT				;AND GIVE GOOD RETURN

HDS.3:	MOVEI	S1,[ITEXT (<Invalid numeric field for File Sequence Number>)]
	PJRST	O$LERR##		;TELL OPR DRIVE+ERROR
					;WAIT FOR HIS RESPONSE
	SUBTTL	HDRSEC - Verify file section number

HDRSEC:	BLPDSP
	HDN.AS
	HDN.AS
	HDN.IL
	HDN.IL
	.RETF	
	.RETF	
	.RETF	
	.RETT				;None for COBOL labels
	.RETT				;None for COBOL labels
	.RETF	

HDN.IL:					;IBM ARE JUST LIKE ASCII
HDN.AS:	MOVE	T1,[CPTRI ^D28,0(BUF)]	;POINT AT THE SECTION NUMBER (CP 28-31)
	HRRZI	T2,4			;IT IS 4 CHARS LONG
	HRL	T2,CVTTAB(LT)		;GET CONVERSION ROUTINE ADDR
	PUSHJ	P,STRNUM		;GET IT AS A NUMBER
	JUMPF	HDN.3			;NOT A NUMBER?
	LOAD	T2,TCB.SN(B)		;NOW PICK UP CURRENT SECTION #
	LOAD	S1,TCB.ST(B)		;GET UNIT STATUS
	TXC	S1,TS.FFF!TS.OUT	;COMPLEMENT FIRST FILE+DOING OUTPUT
	CAME	T2,S2			;DO LABEL AND TCB AGREE?
	TXNN	S1,TS.FFF!TS.OUT	;NO, WRITING FIRST FILE?
	$RETT				;YES, MATCH, OR IGNORE ON OVERWRITE
	MOVEI	S1,[ITEXT (<Incorrect File Section Number>)]
	SKIPA				;AFTER MESSAGE, LIKE OTHER ERROR
HDN.3:	MOVEI	S1,[ITEXT (<Invalid numeric field for File Section Number>)]
	PJRST	O$LERR##		;TELL OPR DRIVE+ERROR
					;WAIT FOR HIS RESPONSE
SUBTTL	HDREXP - Get and check creation and expiration dates

;	This routine also reads the generation and version numbers
; Call -
;	BUF/	Addr of HDR1 buffer

HDREXP:	BLPDSP
	HDE.AS
	HDE.AS
	HDE.IL
	HDE.IL
	.RETF	
	.RETF	
	.RETF	
	.RETT
	.RETT
	.RETF	

HDE.IL:					 ;JUST LIKE ANSI
HDE.AS:	MOVE	T1,[CPTRI ^D43,0(BUF)]	;AIM AT THE CREATION DATE (CP 43-47)
	MOVEI	T2,5			;NUMBER OF CHARS TO CONVERT
	HRL	T2,CVTTAB(LT)		;CONVERSION ROUTINE
	PUSHJ	P,STRNUM		;READ A DECIMAL NUMBER
	SKIPT				;WINS?
	SETZ	S2,			;NO, FLAG NO KNOWN DATE
	MOVE	S1,S2			;COPY THE DATE FROM THE HDR1
	PUSHJ	P,I$DT15##		;CONVERT TO 15-BIT FORMAT
	STORE	S1,TCB.EX(B),TE.CRE	;SAVE IN TCB
	MOVE	T1,[CPTRI ^D49,0(BUF)]	 ;POINT AT THE EXP DATE FIELD (CP 49-53)
	MOVEI	T2,5			;NUMBER OF CHARS TO GET
	HRL	T2,CVTTAB(LT)		;CONVERSION IF ANY
	PUSHJ	P,STRNUM		;GET IT AS A DECIMAL NUMBER
	JUMPF	HDE.1			;BAD NUMBER, COMPLAIN TO  OPR
	PUSH	P,S2			;SAVE DATE FROM LABEL
	MOVE	S1,S2			;COPY IT TO S1
	PUSHJ	P,I$DT15##		;MAKE DATE FROM LABEL IN 15 BIT FORM
	LOAD	T1,TCB.ST(B)		;Get status
	TXNN	T1,TS.OUT		;Don't save exp date on output
	STORE	S1,TCB.EX(B),TE.EXP	;SAVE IT IN THE TCB
	PUSHJ	P,I$DATE##		;GET TODAY'S DATE
	MOVE	T1,S2			;COPY BYTE POINTER TO TODAY INTO T1
	IBP	T1			;SKIP THE LEADING BLANK
	MOVEI	T2,5			;LENGTH OF A DATE
	PUSHJ	P,STRNUM		;MAKE IT A NUMBER
	SKIPT				;VALID NUMBER?
	STOPCD	(IDM,HALT,,<Invalid date from monitor>)
	POP	P,S1			;GET BACK DATE FROM LABEL
	MOVX	T1,TS.EXP		;BIT WHICH FLAGS UNEXPIRED FILE
	ANDCAM	T1,TCB.ST(B)		;CLEAR IT IN CASE EXPIRED
	CAMGE	S2,S1			;IS FILE EXPIRED?
	IORM	T1,TCB.ST(B)		;NO, FLAG IT AS SO
	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

;Now, get the generation and version numbers for this file

	MOVE	T1,[CPTRI ^D36,0(BUF)]	;AIM AT THE GENERATION NUMBER (CP 36-39)
	MOVEI	T2,4			;4 CHAR FIELD
	HRL	T2,CVTTAB(LT)		;CONVERSION ROUTINE
	PUSHJ	P,STRNUM		;READ THE GENERATION NUMBER
	SKIPT				;LOOKS OK?
	SETZ	S2,			;NO, SUPPLY A DEFAULT
	STORE	S2,TCB.GV(B),TG.GEN	;SAVE IN TCB
	MOVE	T1,[CPTRI ^D40,0(BUF)]	;AIM AT THE VERSION NUMBER FIELD (CP 40-41)
	MOVEI	T2,2			;2 CHAR FIELD
	HRL	T2,CVTTAB(LT)		;CONVERSION ROUTINE
	PUSHJ	P,STRNUM		;CONVERT IT
	SKIPT				;LOOKS OK?
	SETZ	S2,			;NO, SUPPLY A DEFAULT
	STORE	S2,TCB.GV(B),TG.VER	;SAVE IN TCB
	$RETT				;AND GIVE GOOD RETURN

HDE.1:	MOVEI	S1,[ITEXT (<Invalid Expiration Date Field>)]
	PJRST	O$LERR##		;TELL OPR
					;WAIT FOR HIS RESPONSE
SUBTTL	HDRDEP - Label type dependent checks

; Call -
;	BUF/	Addr of buffer containing HDR1
; Returns -
;	BUF/	Addr of buffer with HDR2 (unless there isn't a HDR2)

HDRDEP:	BLPDSP
	HDD.AS
	HDD.AS
	HDD.IL
	HDD.IL
	.RETF	
	.RETF	
	.RETF	
	.RETT
	.RETT
	.RETF	

HDD.IL:
HDD.AS:	$CALL	.SAVE3			;SAVE SOME AC'S
	ZERO	TCB.PR(B)		;CLEAR PROTECTION
	ZERO	TCB.RF(B),TF.RFM!TF.FCT	;CLEAR RECORD FORMAT AND FORM CONTROL
	ZERO	TCB.LN(B)		;CLEAR RECORD AND BLOCK LENGTHS
	MOVX	S1,TS.WLK		;Get file write protect bit
	ANDCAM	S1,TCB.ST(B)		;Clear it (assume write is allowed)
	PUSHJ	P,T$RDRC##		;READ NEXT RECORD
	JUMPF	.POPJ			;ERROR
	LOAD	P1,TCB.IO(B)		;GET IO STATUS
	TXNE	P1,TI.EOF		;EOF SEEN??
	$RETT				;Yes, No more HDRs, quit
	MOVE	T1,[CPTRI ^D1,0(BUF)]	;POINT AT LABEL ID IN BUFFER (CP 1-4)
	MOVE	T2,HD2PTR		;AND AT 'HDR2'
	HRRZI	T3,4			;LENGTH OF 4
	HRL	T3,CVTTAB(LT)		;GET ADDR OF CONVERT ROUTINE
	PUSHJ	P,STRCMP		;COMPARE THEM
	JUMPF	HDD.A6			;NOT HDR2, TELL OPR
	LOAD	S1,TCB.ST(B)		;PICK UP STATUS
	TXNN	S1,TS.D1A		;WANT DEC-10 ACCESS CHECKING?
	JRST	HDD.A1			;NO, EXIT NOW
	MOVE	T1,[CPTRI ^D22,0(BUF)]	;POINT AT PROJECT NUMBER (CP 22-27)
	HRRZI	T2,6			;6 CHARS
	HRL	T2,CVTTAB(LT)		;GET ADDR OF CONVERT ROUTINE
	PUSHJ	P,STROCT		;MAKE IT AN OCTAL NUMBER
	JUMPF	HDD.A4			;COULDN'T
	MOVE	P1,S2			;SAVE FOR LATER
	MOVE	T1,[CPTRI ^D28,0(BUF)]	;POINT AT PROGRAMMER NUMBER (CP 28-33)
	HRRZI	T2,6			;6 CHARACTER
	HRL	T2,CVTTAB(LT)		;GET ADDR OF CONVERT ROUTINE
	PUSHJ	P,STROCT		;GET IT IN OCTAL
	JUMPF	HDD.A4			;COULDN'T
	MOVE	P2,S2			;SAVE FOR LATER
	MOVE	T1,[CPTRI ^D16,0(BUF)]	;POINT AT PROTECTION (CP 16-21)
	HRRZI	T2,6			;GET 6 CHARACTERS
	HRL	T2,CVTTAB(LT)		;GET ADDR OF CONVERT ROUTINE
	PUSHJ	P,STROCT		;MAKE THEM AN OCTAL NUMBER
	JUMPF	HDD.A4			;COULDN'T
	STORE	S2,TCB.PR(B)		;SAVE IN TCB
	MOVE	T1,S2			;MAKE T1 BE PROTECTION
	HRRZ	T2,P2			;GET PROGRAMMER NUMBER
	HRL	T2,P1			;MAKE PPN
	LOAD	T3,TCB.OW(B)		;GET THE USER'S PPN
	PUSHJ	P,I$CKAC##		;DO THE ACCESS CHECK
	JUMPG	S2,HDD.A1		;IF ALL ACCESS ALLOWED, RETURN
	JUMPL	S2,HDD.A5		;IF NO ACCESS, TELL OPR NOW
	MOVX	S1,TS.WLK		;ELSE GET FILE WRITE LOCKED BIT
	IORM	S1,TCB.ST(B)		;SET IT IN TCB AND GO ON
HDD.A1:	MOVE	T1,[CPTRI ^D5,0(BUF)]	;POINT AT REC FORMAT FIELD (CP 5)
	MOVE	T2,[POINT 7,P3]		;GET IT INTO P3
	MOVEI	T3,1			;1 CHARACTER
	HRL	T3,CVTTAB(LT)		;CONVERT IF NEEDED
	PUSHJ	P,STGSTR		;GET THE REC FMT
	JUMPF	HDD.A2			;NO GOOD
	LDB	T1,[POINT 7,P3,6]	;COPY CHARACTER TO T1
	MOVE	T2,[XWD -.TRFMX,1]	;MAKE T2 AN AOBJN POINTER TO REC FMTS
	CAME	T1,RECFMT(T2)		;DOES THIS ENTRY MATCH?
	AOBJN	T2,.-1			;NO, TRY TILL DONE
	SKIPLE	T2			;Find a match??
HDD.A2:	MOVX	T2,.TRFUN		;No, Assume Undefined format
	STORE	T2,TCB.RF(B),TF.RFM	;STORE REC FORMAT IN TCB
	MOVE	T1,[CPTRI ^D11,0(BUF)]	;NOW POINT AT REC LEN FIELD (CP 11-15)
	MOVEI	T2,5			;5 CHARACTER FIELD
	HRL	T2,CVTTAB(LT)		;CONVERT
	PUSHJ	P,STRNUM		;DECIMAL NUMBER
	JUMPF	.POPJ			;OOPS
	STORE	S2,TCB.LN(B),TL.REC	;SAVE IN TCB
	MOVE	T1,[CPTRI ^D6,0(BUF)]	;NOW POINT AT BLOCK LEN FIELD (CP 6-10)
	MOVEI	T2,5			;5 CHARACTER FIELD
	HRL	T2,CVTTAB(LT)		;CONVERT
	PUSHJ	P,STRNUM		;DECIMAL NUMBER
	JUMPF	.RETF			;OOPS
	STORE	S2,TCB.LN(B),TL.BLK	;SAVE IN TCB
	MOVE	T1,[CPTRI ^D37,0(BUF)]	;AIM AT FORM CONTROL CHAR (CP37)
	MOVE	T2,[POINT 7,P3]		;STORE CONVERTED CHAR IN P3
	MOVEI	T3,1			;ONLY 1 CHAR
	HRL	T3,CVTTAB(LT)		;CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;READ AND CONVERT FORM CONTROL CHAR
	JUMPF	HDD.A3			;BAD CHAR, ASSUME NONE
	LDB	T1,[POINT 7,P3,6]	;GET BACK THE CHAR
	MOVE	T2,[XWD -.TFCMX,1]	;MAKE POINTER TO TABLE
	CAME	T1,RECFRM(T2)		;IS THIS THE ONE
	AOBJN	T2,.-1			;NO, TRY THE NEXT
	SKIPL	T2			;FIND ONE?
HDD.A3:	MOVX	T2,.TFCNO		;NO, SAY NO FORM CONTROL
	STORE	T2,TCB.RF(B),TF.FCT	;SAVE INDEX
	MOVEI	S1,'SFL'		;SET TO SKIP THE REST OF THE LABEL GROUP
	PJRST	T$POS##			;DO IT AND RETURN

HDD.A4:	MOVEI	S1,[ITEXT (<Invalid PPN or Protection in HDR1 Label>)]
	PUSHJ	P,O$LERR##		;TELL OPR DRIVE+MESSAGE
					;WAIT FOR OPR RESPONSE
	JUMPF	.RETF			;ABORT IF HE SAY'S SO
	JRST	HDD.A1			;OTHERWISE, FINISH UP

HDD.A5:	MOVEI	S1,[ITEXT (<File Protection Prohibits Access>)]
	PUSHJ	P,O$LERR##		;TELL OPR,,WAIT FOR RESPONSE
	JUMPF	.RETF			;ABORT IF HE SAY'S SO
	JRST	HDD.A1			;OTHERWISE, FINISH UP

HDD.A6:	MOVEI	S1,[ITEXT (<HDR2 expected but not found>)]
	PUSHJ	P,O$LERR##		;TELL OPR DRIVE+MESSAGE
					;WAIT FOR OPR RESPONSE
	JUMPF	.RETF			;ABORT IF HE SAY'S SO
	JRST	HDD.A1			;OTHERWISE, FINISH UP
SUBTTL	EOF Label Verification

VEREOF:	$TRACE	(VEREOF,3)
	PUSHJ	P,@EOFLBL(LT)		;CHECK FOR 'EOF1'
	JUMPF	VEOF.1			;NOT THERE
	PUSHJ	P,@EOFSEQ(LT)		;CHECK FILE SEQUENCE NUMBER
	JUMPF	VEOF.1			;DOESN'T CHECK
;	PUSHJ	P,@EOFSEC(LT)		;Check the file section number
;	JUMPF	VEOF.1			;Doesn't match! 
	INCR	TCB.PS(B),TP.POS	;COUNT UP THE FILE NOW
	PUSHJ	P,@EOFEXP(LT)		;CHECK EXPIRATION DATE
	JUMPF	VEOF.1			;IF NO GOOD, QUIT NOW
	PUSHJ	P,I$BCNT##		;GET BLOCK COUNT SO FAR
	MOVEM	S1,TCB.BC(B)		;SAVE
	PUSHJ	P,@EOFBLK(LT)		;CHECK BLOCK COUNT
	JUMPF	VEOF.1			;DOESN'T CHECK
	PUSHJ	P,@EOFDEP(LT)		;GO DO LABEL TYPE DEPENDENT
					; STUFF
	JUMPF	VEOF.1			;DIDN'T WORK
	MOVX	S1,TS.POS		;GET POSITION STATUS BITS
	ANDCAM	S1,TCB.ST(B)		;CLEAR THEM IN THE TCB
	MOVX	S1,TS.ATM		;AND GET BIT FOR AFTER TAPE MARK
	IORM	S1,TCB.ST(B)		;TURN IT ON IN TCB
	$RETT				;AND GIVE GOOD RETURN
VEOF.1:	MOVEI	S1,LE.TRE		;GET CODE FOR TRAILER LABEL ERROR
	MOVEM	S1,G$TERM##		;SAVE AS TERMINATION CODE
	$RETF				;AND RETURN
SUBTTL	EOV Label Verification

VEREOV:	$TRACE	(VEREOV,3)
	PUSHJ	P,@EOVLBL(LT)		;CHECK FOR 'EOV1'
	JUMPF	VEOV.1			;NOT THERE
	PUSHJ	P,@EOVSEQ(LT)		;CHECK FILE SEQUENCE NUMBER
	JUMPF	VEOV.1			;DOESN'T CHECK
;	PUSHJ	P,@EOVSEC(LT)		;Check the file section number
;	JUMPF	VEOV.1			;Doesn't look good!
	PUSHJ	P,@EOVBLK(LT)		;CHECK BLOCK COUNT
	JUMPF	VEOV.1			;DOESN'T CHECK
	PJRST	@EOVDEP(LT)		;GO DO LABEL TYPE DEPENDENT STUFF
VEOV.1:	MOVEI	S1,LE.TRE		;GET CODE FOR TRAILER LABEL ERROR
	MOVEM	S1,G$TERM##		;SAVE IN TERMINATION WORD
	$RETF				;RETURN ERROR
EOFLBL:	BLPDSP
	EFL.AS
	EFL.AS
	EFL.IL
	EFL.IL
	.RETF	
	.RETF	
	.RETF	
	EFL.CA
	EFL.CS
	.RETF	

EOVLBL:	BLPDSP
	EVL.AS
	EVL.AS
	EVL.IL
	EVL.IL
	.RETF	
	.RETF	
	.RETF	
	EVL.CA
	EVL.CS
	.RETF	

EVL.CA:	SKIPA	T2,EV1PTR		 ;GET POINTER TO 'EOV1'
EFL.CA:	MOVE	T2,EF1PTR		 ;GET POINTER TO 'EOF1'
	MOVE	T1,[POINT 7,(BUF)]	 ;AND POINT INTO THE LABEL
	JRST	EFL.A1			;NOW LIKE ALL OTHER LABELS

EVL.CS:	SKIPA	T2,EV1PTR		 ;GET POINTER TO 'EOV1'
EFL.CS:	MOVE	T2,EF1PTR		 ;GET POINTER TO 'EOF1'
	MOVE	T1,[POINT 6,(BUF)]	 ;POINT AT THE LABEL
	JRST	EFL.A1			;NOW LIKE ALL OTHER TYPES

EVL.IL:					 ;DO IBM LIKE ANSI
EVL.AS:	SKIPA	T2,EV1PTR		 ;POINT AT 'EOV1'
EFL.IL:					 ;IBM IS LIKE ANSI
EFL.AS:	MOVE	T2,EF1PTR		 ;POINT AT 'EOF1'
	MOVE	T1,[CPTRI ^D1,0(BUF)]	 ;POINT AT WHAT WE READ (CP 1-4)
EFL.A1:	HRRZI	T3,4			;LENGTH TO COMPARE
	HRL	T3,CVTTAB(LT)		;GET ADDR OF CORRECT CONVERT
					; ROUTINE
	PUSHJ	P,STRCMP		;DO THE COMPARE
	JUMPF	EFL.0			;ERROR
	MOVX	S1,TS.OUT		;GET OUTPUT FLAG
	TDNE	S1,TCB.ST(B)		;DON'T COPY FILE NAME ON OUTPUT
	$RETT				;EXIT ON OUTPUT
	MOVE	T1,[CPTRI ^D5,0(BUF)]	;POINTER TO THE FILE NAME (CP 5-21)
	MOVE	T2,[POINT 7,TCB.FN(B)]	;WHERE TO STORE THE FILE NAME
	MOVEI	T3,^D17			;SEVENTEEN CHARACTERS
	HRL	T3,CVTTAB(LT)		;CONVERSION TYPE
	PUSHJ	P,STGSTR		;COPY THE STRING
	JUMPT	.RETT			;OK RETURN

EFL.0:	MOVEI	S1,[ITEXT (<Invalid EOF1 Record>)] ;ASSUME EOF1 LABEL
	HRRZ	T1,EF1PTR
	TLZ	T2,-1
	CAIE	T1,(T2)			;IS IT AN EOF1 LABEL?
	MOVEI	S1,[ITEXT (<Invalid EOV1 Record>)] ;NO, IT WAS EOV1
	PJRST	O$LERR##		;TELL OPR DRIVE AND ERROR
					;AND WAIT FOR HIS ANSWER
	SUBTTL	EOFSEQ/EOVSEQ - Verify file sequence number for trailers

EOFSEQ:	BLPDSP
	EFS.AS
	EFS.AS
	EFS.IL
	EFS.IL
	.RETF	
	.RETF	
	.RETF	
	EFS.CA
	EFS.CS
	.RETF	

EOVSEQ:	BLPDSP
	EVS.AS
	EVS.AS
	EVS.IL
	EVS.IL
	.RETF	
	.RETF	
	.RETF	
	EVS.CA
	EVS.CS
	.RETF	


EVS.CA:					;SAME AS EOF SEQ CHECK
EFS.CA:	MOVE	T1,[POINT 7,6(BUF),6]	;POINT AT SEQUENCE NUMBER IN BUFFER
	JRST	EFS.A1			;AND FINISH WITH COMMON CODE

EVS.CS:					;SAME AS EOF SEQ CHECK
EFS.CS:	MOVE	T1,[POINT 6,5(BUF),5]	;POINT AT SEQUENCE NUMBER IN LABEL
	JRST	EFS.A1			;AND FINISH WITH COMMON CODE

EVS.IL:					;IBM-EOV LIKE ANSI-EOF
EFS.IL:					;IBM IS LIKE ANSI
EVS.AS:					;EOV IS LIKE EOF
EFS.AS:	MOVE	T1,[CPTRI ^D32,0(BUF)]	;POINT AT SEQ NUM IN LABEL (CP 32-35)
EFS.A1:	HRRZI	T2,4			;FIELD IS 4 LONG
	HRL	T2,CVTTAB(LT)		;GET CONVERSION ROUTINE
	PUSHJ	P,STRNUM		;GET IT AS A NUMBER
	JUMPF	EFS.1		 	;IF NOT A NUMBER, GIVE ERROR
	LOAD	T2,TCB.PS(B),TP.POS	;GET THE SAVED POSITION
	CAME	T2,S2			;IS IT THE SAME?
	JRST	EFS.2			;NO, ERROR
	$RETT				;ALL'S WELL

EFS.1:	MOVEI	S1,[ITEXT (<Illegal File Sequence Number>)]
	PJRST	O$LERR##		;TELL THE OPR AND WAIT FOR HIS ANSWER

EFS.2:	SKIPE	G$SEQC##		;HAVE WE ASKED THE OPERATOR?
	$WTO	(<EOF file sequence warning>,<Label says ^D/S2/ when looking for ^D/T2/>,TCB.OB(B),$WTFLG(WT.SJI))
	$RETT				;RETURN AND IGNORE THE ERROR
	SUBTTL	EOFSEC/EOVSEC - Verify file section number for trailers

EOFSEC:	BLPDSP
	EFN.AS
	EFN.AS
	EFN.IL
	EFN.IL
	.RETF	
	.RETF	
	.RETF	
	.RETT				;COBOL labels don't have 'em
	.RETT				;COBOL labels don't have 'em
	.RETF	

EOVSEC:	BLPDSP
	EVN.AS
	EVN.AS
	EVN.IL
	EVN.IL
	.RETF	
	.RETF	
	.RETF	
	.RETT				;COBOL labels don't have 'em
	.RETT				;COBOL labels don't have 'em
	.RETF	

EVN.IL:					;IBM-EOV LIKE ANSI-EOF
EFN.IL:					;IBM IS LIKE ANSI
EVN.AS:					;EOV IS LIKE EOF
EFN.AS:	MOVE	T1,[CPTRI ^D28,0(BUF)]	;AIM AT FILE SECTION NUMBER (CP 28-31)
	HRRZI	T2,4			;FIELD IS 4 LONG
	HRL	T2,CVTTAB(LT)		;GET CONVERSION ROUTINE
	PUSHJ	P,STRNUM		;GET IT AS A NUMBER
	JUMPF	ENS.1		 	;IF NOT A NUMBER, GIVE ERROR
	LOAD	T2,TCB.SN(B)		;GET THE CURRENT SECTION NUMBER
	CAME	T2,S2			;IS IT THE SAME?
	JRST	ENS.2			;NO, ERROR
	$RETT				;ALL'S WELL


ENS.1:	MOVEI	S1,[ITEXT (<Illegal File Section Number>)]
	SKIPA
ENS.2:	MOVEI	S1,[ITEXT (<Incorrect File Section Number>)]
	PJRST	O$LERR##		;TELL THE OPR
					;WAIT FOR HIS ANSWER
EOFBLK:
EOVBLK:	BLPDSP
	.RETT
	.RETT
	.RETT
	.RETT
	.RETT
	.RETT
	.RETT
	.RETT
	.RETT
	.RETT
EOFEXP:	BLPDSP
	EFE.AS
	EFE.AS
	EFE.IL
	EFE.IL
	.RETF	
	.RETF	
	.RETF	
	.RETT
	.RETT
	.RETF	

EFE.IL:					;LIKE ANSI
EFE.AS:	MOVE	T1,[CPTRI ^D49,0(BUF)]	;POINT AT EXP DATE IN LABEL (CP 49-53)
	MOVEI	T2,5			;NUMBER OF CHARS TO GET
	HRL	T2,CVTTAB(LT)		;CONVERSION IF ANY
	PUSHJ	P,STRNUM		;GET IT AS A DECIMAL NUMBER
	JUMPF	EFE.1			;BAD NUMBER, COMPLAIN TO  OPR
	PUSH	P,S2			;SAVE DATE FROM LABEL
	PUSHJ	P,I$DATE##		;GET BP TO TODAY'S DATE
	MOVE	T1,S2			;COPY THE BYTE POINTER
	IBP	T1			;SKIP OVER THE LEADING BLANK
	MOVEI	T2,5			;NUMBER OF CHARACTERS TO CONVERT
	PUSHJ	P,STRNUM		;CONVERT TO BINARY (IN S2)
	JUMPF	EFE.1			;ILLEGAL SYSTEM ERROR
	POP	P,S1			;GET BACK DATE FROM LABEL
	MOVX	T1,TS.EXP		;BIT WHICH FLAGS UNEXPIRED FILE
	CAMGE	S2,S1			;IS FILE EXPIRED?
	IORM	T1,TCB.ST(B)		;YES, FLAG IT AS SO
	$RETT				;AND GIVE GOOD RETURN

EFE.1:	MOVEI	S1,[ITEXT (<Invalid Expiration Date Field>)]
	PJRST	O$LERR##		;TELL OPR
					;WAIT FOR HIS RESPONSE
EOFDEP:	BLPDSP
	EFD.AS
	EFD.AS
	EFD.IL
	EFD.IL
	.RETF	
	.RETF	
	.RETF	
	EXD.CB
	EXD.CB
	.RETF	

EOVDEP:	BLPDSP
	EVD.AS
	EVD.AS
	EVD.IL
	EVD.IL
	.RETT
	.RETF	
	.RETT
	EXD.CB
	EXD.CB
	.RETT

EXD.CB:	MOVEI	S1,'SFL'		;HAVE TO SKIP REST OF LABELS
	PJRST	T$POS##			;BUT NO SPECIAL PROCESSING

EVD.IL:
EVD.AS:	MOVE	T1,[CPTRI ^D61,0(BUF)]	;SYSTEM CODE IN LABEL (CP 61-73)
	MOVE	T2,S10PTR		;POINT AT SYSTEM CODE
	HRRZI	T3,^D13			;ITS LENGTH
	HRL	T3,CVTTAB(LT)		;CONVERSION ROUTINE
	PUSHJ	P,STRCMP		;SEE IF LOCAL LABELS
	JUMPF	EXD.A1			;NO, JUST SKIP REST
	PUSHJ	P,T$RDRC##		;GO READ NEXT RECORD
	JUMPF	.RETF			;COULDN'T, GIVE BAD RETURN
	LOAD	T1,TCB.IO(B)		;GET THE IO STATUS
	TXNE	T1,TI.EOF		;EOF?
	JRST	EXD.A2			;YES, EXPECTED EOV2 NOT FOUND
	MOVE	T2,EV2PTR		;GET POINTER TO 'EOV2'
	JRST	EXD.AS			;AND PROCEED AS IN EOF LABELS

EFD.IL:
EFD.AS:	MOVE	T1,[CPTRI ^D61,0(BUF)]	;SYSTEM CODE IN LABEL (CP 61-73)
	MOVE	T2,S10PTR		;POINT AT SYSTEM CODE
	HRRZI	T3,^D13			;ITS LENGTH
	HRL	T3,CVTTAB(LT)		;CONVERSION ROUTINE
	PUSHJ	P,STRCMP		;SEE IF LOCAL LABELS
	JUMPF	EXD.A1			;NO, JUST SKIP REST
	PUSHJ	P,T$RDRC##		;GO READ NEXT RECORD
	JUMPF	.RETF			;GIVE BAD RETURN IF ERROR
	LOAD	T1,TCB.IO(B)		;GET THE IO STATUS
	TXNE	T1,TI.EOF		;EOF?
	JRST	EXD.A2			;YES, EXPECTED EOF2 NOT FOUND
	MOVE	T2,EF2PTR		;GET POINTER TO 'EOF2'
EXD.AS:	MOVE	T1,[CPTRI ^D1,0(BUF)]	;POINT TO WHAT WE READ (CP 1-4)
	HRRZI	T3,4			;COMPARE 4 CHARS, NO CONVERSION
	HRL	T3,CVTTAB(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STRCMP		;DO COMPARE
	JUMPF	EXD.A2			;GIVE ERROR ON FAILING COMPARE
EXD.A1:	MOVEI	S1,'SFL'		;ELSE SET TO SKIP FILE
	PJRST	T$POS##			;DO IT AND RETURN

EXD.A2:	MOVEI	S1,[ITEXT (<Expected EOF2/EOV2 Label not Found>)]
	PJRST	O$LERR##		;TELL THE OPR
					;AND WAIT FOR RESPONSE
SUBTTL	Label Output - 'VOL1' and 'UVL1'

;This routine will write VOL1 and UVL1 labels on the tape at the current
;	 (assumedly rewound) position.  It is useful only during intialization,
;	to setup a new tape for some user.
;	As a historical note, it used to be called every time a user
;	wrote the first file on a tape.  This action had the side
;	effect of causing the last writer of the tape to be the owner.
;	Now, when writing the first file, all the volume labels are just
;	bypassed, and any owner or protection fields are left intact.

L$WVOL::
	$TRACE	(L$WVOL,3)
	PUSHJ	P,@WRTVL1(LT)		;WRITE THE 'VOL1' LABEL
	JUMPF	.RETF			;ERROR WRITING 'VOL1' LABEL
	PUSHJ	P,@WRTUV1(LT)		;WRITE THE 'UVL1' LABEL
	JUMPF	.RETF			;CAN'T
	MOVX	P2,TS.VLV!TS.IHL	;GET VOL LABELS VERIFIED + IN HEADER LABELS
	IORM	P2,TCB.ST(B)		;FLAG THAT IN TCB
	$RETT				;AND RETURN

WRTVL1:	BLPDSP
	WV1.AS
	WV1.AS
	WV1.IL
	WV1.IL
	WV1.LT
	.RETF	
	.RETT
	.RETF	
	.RETF	
	.RETT


WRTUV1:	BLPDSP
	WUV.AS
	WUV.AS
	WUV.IL
	WUV.IL
	.RETT
	.RETF	
	.RETT
	.RETF	
	.RETF	
	.RETT
SUBTTL	Label Output - ANSI 'VOL1' Subroutines

;	!-------------------------------------------------------!
;	!                     WRITE 'VOL1'                      !
;	!-------------------------------------------------------!
WV1.LT:	PJRST	T$WRTM##		;JUST WRITE A TAPE MARK
WV1.AS:	MOVE	T1,VL1PTR		;GET POINTER TO STRING TO STORE
	MOVE	T2,[CPTRI ^D1,0(BUF)]	;WHERE TO STORE IT (CP 1-4)
	MOVEI	T3,4			;COUNT
	HRL	T3,CVTTB1(LT)		;CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;STORE THE LABEL ID
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!                     SIXBIT VOLID                      !
;	!-------------------------------------------------------!
	MOVE	T1,[POINT 8,TCB.VL(B)]	;POINT AT CURRENT VOLID
	MOVEI	T3,6			;COUNT
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,STGSTR		;STORE THE VOLID
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!                  ACCESSIBILITY CODE                   !
;	!-------------------------------------------------------!
	MOVE	T1,BNKPTR		;POINT AT A BLANK
	LOAD	S1,TCB.PT(B),TP.PRT	;GET PROTECTION FIELD
	SKIPE	S1			;PROTECTION = 0?
	MOVE	T1,[POINT 7,[ASCII/1/]]	;NO, ACC CHAR = 1
	MOVEI	T3,1			;GET LENGTH
	HRL	T3,CVTTB1(LT)		;AND CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;STORE THE ACCESSIBILITY
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!                       RESERVED                        !
;	!-------------------------------------------------------!
	MOVEI	T3,^D26			;COUNT
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,BNKSTR		;STORE SOME BLANKS
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!                   OWNER IDENTIFIER                    !
;	!-------------------------------------------------------!
	MOVE	T1,D10PTR		;D%A FOR OWNER ID
	MOVEI	T3,3			;# CHARS
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,STGSTR		;STORE IN LABEL
	JUMPF	.RETF			;...
	MOVE	T1,[POINT 7,[ASCII/T10  /]] ;POINT AT OP SYS CODE
	MOVEI	T3,5			;# CHARS
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,STGSTR		;PUT IT IN LABEL
	JUMPF	.RETF			;....

;	!-------------------------------------------------------!
;	!                 SYSTEM SERIAL NUMBER                  !
;	!-------------------------------------------------------!
	PUSHJ	P,I$CPSN##		;GO GET SYSTEM SERIAL NUMBER
	MOVE	T1,S1			;COPY IT TO T1
	MOVEI	T3,5			;5 CHARS
	HRL	T3,CVTTB1(LT)		;WITH~ CONVERSION
	PUSHJ	P,DECSTR		;AS A DECIMAL NUMBER
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!               DEC STANDARD VERSION '1'                !
;	!-------------------------------------------------------!
	MOVEI	T1,1			;DEC STD VERSION
	MOVEI	T3,1			;ONE CHAR
	HRL	T3,CVTTB1(LT)		;CONVERT IT
	PUSHJ	P,OCTSTR		;STORE IT AS A NUMBER
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!                       RESERVED                        !
;	!-------------------------------------------------------!
	MOVEI	T3,^D28			;MORE SPACES
	HRL	T3,CVTTB1(LT)		;CONVERT THEM ALSO
	PUSHJ	P,BNKSTR		;INTO LABEL
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!              LABEL STANDARD VERSION '3'               !
;	!-------------------------------------------------------!
	MOVEI	T1,3			;ANSI STD VERSION
	MOVEI	T3,1			;# CHARS
	HRL	T3,CVTTB1(LT)		;CONVERT IT
	PUSHJ	P,OCTSTR		;STORE INTO LABEL
	JUMPF	.RETF			;...
	PJRST	T$WRRC##		;WRITE OUT THIS LABEL
SUBTTL	Label Output - IBM 'VOL1' Subroutines

;	!-------------------------------------------------------!
;	!                     WRITE 'VOL1'                      !
;	!-------------------------------------------------------!
WV1.IL:	MOVE	T1,VL1PTR		;GET POINTER TO STRING TO STORE
	MOVE	T2,[CPTRI ^D1,0(BUF)]	;WHERE TO STORE IT (CP 1-4)
	MOVEI	T3,4			;COUNT
	HRL	T3,CVTTB1(LT)		;CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;STORE THE LABEL ID
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!                     SIXBIT VOLID                      !
;	!-------------------------------------------------------!
	MOVE	T1,[POINT 8,TCB.VL(B)]	;POINT AT CURRENT VOLID
	MOVEI	T3,6			;COUNT
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,STGSTR		;STORE THE VOLID
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!                  	RESERVED			!
;	!-------------------------------------------------------!
	MOVE	T1,[POINT 7,[ASCIZ /0/]];MUST BE A ZERO
	MOVEI	T3,1			;GET LENGTH
	HRL	T3,CVTTB1(LT)		;AND CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;STORE A ZERO
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!                       VTOC POINTER                    !
;	!-------------------------------------------------------!
	MOVEI	T3,^D10			;GET LENGTH
	HRL	T3,CVTTB1(LT)		;AND CONVERSION ROUTINE
	PUSHJ	P,BNKSTR		;STORE BLANKS
	JUMPF	.RETF			;CHECK FAILURE

;	!-------------------------------------------------------!
;	!			RESERVED		 	!
;	!-------------------------------------------------------!
	MOVEI	T3,^D10			;COUNT
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,BNKSTR		;STORE SOME BLANKS
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!			RESERVED		 	!
;	!-------------------------------------------------------!
	MOVEI	T3,^D10			;COUNT
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,BNKSTR		;STORE SOME BLANKS
	JUMPF	.RETF			;...

;	!-------------------------------------------------------!
;	!                   OWNER IDENTIFIER                    !
;	!-------------------------------------------------------!
	MOVE	T1,D10PTR		;D%A FOR OWNER ID
	MOVEI	T3,3			;# CHARS
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,STGSTR		;STORE IN LABEL
	JUMPF	.RETF			;...
	MOVE	T1,[POINT 7,[ASCII/T10    /]] ;POINT AT OP SYS CODE
	MOVEI	T3,7			;# CHARS
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,STGSTR		;PUT IT IN LABEL
	JUMPF	.RETF			;....

;	!-------------------------------------------------------!
;	!                       RESERVED                        !
;	!-------------------------------------------------------!
	MOVEI	T3,^D29			;MORE SPACES
	HRL	T3,CVTTB1(LT)		;CONVERT THEM ALSO
	PUSHJ	P,BNKSTR		;INTO LABEL
	JUMPF	.RETF			;...
	PJRST	T$WRRC##		;WRITE OUT THIS LABEL
SUBTTL	Label Output - 'UVL1' Subroutines

WUV.IL:	$RETT				;IBM DOESN'T HAVE UVL/VOL2

WUV.AS:
IFN FTVPRO,<				;If we do any protection at all...
IFN FTUPRO,<				;If we do it via UVL1 label
	MOVE	T1,UVLPTR		;POINT AT 'UVL1'
>;End IFN FTUPRO
IFE FTUPRO,<				;If we do it via VOL2 label
	MOVE	T1,VL2PTR		;POINT AT 'VOL2'
>;End IFE FTUPRO
	MOVE	T2,[CPTRI ^D1,0(BUF)]	;WHERE TO SAVE CHARACTERS (CP 1-4)
	MOVEI	T3,4			;LENGTH
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,STGSTR		;PUT CHARS IN LABEL
	JUMPF	.RETF			;...
	LOAD	T1,TCB.PT(B),TP.PRT	;GET PROTECTION
	MOVEI	T3,6			;NUMBER OF CHARACTERS TO STORE
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,OCTSTR		;STORE IN LABEL
	JUMPF	.RETF			;...
	MOVE	T1,TCB.OW(B)		;GET PPN
	CAMN	T1,G$FFAP##		;[OPR] PPN ?
	MOVE	T1,TCB.VO(B)		;YES - USE VOLUME OWNER PPN INSTEAD
	HLRZS	T1			;GET PROJECT NUMBER
	MOVEI	T3,6			;NUMBER OF CHARACTERS TO STORE
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,OCTSTR		;STORE IN LABEL
	JUMPF	.RETF			;...
	MOVE	T1,TCB.OW(B)		;GET PPN
	CAMN	T1,G$FFAP##		;[OPR] PPN ?
	MOVE	T1,TCB.VO(B)		;YES - USE VOLUME OWNER PPN INSTEAD
	HRRZS	T1			;GET PROGRAMMER NUMBER
	MOVEI	T3,6			;NUMBER OF CHARACTERS TO STORE
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,OCTSTR		;STORE IN LABEL
	JUMPF	.RETF			;...
	HRRI	T1,TCB.UN(B)		;Aim at user name
	HRLI	T1,(POINT 7,)		;With a 7-bit pointer
	MOVEI	T3,14			;LENGTH TO STORE
	HRL	T3,CVTTB1(LT)		;CONVERSION
	PUSHJ	P,STGSTR		;STORE NAME IN LABEL
	JUMPF	.RETF			;...
	MOVEI	T3,56			;REST OF LABELS GETS 
	HRL	T3,CVTTB1(LT)		; FILLED WITH BLANKS
	PUSHJ	P,BNKSTR		;...
	JUMPF	.RETF			;...
	PUSHJ	P,T$WRRC##		;WRITE OUT THIS LABEL
	JUMPF	.POPJ			;ANOTHER BAD DAY!
>;End IFN FTVPRO
	$RETT
SUBTTL	Label Output - 'EOF1'

L$WEOF::
WRTEOF:	$TRACE	(WRTEOF,3)
	MOVE	T1,EF1PTR		;POINT AT 'EOF1'
	PUSHJ	P,@WHDR1(LT)		;MAKE AN EOF1 LABEL AND WRITE IT
	JUMPF	.RETF		 	;OOPS, COULDN'T
	MOVE	T1,EF2PTR		;POINT AT 'EOF2'
	PUSHJ	P,@WHDR2(LT)		;MAKE THAT AND WRITE IT
	JUMPF	.RETF		 	;COULDN'T DO IT
	MOVX	S1,TS.POS		;GET STATUS FOR POSITION
	ANDCAM	S1,TCB.ST(B)		;CLEAR IT
	MOVX	S1,TS.ATM		;AND FLAG AFTER TAPE MARK
	IORM	S1,TCB.ST(B)		;IN THE TCB
	PJRST	T$CLOS##		;DO AN OUTPUT CLOSE

SUBTTL	Label Output - 'EOV1'

L$WEOV::
WRTEOV:	$TRACE	(WRTEOV,3)
	MOVE	T1,EV1PTR		;AND A POINTER TO 'EOV1'
	PUSHJ	P,@WHDR1(LT)		;WRITE THE EOV1 LABEL
	JUMPF	.RETF		 	;CAN'T
	MOVE	T1,EV2PTR		;POINT AT EOV2
	PUSHJ	P,@WHDR2(LT)		;AND WRITE IT
	JUMPF	.RETF		 	;WHAT?
	MOVX	S1,TS.POS		;GET POSITION BITS
	ANDCAM	S1,TCB.ST(B)		;CLEAR THEM
	MOVX	S1,TS.ATM		;GET AFTER TAPE MARK BIT
	IORM	S1,TCB.ST(B)		;LIGHT IT IN TCB
	PJRST	T$CLOS##		;CLOSE OUTPUT AND RETURN

SUBTTL	Label Output - 'HDR1' and 'HDR2'

L$WHDR::
WRTHDR:	$TRACE	(WRTHDR,3)
	MOVE	T1,HD1PTR		;POINT AT 'HDR1'
	PUSHJ	P,@WHDR1(LT)		;WRITE IT OUT
	JUMPF	.RETF		 	;ERROR
	MOVE	T1,HD2PTR		;POINT AT 'HDR2'
	PUSHJ	P,@WHDR2(LT)		;WRITE THAT OUT
	JUMPF	.RETF		 	;ERROR
	MOVX	S1,TS.POS		;GET POSITION BITS
	ANDCAM	S1,TCB.ST(B)		;CLEAR THEM
	MOVX	S1,TS.IUD		;GET IN USER DATA BIT
	IORM	S1,TCB.ST(B)		;LIGHT IT IN TCB
	PJRST	T$CLOS##		;CLOSE OUTPUT AND RETURN

WHDR1:	BLPDSP
	WH1.AS
	WH1.AS
	WH1.IL
	WH1.IL
	.RETT
	.RETF	
	.RETT
	.RETF	
	.RETF	
	.RETT

WHDR2:	BLPDSP
	WH2.AS
	WH2.AS
	WH2.IL
	WH2.IL
	.RETT
	.RETF	
	.RETT
	.RETT
	.RETT
	.RETT
SUBTTL	Label Output - ANSI and IBM HDR1 Subroutines

;	!-------------------------------------------------------!
;	!                     WRITE 'HDR1'                      !
;	!-------------------------------------------------------!
WH1.IL:					;LIKE ANSI, BUT DIFF CONVERSION
WH1.AS:	MOVE	T2,[CPTRI ^D1,0(BUF)]	;POINT AT WHERE TO START STORING (CP 1-4)
	HRRZI	T3,4			;HOW MUCH TO STORE
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;SAVE AS STRING
	JUMPF	.RETF			;BAD CHARS?

;	!-------------------------------------------------------!
;	!             17-CHARACTER FILE IDENTIFIER              !
;	!		(From TCB) or -				!
;	!                  'FILE.nnnBBBBBBBBB'                  !
;	!		(where nnn is the file position)	!
;	!-------------------------------------------------------!
	MOVE	S1,[ASCII /     /]	;GET FIVE BLANKS
	CAMN	S1,TCB.FN(B)		;WAS A FILE NAME SPECIFIED
	JRST	WH1.A0			;NO, USE THE DEFAULT
	MOVE	T1,[POINT 7,TCB.FN(B)]	;POINTER TO THE FILE NAME
	HRRZI	T3,^D17			;SEVENTEEN CHARACTER MAX
	HRL	T3,CVTTB1(LT)		;CONVERSION TYPE
	PUSHJ	P,STGSTR		;COPY THE FILE NAME
	JUMPF	.RETF			;BAD FILE NAME
	JRST	WH1.B			;CONTINUE
WH1.A0:
	MOVE	T1,FILPTR		;POINT AT 'FILE'
	HRRZI	T3,5			;SAVE 5 CHARS
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;AS CHARACTERS
	JUMPF	.RETF			;BAD CHARACTER?????
	LOAD	T1,TCB.PS(B),TP.POS	;GET CURRENT POSITION
	JUMPN	T1,WH1.A1		;PROCEED IF NON ZERO
	MOVEI	T1,1			;ELSE MAKE IT 1
	STORE	T1,TCB.PS(B),TP.POS	;AND SAVE IT IN THE TCB
	CAILE	T1,^D999		;MAX EXTENSION
	MOVEI	T1,^D999		;SET TO MAX
WH1.A1:	HRRZI	T3,3			;3 CHARACTERS LONG
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,DECSTR		;AS A DECIMAL NUMBER
	JUMPF	.RETF			;BAD NUMBER
	HRRZI	T3,11			;ELEVEN MORE BLANKS
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,BNKSTR		;ALL BLANKS
	JUMPF	.RETF			;THATS AWFULLY STRANGE

;	!-------------------------------------------------------!
;	!        VOLUME ID OF FIRST VOLUME IN VOLUME SET        !
;	!-------------------------------------------------------!
WH1.B:	MOVE	T1,[POINT 8,TCB.FV(B)] ;POINT AT THE VOLID
	HRRZI	T3,6			;IT'S SIX CHARS LONG
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;SAVE IT AS A STRING
	JUMPF	.RETF			;OOPS

;	!-------------------------------------------------------!
;	!                  FILE SECTION NUMBER                  !
;	!-------------------------------------------------------!
	LOAD	T1,TCB.SN(B)		;GET FILE SECTION NUMBER
	HRRZI	T3,4			;4 WIDE FILED
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,DECSTR		;SAVE AS DECIMAL NUMBER
	JUMPF	.RETF			;COULDN'T???

;	!-------------------------------------------------------!
;	!                 FILE SEQUENCE NUMBER                  !
;	!-------------------------------------------------------!
	LOAD	T1,TCB.PS(B),TP.POS	;GET CURRENT POSITION
	HRRZI	T3,4			;4 WIDE FIELD
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,DECSTR		;AS DECIMAL NUMBER
	JUMPF	.RETF			;WHAT??

;	!-------------------------------------------------------!
;	!             	GENERATION NUMBER 			!
;	!-------------------------------------------------------!
	LOAD	T1,TCB.GV(B),TG.GEN	;GET THE GENERATION NUMBER
	SKIPE	T1			;WAS ANYTHING SPECIFIED
	CAILE	T1,^D9999		;OR TOO BIG?
	MOVEI	T1,1			;OUT OF RANGE, SAY 1
	HRRZI	T3,4			;4 WIDE
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,DECSTR		;USE DECIMAL CONVERISON
	JUMPF	.RETF			;SOMETIMES NOTHING WINS!!!

;	!-------------------------------------------------------!
;	!             	VERSION NUMBER 				!
;	!-------------------------------------------------------!
	LOAD	T1,TCB.GV(B),TG.VER	;GET THE VERSION NUMBER
	CAILE	T1,^D99			;OR TOO BIG?
	SETZ	T1,			;OUT OF RANGE, SAY 0
	HRRZI	T3,2			;2 CHARS WIDE
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,DECSTR		;USE DECIMAL CONVERSION
	JUMPF	.RETF			;SOMETIMES NOTHING WINS!!!

;	!-------------------------------------------------------!
;	!      CREATION DATE (JULIAN) ' YYDDD' OR ' 00000'      !
;	!-------------------------------------------------------!
	PUSHJ	P,I$DATE##		;GET THE DATE
	MOVE	T1,S2			;INTO T1
	HRRZI	T3,6			;ITS SIX CHARACTERS LONG
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;AND AN  STRING
	JUMPF	.RETF			;OOPS

;	!-------------------------------------------------------!
;	!           EXPIRATION DATE (JULIAN) ' YYDDD'           !
;	!-------------------------------------------------------!
	MOVEI	T3,1			;NOW 1 BLANK
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,BNKSTR		;...
	JUMPF	.RETF			;WE ALL HAVE OUR BAD DAYS
	LOAD	S1,TCB.EX(B),TE.EXP	;GET EXPIRATION DATE FROM TAPOP.
	JUMPE	S1,WH1.A2		;NONE SET
	PUSHJ	P,I$DATI##		;MAKE 15 BIT DATE INTO ASCII
	JRST	WH1.A3			;AND PROCEED
WH1.A2:	LOAD	T1,TCB.DT(B)		;GET THE DEFAULT EXPIRATION DATE
	HRRZI	T3,5			;ITS 5 WIDE
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,DECSTR		;AND IN DECIMAL
	LOAD	T1,TCB.DT(B)		;GET THE EXPIRATION DATE AGAIN
	JUMPN	T1,WH1.A4		;IF NON-ZERO, WE'RE OK
	PUSHJ	P,I$DATE##		;ELSE GET TODAY AGAIN
WH1.A3:	MOVE	T1,S2			;MOVE PTR TO T1
	MOVE	T2,[CPTRI ^D48,0(BUF)]	;POINT AT FIELD IN LABEL AGAIN (CP 48-53)
	HRRZI	T3,6			;6 WIDE
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;AS A STRING
	JUMPF	.RETF			;OH WELL

;	!-------------------------------------------------------!
;	!                ACCESSIBILITY CHARACTER                !
;	!-------------------------------------------------------!
WH1.A4:	MOVE	T1,BNKPTR		;POINT TO A BLANK
	SKIPN	S1,TCB.PR(B)		;GET PROT FROM TAPOP IF SET
	LOAD	S1,TCB.PT(B),TP.PRT	;GET PROTECTION FIELD
	SKIPE	S1			;PROTECTION = 0?
	MOVE	T1,[POINT 7,[ASCIZ/1/]]	;POINT AT '1'
	CAIE	LT,LT.IL		;ARE LABELS IBM?
	CAIN	LT,LT.IUL		;OR IBM WITH USER?
	MOVE	T1,[POINT 7,[ASCIZ/0/]]	;YES, FREE ACCESS CHAR IS 0
	HRRZI	T3,1			;1 BLANK
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;...
	JUMPF	.RETF			;BAD DAY

;	!-------------------------------------------------------!
;	!                 BLOCK COUNT '000000'                  !
;	!-------------------------------------------------------!
	MOVE	T1,TCB.BC(B)		;GET BLOCK COUNT FROM TCB
	HRRZI	T3,6			;TO FILL A SIX WIDE FIELD
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,DECSTR		;...
	JUMPF	.RETF			;SIGH

;	!-------------------------------------------------------!
;	!               SYSTEM CODE 'DECSYSTEM10'               !
;	!-------------------------------------------------------!
	MOVE	T1,S10PTR		;POINT AT 'DECSYSTEM10'
	MOVEI	T3,^D13+^D7		;CODE FIELD OF 13 PLUS 7 BLANKS
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;WITH THAT STRING
	JUMPF	.RETF			;AFTER ALL THAT LUCK
	PJRST	T$WRRC##		;AND WRITE THE RECORD


SUBTTL	Label Output - ANSI HDR2 Subroutines

;	!-------------------------------------------------------!
;	!                     WRITE 'HDR2'                      !
;	!-------------------------------------------------------!
WH2.AS:	$CALL	.SAVE1			;SAVE A SCRATCH REGISTER
	MOVE	T2,[CPTRI ^D1,0(BUF)]	; (CP 1-4)
	HRRZI	T3,4
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STGSTR
	JUMPF	.RETF

;	!-------------------------------------------------------!
;	!                     RECORD FORMAT                     !
;	!-------------------------------------------------------!
	LOAD	P1,TCB.RF(B),TF.RFM	;PICK UP RECORD FORMAT
	MOVE	T1,[POINT 7,RECFMT(P1),35-7] ;POINT AT LIST OF CHARACTERS
	MOVEI	T3,1
	HRL	T3,CVTTB1(LT)
	PUSHJ	P,STGSTR		;STORE REC FMT IN LABEL
	JUMPF	.RETF			;OOPS

;	!-------------------------------------------------------!
;	!                     BLOCK LENGTH                      !
;	!-------------------------------------------------------!
	LOAD	T1,TCB.LN(B),TL.BLK	;GET BLOCK LENGTH
	MOVEI	T3,5
	HRL	T3,CVTTB1(LT)
	PUSHJ	P,DECSTR		;SAVE BLOCK LEN IN LABEL
	JUMPF	.RETF

;	!-------------------------------------------------------!
;	!                     RECORD LENGTH                     !
;	!-------------------------------------------------------!
	LOAD	T1,TCB.LN(B),TL.REC	;GET RECORD LENGTH
	MOVEI	T3,5
	HRL	T3,CVTTB1(LT)
	PUSHJ	P,DECSTR		;SAVE REC LEN IN LABEL
	JUMPF	.RETF

;	!-------------------------------------------------------!
;	!                   FILE ACCESS CODE                    !
;	!-------------------------------------------------------!
	SKIPN	T1,TCB.PR(B)		;GET USER-SET PROTECTION
	LOAD	T1,TCB.PT(B),TP.PRT	;OR MOUNTED ONE IF NONE SET
	HRRZI	T3,6			;SIX CHARACTERS
	HRL	T3,CVTTB1(LT)		;CONVERT IF NEEDED
	PUSHJ	P,OCTSTR		;ITS AN OCTAL NUMBER
	JUMPF	.RETF			;OOOPS

;	!-------------------------------------------------------!
;	!                   OWNER'S DIRECTORY                   !
;	!-------------------------------------------------------!
	HLRZ	T1,TCB.OW(B)
	HRRZI	T3,6
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,OCTSTR
	JUMPF	.RETF
	HRRZ	T1,TCB.OW(B)
	HRRZI	T3,6
	HRL	T3,CVTTB1(LT)			;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,OCTSTR
	JUMPF	.RETF

;	!-------------------------------------------------------!
;	!                   SYSTEM DEPENDENT                    !
;	!-------------------------------------------------------!
	MOVEI	T3,^D3
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,BNKSTR
	JUMPF	.RETF

;	!-------------------------------------------------------!
;	!                FORM CONTROL CHARACTER                 !
;	!-------------------------------------------------------!
	LOAD	P1,TCB.RF(B),TF.FCT	;Get form control index
	MOVE	T1,[POINT 7,RECFRM(P1),35-7] ;Aim at appropriate character
	MOVEI	T3,1			;ONE BYTE
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STGSTR
	JUMPF	.RETF

;	!-------------------------------------------------------!
;	!                       RESERVED                        !
;	!-------------------------------------------------------!
	MOVEI	T3,^D43
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,BNKSTR
	JUMPF	.RETF
	PJRST	T$WRRC##
SUBTTL	Label Output - IBM HDR2 Subroutines

;	!-------------------------------------------------------!
;	!                     WRITE 'HDR2'                      !
;	!-------------------------------------------------------!
WH2.IL:	$CALL	.SAVE1			;SAVE A SCRATCH REGISTER
	MOVE	T2,[CPTRI ^D1,0(BUF)]	; (CP 1-4)
	HRRZI	T3,4
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STGSTR
	JUMPF	.RETF

;	!-------------------------------------------------------!
;	!                     RECORD FORMAT                     !
;	!-------------------------------------------------------!
	LOAD	P1,TCB.RF(B),TF.RFM	;PICK UP RECORD FORMAT
	MOVE	T1,[POINT 7,RECFMT(P1),35-7] ;POINT AT LIST OF CHARACTERS
	MOVEI	T3,1
	HRL	T3,CVTTB1(LT)
	PUSHJ	P,STGSTR		;STORE REC FMT IN LABEL
	JUMPF	.RETF			;OOPS

;	!-------------------------------------------------------!
;	!                     BLOCK LENGTH                      !
;	!-------------------------------------------------------!
	LOAD	T1,TCB.LN(B),TL.BLK	;GET BLOCK LENGTH
	CAILE	T1,^D32760		;CAN'T BE GREATER THAN THIS
	MOVEI	T1,^D32760		;ADJUST TO CONFROM TO IBM SPEC
	MOVEI	T3,5
	HRL	T3,CVTTB1(LT)
	PUSHJ	P,DECSTR		;SAVE BLOCK LEN IN LABEL
	JUMPF	.RETF

;	!-------------------------------------------------------!
;	!                     RECORD LENGTH                     !
;	!-------------------------------------------------------!
	LOAD	T1,TCB.LN(B),TL.REC	;GET RECORD LENGTH
	MOVEI	T3,5
	HRL	T3,CVTTB1(LT)
	PUSHJ	P,DECSTR		;SAVE REC LEN IN LABEL
	JUMPF	.RETF

;	!-------------------------------------------------------!
;	!			TAPE DENSITY			!
;	!-------------------------------------------------------!
	PUSH	P,T2			;SAVE FROM DESTRUCTION
	PUSHJ	P,I$GDEN##		;MAKE SURE WE HAVE THE DENSITY
	POP	P,T2			;RESTORE BYTE POINTER TO LABEL BUFFER
	LOAD	T1,TCB.PS(B),TP.DEN	;GET KNOWN DENSITY
	SUBI	T1,1			;ADJUST TO MATCH IBM CODES
	MOVEI	T3,1			;1 CHARACTER
	HRL	T3,CVTTB1(LT)		;GET CONVERSION ROUTINE
	PUSHJ	P,OCTSTR		;WRITE OUT THE DENSITY CODE
	JUMPF	.RETF			;CHECK FOR ERRORS

;	!-------------------------------------------------------!
;	!		DATA SET POSITION			!
;	!-------------------------------------------------------!
	PUSH	P,T2			;SAVE FROM DESTRUCTION
	MOVE	T1,[POINT 8,TCB.FV(B)]	;POINT TO THE FIRST REELID
	MOVE	T2,[POINT 8,TCB.VL(B)]	;POINT TO THE CURRENT REELID
	MOVEI	T4,6			;6 CHARACTERS
	HRL	T3,CVTTAB(LT)		;CONVERSION ROUTINE
	PUSHJ	P,STRCMP		;COMPARE
	POP	P,T2			;RESTORE BYTE POINTER TO BUFFER
	MOVE	T1,[POINT 7,[ASCIZ /0/]];ASSUME FIRST REEL IN VOLUME SET
	SKIPT				;IS IT?
	MOVE	T1,[POINT 7,[ASCIZ /1/]];NO--A CONTINUATION REEL
	MOVEI	T3,1			;1 CHARACTER
	HRL	T3,CVTTB1(LT)		;CONVERSION ROUTINE
	PUSHJ	P,STGSTR		;WRITE DIGIT OUT
	JUMPF	.RETF			;CHECK FOR ERRORS

;	!-------------------------------------------------------!
;	!		JOB/JOB STEP IDENTIFICATION		!
;	!-------------------------------------------------------!
	MOVEI	T3,^D17			;17 CHARACTERS
	HRL	T3,CVTTB1(LT)		;CONVERSION ROUTINE
	PUSHJ	P,BNKSTR		;WRITE BLANKS
	JUMPF	.RETF			;CHECK FOR ERRORS

;	!-------------------------------------------------------!
;	!		TAPE RECORDING TECHNIQUE		!
;	!-------------------------------------------------------!
	MOVEI	T3,2			;2 CHARACTERS
	HRL	T3,CVTTB1(LT)		;CONVERSION ROUTINE
	PUSHJ	P,BNKSTR		;WRITE BLANKS
	JUMPF	.RETF			;CHECK FOR ERRORS

;	!-------------------------------------------------------!
;	!                CONTROL CHARACTERS	                !
;	!-------------------------------------------------------!
	LOAD	P1,TCB.RF(B),TF.FCT	;GET FORM CONTROL INDEX
	MOVE	T1,[POINT 7,RECFRM(P1),35-7] ;AIM AT APPROPRIATE CHARACTER
	MOVEI	T3,1			;ONE BYTE
	HRL	T3,CVTTB1(LT)		;GET ADDR OF CONVERSION ROUTINE
	PUSHJ	P,STGSTR
	JUMPF	.RETF

;	!-------------------------------------------------------!
;	!			RESERVED			!
;	!-------------------------------------------------------!
	MOVEI	T3,1			;LENGTH
	HRL	T3,CVTTB1(LT)		;CONVERSION ROUTINE
	PUSHJ	P,BNKSTR		;WRITE BLANKS
	JUMPF	.RETF			;CHECK FOR ERRORS

;	!-------------------------------------------------------!
;	!		   BLOCK ATTRIBUTE			!
;	!-------------------------------------------------------!
	MOVEI	T3,1			;LENGTH
	HRL	T3,CVTTB1(LT)		;CONVERSION ROUTINE
	PUSHJ	P,BNKSTR		;WRITE A BLANK
	JUMPF	.RETF			;CHECK FOR ERRORS

;	!-------------------------------------------------------!
;	!			RESERVED			!
;	!-------------------------------------------------------!
	MOVEI	T3,^D41			;LENGTH
	HRL	T3,CVTTB1(LT)		;CONVERSION ROUTINE
	PUSHJ	P,BNKSTR		;WRITE BLANKS
	JUMPF	.RETF			;CHECK FOR ERRORS
	PJRST	T$WRRC##		;WRITE RECORD AND RETURN
SUBTTL	Routines to Return File Sequence Number


GETFSN:	BLPDSP			;ERROR IF HERE ON BLP
	GTF.AS			;ANSI LABELS
	GTF.AS			;...
	GTF.IL			;IBM LABELS
	GTF.IL			;IBM LABELS
	GTF.LT			;LEADING TAPE MARK
	GTF.NS			;NON STANDARD
	GTF.NL			;NO LABELS
	GTF.NL			;COBOL ASCII
	GTF.NL			;COBOL SIXBIT
	GTF.NL			;NO LABELS

GTF.NL:
GTF.LT:
GTF.NS:	HALT	.

GTF.IL:
GTF.AS:	MOVE	T1,[CPTRI ^D28,0(BUF)]	;POINT AT FILE SECTION NUMBER (CP 28-31)
GTF.1:	HRRZI	T2,4			;LENGTH OF 4
	HRL	T2,CVTTAB(LT)		;GET CONVERSION ROUTINE
	PJRST	STRNUM			;MAKE IT A NUMBER

GTF.CA:	SKIPA	T1,[POINT 7,5(BUF),13]	;POINT AT FSN
GTF.CS:	MOVE	T1,[POINT 6,4(BUF),17]	;POINT AT FSN
	$RETT
SUBTTL	Routine to Determine if This is an EOF1 Label

CHKEV1:	SKIPA	T2,EV1PTR		;POINT TO 'EOV1'
CHKEF1:	MOVE	T2,EF1PTR		;GET POINTER TO CANONICAL 'EOF1'
	MOVE	T1,CHKE.A(LT)		;GET BYTE POINTER TO LABEL ID FIELD
	MOVEI	T3,4			;COUNT
	HRL	T3,CVTTAB(LT)		;CONVERSION
	PJRST	STRCMP			;DO THE COMPARE

CHKE.A:	Z				;NO PTR FOR BLP
	CPTRI	^D1,0(BUF)		;FOR SL
	CPTRI	^D1,0(BUF)		;AND SUL
	CPTRI	^D1,0(BUF)		;FOR IL
	CPTRI	^D1,0(BUF)		;AND IUL
	Z				;FOR LTM
	Z				;FOR NS
	Z				;FOR NL
	Z				;FOR COBOL ASCII
	Z				;FOR COBOL SIXBIT
	Z				;FOR NL
SUBTTL	Routine to Do Input Checking

;THIS ROUTINE CHECKS IF AN INPUT TYPE OPERATION IS LEGAL TO
;THIS TAPE. AN INPUT TYPE OPERATION IS ANY OPERATION EXCEPT
;REWIND, OUTPUT, CLOSE OUTPUT, OR FEOV.

INPCHK:	MOVX	S1,TS.OUT		;GET ONLY OUPUT LEGAL BIT
	TDNN	S1,TCB.ST(B)		;IS IT SET?
	$RETT				;NO, ALL IS WELL
PS.IOP:	MOVX	S1,LE.IOP		;GET ERROR CODE
	MOVEM	S1,G$TERM##		;STORE IT FOR RETURN
	$RETF



SUBTTL	SETIUD - Routine to set TS.IUD in TCB status word

SETIUD:	MOVE	S1,TCB.ST(B)		;GET STATUS WORD
	TXO	S1,TS.IUD		;SET IN USER DATA
	TXZ	S1,TS.ATM		;CLEAR AFTER TAPE MARK
	MOVEM	S1,TCB.ST(B)		;UPDATE
	$RETT				;RETURN
SUBTTL	Routine to Find HDR1 Label

;THIS ROUTINE FINDS THE HDR1 LABEL IN THE PRECEDING BEGINNING OF FILE
;OR BEGINNING OF VOLUME LABEL GROUP. IT MUST BE CALLED WITH THE TAPE
;POSITIONED IN USER DATA.

FNDHD1:	$TRACE	(FNDHD1,3)
	MOVEI	S1,'BFL'		;SET TO BACKSPACE TO LABEL GROUP
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;CAN'T?
	MOVEI	S1,'BFL'		;NOW BACK OVER LABELS
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;THIS SHOULDN'T HAPPEN
FNDH.1:	LOAD	S1,TCB.IO(B)		;GET IO STATUS
	TXNN	S1,TI.EOF		;LAST OP HIT EOF?
	JRST	FNDH.2			;NO, MUST BE AT START OF VOLUME
	MOVEI	S1,'SFL'		;SKIP BACK TO START OF HDR LABELS
	PUSHJ	P,T$POS##		;GO
	JUMPF	.RETF			;BUT WE JUST WENT THE OTHER WAY
FNDH.2:	PUSHJ	P,T$RDRC##		;READ NEXT RECORD
	JUMPF	.RETF			;ERROR READING RECORD
	MOVX	S1,TI.EOF		;CHECK FOR EOF
	TDNE	S1,TCB.IO(B)		;IN TCB
	$RETF				;NO HDR1?????
	MOVE	T1,CHKE.A(LT)		;GET BYTE POINTER TO LABEL
	MOVE	T2,HD1PTR		;AND TO 'HDR1'
	MOVEI	T3,4			;HOW MANY CHARS TO COMPARE
	HRL	T3,CVTTAB(LT)		;WHAT CONVERSION TO USE
	PUSHJ	P,STRCMP		;COMPARE
	JUMPF	FNDH.2			;NOPE, TRY NEXT RECORD
	MOVX	S1,TS.IUD		;GET IN USER DATA
	ANDCAM	S1,TCB.ST(B)		;CLEAR IT
	MOVX	S1,TS.IHL		;GET IN HEADER LABELS
	IORM	S1,TCB.ST(B)		;SET IT
	$RETT				;RETURN TRUE
SUBTTL	Utility Routines -- Volume protection check


; This routine is called whenever a volume protection error occurs.
; The first time, the operator will be asked to abort or proceed
; with the operation. The operator's response will be memorized
; in the TCB so succeding errors can be handled without operator
; intervention.

VPCCHK:	LOAD	S1,TCB.S2(B),TS.VPC	;GET VOLUME PROTECTION CHECK STATUS
	JRST	@.+1(S1)		;DISPATCH
	EXP	VPCCH0			;ASK
	EXP	VPCCH1			;ABORT
	EXP	VPCCH2			;PROCEED
VPCCH0:	MOVEI	S1,[ITEXT (<Volume protection failure>)]
	PUSHJ	P,O$LERR##		;TELL OPR OF PROTECTION FAILURE
	JUMPT	VPCCH2			;RESPONSE AS PROCEED
VPCCH1:	MOVEI	S1,.TSABO		;GET ABORT CODE
	STORE	S1,TCB.S2(B),TS.VPC	;STORE
	MOVEI	S1,LE.VPF		;VOLUME PROTECTION FAILURE
	MOVEM	S1,G$TERM##		;SET TERMINATION CODE
	$RETF				;AND RETURN
VPCCH2:	MOVEI	S1,.TSPRO		;PROCEED
	STORE	S1,TCB.S2(B),TS.VPC	;STORE
	SETZM	G$TERM##		;GIVE USER THE GREEN LIGHT
	$RETT				;AND PROCEED
SUBTTL	Utility Routines  --  Routine To Mount Previous Volume

;THIS ROUTINE IS CALLED TO MOUNT THE N-1ST VOLUME OF A VOLUME SET ON
;A BACKSPACE RECORD/FILE WHICH WENT INTO THE BEGINNING-OF-VOLUME LABEL
;GROUP ON THE NTH VOLUME.
;IT SPACES TO THE END OF THE VOLUME AND THEN VERIFIES THE EOV LABELS.
;THE TAPE IS LEFT POSITIONED BEFORE THE TAPE MARK PRECEDING THE END-OF-
;FILE-SECTION LABEL GROUP AT THE END OF THE VOLUME. TS.IUD WILL ALWAYS
;BE ON IN TCB.ST.
;TRUE/FALSE IS RETURNED. IF THE FIRST VOLUME OF THE SET IS ALREADY
;MOUNTED, BOT WILL BE STORED IN G$TERM AND FALSE WILL BE RETURNED.

LSTVOL:	$TRACE	(LSTVOL,3)
	PUSHJ	P,CKFIRV		;Are we on the first volume?
	JUMPT	LSTV.3			;Yes, can't back up from here!
	MOVX	S1,%RLPRV		;Get code for previous volume
	SETZ	S2,			;Clear the I/O flag
	PUSHJ	P,MNTVOL		;Get that one mounted
	JUMPF	.RETF			;THAT DIDN'T WORK
	PUSHJ	P,VERVOL		;CHECK ITS VOLUME LABELS
	JUMPF	.RETF			;THEY ARE WRONG
	CAIN	LT,LT.NL		;NOLABELS?
	$RETT				;YES--ALL DONE
LSTV.1:	PUSHJ	P,T$RDRC##		;READ THE HDR1 LABEL
	JUMPF	.RETF			;ERROR
	LOAD	S1,TCB.IO(B)		;GET THE IO STATUS
	TXNE	S1,TI.EOF		;READ SAW EOF??
	JRST	LSTV.2			;YES, MUST BE END OF VOLUME
	PUSHJ	P,@HDRLBL(LT)		;IS THIS A PROPER HDR1?
	JUMPF	.RETF			;NO, ERROR
	MOVEI	S1,'SFL'		;SKIP THE HEADER LABELS
	PUSHJ	P,T$POS##		;TO GET TO USER'S DATA
	JUMPF	.RETF			;ERROR
	MOVEI	S1,'SFL'		;SKIP THE USER'S DATA
	PUSHJ	P,T$POS##		;TO GET TO EOF LABELS
	JUMPF	.RETF			;ERROR
	MOVEI	S1,'SFL'		;SKIP THE EOF LABELS ALSO
	PUSHJ	P,T$POS##		;TO GET TO NEXT FILE'S HDR LABELS
	JUMPF	.RETF			;COULDN'T
	JRST	LSTV.1			;AND TRY TO CHECK THEM

LSTV.2:	MOVEI	S1,'BFL'		;BACK UP OVER SECOND TAPE MARK OF LEOT
	PUSHJ	P,T$POS##		;...
	JUMPF	.RETF			;OOPS
	MOVEI	S1,'BFL'		;BACK UP INTO EOV LABELS
	PUSHJ	P,T$POS##		;LEAVES US AT END OF LABEL GROUP
	JUMPF	.RETF			;EXCEPT WHEN IT DOESN'T WORK
	MOVEI	S1,'BFL'		;NOW BACK OVER LABEL GROUP
	PUSHJ	P,T$POS##		;LEAVES US BEFORE TAPE MARK BEFORE LABEL GROUP
	JUMPF	.RETF			;OOPS
	MOVEI	S1,'SBL'		;NOW SKIP THAT TAPE MARK
	PUSHJ	P,T$POS##		;TO BE AT START OF EOV LABELS
	JUMPF	.RETF			;ON GOOD DAYS
	PUSHJ	P,T$RDRC##		;READ THE EOV1
	JUMPF	.RETF			;CAN'T
	PUSHJ	P,VEREOV		;CHECK THE EOV LABELS
	JUMPF	.RETF			;THEY'RE WRONG
	MOVEI	S1,'BFL'		;BACK UP INTO EOV LABELS
	PUSHJ	P,T$POS##		;LEAVES US AT END OF LABEL GROUP
	JUMPF	.RETF			;EXCEPT WHEN IT DOESN'T WORK
	MOVEI	S1,'BFL'		;NOW BACK OVER LABEL GROUP
	PUSHJ	P,T$POS##		;LEAVES US BEFORE TAPE MARK BEFORE LABEL GROUP
	JUMPF	.RETF			;OOPS
	MOVX	S1,TS.POS		;GET TCB POSITION INFORMATION
	ANDCAM	S1,TCB.ST(B)		;CLEAR IT IN THE TCB
	MOVX	S1,TS.IUD		;FLAG THAT WE'RE IN USER DATA
	IORM	S1,TCB.ST(B)		;SET IT IN THE TCB
	$RETT				;AND GIVE GOOD RETURN
LSTV.3:	MOVX	S1,LE.BOT		;GET CODE FOR BOT
	MOVEM	S1,G$TERM##		;SAVE IT IN TERMINATION WORD
	$RETF				;AND RETURN FALSE
SUBTTL	Routine to get the next volume of a set mounted

;There are two entry points to this routine.
;NXTVIN and NXTVOU.   Both will ask MDA for the next volume of a set,
; however, one asks for the next volume for input and
; the other asks for the next volume for output.

;Call with the TCB adr in B
;Returns TRUE if the tape was mounted (volume labels NOT verified)

NXTVIN:	TDZA	S2,S2			;Clear the flags
NXTVOU:	MOVX	S2,%VWRT		;Mark that we want to write next volume

	$TRACE	(NXTVOL,4)

	MOVX	S1,%RLNXT		;Code to get next volume
	PUSHJ	P,MNTVOL		;Get it mounted
	JUMPF	.RETF			;Couldn't, so quit

	MOVEI	S1,'REW'		;REWIND THIS TAPE
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;ERROR ON REWIND! QUIT
	ZERO	TCB.ST(B)		;CLEAR THE STATUS
	$RETT				;RETURN TRUE
SUBTTL	FIRVOL - Get the first volume of a set mounted

;This routine will as MDA to mount the first volume of
;a volume set.  (this is only neccessary on REWIND)

;Call with the TCB addr in B
FIRVOL:
	PUSHJ	P,CKFIRV		;Are we on the first volume already?
	JUMPT	.RETT			;Yes, use it!
	MOVX	S1,%RLFIR		;Get code for first volume in set
	SETZ	S2,			;And clear the IN/OUT flags
	PJRST	MNTVOL			;Get that one mounted

SUBTTL	CKFIRV - See if current vol is first vol

;Call with TCB of mounted (L$MOUNT) volume in B.
;Returns TRUE is current vol is first vol.
; FALSE if not on first vol

CKFIRV:	
	MOVE	S1,TCB.VL(B)		;Get first part of volid
	MOVE	S2,TCB.VL+1(B)		;And second part
	CAMN	S1,TCB.FV(B)		;First part match?
	CAME	S2,TCB.FV+1(B)		;Yes, does second?
	$RETF				;One of 'em doesn't
	$RETT				;Both do, win
SUBTTL	MNTVOL - Get an arbitrary volume of a set mounted

;Call - 
;	S1/ Relative volume code %RLxxx
;	S2/ Input/Ouput flag (0 or %VWRT)
;	B/  TCB addr
;Returns - 
;	TRUE, volume is up, perhaps on a switched unit,
;		(the switch has been taken care of!)
;	FALSE, OPR refused to comply, or end of volume set

MNTVOL:	$TRACE	(MNTVOL,4)
	PUSHJ	P,REQMDA		;Post the request to MDA
	MOVX	S1,TW.MNT		;CODE FOR MOUNT WAIT
	STORE	S1,TCB.WS(B)		;Set the wait state
	PUSHJ	P,G$NJOB##		;WAIT FOR OPR RESPONSE
	JUMPT	MNTV.2			;Jump if OPR put tape up

	MOVX	S2,LE.VLE		;Default to label error
	CAXN	S1,PLR%ES		;Was it End of Volume set?
	MOVX	S2,LE.EOF		;Yes, return EOF to user
	CAXN	S1,PLR%CN		;Were we cancelled ?
	MOVX	S2,LE.CAN		;Yes, tell the user
	CAXN	S1,PLR%TM		;Exceeded volume limit ?
	MOVX	S2,LE.TMV		;Yes, tell the user
	MOVEM	S2,G$TERM##		;Save the error code
	CAXE	S2,LE.TMV		;If too many volumes 
	CAXN	S2,LE.EOF		;   or end of file then
	$RETF				;      return now
	SETZM	TCB.WS(B)		;Else set TCB idle
	MOVX	S1,TS.NTP		;Get no tape bit
	MOVEM	S1,TCB.ST(B)		;That's all we know about the TCB
	$RETF				;Return

MNTV.2:	MOVX	S1,TS.NTP+TS.VLV	;Get not tape+volume verified bits
	ANDCAM	S1,TCB.ST(B)		;   and clear them
	MOVEI	S1,TCB.VL(B)		;GET ADDRESS OF VOLID
	PJRST	I$RLID##		;SET AS SYSTEM REELID AND RETURN
SUBTTL	REQMDA - Ask MDA to get a different volume mounted

;This routine is called to post a volume switch requet to MDA.
;The routine does not wait for the request to be answered.
;Enter at CANMDA to cancel pending volume switch request.
;Call -
;	S1/ Relative volume code %RLxxx
;	S2/ Input/Output flag (0 or %VWRT)
;	B/  TCB addr

CANMDA:	MOVEI	S1,%RLABO		;ABORT PENDING REEL SWITCH
	MOVEI	S2,0			;NO JUNK PLEASE

REQMDA:	MOVEM	S2,RLVOL+.RLVCD		;Save the I/O flag
	STORE	S1,RLVOL+.RLVCD,RLV.CD	;Store the relative volume code
	LOAD	S1,TCB.DV(B)		;Get the real MT device name
	STORE	S1,RECDV+.RECDN		;Set the device name 
	DMOVE	S1,[EXP REQLN,REQMSG]	;Aim at the message
	PJRST	G$SMDA##		;Send it to MDA

REQMSG:	$BUILD	(.OHDRS)
	$SET	(.MSTYP,MS.TYP,.QOVSR)	;Type - Volume Switch Request
	$SET	(.MSTYP,MS.CNT,REQLN)	;Length
	$SET	(.OARGC,,2)		;2 argument blocks
	$EOB

;The first argument block
	$BUILD	(ARG.DA)
	$SET	(ARG.HD,AR.LEN,ARG.DA+.RECSZ) ;Length of the block
	$SET	(ARG.HD,AR.TYP,.RECDV)	;Block type
	$EOB
RECDV:	BLOCK	.RECSZ			;Space for the device name

;The second argument block
	$BUILD	(ARG.DA)
	$SET	(ARG.HD,AR.LEN,ARG.DA+.RLVSZ) ;Length of the block
	$SET	(ARG.HD,AR.TYP,.RLVOL)	;Block type
	$EOB
RLVOL:	BLOCK	.RLVSZ			;Space for the relative volume argument

	REQLN==.-REQMSG			;Length of the request message
SUBTTL	Routine to Position Tape To Correct File

POSTAP:	$TRACE	(POSTAP,2)
	MOVX	S1,TS.PSN		;GET FLAG FOR POSITIONING NEEDED
	TDNN	S1,TCB.ST(B)		;IS IT ON?
	PJRST	POSFIL			;CHECK ON FILE POSITION ONLY
	MOVX	S1,TS.IHL!TS.ATM	;POTENTIALLY IN HEADERS?
	TDNN	S1,TCB.ST(B)		;???
	STOPCD	(BCP,HALT,,<Bad call to POSTAP>)
	PUSHJ	P,T$RDRC##		;GO READ A RECORD
	JUMPF	.RETF			;CAN'T READ A RECORD
	LOAD	S1,TCB.IO(B),TI.EOF	;GET BIT TO SEE IF WE HIT EOF
	JUMPE	S1,POST.0		;NO, NOT AT EOT
	MOVEI	S1,'BFL'		;YES, SKIP BACK OVER END OF FILE
	PUSHJ	P,T$POS##		;MOVE THE TAPE
	JUMPF	.RETF			;POSITIONING ERROR
	LOAD	T1,TCB.RP(B),TP.RQP	;GET THE REQUEST POSITION
	LOAD	S2,TCB.PS(B),TP.POS	;GET THE ACTUAL POSITION
	CAME	T1,S2			;REQUESTING THE LAST FILE +1 (EOT)
	CAIN	T1,^D99999		;LOOKING FOR EOT
	JRST	POST.2			;YES, WE FOUND IT
	PUSHJ	P,POSZER		;TELL OPR ABOUT SEQ NUM MISMATCH
	JUMPF	.POPJ			;OPR SAID ABORT
	CAIN	S1,PLR%PR		;PROCEED AND IGNORE SEQUENCE ERRORS?
	JRST	POST.2			;PRETEND AT RIGHT POSITION
	CAMG	T1,S2			;CHECK FOR GOING BACKWARD AT EOT
	JRST	POST.3			;YES, SPACE BACKWARD
	MOVEI	S1,LE.PSE		;NO, GET FLAG FOR POSITIONING ERROR
	MOVEM	S1,G$TERM##		;SET AS TERMINATION WORD
	$RETF				;GIVE FALSE RETURN

POST.0:	MOVE	T1,[CPTRI ^D32,0(BUF)]	;POINT AT HDRSEQ (CP 32-35)
	HRL	T2,CVTTAB(LT)		;SET UP TO CONVERT IF NECESSARY
	HRRI	T2,4			;LENGTH OF STRING
	PUSHJ	P,STRNUM		;MAKE STRING INTO NUMBER
	JUMPF	.RETF			;NOT A NUMBER
	STORE	S2,TCB.PS(B),TP.POS	;SAVE THE FILE POSITION NUMBER
	LOAD	T1,TCB.RP(B),TP.RQP	;GET REQUESTED FILE POSITION
	CAMN	T1,S2			;COMPARE IT TO CURRENT FILE POSITION
	JRST	POST.1			;WE'RE THERE, FINISH UP
	PUSHJ	P,POSZER		;TELL OPR ABOUT SEQ NUM MISMATCH
	JUMPF	.POPJ			;OPR SAID ABORT
	CAIN	S1,PLR%PR		;PROCEED AND IGNORE SEQUENCE ERRORS?
	JRST	POST.1			;PRETEND AT RIGHT POSITION
	CAMG	T1,S2			;ARE WE BEFORE THE FILE?
	JRST	POST.3			;NO, GO BACKWARDS
	MOVEI	S1,'SFL'		;GET CODE TO SKIP FILE
	PUSHJ	P,T$POS##		;MOVE THE TAPE
	JUMPF	.RETF			;OOPS, THAT LOST
	ZERO	TCB.ST(B),TS.POS	;CLEAR POSITIONING BITS
	MOVX	S1,TS.IUD		;GET IN USER DATA BIT
	IORM	S1,TCB.ST(B)		;LIGHT THAT IN TCB
	PUSHJ	P,NXTFIL		;SKIP TO NEXT FILE
	JUMPF	.RETF			;COULDN'T SKIP TO NEXT FILE
	JRST	POSTAP			;WE HAVE NOW SKIPPED TO NEXT SET
					; OF HDR LABELS, SEE IF THIS IS IT
POST.1:	MOVEI	S1,'BBL'		;CODE TO BACK UP BLOCK
	PUSHJ	P,T$POS##		;BACK UP OVER HDR LABEL WE JUST READ
	JUMPF	.RETF			;COUDN'T DO IT
	LOAD	S1,TCB.RP(B),TP.RQP	;GET THE REQUESTED POSITION
	STORE	S1,TCB.PS(B),TP.POS	;SAVE AS THE CURRENT POSITION
POST.2:	MOVX	T1,TS.PSN!TS.FFF	;GET BIT THAT SAYS WE NEEDED TO POSITION
	ANDCAM	T1,TCB.ST(B)		;CLEAR IT
	MOVEI	S1,1			;GET A 1
	STORE	S1,TCB.SN(B)		;SET THE FILE SECTION NUMBER NOW!!
	SETZM	G$TERM##		;CLEAR TERMINATION WORD
	MOVX	T1,TS.PSF		;GET FILE POSITION FLAG
	TDNN	T1,TCB.ST(B)		;IS IT ON
	$RETT				;NO, EXIT POSITION IS DONE
	ANDCAB	T1,TCB.ST(B)		;CLEAR THE POSITION FLAG
	TXNE	T1,TS.OUT		;DOING OUTPUT
	$RETT				;YES, THEN ANY NAME OK
	MOVE	T1,[CPTRI ^D5,0(BUF)]	;POINTER TO HDR1 FILE NAME (CP 5-21)
	MOVE	T2,[POINT 7,TCB.FN(B)]	;POINTER TO USER's FILE NAME
	MOVEI	T3,^D17			;COMPARE ALL 17 CHARACTERS
	HRL	T3,CVTTAB(LT)		;GET THE CONVERSION TYPE
	PUSHJ	P,STRCMP		;FILE NAME COMPARE
	JUMPT	.RETT			;YES, GOOD RETURN

	MOVEI	T1,LE.FNF		;GET FILE NOT FOUND RETURN
	MOVEM	T1,G$TERM##		;STORE AS TERMINATION FLAG
	$RETF				;ERROR RETURN
POST.3:	MOVEI	S1,'BFL'		;BACK UP OVER HEADER LABELS
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;ERROR
	MOVEI	S1,'BFL'		;BACK UP OVER END OF FILE LABELS
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;ERROR
	ZERO	TCB.ST(B),TS.POS	;CLEAR THE POSITION BITS
	MOVX	S1,TS.IUD		;NOW IN THE USER DATA
	IORM	S1,TCB.ST(B)		;SET ON
	DECR	TCB.PS(B),TP.POS	;BACKUP THE FILE COUNT
POST.4:	PUSHJ	P,FNDHD1		;FIND THE HEADER RECORDS
	JUMPF	.RETF			;ERROR
	PUSHJ	P,@GETFSN(LT)		;GET THE FILE SECTION NUMBER
	JUMPF	.RETF			;CAN'T BAD TAPE HEADER
	CAIN	S2,1			;FIRST FILE SECTION
	JRST	POST.0			;YES, TRY AGAIN
	MOVEI	S1,'BFL'		;BACK UP OVER FILE LABELS
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;ERROR
	LOAD	S1,TCB.IO(B)		;GET THE IO FLAGS
	TXNE	S1,TI.EOF		;END OF FILE
	JUMPF	.RETF			;YES, BAD TAPE
	PUSHJ	P,LSTVOL		;GET THE PREVIOUS VOLUME
	JUMPT	POST.4			;TRY AGAIN
	MOVEI	S1,LE.PSE		;POSITIONING ERROR
	MOVEM	S1,G$TERM##		;STORE
	$RETF				;RETURN
; Routine to notify the operator about a sequence number mismatch.
POSZER:	MOVE	S1,G$SEQC##		;GET CODE TO PROCESS SEQUENCE ERRORS
	CAIN	S1,PLR%AB		;ABORT USER JOB?
	JRST	PS.BAD			;YES
	CAIE	S1,PLR%PR		;PROCEED AND IGNORE SEQUENCE ERRORS?
	CAIN	S1,PLR%RT		;RETRY SEARCH FOR CORRECT SEQ NUM?
	JRST	POSZ.2			;YES

POSZ.1:	MOVX	S1,TS.FSE		;GET A BIT
	IORM	S1,TCB.S2(B)		;FLAG FILE SEQUENCE ERROR PROCESSING
	MOVEI	S1,POSTX1		;POINT TO INTRODUCTORY TEXT
	MOVEI	S2,POSTX2		;POINT TO MAIN TEXT
	PUSHJ	P,O$LERT##		;ASK THE OPERATOR WHAT TO DO
	MOVX	S2,TS.FSE		;GET BIT AGAIN
	ANDCAM	S2,TCB.S2(B)		;CLEAR IT
	CAIN	S1,PLR%TY		;WANT TO RETYPE THE MESSAGE?
	JRST	POSZER			;STUPID OPR DOESN'T KNOW HOW TO RESPOND
	JUMPF	PS.BAD			;OPR SAID ABORT

POSZ.2:	LOAD	S2,TCB.PS(B),TP.POS	;RELOAD CURRENT POSITION
	LOAD	T1,TCB.RP(B),TP.RQP	;RELOAD REQUESTED POSITION
	CAIE	S1,PLR%PR		;OPR TYPE PROCEED?
	$RETT				;NO--RETURN WITH PLR%RT IN S1
	CAML	T1,S2			;WHICH ONE IS SMALLER
	MOVE	T1,S2			;S2 IS
	CAIL	T1,0			;OUT OF RANGE?
	CAILE	T1,^D999		;MUST BE A LEGAL SEQUENCE NUMBER
	MOVEI	T1,1			;MAKE IT REASONABLE
	STORE	T1,TCB.PS(B),TP.POS	;RESET TO CREATE FILE.001
	STORE	T1,TCB.RP(B),TP.RQP	;SET REQUESTED POSITION TO MATCH
	$RETT				;RETURN WITH PLR%PR IN S1

POSTX1:	ITEXT	(<File sequence number error; label says ^D/TCB.PS(B),TP.POS/ when looking for ^D/TCB.RP(B),TP.RQP/>)
POSTX2:	ITEXT	(<Type 'RESPOND ^I/number/ ABORT' to terminate this operation
Type 'RESPOND ^I/number/ PROCEED' to ignore the error and continue
Type 'RESPOND ^I/number/ RETRY' to search again for correct file>)
POSFIL:	$TRACE	(POSFIL,2)
	MOVX	S1,TS.PSF		;GET FILE POS BIT
	TDNN	S1,TCB.ST(B)		;IS IT ON
	$RETT				;NO, EXIT
	ANDCAM	S1,TCB.ST(B)		;YES, CLEAR IT
	$CALL	.SAVE1			;NEED AN AC
	MOVE	P1,TCB.ST(B)		;GET THE STATUS BIT
	AND	P1,[TS.INP!TS.OUT]	;SAVE FIRST IN/OUT
	ANDCAM	P1,TCB.ST(B)		;CLEAR IN THE STATUS WORD
	PUSHJ	P,PS.REW		;GO TO THE FIRST FILE OF THE FIRST VOLUME
	IORM	P1,TCB.ST(B)		;RESTORE THE FLAGS
	JUMPF	.RETF			;ERROR ON LOGICAL REWIND
	PUSHJ	P,VERVOL		;MAKE SURE THE VOLUME IS OK
	JUMPF	.POPJ			;ITS NOT, SO GIVE UP
POSF.1:	PUSHJ	P,T$RDRC		;READ A RECORD
	JUMPF	.RETF			;ERROR IN READING HDR1
	LOAD	S1,TCB.IO(B),TI.EOF	;GET THE END OF FILE BIT
	JUMPN	S1,POSF.7		;YES AT END OF LOGICAL TAPE
	MOVE	T1,[CPTRI ^D5,0(BUF)]	;FILE NAME IN THE HDR1 LABEL (CP 5-21)
	MOVE	T2,[POINT 7,TCB.FN(B)]	;GET THE USER'S FILE NAME
	MOVEI	T3,^D17			;COMPARE ALL 17 CHARACTERS
	HRL	T3,CVTTAB(LT)		;CONVERSION TYPE
	PUSHJ	P,STRCMP		;IS THIS THE FILE
	JUMPT	POSF.2			;YES, FOUND THE FILE
	MOVEI	S1,'SFL'		;SKIP THE FILE LABELS
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;LOST
	ZERO	TCB.ST(B),TS.POS	;CLEAR THE POSITIONING BIT
	MOVX	S1,TS.IUD		;GET IN THE USER's DATA
	IORM	S1,TCB.ST(B)		;SET IT
	PUSHJ	P,NXTFIL		;GO TO THE NEXT FILE
	JUMPF	.RETF			;ERRORS
	IORM	P1,TCB.ST(B)		;RESET THE IN/OUT FLAG RESET ON REEL SWITCH
	JRST	POSF.1			;TRY AGAIN

POSF.2:	MOVEI	S1,'BBL'		;BACK TO THE HEADER 1 RECORD
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;ERROR
	PJRST	POST.2			;COMMON EXIT

POSF.7:					;HERE ON LOGICAL END OF TAPE
	MOVEI	S1,'BFL'		;SKIP BACK OVER END OF FILE
	PUSHJ	P,T$POS##		;DO IT
	JUMPF	.RETF			;CAN'T
	TXNE	P1,TS.OUT		;DOING OUTPUT
	PJRST	POST.2			;WIN
	MOVEI	T1,LE.FNF		;GET FILE NOT FOUND
	MOVEM	T1,G$TERM##		;STORE AS USER'S TERMINATION
	$RETF				;RETURN
SUBTTL	NXTFIL -- Routine to Skip to Next Data File

;CALLED WHEN IN USER DATA TO SKIP TO NEXT FILE'S HDR1 LABEL

NXTFIL:	$TRACE	(NXTFIL,4)
	LOAD	S1,TCB.ST(B)		;GET TAPE STATUS
	TXNN	S1,TS.IUD		;IN USER DATA?
	STOPCD	(BCN,HALT,,<Bad call to NXTFIL>)
	MOVEI	S1,'SFL'		;CODE TO SKIP A FILE
	PUSHJ	P,T$POS##		;SKIP THE FILE
	JUMPF	.RETF			;THAT LOST
	MOVX	S1,TS.IUD		;GET IN USER DATA BIT
	ANDCAM	S1,TCB.ST(B)		;CLEAR IT
	PUSHJ	P,T$RDRC##		;READ A RECORD
	JUMPF	.RETF			;LOSING MAGTAPES
	PUSHJ	P,CHKEF1		;CHECK IF 'EOF1'
	JUMPF	NXTF.1			;NO, HOPE IT'S 'EOV1'
	MOVEI	S1,'SFL'		;CODE TO SKIP FILE
	PUSHJ	P,T$POS##		;SKIP THE FILE
	JUMPF	.RETF			;THAT LOST
	INCR	TCB.PS(B),TP.POS	;INDICATE NEXT FILE
	MOVX	S1,TS.ATM		;GET AFTER TAPE MARK BIT
	IORM	S1,TCB.ST(B)		;SET IN TCB
	$RETT				;GIVE WINNING RETURN

;HERE IF NOT EOF1 LABEL AFTER USER DATA
NXTF.1:	$CALL	.SAVE1			;SAVE A REGISTER
	PUSHJ	P,CHKEV1		;TRY FOR 'EOV1'
	JUMPF	NXTF.2			;BAD LABELS
	LOAD	P1,TCB.ST(B),TS.PSN	;GET POSITIONING NEEDED FLAG
	PUSHJ	P,NXTVIN		;GET THE NEXT VOLUME
	JUMPF	.RETF			;COULDN'T
	IORM	P1,TCB.ST(B)		;AND TURN IT ON IF NECESSARY
	PUSHJ	P,VERVOL		;CHECK ITS VOLUME LABELS
	JUMPF	.RETF			;THEY LOST
	MOVEI	S1,'SFL'		;SKIP THE REST OF THE LABEL GROUP
	PUSHJ	P,T$POS##		;...
	JUMPF	.RETF			;OOPS
	ZERO	TCB.ST(B),TS.POS	;CLEAR TAPE POSITION BITS
	MOVX	S1,TS.IUD		;GET IN USER DATA BIT
	IORM	S1,TCB.ST(B)		;SET AS POSITION
	JRST	NXTFIL			;AND GO BACK TO START

;HERE IF NEITHER EOF1 OR EOV1 AFTER DATA
NXTF.2:	MOVX	S1,LE.TRE		;TRAILER LABEL ERROR
	STORE	S1,G$TERM##		;SAVE IN TERMINATION CODE WORD
	$RETF				;AND GIVE BAD RETURN
;SUBTTL	Routine to Find a TCB from a Volid
;
;
;;CALLED WITH:
;;	S1 = SIXBIT VOLID
;;RETURNS TRUE/FALSE, B POINTING TO THE TCB WITH MATCHING VOLID IF TRUE
;
;
;L$FVOL::	$TRACE	(L$FVOL,1)
;	$CALL	.SAVET			;SAVE THE T REGS
;	MOVEM	S1,FVOL.A		;SAVE VOLID IN LOCAL STORAGE
;	MOVE	S1,G$LIST##		;Get list handle
;	$CALL	L%FIRST			;Start at the top
;FVOL.1:	JUMPF	.RETF			;NO MORE, RETURN FALSE
;	MOVE	B,S2			;Save pointer to this TCB
;	MOVE	T1,[POINT 6,FVOL.A]	;GET A BYTE POINTER TO THE SOUGHT VOLID
;	MOVE	T2,[POINT 8,TCB.VL(B)]	;GET A BYTE POINTER TO VOLID IN THIS TCB
;	MOVE	T3,[SIXCVT,,6]		;CONVERSION ROUTINE,,LENGTH
;	PUSHJ	P,STRCMP		;DO THEY MATCH?
;	JUMPT	.RETT			;YES, THIS IS THE ONE
;	MOVE	S1,G$LIST##		;Get back list handle
;	$CALL	L%NEXT			;Try for next entry
;	JRST	FVOL.1			;NO, TRY NEXT TCB
;
;FVOL.A:	BLOCK	1			;LOCAL STORAGE
SUBTTL	String Manipulation Routines

;ROUTINE TO COMPARE TO CHARACTER STRINGS
;CALLED WITH
;	T1 = BYTE POINTER TO STRING 1
;	T2 = BYTE POINTER TO STRING 1
;	T3 = ADDR OF CONVERSION ROUTINE FOR STRING 2,,LENGTH OF STRINGS
;
;RETURNS TRUE/FALSE

STRCMP:	HLRZ	T4,T3			;GET ADDR OF CONVERSION ROUTINE INTO T4
	HRRZS	T3			;MAKE T3 ONLY COUNT
STRC.1:	ILDB	S2,T1			;GET A CHARACTER FROM STRING 1
	JUMPE	T4,STRC.2		;CONTINUE IF NO CONVERSION DESIRED
	MOVE	S1,S2			;GET CHARACTER INTO S1
	PUSHJ	P,(T4)			;CALL CONVERSION ROUTINE
	JUMPF	.RETF			;ILLEGAL CHARACTER, RETURN
STRC.2:	ILDB	S1,T2			;GET A CHARACTER FROM STRING 2
	CAME	S1,S2			;COMPARE
	$RETF				;RETURN FALSE
	SOJG	T3,STRC.1		;LOOP FOR NEXT CHARACTER
	$RETT				;ALL DONE, RETURN TRUE

;ROUTINE TO CONVERT A CHARACTER STRING TO A NUMBER
;ENTER AT STRNUM FOR DECIMAL, AT STROCT FOR OCTAL
;CALLED WITH:
;	T1 = BYTE POINTER TO STRING
;	T2 = ADDR OF CONVERSION ROUTINE,,LENGTH OF STRING
;
;RETURNS TRUE/FALSE, NUMBER IN S2

STROCT:	SKIPA	T4,[EXP	10]		;GET RADIX
STRNUM:	MOVEI	T4,^D10			;GET RADIX
	$CALL	.SAVE1			;AND SAVE AN AC
	HLRZ	T3,T2			;GET ADDR OF CONVERSION ROUTINE
	HRRZS	T2			;AND MAKE T2 JUST COUNT
	SETZ	P1,			;CLEAR AN AC AS AN ACCUMULATOR
STRN.1:	ILDB	S2,T1			;GET A CHARACTER
	JUMPE	T3,STRN.2		;CONTINUE IF NO CONVERSION DESIRED
	MOVE	S1,S2			;GET CHAR INTO S1 FOR CONVERT
	PUSHJ	P,(T3)			;CALL CONVERSION ROUTINE
	JUMPF	.RETF			;ILLEGAL CHARACTER, RETURN FALSE
STRN.2:	CAIG	S2,"0"-1(T4)		;IS CHAR BIGGER THAN 9
	CAIGE	S2,"0"			;OR LESS THAN 0
	$RETF				;YES, ITS NOT A DIGIT, RETURN FALSE
	SUBI	S2,"0"			;CONVERT TO A NUMBER
	IMULI	P1,(T4)			;SHIFT THE ACCUMULATOR ONE  DIGIT
	ADD	P1,S2			;AND ADD IN THIS DIGIT
	SOJG	T2,STRN.1		;LOOP FOR MORE
	MOVE	S2,P1			;GET RESULT IN S2 FOR RETURN
	$RETT				;AND GIVE GOOD RETURN
	;ROUTINES TO CONVERT NUMBER INTO STRING
;ENTER AT OCTSTR IF NUMBER IS TO BE INTERPRETED AS OCTAL
;ENTER AT DECSTR IF NUMBER IS TO BE INTERPRETED AS DECIMAL
;CALLED WITH:
;	T1 = NUMBER
;	T2 = DESTINATION BYTE POINTER
;	T3 = ADDR OF CONVERT ROUTINE,,LENGTH OF STRING TO STORE INTO
;RETURNS WITH:
;	T2 = UPDATED DESTINATION BYTE POINTER
;	TRUE/FALSE - FALSE ONLY IF NUMBER WON'T FIT INTO STRING
;			   OF LENGTH (T3)
;STRING STORE IS RIGHT JUSTIFIED, ZERO FILLED

OCTSTR:	SKIPA	T4,[EXP 10]		;SET RADIX TO 8
DECSTR:	MOVEI	T4,^D10			;SET RADIX TO 10
	$CALL	.SAVE1			;SAVE A REGISTER
	HLRZ	P1,T3			;GET ADDR OF CONVERSION ROUTINE INTO P1
	HRRZS	T3			;MAKE T3 JUST COUNT
	MOVE	S2,T1			;COPY NUMBER INTO S2
NUMS.1:	IDIVI	S2,(T4)			;GET A DIGIT
	HRLM	T1,(P)			;SAVE A DIGIT ON THE STACK
	SOJG	T3,NUMS.2		;HAS COUNT EXPIRED
	JUMPE	S2,NUMS.3		;YES, IF NO MORE NUMBER, OK
	$RETF				;NUMBER TOO LONG
NUMS.2:	PUSHJ	P,NUMS.1		;RECURSE FOR NEXT DIGIT
	JUMPF	.RETF			;PROPAGATE FALSE RETURN
NUMS.3:	HLRZ	S2,(P)			;GET A DIGIT OFF THE STACK
	ADDI	S2,"0"			;ADD IN ASCII ZERO
	JUMPE	P1,NUMS.4		;DON'T CALL CONVERT ROUTINE IF THERE ISN'T ONE
	MOVE	S1,S2			;COPY CHARACTER TO S1 FOR CONVERT ROUTINE
	PUSHJ	P,(P1)			;CALL CONVERSION ROUTINE
	JUMPF	.RETF			;OOPS, BAD CHARACTER
NUMS.4:	IDPB	S2,T2			;STORE A CHARACTER
	$RETT				;RETURN TRUE
;ROUTINE TO STORE A STRING, WITH CONVERSION IF NECESSARY
;CALLED WITH:
;	T1 = BYTE POINTER TO SOURCE STRING
;	T2 = BYTE POINTER TO DESTINATION STRING
;	T3 = ADDR OF CONVERSION ROUTINE,,LENGTH OF STRINGS
;
;RETURNS FALSE IF ANY ILLEGAL CHARACTERS
;RETURNS UPDATED DESTINATION BYTE POINTER IN T2
;LH OF T3 = 0 IMPLIES NO CONVERSION

L$STST::
STGSTR:	HLRZ	T4,T3			;GET CONVERSION ROUTINE ADDR IN T4
	HRRZS	T3			;MAKE T3 JUST COUNT
STGS.1:	ILDB	S1,T1			;GET A CHARACTER
	JUMPE	T4,STGS.2		;PROCEED IF NO CONVERSION
	PUSHJ	P,(T4)			;CALL CONVERSION ROUTINE
	JUMPF	.RETF			;ILLEGAL CHARACTER
	MOVE	S1,S2			;COPY CONVERSION RESULT INTO S1
STGS.2:	IDPB	S1,T2			;STORE A CHARACTER
	SOJG	T3,STGS.1		;LOOP FOR MORE
	$RETT				;RETURN TRUE

;ROUTINE TO STORE BLANKS
;CALLED WITH:
;	T2 = DESTINATION BYTE POINTER
;	T3 = ADDR OF CONVERSION ROUTINE,,NUMBER OF BLANKS TO STORE
;
;RETURNS UPDATED DESTINATION BYTE POINTER IN T2
;LH OF T3 = 0 ON CALL IMPLIES NO CONVERSION

BNKSTR:	MOVE	S1,BNKPTR		;POINT TO WORD OF BLANKS
	ILDB	S2,S1			;GET AN ASCII BLANK
	HLRZ	T4,T3			;GET ADDR OF CONVERT ROUTINE
	HRRZS	T3			;MAKE T3 JUST COUNT
	JUMPE	T4,BNKS.1		;SKIP IF NO CONVERT
	MOVE	S1,S2			;COPY TO S1 FOR CONVERSION ROUTINE
	PUSHJ	P,(T4)			;CALL CONVERT ROUTINE
BNKS.1:	IDPB	S2,T2			;STORE A CHARACTER
	SOJG	T3,BNKS.1		;LOOP FOR NEXT
	$RETT				;GIVE GOOD RETURN
SUBTTL	String Conversion

;THE FIRST SET CONVERT TO ASCII FROM OTHER CHARACRTER SETS

L$CVTT::
CVTTAB:	BLPDSP			;ERROR
	Z			;NO CONVERSION FOR ANSI
	Z			;...
	EBCCVT			;EBCDIC TO ASCII
	EBCCVT			;...
	Z
	Z
	Z
	Z			;NO CONVERSION FOR COBOL ASCII
	SIXCVT			;SIXBIT TO ASCII
	Z

SIXCVT:	MOVEI	S2,40(S1)		;CONVERT CHAR IN S1
	TRNE	S2,777600		;LEGAL ASCII?
	$RETF				;NO, GIVE ERROR
	$RETT				;RETURN OK

EBCCVT:	IDIVI	S1,4			;MAKE S1 INDEX TO TABLE,
					; S2 INDEX TO BYTE POINTER
	ADDI	S1,E.ATBL		;MAKE S1 WORD TO GET CHAR FROM
	LDB	S2,PTRS(S2)		;GET THE CORRECT BYTE
	TRNN	S2,200			;IS IT A LEGAL CHAR?
	$RETT				;YES, GOOD RETURN
	$RETF				;NO, LOSE

;THESE CONVERT FROM ASCII TO ANOTHER CHARACTER SET

CVTTB1:	BLPDSP				;THIS IS VERY WRONG
	Z				;NO CONVERSION FOR ASCII
	Z				;DITTO
	ASCEBC				;ASCII TO EBCDIC
	ASCEBC				; "
	Z
	Z
	Z
	Z
	Z
	Z

ASCEBC:	IDIVI	S1,4			;MAKE S1 INDEX TO TABLE
					; S2 INDEX TO BYTE POINTER
	ADDI	S1,A.ETBL		;POINT AT CORRECT LOC IN TABLE
	LDB	S2,PTRS(S2)		;GET THE CHARACTER
	TRNN	S2,400			;IS IT LEGAL?
	$RETT				;YES, GOOD RETURN
	$RETF				;NO, ERROR
SUBTTL	Character Conversion Tables

;FIRST DEFINE SOME MACROS TO SET UP THESE TABLES

.XCREF

DEFINE	WORD(A,B,C,D),<			;DEFINE A MACRO TO GENERATE A WORD
					;OF NINE BIT BYTES
XLIST

BYT(A,1)
BYT(B,2)
BYT(C,3)
BYT(D,4)

BYTE(9)%1,%2,%3,%4


LIST
>
	ZZ==0

DEFINE BYT(A,B),<			;DEFINE THE BYTES AS THE ASCII TO EBCDIC
					;VALUES


	IFG AE%'A-400000,<%'B==400+AE%'A-400000>
	IFLE AE%'A-400000,<%'B==AE%'A>
PURGE AE%'A
>

A.ETBL:					;NOW DEFINE THE TABLE
REPEAT	40,<
	WORD(\ZZ,\<ZZ+1>,\<ZZ+2>,\<ZZ+3>)
ZZ==ZZ+4
>

;NOW REDEFINE THE BYT MACRO TO GENERATE THE EBCDIC TO ASCII TABLE
	ZZ==0

DEFINE BYT(A,B),<			;DEFINE THE BYTES AS THE EBCDIC TO ASCII
					;VALUES


	IFGE EA%'A-400000,<%'B==400+EA%'A-400000>
	IFL EA%'A-400000,<%'B==EA%'A>
PURGE EA%'A
>

E.ATBL:					;NOW DEFINE THE TABLE
REPEAT	100,<
	WORD(\ZZ,\<ZZ+1>,\<ZZ+2>,\<ZZ+3>)
ZZ==ZZ+4
>


.CREF

;SET UP BYTE POINTERS TO THE TABLES
;THESE ASSUME S1 IS POINTING TO THE CORREC WORD IN THE TABLE

PTRS:	POINT	9,(S1),8
	POINT	9,(S1),17
	POINT	9,(S1),26
	POINT	9,(S1),35
BLPDSP:	JRST	.RETF


	END