Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE	PLRTAP - Tape Processing Module
	SUBTTL	Author: Clifford Romash/WLH/DC/NT 3-Aug-83

;
;
;        COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,
;			 1983,1984,1985,1986
;                    DIGITAL EQUIPMENT CORPORATION
;			 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
	SEARCH	ORNMAC		;For the WTO definitions
	SEARCH	PLRMAC
	PROLOG	(PLRTAP)


;THIS MODULE CONTAINS THE TAPE I/O ROUTINES FOR PULSAR.  ALL ROUTINES
;	ALL CALLED WITH 'B' CONTAINING THE ADDRESS OF THE TCB,
;	AND RETURN WITH S1 CONTAINING A TRUE/FALSE INDICATOR.
;
;ARGUMENTS ARE PASSED IN S1 AND S2.

;ROUTINES IN THIS MODULE USE AC'S S1 AND S2 ONLY.  ALL OTHER ACS
;	ARE GUARANTEED TO BE PRESERVED.

SUBTTL	Directory for PLRTAP

SUBTTL	T$INIT -- Initialize PLRTAP

;CALLED DURING PULSAR INITIALIZATION TO INITIALIZE PLRTAP'S
;	LOCAL DATABASE.

	ENTRY	T$INIT

T$INIT:	POPJ	P,			;JUST RETURN FOR NOW

SUBTTL	T$OPEN -- Open A Magtape For I/O

;T$OPEN IS CALLED TO INITIALIZE A MAGTAPE FOR LABEL PROCESSING I/O
;	IT IS CALLED WITH THE TCB ADDRESS IN 'B'
;	IF T$OPEN SUCCEEDS, IT RETURNS TRUE/FALSE AND CALLS THE
;	CALLING ROUTINE AS A CO-ROUTINE. ON THE CALLERS RETURN, IT CALLS
;	T$RELE. IF MORE THAN ONE CALL TO T$OPEN IS MADE BEFORE THE
;	ORIGINAL CALLER RETURNS, T$OPEN IS A NOOP WHICH RETURNS TRUE.

	ENTRY	T$OPEN

T$OPEN:	$TRACE	(T$OPEN,6)
	LOAD	S1,TCB.IO(B)		;GET IO STATUS
	TXNE	S1,TI.OPN		;IS DEVICE OPEN?
	$RETT				;YES, DON'T DO ANYTHING
	LOAD	LT,TCB.LT(B)		;GET THE LABEL TYPE FROM THE TCB
	PUSH	P,T1			;SAVE 
	PUSH	P,T2			;   THE
	PUSH	P,T3			;     'T'
	PUSH	P,T4			;      AC's
	PUSHJ	P,MAKBUF		;Make up some buffers for the TCB
	MOVX	T1,TI.OPN		;GET DEVICE IS OPEN BIT
	IORM	T1,TCB.IO(B)		;TURN IT ON
	MOVEI	T1,.TFLBG		;FUNCTION FOR LABEL GET
	LOAD	T2,TCB.DV(B)		;DEVICE NAME
	MOVE	T3,[2,,T1]		;AC FOR TAPOP.
	SETZM	TCB.DN(B)		;No device yet
					; (in case offline during label get)
	TAPOP.	T3,			;GET THE LABEL DDB
	 $STOP	(LGF,Label Get Failed)
	STORE	T3,TCB.DN(B)		;STORE LABEL DDB NAME IN TCB
	MOVE	T2,T3			;USE IT AS DEVICE NAME FOR OTHER TAPOP.'S
	MOVEI	T1,.TFBSZ+.TFSET	;FUNCTION TO SET BLOCKSIZE
	MOVX	T3,BFRSIZ+1		;GET BUFFER SIZE + A LITTLE EXTRA
	MOVE	T4,[3,,T1]		;AC FOR TAPOP.
	TAPOP.	T4,			;SET THE BLOCKSIZE
	 $STOP	(CSB,Can't Set Blocksize)
	MOVEI	T3,.TFM8B		;INDUSTRY COMPATIBLE 8 BIT MODE
	MOVEI	T1,.TFMOD+.TFSET	;ASK TO SET IT
	MOVE	T4,[3,,T1]		;AC FOR TAPOP.
	TAPOP.	T4,			;SET MODE
	 $STOP	(CSI,Can't Set Industry compatible mode)
REPEAT 0,<
	LOAD	T3,TCB.PS(B),TP.DEN	;GET DENSITY FROM THE TCB
	JUMPE	T3,OPEN.0		;DON'T KNOW THE DENSITY
	MOVEI	T1,.TFDEN+.TFSET	;ARG TO SET IT
	MOVE	T4,[3,,T1]		;AC FOR TAPOP.
	TAPOP.	T4,			;SET THE DENSITY
	 $STOP	(CSD,Can't Set Density)
OPEN.0:>;END REPEAT 0
	MOVX	S1,UU.DEL+.IODMP	;Get bit to disable error logging
	MOVEM	S1,TCB.FI(B)		;Light in FILOP I/O status word
	MOVX	S1,.FOMAU		;Update mode (Input and Output)
	PUSHJ	P,T$FILOP		;Do the FILOP
	MOVX	S1,FO.ASC		;Get assign ext channel bit
	ANDCAM	S1,TCB.FU(B)		;We've got a channel, don't ask again
	MOVEI	S1,PS.RDO!PS.RDH	;TRAP OFF-LINE AND HUNG DEVICE
	PUSHJ	P,I$PICD##		;CONNECT DEVICE TO PSI SYSTEM
	SKIPT				;CHECK FOR ERRORS
	$STOP	(CCT,<Can't connect tape to PSI system>)
	MOVX	S1,.TFRDB		;SET UP TO READ 'READ-BACKWARDS' BIT
	LOAD	S2,TCB.DV(B)		;GET REAL DEVICE NAME
	MOVE	T1,[2,,S1]		;LOAD AC FOR TAPOP
	CAIE	LT,.TFLNV		;UNLABELD USER-EOT?
	TAPOP.	T1,			;NO - READ THE BIT
	  SETZ	T1,			;ASSUME NOT READ-BACKWARDS
	JUMPE	T1,OPEN.1		;IF NOT READING BACKWARDS,,CONTINUE
	MOVX	S1,LE.IOP		;ELSE GET POSITIONING ERROR
	MOVEM	S1,G$TERM##		;SET IT
	MOVX	S1,TS.ERR		;GET THE ERROR INTERLOCK
	IORM	S1,TCB.ST(B)		;AND SET IT ALSO

OPEN.1:	POP	P,T4			;RESTORE
	POP	P,T3			;    THE
	POP	P,T2			;     'T'
	POP	P,T1			;      AC's
	MOVEI	S1,T$RELE		;GET THE ADDRESS FOR CALLER TO RETURN TO
	EXCH	S1,0(P)			;EXCHANGE IT WITH CALLERS ADDRESS
	PUSH	P,S1			;PUT CALLERS ADDRESS BACK ON STACK
	MOVX	S1,TS.ERR		;GET THE ERROR LOCK BIT
	TDNN	S1,TCB.ST(B)		;IS IT ON?
	$RETT				;NO,,ALL'S OK !!!
	$RETF				;ERROR WAS ON, RETURN FALSE

SUBTTL	T$RELE -- Routine To Release Label IO Channel

;THIS ROUTINE IS CALLED AT THE END OF LABEL PROCESSING TO RELEASE
;	THE IO CHANNEL USED FOR LABEL IO AND TO DO THE LABEL RELEASE
;	TO START THE JOB WHICH WAS BLOCKED
;
;IT IS CALLED WITH 'B' CONTAINING THE ADDRESS OF THE TCB. AND RETURNS
;	TRUE/FALSE

	ENTRY	T$RELEASE

T$RELE:	$TRACE	(T$RELE,6)
	$CALL	.SAVET			;SAVE SOME AC'S
	PUSHJ	P,I$PIRD##		;REMOVE PSI CONDITIONS
	MOVE	T4,TCB.IO(B)		;GET IO STATUS
	MOVE	S1,G$TERM##		;GET THE TERMINATION CODE
	CAILE	S1,LE.EOF		;IS IT ONE WHICH IS
	CAIN	S1,LE.BOT		;CONTINUABLE??
	JRST	RELE.1			;YES, DON'T SET ERROR
	MOVX	S1,TS.SLR		;GET A BIT
	TDNE	S1,TCB.ST(B)		;SKIP LABEL RELEASE?
	JRST	RELE.1			;YES
	MOVX	S1,TS.ERR		;GET THE ERROR INTERLOCK BIT
	IORM	S1,TCB.ST(B)		;AND TURN IT ON
	MOVE	S1,G$TERM##		;GET THE TERMINATION CODE
	STORE	S1,TCB.EC(B),TE.TRM	;STORE SO USER WILL GET THE SAME ERROR

RELE.1:	LOAD	S1,TCB.FU(B),TF.DVH	;Get channel #
	RESDV.	S1,			;RELEASE, BUT DON'T WRITE TAPE MARKS
	 JFCL				;Ignore the error
	SETZM	TCB.IC(B)		;ZAP INPUT CCW
	SETZM	TCB.OC(B)		;ZAP OUTPUT CCW
	MOVE	S1,TCB.ST(B)		;GET STATUS BITS
	TXZ	S1,TS.SLR		;CLEAR "SKIP LABEL RELEASE"
	EXCH	S1,TCB.ST(B)		;UPDATE
	TXNE	S1,TS.SLR		;SKIP LABEL RELEASE?
	JRST	RELE.2			;YES
	MOVEI	T1,.TFLRL		;FUNCTION FOR LABEL RELEASE
	LOAD	T2,TCB.DV(B)		;GET THE REAL DEVICE NAME
	JUMPE	T2,RELE.3		;No label ddb, quit
	MOVE	T3,G$TERM##		;GET TERMINATION CODE
	MOVX	S1,TS.ERR		;GET THE ERROR BIT
	TDNE	S1,TCB.ST(B)		;IS IT SET
	LOAD	T3,TCB.EC(B),TE.TRM	;YES, USE THE OLD CODE
IFN FTTRACE,<
	SKIPE	G$DEBUG			;Are we debugging?
	$TEXT	(,<Closing Label DDB with termination code of #^O/T3/>)
>;END OF FTTRACE CONDITIONAL
	MOVE	S1,[3,,T1]		;AC FOR TAPOP.
	TAPOP.	S1,			;SET THE TERM CODE
	 $STOP	(LRF,Label Release Failed)

RELE.2:	TXNN	T4,TI.OAV		;SPECIAL AVR OPEN MODE
	JRST	RELE.3			;NO, CONTINUE
	MOVEI	T1,.TFLDD		;YES, MUST DESTROY THE DDB
	LOAD	T2,TCB.DV(B)		;GET THE DEVICE NAME
	MOVE	T3,[2,,T1]		;AC FOR TAPOP
	TAPOP.	T3,			;DO THE LABEL DESTROY
	 JFCL				;IGNORE THE ERROR
	SETZM	TCB.IO(B)		;CLEAR THE I/O WORD

RELE.3:	TXNN	T4,TI.LND		;DOES LABEL DDB NEED TO BE DESTROYED?
	JRST	RELE.4			;DON'T NEED TO DESTROY DDB
	MOVEI	T1,.TFLDD		;FUNCTION FOR LABEL DESTROY
	LOAD	T2,TCB.DS(B)		;OLD DEVICE NAME
	MOVE	T3,[2,,T1]		;AC FOR TAPOP
	TAPOP.	T3,			;DO THE LABEL DESTROY
	 JFCL				;IGNORE THE ERROR

RELE.4:	MOVE	T1,[TI.EOF!TI.EOT!TI.OPN!TI.BOT!TI.LND!TI.SOP] ;GET LOTSA BITS
	ANDCAM	T1,TCB.IO(B)		;CLEAR THEM
	$RETT				;GIVE GOOD RETURN

SUBTTL	T$NUNI -- Routine to Switch to New Unit

;THIS ROUTINE IS CALLED WITH S1 CONTAINING THE NEW UNIT NAME IN SIXBIT
;  AND B POINTING TO THE TCB
;IT RETURNS WITH THE TCB SET UP TO USE THE NEW UNIT
;AND TRUE/FALSE

	ENTRY	T$NUNI

T$NUNI:	$TRACE	(T$NUNI,6,S1)
	$CALL	.SAVET			;SAVE SOME AC'S TO WORK IN
	$SAVE	<P1,P2>			;And some more regs
	MOVE	P1,S1			;Save new device name
	MOVE	P2,B			;Save ptr to the TCB
	PUSHJ	P,G$FTCB##		;Ask for new device's TCB
	SKIPT				;Found it?
	 $STOP	(SND,<Switch units with non-existent device ^W/P1/>)
	MOVX	T1,TI.OPN		;Get channel opened bit
	TDNE	T1,TCB.IO(B)		;Is this DDB open?
	$STOP	(SIO,Switch units with OPEN Label DDB)
	EXCH	B,P2			;Reset to our TCB, save new TCB
	MOVE	T3,P1			;GET NEW DEVICE IN T3
	LOAD	T2,TCB.DV(B)		;AND OLD DEVICE TO T2
	MOVEI	T1,.TFLSU		;TAPOP FUNCTION TO SWITCH UNITS
	MOVE	T4,[3,,T1]		;AC FOR TAPOP.
	TAPOP.	T4,			;DO THE SWITCH UNITS
	 $STOP	(CSU,Can't Switch Units)
	STORE	T3,TCB.DV(B)		;SAVE NEW DEVICE NAME
	SKIPN	TCB.DS(B)		;KEEP THE ORIGIONAL DRIVE NAME
	STORE	T2,TCB.DS(B)		;SAVE OLD DEVICE TO BE DESTROYED
	MOVX	T1,TI.LND		;FLAG FOR LABEL DDB NEEDS DESTUCTION
	IORM	T1,TCB.IO(B)		;TURN IT ON
	STORE	T2,TCB.DV(P2)		;Make new TCB look like old TCB

	MOVE	T1,TCB.CH(B)		;Get device dependent stuff
	EXCH	T1,TCB.CH(P2)		;Swap with old unit
	MOVEM	T1,TCB.CH(B)		;Save the new stuff
	$RETT				;AND RETURN TRUE

SUBTTL	T$SUNI -- Routine to Switch to Same Unit


T$SUNI::$TRACE	(T$SUNI,6,S1)
	$CALL	.SAVET			;SAVE SOME ACS
	MOVE	T1,[3,,T2]		;SET UP UUO AC
	MOVEI	T2,.TFLSU		;FUNCTION CODE
	MOVE	T3,TCB.DV(B)		;GET DRIVE NAME
	MOVE	T4,T3			;SAME UNIT, REMEMBER?
	TAPOP.	T1,			;KICK MONITOR
	  PUSHJ	P,S..CSU		;SHOULDN'T FAIL
	POPJ	P,			;AND RETURN

	SUBTTL	T$LTYP  --  IS THE DRIVE IN LABEL MODE

;CALLED WITH S1 CONTAINING THE UNIT NAME IN SIXBIT

T$LTYP:: $CALL	.SAVET			;SAVE SOME TEMPS
	MOVE	T1,[XWD 3,T2]		;UUO ARGUMENT
	MOVEI	T2,.TFLBL		;FUNCTION TO GET LABEL TYPE
	MOVE	T3,S1			;COPY THE DEVICE NAME
	TAPOP.	T1,			;GET THE LABEL TYPE
	 $STOP	(RLT,Failed Reading Label Type)
	SKIPE	T1			;BLP MODE
	CAILE	T1,.TFLIU		;IS IT A LEGAL TYPE
	$RETF				;NO
	$RETT				;YES, LEGAL LABEL TYPE

SUBTTL	T$CKAV -- Check unit's acceptibility

;CALLED WITH S1 CONTAINING A UNIT NAME IN SIXBIT

T$CKAV::MOVE	S2,S1			;SAVE DEVICE NAME
	DEVCHR	S1,			;SEE IF THE DEVICE IS AVAILABLE
	TXNE	S1,DV.ASC!DV.ASP	;IS THE DEVICE OWNED BY SOMEONE?
	$RETF				;YES, LOSE
	$RETT				;NO, WIN

SUBTTL	T$POS  -- Position Tape

;T$POS IS CALLED WITH B CONTAINING THE TCB ADDRESS AND S1 CONTAINING
;	THE DESIRED POSITIONING FUNCTION.  POSITIONING FUNCTIONS
;	ARE 3 CHARACTER SIXBIT CODES.  LEGAL CODES ARE:
;
;		'REW'		REWIND THE TAPE
;		'UNL'		UNLOAD THE TAPE
;		'SBL'		SKIP FORWARD 1 BLOCK
;		'SFL'		SKIP FORWARD 1 FILE
;		'BBL'		SKIP BACKWARD 1 BLOCK
;		'BFL'		SKIP BACKWARD 1 FILE
;		'EOT'		SKIP TO LOGICAL EOT
;		'DSE'		DATA SECURITY ERASE

;RETURNS TRUE ALWAYS.

T$POS::	$TRACE	(T$POS,6,S1)
	$CALL	.SAVE3			;SAVE P1-P3
	MOVSI	P1,-PFUNCN		;MAKE AOBJN POINTER
POS.1:	MOVE	P2,PFUNCT(P1)		;GET THE FUNCTION
	CAIN	S1,(P2)			;DO THE COMPARE
	JRST	POS.2			;GOT ONE
	AOBJN	P1,POS.1		;AND LOOP
	$STOP	(IPF,Illegal Positioning Function)

POS.2:	IFN FTTRACE,<
	SKIPE	G$DEBUG			;Are we debugging?
	$TEXT	(,<PULSAR (PLRTAP) positioning for ^T/@POS.T(P1)/>)
	JRST	POS.4			;Skip over the in-line table
POS.T:	[ASCIZ /REWIND/]
	[ASCIZ /UNLOAD/]
	[ASCIZ /SKIP ONE BLOCK/]
	[ASCIZ /SKIP ONE FILE/]
	[ASCIZ /EOT/]
	[ASCIZ /BACKSPACE ONE BLOCK/]
	[ASCIZ /BACKSPACE ONE FILE/]
POS.4:
>;END OF FTTRACE CONDITIONAL
	MOVE	S2,TCB.IO(B)		;GET I/O STATUS BITS
	TXZ	S2,TI.EOT!TI.EOF	;CLEAR EOT & EOF SINCE TAPE WILL MOVE
	CAIN	S1,'REW'		;REWIND?
	TXOA	S2,TI.BOT		;POSITIONING TO BOT (SKIP TO ZAP LEOT)
	CAIN	S1,'UNL'		;UNLOAD?
	TXZ	S2,TI.LET		;CLEAR LEOT
	MOVEM	S2,TCB.IO(B)		;UPDATE STATUS
	PUSHJ	P,T$CLRS		;CLEAR ANY PENDING I/O ERRORS
	HLRZ	P1,P2			;PUT FUNCTION IN P1
	LOAD	P2,TCB.FU(B),TF.DVH	;GET THE CHANNEL NUMBER
	MOVE	P3,[2,,P1]		;LOAD ARG POINTER
	CAXN	P1,.TFUNL		;ABOUT TO DO UNLOAD?
	SETOM	G$UNL##			;YES, SET FLAG FOR OFFLINE TRAP
	TAPOP.	P3,			;AND DO IT
	  SKIPA	S1,TCB.PI(B)		;FAILED - GET PSI WORD
	JRST	POS.5			;ONWARD
	TXNE	S1,PS.RDH		;HUNG DEVICE?
	PJRST	TAPHNG			;YES
	HRRZS	P1			;ISOLATE FUNCTION CODE
	CAIN	P1,.TFDSE		;DATA SECURITY ERASE?
	$RETF				;EASY ONE TO HANDLE
	TXNE	S1,PS.RDO		;UNIT OFF-LINE?
	JRST	POS.6			;YES
	 $STOP	(PRF,Positioning Request Failed)

POS.6:	CAXE	P1,.TFREW		;Were we doing a rewind?
	 JRST	POS.5			;No, continue, else give it another try
	SETZM	TCB.PI(B)		;Clear the PSI word
	SETZM	TCB.WS(B)		;Clear the wait state
	MOVE	P3,[2,,P1]		;Get a pointer to try rewinding again
	LOAD	P2,TCB.FU(B),TF.DVH	;Get the channel number
	MOVX	P1,.TFREW		;Get the rewind code
	TAPOP.	P3,			;Do it
	  JFCL				;Let following catch error
POS.5:	SETZM	G$UNL##			;CLEAR 'UNLOADING' FLAG
	MOVX	S1,TS.NTP		;GET NO TAPE PRESENT BIT
	CAXN	P1,.TFUNL		;WAS IT AN UNLOAD?
	IORM	S1,TCB.ST(B)		;YES, SET APPROPRIATE FLAG
	CAXE	P1,.TFUNL		;WAS IT AN UNLOAD?
	CAXN	P1,.TFREW		;DOING A REWIND
	$RETT				;DON'T WAINT ON ERROR
	CAXE	P1,.TFFSF		;Skip file?
	CAXN	P1,.TFBSF		;or backspace file?
	PUSHJ	P,G$OJOB##		;Yes, that'll take a while, service
					; other tape requests
	PUSHJ	P,T$WAIT		;Wait for things to settle down
	MOVX	S1,.FOGET		;FILOP code to pull GETSTS
	PUSHJ	P,T$FILOP		;Get the bits
	MOVE	P1,S2			;Save status bits
	PUSHJ	P,T$CLRS		;Go clear the status
	MOVE	S1,TCB.IO(B)		;GET I/O STATUS WORD
	TRNE	P1,IO.EOF		;EOF?
	TXO	S1,TI.EOF		;YES
	TRNE	P1,IO.BOT		;BOT?
	TXO	S1,TI.BOT		;YES
	MOVEM	S1,TCB.IO(B)		;UPDATE I/O STATUS WORD
	TRNN	P1,IO.EOF!IO.BOT	;ANY INTERESTING BITS?
	JRST	POS.3			;NO
	MOVX	P2,CL.OUT		;Get suppress output close bit
	IORM	P2,TCB.FI(B)		;Turn it on,
	MOVX	S1,.FOCLS		;FILOP code to CLOSE
	PUSHJ	P,T$FILOP		;Close input side, clearing EOF
	ANDCAM	P2,TCB.FI(B)		;Clear the suppress output close bit
POS.3:	TRNN	P1,IO.IMP!IO.DER!IO.DTE ;ANY OTHER ERRORS? (IGNORE IO.BKT)
	$RETT				;NO, RETURN
	PJRST	RETERR			;STORE ERROR IN G$TERM AND RETURN

;POSITIONING FUNCTION TABLE   XWD TAPOP FUNCTION,SIXBIT CODE

PFUNCT:	XWD	.TFREW,	'REW'	;REWIND
	XWD	.TFUNL,	'UNL'	;UNLOAD
	XWD	.TFFSB,	'SBL'	;SKIP ONE BLOCK
	XWD	.TFFSF,	'SFL'	;SKIP ONE FILE
	XWD	.TFSLE,	'EOT'	;SKIP TO LOGICAL END OF TAPE
	XWD	.TFBSB,	'BBL'	;BACKSPACE ONE BLOCK
	XWD	.TFBSF,	'BFL'	;BACKSPACE ONE FILE
	XWD	.TFDSE,	'DSE'	;DATA SECURITY ERASE
PFUNCN=.-PFUNCT		;LENGTH OF POSITIONING DISPATCH TABLE

SUBTTL	Tape I/O Routines


	INTERN	T$WRTM			;WRITE A TAPE MARK
	INTERN	T$WRRC			;WRITE A RECORD
	INTERN	T$RDRC			;READ A RECORD
	INTERN	T$CLOS			;DO A CLOSE OUTPUT

SUBTTL	T$WRTM -- Write a Tape Mark

;CALLED TO WRITE A TAPE MARK.

T$WRTM:	$TRACE	(T$WRTM,6)
	$CALL	.SAVE2			;SAVE P1 AND P2
	MOVX	S1,<TI.EOT!TI.EOF>	;GET BITS FOR EOT AND EOF
	ANDCAM	S1,TCB.IO(B)		;   AND CLEAR THEM
	MOVEI	P1,.TFWTM		;GET TAPOP FUNCTION
	LOAD	P2,TCB.FU(B),TF.DVH	;GET THE CHANNEL NUMBER
	MOVE	S1,[2,,P1]		;LOAD ARG POINTER
	TAPOP.	S1,			;DO IT
	  CAIN	S1,TPWWL%		;WRITE LOCKED TAPE?
	JRST	WRTM.1			;ANALYZ I/O STATUS
	$STOP	(CWT,Can't Write Tape-mark)

WRTM.1:	MOVX	S1,.FOGET		;FILOP code to GETSTS
	PUSHJ	P,T$FILOP		;Get it
	MOVE	P1,S2			;Get is status
	TRNN	P1,IO.DTE!IO.DER!IO.IMP	;ANY ERRORS?
	 $RETT				;NO, JUST RETURN
	PUSHJ	P,T$CLRS		;Clear the error status
	PJRST	RETERR			;STORE ERROR AND RETURN

SUBTTL	T$WRRC -- Write A Record

;CALLED TO WRITE A RECORD ON TAPE

T$WRRC:	$TRACE	(T$WRRC,6,,<MOVEI S1,TCB.WB(B)
			    TLO   S1,(POINT 8,0)
			    $TEXT (,<^M^J^Q/S1/>)>)
	$CALL	.SAVE1			;SAVE A REGISTER
	MOVX	S1,<TI.EOT!TI.EOF>	;GET BITS FOR EOT AND EOF
	ANDCAM	S1,TCB.IO(B)		;   AND CLEAR THEM
	MOVX	S1,.FOOUT		;FILOP code to do an OUT
	PUSHJ	P,T$FILOP		;Write the buffer
	SKIPF				;Any errors?
	 $RETT				;NO ERRORS, GIVE GOOD RETURN
	MOVE	P1,S2			;Save the error bits
	PUSHJ	P,T$CLRS		;Clear out the error bits
	MOVX	S1,TI.EOT		;OPERATION SAW EOT BIT
	TRNE	P1,IO.EOT		;DID IT?
	  IORM	S1,TCB.IO(B)		;YES, TURN IT ON IN TCB
	TRNN	P1,IO.IMP!IO.DER!IO.BKT!IO.DTE ;ANY ERRORS?
	 $RETT				;NO, GIVE GOOD RETURN
	PJRST	RETERR			;STORE ERRORS AND RETURN

SUBTTL	T$RDRC -- Read A Record

;CALLED TO READ A RECORD FROM MAGTAPE

T$RDRC:	$CALL	.SAVE3			;SAVE SOME REGS
	LOAD	S1,TCB.IO(B),TI.DEC	;GET THE DO DEC COMPAT IO BIT
	JUMPE	S1,RDRC.1		;DON'T CHANGE MODE IF NOT ON
	LOAD	P2,TCB.DN(B)		;GET NAME RETURNED BY LABEL GET
	MOVEI	P1,.TFMOD+.TFSET	;ARG TO TAPOP TO SET MODE
	MOVEI	P3,.TFMDD		;DEC COMPATIBLE MODE
	MOVE	S1,[3,,P1]		;AC FOR TAPOP.
	TAPOP.	S1,			;SET THE MODE
	 $STOP	(CSM,Can't Set DIGITAL compatible Mode)
RDRC.1:	MOVX	S1,<TI.EOT!TI.EOF>	;GET BITS FOR EOT AND EOF
	ANDCAM	S1,TCB.IO(B)		;   AND CLEAR THEM
	MOVX	S1,.FOINP		;FILOP code to do INPUT
	PUSHJ	P,T$FILOP		;Read next block
	SKIPF				;OK?
IFE FTTRACE,<  $RETT	>	;ALL IS WELL
IFN FTTRACE,<  JRST	RDRC.9>
	MOVE	P1,S2			;Save the error bits
	TRNN	P1,IO.IMP!IO.DER!IO.DTE!IO.EOF!IO.BKT ;ANY IO ERRORS?
	 $RETT				;NO, JUST FINISH UP
	PUSHJ	P,T$CLRS		;Clear the bits
	TRNN	P1,IO.EOF		;END OF FILE?
	  JRST	RDRC.3			;NO, PROCEED
	MOVX	S1,TI.EOF		;SAY END OF FILE SEEN 
	IORM	S1,TCB.IO(B)		;IN THE TCB
	MOVX	P2,CL.OUT		;Get suppress output close bit
	IORM	P2,TCB.FI(B)		;Light in FILOP block
	MOVX	S1,.FOCLS		;FILOP code to CLOSE
	PUSHJ	P,T$FILOP		;Close the input side of tape
	ANDCAM	P2,TCB.FI(B)		; to clear EOF. Clear suppress bit
RDRC.3:	TRNE	P1,IO.IMP!IO.DER!IO.DTE	;ANY IO ERRORS?
	  PJRST	RETERR			;YES, STORE ERROR AND RETURN
RDRC.9:	$TRACE	(T$RDRC,6,,<MOVEI S1,TCB.IB(B)
			    TLO   S1,(POINT 8,0)
			    $TEXT (,<^M^J^Q/S1/>)>)
	 $RETT				;NO, RETURN NOW

SUBTTL	T$CLOS -- Close Output

;CALLED TO DO A CLOSE OUTPUT AFTER WRITING LABELS

T$CLOS:	$TRACE	(T$CLOS,6)
	$CALL	.SAVE3			;SAVE SOME REGS
	SETZM	TCB.FI(B)		;Clear Status bits
	MOVX	S1,<TI.EOT!TI.EOF>	;GET BITS FOR EOT AND EOF
	ANDCAM	S1,TCB.IO(B)		;   AND CLEAR THEM
	MOVX	S1,.FOCLS		;FILOP code to close channel
	PUSHJ	P,T$FILOP		;Finished with the device
	MOVX	S1,.FOWAT		;Want to wait for I/O to finish
	PUSHJ	P,T$FILOP		;   So do it...
	MOVX	S1,.FOGET		;FILOP code to GETSTS
	PUSHJ	P,T$FILOP		;Read the error bits
	MOVE	P1,S2			;Pick bits out of FILOP block
	TRNE	P1,IO.IMP!IO.DER!IO.DTE	;ANY ERRORS?
	  PJRST	RETERR			;YES, STORE ERROR AND RETURN
	$RETT				;NO,,RETURN

SUBTTL	Special Purpose Routines

;This routine takes a device name in S1.
;PULSAR doesn't know about this device, but assumedly, it is a magtape.
;This routine will try to get the user out of event wait by getting
;and releasing the label DDB.

T$LGET:: $TRACE	(T$LGET,6,S1)
	MOVEI	T1,.TFLRL		;FUNCTION FOR LABEL RELEASE
	MOVE	T2,S1			;COPY DEVICE NAME TO T2
	MOVE	T3,G$TERM##		;TERMINATION CODE
	MOVE	T4,[3,,T1]		;AC FOR TAPOP
	TAPOP.	T4,			;DO THE LABEL RELEASE
	JFCL				;Oh well, user loses
	MOVEI	T1,.TFLDD		;LABEL DESTROY
	MOVE	T3,[2,,T1]		;AC FOR TAPOP
	TAPOP.	T3,			;DESTROY USELESS DDB
	JFCL				;OH WELL, WE TRIED !!!
	$RETT				;RETURN

;HERE TO CHECK WRITE RING STATUS OF TAPE.
;TAPE HAS BEEN REWOUND.
;RETURNS S2=1 IF TAPE IS WRITE-LOCKED (RING OUT), S2=0 IF NOT

T$WRCK:: $CALL	.SAVET			;SAVE SOME REGISTERS
	MOVEI	T1,.TFWLK		;TAPOP. FUNCTION
	LOAD	T2,TCB.FU(B),TF.DVH	;GET DEVICE TO USE
	MOVE	T3,[2,,T1]		;AC FOR TAPOP.
	TAPOP.	T3,			;GET THE STATUS FROM THE TAPE
	 $STOP	(CCR,Can't Check Ring status)
	MOVE	S2,T3			;COPY RETURNED ANSWER TO S2
	$RETT				;RETURN

SUBTTL	T$FILOP	- Routine to pull a FILOP for the TCB

;Call with S1/ FILOP function code
;		B/ TCB addrs
;Returns - TRUE if FILOP skips
;	FALSE if FILOP loses on an IN or OUT
;	If the FILOP loses and we aren't doing IN or OUT, T$FILOP $STOPs
;	For function .FOGET, the IO status bits are returned in S2
;	If and IN or OUT fails, the IO status bits come back in S2 also

T$FILOP::
	STORE	S1,TCB.FU(B),RHMASK	;Stash desired opcode

FILO.0:	SETZM	S2			;CLEAR S2
	CAXN	S1,.FOINP		;Doing input ?
	MOVEI	S2,TCB.IC(B)		;Yes, get input CCW list address
	CAXN	S1,.FOOUT		;Doint output ?
	MOVEI	S2,TCB.OC(B)		;Yes, get output CCW list address
	SKIPE	S2			;Still null,,don't set
	MOVEM	S2,TCB.FI(B)		;Save the CCW
	HRRI	S2,TCB.FB(B)		;Aim at block
	HRLI	S2,FLPLEN		;And set the length
	CAXE	S1,.FOINP		;Doing input
	 CAXN	S1,.FOOUT		; or output
	  TRNA				; No, don't wait
	JRST	FILO.1			;Don't bother waiting & lenght ok
	PUSHJ	P,T$WAIT		;Yes, wait for any positioning
	HRLI	S2,2			;The block lenght must now be 2
FILO.1:	FILOP.	S2,			;Do the work
	  SKIPA				;No, see if we can hack it
	$RETT				;Wins, so does caller
	MOVEI	TF,0			;CLEAR AC
	EXCH	TF,TCB.PI(B)		;GET INTERRUPT BITS AND CLEAR
	TRNN	TF,PS.RDO!PS.RDH	;OFF-LINE OR HUNG?
	$RETF				;MUST BE A REAL I/O ERROR
	TRNE	TF,PS.RDH		;HUNG DEVICE?
	JRST	TAPHNG			;YES
	TRNE	TF,PS.RDO		;OFF-LINE?
	JRST	TAPOFL			;YES
	$RETF				;SHOULDN'T GET HERE

TAPOFL:	MOVX	S1,TS.NTP		;GET NO TAPE PRESENT BIT
	IORM	S1,TCB.ST(B)		;SET FOR OPR NOTIFY
	PUSHJ	P,O$STAT##		;TELL THE OPERATOR
	MOVX	S1,TS.INI		;GET THE INITIALIZATION BIT
	TDNE	S1,TCB.ST(B)		;DOING THAT?
	JRST	TAPINI			;WAIT FOR DRIVE TO COME ONLINE
	MOVE	S1,TCB.DV(B)		;GET DEVICE NAME
	PUSHJ	P,T$CKAV		;SEE IF IN USE
	JUMPT	TAPKIL			;NO--KILL OFF THE TCB
	PUSH	P,TCB.FU(B)		;SAVE FILOP FUNCTION WORD
	PUSH	P,TCB.FI(B)		;AND I/O STATUS WORD
	PUSHJ	P,T$CLRS		;CLEAR ANY I/O ERRORS
	POP	P,TCB.FI(B)		;RESTORE
	POP	P,TCB.FU(B)		; ...
	JRST	TAPINI			;AND TRY AGAIN LATER
TAPHNG:	MOVEI	S1,LE.DER		;DEVICE
	MOVEM	S1,G$TERM##		; ERROR
	MOVX	S1,TS.SLR		;MAKE SURE USER GETS TERMINATION CODE
	ANDCAM	S1,TCB.ST(B)		; BY INSURING WE DO A LABEL RELEASE
	$WTO	(<Hung device>,,TCB.OB(B),$WTFLG(WT.SJI))
TAPKIL:	PUSHJ	P,T$RELE		;Clean up
	MOVX	S1,TS.KIL		;Get kill bit
	IORM	S1,TCB.ST(B)		;Lite so we flush this TCB
	PUSHJ	P,G$NJOB##		;Go away
	$STOP	(RKM,<Running a killed magtape TDB>)

TAPINI:	PUSHJ	P,G$NJOB##		;RUN ANOTHER JOB WHILE WE WAIT
	LOAD	S1,TCB.FU(B),RHMASK	;GET THE FILOP FUNCTION
	JRST	FILO.0			;AND TRY AGAIN

SUBTTL	T$CLRS - Clear IO status bits

;Call with B pointing to TCB.
;This routine will reset the IO status for that device
;The device must be OPENed on some channel

T$CLRS::
	MOVX	S1,UU.DEL+.IODMP	;Get bit to disable error logging
	MOVEM	S1,TCB.FI(B)	 	;Save in TCB's FILOP block
	MOVX	S1,.FOSET		;code to set IO status
	PJRST	T$FILOP			;Do it, and return

SUBTTL	T$WAIT - Wait until I/O is done

;This routine will wait for I/O is complete in an attempt to put a
;stop to those annoying tape label problems that happen
;"once every two days when the moon is 3/4 full."
;Call:	(B) = TCB address

T$WAIT::PUSHJ	P,.SAVE3		;Save some regs
	MOVX	P1,.TFWAT		;Get the wait function
	LOAD	P2,TCB.FU(B),TF.DVH	;Get the channel number
	MOVE	P3,[XWD 2,P1]		;Get the arg pointer
	TAPOP.	P3,			;Do it
	 $RETF				;Shouldn't happen
	$RETT

SUBTTL	Buffer builder and releaser routines

;MAKBUF - Routine to build input and output buffer rings for a TCB
;Call - with TCB addrs in B
;Return - True always

MAKBUF:	MOVX	S1,FO.ASC		;WE WILL WANT EXTENDED CHANNELS
	MOVEM	S1,TCB.FU(B)		;   SO SET THAT
	MOVEI	S1,TCB.IB(B)		;GET INPUT BUFFER ADDRESS
	ADD	S1,[IOWD BFRSIZ+1,0]	;GEN AN INPUT CCW
	MOVEM	S1,TCB.IC(B)		;GEN INPUT COMMAND LIST
	MOVEI	S1,TCB.WB(B)		;GET OUTPUT BUFFER ADDRESS
	ADD	S1,[IOWD BFRSIZ+1,0]	;GEN AN OUTPUT CCW
	MOVEM	S1,TCB.OC(B)		;GEN OUTPUT COMMAND LIST
	$RETT				;RETURN

SUBTTL	Translate IO Error into Extended Error
SUBTTL	Routine to Decode Error and Return

;ALWAYS CALLED WITH P1 CONTAINING THE IO STATUS WITH ONE OF 
;	IO.IMP, IO.DTE, OR IO.DER ON.
;	STORES THE CORRECT CODE INTO G$TERM AND
;	RETURNS FALSE

RETERR:	TXNN	P1,IO.DTE!IO.DER!IO.IMP	;ANY ERROR BIT ON?
	$STOP	(NEB,No Error Bit)
	TXNE	P1,IO.DTE		;DATA ERROR?
	MOVEI	S1,.TFTDE		;YES, RETURN DATA ERROR CODE FOR TAPOP
	TXNE	P1,IO.DER		;DEVICE ERROR?
	MOVEI	S1,.TFTDV		;YES, RETURN DEVICE ERROR CODE FOR TAPOP
	TXNE	P1,IO.IMP		;WRITE LOCK ERROR?
	MOVEI	S1,.TFTWL		;YES, RETURN WRITE LOCK ERROR CODE FOR TAPOP
	MOVEM	S1,G$TERM##		;SAVE TO RETURN TO USER
	$RETF				;RETURN FALSE

	END