Google
 

Trailing-Edge - PDP-10 Archives - dec-10-omona-u-mc9 - dtasrn.mac
There are 2 other files named dtasrn.mac in the archive. Click here to see a list.
TITLE	DTASRN - NEW FORMAT DECTAPE SERVICE FOR  TD-10 (PDP-10) - V566 
SUBTTL	T. WACHS/CHW/RCC/CMF/TW  22 MAR 77
	SEARCH	F,S
	$RELOC
	$HIGH
;***COPYRIGHT 1973,1974,1975,1976,1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
XP VDTASX,566

	ENTRY	DTASRN
DTASRN:	;SO LOADER WILL GET DTASRN WHEN IN /L MODE
				;DEFINE GLOBAL VERSION NUMBER FOR LOADER MAP.

	ENTRY	DTASRN
DTASRN:			;THIS ENTRY FOR SELECTIVE LOAD BY BUILD
	INTERNAL DTADSP,DMPADV,DTXINT
EXTERNAL	TPOPJ,DTBOTH
EXTERNAL	STOIOS,SETACT,CLRACT,OUT,DTASAV,PIOMOD
EXTERNAL	SETIOD,THSDAT,PUNIT
EXTERNAL	ADVBFE,ADVBFF,ADRERR,WAIT1,CPOPJ,CPOPJ1,BADDIR
EXTERNAL	COMCHK,PJOBN
EXTERNAL	JBTADR,PION,PIOFF,DTTRY,GETWDU,GETWD1,PUTWDU


;DDB MAGIC LOCS
EXTERN	FSTBLK,DLOC,IBLK,OBLK,DISPAD,DMPLST,SVDWRD,DJOTOP,DJOBOT,BADCOM

;IO INSTRUCTIONS:
EXTERN	DXCCNT,DTSCNI,DTSCN2,BFPNTR,USEWRD,PNTR,TEMP
EXTERN	DISTNC,BLOCK,QUANTM,DSCON,RVERS,ERRCNT,FNDTMP,IOWRIT
EXTERN	TURNCT,BLKWRD,LVFLAG,BLKCNT,SVPNTR,USPNTR,DIRCTN,BUF,DTXCON
EXTERN	DTXSTP,DTXTRN,DTSENJ,DTXDMP,DTXIOG,DTXREQ
EXTERN	DTXSF,DTXDSL,DTXDST,DTXSTO,DTXTR2,DTXINI,DTXDTI,DCONS,DTADDB
EXTERN	KONEND,DTSCO2,DTSFNS,DTXDDB,DTXSRC,DTXXIT,DXCNUM,DXIOWD

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 BLKS 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)
	POPJ	P,0		;SPECIAL ERROR STATUS
	JRST	REGSIZ##	;SIZE CAN BE GOTTEN FROM DDB
	JRST	DTAINI##(P2)	;INITIALISE DECTAPE CONTROL(S)
	JSP	T2,DTSCON	;HUNG TAPE
DTADSP:	JSP	T2,DTSCON	;UREL - RELEASE M
	JSP	T2,DTSCON	;UCLS - CLOSE M
OUTB:	JSP	T2,DTSCON	;UOUT - OUTPUT OR OUT UUOS
	JSP	T2,DTSCON	;UIN  - INPUT OR IN UUOS
	JSP	T2,DTSCON	;ENTR - ENTER M
	JSP	T2,DTSCON	;LOOK - LOOKUP M
OUTD:	JSP	T2,DTSCON	;DMPO - OUTPUT M, 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 M
	JRST	ICLS		;CLOSE INPUT
	JSP	T2,DTSCON	;UTPCLR - CLEAR DIRECTORY
	JSP	T2,DTSCON	;MTAP - MTAPE M


	HUNGTP
DISTAB:	UREL
	UCLS
	UOUT
	UIN
	ENTR
	LOOK
	DMPO
	DMPI
ONEONE:	XWD	1,1
M177:	-177
	GETF
	RENAM
NAMXWD:	XWD	-26,NAMSTR
	Z	UTPCLR
	MTAP
DISDIS==DISTAB-DTADSP-1
DTSCON:	PUSH	P,W		;SAVE W FOR UUOCON
	SKIPA	W,FSTDDB	;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
FSTDDB:	POPJ	P,DTADDB	;OTHERS ARE NO-OPS


;CLOSE INPUT DISPATCH

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

LOOK:	TRNE	S,UDSD		;NON-STANDARD?
	JRST	CPOPJ1		;YES. LOOKUP OK
	PUSHJ	P,DTRCHK	;MAKE SURE TAPE NOT REWINDING
	MOVSI	T2,ICLOSB	;FLAG LOOKUP
	PUSHJ	P,CHKCHN	;CHECK FOR 2 LOOKUPS
	POPJ	P,0		;2 OR MORE - ERROR
	PUSHJ	P,DSERCH	;NO. FIND DIRECTORY ENTRY
	POPJ	P,		;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
	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



;CHECK TO SEE IF MORE THAN ONE LOOKUP/ENTER BEING ATTEMPTED
;CALLED WITH LH(T2)= LOOKB OR ENTRB
;SKIP RETURN IF OK, NON-SKIP IF MORE THAN ONE

CHKCHN:	LDB	T1,IADPTR	;GET CHANNEL COUNT
	CAIGE	T1,2		;POSSIBLE ERROR IF GREATER THAN 1
	JRST	CPOPJ1		;JUST ONE - WE'RE OK
	HRRZ	P2,F		;GET DDB ADDRESS
	MOVEI	T1,0		;START WITH CHANNEL
				;ZERO LOOKING FOR ANOTHER
				;LOOKED UP OR ENTERED CHANNEL

	PUSHJ	P,SAVE2##	;SAVE P1-P2
TSTCHN:	HRRZ	P1,USRJDA(T1)	;PICK UP A CHANNEL
	CAME	P1,P2		;SAME DDB?
	JRST	TNXTCH		;NO - TRY NEXT
	TDNN	T2,USRJDA(T1)	;IS CHANNEL LOOK'ED UP
				;OR ENTERED?
	POPJ	P,0		;YES - TOO MANY - FAIL

TNXTCH:	CAMGE	T1,USRHCU	;ANY MORE CHANNELS?
	AOJA	T1,TSTCHN	;YES - GO TRY IT
	JRST	CPOPJ1		;NO - WE'RE OK THEN

	EXTERNAL IADPTR,CPOPJ1,USRHCU,USRJDA
;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
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
	HLLM	F,USRJDA(P1)	;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'T1 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
				;AND TAKE ERROR RETURN

;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
IFN FTKI10!FTKL10,<
	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,440500	;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
FREXIT:	POP	P,T3		;RESTORE T3
	POPJ	P,		;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	FREXIT		;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

;ENTER A FILE NAME IN DIRECTORY
ENTR:	TRNE	S,UDSD		;NON STANDARD?
	JRST	CPOPJ1		;YES. RETURN
	PUSHJ	P,DTRCHK	;MAKE SURE NOT REWINDING
	MOVSI	T2,OCLOSB	;FLAG ENTER
	PUSHJ	P,CHKCHN	;CHECK FOR 2 ENTERS
	POPJ	P,0		;2 OR MORE - ERROR
	PUSHJ	P,GETWDU##	;LOOK AT FIRST ARGUMENT
	JUMPE	T1,CPOPJ##	;ZERO IS AN ERROR
	TLNE	T1,-1		;EXTENDED STYLE ENTER?
	JRST	ENTR1		;NO
	PUSH	P,M		;SAVE M
	ADDI	M,2		;POINT TO .RENAM
	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
				;DON'T1 BOTHER ADDRESS CHECKING-
				;NOW DONE PRIOR TO DESPATCH IN UUOCON
	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,440500	;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
;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,


;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
	HLLM	F,USRJDA(P1)
	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

;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
IFN FTKA10,<
	MOVEI	T1,@T1		;KA10 STYLE RELOCATION
>
	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,DMPCLS+IO+DMPMOD	;SET SWITCHES
	PUSHJ	P,GETDT		;GET CONTROL
	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:
IFN FTKI10!FTKL10,<
	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

IFN FTKA10,<
IFE FTPSCD,<
EWAIT=SLEEP##
>
>
IFN FTKI10!FTKL10!FTPSCD,<
EWAIT:
IFN FTPSCD,<
	AOS	%DTASL##	;NUMBER OF DTA GENERATED SLEEPS
>
IFN FTKI10!FTKL10,<
	SKIPN	DEVEVM(F)	;EVM?
>
	PJRST	SLEEP##		;NO
IFN FTKI10!FTKL10,<
EWAIT1:	PUSHJ	P,RTEVM##	;RETURN EVM
	PUSHJ	P,SLEEP##	;ZZZZZZ
	PJRST	RSTEVM##	;RESTORE EVM
>;END IFN FTKI10!FTKL10
>;END IFN FTKI10!FTKL10!FTPSCD
;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
IFN FTWATCH,<
	SETZM	DEVFIL(F)	;CLEAR FILE AND EXTENSION
	HRRZS	DEVEXT(F)	;SO CONTROL-T DOES NOT PRINT THEM
>
	JRST	STOIOS		;STORE S AND RETURN


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,@DTXWAT##(W)	;GET RESOURCE
	CONO	PI,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
	CONO	PI,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:	CONO	PI,PION		;OK TO LET CLOCK INTERRUPT AGAIN
	JRST	GETDT4		;WAIT TILL AVAL COMES UP
IFN FTKA10,<
	GETDTX==GETDT
>
IFN FTKI10!FTKL10,<
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
>


;DUMP MODE INPUT
DMPI:	IFN	CPBIT, <
	PUSHJ	P,SAVE1##	;SAVE P1
	HRRZ	P1,IBLK(F)	;SET P1=BLOCK TO READ
>
	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
	PUSHJ	P,SLPTST	;SLEEP IF DEAD-RECKONING
	TLZ	S,IO		;MAKE SURE IO=
	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
IFN FTKI10!FTKL10,<
	SKIPN	DEVEVM(F)	;GOT EVM? (COULD 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
	POPJ	P,


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?
	POPJ	P,		;YES. 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


;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
>
	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
IFN FT2REL, <
EXTERN	SAVDDL
>
;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
>
	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
	IFN	CPBIT, <
;HERE TO START DUMP-MODE INTO USER AREA DIRECTLY
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)
	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
>
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
>
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
>
	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
>
	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
READBF:	TLNN	S,DMPMOD	;HAVE CONTROL IF DUMP-MODE
RDBLUK:	PUSHJ	P,GETDT		;GET DT CONTROL

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

;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
>
	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
IFN FTKI10!FTKL10,<
	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
	EXTERN	HNGSTP
;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
	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)
>
	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
	INTERN	SRCH
;INTERRUPT HERE TO READ A BLOCK NUMBER
SRCH:	MOVEM	T1,TEMP(W)	;SAVE WORKING AC
	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
SRCHXT:	MOVE	T1,TEMP(W)	;RESTORE T1
	JRST	DTXXIT(W)	;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
	JRST	SRCHXT		;AND EXIT
SRCHT1:	SETOM	BLOCK(W)	;BLOCK=-1 IS AN ERROR FLAG
	XCT	DTSFNS(W)	;GIVE A FUNCTION STOP
	JRST	SRCHXT		;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?
	JRST	SRCHXT		;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
	JRST	SRCHXT		;AND EXIT THE INTERRUPT
	EXTERNAL	DEVERR
;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?
	JRST	SRCHXT		;YES. FORGET IT
REKON1:	EXCH	T1,TEMP(W)	;RESTORE T1
	JSR	DTDSAV		;SAVE AC'S THROUGH T2
	MOVE	T1,TEMP(W)	;GET DISTANCE TO BLOCK AGAIN
	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:	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,@DTXFRE##(W)	;FREE TD10
	PUSHJ	P,DEVERR	;CAUSE UUOCON TO REENTER ROUTINE AT UUO LEVEL
				; AT WHICH POINT JOB WILL BE PUT TO SLEEP
	JRST	DTDRET		;AND DISMISS INTERRUPT


TRYLTR:	MOVEM	T1,DISTNC(W)
	JRST	DTDRET		;DISMISS INTERRUPT
;ROUTINE TO SAVE SOME AC'S ON THE DATA PI INTERRUPT
	$LOW
DTDSAV:	0
	MOVEM	T2,DTDSV0+T2	;SAVE T2
	MOVEI	T2,DTDSV0	;SAVE 0-T1
	BLT	T2,DTDSV0+T2-1
	MOVE	P,DTDSPD	;SET UP A PD LIST
IFN FTKI10!FTKL10,<
	MOVSI	T2,(IC.UOU)	;LIGHT USER IOT SO NXCMR WILL
	IORM	T2,DTDSAV	; GET THE IOWD FROM USERS AREA
>
	JRST	2,@DTDSAV	;AND RETURN
	$HIGH
DTDRET:	MOVSI	T2,DTDSV0	;RESTORE THE AC'S
	BLT	T2,T2
	JRST	DTXXIT(W)	;AND EXIT THE INTERRUPT


;ROUTINE CALLED ONCE A SECOND ON THE CLOCK
INTERN	DTASEC
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
	MOVSI	T2,RECKON+REWBIT+RUNBIT;DEAD-RECKONING BIT
	CONO	PI,PIOFF
	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,PIOFF
	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,PION
	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:	CONO	PI,PION
	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)
	POP	P,F		;RESTORE F
	POPJ	P,		;AND RETURN

;ROUTINE TO FINISH UP IF A TAPE WAS BEING UNLOADED
EXTERNAL	T2POPJ
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:	MOVE	T1,TEMP(W)
	JSR	DTDSAV		;SAVE ACS THROUGH T2
	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)
	PJRST	DTDRET		;RESTORE ACS AND EXIT

	IFN	CPBIT, <
;HERE WHEN DUMP-MODE POINTER RUNS OUT

EXTERNAL	NXCMR

DMPADV:	JSR	DTDSAV		;SAVE SOME AC'S
	MOVE	F,USEWRD(W)
	LDB	J,PJOBN	;JOB NUMBER
	MOVE	R,JBTADR##(J)	;ADDRESS
	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
	JRST	DTDRET		;AND EXIT THE INTERRUPT


DMPAV3:	XCT	DTSFNS(W)	;GIVE FUNCTION STOP
	SETZM	DTXDMP(W)
	JRST	DTDRET		;AND EXIT THE INTERRUPT

>
;INTERRUPT HERE FOR FLAG CHANNEL
DTXINT:	TRNE	T4,20000	;END ZONE?
	JRST	TURN		;YES TURN TAPE AROUND
	MOVE	F,USEWRD(W)	;RESTORE F
IFN FT5UUO,<
	MOVEM	T4,DEVSTS(F)	;STORE CONI BITS IN DDB
>
	MOVE	S,DEVIOS(F)	;AND S
	LDB	J,PJOBN		;JOB NUMBER
	MOVE	R,JBTADR(J)	;ADDRESS
	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
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
;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,@DTXFRE(W)	;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,THRUTP	;GIVE UP CONTROL IF NOT SEAD-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
;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
>
	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
>
	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:	SETZM	SVDWRD(F)	;ZERO DUMP-MODE STUFF
	SETZM	DMPLST(F)
				;IN IO WAIT?
	PUSHJ	P,SETIOD	;YES. 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
>
	HRRM	J,IBLK(F)	;SAVE IN DDB
	JRST	CPOPJ1
	IFN	CPBIT, <
;HERE WHEN THROUGH DUMP-MODE DIRECTLY TO USER
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
>


;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:
	IFN	CPBIT, <
	TLNN	S,NOBUF		;I/O DIRECT TO USER?
	JRST	ERRS1		;NO
	MOVE	M,SVPNTR(W)	;YES. RESET POINTERS
	MOVEM	M,USPNTR(W)
	MOVEM	M,DMPLST(F)	;STORE M FOR NXT COM
	LDB	J,PJOBN##	;JOB
	MOVE	R,JBTADR##(J)	;ADDRESS
	PUSHJ	P,NXTCOM	;GET FIRST COMMAND AGAIN
	  JRST	PERMER		;WHAT?
	MOVEM	T1,PNTR(W)	;SAVE FIRST IOWD
>
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
DERR:	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
	JRST	BADDIR		;GO PRINT ERROR MESSAGE


SLPNTR:	POINT	7,DEVOAD(F),6

	$LOW
DTDSV0:	BLOCK	T2+1
DTDSPD:	XWD	-45,.
	BLOCK	45
	$LIT


DTAEND:	END