Google
 

Trailing-Edge - PDP-10 Archives - BB-JR93N-BB_1990 - 10,7/unsmon/dtaser.mac
There are 9 other files named dtaser.mac in the archive. Click here to see a list.
TITLE	DTASER - NEW FORMAT DECTAPE SERVICE FOR  TD-10(PDP-10) - V640
SUBTTL	T. WACHS/CHW/RCC/CMF/TW  17 APRIL 90
	SEARCH	F,S
	$RELOC
	$HIGH


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
;  OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1973,1974,1975,1976,1977,1978,1979,1980,1982,1984,1986,1988,1990.
;ALL RIGHTS RESERVED.

.CPYRT<1973,1990>


XP VDTASR,640			;DEFINE GLOBAL VERSION NUMBER FOR LOADER MAP.

DTASER::ENTRY	DTASER		;SO LOADER WILL GET DTASER WHEN IN /L MODE
	SUBTTL	DEFINITIONS

DIRBLK==^D100			;NUMBER OF BLOCK FOR DIRECTORY

TOPBLK==1101			;HIGHEST LEGAL BLOCK NUMBER
NAMSTR==^D83			;1ST NAME WORD IN DIRECTORY
QUANT==3			;NUMBER OF BLOCKS CAN READ BEFORE GIVING UP DTC
MINDIS==14			;MINIMUM NUMBER OF BLOCKS TO SEARCH BEFORE
				; DISCONNECTING	FROM A TAPE
SPACE==4			;NUMBER OF BLOCKS SEPARATING CONTIGUOUS BLOCKS
				; OF A FILE
IFNDEF CPBIT,<CPBIT==-1>

;FLAGS IN RH OF IOS
UDSD==100
UDXX==200

;FLAGS IN LH OF IOS
IOSLEP==IOBEG
REDOIO==100
NOLINK==200
CHNGDR==400
RVERSE==1000
SINGL==2000			;JUST READ OR WRITE 1 BLOCK
DMPMOD==4000
RWDIR==10000
DMPCLS==20000
NOBUF==40000			;DATA GOING DIRECTLY INTO USER AREA
NOBUFC==737777			;-NOBUF
REWBIT==100000
RUNBIT==200000
RECKON==400000			;THIS TAPE IS DEAD-RECKONING.
				; (MUST BE SIGN BIT)
	SUBTTL	INITIALIZATION

;SUBROUTINE TO INITIALIZE DTC

DTAINI:	XMOVEI	F,DTADDB##	;FIRST DDB
DTAINA:	LDB	T1,PDVTYP##	;DEVICE TYPE
	CAIE	T1,.TYDTA	;DECTAPE?
	JRST	DTAINB		;NO
	XMOVEI	T1,DTADIR##(F)	;ADDRESS OF DIRECTORY BLOCK
	MOVEM	T1,DLOC##(F)	;STORE
	HLRZ	F,DEVSER(F)	;LINK TO NEXT DDB
	JUMPN	F,DTAINA	;LOOP

DTAINB:	MOVEI	F,DTADDB##	;START AT FIRST CONTROL
DTAIN0:
IFN FTMP,<
	LDB	T1,DEYCPF##	;CONTROL ON THIS CPU?
	CAME	T1,.CPCPN##	
	JRST	DTAIN1		;NO
>; END IFN FTMP
	XCT	DTXINI##(F)	;CLEAR THE TD10
	SETZM	DSCON##(F)	;ZERO SOME FLAGS
	SETZM	LVFLAG##(F)	
	SETZM	USEWRD##(F)	
DTAIN1:	ADDI	F,DCONS##	;STEP TO NEXT CONTROL
	CAIGE	F,KONEND##	;AT END?
	JRST	DTAIN0		;NO, CLEAR NEXT CONTROL
	POPJ	P,		;YES, EXIT
	SUBTTL	UUO LEVEL DISPATCH TABLE

	JRST	CPOPJ1##	;IT'S ONLINE
	JRST	DVPDTA		;DEVOP. UUO
	JRST	REGSIZ##	;SIZE CAN BE GOTTEN FROM DDB
	JRST	DTAINI		;INITIALISE DECTAPE CONTROL(S)
	JSP	T2,DTSCON	;HUNG TAPE
DTADSP::JSP	T2,DTSCON	;UREL - RELEASE UUO
	JSP	T2,DTSCON	;UCLS - CLOSE UUO
OUTB:	JSP	T2,DTSCON	;UOUT - OUTPUT OR OUT UUOS
	JSP	T2,DTSCON	;UIN  - INPUT OR IN UUOS
	JSP	T2,DTSCON	;ENTR - ENTER UUO
	JSP	T2,DTSCON	;LOOK - LOOKUP UUO
OUTD:	JSP	T2,DTSCON	;DMPO - OUTPUT UUO, DUMP MODE
	JSP	T2,DTSCON	;DMPI - INPUT M, DUMP MODE
	JRST	SETO		;SETO - SET OUTPUT BLOCK NUMBER
	JRST	SETI		;SET INPUT BLOCK NUMBER
	JSP	T2,DTSCON	;GETF - GET NEXT FREE BLOCK NUMBER
	JSP	T2,DTSCON	;RENAM- RENAME UUO
	JRST	ICLS		;CLOSE INPUT
	JSP	T2,DTSCON	;UTPCLR - CLEAR DIRECTORY
	JSP	T2,DTSCON	;MTAP - UUOTAPE M


	HUNGTP
DISTAB:	UREL
	UCLS
	UOUT
	UIN
	ENTR
	LOOK
	DMPO
	DMPI
ONEONE:	XWD	1,1
	-177
	GETF
	RENAM
	XWD	-26,NAMSTR
	Z	UTPCLR
	MTAP

DISDIS==DISTAB-DTADSP-1
	SUBTTL	GENERAL UUO LEVEL ROUTINES

DTSCON:	PUSH	P,W		;SAVE W FOR UUOCON
	SKIPA	W,[DTADDB##]	;ADDRESS OF 1ST CONTROL BLOCK
DTNCON:	ADDI	W,DCONS##	;POINT TO FIRST OR NEXT CONTROL BLOCK
	MOVE	T1,DTXDDB##(W)	;FETCH THE NAME OF ITS DECTAPES
	XOR	T1,DEVNAM(F)	;COMPARE IT WITH UNIT ASSOC WITH M
	TLNE	T1,-1		;RIGHT FAMILY?
	JRST	DTNCON		;NO- CHECK NEXT CONTROL
	XCT	DTSCNI##(W)	;READ STATUS INTO T4
	XCT	DXCCNT##(W)	;READ FLAGS INTO T1
	HRLI	W,(T1)		;PUT INTO LH W
	PUSHJ	P,@DISDIS(T2)	;DISPATCH TO ROUTINE
	SOS	-1(P)		;STRAIGHT RETURN - COMPENSATE CPOPJ1
	POP	P,W		;RESTORE W FOR UUOCON
	JRST	CPOPJ1##	;RETURN TO UUOCON


MTAP:	HRRZ	T2,M		;MTAPE - GET OPERATION
	CAIE	T2,1		;REWIND OR
	CAIN	T2,11		;REWIND UNLOAD ARE LEGAL
	SOJA	T2,MTAP0
	POPJ	P,		;OTHERS ARE NO-OPS


;CLOSE INPUT DISPATCH

ICLS:	TLNE	F,LOOKB		;LOOKUP PERFORMED?
	HRRZS	IBLK##(F)	;CLEAR INDEX OF INPUT FILE
	POPJ	P,
	SUBTTL	LOOKUP

;LOOKUP A DIRECTORY ENTRY

LOOK:	TRNE	S,UDSD		;NON-STANDARD?
	JRST	CPOPJ1##	;YES. LOOKUP OK
	PUSHJ	P,DTRCHK	;MAKE SURE TAPE NOT REWINDING
	PUSHJ	P,DSERCH	;NO. FIND DIRECTORY ENTRY
	  AOJA	M,CPOPJ##	;NOT THERE
	HRRZ	T2,26(T3)	;GET DATE, NO. OF 1K BLOCKS NEEDED
	AOS	M		;POINT UUO TO WORD 3
	PUSHJ	P,STORT2
	HLRE	T1,T3		;GET INDEX
	ADDI	T1,27
	SKIPN	FSTBLK##(F)	;TAPE BEING WRITTEN?
	HRLM	T1,OBLK##(F)	;NO. SAVE INDEX FOR POSSIBLE OUTPUT
	HRLM	T1,IBLK##(F)	;SAVE INDEX FOR TEST OF
				;ENTER OF SAME FILE.
	PUSHJ	P,BLKSRC	;COUNT NUMBER OF BLOCKS IN FILE
	JRST	BDDIR		;NO MENTION OF BLOCK IN DIRECTORY!
	MOVEI	T2,1		;SET T2 TO COUNT BLOCKS
	PUSHJ	P,BLKSRB	;FIND NEXT MENTION IN DIRECTORY
	  AOSA	M		;DONE. POINT TO E+3
	AOJA	T2,.-2		;COUNT AND LOOK FOR NEXT

;T2 HAS THE NUMBER OF BLOCKS BELONGING TO THE FILE

	IMUL	T2,[-177]	;-NUMBER OF WORDS IF ALL BLOCKS FULL
	JUMPL	M,[MOVMS T2	;GET +VE NUMBER OF WORDS IF EXTENDED UUO
		   JRST  .+2]	;CONTINUE
	HRLZS	T2		;SET TO STORE
	PUSHJ	P,STORT2	;STORE IN DIRECTORY WD 4
	SUBI	M,2		;POINT UUO TO DIRECTORY WD 2
	TLZ	S,IO		;MAKE SURE IO IS OFF
	MOVEI	J,DIRBLK	;NO. FIND FIRST MENTION OF BLOCK
	PUSHJ	P,LSTFRE+1	;NEAR DIRECTORY
	JUMPN	J,LOOKE		;FOUND IF J NOT =0
	PUSHJ	P,BLKSRC	;FIND FIRST MENTION IN DIRECTORY
	  JRST	BDDIR		;NOT THEERE - ERROR
LOOKE:	PUSHJ	P,GETDT		;GET DECTAPE CONTROL
	MOVE	T1,[-1,,BLKWRD##];GET IOWD TO READ 1ST WORD
	ADDI	T1,(W)		;RELOCATE FOR RIGHT CONTROL
	MOVEM	T1,DMPLST##(F)	;SAVE IT IN THE DDB
	TLO	S,SINGL		;JUST READ 1 RECORD
	PUSHJ	P,READBC	;GO READ THE BLOCK
				;(CANT GO TO RDBLUK SINCE RWAIT MIGHT RETURN HERE)
	PUSHJ	P,RWAIT		;WAIT TILL IT'S IN
	SETZM	DMPLST##(F)
	PUSHJ	P,GETWDU##	;GET USER'S EXTENSION
	HRR	T1,IBLK##(F)	;GET FIRST BLOCK OF FILE
	SKIPN	FSTBLK##(F)	;IF FILE HAS NOT BEEN ENTERED
	HRRZM	T1,FSTBLK##(F)	;SAVE IN DDB
	HLLM	T1,DEVEXT(F)	;SAVE EXTENSION IN DDB FOR
				; RENAME AND SUPERSEDING SHARED SEGMENTS
	HLRZ	T2,IBLK##(F)
	ADD	T2,DLOC##(F)	;POINT TO DIRECTORY
	MOVEI	T3,1		;BIT FOR EXTENDED DATES
	TDNE	T3,-1(T2)	;EXTENDED BITS ON?
	TRO	T1,100000
	TDNE	T3,^D21(T2)
	TRO	T1,200000
	TDNE	T3,^D43(T2)
	TRO	T1,400000
	PUSHJ	P,PUTWDU##	;STORE EXTENSION AND BLOCK
				; NUMBER IN USER'S AREA
	JRST	CPOPJ1##	;AND TAKE GOOD EXIT
;STORE T2 IN USERS AREA (PRESERVES T1 AND T2)
STORT2:	EXCH	T1,T2		;PUT ARG IN T1 FOR PUTWDU
	PUSHJ	P,PUTWDU##	;STORE T1
	EXCH	T1,T2		;RESTORE T1 AND T2
	POPJ	P,		;AND RETURN
	SUBTTL	RENAME

RENAM:	TLO	F,RENMB
	PUSHJ	P,DSER1		;SEARCH FOR OLD NAME
	  AOJA	M,RENER1	;NOT FOUND - ERROR
	SUBI	M,1		;FOUND. RESET M
	PUSHJ	P,GETWDU##	;GET FILE NAME
	JUMPE	T1,RENAM0	;NOT EXTENDED IF 0
	TLNE	T1,-1		;EXTENDED?
	JRST	RENAM0		;NO
	ADDI	M,2		;YES
	PUSHJ	P,GETWDU##	;GET NAME
RENAM0:	EXCH	T1,T3		;RESTORE T1, NEW NAME IN T3
	JUMPN	T3,RENAM2	;NOT RENAMING TO 0 IF IT GOES
	SETZM	(T1)		;YES. DELETE NAME IN DIR
	SETZM	26(T1)		;DELETE EXTENSION
	SETZM	DEVFIL(F)	;ZERO DEVFIL
	HLRE	T1,T1		;GET INDEX OF FILE
	ADDI	T1,27
	PUSHJ	P,DLETE		;DELETE ALL BLOCKS OF FILE
RENAM1:	TLO	S,CHNGDR	;DIRECTORY HAS CHANGED
	TLO	F,RENMB		;INDICATE RENAME
	PUSHJ	P,JDAADR##
	HLLM	F,(T1)		;SAVE THE BITS
	AOS	(P)		;SET FOR GOOD RETURN
	SETZM	IBLK##(F)	;IF ICLS NOT CALLED, NEXT ENTER SHOULD WIN
	JRST	STOIOS##	;GO TO USER

;COME HERE TO RENAME TO A REAL NEW NAME

RENAM2:	MOVE	U,T1		;SAVE LOC OF NAME IN DIRECTORY
	PUSH	P,T3		;SAVE NEW NAME
	PUSHJ	P,DSERCH	;SEARCH FOR NEW NAME
	  CAIA			;NEW NAME DOESN'T EXIST - OK
	SOJA	M,RENAM3	;NEW NAME ALREADY EXISTS
	POP	P,(U)
	PUSHJ	P,GETWD1##
	HLLM	T1,26(U)	;SAVE IN DIR
	HLLM	T1,DEVEXT(F)	;SAVE INN DDB
	JRST	RENAM1		;GIVE GOOD RETURN TO USER
RENAM3:	POP	P,T1		;POP OFF NEW NAME
	CAMN	U,T3		;DOES NEW NAME=OLD NAME?
	JRST	CPOPJ1##	;YES, JUST CHANGING "PROTECTION" - OK
	JRST	RENER2		;NO, CAN'T RENAME TO AN EXISTING NAME

RENER1:	TDZA	T3,T3		;RH E+1 =0
RENER2:	MOVEI	T3,4		;RH E+1 =4
STOERR:	PUSHJ	P,GETWD1##	;GET SECOND WORD
	HRR	T1,T3		;SET ERROR CODE
	PJRST	PUTWDU##	;STORE IT FOR THE USER
;SEARCH DIRECTORY FOR A MATCH

DSERCH:	TLZ	F,RENMB		;NOT RENAM-LOOKUP
DSER1:	PUSHJ	P,DIRCHK	;ENSURE DIRECTORY IS IN CORE
	HRRZ	T3,DLOC##(F)	;LOCATION OF DIRECTORY
	ADD	T3,[XWD -26,NAMSTR]	;POINT TO START OF NAMES
NMLOOK:	TLNE	F,RENMB		;RENAME
	SKIPA	T1,DEVFIL(F)	;YES, GET OLD NAME
NMLOO1:	PUSHJ	P,GETWDU##	;NO
	JUMPE	T1,CPOPJ##	;NULL ARGUMENT - ERROR RETURN
	SKIPL	M		;FIRST TIME THROUGH?
	TLNE	T1,-1		;EXTENDED ARGUMENT LIST?
	JRST	NMLOO2		;NO, CONTINUE
	TLNE	F,RENMB		;RENAME?
	JRST	NMLOO2		;YES
	ADDI	M,2		;POINT TO FILE NAME
	TLO	M,400000	;INDICATE THAT WE HAVE BEEN HERE ONCE
	JRST	NMLOO1		;GO GET FILE NAME FROM EXTENDED BLOCK
NMLOO2:	MOVEM	T1,DEVFIL(F)	;STORE FOR RENAME AND SUPERSEDING
				; SHARED SEGMENTS
	CAMN	T1,(T3)		;TEST FOR MATCH
	AOJA	M,NMFOUN	;FOUND NAME. CHECK EXTENSION
	AOBJN	T3,.-2		;TRY NEXT NAME
	POPJ	P,		;NOT FOUND
NMFOUN:	TLNE	F,RENMB		;RENAME?
	SKIPA	T1,DEVEXT(F)	;YES, GET NAME FROM DDB
	PUSHJ	P,GETWDU##	;NO, GET NAME FROM USER
	XOR	T1,26(T3)	;TEST AGAINST DIRECTORY EXTENSION
	TLNN	T1,-1		;MATCH?
	JRST	CPOPJ1##	;YES. RETURN
	AOBJP	T3,.+2
	SOJA	M,NMLOOK	;NO. TRY NEXT NAME
	SOJA	M,CPOPJ##	;NAME NOT FOUND

;CHECK IF DIRECTORY IS IN CORE. IF NOT, READ IT

DIRCHK:	TRNN	S,UDSD		;DONT BOTHER IF NON-STANDARD
	SKIPG	DEVMOD(F)	;IS IT IN?
	POPJ	P,		;YES. RETURN
	PUSHJ	P,RTNEVM##	;GIVE UP EVM WHILE IO IS RIGHT IN S
	TLZ	S,IO+RVERSE	;NO, HAVE TO READ IT (FORWARD)
	MOVEI	J,DIRBLK	;BLOCK NUMBER
	PUSHJ	P,GETDT		;GET CONTROL
	TLO	S,RWDIR		;JUST READ 1 BLOCK
	HRRZ	T1,DLOC##(F)	;LOC OF DIRECTORY
	HRLI	T1,-200		;READ 200 WORDS
	MOVEM	T1,DMPLST##(F)	;SAVE THE IOWD IN THE DDB
	PUSHJ	P,READBC	;GO READ IT
	PUSHJ	P,RWAIT		;WAIT TILL IN
	MOVSI	T2,DVDIRI	;SET DIRECTORY-IN-CORE BIT
	ORM	T2,DEVMOD(F)
	POPJ	P,
;SEARCH DIRECTORY FOR FILE WHOSE INDEX IS IN T1

BLKSRC:	MOVSI	U,(POINT 5)	;U IS A BLOCK POINTER
	HRR	U,DLOC##(F)
	MOVEI	J,1		;START AT BLOCK 1

BLKSRA:	ILDB	T3,U		;INDEX OF NEXT BLOCK
	CAMN	T1,T3		;MATCH?
	JRST	CPOPJ1##	;YES. RETURN

BLKSRB:	CAIGE	J,TOPBLK	;NO. SEARCHED LAST?
	AOJA	J,BLKSRA	;NO. TRY NEXT BLOCK
	POPJ	P,		;YES. RETURN

;SET UP POINTER TO DIRECTORY FOR BLOCK IN J
SETPTR:	PUSH	P,J		;SAVE J
	PUSHJ	P,DRPTR		;SET J AS A BYTE POINTER
	MOVE	U,J		;RETURN IT IN U
	PJRST	JPOPJ##		;RESTORE J AND RETURN

;GET NEXT AVAILABLE FREE BLOCK
;RESPECTS T1, T3
NXTFRE:	PUSH	P,T3		;SAVE T3
	PUSHJ	P,SETPTR	;SET U TO A BYTE POINTER
	MOVEI	T1,0		;LOOK FOR FREE BLOCKS
	PUSHJ	P,BLKSRA	;FIND A ZERO BLOCK
	  MOVEI	J,0		;NOT THERE- RETURN 0
	JRST	T3POPJ##	;RESTORE T3 AND RETURN

;GET PREVIOUS FREE BLOCK
LSTFRE:	MOVEI	T1,0		;SET TO LOOK FOR FREE BLOCKS
	PUSH	P,T3		;SAVE T3
	ADDI	J,2
	PUSHJ	P,SETPTR	;SET U AS A POINTER
	SUBI	J,2
LSTFR1:	PUSHJ	P,DECPTR	;DECREMENT BYTE POINTER
	LDB	T3,U		;INDEX TO BLOCK
	CAME	T3,T1		;FOUND?
	SOJG	J,LSTFR1	;TRY AGAIN IF NOT AT START
	JRST	T3POPJ##	;REACHED START - RETURN J=0

;DECREMENT BYTE POINTER

DECPTR:	JUMPL	U,DECPT1
	ADD	U,[BYTE (6) 5]	;DECREMENT
	JUMPG	U,CPOPJ##	;IF POSITIVE - SAME WORD
	HRLI	U,010500	;RESET TO PREVIOS WORD
	SOJA	U,CPOPJ##
DECPT1:	HRLI	U,060500
	SOJA	U,CPOPJ##
;COME HERE TO DELETE THE FILE WHOSE INDEX IS IN T1
DLETE:	MOVEI	T2,0		;SET TO DELETE BLOCKS
	PUSHJ	P,BLKSRC	;FIND A BLOCK BELONGING TO FILE
	JRST	CPOPJ##		;ALL THROUGH
	DPB	T2,U		;DELETE IT
	SOS	1(P)		;ADJUST PDL FOR RETURN
	AOBJN	P,BLKSRB	;AND FIND NEXT MATCH
	SUBTTL	ENTER

;ENTER A FILE NAME IN DIRECTORY
ENTR:	TRNE	S,UDSD		;NON STANDARD?
	JRST	CPOPJ1##	;YES. RETURN
	PUSHJ	P,DTRCHK	;MAKE SURE NOT REWINDING
	PUSHJ	P,GETWDU##	;LOOK AT FIRST ARGUMENT
	JUMPE	T1,CPOPJ##	;ZERO IS AN ERROR
	TLNE	T1,-1		;EXTENDED STY6 ENTER?
	JRST	ENTR1		;NO
	PUSH	P,M		;SAVE M
	ADDI	M,2		;POINT TO .RBNAM
	PUSHJ	P,GETWDU##	;GET THE FILE NAME
	JUMPE	T1,MPOPJ##	;ZERO IS ILLEGAL
	POP	P,M		;RESTORE M
ENTR1:	PUSHJ	P,DSERCH	;NO. LOOK FOR MATCH
	  JRST	NEWENT		;THIS IS A NEW ENTRY
;HERE FOR A NON-NEW NAME ON THE ENTER
ENTR2:	MOVE	T1,T3
	PUSHJ	P,GETWT2
	AOS	M		;POINT TO WORD 3
	HLLZ	T3,T2		;SAVE EXTENSION
	LSH	T2,-^D15
	DPB	T2,[POINT 3,T3,23]
	PUSHJ	P,GETWT2
	ANDI	T2,7777		;LH(E+2) UNUSED
	IOR	T2,T3
	TRNN	T2,77777	;IS DATE ALREADY THERE?
	IOR	T2,THSDAT##	;NO. ADD CURRENT DATE
	HLRE	T3,T1
	ADDI	T3,27
	ADD	T3,DLOC##(F)
	MOVEI	T4,1
	ANDCAM	T4,-1(T3)
	TRZE	T2,10000
	IORM	T4,-1(T3)
	ANDCAM	T4,^D21(T3)
	TRZE	T2,20000
	IORM	T4,^D21(T3)
	ANDCAM	T4,^D43(T3)
	TRZE	T2,40000
	IORM	T4,^D43(T3)
	MOVEM	T2,26(T1)	;INTO DIRECTORY
	MOVE	T4,OBLK##(F)	;IS THIS A SAVE FILE (UGETF DONE
				;BEFORE THE ENTER?)
	SUBI	M,2		;NO, POINT TO NAME
	PUSHJ	P,GETWT2
	MOVEM	T2,(T1)		;INTO DIRECTORY
	HLRE	T1,T1		;COMPUTE INDEX OF FILE
	ADDI	T1,27
	HLRZ	U,IBLK##(F)	;INDEX OF INPUT FILE
	SUB	U,T1		;WRITING SAME FILE AS READING?
	JUMPE	U,CPOPJ##	;TAKE ERROR RETURN IF YES
	DPB	T1,[POINT 17,OBLK##(F),17]	;SAVE INDEX IN DDB
	PUSHJ	P,DLETE		;DELETE ALL BLOCKS BELONGING TO FILE
	AOJE	T4,ENTRD	;FIND FIRST FREE BLOCK ON TAPE IF THIS
				;IS A SAVE FILE (UGETF DONE)
	MOVEI	J,DIRBLK	;NO. GET 1ST BLOCK CLOSE TO
	TLO	S,RVERSE	;DIRECTORY, GOING IN REVERSE
	PUSHJ	P,USLSTA
	CAILE	J,TOPBLK	;BLOCK LEGAL?
	JRST	ENTRE		;NO. ERROR RETURN
ENTRC:	MOVEM	J,FSTBLK##(F)	;SAVE AS 1ST BLOCK
	HRRM	J,OBLK##(F)	;SAVE IN DDB
	PUSHJ	P,GETWD1##	;GET EXTENSION
	HRR	T1,FSTBLK##(F)	;SET 1ST BLOCK NUMBER
	PUSHJ	P,PUTWDU##	;SAVE IT IN THE USER'S AREA
	MOVE	J,FSTBLK##(F)	;RESTORE J
	HLLM	T1,DEVEXT(F)	;SAVE EXTENSION IN DDB ALSO
	TLO	S,NOLINK	;INDICATE THERE IS AN UNLINKED BLOCK
	AOS	(P)		;SET FOR SKIP RETURN
				;AND FALL INTO MARKDR
;MARK DIRECTORY ENTRY POINTED TO BY J AS TAKEN
MARKDR:	PUSHJ	P,DRPTR		;SET POINTER TO BLOCK IN DIR
	HLRZ	T1,OBLK##(F)	;PICK UP INDEX
	IDPB	T1,J		;MARK DIRECTORY
	TLO	S,CHNGDR	;DIRECTORY HAS CHANGED
	JRST	STOIOS##

	;;SET POINTER TO CORRECT DIRECTORY ENTRY
DRPTR:	PUSH	P,T1		;SAVE T1 AND T2
	PUSH	P,T2
	MOVEI	T1,-1(J)	;SET FOR ILDB OR IDPB
	IDIVI	T1,7		;COMPUTE WORD, POSITION
	MOVEM	T1,J		;DIRECTORY WORD NUMBER INTO J
	MOVE	U,T2		;BYTE NUMBER INTO U
	POP	P,T2		;RESTORE T1,T2
	ADD	J,DLOC##(F)	;GET CORRECT ADDRESS
	HRLI	J,(POINT 5)	;MAKE IT A BYTE POINTER
	JUMPE	U,TPOPJ##	;CORRECT FOR POSITION IN WORD
	IBP	J
	SOJG	U,.-1
	JRST	TPOPJ##

;HERE FOR NEW FILE NAME ON ENTER
NEWENT:	SUB	T3,[XWD 26,26]	;START AT BEGINNING OF DIRECT.
	SKIPN	(T3)		;FIND A FREE SLOT
	AOJA	M,ENTR2		;RETURN WITH UUO POINTING TO WRD 2
	AOBJN	T3,.-2
	MOVEI	T3,2		;ERROR CODE
	JRST	STOERR		;TELL USER NO FREE SLOTS


ENTRD:	MOVEI	T1,0		;GET THE 1ST FREE BLOCK ON TAPE
	PUSHJ	P,BLKSRC	;AS THE 1ST LOGICAL BLOCK OF THE FILE
	  JRST	ENTRE		;NONE AVAILABLE
	JRST	ENTRC		;CONTINUE WITH ENTER

;HERE WHEN NO FREE BLOCKS ON THE TAPE
ENTRE:	LDB	T1,[POINT 17,OBLK##(F),17]	;INDEX
	ADD	T1,DLOC##(F)
	SETZM	NAMSTR-1(T1)	;GET RID OF NAME
	MOVEI	T3,2
	JRST	STOERR		;GIVE ERROR RETURN TO USER
	SUBTTL	USETI/USETO/UGETF

;USETI  -  SET NEXT INPUT BLOCK TO READ
SETI:	TDZ	S,[XWD IOEND,IODEND]	;ZERO THE EOF BITS
	SKIPA	U,F		;STORE RH(M) IN THE DDB

;USETO  -  SET NEXT OUTPUT BLOCK TO WRITE
SETO:	MOVEI	U,1(F)
	PUSHJ	P,DWAIT		;WAIT FOR BUFFERS TO FILL (OR EMPTY)
	HRRM	M,IBLK##(U)	;SET BLOCK NUMBER
	JRST	STOIOS##	;STOE S, POPJ

;UGETF	-  GET NEXT FREE BLOCK FOR THIS FILE
GETF:	PUSHJ	P,DWAIT		;WAIT TILL BUFFERS EMPTY
	PUSHJ	P,DIRCHK	;ENSURE DIR. IN CORE
	PUSHJ	P,USRFRE	;GET NEXT AVAILABLE BLOCK
	SKIPN	OBLK##(F)	;HAS AN ENTER BEEN DONE?
	SETOB	J,OBLK##(F)	;NO, SET SWITCH SO THAT THE NEXT ENTER
				;WILL FINF FIRST FREE BLOCK ON TAPE
	MOVE	T1,J		;TELL USER THE BLOCK NUMBER
	JRST	PUTWDU##


;GET NEXT (OR PREVIOUS) FREE BLOCK
USRFRE:	MOVEI	T3,SPACE	;BLOCKS "SPACE" APART
	LDB	J,PIOMOD##	;EXCEPT DUMP AND SAVE FILES
	SKIPL	OBLK##(F)	;UGETF DONE BEFORE ENTER?
	CAIL	J,SD		;OR ONE OF DUMP MODES?
	MOVEI	T3,2		;YES, BLOCKING FACTOR=2
USRFRA:	HRRE	J,OBLK##(F)	;CURRENT BLOCK
	TLNE	S,RVERSE	;FORWARD?
	JRST	USRLST		;NO
	ADDI	J,(T3)		;YES. FIND NEXT BLOCK AT LEAST N 
	SKIPL	J
	CAILE	J,TOPBLK
	TDZA	J,J
CALNXT:	PUSHJ	P,NXTFRE	;BLOCKS PAST THIS ONE
	JUMPN	J,STOIOS##	;RETURN IF FOUND
	TLOE	T3,1		;FOUND NONE ON THIS PASS
	JRST	NOBLKS		;TAPE IS FULL
	TLC	S,RVERSE	;REVERSE DIRECTION
	HRRI	T3,1		;START LOOKING AT NEXT BLOCK IN OTHER DIRECTION
	JRST	USRFRA
USRLST:	SUBI	J,(T3)		;LOOK FOR FREE BLOCK N BEFORE
	SKIPG	J
	TDZA	J,J		;REVERSE IF AT FRONT OF TAPE
USLSTA:	PUSHJ	P,LSTFRE	;THIS ONE
	JRST	CALNXT+1
;NO FREE BLOCKS AVAILABLE. GIVE HIGH BLOCK,SET IOBKTL LATER
NOBLKS:	TLC	S,RVERSE	;SET TO TRY BETWEEN CURRENT BLOCK
	TLON	T3,2		; AND END OF TAPE IN ORIGINAL DIRECTION
	JRST	USRFRA		;TO IF HAVENT TESTED THAT ALREADY
	MOVEI	J,TOPBLK+1	;SET HIGH BLOCK
	POPJ	P,
	SUBTTL	UTPCLR

;UTPCLR UUO
UTPCLR:	TRNE	S,UDSD
	POPJ	P,		;FORGET IT FOR NON-STANDARD
	TLO	S,SINGL+RWDIR	;INDICATE UTPCLR
	PUSHJ	P,DIRCHK	;MAKE SURE DIRECTORY IS IN CORE
	TLZ	S,SINGL+RWDIR	; DIRCHK MAY HAVE TO READ DIRECTORY
	TLO	S,CHNGDR	;DIRECTORY HAS CHANGED
	HRRZ	T1,DLOC##(F)	;LOC OF DIRECTORY
	HRL	T2,T1
	HRRI	T2,1(T1)	;BLT POINTER
	SETZM	(T1)
	BLT	T2,176(T1)	;LEAVE LAST WORD IN DIR. ALONE
	MOVSI	T2,17000	;MARK DIRECTORY AS UNAVAILABLE
	MOVEM	T2,16(T1)
	MOVSI	T2,757000	;RESERVE BLOCKS 1 AND 2
	MOVEM	T2,(T1)		;FOR READ IN MODE LOADER
	MOVSI	T2,777770	;MARK BLOCKS 1102-1105 AS
	ORCAM	T2,NAMSTR-1(T1)	;UNAVAILABLE ALSO
	TLO	F,OUTPB		;SO RELEASE WILL WRITE DIRECTORY
	PUSHJ	P,JDAADR##
	HLLM	F,(T1)
	JRST	STOIOS##

;SUBROUTINE TO FETCH ITEM POINTED TO BY M INTO T2
;PRESERVES T1.
GETWT2:	PUSH	P,T1		;SAVE T1
	PUSHJ	P,GETWDU##	;GET REQUESTED ITEM
	MOVE	T2,T1		;ITEM TO T2
	JRST	TPOPJ##		;RESTORE T1 AND RETURN
	SUBTTL	CLOSE

;CLOSE UUO
UCLS:	TLNN	F,OUTPB		;IF NO OUTPUTS WERE DONE
	JRST	CLSDMP		; WRITE AN EMPTY BLOCK
	TLNE	S,NOLINK	;IS LAST BLOCK NOT LINKED?
	TRNE	S,UDSD		;AND NOT NON-STD?
	JRST	UCLS1		;YES. RETURN
	LDB	T1,PIOMOD##	;NO. WRITE LAST BLOCK
	CAIL	T1,16		;DUMP MODE?
	JRST	CLSDMP		;YES. CLOSE DUMP MODE
	MOVE	T1,DEVOAD(F)	;LOC OF BUFFER
	EXCTUX	<MOVE T2,1(T1)>	;LINK WORD
	TLON	T2,-1		;LINK=-1 IF NOT SPECIFIED
	EXCTXU	<MOVEM T2,1(T1)>	;LINK = -1... EOF
	MOVEM	S,DEVIOS(F)	;SAVE S
	PUSHJ	P,OUT##		;GO TO WRITE RECORD
	  SKIPA			;IF TAPE DEAD-RECKONED
	PUSHJ	P,UCLS2
UCLS1:	PUSHJ	P,RWAIT		;DELAY, REDO IO IF DEAD-RECKONED

;HERE WHEN THE LAST BLOCK IS REALLY WRITTEN
	SETZM	OBLK##(F)	;MAKE SURE OBLK IS 0
	SETZM	FSTBLK##(F)	;SO NEW LOOKUP WILL SET LH(OBLK)
	TLZ	S,NOLINK	;CLEAR LINKED FLAG
	TLZ	F,OUTPB		;NO OUTPUTS DONE IF ANOTHER ENTER WITHOUT RELEASE
	JRST	STOIOS##	;AND LEAVE


;HERE TO CLOSE A DUMP MODE FILE
CLSDMP:	TLO	S,IO+DMPMOD	;SET SWITCHES
	PUSHJ	P,GETDT		;GET CONTROL
	TLO	S,DMPCLS	;SAFE TO SET BIT NOW
	SETZM	BUF##(W)	;ENSURE ZERO LINK,WORDCOUNT
	SETZM	BUF##+1(W)	;MAKE SURE 0, SO CAN GET WITH 3 SERIES MON.
				;FILES SAVED WITH 4 SERIES MONITOR.
	MOVEI	T1,BUF##(W)	;POINT T1 AT BUFFER
	PUSHJ	P,OUFULL	;GO WRITE THE BLOCK
	JRST	UCLS1		;AND LEAVE

;HERE TO REDO FINAL BLOCK
UCLS2:	SKIPN	DEVEVM(F)
	PUSHJ	P,GTOEVM##	;GET EVM AGAIN
	TLNN	S,DMPMOD
	JRST	OUTB
	JRST	OUTD
;ROUTINE TO ENSURE THAT A TAPE IS NOT REWINDING
DTRCHK:	TLNN	S,REWBIT	;REWINDING?
	POPJ	P,		;NO, RETURN
				;YES, FALL INTO DWAIT
;ROUTINES TO WAIT FOR A (POSSIBLY) DEAD-RECKONING TAPE
DWAIT:	PUSHJ	P,WAIT1##	;WAIT TILL IOACT OFF
	TLNE	S,IOSLEP	;JOB SLEEPING?
	SKIPL	DEVIOS(F)	;TAPE DEAD-RECKONING?
	POPJ	P,		;NO, RETURN
	PUSHJ	P,SLPTST	;YES, SLEEP FOR A WHILE
	JRST	DWAIT		;AND GO TRY AGAIN

;THIS ROUTINE REENTERS CALLER IF TAPE WAS DEAD-RECKONING
;SINCE OTHERWISE NOTHING WILL DO THE I/O AFTER JOB SLEPT)
RWAIT:	PUSH	P,J		;SAVE J
	MOVSI	J,REDOIO	;MAKE SURE BIT IS OFF
	ANDCAM	J,DEVIOS(F)
	PUSHJ	P,WAIT1##	;WAIT
	TDNN	J,DEVIOS(F)	;DID TAPE DEAD-RECKON?
	PJRST	JPOPJ##		;NO, RETURN
	PUSHJ	P,SLPTST	;SLEEP FOR A WHILE
	TLNN	S,DMPCLS	;DONT GET CONTROL IF FROM CLOSE
	PUSHJ	P,GETDT1	;GET CONTROL AGAIN
	POP	P,J		;RESTORE J
	POP	P,T1		;RETURN TO CALLER AT INSTR BEFORE CALL
	JRST	-2(T1)		; SO THE I/O WILL ACTUALLY BE EXECUTED

;THIS ROUTINE GIVES UP EVM IF ANY BEFORE PUTTING A
; JOB TO SLEEP WHILE A TAPE DEAD RECKONS OR REWINDS

EWAIT:
IFN FTPSCD,<
	AOS	%DTASL##	;NUMBER OF DTA GENERATED SLEEPS
>
	SKIPN	DEVEVM(F)	;EVM?
	PJRST	SLEEPF##	;NO
	PUSHJ	P,RTEVM##	;RETURN EVM
	PUSHJ	P,SLEEPF##	;ZZZZZZ
	PJRST	RSTEVM##	;RESTORE EVM
	SUBTTL	RELEASE

;RELEASE UUO
UREL:	MOVSI	T1,DVDIRIN	;IF NONSTANDARD, WILL CLEAR
	TRNE	S,UDSD		;CLEAR NON-STANDARD BIT.
	ANDCAM	T1,DEVMOD(F)	;SO DIRECTORY WILL BE READ ANEW
	MOVSI	T1,IOSLEP	;IS TAPE DEAD-RECKONING?
	SKIPGE	DEVIOS(F)
	IORM	T1,DEVIOS(F)	;YES, MAKE SURE JOB SLEEPS
				; (IOSLEP MIGHT HAVE BEEN CLEARED)
	PUSHJ	P,DWAIT		;MAKE SURE THE TAPE IS STOPPED
	TLNN	F,ENTRB+OUTPB+RENMB;IF NO ENTER/OUTPUT/RENAME ON THIS CHAN
	JRST	UREL3		;ZERO IBLK AND RETURN IMMEDIATELY
	PUSHJ	P,NXTCM2	;CLEAR OUT DUMP MODE STUFF
	SKIPG	DEVMOD(F)	;IF DIRECTORY HAS BEEN
	TLZN	S,CHNGDR	;MODIFIED IT MUSY BE WRITTEN
	JRST	UREL2		;IT HASN'T BEEN CHANGED
	TLZE	S,NOLINK	;UNLINKED BLOCK?
	PUSHJ	P,CLSDMP	;YES. WRITE IT.
	TLO	S,IO
	PUSHJ	P,GETDT		;WAIT TILL DTC AVAILABLE
	SKIPL	DEVMOD(F)	;TAPE ASSIGNED SINCE JOB WENT INTO WAIT?
	JRST	UREL1		;YES, DON'T WRITE DIRECTORY ON NEW TAPE
	TLO	S,RWDIR		;GOING TO WRITE DIRECTORY
	MOVEI	J,DIRBLK	;BLOCK NUMBER
	HRRZ	T1,DLOC##(F)	;LOC OF DIRECTORY
	HRLI	T1,-200		;WRITE 200 WORDS
	MOVEM	T1,DMPLST##(F)	;SAVE IOWD IN DDB
	PUSHJ	P,WRTBLK	;WRITE THE DIRECTORY
	PUSHJ	P,RWAIT		;WAIT TILL IT HAS BEEN WRITTEN
	JRST	UREL2
UREL1:	PUSHJ	P,THRUTD	;GIVE UP CONTROL

UREL2:	MOVE	T1,DEVIAD(F)	;BITS 1,2 ARE COUNT OF CHANS
	TLNE	T1,200000	;DEV INITED ON ANOTHER CHANNEL TOO?
QUANTL:	POPJ	P,QUANT		;YES. DONT ZAP S OR DDB

;SOME BITS IN THE S WORD AND THE DDB WILL NORMALLY BE CHANGED ON THE
;INTERRUPT LEVEL AFTER THE RELEASE, BUT HNGSTP CAN CAUSE  THESE ACTIONS
;NEVER TO OCCUR, SO MAKE SURE THEY REALLY HAPPENED
	TLZ	S,77600		;ZERO S BITS
	TRZ	S,UDSD
	SETZM	OBLK##(F)	;AND OBLK
	SETZM	FSTBLK##(F)
UREL3:	SETZM	IBLK##(F)	;ZERO IBLK SO WRITING A FILE AFTER READING
				;IT WILL WORK (CHECK IS MADE AT ENTER)
	SETZM	SVDWRD##(F)
	TLZ	S,DMPMOD	;MAKE SURE BIT IS OFF
	SETZM	DEVFIL(F)	;CLEAR FILE AND EXTENSION
	HRRZS	DEVEXT(F)	;SO CONTROL-T DOES NOT PRINT THEM
	JRST	STOIOS##	;STORE S AND RETURN
	SUBTTL	GET DECTAPE CONTROL

GETDT0:	MOVSI	S,IOSLEP	;DWAIT WILL LOOP IF IOSLEP OFF
	IORM	S,DEVIOS(F)
	PUSHJ	P,DWAIT		;WAIT TILL TAPE STOPS REWINDING
;GET DEC TAPE CONTROLLER
GETDT:	TLZE	S,REWBIT	;IF TAPE IS REWIZDING NOW
	JUMPL	S,GETDT0	;WAIT TILL THRU BEFORE CONTINUING
	JUMPGE	S,GETDT1	;IF DEAD-RECKONING,
	MOVEI	T1,1		;SLEEP FOR 1 SECOND
	PUSH	P,J
	LDB	J,PJOBN##	;JOB NUMBER
	PUSHJ	P,EWAIT		;ZZZZZZZZZ
	POP	P,J		;RESTORE J
	MOVE	S,DEVIOS(F)	;RESTORE S
	JRST	GETDT		;AND SEE IF SLEEPING NOW
GETDT1:
GETDT4:	PUSHJ	P,DXWAIT	;GET RESOURCE
	PIOFF			;AVOID CLOCK INTERRUPT
	SKIPE	USEWRD##(W)	;SOMEONE ELSE ALREADY GRAB CONTROLL(AT CLOCK LEVEL)
	JRST	GETDT6		;YES,GO WAIT SOME MORE
	MOVEM	F,USEWRD##(W)	;NO,SAVE AC NEEDED ON INTERRUPT LEVEL
	PION
	LDB	T1,PUNIT##	;HAVE CONTROL NOW
	LSH	T1,11		;CONNECT TO DTA
	XCT	DTXSTO##(W)	;SEE IF TAPE IS OK
	XCT	DTSCNI##(W)	;CONI DAS,T4
	TLNE	T4,10		;IDLE? (SHOULD BE)
	TRNE	T4,100		;SELECT ERROR?
	JRST	QUEST		;YES. COMPLAIN
	TLNE	S,IO		;NO. TRYING TO WRITE TAPE?
	TRNN	T4,4000		;YES. WRITE PROTECTED?
	SKIPA	T1,QUANTL	;NO. EVERYTHING IS OK
	JRST	QUEST		;YES. COMPLAIN
	HRRZM	T1,QUANTM##(W)	;SET UP NUMBER OF BLOCKS TO KEEP CONTROL FOR
	MOVEI	T1,10000	;SET UP TO DESELECT CONTROL
	XCT	DTXCON##(W)	; SO FNDBLK TEST WILL WORK (CONO DAC,20000)
	JRST	SETACT##	;LIGHT IOACT AND RETURN


;COME HERE TO COMPLAIN ABOUT UNIT NOT RIGHT (SELECT OR PROTECT ERROR)
QUEST:	PUSH	P,S		;SAVE S
	PUSHJ	P,THRUTD	;GIVE UP CONTROL
	POP	P,S
	MOVEM	S,DEVIOS(F)
	PUSHJ	P,HNGSTP##	;TYPE "DTAN OK?"
	JRST	GETDT1		;GET CONTROL AGAIN AND RETRY
GETDT6:	PION			;OK TO LET CLOCK INTERRUPT AGAIN
	JRST	GETDT4		;WAIT TILL AVAL COMES UP
GETDTX:	PUSHJ	P,GETDT		;GET TD10
	SKIPN	DEVEVM(F)	;DID EVM GO AWAY (FROM REWINDING TAPE)?
	PJRST	RSTEVM##	;YES, GET IT AGAIN
	POPJ	P,		;NO, RETURN
	SUBTTL	INPUT

;DUMP MODE INPUT
DMPI:
IFN CPBIT, <
	PUSHJ	P,SAVE1##	;SAVE P1
	HRRZ	P1,IBLK##(F)	;SET P1=BLOCK TO READ
>; END IFN CPBIT
	TLZ	S,IO		;MAHE SURE IO IS OFF
	PUSHJ	P,DMPSET	;SET UP DUMP-MODE STUFF
	TLOA	S,DMPMOD


;INPUT UUO
UIN:	TLZ	S,DMPMOD
	TLZ	S,IO		;MAKE SURE IO=
	PUSHJ	P,SLPTST	;SLEEP IF DEAD-RECKONING
	HRRZ	J,IBLK##(F)	;BLOCK TO READ
	PUSHJ	P,STOIOS##	;SAVE S
	TRNN	S,UDSD		;NON-STANDARD?
	JRST	UIN1		;NO, CONTINUE
	TRNE	S,UDXX		;YES, "SEMI-STANDARD"?
	PUSHJ	P,BLKCHK	;YES, CHECK BLOCK FOR LEGALITY
	JRST	UIN2		;AN CONTINUE
UIN1:	JUMPE	J,EOF		;0 MEANS EOF
	PUSHJ	P,BLKCHK	;CHECK LEGALITY OF BLOCK NUMBER
	TLNN	S,DMPMOD	;DUMP MODE?
	CAIE	J,DIRBLK	;TRYING TO READ DIRECTORY?
	JRST	UIN2		;NO. GO READ

;READING DIRECTORY - GIVE CORE IMAGE IF IT EXISTS
	PUSHJ	P,DIRCHK	;READ IT IF IT ISN'T1 IN ALREADY
	SKIPN	DEVEVM(F)	;GOT EVM? (MAY HAVE GIVEN IT UP IF DEAD RECKONING HAPPENED)
	PUSHJ	P,GTIEVM##	;NO, NEED IT TO MOVE DIRECTORY TO USER'S AREA
	HRL	T1,DLOC##(F)	;LOC OF DIRECTORY
	MOVEI	T2,@DEVIAD(F)	;WHERE USER WANTS IT
	HRRI	T1,1(T2)	;LOC OF  DATA
	BLT	T1,200(T2)	;GIVE IT TO HIM
	PUSHJ	P,ADVBFF##	;ADVANCE BUFFERS
	  JFCL
	PJRST	RTNEVM


UIN2:	TLNE	S,DMPMOD	;DUMP MODE?
	JRST	READBC		;YES, GO START THE IO
	PUSHJ	P,GETDTX	;GET CONTROL (MIGHT BE MOVED BEFORE GETTING TD10
				; SO CANT COMPUTE @DEVIAD TILL AFTER)
	MOVEI	T1,@DEVIAD(F)	;ADDRESS OF THE BUFFER
	ADD	T1,[-200,,1]	;MAKE AN IOWD
	MOVEM	T1,DMPLST##(F)	;SAVE IT IN THE DDB
	JRST	READBC		;AND START THE IO
;ROUTINE TO PUT JOB TO SLEEP IF TAPE IS DEAD-RECKONING AND IOSLEP IS ON
SLPTST:	TLZN	S,IOSLEP	;SHOULD JOB GO TO SLEEP?
	POPJ	P,		;NO, RETURN
	MOVEM	S,DEVIOS(F)	;YES, SAVE NEW S
	JUMPGE	S,CPOPJ##	;RETURN IF NOT DEAD-RECKONING
	LDB	J,PJOBN##	;JOB NUMBER
	LDB	T1,SLPNTR	;TIME TO SLEEP
	PUSHJ	P,EWAIT		;ZZZZZ
	MOVE	S,DEVIOS(F)	;RESTORE S
	POPJ	P,		;AND RETURN


;CHECK VALIDITY OF BLOCK NUMBER
BLKCHK:	CAIG	J,TOPBLK	;LEGAL?
	JRST	[HRLM	J,DTXBLK##(F) ;SAVE AS LAST BLOCK FOR I/O
		 POPJ	P,]	;RETURN
	POP	P,T1
	TROA	S,IOBKTL	;NO. LIGHT ERROR BIT

;INPUT BLOCK = 0 - END OF FILE
EOF:	TLO	S,IOEND		;LIGHT EOF BIT
	TLNN	S,DMPMOD
	JRST	STOIOS##
	JRST	DMPEOF		;GIVE UP CONTROL IF DUMP-MODE


	SUBTTL	OUTPUT

;DUMP MODE OUTPUT
DMPO:	PUSHJ	P,DIRCHK	;MAKE SURE DIRECTORY IS IN CORE
IFN CPBIT,<
	PUSHJ	P,SAVE1##	;SAVE P1
	HRRZ	P1,OBLK##(F)	;SET P1=BLOCK TO WRITE
>; END IFN CPBIT
	TLO	S,IO		;INDICATE OUTPUT
	PUSHJ	P,DMPSET	;SET DUMP-MODE POINTERS
	TLOA	S,DMPMOD

;OUTPUT UUO
UOUT:	TLZ	S,DMPMOD
	TLNE	S,REDOIO	;IF NOT DEAD-RECKONING,
	TLNN	S,NOLINK	;IF THE CURRENT BLOCK ISN'T LINKED,
	JRST	UOUT0
	MOVEI	T1,@DEVOAD(F)	;POINT TO BUFFER
	SKIPL	1(T1)
	HRRZS	1(T1)		;AND INDICATE NO LINK YET
				;(ELSE WE'LL THINK A LINK EXISTS IF HAVE TO
				; REWRITE AFTER DEAD-RECKONING)
UOUT0:	TLO	S,IO		;INDICATE OUTPUT
	PUSHJ	P,SLPTST	;SLEEP IF DEAD-RECKONING
	MOVEM	S,DEVIOS(F)
	PUSHJ	P,DIRCHK	;MAKE SURE DIRECTORY IS IN CORE
	TLO	S,IO		;IF DIRCHK READ, IO WENT OFF
	HRRZ	J,OBLK##(F)	;BLOCK TO WRITE
	TRNN	S,UDSD		;IF NON-STANDARD
	JRST	UOUT1
	TRNE	S,UDXX		;WANT BLOCK NUMBERS CHECKED?
	PUSHJ	P,BLKCHK	;YES, DO SO
	JRST	UOUT2		;AND CONTINUE
UOUT1:	CAIN	J,DIRBLK	;CHECK IF WRITING DIRECTORY
	JRST	COR2HM		;YES. WRITE CORE IMAGE
	JUMPE	J,FAKADV	;DONT WRITE IF NO BLOCK GIVEN
	PUSHJ	P,BLKCHK	;CHECK FOR LEGAL BLOCK
UOUT2:	TLNN	S,DMPMOD	;ALREADY HAVE CONTROL IF DUMP-MODE
	PUSHJ	P,GETDTX	;GET DEC TAPE CONTROLLER
FILBUF:	TLNE	S,DMPMOD	;DUMP MODE?
	JRST	DMPFIL		;YES. FILL BUFFER FROM LIST
	MOVEI	T1,@DEVOAD(F)	;LOC OF BUFFER
	ADD	T1,[-200,,1]	;MAKE AN IOWD
	MOVEM	T1,DMPLST##(F)	;AND SAVE IT IN THE DDB
	TLZ	S,NOLINK	;INDICATE NOT LINKED
OUFULL:	TRNE	S,UDSD		;NON-STANDARD?
	JRST	OUTBL2		;YES. NO FILE-STRUCTURED OPERATIONS
	HLRE	J,0(T1)		;IS IT LINKED?
	JUMPL	J,LSTBLK	;YES. - LAST BLOCK OF FILE
	JUMPN	J,OUTBLK	;IF NON-0 - YES
	TLNE	S,DMPCLS	;NO. LAST BLOCK OF A DUMP FILE?
				;DMPCLS WILL BE TURNED OFF AT THE INTERRUPT
	JRST	OUTBLK		;YES. LINK MUST STAY 0
	PUSH	P,T1
	PUSHJ	P,USRFRE	;COMPUTE NEXT BLOCK
	POP	P,T1
	TLOA	S,NOLINK	;THIS BLOCK NOT LINKED
LSTBLK:	MOVEI	J,0
OUTBLK:	HRLM	J,0(T1)		;SAVE LINK IN 1ST WORD OF BLOCK
	SKIPN	J
	TLO	S,DMPCLS
	MOVE	T3,FSTBLK##(F)	;STORE 1ST BLOCK OF FILE IN WORD
	DPB	T3,[POINT 10,0(T1),27]
	HRRZ	J,OBLK##(F)	;BLOCK TO WRITE NOW
	PUSHJ	P,BLKCHK	;CHECK LEGALITY OF BLOCK
	PUSHJ	P,MARKDR	;MARK BLOCK TAKEN IN DIRECTORY
OUTBL2:	HRRZ	J,OBLK##(F)
	PUSHJ	P,STOIOS##


WRTBLK:	PUSHJ	P,FNDBLK	;GO SEARCH FOR BLOCK
	MOVE	T2,[BLKO DTC,700]	;HERE WE ARE - GO WRITE
	JRST	RDWRT
;TRYING TO WRITE DIRECTORY - STORE IN CORE
COR2HM:	MOVEI	T1,@DEVOAD(F)	;WHERE IT IS
	HRLI	T1,1(T1)
	HRR	T1,DLOC##(F)	;WHERE TO PUT IT
	MOVEI	T2,177(T1)
	BLT	T1,(T2)
	TLO	S,CHNGDR	;REMEMBER TO WRITE IT OUT
	MOVSI	T2,DVDIRI
	ORM	T2,DEVMOD(F)	;DIR. IS NOW IN CORE
	SKIPA
FAKADV:	TRO	S,IOBKTL	;SOMETHING IS WRONG-LIGHT AN ERROR BIT
	TLZE	S,DMPMOD	;DUMP MODE?
	JRST	THRUTD		;YES. GIVE UP CONTROL
	PUSHJ	P,ADVBFE##	;ADVANCE BUFFERS
	  JFCL
	TLZ	S,NOLINK	;DIRECTORY BLOCK IS NOT LINKED
	SETZM	OBLK##(F)
	JRST	STOIOS##
;SET UP POINTERS AND STUFF FOR DUMP-MODE
DMPSET:	PUSHJ	P,SLPTST
	PUSHJ	P,GETDTX	;GET CONTROL
	SETZM	BADCOM##(F)	;REPEAT ERROR FLAG ON ENTRY
	PUSHJ	P,DMOHK		;GO CHECK FIRST COMMAND
	SETOM	LVFLAG##(W)	;MARK THIS AS UUO LEVEL SO COMMON
				;CODE AT EXIT (IOGO2 AND FNDBL3) CAN
				;DISTINGUISH
	SKIPE	BADCOM##(F)	;NON ZERO MEANS ERROR IN FIRST COMMAND
	JRST	SVADER		;SPECIAL ERROR EXIT ON SETUP
	TLO	S,DMPMOD	;LIGHT BIT
	JUMPE	T1,DMPTS1
IFN CPBIT, <
	TRNE	S,UDSD		;NO.  NON-STD MODE?
	JRST	TOUSER		;YES. GO ELSEWHERE
>; END IFN CPBIT
	MOVEM	M,DMPLST##(F)	;NO, SAVE START OF LIST -1
	SOS	DMPLST##(F)
	POPJ	P,

DMOHK:	PUSHJ	P,DT3XCH	;SAVE ACS USED BY COMCHK
	PUSHJ	P,COMCHK##	;TO REPORT RESULTS & SET UP LIMITS
	PUSHJ	P,DT3XCH	;SAVE LIMITS AND RESULT-RESTORE ACS
	POPJ	P,
DT3XCH:	EXCH	T2,DJOTOP##(F)	;USER UPPER LIMIT RETURNS HERE
	EXCH	T3,DJOBOT##(F)	;USER LOWER LIMIT
	EXCH	S,BADCOM##(F)	;FLAG TO SHOW ADDRESS ERROR IF
	POPJ	P,		;NOT ZERO
;HERE TO START DUMP-MODE INTO USER AREA DIRECTLY
IFN CPBIT,<
TOUSER:	JUMPE	P1,NOBLK0	;CANT READ BLK 0 IN NON-STD DUMP  MODE
	HLROM	T1,BLKCNT##(W)	;SAVE INTTIAL WDCNT
	MOVEM	M,USPNTR##(W)	;SAVE ADR OF LIST
	MOVEM	M,SVPNTR##(W)
	SOS	SVPNTR##(W)
	MOVEM	T1,PNTR##(W)	;AND SAVE IT
	SETOM	DTXDMP##(W)	;INDICATE DUMP MODE
	SETZM	DMPLST##(F)	;MAKE SURE DMPLST = 0
	TLO	S,NOBUF		;INDICATE DIRECTLY TO USER
	TLNN	S,IO
	POPJ	P,		;READING - CONTINUE
	POP	P,T1		;WRITING - THIS WILL SAVE LOTS OF TIME
	JRST	OUTBL2

NOBLK0:	TRO	S,IOIMPM
>; END IFN CPBIT
DMPTS1:	POP	P,T1
	JRST	THRUTD

;FILL OUTPUT BUFFER FROM LIST
DMPFIL:	MOVSI	T2,-177
	ADDI	T2,BUF##+1(W)	;RELOCATE INTO RIGHT CONTROL BLOCK
IFE CPBIT,<
	TRNE	S,UDSD
	SUB	T2,ONEONE	;200 DATA WORDS IF NON-STANDARD
>; END IFE CPBIT
DMPFLB:	PUSHJ	P,NXTCOM	;GET NEXT COMMAND
	  JRST	DMPOTH		;END OF LIST
DMPFLA:	MOVE	T3,(T1)		;GET NEXT WORD
	MOVEM	T3,(T2)		;INTO BUFFER
	AOBJP	T2,DMPOVR	;BUFFER FULL IF GOES
	AOBJN	T1,.-3		;GET NEXT WORD FROM COMMAND
	JRST	DMPFLB		;GET NEXT COMMAND

DMPOTH:
IFE CPBIT,<
	TRNN	S,UDSD
>; END IFE CPBIT
	HRRZM	T2,BUF##(W)	;LIST RAN OUT  SAVE WORD COUNT
	SETZM	(T2)		;ZERO REST OF BUFFER
	HRRZI	T2,1(T2)
	CAIL	T2,BUF##+177(W)	;JUST ZERO 1 WORD IF AT TOP
	JRST	DMPOT1
	HRLI	T2,-1(T2)
	BLT	T2,BUF##+177(W)

DMPOT1:	MOVNI	T2,BUF##+1(W)	;CORRECT THE WORD COUNT
	ADDM	T2,BUF##(W)
	JRST	DMPOV1

;BUFFER FULL BEFORE END OF COMMAND
DMPOVR:	AOBJN	T1,.+3		;WAS THAT LAST WORD OF COMMAND?
	PUSHJ	P,NXTCOM	;YES. GET NEXT
	  MOVEI	T1,0		;LAST
	MOVEM	T1,SVDWRD##(F)	;SAVE REMAINDER OF COMMAND
	MOVEI	T1,177
IFE CPBIT,<
	TRNN	S,UDSD
>; END IFE CPBIT
	MOVEM	T1,BUF##(W)	;WD CNT =177
DMPOV1:	MOVEI	T1,BUF##(W)	;SET T1 FOR 1ST WORD OF DATA
	JRST	OUFULL		;GO WRITE PART OF STUFF
;GET NEXT COMMAND FROM LIST
NXTCOM:	SKIPN	DMPLST##(F)	;END OF COMMANDS?
	JRST	NXTCM2		;YES. RETURN
	EXCH	M,DMPLST##(F)	;POINT TO CURRENT IOWD
	PUSHJ	P,DT3XCH	;SAVE ACS AND GET BOUNDRIES
	PUSHJ	P,NXCMR##	;GET NEXT IOWD AND CHECK IT
	PUSHJ	P,DT3XCH	;SAVE RESULTS AND RESTORE ACS
	EXCH	M,DMPLST##(F)	;SAVE NEW POINTER
	JUMPE	T1,NXTCM2	;END OF LIST
	AOJA	T1,CPOPJ1##	;GOOD RETURN WITH IOWD

;END OF DUMP-MODE LIST
NXTCM2:	SETZM	SVDWRD##(F)	;ZERO POINTERS
	SETZM	DMPLST##(F)
	SETZM	DTXDMP##(W)
	POPJ	P,


DMPFLC:	SKIPN	T1,SVDWRD##(F)	;IS THERE ANOTHER COMMAND
	JRST	DMPTH2		;NO, THROUGH
	JRST	DMPFLA		;AND DO THE IOWD
DTC=320
DTS=324

;IO INTERFACE
RDBLUK:	PUSHJ	P,GETDT		;GET DT CONTROL

READBC:	PUSHJ	P,FNDBLK	;SEARCH FOR RIGHT BLOCK
	MOVE	T2,[BLKI DTC,300]	;FOUND IT - START READING

;HERE WITH J=BLOCK NUMBER, T2=FUNCTION.  START SEARCH
RDWRT:	OR	T2,DXCNUM##(W)	;INSERT DEVICE NUMBER
	HLLM	T2,DXIOWD##(W)	;BLKI OR BLKO
	TLNE	S,DMPMOD
	SKIPA	T1,BFPNTR##(W)
	MOVE	T1,DMPLST##(F)
	HRLI	T2,(JFCL)	;ASSUME GOING FORWARD
	TLNN	W,100000	;ARE WE?
	SOJA	T1,RDWRT1	;YES
	ADDI	T1,176		;NO, START AT TOP OF BLOCK
	HRLI	T2,(CAIA)	;SET TO SOS BLKI POINTER ON
				; DATA-LEVEL INTERRUPT
RDWRT1:	HLLM	T2,DXDCTN##(W)
IFN CPBIT,<
	TLNN	S,NOBUF		;IF DIRECTLY TO USER
	MOVEM	T1,PNTR##(W)	; PNTR IS ALREADY SET UP
>; END IFN CPBIT
	MOVEM	S,DEVIOS(F)
	PUSHJ	P,DTXIOG##(W)	;WAKE UP THE CONTROLLER TO DO IO
DROUTH:	SKIPN	LVFLAG##(W)	;IS THIS FIRST TIME THROUGH
				;THIS CODE FOR THIS UUO CALL
	POPJ	P,		;NO RETURN FROM INTERRUPT
	SETZM	LVFLAG##(W)	;YES. RESET FIRST TIME FLAG
DROUT1:	PUSHJ	P,DWAIT		;LET CALLING JOB WAIT UNTIL
				;INTERRUPT LEVEL IO DONE
	TLNN	S,DMPMOD	;COMMAND FINISH?
	JRST	DROUT2		;YES, RETURN
	MOVE	M,DMPLST##(F)	;LOC OF IOWD
	SKIPN	SVDWRD##(F)	;ADJUST M IS DMPLST IS TOO LOW
	ADDI	M,1		;SINCE WE DIDN'T FINISH, MUST HAVE RECKONNED
				; SO WE GAVE UP OUR EVM
	PUSHJ	P,RSTEVM##	;GET THE EVM BACK 

	HRRZ	J,IBLK##(F)	;NO, GET NEXT BLOCK TO READ
	PUSHJ	P,RDBLUK	;START READING IT
	JRST	DROUT1		;AND WAIT TILL DONE
DROUT2:	SKIPE	BADCOM##(F)	;WHERE THERE ANY LIST ERRORS?
	JRST	ADRERR##	;YES
	POPJ	P,		;NO
;HERE TO PERFORM A REWIND MTAPE FOR DTA
MTAP0:	TLZ	S,IO		;MAKE SURE IO IS OFF
	PUSHJ	P,GETDT		;GET THE CONTROL FOR THE TAPE
	MOVEI	T2,-1(M)	;RESET T2
	LSH	T2,15		;T2=0 FOR REW; 10 FOR REW UNLD
	TRZ	S,IOACT		;CLEAR IOACT
	TLO	S,REWBIT+RVERSE(T2)	;SET SOME BITS IN S
	MOVN	J,T2		;BLOCK = 0 OR -10
	MOVSI	T1,DVDIRIN
	TLNE	S,RUNBIT	;IF THIS IS AN UNLOAD
	ANDCAM	T1,DEVMOD(F)	; CLEAR DIRECTORY-IN-CORE
	PUSHJ	P,FNDBLK	;GO FIND BLOCK

;CONTROL COMES HERE ON THE INTERRUPT CHANNEL WHEN THE BLOCK IS FOUND
; IF THE TAPE DID NOT DEAD-RECKON, AND IS REWIND ONLY (NOT UNLOAD)
	XCT	DTSFNS##(W)	;FUNCTION STOP
	POPJ	P,		;DISMISS INTERRUPT
;COME HERE TO START READING BLOCK NUMBERS
FNDBLK:	MOVEM	J,BLOCK##(W)	;BLOCK WE'RE LOOKING FOR
	POP	P,DISPAD##(F)	;WHERE TO GO WHEN RIGHT BLOCK FOUND
	SETZM	ERRCNT##(W)
FNDBL2:	SETZM	TURNCT##(W)
	XCT	DXCCNT##(W)	;CONI DAC,T1
	HRLI	W,(T1)		;PUT CONI BITS IN LH(W)
	LDB	T1,PUNIT##	;GET UNIT NUMBER
	LSH	T1,11		;POSITION IT
	TLNE	W,20000		;TAPE SELECTED?
	JRST	FNDBL4		;YES
	TRO	T1,230000	;NO, SET TO SELECT TAPE FORWARD
	TRNE	S,UDSD		;NON-STANDARD?
	TRNE	S,UDXX		;YES, BUT START IN LAST DIRECTION IF UDXX IS ON
	TLNE	S,RVERSE	;LAST DIRECTION OF THE TAPE REVERSE?
	TRC	T1,300000	;YES. SET FOR REVERSE
	SKIPGE	OBLK##(F)	;IS THE SPACING FACTOR 2?
	TRC	T1,300000	;YES, START IN OPPOSITE DIRECTION
FNDBL3:	TRO	T1,DTBOTH##+200	;ADD PI ASSIGNMENT
	SETOM	DTXSRC##(W)	;INDICATE SEARCHING FOR BLOCK NUMBERS
	XCT	DTXCON##(W)	;START SEARCH
	XCT	DTSENJ##(W)	;ENABLE FOR ALL BUT JOB DONE
	TLNE	S,DMPMOD	;DUMP MODE?
	TLNN	S,IO		;YES, OUTPUT?
	SETZ	T3,		;NO
	TRNE	S,UDSD
	MOVEI	T3,1
	MOVEM	T3,IOWRIT##(W)	;IOWRIT NON-0 IF DUMP-MODE OUTPUT
	TLZ	S,RECKON	;TURN OFF DEAD-RECKON BIT
	PUSHJ	P,STOIOS##	;SAVE S
IFN CPBIT,<
	TLZ	S,NOBUFC	;SET WORD NON-ZERO IF NOBUF ON
	HLRZM	S,DIRCTN##(W)
>; END IFN CPBIT
	HRRZ	T1,DMPLST##(F)	;ADR OF IOWD
	CAIN	T1,BLKWRD##(W)	;READING THE LINK ONLY?
	SETOM	DIRCTN##(W)	;YES, MUST BE GOING FORWARD
	JRST	DROUTH		;EXIT. CHECK FOR LIST ERRORS AFTER IO-DONE

FNDBL4:	TLNE	W,200000	;DIRECTION TEST
	TROA	T1,200000	;FORWARD
	TRO	T1,100000	;REVERSE
	JRST	FNDBL3		;START SEARCH
;INTERRUPT HERE TO READ A BLOCK NUMBER
SRCH::	XCT	DTSCN2##(W)	;GET STATUS BITS
	TLNE	T1,2000		;IS CONTROL STILL ACTIVE?
	JRST	SRCHD		;YES. MUST BE IN "PSEUDO END-ZONE"
	XCT	DTXDTI##(W)	;NO. READ A BLOCK NUMBER
	ANDI	T1,7777		;REMOVE EXTRANEOUS BITS IN CASE P-8 DECTAPE
	SKIPL	BLOCK##(W)	;REWIND AND UNLOAD?
	JRST	SRCH1		;NO
	XCT	DTXSF##(W)	;YES, TAPE ALREADY IN REVERSE?
	JRST	REKON1		;YES, DISCONNECT IT
	JRST	SRCHTR		;NO, TURN IT AROUND
SRCH1:	SUB	T1,BLOCK##(W)	;CURRENT BLOCK - TARGET BLOCK
	SKIPE	DIRCTN##(W)	;MUST BE GOING FORWARD IF DUMP-MODE
	JRST	SRCHC		;DIRECTLY TO USER
	JUMPE	T1,FOUND	;=0 IF WE'RE THERE
	XCT	DTXSF##(W)	;IF TAPE IS IN REVERSE
	MOVNS	T1		; SWITCH TURN-AROUND TEST
	JUMPG	T1,SRCHTR	;TURN AROUND IF POSITIVE
SRCH2:	MOVMS	T1
	CAILE	T1,MINDIS	;WORTH WHILE TO DISCONNECT TAPE?
	JRST	REKON		;YES. GO DISCONNECT
	POPJ	P,		;AND DISMISS THE INTERRUPT

;HERE TO TURN TAPE AROUND
SRCHTR:	AOS	T1,TURNCT##(W)	;NO OF TIMES TAPE WAS REVERSED
	CAILE	T1,3		;TRIED ENOUGH?
	JRST	SRCHT1		;YES, SET AN ERROR AND STOP TAPE
	XCT	DTXTRN##(W)	;NO, TURN THE TAPE AROUND
	POPJ	P,		;AND EXIT
SRCHT1:	SETOM	BLOCK(W)	;BLOCK=-1 IS AN ERROR FLAG
	XCT	DTSFNS##(W)	;GIVE A FUNCTION STOP
	POPJ	P,		;AND EXIT THE INTERRUPT


SRCHC:	XCT	DTXSF##(W)	;GOING FORWARD?
	TLCA	T1,400000	;NO. SWITCH TURN AROUND TEST, ENSURE FORWARD
	JUMPE	T1,FOUND	;GO IF FOUND FORWARD
	JUMPG	T1,SRCHTR	;TURN THE TAPE AROUND IF NEGATIVE
	SKIPL	DIRCTN##(W)	;READING THE LINK ONLY?
	POPJ	P,		;NO, DISMISS THE INTERRUPT
	XCT	DTXSF##(W)	;YES, IN REVERSE?
	TLC	T1,400000	;YES, SWITCH TURN-AROUND TEST
	JRST	SRCH2		;DISCONNECT FROM TAPE IF A LONG DISTANCE

;COME HERE IF CONTROL IS STILL ACTIVE AFTER READING A BLOCK NUMBER
;THIS MEANS THAT TAPE IS IN THE "PSEUDO END-ZONE" - EXTRA FILLERS
;INSERTED FOR THE BENEFIT OF THE P-9
SRCHD:	XCT	DTXTRN##(W)	;TURN TAPE AROUND
	POPJ	P,		;AND EXIT THE INTERRUPT
;COME HERE WHEN A TAPE IS IN A LONG SEARCH
;IF THIS TAPE HAS NOT USED THE MONITOR BUFFER (READING), AND
;IF NO OTHER TAPES ARE DISCONNECTED, THIS ONE WILL BE,
;AND A CLOCK REQUEST WILL BE ENTERED FOR AN ESTIMATED TIME TO BLOCK.

REKON:	SKIPN	IOWRIT##(W)	;MONITOR BUFFER FULL?
	SKIPGE	DSCON##(W)	;STOPPING ALL DEAD-RECKONING DRIVES?
	POPJ	P,		;YES. FORGET IT
REKON1:	MOVE	T2,DISTNC##(W)	;OLD DISTANCE-TO-BLOCK
	SKIPGE	BLOCK##(W)	;REWIND AND UNLOAD?
	JRST	REKON2		;YES
	SUB	T2,T1		;NO, CHECK SEQUENCE
	SOJN	T2,TRYLTR	;JUMP IF NOT SEQUENTIAL BLOCKS
REKON2:
IFN FTMP,<
	SKIPGE	INTLBT##
	SKIPL	INTRLK##	;I KNOW IT'S UGLY
	JRST	TRYLTR		; BUT DEADLY EMBRACE IS WORSE
>; END IFN FTMP
	MOVE	F,USEWRD##(W)	;NO. DISCONNECT FROM THIS ONE
	MOVE	S,DEVIOS(F)	;SET UP S
	MOVEI	T2,^D19		;COMPUTE NO OF SECONDS TO THE BLOCK
	XCT	DTXSF##(W)	; BASED ON 50 MS PER BLOCK FORWARD,
	MOVEI	T2,^D24		; AND 40 MS PER BLOCK IN REVERSE
	IDIVI	T1,(T2)		;T1=NO OF SECS
	TLNE	S,RUNBIT	;REWIND AND UNLOAD?
	ADDI	T1,^D10		;YES, ALLOW FOR TIME TO PULL TAPE OFF THE END
	SKIPN	T1		;MAKE SURE TIME IS AT LEAST
	MOVEI	T1,1		; 1 SECOND
	DPB	T1,SLPNTR	;SAVE TIME TO BLOCK IN DDB
	TLO	S,RECKON+IOSLEP+REDOIO	;INDICATE TAPE IS DEAD-RECKONING
				;SET IOSLEP SO NEXT I/O WILL CAUSE JOB TO SLEEP
	XCT	DTXSF##(W)	;DETERMINE DIRECTION
	TLOA	S,RVERSE	;REVERSE
	TLZ	S,RVERSE	;FORWARD
	XCT	DTXDSL##(W)	;DESELECT THE CONTROL
;BIT 400000 IS TO PREVENT ERROR FLAGS FROM COMING IN LATER -
; IT DOES NOT CAUSE THE DESELECTED TAPE TO STOP THOUGH
	SETZM	USEWRD##(W)	;INDICATE NO TAPE IN USE
	PUSHJ	P,DXFREE	;FREE TD10
	PUSHJ	P,DEVERR##	;CAUSE UUOCON TO REENTER ROUTINE AT UUO LEVEL
				; AT WHICH POINT JOB WILL BE PUT TO SLEEP
	POPJ	P,		;AND DISMISS INTERRUPT


TRYLTR:	MOVEM	T1,DISTNC##(W)
	POPJ	P,		;DISMISS INTERRUPT
	SUBTTL	ONCE/SECOND CODE

;ROUTINE CALLED ONCE A SECOND ON THE CLOCK
DTASEC::SKIPA	W,[DTADDB##]	;START AT 1ST KONTROLLER
DTASE0:	ADDI	W,DCONS##	;NEXT CONTROL
	CAIL	W,KONEND##	;STILL IN CONTROL DATA BLOCKS?
	POPJ	P,		;NO, THROUGH
	HRRZ	F,W		;YES, SET F TO 1ST DDB IN CONTROL
IFN FTMP,<
	PUSHJ	P,CHKCPI##	;KONTROLLER ON THIS CPU?
	  JRST	DTASE0		;NO, LOOK AT NEXT ONE
>; END IFN FTMP
	MOVSI	T2,RECKON+REWBIT+RUNBIT;DEAD-RECKONING BIT
	SKIPE	T1,DSCON##(W)	;SOME TAPE TIME OUT WITH CNTROL IN USE?
	AOS	T1,DSCON##(W)	;YES
	CAIGE	T1,2		;HAS IT BEEN 1 SECOND SINCE WE TRIED?
	JRST	DTASE3		;NO
	CONO	PI,PI.OFF
	XCT	DTSCNI##(W)	;YES, HAVE TO STOP ALL TAPES
	SETOM	DSCON##(W)	;INDICATE SO
	HLRZS	T4		;OLD PI ENABLES
	ANDI	T4,770000
	XCT	DTSCO2##(W)	;STOP ALL DISCONNECTED TAPES
	CONO	PI,PI.ON
	MOVEI	T3,0
DTASE1:	SKIPL	DEVIOS(F)	;IS THIS TAPE DEAD-RECKONING?
	JRST	DTASE2		;NO
	ANDCAM	T2,DEVIOS(F)	;YES, NOW IT ISN'T
	DPB	T3,SLPNTR	;SLEEP-TIME =0
DTASE2:	PUSHJ	P,NXTDTA	;GET NEXT DTA DDB
	  JRST	DTASE1		;AND TEST THAT TAPE
	SETZM	DSCON(W)	;DONE - DSCON=0
	JRST	DTASE0		;TRY NEXT CONTROLLER
;HERE ON A CLOCK INTERRUPT IF NOT TRYING TO STOP ALL TAPES
DTASE3:	SKIPL	DEVIOS(F)	;TAPE DEAD-RECKONING?
	JRST	DTASE5		;NO
	LDB	T1,SLPNTR	;YES, GET SLEEP TIME
	JUMPE	T1,DTASE6	;GO IF NOW 0
	SUBI	T1,1		;DECREMENT THE TIME
	DPB	T1,SLPNTR
	JUMPN	T1,DTASE5	;IF NOW 0,
DTAS3A:	SKIPE	USEWRD##(W)	;IS CONTROL FREE?
	JRST	DTASE4		;NO
	LDB	T1,PUNIT##	;YES, GET UNIT
	LSH	T1,11		;POSITION THE BYTE
	PUSHJ	P,REWFIN	;FINISH UP IF TAPE BEING UNLOADED
	XCT	DTXSTO##(W)	;STOP THE TAPE
	ANDCAM	T2,DEVIOS(F)	;NO LONGER DEAD-RECKONING
	XCT	DTXDST##(W)	;DESELECT CONTROL
	JRST	DTASE5		;AND TRY NEXT DDB

;HERE IF A TAPE TIMES OUT AND THE CONTROL IS IN USE
DTASE4:	SKIPN	T1,DSCON##(W)	;ALREADY WAITING FOR THE CONTROL TO FREE UP?
	MOVEI	T1,1		;NO, NOW WE ARE
	MOVEM	T1,DSCON##(W)	;STORE FLAG
DTASE5:	PUSHJ	P,NXTDTA	;GET NEXT DDB
	  JRST	DTASE3		;TEST IF IT'S DEAD-RECKONING
	JRST	DTASE0		;DONE - TEST NEXT CONTROL

;HERE IF THE DEAD-RECKON TIME BYTE IS ALREADY 0
DTASE6:	SKIPN	DSCON##(W)	;IF NOT WAITING FOR CONTROL,
	JRST	DTAS3A		;STOP THE DRIVE
	JRST	DTASE5		;AND TRY NEXT DDB
;SUBROUTINE TO FIND THE NEXT DTA DDB
;ENTER WITH F= CURRENT DDB
;RETURN CPOPJ WITH F= NEXT DTA DDB
;RETURN CPOPJ1 IF NEXT DDB IS NOT A DTA
NXTDTA:	HLRZ	F,DEVSER(F)	;NEXT DDB
	MOVE	T1,DEVMOD(F)
	TLNN	T1,DVDTA	;IS IT A DTA?
	JRST	CPOPJ1##	;NO, SKIP-RETURN
	MOVE	T1,DEVNAM(F)	;YES, IS IT RIGHT CONTROL?
	XOR	T1,DTXDDB##(W)
	TLNE	T1,-1
	AOS	(P)		;NO, SET FOR SKIP-RETURN
	POPJ	P,		;RETURN CPOPJ OR CPOPJ1


;ROUTINE TO STOP ALL TAPES WITH THE SLEEP-TIME =0
;CALLED WHEN CONTROL IS AVAILABLE (IF DSCON IS NON-0)
STOPIT:	XCT	DXCCNT##(W)
	MOVE	T4,T1		;CONI BITS INTO T4
	ANDI	T4,7000		;CURRENT UNIT
	PUSH	P,F		;SAVE F
	HRRZ	F,W		;START AT 1ST TAPE ON CONTROL
	MOVSI	T2,RECKON
STOPI1:	SKIPL	DEVIOS(F)	;IS TAPE DEAD-RECKONING?
	JRST	STOPI2		;NO
	LDB	T1,SLPNTR	;YES, GET SLEEP-TIME
	JUMPN	T1,STOPI2	;IF 0,
	LDB	T1,PUNIT##	;GET UNIT
	LSH	T1,11
	PUSHJ	P,REWFIN	;FINISH UP IF TAPE BEING UNLOADED
	XCT	DTXSTO##(W)	;STOP THE TAPE
	ANDCAM	T2,DEVIOS(F)	;TURN OFF DEAD-RECKON BIT
STOPI2:	PUSHJ	P,NXTDTA	;STEP TO NEXT DDB
	  JRST	STOPI1		;STOP IT IF TIME=0
	SETZM	DSCON##(W)	;DONE - ZERO DSCON
	MOVEI	T1,30000(T4)	;CONNECT CONTROL BACK TO OLD UNIT
	XCT	DTXCON##(W)
	JRST	FPOPJ##		;RESTORE F AND RETURN

;ROUTINE TO FINISH UP IF A TAPE WAS BEING UNLOADED
REWFIN:	PUSH	P,T2		;SAVE T2
	MOVE	T2,DEVIOS(F)	;IOS
	TLZN	T2,RUNBIT	;TAPE BEING UNLOADED?
	JRST	REWFI1
	XCT	DTXTR2##(W)	;YES, TURN IT AROUND(SO BRAKES WILL WORK)
	TLZ	T2,RVERSE	;START FORWARD NEXT TIME
REWFI1:	TLZ	T2,REWBIT+IOSLEP	;ZERO REWBIT
	MOVEM	T2,DEVIOS(F)	;SAVE NEW S
	JRST	T2POPJ##	;RESTORE T2 AND RETURN
;HERE WHEN CORRECT BLOCK NUMBER IS FOUND

FOUND:	MOVEM	T3,FNDTMP##(W)
	MOVE	F,USEWRD##(W)	;SET UP F
	MOVE	S,DEVIOS(F)	; AND S
	PUSHJ	P,@DISPAD##(F)	;DISPATCH
	MOVE	T3,FNDTMP##(W)	;RESTORE T3
	SETZM	DTXSRC##(W)	;INDICATE NOT SEARCHING (DATA TRANSFER)
	POPJ	P,		;RESTORE ACS AND EXIT

;HERE WHEN DUMP-MODE POINTER RUNS OUT

IFN CPBIT,<
DMPADV::MOVE	F,USEWRD##(W)
	LDB	J,PJOBN##	;JOB NUMBER
	EXCH	M,USPNTR##(W)	;POINTS TO CURRENT IOWD IN DUMP COMMAND LIST
	PUSHJ	P,DT3XCH	;SAVE ACS AND GET BOUNDRIES
	PUSHJ	P,NXCMR##	;GET NEXT IOWD AND CHECK IT
	PUSHJ	P,DT3XCH	;SAVE RESULT AND RESTORE ACS
	EXCH	M,USPNTR##(W)	;ALSO SAVE NEW POINTER AND RESTORE UUO
	JUMPE	T1,DMPAV3	;ZERO COMMAND IS LIST END
				;UPDATE WORD COUNT. THIS MUST BE DONE
	HLRE	T2,T1		;HERE AS EACH WORD IS SEEN
	ADDM	T2,BLKCNT##(W)	;SUBTRACT NEGATIVE COUNT
	MOVEM	T1,PNTR##(W)	;NEW POINTER
	POPJ	P,		;AND EXIT THE INTERRUPT


DMPAV3:	XCT	DTSFNS##(W)	;GIVE FUNCTION STOP
	SETZM	DTXDMP##(W)
	POPJ	P,		;AND EXIT THE INTERRUPT
>; END IFN CPBIT
;INTERRUPT HERE FOR FLAG CHANNEL
DTXINT::TRNE	T4,20000	;END ZONE?
	JRST	TURN		;YES TURN TAPE AROUND
	MOVE	F,USEWRD##(W)	;RESTORE F
	MOVEM	T4,DEVSTS(F)	;STORE CONI BITS IN DDB
	HRRM	T4,DTXBLK##(F)	;SAVE HERE TOO

	MOVE	S,DEVIOS(F)	;AND S
	LDB	J,PJOBN##	;JOB NUMBER
	SKIPGE	BLOCK##(W)	;BAD BLOCK NUMBER?
	TROA	S,IODTER	;YES, LIGHT IODTER AND RETURN
	TLZE	S,REWBIT	;NO, FROM A REWIND MTAPE?
	JRST	REWDUN		;YES. DONE
	TRNE	T4,100000	;JOB DONE?
	TRNE	T4,670000	;AND NO ERRORS?
	JRST	ERRS		;NO. TOUGH LUCK
	TLNN	S,IO		;READING?
	AOSA	DTXWRD##(F)	;YES...KEEP COUNT OF BLOCKS READ
	AOS	DTXWWT##(F)	;NO...ADD TO COUNT OF BLOCKS WRITTEN
DTAIN2:	TLNE	S,DMPMOD	;DUMP MODE?
	JRST	DMPTHR		;YES. GO ELSEWHERE
	TLNN	S,RWDIR
	TLNN	S,SINGL
	JRST	.+3
	LDB	T1,[POINT 10,BLKWRD##(W),27]	;GET 1ST BLOCK NO. IF READ
				;CAME FROM LOOKUP
	HRRM	T1,IBLK##(F)	;STORE IN DDB
				;NO. IN IO WAIT?
	PUSHJ	P,SETIOD##	;YES. TAKE OUT OF WAIT
	TLZE	S,SINGL+RWDIR	;DIRECTORY OPERATION OR
				;CLOSING DUMP FILE?
	JRST	THRUTP		;YES. LEAVE
	TLNE	S,IO		;WRITING?
	JRST	OUTHRU		;YES
;HERE ON END OF AN INPUT BLOCK
	MOVE	T3,DMPLST##(F)
	HRROI	T2,177		;MASK OUT 1ST-BLK DATA
	TRNN	S,UDSD		;UNLESS IN NON-STD
	ANDM	T2,(T3)
	HLRZ	J,(T3)		;NEXT BLOCK TO READ
	TRNE	S,UDSD		;IF NON-STD
	AOSA	J,IBLK##(F)	;READ SEQUENTIAL BLOCKS
	HRRM	J,IBLK##(F)	;SAVE IN DDB
	TRNE	S,IODTER+IODERR+IOIMPM
	JRST	THRUIN
	PUSHJ	P,ADVBFF##	;GET NEXT BUFFER
	JRST	THRUIN		;EMPTY BUF NOT AVAILABLE
	SKIPLE	DSCON##(W)	;TAPE TIMED OUT?
	PUSHJ	P,STOPIT	;YES, STOP IT NOW
	JUMPE	J,THRUIN	;EXIT  IF EOF OR BLOCK TOO LARGE
	CAILE	J,TOPBLK	;THE ERROR WILL BE CAUGHT ON THE
	JRST	THRUIN		;UUO LEVEL NEXT TIME AROUND
	MOVEI	T1,@DEVIAD(F)	;ADRESS OF THE USER'S BUFFER
	ADDI	T1,1		;POINT TO LINK WORD
	HRRM	T1,DMPLST##(F)	;SAVE LOC IN DDB
	SOSGE	QUANTM##(W)	;HAS TAPE HAD CHAN LONG ENOUGH?
	SKIPG	@DTXREQ##(W)	;YES. ANYONE ELSE WANT IT?
	JRST	READBC		;NO. READ NEXT BLOCK

THRUIN:	HRRZ	T1,OBLK##(F)	;TAPE ALSO BEING WRITTEN?
	JUMPN	T1,THRUTP	;YES. DONT CHANGE REVERSE BIT
	TLZ	S,RVERSE	;NO. SET S BIT TO CORRECT DIRECTION
	TLNE	W,100000
	TLO	S,RVERSE	;SKIP OVER THRUTH INTO THRUTP
;HERE WHEN TAPE IS DONE
THRUTP:	SETZM	DMPLST##(F)
	MOVEM	S,DEVIOS(F)	;SAVE S IN DDB
	XCT	DTXSTP##(W)	;STOP TAPE
	SKIPLE	DSCON##(W)	;HAS A TAPE TIMED OUT?
	PUSHJ	P,STOPIT	;YES, STOP IT NOW
THRUTD:	PUSHJ	P,DXFREE	;FREE TD10
	MOVEI	T1,10000	;DESELECT CONTROL
	XCT	DTXCON##(W)
	TLZ	S,DMPMOD+NOBUF+REWBIT+RUNBIT+RWDIR+SINGL+DMPCLS
	SETZM	USEWRD##(W)	;INDICATE CONTROL NOW FREE
	JRST	CLRACT##	;RESET IOACT AND RETURN

;COME HERE IF A TAPE IS HUNG
HUNGTP:	TLNN	S,REWBIT	;IGNORE IF REWINDING
	JUMPGE	S,HUNGT1	;GIVE UP CONTROL IF NOT DEAD-RECKONING
	JRST	CPOPJ1##	;IGNORE IT IF DEAD RECKONING -
;WHEN THE TAPE TIMES OUT FNDBLK WILL RESET THE HUNG TIME, AND
;IF IT IS STILL HUNG AT ITS END THE ERROR MESSAGE WILL OCCUR

HUNGT1:	TLNN	S,IOW		;IS IOW SET?
	PJRST	THRUTP		;NO, DON'T TRY TO PRESERVE IT
	PUSHJ	P,THRUTP	;YES, CLEAR IOACT PARAMS
	MOVSI	S,IOW		;GET BIT TO RESTORE
	IORB	S,DEVIOS(F)	;SET IN S AND MEMORY
	POPJ	P,		;RETURN (GIVING HUNG DEVICE)
;HERE ON END OF OUTPUT BLOCK
OUTHRU:	MOVE	T1,DMPLST##(F)	;IOWD
	HLRZ	J,0(T1)		;GET LINK
	TRNE	S,UDSD		;NOW STD?
	AOSA	J,OBLK##(F)	;YES WRITE NEXT BLOCK NEXT
	HRRM	J,OBLK##(F)	;SAVE IN DDB AS NEXT BLOCK
	PUSHJ	P,ADVBFE##	;GET NEXT BUFFER
	JRST	THRUTP		;NOT FULL
	SKIPLE	DSCON##(W)	;HAS A TAPE TIMED OUT?
	PUSHJ	P,STOPIT	;YES, STOP IT NOW
	HRRZ	J,OBLK##(F)	;NEXT BLOCK TO WRITE
	CAILE	J,TOPBLK	;LEGAL?
	JRST	THRUTP		;NO. CATCH ERROR ON UUO LEVEL
	SOSGE	QUANTM##(W)	;YES. HAD CHAN LONG ENOUGH?
	SKIPG	@DTXREQ##(W)	;AND SOMEONE ELSE WANT IT?
	JUMPN	J,FILBUF	;NO. GO WRITE NEXT BLOCK IF NOT DONE
	JRST	THRUTP		;YES. GIVE UP TAPE


;TURN TAPE AROUND AFTER END-ZONE INTERRUPT
TURN:	TLNE	W,500		;READING BLOCK NUMBERS?
	JRST	DIREOF		;NO. END ZONE WHILE READING DATA
	XCT	DTXTRN##(W)	;YES. TURN AROUND
	AOS	TURNCT##(W)	;INCREMENT NO OF TIMES TAPE HAS TURNED
	POPJ	P,		;RETURN ANND DISMISS THE INTERRUPT

;COME HERE ON AN END ZONE INTERRUPT WHILE READING DATA
;THIS CAN ONLY HAPPEN IN MODE 116,117
;LIGHT IODEND (IT IS A PREMATURE EOF) AND LEAVE
DIREOF:	MOVE	F,USEWRD##(W)	;RESTORE F
	MOVE	S,DEVIOS(F)	;AND S
	JRST	DMPEOF		;LIGHT IODEND AND RETURN
;COME HERE ON END OF DUMP MODE BLOCK
SVDMTH:	SKIPLE	DSCON##(W)	;HAS A TAPE TIMED OUT
	PUSHJ	P,STOPIT	;YES, STOP IT
IFN CPBIT,<
	TLNE	S,NOBUF		;DIRECTLY TO USER?
	JRST	USDMTH		;YES. ALMOST THROUGH
>; END IFN CPBIT
	MOVSI	T2,-177		;SET UP COUNT
	ADDI	T2,BUF##+1(W)	;RELOCATE
	CAIE	J,DIRBLK	;IF DIRECTORY
	TRNE	S,UDSD		;OR NON-STANDARD
	SUB	T2,ONEONE	;GIVE WHOLE BUFFER
	TLNN	S,IO
	JRST	SVDMIN		;INPUT FILE
	HLRZ	J,BUF##(W)	;OUTPUT FILE. NEXT BLOCK
	HRRM	J,OBLK##(F)
	JUMPE	J,DMPTHA	;LAST BLOCK
IFE CPBIT,<
	TRNE	S,UDSD		;IF NON-STD MODE
	AOSA	OBLK##(F)	;WRITE CONSECUTIVE BLOCKS
>; END IFE CPBIT
	CAIG	J,TOPBLK	;NOT LAST. LEGAL BLOCK NUMBER?
	POPJ	P,		;YES. RETURN

	TRO	S,IOBKTL	;BLOCK TOO LARGE
DMPTHA:	POP	P,T1		;REMOVE THE RETURN ADDRESS FROM
				;CALL TO SVDMTH, SINCE
				;NO MORE I/O WILL BE DONE
DMPTH2:	PUSHJ	P,NXTCM2	;ZERO DUMP MODE STUFF
	PUSHJ	P,SETIOD##	;RESTART JOB
	JRST	THRUTP

;HERE ON END OF SAVE MODE INPUT BLOCK
SVDMIN:	CAIN	J,DIRBLK	;DIRECTORY
	TDZA	J,J		;YES LINK=0
	HLRZ	J,BUF##(W)	;NEXT BLOCK NUMBER
IFE CPBIT,<
	TRNE	S,UDSD		;NON-STANDARD?
	AOSA	J,IBLK##(F)	;YES. READ CONSECUTIVE BLOCKS
>; END IFE CPBIT
	HRRM	J,IBLK##(F)	;SAVE IN DDB
	JRST	CPOPJ1##
;HERE WHEN THROUGH DUMP-MODE DIRECTLY TO USER
IFN CPBIT,<
USDMTH:	MOVEI	T2,IBLK##(F)
	TLNE	S,IO	
	MOVEI	T2,OBLK##(F)	;SET T2 TO RIGHT BLOCK NUMBER
	MOVN	T1,BLKCNT##(W)	;UPDATE BLOCK COUNTER
	ADDI	T1,177		;ALLOW FOR PARTIAL BLOCKS
	ASH	T1,-7		;DIVIDE WORD COUNT BY WORDS/BLOCK
	ADDM	T1,(T2)
	JRST	DMPTHA		;THROUGH
>; END IFN CPBIT


;HERE WHEN THROUGH DUMP MODE BLOCK
DMPTHR:	PUSHJ	P,SVDMTH	;END OF BLOCK HOUSEKEEPING
				; RETURN ONLY IF MORE I/O 
				; WILL BE DONE
	JRST	DMPFLC		;FILL BUFFER FOR NEXT OUTPUT

;HERE WHEN THROUGH READING A DUMP-MODE BLOCK
	SKIPN	T1,SVDWRD##(F)	;PARTIAL COMMAND?
	JRST	DMIFLA		;NO, GET NEXT COMMAND
	SOS	DMPLST##(F)	;YES, RELOCATE IT
	PUSH	P,T2		;SAVE POINTER TO DATA
	PUSHJ	P,NXTCOM
	  JRST	DMPTHA		;HE WIPED OUT HIS IOWD GIVE ADR CHK
	HLRE	T2,T1		;ORIGINAL WRDCNT
	HLRE	T3,SVDWRD##(F)	;CURRENT WRDCNT
	SUB	T3,T2		;NO OF WRDS XFERRED
	HRLS	T3		;SET TO UPDATE IOWD (JOB MAY NOT BE IN SAME PLACE)
	ADD	T1,T3		;T1=IOWD REFLECTING (NEW) POSITION
	POP	P,T2
	JRST	DMIFLC		;AND CONTINUE
DMIFLA:	PUSHJ	P,NXTCOM	;NO. GET NEXT COMMAND
	  JRST	DMPTH2		;END OF LIST - THROUGH
DMIFLC:	MOVE	T3,(T2)		;NEXT DATA WORD
	MOVEM	T3,(T1)		;GIVE TO USER
	AOBJP	T2,.+3		;IF BUFFER IS FULL
	AOBJN	T1,DMIFLC	;GET NEXT WORD
	JRST	DMIFLA		;GET NEXT COMMAND
	AOBJN	T1,.+3		;BUFFER IS FULL. IS COUNT EXACTLY 177?
	PUSHJ	P,NXTCOM	;THAT COM. IS DONE. GET NEXT
	  JRST	DMPTH2		;END OF LIST - THROUGH
	MOVEM	T1,SVDWRD##(F)	;SAVE PARTIAL COMMAND FOR NEXT TIME
	JUMPE	J,DMPEOF	;IF EOF - LIGHT BIT
	CAIG	J,TOPBLK	;BLOCK LEGAL?
	JRST	READBC		;GO READ BLOCK NUMBER
	TROA	S,IOBKTL	;LIGHT ERROR BIT

;EOF BEFORE ALL DATA IS IN - DUMP MODE
DMPEOF:	TRO	S,IODEND	;LIGHT EOF BIT
	JRST	DMPTH2		;GIVE UP TAPE
SVADER:	PUSHJ	P,DMPTH2	;GIVE UP CONTROL
	JRST	ADRERR##	;TYPE ERROR MESSAGE

;COME HERE ON ERROR
ERRS:	PUSHJ	P,DTASYR	;MAKE AN ERROR LOG ENTRY
IFN CPBIT,<
	TLNN	S,NOBUF		;I/O DIRECT TO USER?
	JRST	ERRS1		;NO
	MOVE	M,SVPNTR##(W)	;YES. RESET POINTERS
	PUSHJ	P,DT3XCH	;SAVE AC'S AND GET BOUNDRIES
	PUSHJ	P,NXCMR##	;GET FIRST IOWD AGAIN
	PUSHJ	P,DT3XCH	;RESTORE AC'S
	JUMPE	T1,PERMER	;MUST HAVE OVERWRITTEN THE LIST
	MOVEM	M,USPNTR##(W)	;ADDR OF CURRENT IOWD
	HLROM	T1,BLKCNT##(W)	;START WORD COUNT OVER
	MOVEM	T1,PNTR##(W)	;SAVE FIRST IOWD
>; END IFN CPBIT
ERRS1:	AOS	T1,ERRCNT##(W)	;BUMP COUNT
	XCT	DTSCNI##(W)	;DO A CONI DAS,T4
	TRNN	T4,40000	;IF ILLEGAL OP DONT RETRY
	CAILE	T1,DTTRY##	;ENOUGH REREADS?
	JRST	PERMER		;YES. PERMANENT ERROR
	JRST	FNDBL2		;NO. TRY AGAIN

;PERMANENT ERROR
PERMER:	SKIPL	BLOCK##(W)	;IF BAD BLOCK # LIGHT IODTER
	TRNE	T4,400000
	TRO	S,IODTER	;PARITY
	TRNN	T4,10000
	TRNE	T4,200000
	TRO	S,IODERR	;MISSED DATA
	TRNE	T4,40000
	TRO	S,IOIMPM	;ILLEGAL OP
	TLNE	S,DMPMOD	;DUMP MODE?
	JRST	DMPTHR		;YES. NOT THROUGH YET
	TLNN	S,IO+RWDIR+SINGL
	JRST	DTAIN2
REWDUN:	PUSHJ	P,SETIOD##	;NO. TAKE OUT OF IO WAIT
	TLCN	S,RWDIR+SINGL	;DIRECTORY OPERATION?
	JRST	THRUTP		;NO. RETURN TO USER
	TLZN	S,RWDIR+SINGL	;YES. UTPCLR ?
	JRST	THRUTP		;YES. IGNORE ERROR
	PUSHJ	P,THRUTP	;NO. STOP TAPE
	MOVSI	T1,DVDIRIN	;CLEAR DIRECTORY IN CORE BIT
	ANDCAM	T1,DEVMOD(F)
BDDIR:	LDB	J,PJOBN##	;NUMBER OF OFFENDING JOB
	JUMPE	J,CPOPJ##
	JRST	BADDIR##	;GO PRINT ERROR MESSAGE

SLPNTR:	POINT	7,DEVOAD(F),6
	SUBTTL	DECTAPE KONTROLLER SCHEDULING ROUTINES

;HERE TO WAIT/FREE FOR DECTAPE KONTROLLER POINTED TO BY W

DXWAIT:	PUSH	P,J		;SAVE J
	LDB	J,PJOBN##	;GET JOB #
	HRLM	W,JBTDTC##(J)	;WHO WE WANT
	CPLOCK	(SCD)		;RUN WITH THE SCHEDULAR INTERLOCK
	AOSG	DTXREQ##(W)	;SAY WE WANT IT
DXWAI1:	SKIPE	DTXWAT##(W)	;ANYONE OWN IT?
	JRST	WAITDX		;YES, HAVE TO WAIT FOR IT
	MOVEM	J,DTXWAT##(W)	;SET WE OWN IT
	CPUNLK	(SCD)
	JRST	JPOPJ##		;RETURN

WAITDX:	CPUNLK	(SCD)
	MOVEI	T1,DTQ##
	DPB	T1,PJBSTS##	;MARK JOB WAITING
	PUSHJ	P,DTWAIT##	;WAIT FOR IT
	JRST	JPOPJ##		;REESTORE J AND RETURN

;HERE TO GIVE UP ANY CONTROLLER WE MIGHT OWN
;J CONTAINS JOB NUMBER

DTXFRE::HLRZ	W,JBTDTC##(J)	;ONE WE OWN
	JUMPE	W,CPOPJ##
	PUSH	P,T1		;SAVE T1
	PUSH	P,J
	JRST	DXFRE1
DXFREE:	PUSH	P,T1
	PUSH	P,J
	LDB	J,PJOBN##
DXFRE1:	HRRZS	JBTDTC##(J)
	SOS	DTXREQ##(W)	;ONE LESS WAITER/HOLDER
	SETZM	DTXWAT##(W)	;CLEAR OWNING JOB
	PJRST	SRFRDT##	;TREAT LIKE DA/AU

;HERE FROM SCHEDULAR TO SEE IF WE OWN A DECTAPE CONTROLLER
;SKIP RETURN IF DO, NONSKIP IF DON'T

OWNDTC::PUSH	P,T1
	HLRZ	T1,JBTDTC##(J)	;CONTROLLER WE THINK WE OWN
	JUMPE	T1,TPOPJ##	;DON'T OWN IT
	CAMN	J,DTXWAT(T1)	;REALLY OWN IT?
	AOS	-1(P)		;NOPE
	JRST	TPOPJ##

;HERE FROM SCHEDULAR TO UNWIND A DECTAPE
;ENTER WITH JOB WANT TO RUN IN J, EXIT WITH JOB OWNING HIS DECTAPE
;KONTROLLER IN T3

UNWDTC::HLRZ	T3,JBTDTC##(J)
	JUMPE	T3,CPOPJ##	;DOESN'T WANT ONE?  PUNT
	MOVE	T3,DTXWAT(T3)	;GET JOB #
	POPJ	P,

;HERE TO GIVE JOB DECTAPE KONTROLLER AT SCHEDULAR LEVEL

SCDDT::	HLRZ	T3,JBTDTC##(J)	;ONE HE WANTS
	JUMPE	T3,CPOPJ##	;?
	HRL	T3,DTXWAT##(T3)	;RESOURCE
	TLNE	T3,-1		;STILL FREE?
	POPJ	P,		;NOPE
	MOVEM	J,DTXWAT##(T3)	;WE NOW OWN IT
	JRST	CPOPJ1##
	SUBTTL	DEVOP. UUO


;CALLED FROM UUOCON WITH DEVOP. FUNCTION CODE IN T1, DDB ADDRESS IN F

DVPDTA:	MOVSI	T2,-DVPTBL	;-VE LENGTH OF TABLE
DVPDT1:	HLRZ	T3,DVPTAB(T2)	;GET ENTRY FROM TABLE
	CAIE	T3,(T1)		;MATCH?
	AOBJN	T2,DVPDT1	;NO, LOOP
	JUMPGE	T2,ECOD2##	;JUMP IF NO MATCH
	HRRZ	T2,DVPTAB(T2)	;GET DISPATCH ADDRESS
	PJRST	(T2)		;CALL THE ROUTINE

DVPTAB:	XWD	1006, DVPRDI	;READ DECTAPE INFO
	XWD	2006, DVPSDI	;SET DECTAPE INFO
DVPTBL==.-DVPTAB		;LENGTH OF TABLE
;READ DECTAPE INFO (REELID, READ/WRITE COUNTS)

DVPRDI:	MOVE	T1,DTXRID##(F)	;GET REELID
	PUSHJ	P,PUTWR1##	;STORE IT
	  JRST	RTM1##		;ADDRESS CHECK
	MOVE	T1,DTXWRD##(F)	;GET WORDS READ
	PUSHJ	P,PUTWR1##	;STORE IT
	  JRST	RTM1##		;ADDRESS CHECK
	MOVE	T1,DTXWWT##(F)	;GET WORDS WRITTEN
	PUSHJ	P,PUTWR1##	;STORE IT
	  JRST	RTM1##		;ADDRESS CHECK
	JRST	CPOPJ1##	;SKIP RETURN


;SET DECTAPE REELID (CLEARS READ/WRITE COUNTS)

DVPSDI:	PUSHJ	P,PRVJ##	;PRIVILEGED JOB?
	  SKIPA			;YES
	JRST	ECOD1##		;NOPE
	PUSHJ	P,GETWR1##	;GET REELID
	  JRST	RTM1##		;ADDRESS CHECK
	MOVEM	T1,DTXRID##(F)	;SAVE NEW REELID
	SETZM	DTXWRD##(F)	;CLEAR READ AND
	SETZM	DTXWWT##(F)	; WRITE COUNTS
	JRST	CPOPJ1##	;SKIP RETURN
DTASYR:	PUSHJ	P,SAVT##	;SAVE SOME ACS
	XCT	DTSCN2##(W)	;CONI DTS, (READ STATUS)
	MOVEM	T1,DTXEST##(F)	;SAVE ERROR STATUS
	XCT	DXCCNT##(W)	;CONI DTC, (READ FLAGS)
	MOVEM	T1,DTXEFL##(F)	;SAVE ERROR FLAGS
	XCT	DTXDTI##(W)	;DATAI DAC, (READ BLOCK NUMBER)
	MOVEM	T1,DTXEBK##(F)	;SAVE ERROR BLOCK
	SETZ	T1,		;LET XFR ROUTINE ALLOCATE
	XMOVEI	T2,ELGTBL	;POINT TO TRANSFER TABLE
	PUSHJ	P,XFRSEB##	;COPY DATA
	  JFCL			;NO CORE
	POPJ	P,		;RETURN

ELGTBL:	SEBTBL	(.ERDTA,ELGEND,EX.SYE!EX.DEL!EX.QUE)
	MOVE	DEVNAM(F)	;(R00) DEVICE NAME
	MOVE	DTXRID##(F)	;(R01) REELID
	MOVE	DEVFIL(F)	;(R02) FILE NAME
	HLLZ	DEVEXT(F)	;(R03) EXTENSION
	MOVE	DTXWRD##(F)	;(R04) WORDS READ
	MOVE	DTXWWT##(F)	;(R05) WORDS WRITTEN
	MOVE	J		;(R06) JOB NUMBER
	MOVE	JBTPPN##(J)	;(R07) PPN OF USER
	MOVE	JBTNAM##(J)	;(R10) SIXBIT PROGRAM NAME
	MOVE	DTXEST##(F)	;(R11) CONI DTS,
	MOVE	DTXEFL##(F)	;(R12) CONI DTC,
	MOVE	DTXEBK##(F)	;(R13) DATAI DTC,
ELGEND:!			;END OF TABLE
	SUBTTL	THE END

	$LIT


DTAEND:	END