Google
 

Trailing-Edge - PDP-10 Archives - BB-BT99T-BB_1990 - 10,7/mon/tapuuo.mac
There are 13 other files named tapuuo.mac in the archive. Click here to see a list.
TITLE	TAPUUO - MAGTAPE USER INTERFACE FOR TOPS10- V442
SUBTTL	T.HESS/TAH/TW/GMU/DPM	17-APR-90

	SEARCH	F,S,DEVPRM
	$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
; 1974,1975,1976,1977,1978,1979,1980,1982,1984,1986,1988,1990.
;ALL RIGHTS RESERVED.

.CPYRT<1974,1990>


XP VTPUUO,442		;DEFINE VERSION NUMBER FOR STORAGE MAP
	SALL

TAPUUO::ENTRY	TAPUUO

;DISPATCH TABLE

	POPJ	P,		;(-5) OFFLINE
	JRST	ECOD2##		;(-4) SPECIAL ERROR STATUS
	JRST	REGSIZ##	;(-3) USE DEFAULT
	JRST	TPMINI		;(-2) INITIATION
	JRST	TPMHNG		;(-1) HUNG DEVICE
TPMDSP::JRST	TPMREL		;(0) RELEASE
	JRST	TPMCLS		;(1) CLOSE OUTPUT
	JRST	TPMOUT		;(2) OUTPUT
	JRST	TPMIN		;(3) INPUT
	JRST	TPMENT		;(4) ENTER
	JRST	TPMLKP		;(5) LOOKUP
	JRST	TPMDOU		;(6) DUMP OUTPUT
	JRST	TPMDIN		;(7) DUMP INPUT
	POPJ	P,		;(10) USETO
	POPJ	P,		;(11) USETI
	POPJ	P,		;(12) UGETF
	JRST	CPOPJ1##	;(13) RENAME
	JRST	TPCLSI		;(14) CLOSE INPUT
	POPJ	P,		;(15) UTPCLR
	JRST	MTAPE0		;(16) MTAPE UUO

IFE FTTLAB,<
TPMENT==CPOPJ1##		;DUMMY ENTRIES
TPMLKP==CPOPJ1##
TPCLSI==CPOPJ##
> ;END IFE FTTLAB
;RANDOM DDB BYTE POINTERS

TDYMOD:	POINT 3,TDVSTS(F),10
TDYMD1:	POINT 3,TDVSTS(F),31		;FOR SET FORMAT
TDYDEN:	POINT 4,TDVSTS(F),7
TDYDN1:	POINT 4,TDVSTS(F),35		;FOR SET DENSITY
TDYBYT:	POINT 8,TDVSTS(F),10		;PARITY/DENSITY/MODE
	TDMDBY==170			;MASK OF DENSITY IN PAR/DEN/MODE
PDENS:	POINT 2,DEVIOS(F),28		;DENSITY (SETSTS)
PBUFRM:	POINT 14,DEVOAD(F),13		;MAXIMUM FRAME COUNT

;RANDOM DDB STATUS

D.RDBK==(1B0)		;READ BACKWARDS
D.NRLT==(1B1)		;NEXT RECORD AT LOW THRESHOLD
			;(1B2) UNUSED
D.EPAR==(1B3)		;USE EVEN PARITY (7TK ONLY)

;BITS IN S (DEVIOS)

IOERRS==IODERR!IODTER!IOBKTL!IOIMPM ;ALL I/O ERRORS
OFFLIN==(1B1)		;UNIT IS OFF LINE
OFLUNH==(1B2)		;OFF-LINE UNIT NOT READY
IFN FTTLAB,<
FINP==(1B3)		;FIRST INPUT OPERATION
LBLNED==(1B4)		;LABELING ACTION NEEDED
LBLWAT==(1B5)		;WAITING FOR LABEL PROCESS
LBLSTP==(1B6)		;STOP I/O BECAUSE OF ERROR
FOUT==(1B7)		;FIRST OUTPUT OPERATION
FSTOP==FINP!FOUT	;FIRST I/O OPERATION
LBLEOF==(1B8)		;EOF SEEN
> ;END IFN FTTLAB
;BITS IN DEVIAD
OFLHNG==(1B0)		;HUNG DEVICE (MUST BE SIGN BIT)
MTSNAR==:(1B9)		;SET-RETRY BIT (UUOCON,COMCON USE)
IOSRTY==:(1B10)		;IF ON, NO ERROR RETRY (TXIKON)
IOSCP2==:(1B11)		;STARTING IO FROM 2ND CPU

;MISCELLANEOUS STUFF
ST.FAC==1B0		;UPADTE DENSITY IN OTHER DDB
	 .ORG	DEVLEN
TDVUDB::!BLOCK	1		;LH = UDB PNTR
TDVSTS:!BLOCK	1		;UNIT STATUS INFO
TDVIOR::!BLOCK	1		;IORB TO WAIT FOR
TDVSUL:!BLOCK	1		;SAVED USER UPPER LIMIT
TDVSLL:!BLOCK	1		;SAVED USER LOWER LIMIT
TDVSVM:!BLOCK	1		;SAVED M FOR DUMP MODE
TDVREM:!BLOCK	1		;REMAINDER FOR MODE 16
TDVLEN::!			;LENGTH OF TAPE DDB

	 .ORG

	$LOW

TDVDDB::DDBBEG	(TDV,TDVLEN)
	SETWRD	(DEVCHR,<MTSIZ##+1>)		;DEVCHR
	SETWRD	(DEVSER,<MCSEC0+TPMDSP>)	;DEVSER
	SETWRD	(DEVMOD,<DVLNG!1023,,154403+<1_BYTMOD>>) ;DEVMOD
	SETWRD	(DEVTYP,<<.TYMTA*.TYEST>!DEPLEN,,DEPEVM>);DEVTYP
	SETWRD	(DEVCPU,<600000,,TAPCHN##>)	;DEVCPU
	DDBEND
	$HIGH
;POINTERS TO LABEL STATUS WORD IN UDB

IFN FTTLAB,<
TUYLTP::POINT	4,TUBLBL(U),35	;LABEL TYPE
TUYRQT:	POINT	4,TUBLBL(U),27	;REQUEST TYPE CODE
TUYINF:	POINT	6,TUBLBL(U),23	;ADDITIONAL INFO
TUYJBN:	POINT	9,TUBLBL(U),17	;JOB NUMBER

; BITS AND PIECES IN THE TAPE LABEL INFORMATION BLOCK

TUYFCT:	POINT	18,TUBRFM(U),17	;FORMS CONTROL BYTE
   .TFCNO==1			   ;NO FORMS CONTROL
   .TFCAS==2			   ;1ST CHAR IS FORMS CONTROL
   .TFCAM==3			   ;RECORD CONTAINS ALL FORMS CONTROL
TUYRFM:	POINT	18,TUBRFM(U),35	;RECORD FORMAT BYTE
   .TRFDF==0			   ;DEFAULT
   .TRFFX==1			   ;FIXED
   .TRFVR==2			   ;VARIABLE
   .TRFSP==3			   ;SPANNED
   .TRFUN==4			   ;UNDEFINED
TUYRSZ:	POINT	36,TUBRCC(U),35	;RECORD SIZE
TUYBSZ:	POINT	36,TUBBKL(U),35	;BLOCK SIZE
TUYECR:	POINT	18,TUBEXP(U),17	;CREATION DATE (15-BIT FORMAT)
TUYEEX:	POINT	18,TUBEXP(U),35	;EXPIRATION DATE (15-BIT FORMAT)
TUYPRT:	POINT	36,TUBPRT(U),35	;PROTECTION CODE
TUYPSN:	POINT	36,TUBPSN(U),35	;FILE SEQUENCE NUMBER
TUYFNM:	POINT	 7,TUBFNM(U)	;START OF 17 CHARACTER FILE.EXT
TUYGEN:	POINT	18,TUBGVR(U),17	;GENERATION NUMBER
TUYVER:	POINT	18,TUBGVR(U),35	;VERSION NUMBER

; TABLE OF CHARACTERS PER WORD INDEXED BY TAPE MODE
CPWTBL:	EXP	5		;EITHER EQUIV TO 1 OR ILLEGAL
	EXP	5		;DEC CORE DUMP
	EXP	4		;INDUSTRY COMPATIBLE
	EXP	6		;TU70 SIXBIT
	EXP	5		;ANSI ASCII
	EXP	6		;7-TRK CORE DUMP

> ;END IFN FTTLAB

PMTCRC::POINT	9,TUBCHR(U),26	;LAST 9TK CRC (NRZI)
PMTNCR::POINT	3,TUBCHR(U),29	;BYTE RESIDUE OF LAST WORD
PMTRTY:	POINT	1,DEVIOS(F),9	;RETRY BIT

SUBTTL INPUT UUO
TPMIN::	PUSHJ	P,SAVE2##	;SAVE P1,P2
	PUSHJ	P,INSET		;SET UP ACS ETC.
IFN FTTLAB,<
	TLZN	S,LBLSTP	;LBL PCS WANT US TO STOP?
	JRST	TPMINA		;NO - PROCEED
	TRNN	S,IODEND	;EOF ONLY?
	PJRST	TPSTP0		;NO - RETURN
	MOVEI	P1,0		;YES - FIX THINGS FOR UUOCON
	PJRST	RDEOF		;...
> ;END IFN FTTLAB
TPMINA:	PUSHJ	P,SETRED	;SET READ OP
	PUSHJ	P,GENIOR	;GENERATE IORB
	  JRST	TPMINF		;WHOOPS (UNABLE TO GET STORAGE)
IFN FTMP,<
	PUSHJ	P,TPMACC	;IF CONT ON OTHER CPU
	  PJRST	PCLINP		; DO IT DIFFERENTLY
> ;END IFN FTMP
	MOVEI	T2,DEPAIO	;ASYNC I/O?
	TDNE	T2,DEVAIO(F)
	JRST	QUEINP		;YES - GO QUEUE INPUT REQUEST
	MOVEM	T1,TDVIOR(F)	;NO - REMEMBER THIS IORB
	XMOVEI	T2,TPMIN1	;HACK LOCATION
	MOVEM	T2,IRBIVA(T1)	;DEFEND AGAINST KONWAT
	PUSHJ	P,TAPRQT##	;PLACE AT END OF QUEUE
	PUSHJ	P,KONWAT	;WAIT FOR KONTROLLER
				;RETURN HERE P1 := IORB
	SKIPGE	TRBFNC(P1)	;AOK??
	JRST	TPMFLS		;FLUSH REQUEST ARE RETURN TO USER
	SKIPN	DEVEVM(F)	;HAVE EVM?
	PUSHJ	P,RSTEVM##	;NO - GET IT IF NECESSARY
TPMIN1:	PUSHJ	P,TPMXCI	;RELOCATE DEVIAD & XCT .+1
	  EXCTUX <LDB T2,[POINT 17,0(T1),17]> ;SIZE OF BUFFER
IFN FTKS10,<
	CAILE	T2,^D7682	;MAX # WORDS GUARANTEED NOT TO RUN OUT
	JRST	TPMFLS		;OF MAPPING REGS (1 WORD ON LAST WORD OF PAGE
				; + 15 FULL PAGES) +1 (T2:=BUFFER SIZE +1)
> ;END IFN FTKS10
	SOJLE	T2,TPMFLS	;LOSE IF TOO SMALL (0 OR 1)
	MOVNS	T2		;NEGATE SIZE
	HRLZS	T2		;TO LH
	HRRI	T2,1(T1)	;MAKE GENUINE IOWD
	MOVE	T1,P1		;IORB PNTR IN T1
	SETZ	T4,		;DO WHOLE BUFFER
	PUSHJ	P,MAKLST	;GET IOWD LIST
	  JRST	TPMFLS		;FLUSH IF NO SPACE
	TRO	S,IOACT		;SET I/O ACTIVE
	PUSHJ	P,STORS7##	;STORE S
	XMOVEI	T1,INPDUN	;WHERE TO GO WHEN DONE
	MOVEM	T1,IRBIVA(P1)	;STORE IT
TPSWST:
IFN FTKS10,<
	TLNN	S,IO		;DON'T SWEEP IF OUTPUT ON KS10
>
	PUSHJ	P,TPMSWP	;SWEEP CACHE IF NOT TM10A
TPSTRT:	MOVE	T1,P1		;IORB TO T1 FOR TAPSER
	PJRST	TAPSIO##	;TELL TAPSER TO TAKE IT AWAY


;ROUTINE TO FLUSH REQUEST AND RETURN IORB / SET IMPROPER MODE

TPMFLS:	PUSHJ	P,TAPFLS##	;FLUSH UNIT
	PUSHJ	P,TPMRI1	;T1 := IORB
	PUSHJ	P,SETIOD##	;REVIVE USER
	PUSHJ	P,CLRACT##	;CLEAR I/O ACTIVE
	PUSHJ	P,TAPCTM##	;CLEAR HUNG TIMER

;ROUTINE TO SET IMPROPER MODE AND RETURN

TPMINF:	PUSHJ	P,RTEVM##	;RETURN RESOURCES
	TRO	S,IOIMPM	;LITE A BIT
	PJRST	STOIOS##	;STORE S AND RETURN
;HERE WHEN INPUT DONE
;U,W,F SETUP  AND P1=IORB
INPDUN:	PUSHJ	P,SETIOS	;SET UP S AND CHECK ERRORS
	  JSP	P2,INPERR	;PONDER PROBLEM
	MOVE	T1,P1		;COPY IORB PNTR TO T1
	LDB	T2,PRBFCN##	;GET FCN
	CAIN	T2,RB.FRB	;READ BACKWARDS?
	TRNN	S,IOBOT		;YES - AT BOT?
	TRNE	S,IODEND	;SEEN EOF?
	JRST	RDEOF		;YES - TELL HIM
	LDB	P2,PRBMOD##	;GET MODE
	MOVE	P2,TMODTB##(P2)	;NO. OF BYTES PER WORD
	LDB	T2,PIOMOD##
	CAIN	T2,BYTMOD	;BUT IF IN BYTE MODE
	SETZ	P2,		; NO CONVERSION OF BYTE COUNT
IFN FTMP,<
	PUSHJ	P,STONBF##	;UPDATE LH(DEVNBF) IF POSSIBLE
	AOS	DEVNBF(F)	;COUNT 1 MORE RECORD READ
> ;END IFN FTMP
	PUSHJ	P,SVEUF##	;MAKE JOB ADDRESSABLE
	PUSHJ	P,SPCS##	;ALSO SETUP PCS
IFN FTKL10,<
	MOVE	T1,TKBCNT(W)	;NUMBER OF RECORDS WE DID
	SOJLE	T1,INPDN2	;IF MORE THAN 1,
IFN FTMP,<ADDM	T1,DEVNBF(F)>	;UPDATE NO OF RECS READ IN DDB

INPDN1:	SOSG	TKBCNT(W)	; (WOULD HAVE STOPPED EARLY ON LENGTH ERROR
	JRST	INPDN2		; IF THE WRDCNT WAS WRONG)
	MOVE	T1,DEVIAD(F)
	EXCTUX	<MOVE T2,1(T1)>	;GET BYTE COUNT
	ADDM	T2,TUBCRD(U)	;UPDATE TOTAL CHARS READ
	LDB	T4,PRBMD2##	;GET MODE
	PUSHJ	P,CHR2WD	;CONVERT TO WORDCOUNT
	EXCTUU	<MOVEM T2,1(T1)>	;STORE WRDCNT IN BUFFER
	PUSHJ	P,ADVBFI##	;MOVE TO NEXT BUFFER
	  TLOA	P1,400000	;FLAG NOT TO CALL ADVBFX AGAIN
	JRST	INPDN1		;AND KEEP ON GOING
INPDN2:
> ;END IFN FTKL10
	LDB	T4,PRBMD2##	;GET MODE
IFN FTKL10,<
	MOVSI	T2,RB.SEN	;AN ERROR IN NEXT RECORD (CHAN CHAINING)?
	TDNE	T2,TRBSTS(P1)	; (BUT THIS RECORD IS OK)
	JRST	[ANDCAM T2,TRBSTS(P1)	;YES - HENCE RECORD LENGTH IS RIGHT
		 PUSHJ  P,TPMXCI	;SO GET BYTE COUNT OUT OF BUFFER
		   EXCTUX <MOVE T2,1(T1)> ; WHERE DX10 STORED IT
		 MOVEM  T2,TRBRCT(P1)
		 JRST   INPDN3]
> ;END IFN FTKL10
	MOVE	T2,TRBRCT(P1)	;GET CHARS READ
INPDN3:	MOVEM	T2,TUBCCR(U)	;SAVE COUNT FOR TAPOP
	PUSHJ 	P,TPMXCI	;SET UP FOR PXCT
	  EXCTUX <LDB T3,[POINT 17,0(T1),17]> ;GET BUFFER SIZE+1 IN WORDS
	SOS	T3		;BUFFER SIZE
	IMUL	T3,TMODTB##(T4)	;GET BUFFER SIZE IN FRAMES
	CAILE	T2,(T3)		;RECORD .LTE. BUFFER
	MOVEI	T2,(T3)		;NO, USE BUFFER SIZE
	PUSHJ	P,CHR2WD	;CONVERT FC TO WC OR BC
	PUSHJ	P,TPMXCI	;GET C(DEVIAD) AGAIN
	  EXCTUU <MOVEM	T2,1(T1)>	;STORE IN HEADER
	PUSHJ	P,TPMRCW	;RETURN XFER LIST
	TLZN	P1,400000	;HAVE AN ADDRESS CHECK EARLIER (DX10)?
	PUSHJ	P,ADVBFF##	;ADVANCE BUFFERS
	  JRST	TPSWSP		;NO MORE STOP IO
IFN FTMP,<
	HRRZ	T1,DEVIAD(F)	;NEXT BUFFER OK WRT CACHE
	PUSHJ	P,BUFSSN##
	  JRST	TPSWSP		;NO, STOP I/O
> ;END IFN FTMP
	PUSHJ	P,SETIOD##	;REVIVE USER
	MOVEM	S,DEVIOS(F)	;SAVE CORRECT IOS
	MOVE	T1,P1		;SET UP IORB PNTR
	LDB	P2,PRBFCN##	;GET FCN BACK
	PUSHJ	P,TPIOGO	;SET IORB
	  JRST	TPSWSP		;NO MORE - STOP I/O
	JRST	TPMIN1		;START NEXT READ

;SUBROUTINE TO CONVERT BYTE-COUNT TO WORD-COUNT
;ENTER T2=BYTE COUNT, P2=NO OF BYTES PER WORD, P2=0 IF BYTE MODE
;EXIT T2=WORDCOUNT
CHR2WD:	JUMPE	P2,FCTOBC
	IDIVI	T2,(P2)
	JUMPE	T3,CPOPJ##
	AOJA	T2,CPOPJ##

;SUBROUTINE TO CONVERT FRAME COUNT TO BYTE COUNT
;ENTER T4=PRBMOD, T2=FRAME COUNT
;EXIT T2=BYTE COUNT
FCTOBC:	PUSHJ	P,SAVE3##
	HRRZ	P1,DEVBUF(F)	;BUFFER HEADER BLOCK ADDR
	EXCTUX	<LDB P3,[POINT 6,1(P1),11]>	;BYTE SIZE
	CAMN	P3,TMODFS##(T4)	;BYTE SIZE = FRAME SIZE ?
	POPJ	P,		;YES, BYTE COUNT = FRAME COUNT
	IDIV	T2,TMODTB##(T4)	;NO, CALCULATE BYTE COUNT
	MOVEI	P1,44		;WORD LENGTH
	IDIVI	P1,(P3)		;36/ BYTE SIZE
	IMULI	T2,(P1)		;# WORDS * BYTES PER WORD
	SKIPN	P1,T3		;EXTRA FRAMES ?
	POPJ	P,		;NO
	IMUL	P1,TMODFS##(T4)	;YES, EXTRA FRAMES * FRAME SIZE
	ADDI	P1,-1(P3)	;ROUND UP
	IDIVI	P1,(P3)		;/ BYTE SIZE
	ADD	T2,P1		;ADD EXTRA BYTES
	POPJ	P,
TPIOGO:	TRNN	S,IOTEND!IOERRS	;ANY ERRORS / EOT
	PUSHJ	P,QDECR		;DECREMENT QUANT
	  POPJ	P,		;NO MORE - RETURN
	MOVE	T1,P1		;GET IORB PNTR
	MOVEI	T2,RB.ACT	;MARK REQUEST ACTIVE
	PUSHJ	P,STOIOR	;STORE INFO IN IORB
	  JFCL			;NO WAY
	PJRST	CPOPJ1##	;GIVE SKIP RETURN


;ROUTINE TO HANDLE EOF/BOT AND STOP TAPE

RDEOF:	TRZ	S,IODEND	;CLEAR EOF
	TLO	S,IOEND		;SAY PAYS END SEEN
	PUSHJ	P,TPMXCI	;GET C(DEVIAD)
	  EXCTXU <MOVEM S,-1(T1)>  ;STORE IOS IN BUFFER HEADER
IFN FTTLAB,<JUMPE P1,TPSTP0>	;JUMP IF NO IOLIST
	PUSHJ	P,TPMRCW	;RETURN CCW LIST

TPMSTP:	PUSHJ	P,TPMRIO	;RETURN IORB
TPSTP0:	PUSHJ	P,RTEVM##	;RETURN EVM IF ANY
	TRZ	S,IOACT		;FIGHT DUAL-CPU RACE
	PUSHJ	P,SETIOD##	;REVIVE HIM
	PUSHJ	P,CLRACT##	;CLEAR I/O ACTIVE
	PUSHJ	P,TAPCTM##	;CLEAR HUNG TIMER
	HLLZS	TKBSTS(W)	;SET CNTR TO ZERO
	PJRST	STOIOS##	;STASH IOS & EXIT
TPSWSP:	PUSHJ	P,TPMSWP	;SWEEP CACHE IF NOT TM10A
	JRST	TPMSTP		;NOW STOP IO

;ROUTINE TO RETURN IOWD LIST , P1 := IORB

TPMRCW:
IFN FTKL10,<
	HRRE	T1,@IRBACC(P1)	;FETCH CHANNEL COMMAND LIST
	CAIG	T1,100		;ALLOW FOR COUNT
	POPJ	P,		;RETURN
	PJRST	RTNIOW##	;ELSE RETURN WHOLE LIST
> ;END IFN FTKL10
IFN FTKS10,<POPJ P,>		;RETURN


;ROUTINE TO RETURN IORB AND DE-Q IT

TPMRIO:	PUSHJ	P,TAPREM##	;HAVE TAPSER PRUNE QUEUE
				; RETURN PNTR TO IORB IN T1
TPMRI1:	MOVE	T2,T1		;GIVWDS LIKES IT IN T2
	MOVEI	T1,TRBLEN	;# OF WORDS
	PJRST	GIVWDS##	;RETURN CORE

;ROUTINE TO DECREMENT KONTROLLER QUANTA - SKIP RETURN IF NON-ZERO

QDECR:	HRRZ	T1,TKBSTS(W)	;GET QUANTA
	SOSL	T1		;DECR SKIP IF NEG
	HRRM	T1,TKBSTS(W)	;STORE RESULT
	JUMPG	T1,CPOPJ1##	;SKIP RET IF STILL POSITIVE
	POPJ	P,		;QUANTUM GONE TO 0, GIVE UP
SUBTTL	OUTPUT UUO

TPMOUT:	PUSHJ	P,SAVE2##	;SAVE P1,P2
	PUSHJ	P,OUTSET	;SET UP FOR OUTPUT
	SKIPGE	TUBREC(U)	;IS RECORD COUNT NEGATIVE?
	SETZM	TUBREC(U)	;YES, INITIALIZE TO ZERO
IFN FTTLAB,<
	TLZE	S,LBLSTP	;WANT TO STOP NOW?
	JRST	TPSTP0		;STOP ON LABEL ERROR
> ;END IFN FTTLAB
	MOVEI	P2,RB.FWT	;FUNCTION WRITE
	PUSHJ	P,GENIOR	;MAKE AN IORB
	  JRST	TPMINF		;UNABLE TO GET STORAGE
IFN FTMP,<
	PUSHJ	P,TPMACC	;IF ON OTHER CPU
	  JRST	PCLOUT		; DO IT DIFFERENTLY
> ;END IFN FTMP
	MOVEI	T2,DEPAIO	;ASYNC I/O?
	TDNE	T2,DEVAIO(F)
	JRST	QUEOUT		;YES - GO QUEUE OUTPUT REQUEST
	MOVEM	T1,TDVIOR(F)	;NO - WAIT FOR THIS ONE
	XMOVEI	T2,TPMOU1	;HACK LOCATION
	MOVEM	T2,IRBIVA(T1)	;DEFEND AGAINST KONWAT
	PUSHJ	P,TAPRQT##	;QUEUE IT UP
	PUSHJ	P,KONWAT	;WAIT FOR CONTROLLER
				;RETURN WITH P1 := IORB
	SKIPGE	TRBFNC(P1)	;THINGS IN SHAPE
	JRST	TPMFLS		;NO - U LOSE
	SKIPN	DEVEVM(F)	;HAVE EVM
	PUSHJ	P,RSTEVM##	;NO - GET IT IF NECESSARY
				;FALL INTO TPMOU1
TPMOU1:	PUSHJ	P,TPMXCO	;GET C(DEVOAD)
	  EXCTUX <HRRZ	T2,1(T1)>	;GET WORD COUNT FROM BUFFER
	JUMPE	T2,ADVOUT	;HANDLE EMPTY BUFFER SPECIAL
	LDB	T3,PIOMOD##	;MODE OF DDB
	CAIE	T3,BYTMOD	;BYTE MODE?
	JRST	[SETZM T4	;NO
		   JRST TPMOU2]
	LDB	T3,PRBMD2##	;YES, CONVERT TO WORDS
	MOVE	T4,T2		;KEEP BYTE COUNT AROUND
	IDIV	T2,TMODTB##(T3)
	SKIPE	T3
	ADDI	T2,1		;T2=NUMBER OF WORDS
TPMOU2:	PUSHJ	P,TPMXCO	;GET BUFFER SIZE
	EXCTUX	<LDB T3,[POINT 17,0(T1),17]>
IFN FTKS10,<
	CAIG	T2,^D7621	;MAX # WORDS GUARANTEED NOT TO RUN OUT
				;OF MAPPING REGS (1 WORD ON LAST WORD OF PAGE
				; + IS FULL PAGES)
> ;END IFN FTKS10
	CAILE	T2,-1(T3)	;OK?
	JRST	SETIMP		;NO, LIGHT AN ERROR BIT
	MOVNS	T2		;-N
	HRLZS	T2		;PUT IN LH
	HRRI	T2,1(T1)	;BUFFER ADDRS
	MOVE	T1,P1		;IORB PNTR TO T1
	PUSHJ	P,MAKLST	;MAKE CHL XFER LIST
	  JRST	TPMFLS		;FLUSH REQUEST
	TRO	S,IOACT		;SET I/O ACTIVE
	PUSHJ	P,STORS7##	;STORE S
	XMOVEI	T1,OUTDUN	;WHERE TO GO WHEN FINISHED
	MOVEM	T1,IRBIVA(P1)	;STORE IN IORB
	PJRST	TPSWST		;START DEVICE
;HERE WHEN OUTPUT DONE, P1 := IORB
OUTDUN:	PUSHJ	P,SETIOS	;SET UP S W/ TAPE INFO
	  JSP	P2,OUTERR	;TRY TO FIX WRITE ERROR
	PUSHJ	P,SETIOD##	;REVIVE USER
	PUSHJ	P,STORS7##	;SAVE S IN DDB
	PUSHJ	P,TPMRCW	;RETURN XFER LIST
IFN FTTLAB,<
	TRNE	S,IOTEND	;EOT SEEN YET?
	JRST	LBLEOT		;YES - INVOKE LBL PCS
> ;END IFN FTTLAB
IFN FTKL10,<
	PUSHJ	P,SVEUF##	;SET UP ADDRESSING (ADVBFO DOESN'T)
	PUSHJ	P,SPCS##	;AND PCS
OUTDN1:	SOSG	TKBCNT(W)	;FOR ALL BUT THE LAST BUFFER,
	JRST	OUTDN2
	PUSHJ	P,ADVBFO##	;TELL UUOCON THAT IT'S FULL
	  JRST	TPMSTP		;OOPS, ADDRESS CHECK, ETC.
	JRST	OUTDN1		;AND TRY THE NEXT
OUTDN2:
> ;END IFN FTKL10
	PUSHJ	P,ADVBFE##	;ADVANCE BUFFER
	  JRST	TPMSTP		;NO MORE STOP IO
	MOVEI	P2,RB.FWT	;TRY TO WRITE ON
IFN FTMP,<
	MOVSI	T2,-1		;IF NEXT BUFFER WAS NOT SWEPT
	TDNE	T2,DEVNBF(F)	; SHUT DOWN THE TAPE
> ;END IFN FTMP
	PUSHJ	P,TPIOGO	;...
	  JRST	TPMSTP		;NO MORE RETURN
	JRST	TPMOU1		;CONTINUE WRITING
;HERE TO ADVANCE BUFFER IF ONE FOUND EMPTY

SETIMP:	TRO	S,IOIMPM	;USER FIDDLED WITH BUFFER HEADER
ADVOUT:
IFN FTMP,<
	PUSHJ	P,CHKCPI##	;UUOCON HAS INCREMENTED DEVNBF
	  SKIPA	T1,[-1]		; BUT WE WON'T GET TO MAKLST
	MOVSI	T1,-1		; TO COUNT IT DOWN
	ADDM	T1,DEVNBF(F)	; SO MAKE DEVNBF RIGHT
> ;END IFN FTMP
	PUSHJ	P,ADVBFE##	;CYCLE
	  SKIPA			;NO NEXT BUFFER
	JRST	TPMOU1		;TRY THIS ONE
	PUSHJ	P,SETIOD##	;REVIVE USER
	PUSHJ	P,CLRACT##	;CLEAR I/O ACTIVE
	PUSHJ	P,TAPCTM##	;CLEAR HUNG TIMER
TPMFLX:	PUSHJ	P,TAPFLS##	;ELSE FLUSH REQUEST
	PUSHJ	P,TPMRI1	;RETURN IORB
	PJRST	RTEVM##		;AND EVM IF ANY

IFN FTTLAB,<
;ENTER HERE TO PROCESS EOT AND SEND MSG TO LBL PCS

LBLEOT:	PUSHJ	P,ADVBFE##	;ADVANCE BUFFERS
	  JFCL			;IGNORE
	PUSHJ	P,LBLCHK	;LABEL PROCESSING?
	SKIPA			;YES - SEND MSG ETC.
	PJRST	TPMSTP		;ELSE PROCESS AS BEFORE
	LDB	T1,TUYLTP	;GET LABEL TYPE.
	CAIN	T1,LT.NLV	;SHOULD USER SEE EOT?
	JRST	TPMSTP		;YES, GIVE IT TO THEM
	TLO	S,LBLNED	;NO GIVE IT TO LBL PCS NEXT TIME.
	TRZ	S,IOTEND	;CLEAR EOT NOW
	MOVEI	T1,LR.EOT	;SET TYPE EOT
	DPB	T1,TUYRQT	; IN LBL MESSAGE
	PJRST	TPMSTP		;  AND STOP IO
> ;END IFN FTTLAB
SUBTTL DUMP-MODE I/O
TPMDOU:	PUSHJ	P,SAVE2##	;SAVE P1,P2
	PUSHJ	P,OUTSET	;SET FOR OUTPUT
	SKIPGE	TUBREC(U)	;IS RECORD COUNT NEGATIVE?
	SETZM	TUBREC(U)	;YES, INITIALIZE TO ZERO
	JRST	TPMDMP		;TO COMMON ROUTINE

TPMDIN:	PUSHJ	P,SAVE2##	;SAVE P1,P2
	PUSHJ	P,INSET		;SET FOR INPUT
TPMDMP:
IFN FTTLAB,<
	TLZE	S,LBLSTP	;LBL ERROR?
	POPJ	P,		;YES, RETURN NOW
> ;END IFN FTTLAB
	PUSHJ	P,DMPSET	;SET UP IORB & WAIT FOR CTL
	  PJRST	TPMINF		;LOSAGE
	PUSHJ	P,COMCHK##	;GET 1ST IOWD & BOUNDARIES
	JUMPN	S,ADRXIT	;ADDRESS CHECK?
	MOVE	S,DEVIOS(F)	;RESTORE S
	JUMPE	T1,TPMFLS	;OR NULL LIST - EXIT
	PUSHJ	P,SAVT##	;SAVE T1 (IOWD)
	MOVEM	T2,TDVSUL(F)	;SAVE USER UPPER LIMIT
	MOVEM	T3,TDVSLL(F)	;  AND USER LOWER LIMIT
TPDNXT:	MOVEM	M,TDVSVM(F)	;  AND M (UUO)
	MOVEM	T1,-1(P)	;SAVE T1 IN CASE OFL
IFN FTKS10,<
	TRNN	S,1B35		;MODE 16?
	TLNN	S,IO		;YES, OUTPUT?
	SKIPA			;NO, CHECK FOR BIG IOWD
	JRST	TPDNX1		;YES, DON'T CHECK (ADIIOW WILL FIX)
	HLRZ	T2,T1		;MAX # WORDS GUARANTEED NOT TO RUN OUT
	CAIGE	T2,^D-7681	;OF MAPPING REGISTERS
	JRST	TPMFLS		;(1 WORD ON LAST WORD OF PAGE + 15 FULL PAGES)
TPDNX1:
> ;END IFN FTKS10
	PUSHJ	P,ADJIOW	;ADJUST IOWDS IF NECESSARY
				;RETURNS IOWD IN T2
	PUSHJ	P,TPMDGO	;START I/O
	  JRST	TPMFLS		;CAN'T - MAKLST LOST
	MOVE	M,TDVSVM(F)	;RESTORE M
	PUSHJ	P,WAIT1##	;WAIT FOR I/O TO CEASE
	TLNN	S,IO		;WRITING?
	PUSHJ	P,TPMSWP	;NO, MUST SWEEP CACHE
IFN FTTLAB,<
	PUSHJ	P,LBLCKS	;CHECK FOR LABEL EXPECTED
	  JFCL			;IGNORE THIS RETURN
	TLNE	S,LBLNED	;NEED LABELS?
	PUSHJ	P,LBLMSG	;YES, SEND THE MESSAGE
	TLZ	S,LBLSTP	;GET RID OF THIS BIT
	MOVEM	S,DEVIOS(F)	;SAVE NEW STATUS
> ;END IFN FTTLAB
	TLNE	S,IOSTBL	;ARE WE IN TROUBLE?
	JRST	TPDOFL		;YES - CHECK OFFLINE
	TRNE	S,IODEND!IOBOT!IOERRS	;ERRORS?
	POPJ	P,		;YES - EXIT
	PUSHJ	P,DMPSET	;GEN IORB FOR NEXT IOWD
	  PJRST	TPMINF		; NO ROOM - LOSE
	MOVE	M,TDVSVM(F)	;RESTORE SAVED STUFF
	MOVE	T2,TDVSUL(F)
	MOVE	T3,TDVSLL(F)	;...
	PUSHJ	P,NXCMR##	;GET NEXT IOWD
	JUMPN	S,ADRXIT	;JUMP IF ADR CHK
	MOVE	S,DEVIOS(F)	;S CLOBBERED BY NXCMR!
	JUMPE	T1,TPMFLX	;ALL DONE IF ZERO
	JRST	TPDNXT		;SAVE M AND TRY NEXT
;ROUTINE TO HANDLE OFF-LINE UNIT IN DUMP MODE

TPDOFL:	TLZ	S,OFFLIN!IOSTBL	;CLEAR BITS
	PUSHJ	P,CKTC10	;CHECK TC10 CROCK
	  PUSHJ	P,HNGSTP##	;CALL ATTEN TO OURSELVES
	PUSHJ	P,DMPSET	;GEN IORB ETC.
	  PJRST	TPMINF		;NO ROOM
	MOVE	T1,-1(P)	;RESTORE IOWD
	JRST	TPDNXT		;TRY AGAIN
;ROUTINE TO START DUMP MODE I/O

TPMDGO:	MOVE	T1,P1		;IORB TO T1
	SETZ	T4,		;NOT BYTE-MODE, DO ALL OF IOWD
	PUSHJ	P,MAKLST	;GEN IO XFER LIST
	  POPJ	P,		;WHOOPS
	CONSO	PI,II.IPA	;DON'T SET IF AT INT LVL
	PUSHJ	P,SETACT##	;SET I/O ACTIVE
	HLLOS	TKBSTS(W)	;GRNTEE CONTROLLER
	XMOVEI	T1,DMPDUN	;WHERE TO GO WHEN DONE
	MOVEM	T1,IRBIVA(P1)	;SAVE IN IORB
	AOS	0(P)		;GIVE SKIP RETURN
	PJRST	TPSWST		;GO START DEVICE

;COME HERE ON DONE INTERUPT FOR DUMP MODE I/O

DMPDUN:	PUSHJ	P,SETIOS	;SET UP S
	  JSP	P2,DMPERR	;ERROR RETURN
	PUSHJ	P,TPMRCW	;RETURN XFER LIST
	MOVE	T2,TRBRCT(P1)	;BYTE COUNT OF LAST REC
	MOVEM	T2,TUBCCR(U)	;SAVE FOR TAPOP
	TRNN	S,IODEND!IOBOT!IOERRS	;ERRORS?
	SKIPN	T1,TDVREM(F)	;ANY PARTIAL LEFT?
	JRST	TPMSTP		;STOP NOW
	PUSHJ	P,ADJIOW	;MUNG IOWD IF NECESSARY
	TLNN	S,IO		;INPUT?
	SKIPE	TDVREM(F)	;YES - DONE?
	SKIPA	T1,P1		;NO - PROCEED
	JRST	TPMSTP		;YES - SHUT DOWN
	PUSH	P,T2		;SAVE IT
	LDB	P2,PRBFCN##	;GET FCN BACK
	MOVEI	T2,RB.ACT	;MAKE IORB ACTIVE AGAIN
	PUSHJ	P,STOIOR	;STORE INFO IN IORB
	  JFCL			;UNLIKELY
	POP	P,T2		;RESTORE IOWD
	PUSHJ	P,TPMDGO	;START IT UP
	  JRST	TPMFLS		;FLUSH - MAKLST LOST
	POPJ	P,		;EXIT INTERUPT
;ROUTINE TO PERFORM IOWD HACKING FOR MODE 16
;DESIRED IOWD IN T1, RETURN ADJUSTED IOWD IN T2


ADJIOW:	MOVE	T2,T1		;MOVE TO T2 IN CASE
	SETZM	TDVREM(F)	;CLEAR REMAINDER
	TRNE	S,1B35		;WE HAVE NOTHING TO DO?
	POPJ	P,		;MODE 17 - RETURN
	TLNE	S,IO		;OUTPUT/INPUT?
	JRST	[LDB T4,PBUFSZ##	;OUTPUT - GET BUFFER SIZE
		 MOVNI	T4,-1(T4) ;- BLOCK SIZE
		 JRST ADJIO1]	;JOIN COMMON CODE
	LDB	T4,[POINT RB.MDS,TRBFNC(P1),RB.MDP]	;INPUT - GET MODE
	MOVE	T3,TRBRCT(P1)	;CHAR COUNT OF LAST RECORD OR ZERO
	IDIV	T3,TMODTB##(T4)	;CONVERT TO WORDS
	SKIPE	T4		;CHECK REMAINDER
	ADDI	T3,1		;ADJUST IF NECESSARY
	MOVNI	T4,(T3)		;NEGATE
ADJIO1:	HLRE	T1,T2		;SIZE OF XFER
	CAML	T1,T4		;DOES IT FIT?
	POPJ	P,		;YES - JUST RETURN
	SUB	T1,T4		;NEW WORD COUNT
	SUB	T2,T4		;NEW ADDRESS
	HRL	T2,T1		;WORRY ABOUT CARRY
	MOVEM	T2,TDVREM(F)	;SAVE FOR LATER
	TLNN	S,IO		;OUTPUT?
	POPJ	P,		;NO - THEN DONE
	ADD	T2,T4		;RE-ADJUST IOWD FOR NOW
	HRL	T2,T4		;-BS,,ADDRS OPTIMAL
	POPJ	P,		;RETURN

;HERE ON ADDRESS CHECK AT UUO LEVEL

ADRXIT:	PUSHJ	P,TPMFLS	;FLUSH REQUEST
	PJRST	ADRERR##	;AND STOP USER

;SET UP IORB FOR DUMP I/O
;RETURN P1 := IORB , CONTROLLER SCHEDULED

DMPSET:	MOVEI	P2,RB.FWT	;ASSUME WRITE
	TLNN	S,IO		;IS IT?
	PUSHJ	P,SETRED	;NO - GET READ FCN
	TRNN	S,1B35		;MODE 16?
	CAIE	P2,RB.FRB	;YES - READ BACKWARDS?
	PUSHJ	P,GENIOR	;GENERATE IORB
	  POPJ	P,		;NO ROOM - LOSE
	MOVEM	T1,TDVIOR(F)	;REMEMBER THIS ONE
	XMOVEI	T2,TPMNOP	;HACK LOCATION
	MOVEM	T2,IRBIVA(T1)	;DEFEND AGAINST KONWAT
	PUSHJ	P,CPURQT##	;QUEUE IT UP
	PUSHJ	P,KONWAT	;WAIT TILL NOTICED
				;RETURN WITH P1 := IORB
	SKIPN	DEVEVM(F)	;KI ONLY
	PUSHJ	P,DMPEV##	;RESTORE EVM IF NECESSARY

	JRST	CPOPJ1##	;SKIP RETURN
SUBTTL RELEASE AND CLOSE UUO'S

TPMREL:	PUSHJ	P,WAIT1##	;WAIT FOR I/O TO CEASE
	MOVEI	T1,0		;RESET TO ZERO MODE
	DPB	T1,TDYMOD	;INTO THE DDB
	MOVSI	T1,D.RDBK!D.NRLT!D.EPAR
	ANDCAM	T1,TDVSTS(F)	;CLEAR THIS STUFF TOO
	MOVE	U,TDVUDB(F)	;UDB POINTER
IFN FTTLAB,<
	TLNE	S,LBLWAT	;WAITING FOR LABELS
	PJRST	LBLABO		;YES,JUST TELL LBL PCS
> ;END IFN FTTLAB
	PUSHJ	P,TPMRLW	;WAIT TILL DESELECTED
TPMRL2:	PUSHJ	P,TAPKIL##	;KLANK CTL
IFN FTMP,<
	SETZM	DEVNBF(F)	;NO SWEPT-FOR BUFFERS
	SETZM	DEVSBF(F)
> ;END IFN FTMP
	PJRST	TPMDQ		;UNWIND Q , PNTR IN T1

TPMRLW:	MOVSI	T1,TUSREW##!TKSSEL##
IFN FTMP,<CONSO	PI,PI.IP7>	;CAN'T SLEEP ON CLOCK LEVEL (TAPTIC)
	TDNN	T1,TUBSTS(U)	;TAPE SHOULD NOT BE SELECTED
	POPJ	P,		;OK TO PROCEED
	PUSHJ	P,TSLEE1	;SLEEP 1 SEC (REWINDS LIKE TO
				;  STRETCH THEIR LEGS SLOWLY!)
	JRST	TPMRLW		;SEE IF SUCCESSFUL
;CLOSE (WRITE TM,TM,BSB)

TPMCLS:	TLNN	F,OUTPB		;ANY OUTPUTS
	POPJ	P,		;NO -RETURN
	LDB	T1,PIOMOD##	;GET MODE
	CAIGE	T1,SD		;DUMP MODE?
	PUSHJ	P,OUT##		;NO - DUMP PARTIAL BUFFER
	PUSHJ	P,WAIT1##	;WAIT FOR I/O TO STOP
IFN FTMP,<
	SETZM	DEVNBF(F)	;NO BUFFERS SWEPT FOR
	SETZM	DEVSBF(F)
> ;END IFN FTMP
	MOVE	U,TDVUDB(F)	;UDB ADDRESS
IFN FTTLAB,<
	LDB	J,PJOBN##	;RESTORE J
	PUSHJ	P,LBLCHK	;NEED LABELING?
	  JRST	TPCLSO		;YES - SEND CLOSE MSG
> ;END IFN FTTLAB
	MOVSI	T1,TKSOFL##!TUSREW##
	TDNN	T1,TUBSTS(U)
	TRNE	S,IOBOT		;TAPE AT BOT (REW OR UNLOAD) ?
	POPJ	P,		;YES, DON'T WRITE EOF'S
	PUSHJ	P,SAVE3##	;SAVE P1,P2,P3
	MOVE	P3,S
	ANDI	P3,IOERRS
	PUSHJ	P,IOSET		;SET UP U
TPMCL1:	MOVEI	P2,RB.FTM	;WRITE TAPE MARK
	PUSHJ	P,GENIOR	;GENERATE IORB
	  JRST	TPMINF		;WHOOPS
	MOVEM	T1,TDVIOR(F)	;IORB TO REMEMBER
	XMOVEI	T2,TPMCL1	;HACK LOCATION
	MOVEM	T2,IRBIVA(T1)	;DEFEND AGAINST KONWAT
	PUSHJ	P,CPURQT##	;Q IT UP
	PUSHJ	P,GENIOR	;ANOTHER REQUEST
	  JRST	TPMINF
	XMOVEI	T2,TPMCL1	;HACK LOCATION
	MOVEM	T2,IRBIVA(T1)	;DEFEND AGAINST KONWAT
	PUSHJ	P,CPURQT##	;ADD TO QUEUE
	MOVEI	P2,RB.FBR	;BACK OVER LAST TM
	PUSHJ	P,GENIOR	;MAKE ANOTHER IORB
	  JRST	TPMINF		;LOSER
	XMOVEI	T2,TPMCL1	;HACK LOCATION
	MOVEM	T2,IRBIVA(T1)	;DEFEND AGAINST KONWAT
	PUSHJ	P,CPURQT##	;Q IT
	PUSHJ	P,KONWAT	;NOW WAIT YOUR TURN
				;P1 := FIRST IORB
	PUSHJ	P,SETACT##	;SET I/O ACTIVE
	XMOVEI	T1,CLSDUN	;WHERE TO GO ON ENDING INT
	MOVEM	T1,IRBIVA(P1)	;STORE IN IORB

	MOVEI	T1,1		;SET FOR ONE OP
	HRRM	T1,@IRBACC(P1)	;INTO IORB
	PUSHJ	P,TPSTRT	;GO START IT
	PUSHJ	P,WSYNC##	;WAIT FOR IT TO STOP
	IOR	S,P3
	TRZ	S,IODEND	;CLEAR EOF ON WRITE
	PJRST	STOIOS##	;STORE S AND RETURN
;ROUTINE TO PERFORM CLOSE INTERUPT ACTION

CLSDUN:	PUSHJ	P,SETIOS	;SET UP S FOR ERROR CHECK
	  JSP	P2,OUTERR	;GO HANDLE ERROR
	TRNE	S,IOIMPM	;WRITE LOCKED?
	JRST	CLSWLK		;YES - FLUSH REMAINDER
	PUSHJ	P,TPMRIO	;REMOVE ITEM
	HRRZ	T1,TUBQUE(U)	;GET NEXT ITEM
	MOVEI	T2,RB.ACT	;MARK ACTIVE
	DPB	T2,PRBRQS##
	MOVEI	P2,CLSDUN	;ASSUME HERE AGAIN
	LDB	T2,PRBFCN##	;GET FCN
	CAIN	T2,RB.FBR	;BACKSPACE RECORD?
	XMOVEI	P2,CLSDN1	;YES - GO HERE INSTEAD
	MOVEM	P2,IRBIVA(T1)	;SAVE NEXT INT ADDRS
	HLLOS	TKBSTS(W)	;GRNTEE STILL KEEP KONTROLLER
	MOVEI	T2,1		;ONLY ONE OP PSE
	HRRM	T2,@IRBACC(T1)	;...
	PJRST	TAPSIO##	;START DEVICE

;HERE AFTER BACKSPACE RECORD

CLSDN1:	PUSHJ	P,SETIOS	;SET UP S
	  JSP	P2,SPERR	;HANDLE SPACING ERROR
	PJRST	TPMSTP		;AND WIND DOWN

;HERE IF WRITE LOCKED ON CLOSE

CLSWLK:	PUSHJ	P,TAPDSL##
	PUSHJ	P,TPMRL2	;FLUSH Q AND STOP I/O
	PJRST	TPSTP0		;...

IFN FTTLAB,<

;ROUTINE TO HANDLE INPUT CLOSE OPERATION
TPCLSI:	MOVE	U,TDVUDB(F)	;UDB ADDRESS
	SETZ	T1,		;CLEAR AC
	TDNE	S,[LBLEOF,,IODEND] ;TAPE MARK OR EOF SEEN?
	MOVEI	T1,1		;YES, SAY SO
	PUSHJ	P,LBLCHK	;NEED LABELING?
	  TLNN	F,INPB		;YES - ANY INPUTS??
	POPJ	P,		;NO - RETURN
	DPB	T1,TUYINF	;SAVE TAPE MARK STATUS
	MOVEI	T1,LR.CLI	;SET REQUEST TYPE
	JRST	TPCLSX		;PICK UP COMMON CODE

;ROUTINE TO HANDLE CLOSE OUTPUT OPERATION

TPCLSO:	MOVEI	T1,LR.CLO	;SET REQUEST TYPE
TPCLSX::DPB	T1,TUYRQT	; INTO UDB
	TLO	S,FSTOP!IOBEG	;SET FIRST OP ALSO
	MOVEM	S,DEVIOS(F)	;UPDATE STATUS
IFN FTMP,<
	PUSHJ	P,WAIT1##	;WAIT FOR IO TO STOP
	SETZM	DEVNBF(F)	;CLEAR COUNTERS OF NUMBER OF BUFS SWEPT FOR
	SETZM	DEVSBF(F)
> ;END IFN FTMP
	PJRST	LBLMSG		;INFORM LBL PCS
> ;END IFN FTTLAB
SUBTTL	ENTER AND LOOKUP UUOS


IFN FTTLAB,<
; ENTER UUO
TPMENT:	PUSHJ	P,TPMLIB	;SET UP U AND LABEL INFO BLOCK
	  JRST	CPOPJ1##	;NOT LABELED OR TAPE LABELER NOT RUNNING
	JSP	T4,TPMARG	;SAVE ACS AND SET POINTERS TO CALLER'S ARGS
	MOVSI	T2,TUSWTL##	;GET WRITE LOCKED BIT
	TDNE	T2,TUBSTS(U)	;CHECK STATUS
	JRST	LERWLK		;CAN'T DO ENTER UUOS ON W/L DEVICES

; FORMS CONTROL BYTE
	MOVE	T2,[.TFCNO,,.TRFDF] ;NO FORMS CONTROL AND DEFAULT RECORD FORMAT
;	HRRI	M,UUXFRW(P1)	;POINT TO FORMS CONTROL/RECORD FORMAT WORD
;	CAIGE	P2,UUXFRW	;ARG BLOCK CONTAIN THIS WORD?
;	TDZA	T1,T1		;NO
;	PUSHJ	P,GETWDU##	;GET FROM ARG BLOCK
;	SKIPN	T1		;WAS ONE SPECIFIED?
	MOVE	T1,T2		;NO--USE DEFAULT
	HLRZ	T2,T1		;GET FORMS CONTROL
	DPB	T2,TUYFCT	;STORE IT

; RECORD FORMAT BYTE
	HRRI	M,UUXBSZ(P1)	;POINT TO RECORD FORMAT WORD (BSZ)
	CAIGE	P2,UUXBSZ	;ARG BLOCK CONTAIN THIS WORD?
	TDZA	T1,T1		;NO
	PUSHJ	P,GETWDU##	;GET FROM ARG BLOCK
	LDB	T1,[POINT 6,T1,29] ;GET RECORD FORMAT BYTE
	SKIPN	T1		;WAS ONE SPECIFIED?
	MOVEI	T1,.TRFDF	;NO--DEFAULT
	DPB	T1,TUYRFM	;STORE RECORD FORMAT

; RECORD SIZE
	LDB	T2,PBUFSZ##	;GET BLOCK SIZE
	SUBI	T2,1		;ACCOUNT FOR OFF BY ONE
	LDB	T1,TDYMOD	;GET THE MODE
	IMUL	T2,CPWTBL(T1)	;MULTIPLY BY CHARACTERS PER WORD
	HRLZS	T2		;PUT IN LH
	HRRI	M,UUXRSZ(P1)	;POINT TO RECORD SIZE WORD IN ARG BLOCK
	CAIGE	P2,UUXRSZ	;ARG BLOCK CONTAIN THIS WORD?
	TDZA	T1,T1		;NO
	PUSHJ	P,GETWDU##	;GET FROM ARG BLOCK
	TLNN	T1,-1		;RZS SPECIFIED?
	HLL	T1,T2		;NO--USE COMPUTED VALUE
	MOVSS	T1		;PUT RZS IN RH, BSZ IN LH
	DPB	T1,TUYRSZ	;STORE RSZ

; BLOCK SIZE
	HLRZS	T1		;GET BSZ
	SKIPE	T1		;WAS ONE SPECIFIED?
	DPB	T1,TUYBSZ	;SET IT

; CREATION DATE
	HRRI	M,UUNATT(P1)	;4-WORD
	SKIPE	P2		;EXTENDED?
	HRRI	M,UUXPRV(P1)	;YES
	PUSHJ	P,GETWDU##	;GET ATTRIBUTE WORD
	LDB	T4,[POINT 12,T1,35] ;KEEP ONLY LOW DATE
	HRRI	M,UUNEXT(P1)	;4-WORD
	SKIPE	P2		;EXTENDED?
	HRRI	M,UUXEXT(P1)	;YES
	PUSHJ	P,GETWDU##	;GET EXTENSION WORD
	LDB	T1,[POINT 3,T1,20] ;GET HIGH DATE
	DPB	T1,[POINT 3,T4,23] ;MERGE LOW AND HIGH
	SKIPN	T4		;USER SPECIFY A CREATION DATE?
	MOVE	T4,THSDAT##	;NO, USE TODAYS
	DPB	T4,TUYECR	;STORE IT

; EXPIRATION DATE
	HRRI	M,UUXDED(P1)	;BUT JUST IN CASE ...
	CAIGE	P2,UUXDED	;ARG BLOCK CONTAIN THIS WORD?
	TDZA	T1,T1		;NO
	PUSHJ	P,GETWDU##	;GET EXPIRATION DATE
	SKIPN	T1		;USER SPECIFY A DATE?
	MOVE	T1,THSDAT##	;ASSUME NO EXPIRATION DATE
	DPB	T1,TUYEEX	;STORE IT

; PROTECTION CODE
	HRRI	M,UUNATT(P1)	;4-WORD
	SKIPE	P2		;EXTENDED?
	HRRI	M,UUXPRV(P1)	;YES
	PUSHJ	P,GETWDU##	;GET PROTECTION CODE
	LSH	T1,-^D27	;POSITION
	DPB	T1,TUYPRT	;SAVE IT

; FILE SEQUENCE NUMBER
;	HRRI	M,UUXPSN(P1)	;POINT TO SEQUENCE NUMBER IN ARG BLOCK
;	CAIGE	P2,UUXPSN	;ARG BLOCK CONTAIN THIS WORD?
;	TDZA	T1,T1		;NO
;	PUSHJ	P,GETWDU##	;GET IT
;	SKIPE	T1		;WAS ONE SPECIFIED?
	LDB	T1,TUYPSN	;GET OLD SEQUENCE NUMBER
	CAIG	T1,0		;MUST BE POSITIVE
	MOVEI	T1,1		;CALL IT THE FIRST FILE
	CAILE	T1,^D999	;THIS IS THE MAX
	MOVEI	T1,^D999	;DON'T OVERFLOW
	DPB	T1,TUYPSN	;AND SAVE IT

; FILE NAME AND EXTENSION
	MOVE	T1,[ASCII |     |] ;A WORD OF BLANKS
	MOVSI	T2,-4		;4 WORDS
	HRRI	T2,TUBFNM(U)	;STARTING HERE
	MOVEM	T1,(T2)		;STORE A WORD OF BLANKS
	AOBJN	T2,.-1		;BLANK OUT ENTIRE BLOCK
	SETZM	DEVFIL(F)	;CLEAR
	SETZM	DEVEXT(F)	; JUNK
	HRRI	M,UUNNAM(P1)	;4-WORD
	SKIPE	P2		;EXTENDED?
	HRRI	M,UUXNAM(P1)	;YES
	PUSHJ	P,GETWDU##	;GET FILE NAME
	SKIPN	T1		;NULL?
	PUSHJ	P,TPMDFE	;GENERATE DEFAULT FILE NAME AND EXTENSION
	MOVEM	T1,DEVFIL(F)	;STORE IN DDB
	PUSHJ	P,SIXOUT	;STORE IN TUB
	MOVEI	T1,"."		;GET A PERIOD
	PUSHJ	P,TPMTYO	;SEPARATE FILENAME FROM EXTENSION
	SKIPN	T1,DEVEXT(F)	;WAS EXTENSION DEFAULTED CUZ BLANK FILE NAME?
	PUSHJ	P,GETWD1##	;NO--GET EXTENSION FROM ENTER BLOCK
	HLLZS	T1		;ZAR RH
	MOVEM	T1,DEVEXT(F)	;STORE IN DDB
	PUSHJ	P,SIXOUT	;STORE IN TUB

; GENERATION
	MOVEI	T2,0		;NO GENERATION,,NO VERSION
;	HRRI	M,UUXGVR(P1)	;POINT TO FORMS CONTROL/RECORD FORMAT WORD
;	CAIGE	P2,UUXGVR	;ARG BLOCK CONTAIN THIS WORD?
;	TDZA	T1,T1		;NO
;	PUSHJ	P,GETWDU##	;GET FROM ARG BLOCK
;	SKIPN	T1		;WAS ONE SPECIFIED?
	MOVE	T1,T2		;NO--USE DEFAULT
	HLRZ	T2,T1		;GET GENERATION NUMBER
	DPB	T2,TUYGEN	;STORE IT

; VERSION
	DPB	T1,TUYVER	;STORE VERSION

	PUSHJ	P,TPMFOU	;DO FIRST OUTPUT PROCESSING
	  JRST	LERLBL		;LABELING ERROR (ERROR CODE IN T1)
	JRST	CPOPJ1##	;RETURN
; STILL UNDER FTTLAB

; LOOKUP UUO
TPMLKP:	PUSHJ	P,TPMLIB	;SET UP U AND LABEL INFO BLOCK
	  JRST	CPOPJ1##	;NOT LABELED OR TAPE LABELER NOT RUNNING
	JSP	T4,TPMARG	;SAVE ACS AND SET POINTERS TO CALLER'S ARGS
	HRRI	M,UUNNAM(P1)	;4-WORD
	SKIPE	P2		;EXTENDED?
	HRRI	M,UUXNAM(P1)	;YES
	PUSHJ	P,GETWDU##	;GET REQUESTED FILE NAME
	MOVEM	T1,DEVFIL(F)	;SAVE IT
	PUSHJ	P,GETWD1##	;GET REQUESTED EXTENSION
	HLLZM	T1,DEVEXT(F)	;SAVE IT
	SKIPE	DEVFIL(F)	;LOOKING FOR A SPECIFIC FILE?
	JRST	TPMLK2		;YES
	SKIPE	DEVEXT(F)	;(BLANK).EXT DOESN'T MAKE IT
	JRST	LERFNF		;CALL IT A FILE NOT FOUND ERROR
	JRST	TPMLK2		;ENTER LOOKUP LOOP
TPMLK1:	MOVEI	T1,16		;CODE TO FORWARD SPACE ONE FILE
	PUSHJ	P,MTAP0		;DO IT
TPMLK2:	PUSHJ	P,TPMLIC	;CLEAR OUT LABEL INFO BLOCK
	  JFCL			;WILL ALWAYS SKIP HERE
	PUSHJ	P,TPMFIN	;DO FIRST INPUT PROCESSING
	  SKIPA			;LABELING ERROR
	JRST	TPMLK3		;ONWARD
	CAIE	T1,LE.EOF	;EOF (LOOKUP READ FORWARD FAILED)?
	CAIN	T1,LE.BOT	;BOT (LOOKUP READ BACKWARDS FAILED)?
	JRST	LERFNF		;CONVERT TO FILE NOT FOUND
	CAIE	T1,LE.FNF	;SPECIFIC FILENAME.EXT LOOKUP FAILED?
	JRST	LERFNF		;YES
	JUMPN	T1,LERLBL	;ELSE IT MIGHT BE A FATAL LABELING ERROR
TPMLK3:	SKIPN	DEVFIL(F)	;LOOKING FOR A SPECIFIC FILE NAME?
	JRST	TPMLK4		;NO--ANY ONE WILL DO
	PUSHJ	P,SIXINP	;GET FILE NAME FROM TAPE LABEL
	CAME	T1,DEVFIL(F)	;MATCH?
	JRST	TPMLK1		;NO
	CAIE	T3,"."		;MUST BE A PROPER FILESPEC
	JRST	TPMLK1		; OR IT'S NO GOOD
	PUSHJ	P,SIXINP	;GET EXTENSION
	CAME	T1,DEVEXT(F)	;MATCH?
	JRST	TPMLK1		;NO
	JRST	TPMLK5		;ONWARD
TPMLK4:	PUSHJ	P,SIXINP	;GET FILE NAME
	MOVEM	T1,DEVFIL(F)	;STORE IN DDB
	HRRI	M,UUNNAM(P1)	;4-WORD
	SKIPE	P2		;EXTENDED?
	HRRI	M,UUXNAM(P1)	;YES
	PUSHJ	P,PUTWDU##	;RETURN THE FILE NAME WE FOUND
	CAIE	T3,"."		;LEGAL TOPS-10 FILESPEC?
	TDZA	T1,T1		;NO--JUST RETURN A ZERO
	PUSHJ	P,SIXINP	;GET EXTENSION
	HLLZS	T1		;EXTENSIONS ARE ONLY 3 CHARACTERS LONG
	MOVEM	T1,DEVEXT(F)	;STORE IN DDB
	PUSHJ	P,PUTWD1##	;STORE IT
TPMLK5:

; FORMS CONTROL BYTE
;	LDB	T2,TUYFCT	;GET FORMS CONTROL

; RECORD FORMAT BYTE
	LDB	T1,TUYRFM	;GET RECORD FORMAT BYTE
	LSH	T1,6		;POSITION
	HRRI	M,UUXBSZ(P1)	;POINT TO RECORD FORMAT WORD (BSZ)
	CAIL	P2,UUXBSZ	;ARG BLOCK CONTAIN THIS WORD?
	PUSHJ	P,PUTWDU##	;YES--STORE IT

; RECORD SIZE / BLOCK SIZE
	LDB	T1,TUYRSZ	;GET RECORD SIZE FROM TAPE LABEL
	HRLZS	T1		;PUT IN LH
	LDB	T2,TUYBSZ	;GET BLOCK SIZE FROM TAPE LABEL
	IOR	T1,T2		;MAKE IT RSZ,,BSZ
	HRRI	M,UUXRSZ(P1)	;POINT TO RECORD SIZE WORD IN ARG BLOCK
	CAIL	P2,UUXRSZ	;ARG BLOCK CONTAIN THIS WORD?
	PUSHJ	P,PUTWDU##	;YES--STORE IT

; CREATION DATE
	HRRI	M,UUNATT(P1)	;4-WORD
	SKIPE	P2		;EXTENDED?
	HRRI	M,UUXPRV(P1)	;YES
	PUSHJ	P,GETWDU##	;GET ATTRIBUTE WORD
	LDB	T4,TUYECR	;GET CREATION DATE FROM LABEL
	LDB	T2,[POINT 12,T4,35] ;KEEP ONLY LOW DATE
	DPB	T2,[POINT 12,T1,35] ;MOVE INTO EXISTING ATTRIBUTE WORD
	PUSHJ	P,PUTWDU##	;SET LOW DATE
	HRRI	M,UUNEXT(P1)	;4-WORD
	SKIPE	P2		;EXTENDED?
	HRRI	M,UUXEXT(P1)	;YES
	PUSHJ	P,GETWDU##	;GET EXTENSION WORD
	LDB	T2,[POINT 3,T4,23] ;GET HIGH DATE FROM THE LABEL
	DPB	T2,[POINT 3,T1,20] ;MOVE INTO EXISTING EXTENSION WORD
	PUSHJ	P,PUTWDU##	;SET HIGH DATE

; EXPIRATION DATE
	LDB	T1,TUYEEX	;GET EXPIRATION DATE
	HRRI	M,UUXDED(P1)	;BUT JUST IN CASE ...
	CAIL	P2,UUXDED	;ARG BLOCK CONTAIN THIS WORD?
	PUSHJ	P,PUTWDU##	;YES--STORE IT

; PROTECTION CODE
	HRRI	M,UUNATT(P1)	;4-WORD
	SKIPE	P2		;EXTENDED?
	HRRI	M,UUXPRV(P1)	;YES
	PUSHJ	P,GETWDU##	;GET EXISTING WORD
	LDB	T2,TUYPRT	;GET PROTECTION CODE FROM TAPE LABEL
	DPB	T2,[POINT 9,T1,8] ;MERGE INTO EXISTING WORD
	PUSHJ	P,PUTWDU##	;STORE IT

; FILE SEQUENCE NUMBER
;	LDB	T1,TUYPSN	;GET SEQUENCE NUMBER
;	HRRI	M,UUXPSN(P1)	;POINT TO SEQUENCE NUMBER IN ARG BLOCK
;	CAIL	P2,UUXPSN	;ARG BLOCK CONTAIN THIS WORD?
;	PUSHJ	P,PUTWDU##	;YES--STORE WORD

; GENERATION
;	LDB	T2,TUYGEN	;GET GENERATION

; VERSION
;	LDB	T1,TUYVER	;GET VERSION
;	HRL	T1,T2		;PUT IN ONE WORD
;	HRRI	M,UUXGVR(P1)	;POINT TO FORMS CONTROL/RECORD FORMAT WORD
;	CAIL	P2,UUXGVR	;ARG BLOCK CONTAIN THIS WORD?
;	PUSHJ	P,PUTWDU##	;YES--STORE WORD

	JRST	CPOPJ1##	;AND RETURN
; STILL UNDER FTTLAB

; INITIALIZE LABEL INFORMATION BLOCK IN THE TUB FOR ENTER
; AND LOOKUP UUOS.  RETURNS CPOPJ1 IF PROCESSING LABELED
; TAPES AND THIS TAPE IS LABELED.
TPMLIB:	PUSHJ	P,NULTST##	;CHECK FOR NUL
	  POPJ	P,		;RETURN IF THE NUL DEVICE
	SETZM	DEVFIL(F)	;CLEAR FILE NAME
	SETZM	DEVEXT(F)	;CLEAR EXTENSION
	MOVE	U,TDVUDB(F)	;POINT TO UDB FOR THIS DDB
	TLO	S,FSTOP		;SET UP
	MOVEM	S,DEVIOS(F)	; FIRST I/O
	PUSHJ	P,LBLCKM	;TAPE LABELED AND TAPE LABELER RUNNING?
	  SKIPA			;YES
	POPJ	P,		;NOTHING MORE TO DO

	LDB	T1,TUYLTP	;GET LABEL TYPE
	CAIL	T1,LT.SL	;ANSI?
	CAILE	T1,LT.IUL	;IBM?
	POPJ	P,		;NO

; HERE TO JUST RE-INITIALIZE THE LABEL INFO BLOCK
TPMLIC:	LDB	T1,TUYPSN	;SAVE CURRENT SEQUENCE NUMBER
	SETZM	TUBLIB(U)	;CLEAR FIRST WORD OF LABEL STORAGE AREA
IFE FTXMON,<
	MOVSI	T2,TUBLIB(U)	;START OF LABEL INFO BLOCK
	HRRI	T2,TUBLIB+1(U)	;MAKE A BLT POINTER
	BLT	T2,TUBLIB+TLPMAX-1(U) ;CLEAR ENTIRE BLOCK
> ;END IFE FTXMON
IFN FTXMON,<
	PUSH	P,T1		;SAVE FROM DESTRUCTION
	MOVEI	T1,TLPMAX	;LENGTH
	XMOVEI	T2,TUBLIB(U)	;STARTING ADDRESS
	XMOVEI	T3,TUBLIB+1(U)	;MAKE A BLT POINTER
	EXTEND	T1,[XBLT]	;COPY
	POP	P,T1		;RESTORE T1
> ;END IFN FTXMON
	DPB	T1,TUYPSN	;RESTORE FILE SEQUENCE NUMBER
	MOVE	T1,TUYFNM	;GET BYTE POINTER TO FILE.EXT
	MOVEM	T1,TUBPTR(U)	;STORE WORKING COPY
	TLO	S,FSTOP		;SET UP
	MOVEM	S,DEVIOS(F)	; FIRST I/O
	JRST	CPOPJ1##	;RETURN


; SAVE ACS AND SET UP POINTERS TO CALLER'S ARG BLOCK
TPMARG:	PUSHJ	P,SAVE4##	;SAVE SOME ACS
	HRRZ	P1,M		;SAVE UVA OF ARG BLOCK
	PUSHJ	P,GETWDU##	;GET FIRST WORD
	TLNN	T1,-1		;4-WORD OR EXTENDED BLOCK
	TRZA	T1,RB.BIT	;EXTENDED
	TDZA	P2,P2		;4-WORD, SO ZERO LENGTH
	MOVE	P2,T1		;ELSE COPY EXTENDED LENGTH TO A SAFE PLACE
	MOVE	T1,P1		;START ADDRESS OF ARG BLOCK
	SKIPN	T2,P2		;EXTENDED?
	MOVEI	T2,4		;4-WORD
	PUSHJ	P,ARNGE##	;RANGE CHECK
	  JRST	UADERR#		;ADDRESS CHECK
	  JFCL			;ADDRESS OK BUT ILLEGAL FOR I/O (IGNORED HERE)
	JRST	(T4)		;RETURN


; FIRST I/O
TPMFIN:	SKIPA	T1,[LR.FIN]	;FIRST INPUT
TPMFOU:	MOVEI	T1,LR.FOU	;FIRST OUTPUT
	DPB	T1,TUYRQT	;SET FOR TAPE LABELER
	MOVEI	T1,77		;GET LABEL READ FUNCTION CODE
	DPB	T1,TUYINF	;SET IT
	PUSHJ	P,LBLMSG	;GIVE PULSAR A KICK
	LDB	T1,PDVESE##	;GET EXTENDED ERROR STATUS SET BY LABELER
	JUMPN	T1,CPOPJ##	;LABELING ERROR IF NON-ZERO
	JRST	CPOPJ1##	;RETURN


; GENERATE A DEFAULT FILE NAME AND EXTENSION
TPMDFE:	LDB	T1,TUYPSN	;GET CURRENT SEQUENCE NUMBER
	MOVEI	T4,3		;EXTENSION IS THREE CHARACTERS
TPMDF1:	IDIVI	T1,12		;DIVIDE BY 10
	ADDI	T2,'0'		;MAKE SIXBIT
	LSHC	T2,-6		;SAVE CHARACTER
	SOJG	T4,TPMDF1	;LOOP
	HLLZM	T3,DEVEXT(F)	;SET EXTENSION
	MOVE	T1,['FILE  ']	;DEFAULT
	MOVEM	T1,DEVFIL(F)	; FILE NAME
	POPJ	P,		;AND RETURN


; CHARACTER TYPER FOR FILE NAME AND EXTENSION GENERATION
TPMTYO:	IDPB	T1,TUBPTR(U)	;PUT CHARACTER
	POPJ	P,		;RETURN


; ROUTINE TO TYPE A SIXBIT WORD FOR FILE.EXT PROCESSING
SIXOUT:	SKIPN	T2,T1		;COPY WORD
	POPJ	P,		;NOTHING TO DO
SIXOU1:	LSHC	T1,6		;SHIFT IN A CHARACTER
	ANDI	T1,77		;NO JUNK
	ADDI	T1,40		;CONVERT SIXBIT TO ASCII
	IDPB	T1,TUBPTR(U)	;STORE CHARACTER
	JUMPN	T2,SIXOU1	;LOOP
	POPJ	P,		;RETURN


; ROUTINE TO GET A SIXBIT WORD FOR FILE.EXT PROCESSING
SIXINP:	SETZ	T1,		;CLEAR DESTINATION
	MOVE	T2,[POINT 6,T1]	;BYTE POINTER
SIXIN1:	ILDB	T3,TUBPTR(U)	;GET CHARACTER
	CAIN	T3,"-"		;DASH?
	JRST	SIXIN2		;YES
	CAIL	T3,"0"		;CHECK
	CAILE	T3,"9"		; DIGITS
	CAIL	T3,"A"		;CHECK
	CAILE	T3,"Z"		; LETTERS
	POPJ	P,		;NO MATCH
SIXIN2:	SUBI	T3,40		;CONVERT ASCII TO SIXBIT
	TRNN	T1,77		;WORD FULL?
	IDPB	T3,T2		;NO--STORE CHARACTER
	JRST	SIXIN1		;LOOP


; ERROR HANDLING
LERFNF:	MOVEI	T4,FNFERR	;FILE NOT FOUND
	JRST	LERERR
LERWLK:	MOVEI	T4,WLKERR	;WRITE-LOCKED
	JRST	LERERR
LERACS:	MOVEI	T4,ACSERR	;ADDRESS CHECK STORING ANSWERS
	JRST	LERERR
LERLBL:	MOVEI	T4,LBLERR	;TAPE LABELING ERROR
LERERR:	HRRI	M,UUNEXT(P1)	;4-WORD
	SKIPE	P2		;EXTENDED?
	HRRI	M,UUXEXT(P1)	;YES
	PUSHJ	P,GETWDU##	;GET EXTENSION WORD
	HRR	T1,T4		;GET ERROR CODE
	PUSHJ	P,PUTWDU##	;STORE IT
	POPJ	P,		;RETURN


> ;END IFN FTTLAB FROM WAY BACK
SUBTTL MTACHR AND MTARID UUO'S
;MTACHR UUO

MTACHR::HLRE	T2,T1		;GET LH ARG FROM USER
	JUMPLE	T2,MTACHX	;JUMP IF OLD STYLE
	SUBI	T2,1		;ACCOUNT FOR WORD USED TO PASS DEVICE NAME
	CAILE	T2,TPCHMX	;CHECK RANGE
	JRST	MTACHX		;MIGHT BE NUMERIC LOGICAL NAME
	PUSHJ	P,SAVE1##	;SAVE P1
	MOVN	P1,T2		;NEGATE LEN IN P1
	HRLZS	P1		;TO LH
	HRR	M,T1		;FIXUP M TO POINT TO USER AREA
	PUSHJ	P,GETWRD##	;GET FIRST WORD OF BLOCK
	  JRST	RTM1##		;OUT OF BOUNDS
	PUSHJ	P,MTACHS	;SCAN FOR DDB (ARG IN T1)
	  JRST	RTM1##		;NO SUCH MTA
				;RETURN DDB IN F, UDB IN U
	HRRI	P1,TUBRID	;OFFSET INTO UDB
	PUSHJ	P,TPMCPY	;COPY DATA
	  POPJ	P,		;OUT OF BOUNDS
	MOVE	T1,TUBCHR(U)	;GET CHARACTERISTICS WORD
	PJRST	STOTC1##	;STORE IN AC AND EXIT

;HERE WHEN ARG IS CHL # OR DEVICE NAME
MTACHX:	PUSHJ	P,MTACHS	;LOOK FOR DDB (ARG IN T1)
	  PJRST	RTM1##		;NO SUCH MTA
	PJRST	STOTC1##	;STORE T1
MTARID::PUSHJ	P,PRVJ##	;NEED PRIVS
	PUSHJ	P,MTAIDD	;FIND DDB
	  PJRST	RTM1##		;NO PRIVS OR NO DDB
	MOVE	T1,DEVMOD(F)	;MAKE SURE ITS AN MTA
	MOVE	U,TDVUDB(F)	;UDB ADDRESS
	TLNN	T1,DVTTY	;...
	TLNN	T1,DVMTA	;....
	JRST	RTM1##		;ERROR RETURN
	PUSHJ	P,GETWD1##	;GET REEL ID
	MOVEM	T1,TUBRID(U)	;STORE IN UDB
	PJRST	CPOPJ1##	;GIVE SKIP RETURN
;ROUTINE TO FIND A DDB FOR THE MTAID. UUO.
;CALL:	MOVE	T1,ARG
;	PUSHJ	P,MTAIDD
;	  RETURN HERE IF NO SUCH DEVICE
;	RETURN HERE WITH F=DDB ADDRESS

MTAIDD:	JUMPL	T1,MTAID1	;IF ARG IS AN
	CAIG	T1,HIGHXC##	;  OPEN CHANNEL,
	PJRST	DVCNSG##	;  LET DVCNSG FIND IT
MTAID1:	PUSHJ	P,DEVSRC##	;LOOK FOR PHYSICAL OR LOGICAL MATCH
	  CAIA			;NONE FOUND
	JRST	CPOPJ1##	;FOUND IT
	TRNE	T1,-1		;LOSE IF GENERIC MTA
	TRNE	T1,7777		;OR IF NOT MTAU
	POPJ	P,
	MOVEI	T3,0		;NO RESTRICTIONS ON DVSTAS
	PUSHJ	P,DVASRC##	;LOOK FOR MTAU
	  SKIPGE	T4		;IF FOUND BUT ASSIGNED TO SOMEONE ELSE,
	JRST	CPOPJ1##	;RETURN SUCCESS
	POPJ	P,		;NOT FOUND
;ROUTINE TO SCAN FOR MTA DDB AND SET UP F AND U
;CALLED WITH T1 := SOMETHING THAT DVCNSG LIKES
;ALSO UPDATE TUBCHR AND RETURN INFO IN T1

MTACHS:	PUSHJ	P,DVCNSG##	;LOOK FOR DDB
	  POPJ	P,		;ERROR RETURN
	MOVSI	T1,DVMTA	;CHECK FOR MTA DDB
	TDNN	T1,DEVMOD(F)	;...
	POPJ	P,		;NOPE - ERROR
	MOVE	U,TDVUDB(F)	;UDB ADDRESS
	PUSHJ	P,GETDEN	;GET CURRENT DENSITY
	LDB	T2,TDYDEN	;UNLESS ACTUAL KNOWN
	SKIPE	T2		;IS IT?
	MOVE	T1,T2		;YES, GIVE THEN THE REAL THING
	DPB	T1,[POINT 3,TUBCHR(U),35]
	MOVEI	T1,1B31+1B32	;BITS FOR TUBCHR
	MOVEI	T2,TUC7TK##	;CHECK 7 TRACK
	TDNN	T2,TUBCNF(U)	;IS IT?
	TRZ	T1,1B31		;NO - CLEAR BIT
	MOVSI	T2,TUSWTL##	;CHECK WRITE LOCKED
	TDNN	T2,TUBSTS(U)	;IS IT?
	TRZ	T1,1B32		;NO - CLEAR BIT
	IORM	T1,TUBCHR(U)	;SET APPROPRIATE BITS
	TRC	T1,1B31+1B32	;COMPLEMENT BITS
	ANDCAB	T1,TUBCHR(U)	;AND CLEAR OTHERS
	JRST	CPOPJ1##	;GIVE GOOD RETURN
SUBTTL	TAPOP. UUO
;TAPOP. UUO OR CALLI 154
;UUO TO PERFORM MISCELLANEOUS FUNCTIONS FOR A SPECIFIC TAPE UNIT
;CALL:	MOVE	AC,[+N,,ADR]
;	CALLI	AC,154
;	  ERROR RETURN
;	NORMAL RETURN
UTAPOP::PUSHJ	P,SAVE4##	;SAVE AC'S
	MOVE	P4,T1		;SAVE USER ARG IN P4
	HRR	M,T1		;ADDRS OF BLOCK
	HLRE	T2,T1		;GET LENGTH
	CAIL	T2,2		;VALID LENGTH?
	PUSHJ	P,GETWRD##	;YES - GET ARG (FCN CODE)
	  PJRST	ECOD4##		; NO - ERROR
	JUMPLE	T1,RTZER##	;RETURN 0 IF BAD FCN
	HRR	P1,T1		;SAVE FCN IN P1
	PUSHJ	P,GETWR1##	;GET NEXT ARG (DEVICE SPEC)
	  PJRST	ECOD4##
	PUSHJ	P,DVCNSG##	;SEARCH FOR IT
	  PJRST	ECOD2##		;NO SUCH
	CAIN	F,DSKDDB##	;IS IT NUL?
	CAME	T1,[SIXBIT/NUL/]
	SKIPA	T1,DEVMOD(F)	;CHECK ON TAPE UNIT
	JRST	CPOPJ1##	;YES, GOOD RETURN
	TLNN	T1,DVMTA	;...
	PJRST	ECOD2##		;NOPE
	TLNE	T1,DVTTY	;CHECK IF ALSO TTY
	PJRST	CPOPJ1##	;NUL WINS
	MOVE	S,DEVIOS(F)	;SET UP STATUS
	TRNN	P1,1000		;IF NOT A READ FNCN
	PUSHJ	P,WAIT##	;WAIT FOR ALL IO TO COMPLETE
	MOVE	U,TDVUDB(F)	;UDB ADDRESS
	HRRZ	T1,P1		;GET FCN CODE
	TRNE	T1,3000		;READ/SET CODE?
	JRST	TAPRSQ		;YES - GO HANDLE
	CAIG	T1,TAPLN0	;NO - CHECK LEGAL
	SKIPN	P3,TAPTB0-1(T1)	;EXISTS?
	PJRST	RTZER##		;ILLEGAL FCN CODE
	TLNN	P3,(TAP.NP)	;NEED POKE PRIVS?
	JRST	CHKRED		;NO - TRY OTHERS
	MOVSI	T1,JP.POK	;YES - CHECK HIS PRIVS
	PUSHJ	P,PRVBIT##	;...
	  PJRST	0(P3)		;OK - DISPATCH
	JRST	ECOD1##		;NO - GIVE ERROR RETURN

CHKRED:	TLNN	P3,(TAP.RP)	;NEED READ PRIVS?
	JRST	CHKWRT		;NO - PROCEED
	PUSHJ	P,TREDOK	;YES - CHECK THEM
	  PJRST	ECOD1##		;NOT ENOUGH PRIVS
CHKWRT:	TLNN	P3,(TAP.WP)	;NEED WRITE PRIVS?
	PJRST	0(P3)		;NO - JUST CALL ROUTINE
	PUSHJ	P,TWRTOK	;YES - CHECK THEM
	  PJRST	ECOD1##		;NOT ENOUGH
	PJRST	0(P3)		;DISPATCH
;HERE IF FCN CODE IS IN THE RANGE 2000-3777

TAPRSQ:	ANDI	P1,777		;MASK FCN CODE
	CAIL	T1,3000		;POSSIBLE CUSTOMER-DEFINED FUNCTION?
	JRST	TAPCUS		;MAYBE, GO SEE
	TRZE	T1,1000		;READ CODE?
	JRST	TAPRED		;YES - TRY IT
	CAIGE	T1,2000+TAPLN1	;CHECK RANGE
	SKIPN	P3,TAPTB1(P1)	;  AND VALIDITY
	PJRST	RTZER##		;INVALID
	HLRZ	T2,P4		;CHECK ARG LIST
	CAIL	T2,3		;AT LEAST 3
	PUSHJ 	P,GETWR1##	;GET NEXT ARG
	  PJRST	ECOD4##		;ADDRS ERROR
	MOVE	P2,T1		;SAVE IT IN P2
	PUSHJ	P,TWRTOK	;CHECK WRITE PRIVS
	  PJRST	ECOD1##		;ERROR RETURN
	LDB	T1,TAPSYR	;LEGAL - RANGE CHK REQ'D?
	JUMPE	T1,TAPST1	;JUMP IF NO
	TLNE	P3,(TAP.FC)	;SETTING FRAME-COUNT?
	JUMPE	P2,TAPST1	;YES, 0 IS LEGAL
	MOVE	T2,TAPSRT-1(T1)	;MAX VALUE IN RH
	HLRZ	T3,T2		; MIN VALUE IN LH
	CAIG	P2,(T2)		;.GT. MAX VALUE?
	CAIGE	P2,(T3)		; OR .LT. MIN VALUE?
	PJRST	ECOD3##		;ARG OUT OF RANGE
	TLNN	P3,(TAP.FC)	;SETTING FRAME COUNTER?
	JRST	TAPST1
	LDB	T2,TDYMOD	;YES, DO WE KNOW MODE?
	JUMPE	T2,TAPST1
	MOVE	T1,P2		;YES, CONVERT TO NUMBER OF WORDS
	IDIV	T1,TMODTB##(T2)
	SKIPE	T2
	ADDI	T1,1
	ADDI	T1,1		;ALLOW FOR OVERHEAD WORD
	DPB	T1,PBUFSZ##	;AND SAVE BUFFER SIZE
TAPST1:	TLNE	P3,(TAP.SA!TAP.FC)	;SET ALLOWED?
	JRST	TAPST2		;YES - DO IT
	TLNN	P3,(TAP.PS)	;NO - NEED PRIVS
	PJRST	ECOD5##		;NOHOW!
	MOVSI	T1,JP.POK	;NEED PRIVS TO SET
	PUSHJ	P,PRVBIT##	;GO CHECK
	  SKIPA			;OK RETURN
	PJRST	ECOD1##		;NOPE
TAPST2:	TLNE	P3,(TAP.DN)	;SETTING DENSITY?
	JRST	TAPDEN		;YES, DO IT
IFN	FTTLAB,<
	TLNE	P3,(TAP.LT)	;SETTING LABEL TYPE?
	JRST	TAPLBT		;YES, DO IT
>				;END FTTLAB
	TLNE	P3,(TAP.SP)
	JRST	0(P3)
	DPB	P2,0(P3)	;SET BIT (BYTE)
	JRST	CPOPJ1##	;DONE
TAPDEN:	SKIPN	T1,P2		;DEFAULT SPECIFIED?
	PUSHJ	P,GETDN1	;YES, SET IT UP
	MOVEI	T3,TUCD20##	;GET LOWEST DENSITY
	LSH	T3,-1(T1)	;CONVERT DENSITY TO BIT POSITION
	TDNN	T3,TUBCNF(U)	;SETTING VALID DENSITY?
	JRST	ECOD15##	;NO, ERROR
	DPB	T1,0(P3)	;SET THE DENSITY
IFN FTTLAB,<
	TLZ	T1,(ST.FAC)	;REQUEST DENSITY CHANGE
	PUSHJ	P,SETODN	; THEN SET OTHER DDB
> ;END IFN FTTLAB
	JRST	CPOPJ1##	;RETURN OK

;SET LABEL TYPE
IFN FTTLAB,<
TAPLBT:	DPB	P2,TUYLTP	;SET THE LABEL TYPE
	MOVE	T1,UDBDDB(U)	;GET THE REAL DDB ADDRESS
	MOVSI	T2,DVDIR	;GET DIRECTORY DEVICE BIT
	ANDCAM	T2,DEVMOD(T1)	;ASSUME NOT LABELED
	CAIL	P2,LT.SL	;SOME FLAVOR OF
	CAILE	P2,LT.IUL	; ANSI OR IBM LABELS?
	SKIPA			;NO
	IORM	T2,DEVMOD(T1)	;LITE DIRECTORY BIT FOR USER PROGRAMS
	JUMPN	P2,CPOPJ1##	;NOT BLP, RETURN
	DPB	P2,PDVESE##	;CLEAR LAST LABELING ERROR
	TLZ	S,LBLNED+LBLWAT+LBLSTP+LBLEOF+FSTOP
	MOVEM	S,DEVIOS(F)	;CLEAR LABEL BITS AND SAVE
	JRST	CPOPJ1##	;RETURN
>				;END IFN FTTLAB
;HERE TO HANDLE READ FUNCTIONS

TAPRED:	CAIGE	T1,TAPLN1	;CHECK VALID ARG
	SKIPN	TAPTB1(P1)	; AND EXISTANCE
	PJRST	RTZER##		;RETURN ZERO
	PUSHJ	P,TREDOK	;CHECK PRIVS
	  PJRST	ECOD1##		;NOPE
	MOVE	P3,TAPTB1(P1)	;GET TABLE ENTRY
	TLNE	P3,(TAP.DN)	;DENSITY?
	JRST	TAPRD1		;YES - SPECIAL
	TLNE	P3,(TAP.SP)	;SPECIAL ROUTINE?
	JRST	0(P3)		;YES - CALL IT
	LDB	T1,0(P3)	;NO - GET VALUE
	TLNE	P3,(TAP.MD)	;MODE READ?
	PUSHJ	P,GTMODE	;YES, FIND OUT WHAT WE HAVE
	PJRST	STOTC1##	;STORE VALUE & SKIP RETURN

;HERE TO HANDLE DENSITY READ

TAPRD1:	PUSHJ	P,GETDEN	;GET DENSITY ARG
	LDB	T2,TDYDEN	;UNLESS ACTUAL KNOWN
	SKIPE	T2		;IS IT?
	MOVE	T1,T2		;YES, GIVE THEN THE REAL THING
	PJRST	STOTC1##	;STORE ETC.

;ROUTINES TO CHECK PRIVS FOR READ OR WRITE

TREDOK:	PUSHJ	P,SAVE2##	;SAVE P1,P2
	MOVSI	P1,PVSPYM!PVSPYA ;SPY PRIVS
	JRST	CKMTA

TWRTOK:	PUSHJ	P,SAVE2##	;SAVE P1,P2
	MOVSI	P1,JP.POK	;POKE PRIVS
CKMTA:	LDB	P2,PJOBN##	;GET OWNERS JOB #
	CAMN	P2,J		;IS IT US?
	JRST	CPOPJ1##	;YES - DO WHAT U WANT
	EXCH	P1,T1		;NO - FURTHER CHECKING REQ'D
	PUSHJ	P,PRVBIT##
	  AOS	(P)		;OK - SET FOR SKIP
	MOVE	T1,P1		;RESTORE T1
	POPJ	P,		;RETURN

;HERE FOR POSSIBLE CUSTOMER-DEFINED TAPOP. UUO FUNCTION

TAPCUS:	CAIGE	T1,3000+TAPLC0	;IN RANGE?
	SKIPN	TAPTC0(P1)	;AND EXISTS?
	PJRST	RTZER##		;NO, RETURN ZERO
	PUSHJ	P,TREDOK	;CHECK PRIVILEGES
	  JRST	ECOD1##		;NO PRIVILEGES
	MOVE	P3,TAPTC0(P1)	;GET TABLE ENTRY
	TLNE	P3,(TAP.SP)	;SPECIAL ROUTINE?
	PJRST	(P3)		;YES, DISPATCH TO IT
	LDB	T1,(P3)		;NO, GET VALUE
	PJRST	STOTC1##	;STORE IT AND RETURN
;TABLES FOR TAPOP. UUO

;CONTENTS OF TAPTB0 ARE AS FOLLOWS
;BITS 0-5 ARE CORRESPONDING MTAPE CODE IF ANY
;BITS 6-12 ARE FLAGS FOR DETERMINING VALIDITY
;RH IS ROUTINE ADDRS

TAP.RP==1B6	;NEED READ PRIVS FOR THIS FCN
TAP.WP==1B7	;NEED WRITE PRIVS FOR THIS FCN
TAP.NP==1B8	;NEED JACCT / [1,2] PRIVS

DEFINE TMAC(MTCOD,BITS,ROU),<
	EXP	<MTCOD>B5+BITS+ROU
>

TAPTB0:	TMAC	(MT.WAT,TAP.RP,TAPOPM)	;1 - WAIT FOR UNIT AVAIL
	TMAC	(MT.REW,TAP.WP,TAPOPM)	;2 - REWIND
	TMAC	(MT.UNL,TAP.WP,TAPOPM)	;3 - REWIND & UNLOAD
	TMAC	(MT.FSR,TAP.WP,TAPOPM)	;4 - SKIP RECORD
	TMAC	(MT.FSF,TAP.WP,TAPOPM)	;5 - SKIP FILE
	TMAC	(MT.SET,TAP.WP,TAPOPM)	;6 - SKIP TO LEOT
	TMAC	(MT.BSR,TAP.WP,TAPOPM)	;7 - BACKSPACE RECORD
	TMAC	(MT.BSF,TAP.WP,TAPOPM)	;10 - BACKSPACE FILE
	TMAC	(MT.WTM,TAP.WP,TAPOPM)	;11 - WRITE TAPE MARK
	TMAC	(MT.WLG,TAP.WP,TAPOPM)	;12 - WRITE LONG GAP
	TMAC	(0,TAP.WP,TPMDSE)	;13 - DATA SECURITY ERASE
	TMAC	(0,TAP.WP,TPMWET)	;14 - WRITE LEOT
IFN FTTLAB,<
	TMAC	(0,TAP.NP,TPMLBG)	;15 - LABEL GET
	TMAC	(0,TAP.NP,TPMLBR)	;16 - LABEL RELEASE
	TMAC	(0,TAP.NP,TPMLSU)	;17 - SWAP UNITS
	TMAC	(0,TAP.NP,TPMLDD)	;20 - DESTROY LABEL DDB
	TMAC	(0,TAP.WP,TPMFEV)	;21 - FORCE EOV
	TMAC	(0,TAP.WP,TPMURQ)	;22 - USER REQUEST
>	 ;END IFN FTTLAB
IFE FTTLAB,<				;;; DUMMIES
	0				;15
	0				;16
	0				;17
	0				;20
	0				;21
	0				;22
> ;END IFE FTTLAB
	TMAC	(0,TAP.NP,TPMSMM)	;23 - SET MAINT MODE
	TMAC	(0,TAP.NP,TPMCMM)	;24 - CLEAR MAINT MODE
	TMAC	(0,TAP.NP,TPMCEC)	;25 - CLEAR ERROR COUNTERS

IFN FTPATT,<EXP	CPOPJ##>		;ROOM FOR PATCHING
TAPLN0==.-TAPTB0

;CONTENTS OF TAPTB1 ARE AS FOLLOWS
;BITS 0-5 ARE INDEX INTO RANGE TABEL IF ANY
;BITS 6-12 ARE FLAGS FOR DETERMINING VALIDITY
;RH IS ADDRS OF BYTE PNTR

TAP.DN==1B6		;SPECIAL DENSITY ACTION
TAP.SA==1B7		;SET ALLOWED
TAP.PS==1B8		;PRIV SET ONLY
TAP.SP==1B9		;SPECIAL ACTION
TAP.FC==1B10		;SET FRAME COUNT
TAP.MD==1B11		;MODE (ASCII, CORE-DUMP, ...)
TAP.LT==1B13		;SET LABEL TYPE
TAPTB1:	TMAC	(0,0,<[POINT 36,TUBFES(U),35]>)	;1000 - FINAL ERROR DISPOSITION
	TMAC	(1,TAP.DN+TAP.SA,TDYDN1)	;1001 - DENSITY
	TMAC	(0,0,TUYKTP)	;1002 - KONTROLLER TYPE
	TMAC	(0,TAP.SA,<[POINT 1,TDVSTS(F),0]>)	;1003 - READ BACKWARDS

	TMAC	(0,TAP.SA,<[POINT 1,TDVSTS(F),1]>)	;1004 - LOW THRESHOLD
	TMAC	(0,TAP.SA,<[POINT 1,DEVIOS(F),^L<IOPAR>]>)	;1005 - EVEN PARITY
	TMAC	(2,TAP.SA!TAP.SP,TAPBKS)	;1006 - BLOCKSIZE
	TMAC	(3,TAP.SA!TAP.MD,TDYMOD)	;1007 - MODE
	TMAC	(0,TAP.PS,<[POINT 1,TUBCNF(U),18]>)	;1010 - TRACK INFO
	TMAC	(0,0,<[POINT 1,TUBSTS(U),2]>)	;1011 - WRITE LOCK
	TMAC	(0,0,<[POINT 36,TUBCCR(U),35]>)	;1012 - CHAR CNT
	TMAC	(0,TAP.PS,<[POINT 36,TUBRID(U),35]>)	;1013 - REELID
	TMAC	(0,0,PMTCRC)	;1014 - CRC
	TMAC	(0,0,<[POINT 18,TUBSTS(U),17]>)	;1015 - UNIT STATUS
	TMAC	(0,TAP.SP,TAPSTS)	;1016 - STATISTICS
	TMAC	(0,0,<[POINT 36,TUBIEP(U),35]>)	;1017 - INITIAL ERROR POINTER
	TMAC	(0,0,<[POINT 36,TUBFEP(U),35]>)	;1020 - FINAL ERROR POINTER
	TMAC	(0,TAP.SP,TAPIES)	;1021 - INITIAL ERROR STATS
	TMAC	(0,TAP.SP,TAPFES)	;1022 - FINAL ERROR STATS
	TMAC	(0,0,<[POINT 36,TUBTRY(U),35]>)	;1023 - # RETRIES
IFN FTTLAB,<
	TMAC	(4,TAP.PS+TAP.LT,TUYLTP) ;1024 - READ/SET LABEL TYPE
	TMAC	(4,TAP.PS+TAP.LT,TUYLTP) ;1025 - READ/SET LABEL TYPE
	TMAC	(0,0,PDVESE)	;1026 - LABEL TERMINATION CODE
> ;END IFN FTTLAB
IFE FTTLAB,<				;;; DUMMIES
	0				;1024
	0				;1025
	0				;1026
> ;END IFE FTTLAB
	TMAC	(0,TAP.PS,<[POINT 1,TUBCNF(U),20]>)	;1027 - DIAG MODE SET
	TMAC	(0,TAP.PS,<[POINT 1,TUBCNF(U),21]>)	;1030 - FORCE SENSE
	TMAC	(5,TAP.FC,PBUFRM)	;1031 : MAX FRAME COUNT
	TMAC	(0,0,<[POINT 5,TUBCNF(U),27]>)	;1032 - DENSITY CAPABILITIES

IFN FTTLAB,<
	TMAC	(0,TAP.SP!TAP.SA,TAPRLP)	;1033 - READ LABEL PARAMETERS
> ;END IFN FTTLAB
IFE FTTLAB,<
	0			;1033 - DUMMY
> ;END IFE FTTLAB
TAPLN1==.-TAPTB1
;RANGE TABLE FOR TAPOP UUO

TAPSRT:	0,,5			;1 - DENSITY
	<NOISE##/4>,,377777	;2 - BLOCKSIZE
	0,,5			;3 - MODE
IFN FTTLAB,< 0,,LT.MAX		;4 - LABEL TYPE>
IFE FTTLAB,< 0>

NOISE##,,<^D4095*6>-1		;5 - MAX FRAME-COUNT

TAPSYR:	POINT	6,TAPTB1(P1),5	;POINTER TO RANGE INDEX
TAPMTP:	POINT	6,TAPTB0-1(P1),5 ;POINTER TO MTAPE EQUIVALENT

;CONTENTS OF TAPTC0 ARE AS FOLLOWS
;BITS 0-5 ARE INDEX INTO RANGE TABLE (IF ANY)
;BITS 6-12 ARE FLAGS FOR DETERMINING VALIDITY
;BITS 18-35 IS ADDRESS OF BYTE POINTER OR SPECIAL ROUTINE

TAPTC0:				;CUSTOMER FUNCTIONS GO HERE
TAPLC0==.-TAPTC0		;LENGTH OF CUSTOMER-DEFINED TABLE
;ROUTINE TO LINK TAPOP. FCNS TO MTAPE FCNS

TAPOPM:	PUSHJ	P,PIOSET	;SET UP ACS, UDB, ETC.
	JUMPE	J,ECOD6##	;ERROR IN NO OWNER
	LDB	T1,TAPMTP	;GET MTAPE FCN CODE
	HRR	M,T1		;MAKE M LOOK LIKE IN MTAPE
	PUSH	P,T1		;SAVE MTAPE FUNCTION CODE
	PUSHJ	P,MTAP0		;ISSUE MTAPE COMMAND
	POP	P,T1		;RESTORE FUNCTION CODE
	CAIE	T1,MT.WTM	;WRITE TAPE MARK OR
	CAIN	T1,MT.WLG	;LONG GAP?
	SKIPA
	PJRST	CPOPJ1##	;NO, SKIP RETURN
	MOVEI	P2,RB.FYB	;YES, MAKE YELLOW BALL IORB
	PUSHJ	P,GENIOR	;SO WE KNOW WHEN THE WRITE IS DONE
	  JRST	TAPOP1		;CAN'T QUEUE, JUST TEST
	MOVEM	T1,TDVIOR(F)
	XMOVEI	T2,TPMNOP	;HACK LOCATION
	MOVEM	T2,IRBIVA(T1)	;DEFEND AGAINST KONWAT
	PUSHJ	P,TAPRQT##	;PLACE AT END OF QUEUE
	PUSHJ	P,KONWAT	;WAIT FOR CONTROLLER
	PUSHJ	P,TPMFLX	;FLUSH THIS REQUEST
TAPOP1:	MOVE	S,DEVIOS(F)	;SET UP S
	TRNE	S,IOIMPM	;TO CHECK FOR WRITE LOCK
	PJRST	ECOD16##	;CAUSE ERROR RETURN
	PJRST	CPOPJ1##	;ALL OK

;SPECIAL ROUTINE FOR BLOCKSIZE
TAPBKS:	HRR	M,P4		;GET FUNCTION
	PUSHJ	P,GETWRD##	;GET USER'S FUNCTION
	  JRST	ECOD4		;ADDRESS ERROR
	TRNE	T1,2000		;READ OR SET?
	JRST	TAPSBS		;SET
	LDB	T1,PBUFSZ##	;GET IT
	JRST	STOTC1		;STORE AND GOOD RETURN

;HERE TO SET BLOCKSIZE
TAPSBS:	LDB	T1,TUYKTP##	;GET KONTROLLER TYPE
	CAILE	T1,K.MAX	;DO WE KNOW ABOUT IT?
	JRST	ECOD3##		;NO--CALL IT OUT OF RANGE
	MOVE	T2,UDBKDB(U)	;GET KDB ADDRESS
	MOVE	T2,KDBDSP(T2)	;AND IT'S DISPATCH TABLE
	CAMLE	P2,TPKBSZ(T2)	;OK FOR THIS KONTROLLER TYPE?
	JRST	ECOD3##		;NO, OUT OF RANGE ERROR
	DPB	P2,PBUFSZ##	;DO IT
	JRST	CPOPJ1##	;AND GOOD RETURN

;SPECIAL ROUTINE FOR STATISTICS (1016)
;LH(P4) := LEN OF ARG BLOCK , RH(M) := LOC OF LAST ARG

TAPSTS:	HLRZ	T2,P4		;GET LENGTH
	SUBI	T2,2		;CORRECT FOR ARGS
	JUMPLE	T2,ECOD4##	;NOT ENOUGH ARGS
	CAILE	T2,TPCHMX	;COMPARE AGAINST MAX
	MOVEI	T2,TPCHMX	;OUT OF RANGE - USE MAX
	MOVN	P1,T2		;NEGATE LENGTH
	HRLZS	P1		;MOVE TO LH
	HRRI	P1,TUBRID	;BASE OFFSET TO STATISTICS

TPMCPY:	HRRZ	T1,P1		;GET UDB OFFSET
	ADD	T1,U		;RELOCATE
	MOVE	T1,(T1)		;FETCH WORD
	PUSHJ	P,PUTWR1##	;STORE IN USER AREA
	  JRST	RTM1##		;OUT OF BOUNDS
	AOBJN	P1,TPMCPY	;CONTINUE TILL DONE
	PJRST	CPOPJ1##	;THEN GIVE SKIP RETURN

;SPECIAL ROUTINE FOR ERROR INFO (1021/1022)

TAPIES:	SKIPA	P1,TUBIEP(U)	;GET INITIAL ERROR PNTR
TAPFES:	MOVE	P1,TUBFEP(U)	;GET FINAL ERROR PNTR
	HLRZ	T2,P4		;GET USER LEN
	MOVNI	T2,-2(T2)	;NEGATE AND ADJUST FOR ARGS
	JUMPGE	T2,ECOD4##	;NOT ENOUGH ARGS
	HLRE	T3,P1		; -LEN OF ERROR BLOCK
	CAMLE	T2,T3		;CHECK VALIDITY
	HRL	P1,T2		;YES - USE USERS ARG
	PJRST	TPMCPY		;GO COPY DATA
;ROUTINE TO HANDLE DATA SECURITY ERASE

TPMDSE:	PUSHJ	P,PIOSET	;SET ACS ETC.
IFN FTTLAB,<
	MOVEI	T1,40(P1)	;GENERATE SPECIAL CODE
	PUSHJ	P,LBLSLP	;WAIT FOR LBL PCS TO FINISH
	PUSHJ	P,LBLPOS	;CHECK FOR LBL PCS
	  PJRST	CPOPJ1##	;ALL DONE - RETURN
> ;END IFN FTTLAB
	JUMPE	J,ECOD6##	;ERROR IF NO OWNER
	MOVEI	P2,RB.FSE	;FCN TO P2
	MOVEI	P3,TPMDE0	;USE WRITE WITH LONG TIMEOUT
	TRZ	S,IOERRS
	PUSHJ	P,MTAP2		;START OP
	PUSHJ	P,TPSKPW	;WAIT TILL DONE
	TRNE	S,IOERRS
	PJRST	ECOD0##
	MOVEI	P2,RB.FLG	;NOW DO 14 ERASE GAP OPS
	MOVEI	P3,TPMDE1
	AOS	(P)		;GIVE SKIP RETURN
	PJRST	MTAP2		;START OP

;HERE TO PERFORM WRITE OP WITH LONG TIMEOUT

TPMDE0:	XMOVEI	T1,WRTDUN	;WHERE TO GO ON COMPLETION
	MOVEM	T1,IRBIVA(P1)	;SAVE IT
	PJRST	TPSTRT		;GO START THE OPERATION

;HERE ON KONTROLLER AVAILABLE

TPMDE1:	MOVEI	T1,^D14		;SET COUNT
	HRRM	T1,@IRBACC(P1)	;INTO IORB
	PJRST	TPMWR1		;START I/O

;ROUTINE TO WRITE LEOT (TM,TM,BSB)

TPMWET:	PUSHJ	P,PIOSET	;SET ACS ETC.
IFN FTTLAB,<
	MOVEI	T1,40(P1)	;SPECIAL CODE
	PUSHJ	P,LBLSLP	;WAIT FOR LBL PCS TO FINISH
	PUSHJ	P,LBLPOS	;CHECK LABELER
	  PJRST	CPOPJ1##	;THROUGH - EXIT
> ;END IFN FTTLAB
	JUMPE	J,ECOD6##	;ERROR IF NO OWNER
	PUSHJ	P,SAVE3##
	MOVE	P3,S
	ANDI	P3,IOERRS
	PUSHJ	P,TPMCL1	;JOIN CLOSE CODE
	MOVE	S,DEVIOS(F)	;SET UP S
	TRNE	S,IOIMPM	;WRITE LOCK?
	PJRST	ECOD16##	;YES, CAUSE ERROR RETURN
	PJRST	CPOPJ1##	;NO, ALL OK
IFN FTTLAB,<

;TAPE LABEL GET -- SET UP DDB IF NONE AND CONTINUE UNIT

TPMLBG:	MOVE	T1,DEVNAM(F)	;GET PHYS NAME
	MOVEI	T2,'''L'	;CONVERT TO SECONDARY NAME
	DPB	T2,[POINT 12,T1,11]
	PUSH	P,T1		;SAVE IT
	PUSH	P,F		;SAVE DDB PNTR
	PUSHJ	P,DEVPHY##	;SEARCH FOR EXISTANCE
	  JRST	TPLBGA		;NOT FOUND
	POP	P,P1		;FOUND AIM P1 AT REAL DDB
	POP	P,(P)		;AND THROW AWAY THE NAME
	LDB	T1,PJOBN##	;GET  OWNER JOB#
	CAME	T1,J		;DO WE OWN IT?
	JUMPN	T1,ECOD14##	;NO, ERROR IF ANOTHER
	JRST	TPLBG1		;OURS OR NO OWNER

TPLBGA:	MOVEI	T2,TDVLEN	;SIZE OF DDB
	PUSHJ	P,GETWDS##	;ALLOCATE STORAGE
	  JRST	[MOVEI T1,1	;FAILED
IFN FTPSCD,<
		AOS %MTASL##	;COUNT MTA GENERATED SLEEP
>;END IFN FTPSCD
		 PUSHJ P,TSLEE2 ;WAIT FOR SOME TO APPEAR
		 JRST TPLBGA]	;TRY AGAIN
	POP	P,P1		;GET OLD DDB PNTR INTO P1
	MOVE	F,T1		;SET UP NEW PNTR
	HRLI	T1,TDVDDB	;LOC OF PROTOTYPE
	BLT	T1,TDVLEN-1(F)	;MOVE INTO PLACE
	POP	P,DEVNAM(F)	;GIVE IT A NAME
	MOVEI	T1,ASSCON	;MAKE LABEL DDB ASSIGNED BY CONSOLE
	IORM	T1,DEVMOD(F)
	MOVSI	T1,DVLNG	;CLEAR LONG DISPATCH FLAG (WHY?)
	ANDCAM	T1,DEVMOD(F)
	MOVSI	T1,DEPRAS	;SET RESTRICTED ASSIGNMENT FLAG
	IORM	T1,DEVTYP(F)
	MOVEI	T1,DEPEVM	;NOW GET THIS CORRECT
	TDNE	T1,DEVTYP(P1)	;IF OLD DDB NEEDED EVM
	IORM	T1,DEVTYP(F)	;  THEN THIS ONE DOES ALSO
	MOVE	T1,DEVCPU(P1)	;COPY OLD INTERLOCK WORD
	MOVEM	T1,DEVCPU(F)	;TO NEW DDB
	HLRZ	T1,DEVSER(P1)	;FIX UP LINKS OF
	HRLM	T1,DEVSER(F)	;  DDB CHAIN TO
	HRLM	F,DEVSER(P1)	;  INCLUDE THIS NEW ONE
TPLBG1:	DPB	J,PJOBN##	;ASSIGN TO THIS JOB
	MOVE	T1,TDVUDB(P1)	;UDB POINTER
	MOVEM	T1,TDVUDB(F)	;INTO NEW DDB
	MOVE	T1,TDVSTS(P1)	;GET PAR/DEN/MODE, USERS SET
	MOVEM	T1,TDVSTS(F)	; AND STORE IN LABEL DDB
	MOVEM	F,TUBDDL(U)	;LINK LABEL DDB TO UDB
	PUSHJ	P,TPWAIT	;WAIT OUR TURN FOR THIS TAPE
	MOVE	T1,DEVNAM(F)	;GET NAME OF NEW DDB
	PUSHJ	P,STOTAC##	;STORE FOR USER
	AOS	0(P)		;SET FOR SKIP RETURN
	PJRST	TAPCNT##	;ALLOW UNIT TO BE SCHEDULED AGAIN

	;;; STILL IN FTTLAB CONDITIONAL
;TAPE LABEL RELEASE -- TRY TO GET JOB RUNNING AGAIN

TPMLBR:	SKIPE	P1,TUBDDL(U)	;LABEL DDB ADDRESS
	SETZM	TUBDDL(U)	;CLEAR SECONDARY DDB
	AOS	0(P)		;SET FOR SKIP RETURN
	HLRZ	T1,P4		;USERS LENGTH
	CAIL	T1,3		;CHECK FOR POSSIBLE 3RD ARG
	PUSHJ	P,GETWR1##	;FETCH IT
	  MOVEI	T1,0		;ASSUME ZERO
	CAILE	T1,IOMAX%	;RANGE CHECK
	MOVEI	T1,0		;ASSUME IT SHOULD BE ZERO
	DPB	T1,PDVESE##
	TLZN	S,LBLWAT	;CHECK IF WAITING
	JRST	TPLBRU		;NO - UNWIND REQUESTS
	MOVEM	S,DEVIOS(F)
	LDB	T1,PJOBN##	;GET JOB NUMBER
	JUMPE	T1,TPLBRU	;IF NONE - EXIT
	PUSH	P,J		;SAVE RUNNING JOB #
	PUSHJ	P,SETACS	;LINK UP DDB,UDB
	POP	P,J		;GET BACK UUO JOB #
	EXCH	T1,J		;SAVE J - SET OTHER JOB #
	LDB	T2,PJBSTS##	;GET JOB STATUS
	EXCH	T1,J		;RESTORE J
	CAIN	T2,STOPQ##	;IS JOB STOPPED?
	PJRST	TAPHLD##	;YES - JUST SET NS
	PJRST	EWAKE##		;ELSE WAKE HIM UP

;HERE TO JUST QUIETLY DE-Q OLD INFO

TPLBRU:	MOVSI	T1,TUBQUE(U)	;SET Q TO NULL STATE
	EXCH	T1,TUBQUE(U)	;AND FETCH OLD INFO
	TLZ	T1,-1		;CLEAR LH
	PJRST	TPMDQ		;SLUURRRRP!
;ROUTINE TO SWITCH TWO UNITS FOR TAPE LABELING
;CALL - F := CURRENT DDB

TPMLSU:	MOVE	T1,DEVNAM(F)	;GET CURRENT DEVICE'S NAME
	PUSHJ	P,DEVPHY##	;LOCATE IT WITH A VALID PREDECESSOR
	  JRST	ECOD2##		;PUNT IF IT WENT AWAY
	MOVE	P2,T2		;SAVE PREDECESSOR
	TLZ	F,-1-MXSECN	;MAKE COMPARISONS WORK
	PUSH	P,F		;SAVE TAPE LABELER'S DDB
	MOVE	T1,TDVUDB(F)	;POINT TO THE TUB
	MOVE	F,UDBDDB(T1)	;AND NOW THE REAL DDB
	PUSHJ	P,PSIRSW##	;SIGNAL THE REEL SWITCH
	POP	P,F		;AND ITS DDB
	HLRZ	T1,P4		;GET USERS LENGTH
	CAIL	T1,3		;MIN OF 3
	PUSHJ	P,GETWR1##	;GET NAME OF NEW DEVICE
	  PJRST	ECOD4##		;BAD ARG ADDRS
	MOVE	P1,F		;SAVE OLD DDB ADDRS
	PUSHJ	P,DEVPHY##	;LOOK FOR NEW ONE
	  PJRST	ECOD2##		;SEARCH LOST
	MOVSI	T1,DVMTA	;GRNTEE IT IS A MTA
	TDNN	T1,DEVMOD(F)	;...
	PJRST	ECOD2##		;SORRY 'BOUT THAT
	MOVE	P3,T2		;SAVE PRED.
	EXCH	F,P1		;GET OLD DDB ADDRESS FOR STATS
	PUSHJ	P,SNDVSS##	;SEND VOL SWITCH TAPE STATS FOR ACCOUNTING
	  JFCL			;WE TRIED
	PUSHJ	P,TPSTAT	;REPORT STATS
	CAMN	P1,F		;SAME DDB
	JRST	CPOPJ1##	;YES--GO AWAY
	EXCH	F,P1		;NO--GET NEW DDB BACK
	TAPOFF			;DEFEND AGAINST INTERRUPTS
	SKIPA	T1,DEVIOS(P1)	;GET OLD UNIT STATUS BITS
	EXP	 <LBLNED+FSTOP+IOEND+IOSTBL+LBLEOF,,IOTEND+IOEND+IOERRS>
	TDZ	T1,.-1		;CLEAR LOTS OF BITS...
	MOVEM	T1,DEVIOS(P1)	;SAVE THE NEW STATUS
	DDBSRL			;DONT LET ANY OTHER CPU SCAN CHAIN
	MOVE	T1,DEVNAM(F)	;GET NEW NAME
	EXCH	T1,DEVNAM(P1)	;EXCHANGE WITH OLD ONE
	MOVEM	T1,DEVNAM(F)	;AND SAVE IN NEW DDB
	SKIPE	DEVLOG(P1)	;WAS THERE A LOGICAL NAME
	JRST	TPLSU1		;YES - OK THEN
	MOVEM	T1,DEVLOG(P1)	;NO - USE OLD PHYSICAL NAME
TPLSU1:	MOVE	T1,DEVCPU(P1)	;SWAP DEVCPU
	EXCH	T1,DEVCPU(F)	; BETWEEN THE
	MOVEM	T1,DEVCPU(P1)	;  TWO DDBS
	HLRZ	T1,DEVSER(P1)	;SUCCESSOR TO 1ST UNIT
	HLRZ	T2,DEVSER(F)	;SUCCESSOR TO 2ND UNIT
	HRLM	F,DEVSER(P2)	;MAKE PRED(1ST) POINT AT 2ND
	HRLM	P1,DEVSER(P3)	;MAKE PRED(2ND) POINT AT 1ST
	CAIN	T2,(P1)		;MAKE 1ST POINT AT SUCC(2ND)
	MOVE	T2,F		; IF 1ST = SUCC 2ND, POINT 1ST AT 2ND
	HRLM	T2,DEVSER(P1)
	CAIN	T1,(F)		;POINT 2ND AT SUCC (1ST)
	MOVE	T1,P1		; OR AT 1ST
	HRLM	T1,DEVSER(F)
	MOVE	T1,GENPTR##	;AOBJN POINTER TO TABLE
TPLSU2:	HRRZ	T2,GENTAB##+1(T1) ;GET ADDR OF THIS GENERIC DDB
	CAIN	T2,(F)		;IS 1ST DDB GENERIC ?
	HRRM	P1,GENTAB##+1(T1) ;YES, UPDATE NEW DDB AS GENERIC
	CAIN	T2,(P1)		;IS 2ND DDB GENERIC ?
	HRRM	F,GENTAB##+1(T1) ;YES, ITS THE OLD ONE NOW
	AOBJN	T1,.+1		;ACCOUNT FOR TWO WORD ENTRIES
	AOBJN	T1,TPLSU2	;SEARCH THE TABLE
	DDBSRU			;GIVE UP INTERLOCK
	MOVE	T2,TDVUDB(P1)	;UDB ADDRESS
	EXCH	T2,TDVUDB(F)	;SWAP
	MOVEM	T2,TDVUDB(P1)	;UPDATE
	MOVEM	F,UDBDDB(U)	;FIX UDB / DDB PNTR
	MOVE	P2,U		;OLD UDB PNTR
	MOVE	U,TDVUDB(P1)	;NEW UDB ADDRESS
	MOVE	T2,TUBLBL(U)	;EXCHANGE LABEL INFO IN UDBS
	EXCH	T2,TUBLBL(P2)
	MOVEM	T2,TUBLBL(U)	;...
	MOVEM	P1,UDBDDB(U)	;AND SET PNTR
	MOVE	F,P1		;MAKE F POINT AT NEW DDB
	SKIPE	T1,TUBDDL(U)	;GET NEW UNIT'S OLD LABEL DDB
	MOVEM	P2,TDVUDB(T1)	;CHANGE ITS UNIT POINTER IF IT EXISTS
	EXCH	T1,TUBDDL(P2)	;UPDATE PREVIOUS, GET OLD
	SKIPE	T1		;IF NEW LABEL DDB,
	MOVEM	U,TDVUDB(T1)	;UPDATE ITS UNIT POINTER
	MOVEM	T1,TUBDDL(U)	;AND THE UNIT POINTER TO THE DUMB DDB
	TAPON			;ALLOW INTERRUPTS AGAIN
	JRST	CPOPJ1##	;SKIP EXIT
;ROUTINE TO SEND FORCE EOV MESSAGE TO LBL PCS

TPMFEV:	MOVE	S,DEVIOS(F)	;SET UP S
	PUSHJ	P,LBLCKM	;CHECK FOR LBL PROCESS
	  SKIPA	T1,[LR.EOV]	;REQUEST CODE
	PJRST	ECOD7##		;NO LABEL PROCESS
	PUSHJ	P,LBLSLP	;WAIT FOR LBL PCS TO FINISH
	DPB	T1,TUYRQT	;REQUEST TYPE
	MOVEI	T1,0		;ZERO ADDITIONAL INFO
	DPB	T1,TUYINF	;...
TPMSND:	PUSHJ	P,LBLMSG	;SEND MESSAGE AND BLOCK
	LDB	T1,PDVESE##
	JUMPE	T1,CPOPJ1##	;SKIP RETURN IF NO ERROR
	PJRST	ECOD10##	;ELSE ERROR

;ROUTINE TO SEND USER REQUEST FOR LABEL PROCESSING

TPMURQ:	MOVE	S,DEVIOS(F)	;SET UP S
	PUSHJ	P,LBLCKM	;SEE IF LBL PCS
	  SKIPA	T1,[LR.URQ]	;YES - REQUEST TYPE
	PJRST	ECOD7##		;ERROR
	PUSHJ	P,LBLSLP	;WAIT FOR LBL PCS TO FINISH
	DPB	T1,TUYRQT	;REQUEST TYPE
	HLRZ	T1,P4		;GET USER LENGTH ARG
	CAIL	T1,3		;CHECK FOR ENUF ARGS
	PUSHJ	P,GETWR1##	;FETCH NEXT
	  PJRST	ECOD4##		;TOO FEW ARGS
	CAILE	T1,77		;CHECK RANGE
	  JRST	ECOD3##		;OUT OF BOUNDS
	DPB	T1,TUYINF	;STASH IN UDB
	PJRST	TPMSND		;SEND MESSAGE
;ROUTINE TO DESTROY LABEL DDB AND GIVE BACK ITS STORAGE

TPMLDD:	SKIPE	TUBDDL(U)	;LABEL DDB ADDRESS
	JRST	ECOD12##	;ERROR IF THERE IS ONE
	MOVE	T1,DEVNAM(F)	;GET PHYS NAME
	MOVEI	T2,'''L'	;CONVERT TO SECONDARY NAME
	DPB	T2,[POINT 12,T1,11]
	PUSHJ	P,DEVPHY##	;GO FIND IT
	  JRST	CPOPJ1##	;NOT THERE, JUST RETURN
	LDB	T1,PJOBN##	;GET THIS DDB'S OWNER
	CAME	T1,J		;IS IT THE GUY DOING RELEASE
	JUMPN	T1,ECOD6##	;NO, ERROR IF ANOTHER
	PUSHJ	P,WAIT1##	;WAIT FOR I/O TO STOP
	AOS	0(P)		;SET FOR SKIP RETURN
	MOVE	T1,DEVSER(F)	;GET LINK FROM DB TO BE DESTROYED
	HLLM	T1,DEVSER(T2)	;SAVE IN PREDESSOR

;PREVENT THE POSSIBILITY THAT SOMEONE HAS AN F POINTING AT THE
;DDB THAT WILL GO AWAY IN A LITTLE WHILE.  IF THEY GET HELD UP
;AND THEN TRY TO DEVSER THEMSELVES TO THEIR NEXT DDB, THEY MAY
;TRY TO USE CORE THAT HAS BEEN RE-USED BY SOMEONE.
	DDBSRL			;STOP DDB SCANNING
	MOVE	T1,DEVSER(F)	;GET LINK FROM DB TO BE DESTROYED
	HLLM	T1,DEVSER(T2)	;SAVE IN PREDESSOR
	DDBSRU			;RESUME DDB SCANNING
	PUSHJ	P,SAVE1##	;SAVE P1
	MOVEI	P1,0		;START AT CHANNEL 0
TPMLD2:	PUSHJ	P,NXTCH##	;NEXT CHANNEL
	  JRST	TPMLD3		;DONE
	CAIE	T1,(F)		;IS IT INITED ON THIS CHANNEL
	JRST	TPMLD2		;NO
	SOS	P1		;UNDO NXTCH ADVANCE
	PUSHJ	P,JDAADP##	;NO, CLEAR OUT THIS CHANNEL
	SETZM	(T1)
TPMLD3:	SKIPE	DEVPSI##(F)	;ON THE PSI SYSTEM?
	PUSHJ	P,PSIRMV##	;YES, REMOVE IT

	MOVEI	T1,TDVLEN	;SIZE OF DDB
	HRRZ	T2,F		;ADDR
	PJRST	GIVWDS##	;GIVE BACK STORAGE AND RETURN
;READ/SET LABEL PARAMETERS
TAPRLP:	HRR	M,P4		;POINT AT USER'S FUNCTION
	TLZ	F,-1-MXSECN	;CLEAR JUNK FROM UUOCON
	PUSHJ	P,LBLCKM	;CHECK FOR LBL PCS
	  JRST	TAPRL0		;THERE IS ONE, GO AHEAD
	PUSHJ	P,GETWRD##	;GET USER'S FUNCTION
	  PJRST	ECOD4##		;ADDR ERROR
	CAME	F,TUBDDL(U)	;LABEL DDB ADDRESS?
	PJRST	ECOD7##		;NO, NO LBL PCS
	TRNE	T1,2000		;SET FUNCTION
	JRST	TAPSLP		;YES, DO IT
	JRST	TAPRL1		;DO READ
TAPRL0:	PUSHJ	P,GETWRD##	;GET USER'S FUNCTION
	  PJRST	ECOD4##		;ADDR ERROR
	PUSHJ	P,LBLSLP
	TRNE	T1,2000		;SET FUNCTION?
	JRST	TAPSLP		;YES
	TLNN	S,FINP		;FIRST INPUT DONE?
	JRST	TAPRL1		;YES, PROCEED
	MOVEI	T1,LR.FIN	;REQUEST FOR FIRST INPUT
	DPB	T1,TUYRQT	;SAVE IN TUB
	MOVEI	T1,77		;GET LABEL READ FCN
	DPB	T1,TUYINF	;SET IT
	PUSHJ	P,LBLMSG	;SEND MESSAGE
	LDB	T1,PDVESE##	;CHECK ERROR BITS
	JUMPN	T1,ECOD10##	;GIVE ERROR TO USER
TAPRL1:	ADDI	M,1		;POINT AT WHERE TO START STORING
	HLRZ	T2,P4		;GET LENGTH
	SUBI	T2,2		;CORRECT FOR ARG'S
	JUMPLE	T2,ECOD4##	;NOT ENOUGH ARG'S
	CAILE	T2,TLPMAX	;BIGGER THAN MAX?
	MOVEI	T2,TLPMAX	;YES, USE MAX
	MOVN	P1,T2		;NEGATE LENGTH
	HRLZS	P1		;MOVE TO LH
	HRRI	P1,TUBRFM	;UDB OFFSET TO START OF LABEL PARAMETER AREA
	JRST	TPMCPY		;USE EXISTING ROUTINE TO RETURN BLOCK
TAPSLP:	HLRZ	T2,P4		;GET LENGTH OF USER'S ARG BLOCK
	SUBI	T2,2		;ACCOUNT FOR FIRST 2 ARG'S
	JUMPLE	T2,ECOD4##	;NOT ENOUGH ARGS
	CAILE	T2,TLPMAX	;BIGGER THAN MAX
	MOVEI	T2,TLPMAX	;YES, USE MAX
	MOVN	P1,T2		;GET NEGATIVE LENGTH
	HRLZS	P1		; INTO LH FOR AOBJN
	HRRI	P1,TUBRFM(U)	;POINT AT START OF AREA
	ADDI	M,1		;POINT M AT DEVICE ARG WORD
TAPSL1:	PUSHJ	P,GETWR1##	;GET NEXT ARGUMENT
	  PJRST	ECOD4##		;NOT THERE, ERROR
	MOVEM	T1,0(P1)	;STORE IN TUB
	AOBJN	P1,TAPSL1	;GET ALL ARGUMENTS
	MOVEI	T1,TLPMAX
	SUB	T1,T2
	JUMPLE	T1,CPOPJ1##
	ADDI	P1,1
	SETZM	(P1)
	SOJG	T1,.-2
	JRST	CPOPJ1##	;SKIP RETURN
> ;END IFN FTTLAB

IFN FTTLAB,<
;ROUTINE TO SET DENSITY IN THE OTHER DDB.
; (EITHER THE LABEL DDB, OR THE REAL DDB)
;CALL-T1 HAS DESIRED DENSITY CODE
; -F POINTS AT REGULAR (OR LABEL) DDB
;RETURNS- T2,T3 CLOBBERED, DENSITY SET IN
; LABEL (OR REGULAR) DDB

SETODN:	MOVE	T3,TDVUDB(F)	;GET DOWN TO UDB
	SKIPN	T2,TUBDDL(T3)	;GET LABEL DDB ADDRESS
	POPJ	P,		;NO OTHER, DON'T BOTHER
	PUSH	P,F		;SAVE F
	TLZ	F,-1-MXSECN	;CLEAR POSSIBLE JUNK FROM UUOCON
	CAMN	T2,F		;SET DENSITY ON LABEL DDB
	MOVE	T2,UDBDDB(T3)	; GET ADDRESS OF REGULAR DDB
	SKIPN	T2		;BETTER BE ONE!
	STOPCD	FPOPJ##,DEBUG,RDN ;++ REGULAR DDB NOT FOUND
	EXCH	T2,F		;AIM AT OTHER
	TLNN	T1,(ST.FAC)	;REQUEST A DENSITY CHANGE?
	DPB	T1,TDYDN1	;SET DENSITY
	TLNE	T1,(ST.FAC)	;ACTUAL DENSITY?
	DPB	T1,TDYDEN	;YES, SET ACTUAL DENSITY
	EXCH	T2,F		;BACK TO NORMAL
	JRST	FPOPJ##		;RESTORE F AND RETURN
>;END IFN FTTLAB
;ROUTINE TO TAKE CTL OFF-LINE AND SET MAINT MODE FOR ALL KONTROLLERS
;ON SAME SAME CHANNEL. SOME DIAGS THINK SINCE THEY OWN ONE KONTROLLER
;ON THE CHANNEL THAT THEY CAN DO WHAT THEY WANT WITH THE CHANNEL. THIS
;CAN CAUSE PROBLEMS IF THERE ARE OTHER KONTROLLERS ON THE SAME CHANNEL.

TPMSMM:	MOVE	W,UDBKDB(U)	;GET KDB ADDRS
	HRRZ	T3,TKBJOB(W)	;GET KDB "OWNER" IF ANY
	MOVSI	T2,TKSMNT##	;GET MAINT BIT
	TDNN	T2,TKBSTS(W)	;IN MAINTENANCE MODE ALREADY
	JRST	TPMSM0		;NO
	CAIE	T3,(J)		;YES, IS IT SAME PERSON?
	PJRST	ECOD11##	;NO, GIVE ERROR RETURN
	MOVE	T1,KDBICP(W)	;YES, GET ADDRS OF CHANNEL PROGRAM
	PJRST	STOTC1##	;RETURN ADDRS TO CALLER

;LOOP THRU ALL KDBS ON SAME CHANNEL AND SEE IF ALL UDB/DDBS ARE
;"ASSIGNABLE".

TPMSM0:	PUSH	P,KDBICP(W)	;SAVE ADDRS OF CHANNEL PROGRAM FOR USER
	MOVE	T4,KDBDVC(W)	;GET DEVICE CODE
	DDBSRL			;GET THE DDB INTERLOCK
	SKIPA	W,KDBTAB##+.TYMTA ;GET FIRST KDB ADDRS
TPMSM1:	MOVE	W,KDBNXT(W)	;GET NEXT KDB ADDRS
	JUMPE	W,TPMSM4	;IF NONE, GO SET UP DDBS
	CAME	T4,KDBDVC(W)	;ON SAME CHANNEL?
	JRST	TPMSM1		;NO, TRY NEXT KDB
	MOVE	T3,KDBIUN(W)	;YES, GET POINTER TO UDB TABLE
TPMSM2:	SKIPN	T2,0(T3)	;SEE IF UNIT EXISTS
	JRST	TPMSM3		;NO - TRY NEXT
	MOVE	F,UDBDDB(T2)	;GET DDB PNTR
	LDB	T1,PJOBN##	;OWNING JOB NUMBER
	CAME	T1,J		;IT HAD BETTER BE ME
	JUMPN	T1,[DDBSRU	; OR JOB 0
		    POP  P,(P)	;PHASE STACK
		    JRST ECOD11##] ;RETURN ERROR
TPMSM3:	CAMGE	T3,KDBFUN(W)	;LAST UDB?
	AOJA	T3,TPMSM2	;NO, LOOP FOR MORE
	JRST	TPMSM1		;YES, GO TO NEXT KDB

;WE CAN GET ALL UDB/DDBS NEEDED, SET THEM UP

TPMSM4:	SKIPA	W,KDBTAB##+.TYMTA ;GET FIRST KDB ADDRS
TPMSM5:	MOVE	W,KDBNXT(W)	;GET NEXT KDB ADDRS
	JUMPE	W,TPMSM8	;IF NONE, GO FINISH UP
	CAME	T4,KDBDVC(W)	;ON SAME CHANNEL?
	JRST	TPMSM5		;NO, TRY NEXT KDB
	MOVE	T3,KDBIUN(W)	;POINTER TO UDB TABLE
TPMSM6:	SKIPN	T2,0(T3)	;GET TUB
	JRST	TPMSM7		;NONE THERE
	MOVE	F,UDBDDB(T2)	;GET DDB PNTR
	MOVEI	T1,ASSCON	;ASSIGNED BY COMMAND BIT
	IORM	T1,DEVMOD(F)	;NAIL DOWN THE DDB
	DPB	J,PJOBN##	;INCLUDE OWNING JOB NUMBER
TPMSM7:	CAMGE	T3,KDBFUN(W)	;LAST UDB?
	AOJA	T3,TPMSM6	;LOOP FOR MORE
	CONO	PI,PI.OFF	;TURN OFF WORLD
IFN FTKL10,<HLLZS @KDBCSO(W)>	;REMOVE FROM CONSO CHAIN
	MOVSI	T1,TKSMNT##	;SET MAINT MODE BIT
	IORM	T1,TKBSTS(W)	;IN KDB
	CONO	PI,PI.ON	;RESTORE WORLD
	HRRM	J,TKBJOB(W)	;SAVE HIS JOB NUMBER
	JRST	TPMSM5		;LOOP FOR NEXT KDB
TPMSM8:	DDBSRU			;RELEASE DDB INTERLOCK

;PUT ANY KONTROLLERS ACCESSING SAME UNIT(S) IN MAINTENANCE MODE TOO

	XMOVEI	T3,UDBKDB(U)	;GET POINTER TO KDB ADDRESSES
	MOVEI	T2,MXPORT	;GET MAXIMUM NUMBER OF KDBS
	MOVSI	T4,TKSMNT##	;GET BIT TO SET
TPMSM9:	SKIPN	T1,(T3)		;GET KDB ADDRESS
	JRST	TPMS10		;NO MORE
	IORM	T4,TKBSTS(T1)	;SET MAINT BIT
	HRRM	J,TKBJOB(T1)	;SET JOB NUMBER (OWNER) TOO
	AOS	T3		;BUMP POINTER
	SOJG	T2,TPMSM9	;TRY NEXT
TPMS10:	POP	P,T1		;INFO USER WOULD LIKE (KDBICP)
	PJRST	STOTC1##	;AND SKIP RETURN

;ROUTINE TO RESTORE CTL AND CLEAR MAINT MODE (FOR ALL CTLS ON SAME CHANNEL)

TPMCMM:	MOVE	W,UDBKDB(U)	;GET KDB PNTR
	HRRZ	T4,TKBJOB(W)	;DOES THIS JOB HAVE KONTROLLER?
	CAIE	T4,(J)		;?
	JRST	ECOD11##	;NO - LOSE
	PUSH	P,KDBDVC(W)	;SAVE DEVICE CODE
	SKIPA	W,KDBTAB##+.TYMTA ;GET FIRST KDB ADDRS
TPMCM0:	MOVE	W,KDBNXT(W)	;GET NEXT KDB ADDRS
	JUMPE	W,TPMCM1	;GO CHECK POSSIBLE OTHER KDBS
	MOVE	T4,KDBDVC(W)	;GET DEVICE CODE
	CAMN	T4,(P)		;SAME CHANNEL?
	PUSHJ	P,TPMCMX	;YES, FREE UP KDB AND DDBS
	JRST	TPMCM0		;LOOP FOR NEXT KDB
TPMCM1:	XMOVEI	T3,UDBKDB(U)	;GET ADDRESS OF KDBS
	MOVEI	T2,MXPORT	;GET MAXIMUM NUMBER OF KDBS TO UNIT
	MOVSI	T4,TKSMNT##	;GET BIT TO CLEAR
TPMCM9:	SKIPN	T1,(T3)		;GET KDB ADDRESS
	JRST	TPOPJ1##	;NO MORE RETURN
	ANDCAM	T4,TKBSTS(T1)	;CLEAR MAINT BIT
	HLLZS	TKBJOB(T1)	;CLEAR OWNER
	AOS	T3		;BUMP POINTER
	SOJG	T2,TPMCM9	;TRY NEXT KDB
	JRST	TPOPJ1##	;DONE

;FREE UP KDB AND ASSOCIATED DDBS. CALLED FROM TPMCMM AND TPFREE.

TPMCMX:	HLLZS	TKBJOB(W)	;CLEAR KDB OWNER
	MOVE	T4,KDBDSP(W)	;ADDRS OF CTL DEP CODE
	MOVE	T1,KDBCAM(W)	;ON CORRECT CPU?
	TDNE	T1,.CPBIT##
	PUSHJ	P,@TPKRES(T4)	;YES, RESET CONTROLLER
	MOVSI	T1,TKSMNT##	;BIT TO CLEAR NOW
	ANDCAM	T1,TKBSTS(W)	; IN KDB
	MOVE	T3,KDBIUN(W)	;POINTER TO UDB TABLE
	DDBSRL			;INTERLOCK DDB SCANNING
TPMCM2:	SKIPN	T2,0(T3)	;GET TUB
	JRST	TPMCM3		;NONE THERE
	MOVE	F,UDBDDB(T2)	;GET DDB PNTR
	MOVEI	T1,ASSCON	;BIT TO CLEAR
	ANDCAB	T1,DEVMOD(F)	;CLEAR ASSIGNED BY COMMAND
	TRNE	T1,ASSPRG	;IS DEVICE INITED?
	JRST	TPMCM3		;NO
	SETZB	T1,DEVLOG(F)	;CLEAR ANY LOGICAL NAME ASSIGNMENT
	DPB	T1,PJOBN##	;AND OWNING JOB
TPMCM3:	CAMGE	T3,KDBFUN(W)	;LAST UDB?
	AOJA	T3,TPMCM2	;LOOP FOR MORE
	DDBSRU			;RELEASE INTERLOCK
	MOVE	T2,KDBDSP(W)	;GET DISPATCH TABLE
	MOVE	T1,KDBCAM(W)	;ON CORRECT CPU?
	TDNE	T1,.CPBIT##
	PUSHJ	P,@TPKLOD(T2)	;LOAD MICROCODE IF AVAILABLE
	  JFCL			;PROBABLY NOT THAT KIND OF CTL
	POPJ	P,		;RETURN

;ROUTINE CALLED ON TAPE ON-LINE
TPMONL::
IFN FTMDA,<
	PUSH	P,W		;IPCSER WIPES W
	MOVE	T1,UDBDDB(U)
	MOVE	T1,DEVNAM(T1)	;SIXBIT NAME
	MOVEI	T2,.TYMTA	;A MAGTAPE
	PUSHJ	P,SNDMDC##	;TELL MDC
	  JFCL
	POP	P,W		;RESTORE W
>; END IFN FTMDA
	PUSH	P,F		;SAVE F
	MOVE	F,UDBDDB(U)	;GET DDB
	PUSHJ	P,PSIONL##	;TELL PSISER
	POP	P,F		;RESTORE F
	POPJ	P,		;AND RETURN
; TAPOP. UUO FUNCTION .TFCEC
;
; CLEAR ERROR COUNTERS. THIS FUNCTION IS USED MAINLY BY THE TAPE LABLER.
; IN ORDER TO DETERMINE TAPE LABEL TYPE, PULSAR WILL READ A TAPE
; USING VARYING DENSITIES UNTIL A KNOWN LABEL TYPE IS FOUND. ALL
; FAILURES RESULT IN 'HARD ERRORS'. THESE ERRORS ARE REPORTED BY
; DAEMON AND GET TYPED OUT ON THE CTY AND THE USER'S TTY AS A RESULT
; OF THE SET WATCH MTA COMMAND. SINCE THESE AREN'T REALLY ERRORS,
; PULSAR MUST USE TAPOP. UUO FUNCTION .TFCEC TO AVOID MISLEADING AND
; AGGRIVATING USERS, AND DRIVING FIELD SERVICE PEOPLE UP A WALL W;
;
TPMCEC:	SETZM	TUBHRE(U)	;CLEAR HARD READ ERRORS
	SETZM	TUBSRE(U)	;CLEAR SOFT READ ERRORS
	SETZM	TUBHWE(U)	;CLEAR HARD WRITE ERRORS
	SETZM	TUBSWE(U)	;CLEAR SOFT WRITE ERRORS
	JRST	CPOPJ1##	;RETURN
SUBTTL MTAPE UUO

;MTAPE UUO

MTAPE0::PUSHJ	P,SAVE3##	;SAVE P1,P3
	PUSHJ	P,WAIT##	;WAIT FOR ALL PREVIOUS IO TO COMPLETE
	PUSHJ	P,PIOSET	;SET UP ACS
	HRRZ	T1,M		;GET RH OF UUO
	CAIE	T1,MT.DEC	;CHECK SPECIAL JUNK
	CAIN	T1,MT.IND	;  FOR 9-TK TAPES
	JRST	TPM9TK		;SET/CLR 4/4.5 BYTE MODE
	CAIN	T1,MT.STL	;SPECIAL LOW THRESHOLD
	JRST	TPMLOW		;  TM10 ONLY
MTAP0:
IFN FTTLAB,<
	CAIG	T1,MT.MAX	;CHECK VALID ARG
	SKIPN	P3,MTDTBL(T1)	;GET TABLE ENTRY
	JRST	UUOERR##	;ERROR IF NOT IMPLEMENTED
	PUSHJ	P,LBLCKM	;PROCESSOR RUNNING ?
	  SKIPA
	JRST	MTAP1
	PUSHJ	P,LBLSLP	;WAIT FOR LABEL PCS
	JUMPE	T1,MTAP1	;DON'T CALL LBL PLS ON NOOP
	PUSHJ	P,LBLPOS	;CHECK LBLPCS
	  POPJ	P,		;HE DID IT FOR YOU
	JRST	MTAP1		;PROCEED
> ;END IFN FTTLAB
MTAP:	CAIG	T1,MT.MAX	;CHECK VALID ARG
	SKIPN	P3,MTDTBL(T1)	;GET TABLE ENTRY
	JRST	UUOERR##	;ERROR IF NOT IMPLEMENTED
MTAP1:	HLRZ	P2,P3		;FCN INTO P2
MTAP2:	PUSHJ	P,GENIOR	;GENERATE IORB
	  JRST	TPMINF		;WHAT ELSE???
	MOVEM	T1,TDVIOR(F)	;WAIT TILL READY
IFE FTXMON,<HRRZS P3>		;STRIP OFF LH JUNK
IFN FTXMON,<
	SKIPE	P3		;HAVE A ROUTINE ADDRESS?
	XHLLI	P3,.		;INCLUDE SECTION NUMBER
> ;END IFN FTXMON
	MOVEM	P3,IRBIVA(T1)	;SAVE INT VECTOR
	PUSHJ	P,CPURQT##	;QUEUE IT UP
	MOVSI	T1,TKSOFL##	;IF KONTROLLER IS OFF-LINE,
	TDNE	T1,TKBSTS(W)
	JRST	POSOFL		;COMPLAIN TO USER AND OPER
	PUSHJ	P,KONWAT	;WAIT FOR KONTROLLER (P1 := IORB UPON RETURN)
	MOVSI	T1,TKSOFL##	;SEE IF UNIT IS OFFLINE
	TDNE	T1,TUBSTS(U)	;??
	JRST	POSOFL		;YES - INFORM WORLD
	SKIPE	T1,IRBIVA(P1)	;GET ROUTINE ADDRESS
IFE FTXMON,<JRST (T1)>		;DO SPECIAL ROUTINE
IFN FTXMON,<XJRST T1>		;DO SPECIAL ROUTINE
MTAPG1:	MOVEI	T1,1		;ONE OP ONLY
MTAPGO:	HRRM	T1,@IRBACC(P1)	;...
	XMOVEI	T1,TPMISP	;WHERE TO GO WHEN DONE
MTAPG2:	MOVEM	T1,IRBIVA(P1)	;SAVE IT
	PJRST	TPSTRT		;GO STRT OP
;ENTER HERE TO HANDLE OFFLINE DEVICE IF MTAPE UUO
;C(T1) := TKSOFL

POSOFL:	ANDCAM	T1,TUBSTS(U)	;CLEAR FLAG
	PUSHJ	P,TPMFLX	;FLUSH CURRENT REQUEST
POSOF1:	TLZ	S,IOSTBL!OFFLIN	;CLEAR THESE ALSO
	PUSHJ	P,CKTC10	;CHECK ON TC10C
	  PUSHJ	P,HNGSTP##	;INFORM ALL
	MOVSI	P2,OFLUNH	;PRESERVE THIS BIT
	AND	P2,DEVIOS(F)	;AROUND CALL TO IOSET
	PUSHJ	P,PIOSET	;RESET ACS
	IORM	P2,DEVIOS(F)	;RESTORE BIT IF ON
	HRRZ	T1,M		;GET FCN BACK IN T1
	JRST	MTAP		;CONTINUE

;DISPATCH TABLE FOR MTAPE UUO FUNCTIONS

MTDTBL:	RB.FYB,,TPMNOP		;0-WAIT
	RB.FRW,,TPMREW		;1-REWIND
	0			;2-ILLEGAL
	RB.FTM,,TPMWRT		;3-WRITE TAPE MARK
	0			;4-ILLEGAL
	0			;5-ILLEGAL
	RB.FSR,,0		;6-FORWARD SKIP RECORD
	RB.FBR,,0		;7-BACKWARD SKIP RECORD
	RB.FBR,,TPMSET		;10-SKIP TO LEOT (BACKUP FIRST)
	RB.FRU,,TPMUNL		;11-REWIND AND UNLOAD
	0			;12-ILLEGAL
	RB.FLG,,TPMWRT		;13-WRITE 3" BLANK TAPE
	0			;14-ILLEGAL
	0			;15-ILLEGAL
	RB.FSF,,TPMFSF		;16-FORWARD SKIP FILE
	RB.FBF,,TPMBSF		;17-BACKWARD SKIP FILE

;HERE TO DO AN INTERNAL MTWAT.
TPWAIT:	MOVEI	P2,RB.FYB	;YELLOW BALL FUNCTION
	PUSHJ	P,GENIOR	;SO WE KNOW WHEN IT'S OUR TURN
	  JRST	[PUSHJ	P,TSLEE1	;WAIT FOR CORE TO APPEAR
		 JRST	.-2]		;TRY AGAIN FOR THE IORB
	MOVEM	T1,TDVIOR(F)
	XMOVEI	T2,TPMNOP	;A PHONY IVA
	MOVEM	T2,IRBIVA(T1)	;DEFEND AGAINST KONWT2
	PUSHJ	P,CPURQT##	;PLACE AT END OF QUEUE
	PUSHJ	P,KONWAT	;WAIT FOR CONTROLLER
;	PJRST	TPMNOP		;UPDATE STATUS AND FLUSH THIS REQUEST

;HERE ON MTAPE 0
TPMNOP:	MOVE	S,DEVIOS(F)
	MOVSI	T1,TUSBOT##	;IS DRIVE AT BOT?
	TDNE	T1,TUBSTS(U)
	TRO	S,IOBOT		;YES
	MOVEM	S,DEVIOS(F)	;LIGHT BIT IF AT BOT
	JRST	TPMFLX		;THROW AWAY IORB AND RETURN

;HERE TO PERFORM SOME SORT OF WRITE FUNCTION

TPMWRT:	MOVEI	T1,1		;DO ONLY ONE OP
	HRRM	T1,@IRBACC(P1)	;STORE FOR DRIVER
TPMWR1:	MOVEI	T1,WRTDUN	;WHERE TO GO
	JRST	MTAPG2		;START OP

;HERE WHEN DONE (CHECK ERRORS)

WRTDUN:	PUSHJ	P,SETIOS	;SET UP S
	  JSP	P2,OUTERR	;ATTEMPT RECOVERY
	PJRST	TPMSTP		;STOP I/O AND RETURN

;INTERUPT AT END OF SPACING OP

TPMISP:	PUSHJ	P,SETIOS	;SET UP S
	  JSP	P2,SPERR	;HANDLE SPACING ERROR
	PUSHJ	P,TPMRIO	;RETURN IORB
	HLLZS	TKBSTS(W)	;CLEAR KON STATUS
TPMISX:
IFN FTTLAB,<TLZ	S,LBLNED>	;NO ADDITIONAL LABELER WORK NEEDED
	PJRST	STOIOS##	;WIND IT DOWN

;ROUTINE TO SET/CLR 4/5 BYTE 9 TRACK MODE

TPM9TK:	MOVEI	T1,TUC7TK##	;7-TRACK BIT
	TDNE	T1,TUBCNF(U)	;SEE IF ITS OK
	POPJ	P,		;FORGET IT IF 7TK
	HRRZ	T1,M		;RESTORE T1
	MOVEI	T2,RB.MCD	;SET NORMAL MODE
	CAIE	T1,MT.DEC	;DEC MODE?
	MOVEI	T2,RB.MBY	;INDUSTRY COMPATIBLE
	DPB	T2,TDYMOD	;SET IN MODE FIELD OF DDB
	POPJ	P,		;RETURN


;SET LOW THRESHOLD FOR TM10 CONTROLLERS

TPMLOW:	MOVSI	T2,D.NRLT	;NEXT REC AT LOW THRESHOLD
	IORM	T2,TDVSTS(F)	;SET IN DDB
	POPJ	P,		;RETURN
;HERE TO HANDLE UNLOAD. SETUP COUNTERS, REPORT TO DAEMON
;AND BITCH AT USER AND OPERATOR. (PS - CHECK SET WATCH MTA)

TPMUNL:
IFN FTMP,<
	SETZM	DEVNBF(F)
	SETZM	DEVSBF(F)
> ;END IFN FTMP
	AOSA	P2,TUBTUN(U)	;TOTAL UNLOADS, REMEMBER THIS IS UNLOAD
TPMREW:	SETZ	P2,		;CLEAR UNLOAD FLAG
	MOVSI	T1,TUSREW##	;SET REWINDING NOW!
	IORM	T1,TUBSTS(U)	;...
	SETZM	TUBCNI(U)	;FORGET ANY ERROR, DO THE REW/UNL
	PUSHJ	P,MTAPG1	;START OPERATION
	PUSHJ	P,TPMRLW	;WAIT TILL DISCONNECTED
	JUMPE	P2,TPMRW1	;NO MSG IF REWIND
	MOVSI	T1,DVDIR	;GET DIRECTORY DEVICE BIT
	ANDCAM	T1,DEVMOD(F)	;CLEAR IT
	PUSHJ	P,TPSTAT	;PRINT STATS
	PJRST	STOIOS##	;STORE S AND RETURN
TPMRW1:	TRO	S,IOBOT		;SET BOT
	MOVSI	T1,TKSOFL##
	TDNN	T1,TUBSTS(U)	;CHECK OFF-LINE
	PJRST	STOIOS##	;STORE S AND RETURN
	ANDCAM	T1,TUBSTS(U)	;CLEAR OFL BIT
	JRST	POSOF1		;INFORM USER
;ROUTINE TO PRINT TAPE STATISTICS AND CALL DAEMON

TPSTAT::PUSHJ	P,SAVE2##	;SAVE P1,P2
	PUSH	P,W		;SAVE US FROM SCNSER
	PUSH	P,F		;SAVE F
	PUSH	P,U		;SAVE U
	MOVE	P1,F		;HIDE DDB IN P1
	MOVE	P2,U		;HIDE UDB IN P2
	MOVE	P2,TDVUDB(F)	;GET UDB ADDRESS
	MOVE	P1,UDBDDB(P2)	;GET DDB ADDRESS
	LDB	J,PJOBN##	;GET OWNER JOB NUMBER
IFN FTTLAB,<
	CAME	J,TLPJOB##	;TAPE LABELER?
	JRST	TPSTA6		;NO
	MOVE	F,P1		;USE PRIMARY DDB
	LDB	J,PJOBN##	;GET USER JOB NUMBER
TPSTA6:
> ;END IFN FTTLAB
	MOVE	T1,TUBCRD(P2)	;CHARACTERS READ
	IOR	T1,TUBCWR(P2)	;CHARACTERS WRITTEN
	IOR	T1,TUBHRE(P2)	;HARD READ ERRORS
	IOR	T1,TUBHWE(P2)	;HARD WRITE ERRORS
	JUMPE	T1,TPSTA5	;ANYTHING TO REPORT?
	MOVSI	T1,JW.WMT	;CHECK IF HE WANTS TO SEE IT
	TDNN	T1,JBTWCH##(J)	;?

	JRST	TPSTA3		;JUST TELL OPR & DAEMON
	PUSHJ	P,TTYFND##	;SET UP F AND U
TPSTA0:	PUSHJ	P,CRLF##	;PRINT CRLF
	PUSHJ	P,PRLBK##	;LEFT BRACKET
	MOVE	T2,DEVNAM(P1)	;GET DEVICE NAME
	PUSHJ	P,PRNAME##	;RPINT IT
	PUSHJ	P,INLMES##	;PRINT A COLON
	  ASCIZ	":"
	SKIPE	T2,TUBRID(P2)	;SEE IF REEL ID
	PUSHJ	P,PRNAME##	;YES - PRINT IT
	SKIPN	TUBCRD(P2)	;READ STATS?
	SKIPE TUBHRE(P2)	;HARD READ ERRORS?
	 CAIA
	JRST	TPSTA1		;NO READ STATS-JUMP AROUND
	PUSHJ	P,INLMES##
	  ASCIZ	" Read(C/H/S) = "
	MOVE	T1,TUBCRD(P2)	;CHARS READ
	PUSHJ	P,PRTDIG##
	PUSHJ	P,PRSLSH##	;SLASH
	MOVE	T1,TUBHRE(P2)	;HARD READ ERRORS
	PUSHJ	P,PRTDIG##
	PUSHJ	P,PRSLSH##	;SLASH
	MOVE	T1,TUBSRE(P2)	;SOFT READ ERRORS
	PUSHJ	P,PRTDIG##
				;;; FALLIN TPSTA1
TPSTA1: SKIPN	TUBCWR(P2)	;ANYTHING WRITTEN?
	SKIPE	TUBHWE(P2)	;OR HARD WRITE ERRORS?
	CAIA			;YES, PRINT STATS
	JRST	TPSTA2		;NO
	PUSHJ	P,INLMES##
	  ASCIZ	" Write(C/H/S) = "
	MOVE	T1,TUBCWR(P2)	;CHARS WRITTEN
	PUSHJ	P,PRTDIG##
	PUSHJ	P,PRSLSH##	;SLASH
	MOVE	T1,TUBHWE(P2)	;HARD WRITE ERRORS
	PUSHJ	P,PRTDIG##
	PUSHJ	P,PRSLSH##	;SLASH
	MOVE	T1,TUBSWE(P2)	;SOFT WRITE ERRORS
	PUSHJ	P,PRTDIG##
TPSTA2:	PUSHJ	P,PRRBKC##	;RIGHT BRACKET
	CAMN	U,OPRLDB##	;THIS DA OPR?
	JRST	TPSTA4		;YES - DONE
TPSTA3:	MOVE	U,OPRLDB##	;NO - GET OPR LINE
	JRST	TPSTA0		;DO OVER

TPSTA4:	MOVE	U,P2		;RESTORE UDB PNTR
	MOVE	F,P1		;  AND DDB PNTR
	PUSHJ	P,TPESTS	;CREATE AN ERROR LOG ENTRY

TPSTA5:	POP	P,U
	POP	P,F
	POP	P,W		;RESTORE KDB
	MOVE	S,DEVIOS(F)	;RESTORE S
	POPJ	P,		;RETURN
;ROUTINE TO PERFORM SKIP FILE

TPMFSF:	PUSHJ	P,TAPFOL##	;FILE OPERATION LEGAL?
	  JRST	MTAPG1		;YES, DON'T DO MULTIPLE SKIP REC OPS
	MOVE	T1,P1		;COPY IORB
	MOVEI	P1,RB.FSR	;SKIP RECORD FUNCTION CODE
	DPB	P1,PRBFCN##	;CHANGE SO SIMULATION WORKS
	MOVE	P1,T1		;RESTORE IORB
	PUSHJ	P,TPSKPS	;CALL SKIP SET (RETURN WITH S SETUP)
	TRNE	S,IODEND!IODERR	;SEEN EOF OR DEVICE ERROR?
	PJRST	TPMISX		;GO CLEAR LABELER STUFF
TPMFS0:	MOVEI	T1,MT.FSF	;GO 'ROUND AGAIN
	JRST	MTAP		;...


;ROUTINE TO PERFORM BACKSPACE FILE

TPMBSF:	PUSHJ	P,TAPFOL##	;FILE OPERATION LEGAL?
	  JRST	MTAPG1		;YES, DON'T DO MULTIPLE SKIP REC OPS
	MOVE	T1,P1		;COPY IORB
	MOVEI	P1,RB.FBR	;BACKSPACE RECORD FUNCTION CODE
	DPB	P1,PRBFCN##	;CHANGE SO SIMULATION WORKS
	MOVE	P1,T1		;RESTORE IORB
	PUSHJ	P,TPSKPS	;CALL SKIP SET (RETURN WITH S SETUP)
	TRNE	S,IODEND!IOBOT!IODERR ;ERRORS?
	PJRST	TPMISX		;GO CLEAR LABELER STUFF
	MOVEI	T1,MT.BSF	;CALL BACKSPACE AGAIN
	JRST	MTAP		;SKIP SOME MORE

;ROUTINE CALLED TO SET UP MULTIPLE SKIPPING OPERATION
;RETURN S WITH STATUS OF OUTCOME

TPSKPS:	HRRZ	T1,-1(P)	;HAVE WE JUST BEEN HERE?
	CAIE	T1,TPSKPX+1	; (IF SO, WE CAME THROUGH HNGSTP)
	JRST	TPSKP0		;NO, CARRY ON
	POP	P,(P)		;YES, REMOVE LAST 2 CALLS FROM
	POP	P,(P)		; LIST SO AS NOT TO GET AN EPO
TPSKP0:	HRRZ	T1,TKBSTS(W)	;GET QUANTUM
	PUSHJ	P,MTAPGO	;START OP
TPSKPW::MOVEI	T1,MT.WAT	;WAIT OP CODE
TPSKPX:	PUSHJ	P,MTAP		;GO EXECUTE
	MOVE	S,DEVIOS(F)	;SET UP S
	POPJ	P,		;RETURN

;ROUTINE TO SKIP TO LOGICAL EOT

TPMSET:	PUSHJ	P,MTAPG1	;DO BSR FIRST
	PUSHJ	P,TPSKPW	;WAIT
TPMST1:	PUSHJ	P,TPMFS0	;FORWARD SKIP FILE
	TRNE	S,IODERR	;DEVICE ERROR
	POPJ	P,		;YES - RETURN
	MOVEI	T1,MT.FSR	;PLUS ONE RECORD
	PUSHJ	P,MTAP		;...
	PUSHJ	P,TPSKPW	;WAIT TILL DONE
	TRNE	S,IODERR	;DEVICE ERROR?
	POPJ	P,		;YES - RETURN
	TRNN	S,IODEND	;2ND EOF?
	JRST	TPMST1		;NO - TRY AGAIN
	MOVEI	T1,MT.BSR	;BACKSPACE OVER EOF
	PUSHJ	P,MTAP		;DO IT
	PJRST	TPSKPW		;QUEUE YELLOW BALL AND RETURN
	SUBTTL	DIAG UUO INTERFACE


TPMDIA::EXP	TPMPPR			;PREPROCESSOR ROUTINE
	DIAFNC	(CTC,TPDCTC,TPDCTC)	;CONTROL-C ENTRY FROM MONITOR
	DIAFNC	(ASU,TPDASU,TPDASU)	;ASSIGN SINGLE UNIT
	DIAFNC	(AAU,TPDAAU,TPDAAU)	;ASSIGN ALL UNITS
	DIAFNC	(RAU,TPDRCU,TPDRCU)	;RELEASE ALL UNITS
	DIAFNC	(SCP,TPDSCP,CPOPJ##)	;SPECIFY CHANNEL PROGRAM
	DIAFNC	(RCP,TPDRCP,CPOPJ##)	;RELEASE CHANNEL PROGRAM
	DIAFNC	(GCS,TPDGCS,CPOPJ##)	;GET CHANNEL STATUS
	DIAFNC	(AKU,TPDKUN,TPDKUN)	;GET KONTROLLER AND UNIT
	DIAFNC	(SCR,TPDSCR,CPOPJ##)	;SPECIFY CHN PGM FOR READ REV
	DIAFNC	(ELD,TPDELD,TPDELD)	;ENABLE MICROCODE LOADING
	DIAFNC	(DLD,TPDDLD,TPDDLD)	;DISABLE MICROCODE LOADING
	DIAFNC	(LOD,TPDLOD,TPDLOD)	;LOAD MICROCODE
	DIAFNC	(SDS,TPDSDS,TPDSDS)	;SET DEVICE STATUS
	DIAFNC				;TERMINATE TABLE

TPMPPR:	JRST	(P3)		;GO PROCESS DIAG. UUO
; ENABLE/DISABLE MICROCODE LOADING
TPDDLD:	TDZA	T1,T1		;DISABLE
TPDELD:	MOVEI	T1,1		;ENABLE
	MOVE	T2,KDBDSP(W)	;GET DISPATCH TABLE
	PUSHJ	P,@TPKEDL(T2)	;TOGGLE THE BIT
	  JRST	DIAANM##	;MICROCODE NOT AVAILABLE
	JRST	CPOPJ1##	;RETURN


; LOAD MICROCODE
TPDLOD:	MOVE	T2,KDBDSP(W)	;GET DISPATCH TABLE
	PUSHJ	P,@TPKLOD(T2)	;LOAD MICROCODE
	  JRST	DIAARF##	;COULDN'T
	JRST	CPOPJ1##	;RETURN
;SET DEVICE STATUS
TPDSDS:
IFN FTMP,<
	MOVE	T1,KDBCAM(W)	;FETCH CPU MASK
	PUSHJ	P,CPUOK##	;FIND A RUNNING CPU
	  JRST	DIAANR##	;CPU NOT RUNNING
	PUSHJ	P,ONCPUS##	;TRY TO GET THERE
	  JRST	DIAANR##	;CPU NOT RUNNING
> ;END IFN FTMP
	PUSHJ	P,GETWD1##	;GET NEXT ARGUMNET
	CAIL	T1,0		;RANGE
	CAILE	T1,SDSLEN	; CHECK
	JRST	DIAABA##	;BAD ARGUMENT LIST
	PUSHJ	P,SAVE3##	;SAVE SOME ACS
	MOVE	P2,T1		;SAVE SUB-FUNCTION CODE
	SETZB	P1,P3		;ASSUME DOING ONLY ONE UNIT
	JUMPGE	U,TPDSD1	;ROMP THROUGH LOOP ONLY ONCE
	MOVNI	P3,1		;REMEMBER DOING THE WHOLE KONTROLLER
	PUSHJ	P,@SDSTAB(P2)	;DO KONT STUFF BEFORE LOOPING THROUGH DRIVES
	  POPJ	P,		;PROPAGATE ERROR BACK
	MOVE	T1,KDBDSP(W)	;POINT TO DRIVER DISPATCH
	LDB	P1,[POINTR (DRVCF2(T1),DR.HDN)] ;GET HIGHEST DRIVE ON KONT
	SETZ	U,		;START WITH FIRST DRIVE

TPDSD1:	MOVE	T1,KDBIUN(W)	;DRIVE TABLE
TPDSD2:	SKIPN	T2,(T1)		;GET A UDB
	JRST	TPDSD3		;NONE THERE
	CAMN	U,UDBPDN(T2)	;FOUND THE UDB?
	JRST	TPDSD4		;YES
TPDSD3:	CAMGE	T1,KDBFUN(W)	;END OF TABLE?
	AOJA	T1,TPDSD2	;KEEP SEARCHING
	HRROS	U		;FLAG A NON-EXISTANT DRIVE

TPDSD4:	PUSHJ	P,@SDSTAB(P2)	;DISPATCH
	  POPJ	P,		;PROPAGATE ERROR BACK
	HRRZS	U		;INCASE LAST DRIVE DIDN'T EXIST
	AOS	U		;ADVANCE TO NEXT
	SOJGE	P1,TPDSD1	;LOOP FOR ANOTHER
	JRST	CPOPJ1##	;RETURN


SDSTAB:	IFIW	SDSIGN		;SET IGNORE
	IFIW	SDSCLR		;CLEAR IGNORE
	IFIW	SDSDET		;SET DETACHE
	IFIW	SDSATT		;SET ATTACHED
SDSLEN==.-SDSTAB		;LENGTH OF TABLE
;SET IGNORE
SDSIGN:	CAMN	U,[EXP -1]	;KONTROLLER?
	JRST	CPOPJ1##	;MEANINGLESS
	JUMPGE	U,CPOPJ1##	;CAN'T IGNORE AN KNOWN DRIVE
	HRRZ	T1,U		;COPY PHYSICAL DRIVE NUMBER
	MOVE	T2,[1,,KDBIUM]	;STATE,,MASK WORD OFFSET
	PUSHJ	P,AUTMSK##	;SET DRIVE IGNORED
	  JRST	DIAAIU##	;ILLEGAL UNIT
	JRST	CPOPJ1##	;RETURN


;CLEAR IGNORE
SDSCLR:	CAMN	U,[EXP -1]	;KONTROLLER?
	JRST	CPOPJ1##	;MEANINGLESS
	HRRZ	T1,U		;GET DRIVE NUMBER
	MOVEI	T2,KDBIUM	;STATE,,MASK WORD OFFSET
	PUSHJ	P,AUTMSK##	;CLEAR DRIVE IGNORED
	  JRST	DIAAIU##	;ILLEGAL UNIT
	JRST	CPOPJ1##	;RETURN


;SET DETACHED
SDSDET:	CAME	U,[EXP -1]	;DETACH KONTROLLER?
	JRST	SDSDE1		;SINGLE DRIVE
	PUSHJ	P,TPDKI0	;STOP I/O ON THIS KONTROLLER
	  POPJ	P,		;PROPAGATE FAILURE
	HRRZS	TKBJOB(W)	;OWNED BY JOB 0
	JRST	CPOPJ1##	;RETURN SUCCESS
SDSDE1:	JUMPL	U,CPOPJ1##	;CANNOT DETACH AN UNKNOWN DRIVE
	MOVE	T1,KDBIUN(W)	;DRIVE TABLE
SDSDE2:	MOVE	T2,(T1)		;GET A UDB
	CAMN	U,UDBPDN(T2)	;FOUND THE UDB?
	JRST	SDSDE3		;YES
	CAMGE	T1,KDBFUN(W)	;END OF TABLE?
	AOJA	T1,SDSDE2	;KEEP SEARCHING
	JRST	CPOPJ1##	;NOT THERE???
SDSDE3:	PUSH	P,U		;SAVE U
	MOVE	U,T2		;COPY UDB ADDRESS
	MOVE	F,UDBDDB(U)	;GET DDB ADDRESS TOO
	PUSHJ	P,DDBDET##	;DETACH SINGLE DRIVE
	  JFCL			;ALREADY ASSIGNED TO SOME JOB
	MOVE	U,UDBPDN(U)	;GET DRIVE NUMBER
	PUSHJ	P,SDSCLR	;MAKE SURE IGNORE IS CLEARED
	  JFCL			;ALWAYS SKIPS
	MOVE	U,TDVUDB(F)	;RESET UDB ADDRESS
	PUSHJ	P,TAPMPD##	;REPORT CHANGE TO [SYSTEM]MDA
	JRST	UPOPJ1##	;RESTORE U AND RETURN


;SET ATTACHED
SDSATT:	CAME	U,[EXP -1]	;ATTACH KONTROLLER?
	JRST	SDSAT1		;SINGLE DRIVE
	SYSPIF			;INTERLOCK
	MOVSI	T1,TKSNS##	;DIAG BIT
	TDNN	T1,TKBSTS(W)	;IS THIS KONTROLLER STOPPED?
	JRST	SDSATE		;NO, ERROR
	HLRZ	T1,TKBJOB(W)	;YES, BUT BY WHAT JOB?
	JUMPE	T1,SDSAT0	;ERROR IF NOT ASSIGNED TO JOB ZERO
SDSATE:	SYSPIN			;ERROR - PI BACK ON AND
	JRST	DIAAAF##	;GIVE ATTACH FAILED ERROR

SDSAT0:	HRLM	J,TKBJOB(W)	;MAKE IT LOOK NORMAL TO TPDSI0
	SYSPIN			;DONE WITH CRITICAL SECTION
	PUSHJ	P,TPDSI0	;START I/O ON THIS KONTROLLER
	  POPJ	P,		;PROPAGATE FAILURE
	JRST	CPOPJ1##	;OR SUCCESS
SDSAT1:	PUSHJ	P,AUTLOK##	;GET AUTCON INTERLOCK
	  JRST	SDSAT1		;SPIN IF AT CLOCK LEVEL
	PUSH	P,U		;SAVE U
	PUSH	P,P1		;SAVE P1
	HLLZ	P1,KDBIUN(W)	;MASSBUS UNIT
	HRRI	P1,(U)		;PHYSICAL DRIVE NUMBER
	MOVE	T1,KDBDVC(W)	;DEVICE CODE
	MOVE	T2,KDBDSP(W)	;DRIVER DISPATCH
	MOVE	T3,KDBCHN(W)	;CHANNEL DATA BLOCK
	PUSHJ	P,AUTSET##	;SET UP CPU VARIABLES
	MOVE	T1,KDBDSP(W)	;DISPATCH
	PUSHJ	P,@TPKDRV(T1)	;TRY TO CONFIGURE A DRIVE
	  TDZA	T1,T1		;FAILED
	MOVNI	T1,1		;SUCCESS
	POP	P,P1		;RESTORE P1
	POP	P,U		;RESTORE U
	PUSHJ	P,AUTULK##	;RELEASE AUTCON INTERLOCK
	JUMPN	T1,SDSAT2	;CONTINUE IF SUCCESSFUL
	SKIPGE	U		;SKIP IF DRIVE EXISTS BUT ATTACH FAILED
	JUMPL	P3,CPOPJ1##	;RETURN IF NON-EXISTANT DRIVE & ATTACHING KONT
	JRST	DIAAAF##	;ELSE TAKE ERROR RETURN
SDSAT2:	MOVEI	T1,ASSCON	;BIT TO TEST
	LDB	T2,PJOBN##	;GET DDB OWNER
	TDNE	T1,DEVMOD(F)	;ASSIGNED?
	JUMPN	T2,DIAAAF##	;ERROR IF OWNED BY NULL JOB (DETACHED)
	JRST	CPOPJ1##	;ELSE RETURN GOODNESS
;HERE TO ASSIGN SOME UNIT
TPDASU:	PUSHJ	P,TPDTST	;SEE IF WE CAN GRAB UNIT
	  POPJ	P,		;SOMEONE ELSE DOES
	MOVEM	T1,TUBCNF(U)	;UPDATE TUBCNF WITH TUCDIG BIT ON
	DPB	J,PJOBN##	;SET JOB NUMBER IN DDB
	JRST	TPDHVF

;HERE TO DETACH A TAPE KONTROLLER
;CALLED ON OWNING CPU BY RECON. UUO WITH KDB ADDRESS IN P1

TPMDET::PUSH	P,W		;SAVE PDB ADDRESS
	MOVE	W,P1		;PUT KDB ADDRESS WHERE IT BELONGS
	PUSHJ	P,TPDKI0	;STOP I/O ON THIS KONTROLLER
	  JRST	WPOPJ##		;PROPAGATE FAILURE
	HRRZS	TKBJOB(W)	;OWNED BY JOB 0
	JRST	WPOPJ1##	;RETURN SUCCESS

;HERE TO START/STOP I/O ON THE SPECIFIED KONTROLLER

TPDKIO::MOVSI	T1,JP.POK	;CHECK FOR PRIVILEGES
	PUSHJ	P,PRVBIT##	;...
	  SKIPA			;PRIVILEGED, SKIP
	JRST	DIAANP##	;ERROR
	PUSHJ	P,GETWD1##	;GET NEXT WORD (DEVICE)
	JUMPE	T1,TPDKI6	;WANTS ALL TAPE I/O
	PUSHJ	P,CHKGEN##	;GET GENERIC POINTER
	JRST	[SETZ F,	;CLEAR STALE DDB
		 JRST DIAAIU##]	;DONE
	MOVE	W,TDVUDB(F)	;POINT TO THE UDB
	MOVE	W,UDBKDB(W)	;AND TO THE PRIMARY KDB
	SETZ	F,		;**NOT AN I/O UUO***
	JUMPE	W,DIAAIU##	;?NO KDB?
;FALL INTO TPDKI0

TPDKI0:	PUSHJ	P,SAVE2##	;SAVE P1 AND P2
	SYSPIF
	HLRZ	T1,TKBJOB(W)	;GET MAINTENANCE JOB
	CAIE	T1,(J)		;IS IT ME?
	JUMPN	T1,[SYSPIN	;NO
		    JRST DIAAAJ##] ;SOMEONE ELSE ALREADY
	MOVSI	T1,TKSNS##	;DIAG BIT
	TDNE	T1,TKBSTS(W)	;IS THIS A NO-OP?
	JRST	[SYSPIN		;YES
		 JRST	CPOPJ1##] ;RETURN VACUOUSLY
	IORM	T1,TKBSTS(W)	;NO, LIGHT THE BIT
	HRLM	J,TKBJOB(W)	;IT'S US NOW
	SYSPIN
TPDKI1:	MOVSI	T1,TKSSEL	;HAS IT STOPPED YET?
	TDNN	T1,TKBSTS(W)	;?
	JRST	TPDKI2		;CHECK REWIND STATUS
	MOVEI	T1,2
	PUSHJ	P,SLEEPF##	;WAIT A BIT
	JRST	TPDKI1

TPDKI2:	MOVE	P1,KDBIUN(W)	;POINTER TO UDB TABLE
	MOVSI	P2,TUSREW##	;REWINDING BIT
TPDKI3:	SKIPE	U,(P1)		;ANY?
TPDKI4:	TDNN	P2,TUBSTS(U)	;YES, IS IT REWINDING?
	JRST	TPDKI5		;NO
	MOVEI	T1,2
	PUSHJ	P,SLEEP##	;WAIT A BIT
	JRST	TPDKI4		;CHECK AGAIN

TPDKI5:	CAMGE	P1,KDBFUN(W)	;FINAL UDB?
	AOJA	P1,TPDKI3	;LOOP FOR MORE
	JRST	CPOPJ1##	;DONE

;HERE TO STOP I/O ON ALL MAG TAPE KONTROLLERS

TPDKI6:	SKIPA	W,KDBTAB##+.TYMTA ;POINT TO FIRST KDB
TPDKI7:	MOVE	W,KDBNXT(W)	;POINT TO NEXT KDB
	JUMPE	W,CPOPJ1##	;DONE
	PUSHJ	P,TPDKI0	;SHUT DOWN THE I/O HERE
	  JRST	TPDKI9		;OOPS, UNDO WHAT WE DID
	JRST	TPDKI7		;NEXT KDB

TPDKI9:	PUSH	P,T1		;SAVE ERROR
	PUSHJ	P,TPDSIA	;CRANK IT UP AGAIN
	  JFCL
	POP	P,T1		;RESTORE ERROR
	PJRST	STOTAC##	;IN CASE SIO CLEARED IT


;HERE TO ATTACH A TAPE KONTROLLER
;CALLED ON OWNING CPU BY RECON. UUO WITH KDB ADDRESS IN P1

TPMATT::PUSH	P,W		;SAVE PDB ADDRESS
	MOVE	W,P1		;PUT KDB ADDRESS WHERE IT BELONGS
	SYSPIF			;INTERLOCK
	MOVSI	T1,TKSNS##	;DIAG BIT
	TDNN	T1,TKBSTS(W)	;IS THIS KONTROLLER STOPPED?
	JRST	[SYSPIN		;NO
		 JRST WPOPJ##]	;GIVE ERROR RETURN
	HLRZ	T1,TKBJOB(W)	;YES, BUT BY WHAT JOB?
	JUMPN	T1,[SYSPIN	;DETACH ASSIGNED IT JOB ZERO
		    JRST WPOPJ##] ;SO ATTACH ONLY TAKES IT BACK FROM THERE
	HRLM	J,TKBJOB(W)	;MAKE IT LOOK NORMAL TO TPDSI0
	SYSPIN			;DONE WITH CRITICAL SECTION
	PUSHJ	P,TPDSI0	;START I/O ON THIS KONTROLLER
	  JRST	WPOPJ##		;PROPAGATE FAILURE
	JRST	WPOPJ1##	;OR SUCCESS

;HERE TO START I/O UP AGAIN

TPDSIO::MOVE	P1,T1		;SAVE ORIGINAL ARG
	MOVSI	T1,JP.POK	;CHECK FOR PRIVILEGES
	PUSHJ	P,PRVBIT##	;...
	  SKIPA			;PRIVILEGED, SKIP
	JRST	DIAANP##	;ERROR
	PUSHJ	P,GETWD1##	;GET NEXT
	JUMPE	T1,TPDSIA	;FIX ALL OF THEM WE OWN
	PUSHJ	P,CHKGEN##	;GET DEVICE NAME
	  JRST	[SETZ F,
		 JRST DIAAIU##]	;CAN'T FIND DEVICE
	MOVE	W,TDVUDB(F)	;POINT TO THE UDB
	MOVE	W,UDBKDB(W)	;AND TO THE PRIMARY KDB
	SETZ	F,		;**DON'T OWN THIS DDB**
	JUMPE	W,DIAAIU##	;NO SUCH DEVICE

TPDSI0:	HLRZ	T1,TKBJOB(W)	;GET MAINTENACE OWNER
	CAIE	T1,(J)		;IS IT ME?
	JRST	DIAAAJ##	;OWNED BY SOMEONE ELSE
	MOVSI	T1,TKSNS##
	ANDCAM	T1,TKBSTS(W)
	HRRZS	TKBJOB(W)	;WE DON'T ANY MORE
	AOS	(P)
IFN FTMP,<
	MOVE	T1,KDBCAM(W)	;GET CPU FOR SPECIFIED KONTROLLER
	PUSHJ	P,CPUOK##	;IS IT RUNNING?
	  POPJ	P,		;NO
	PUSHJ	P,ONCPUS##	;GET US ONTO THAT CPU
	  POPJ	P,		;NOT RUNNING
> ;END IFN FTMP
	MOVE	T1,KDBDSP(W)	;CLANK SCHED TO LOOK
	PJRST	@TPKSCH(T1)

TPDSIA::SKIPA	W,KDBTAB##+.TYMTA ;POINT TO FIRST KDB
TPDSI6:	MOVE	W,KDBNXT(W)	;POINT TO NEXT KDB
	JUMPE	W,TPDSI7	;DONE
	PUSHJ	P,TPDSI0	;START I/O ON THIS ONE
	  JFCL			;DON'T OWN IT
	JRST	TPDSI6

TPDSI7:	JUMPL	M,CPOPJ		;FROM DIACLR
	AOS	(P)		;SKIP RETURN
	MOVE	T1,P1
	PJRST	STOTAC##	;RESTORE ORIGINAL ARG

;HERE TO ASSIGN ALL UNITS ON A CONTROLLER
TPDAAU:	MOVE	T3,KDBIUN(W)	;POINTER TO UDB TABLE
TPDAA1:	SKIPE	U,(T3)		;HAVE A UDB
	PUSHJ	P,TPDTST
	  JUMPN	U,CPOPJ##
	CAMGE	T3,KDBFUN(W)	;FINAL UDB?
	AOJA	T3,TPDAA1	;LOOP FOR MORE
	DDBSRL			;GET DDB INTERLOCK
	MOVE	T3,KDBIUN(W)	;POINTER TO UDB TABLE
	MOVEI	T1,TUCDIG##
	PUSH	P,[EXP 0]	;RESERVE STORAGE FOR A UDB ADDRESS
TPDAA2:	SKIPE	U,(T3)
	JRST	[IORM	T1,TUBCNF(U) ;TURN ON DIAG BIT
		 MOVE	F,UDBDDB(U)  ;GET DDB ADDRESS
		 DPB	J,PJOBN##    ;SET JOB NUMBER IN DDB
		 JRST	.+1]
	SKIPN	(P)		;FOUND THE FIRST UDB YET?
	MOVEM	U,(P)		;SAVE ADDRESS NOW
	CAMGE	T3,KDBFUN(W)	;FINAL UDB?
	AOJA	T3,TPDAA2	;LOOP FOR MORE
	DDBSRU			;RELEASE DDB INTERLOCK
	POP	P,U		;GET SAVED UDB ADDRESS BACK
TPDHVF:	SKIPE	DIATAP		;NO TAPE DIAGS?
	CAMN	J,DIATAP	;OR SAME JOB?
	JRST	TPDSCH
	PUSH	P,T1		;SAVE TUBCNF BITS OR TUCDIG BIT
	MOVEI	T1,2
	PUSHJ	P,SLEEPF##
	POP	P,T1
	JRST	TPDHVF
TPDSCH:	PUSH	P,W		;SAVE KDB
	PUSHJ	P,FNDPDS##	;FIND THE PDB
	HRROM	F,.PDDIA##(W)	;UPDATE DIAG DDB (WITH ONLY ONE OR ONE OF MANY)
	POP	P,W		;RESTORE KDB
	MOVEM	J,DIATAP	;SAVE JOB CURRENTLY DOING TAPE DIAGS
	MOVSI	T1,NSWP!NSHF
	IORM	T1,JBTSTS##(J)
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN


;PRESERVES T3
TPDTST:	MOVE	F,UDBDDB(U)
	MOVE	T1,TUBCNF(U)
	LDB	T2,PJOBN##
	CAME	T2,.CPJOB##
	JUMPN	T2,DIAAAJ##
	TRO	T1,TUCDIG##
	JRST	CPOPJ1##


;HERE ON ^C, HALT, EXIT, ETC   WITH F=DIAGING DDB
TPDCTC:	MOVE	U,TDVUDB(F)	;UDB ADDRESS
	MOVE	W,UDBKDB(U)	;KDB ADDRESS (PRIMARY)
	SOS	(P)

;HERE TO RELEASE ALL UNITS
TPDRCU:	JUMPE	F,CPOPJ1##
IFN FTKL10,<PUSHJ P,TPDRCX>	;RETURN ANY IOWD
	MOVEI	T1,TUCDIG##
	MOVE	T2,KDBIUN(W)	;POINTER TO UDB TABLE
	SETZ	T4,
	PUSH	P,U
	DDBSRL			;GET DDB INTERLOCK
TPDRC1:	SKIPE	U,(T2)
	TDNN	T1,TUBCNF(U)
	JRST	TPDRC2
	MOVE	F,UDBDDB(U)
	LDB	T3,PJOBN##
	CAME	T3,J
	JRST	TPDRC2
	ANDCAM	T1,TUBCNF(U)
	DPB	T4,PJOBN##
TPDRC2:	CAMGE	T2,KDBFUN(W)	;FINAL UDB?
	AOJA	T2,TPDRC1	;LOOP FOR MORE
	DDBSRU			;RELEASE DDB INTERLOCK
	POP	P,U
	PUSH	P,W		;SAVE KDB
	PUSHJ	P,FNDPDS##	;FIND THE PDB
	SETZM	.PDDIA##(W)	;CLEAR DIAG DDB
	POP	P,W		;RESTORE KDB
	SETZM	DIATAP
	HRRZ	T1,TUBQUE(U)
	JUMPE	T1,CPOPJ1##
	PUSHJ	P,TPMFLS	;GIVE UP IORB, START SOME OTHER TAPE
	JRST	CPOPJ1##

IFN FTKL10,<
;HERE TO SET UP A CHANNEL PROGRAM
TPDSCP:	TDZA	P4,P4		;NORMAL CHANNEL PROGRAM
TPDSCR:	MOVNI	P4,1		;READ REVERSE CHANNEL PROGRAM
	JUMPE	F,DIAAAU##	;NO ASS'D UNITS
IFN FTKL10,<PUSHJ P,TPDRCX>	;RETURN ANY IOWD
	PUSHJ	P,GETWD1##	;GET IOWD
	HLRE	T2,T1		;LENGTH OF IOWD
	JUMPE	T2,DIAACP##	;TOO BIG IF 0
	SKIPE	P4		;REVERSE?
	ADD	T1,T2		;YES. POINT TO START
	MOVE	P3,T1		;UNRELOCATED IOWD
	MOVEI	T1,1(T1)	;START ADDRESS
	MOVNS	T2		;+LENGTH
	ADDI	T2,-1(T1)	;TOP ADDRESS
	PUSHJ	P,ZRNGE##	;MAKE SURE THE PAGES ARE OK
	  JRST	DIAACP##	;SOME PAGE NOT THERE, BOMB HIM OUT
	HRRZ	T1,TUBQUE(U)
	JUMPN	T1,TPDSC0	;JUMP IF HAVE AN IORB
	MOVEI	P2,RB.FYB	;DUMMY FUNCTION
	PUSHJ	P,GENIOR	;GET AN IORB
	  JRST	DIAAFC##	;NO FREE CORE
	MOVEM	T1,TDVIOR(F)	;SAVE ADDRESS
	PUSHJ	P,SETACS	;SET UP ACS
	PUSHJ	P,TAPRQT##	;QUEUE IT UP
	HRRZ	T1,TUBQUE(U)	;GET IORB ADDRESS BACK
TPDSC0:	MOVE	T2,P3		;IOWD
	SETZ	T4,		;NOT BYTE MODE, DO ALL OF IOWD
	TRO	S,IOCON
	TLZ	S,IO
	MOVE	P1,T1
	LDB	T3,PRBMOD##
	JUMPN	T3,TPDSC1
	MOVEI	T3,RB.MCD	;CORE-DUMP IF NOT GIVEN
	DPB	T3,PRBMOD##
TPDSC1:	PUSHJ	P,MAKLST
	  JRST	DIAAFC##
	HRRZ	T3,@IRBACC(T1)
	MOVE	T1,KDBICP(W)
	MOVE	T2,KDBCHN(W)
	MOVE	T2,CHNTYP(T2)
	TLNE	T2,CP.RH2
	TLO	T3,(INSVL.(.CCJMP,CC.OPC))
	MOVEM	T3,(T1)
	PUSHJ	P,STOTAC##	;TELL USER ICWA
	JUMPE	P4,TPDSC2	;REVERSE?
	TLZN	T3,(INSVL.(.CCJMP,CC.OPC)) ;YES, RH20 - DEVICE?
	JRST	TPDSC2		;CAN'T REVERSE LIST
	HLRE	T2,P3		;REVERSE IT
	MOVNS	T2
	PUSHJ	P,REVCCW##
TPDSC2:	PUSHJ	P,CSDMP##	;SWEEP CACHE
	JRST	CPOPJ1##	;AND TAKE GOOD RETURN
> ;END IFN FTKL10
IFN FTKL10,<
;HERE TO RETURN A CHANNEL PROGRAM
TPDRCP:	JUMPE	F,CPOPJ1##
	AOS	(P)
TPDRCX:	HRRZ	T2,TUBQUE(U)
	JUMPE	T2,CPOPJ##
	HRRZ	T1,@IRBACC(T2)
	HLLZS	@IRBACC(T2)
	JUMPN	T1,RTNIOW##
	POPJ	P,
> ;END IFN FTKL10

IFN FTKL10,<
;HERE TO TELL USER FINAL CHANNEL STATISTICS
TPDGCS:	JUMPE	F,CPOPJ1##
	MOVE	P2,KDBICP(W)
	PJRST	DIAGCS##
> ;END IFN FTKL10

;ROUTINE TO GET CONTROLLER/UNIT NUMBERS
TPDKUN::MOVE	U,TDVUDB(F)	;UNIT
	MOVE	T1,UDBKDB(U)	;KDB ADDRESS (PRIMARY)
	MOVE	T2,KDBDVC(T1)	;GET DEVICE CODE
	HLRE	T1,KDBUNI(T1)	;UNIT
	SKIPGE	T1		;MULTI UNIT?
	TDZA	T1,T1		;NO, JUST USE SLAVE ADDR
	LSH	T1,3		;YES. SHIFT
	ADD	T1,UDBPDN(U)	;ADD IN PHYSICAL DRIVE NUMBER
	LSH	T2,2		;MAKE DEVICE CODE 9 BITS
	HRL	T1,T2		;DEVICE CODE TO LH,UNIT NO TO RH
	AOS	(P)		;GIVE SKIP RETURN
	PJRST	STOTAC##	;AND STORE VALUE IN USER'S AC
SUBTTL ERROR RECOVERY

;HERE ON TAPE UNIT HUNG FROM CLOCK1

TPMHNG:	PUSHJ	P,SAVE1##	;SAVE P1
	PUSHJ	P,SAVW##	;SAVE W
	MOVE	U,TDVUDB(F)	;UDB ADDRESS
	MOVE	T1,TUBAKA(U)	;GET ACTIVE KDB ADDRESS
	TLZ	T1,(1B0)	;CLEAR POSSIBLY INVALID BIT
	MOVE	T1,TKBSTS(T1)	;GET STS
	TLNE	T1,TKSNS##	;CONFIG DOING ITS THING?
	JRST	CPOPJ1##	;DON'T REALLY HANG IT THEN
	SKIPL	DEVIAD(F)	;JOB IN KONTROLLER WAIT?
	JRST	TPMHN1		;NO, DON'T HAVE TO WAKE IT
	MOVSI	T1,OFLHNG	;WOKEN FROM KONTROLLER WAIT
	ANDCAM	T1,DEVIAD(F)	; BECAUSE OF A HUNG TIME OUT
	LDB	T1,PJOBN##	;JOB NUMBER
	PUSHJ	P,EWAKE##	;GET IT STARTED
TPMHN1:	PUSHJ	P,TAPHNG##	;INFORM LOWER LEVEL
TPMDQ:	PUSHJ	P,SAVE2##	;SAVE P1,P2
	SKIPN	P1,T1		;SEE IF THERE WAS ONE
	POPJ	P,		;NO - JUST EXIT
IFN FTMP,<PUSHJ	P,TAPCPU##>	;GET ONTO OWNING CPU

TPMDQ1:	CAIN	P1,TKBERB(W)	;CHECK FOR ERROR IORB
	JRST	[MOVE P2,IRBLNK(P1) ;TRY NEXT IF IT IS
		 JRST TPMDQ2]	;CHECK DONE
	PUSHJ	P,TPMRCW	;RETURN XFER LIST IF ANY
	MOVE	T2,P1		;SET FOR GIVWDS
	MOVEI	T1,TRBLEN	;LENGTH
	MOVE	P2,IRBLNK(P1)	;GET LINK
	PUSHJ	P,GIVWDS##	;RETURN IORB
TPMDQ2:	SKIPE	P1,P2		;CHECK FOR MORE
	JRST	TPMDQ1		;YES - RETURN IT
	PJRST	TAPCTM##	;CLEAR HUNG TIMER

;HERE FROM GIVRES IN ERRCON
TPFREE::SKIPN	KDBTAB##+.TYMTA ;ANY TAPES AT ALL ON SYSTEM?
	POPJ	P,		;NO, GO AWAY
	MOVEI	F,TDVDDB	;ADDRS OF FIRST DDB
	PUSH	P,U		;SAVE U
TPFRE1:	MOVE	T1,DEVMOD(F)	;GET TYPE INFO
	TLNN	T1,DVMTA	;STILL A MTA
	JRST	TPFRE2		;DONE
	LDB	T1,PJOBN##	;YES - GET OWNING JOB
	MOVE	S,DEVIOS(F)	;AND SETUP S
	CAMN	T1,J		;BELONG TO US?
	PUSHJ	P,TPMHLD	;YES - GO SET ON HOLD
	HLRZ	F,DEVSER(F)	;LINK TO NEXT
	JUMPN	F,TPFRE1	;AND CONTINUE
TPFRE2:	MOVE	W,KDBTAB##+.TYMTA ;START AT FIRST KONTROLLER
TPFRE3:	HRRZ	T1,TKBJOB(W)	;GET GET KDB OWNER
	CAMN	T1,J		;OWNED BY US?
	PUSHJ	P,TPMCMX	;YES, RELEASE MAINT MODE
	SKIPE	W,KDBNXT(W)	;NEXT KONTROLLER
	JRST	TPFRE3		;GO TEST IT
	PJRST	UPOPJ##		;DONE IF NONE LEFT

TPMHLD::MOVE	U,TDVUDB(F)	;UDB ADDRESS
	SKIPG	W,TUBAKA(U)	;AND ACTIVE KDB ADDRESS IF SELECTED
	POPJ	P,		;THERE ISNT ONE
IFN FTTLAB,<
	SKIPN	TUBDDL(U)	;LABEL DDB ADDRESS
	JRST	TPHLD1		;OK IF NONE
	PUSH	P,F		;SAVE F
	TLZ	F,-1-MXSECN	;CLEAR POSSIBLE JUNK FROM UUOCON
	CAME	F,TUBDDL(U)	;LABEL DDB ADDRESS?
	JRST	FPOPJ##		;NO--THEN EXIT
	POP	P,F		;RESTORE F
> ;END IFN FTTLAB
TPHLD1:	TRNN	S,IOACT		;ACTIVE?
	PJRST	TAPHLD##	;NO - CALL TAPSER
	MOVSI	T1,TUSNS##	;ELSE SET NO SCHED
	IORM	T1,TUBSTS(U)	;  AND WAIT FOR I/O TO CEASE
	POPJ	P,
;ROUTINE CALLED FROM TAPSER WHEN KONTROLLER IS FOUND OFF-LINE

TPMOFL::MOVSI	T1,TKSSIL##	;BIT FOR SILENCE
	TDNN	T1,TKBSTS(W)	;WANT TO HEAR?
	SKIPGE	DEBUGF##	;  FOR ANY REASON
	POPJ	P,		;  DEBUG MODE OR SILENCED
	MOVE	T2,STATES##
	TRNE	T2,ST.NOP	;OPR IN ATTENDANCE?
	IORM	T1,TKBSTS(W)	;NO, ONLY TYPE THE MESSAGE ONCE
	PUSHJ	P,SAVE2##	;SAVE P1,P2
	MOVE	P1,U		;UDB ADDRS TO P1
	MOVE	P2,W		;KDB ADDRS TO P2
	MOVE	U,OPRLDB##	;GET OPR ADDRS TO SEND MSG
	PUSHJ	P,INLMES##	;NOW INFORM HIM
	  ASCIZ	"
%% Tape controller "
	MOVE	T2,KDBNAM(P2)	;NAME
	PUSHJ	P,PRNAME##	;PRINT IT
	PUSHJ	P,INLMES##	;REST OF MSG
	  ASCIZ	" is off-line
"
	MOVE	U,P1		;RESTORE STUFF
	MOVE	W,P2		;...
	POPJ	P,		;RETURN

;ROUTINE TO SET SILENCE IF C(T1) IS A TAPE KONTROLLER
;CALL:	MOVE T1,<KONTROLLER ID>
;	PUSHJ	P,TPMSIL
;	  RETURN HERE IF OK
;	RETURN HERE TO PROCEED
;T1 - PRESERVED

TPMSIL::PUSH	P,T1		;SAVE ARG
	PUSH	P,W		;SAVE W
	SKIPN	W,KDBTAB##+.TYMTA ;GET FIRST KDB
	JRST	TPMSLX		;NO TAPES ANYWHERE
TPMSLL:	CAMN	T1,KDBNAM(W)	;THIS ONE?
	JRST	TPMSL1		;YES - SET BIT
	SKIPE	W,KDBNXT(W)	;NO--LINK TO NEXT
	JRST	TPMSLL		;GO CHECK IT
TPMSLX:	POP	P,W		;RESTORE W
	PJRST	TPOPJ1##	;SKIP RETURN

TPMSL1:	MOVSI	T2,TKSSIL##	;BIT TO SET IN KDB
	IORM	T2,TKBSTS(W)	;...
	POP	P,W
	PJRST	TPOPJ##		;RETURN
;TAPSER INITIATION

TPMINI:	SE1ENT			;ENTER SECTION ONE
	PUSHJ	P,SAVE1##	;SAVE P1
	MOVE	T1,[TUBRID,,TDVDDB] ;REELID OFFSET,,FIRST DDB
	MOVEM	T1,CNFMTA##	;SAVE FOR DAEMON ERROR REPORTING
	MOVEI	T1,UDBDDB	;OFFSET TO DDB
	MOVEM	T1,TAPDDP##	;SAVE FOR GETTABS
IFN FTMP,<
	MOVEI	T1,[IORM T2,.CPCHX##-.CPCDB##(P1) ;STORE CACHE SWEEP BIT
		    LSH  T2,1	;POSITION FOR NEXT CPU
		    POPJ P,]	;RETURN
	MOVSI	T2,TKSCHX##	;GET CACHE SWEEP BIT
	PUSHJ	P,CPUAPP##	;STUFF INTO ALL THE CDBS
> ;END IFN FTMP
	POPJ	P,		;RETURN
;OUTPUT ERROR DETECTED - CHECK FOR WRITE LOCK

DMPERR:				;DUMP MODE ERRORS
OUTERR:	TRNE	S,IOIMPM	;WRITE LOCKED?
	JRST	(P2)		;YES - JUST RETURN

;INPUT AND SPACING ERROR
;  ALSO COMMON CODE TO OUTPUT ERRORS

SPERR:
INPERR:	MOVSI	T1,TUSREW##	;CLR REWINDING INFO
	ANDCAM	T1,TUBSTS(U)	;ON ANY ERROR
	HLRZ	T1,TRBSTS(P1)	;GET ERROR INFO
IFN FTTLAB,<
	TLNE	S,LBLNED	;NEED PROCESSING?
	JRST	ERRLBL		;YES - SCHEDULE
> ;END IFN FTTLAB
	PUSHJ	P,TPEMOV
	TRNE	T1,RB.SOL	;OFF-LINE?
	JRST	ERROFL		;YES, HANDLE IT
	TRNN	T1,RB.SER!RB.SRE ;NON-RECOV OR RECOVERED
	TRNE	S,IONRCK	;USER WANT JUST TO TRY?
	JRST	ERRX1		;JUST LOG ERROR & EXIT
	SETZM	TUBTRY(U)	;CLEAR ATTEMPT COUNTER
	MOVEI	T2,DEPDER	;ERROR RETRY DISABLED?
	TDNE	T2,DEVSTA(F)
	JRST	ERRX1		;YES, LOG AND EXIT
	PJRST	TAPERP##	; AND TRY TO RECOVER
;HERE TO HANDLE UNIT OFF-LINE (FLUSH IORB AND RETURN TO UUO LEVEL

IFN FTTLAB,<
ERRLBL:	PUSH	P,T1		;SAVE TRBSTS FOR LATER
	MOVEI	T1,LR.TM	;ASSUME TAPE MARK
	DPB	T1,TUYRQT	;PUT IN CORRECT REQUEST
	MOVE	T1,P1		;LOC OF IORB
	LDB	T1,PRBFCN##	;WHAT WE'RE DOING
	CAIE	T1,RB.FRD	;IF A READ,
	CAIN	T1,RB.FRB
	TLOA	S,LBLEOF	; TURN ON A FUNNY BIT
	JRST	[POP P,T1	; RESTORE TRBSTS
		JRST ERROF1]	; AND CLEAR IODEND SO AS NOT
	LDB	T1,PIOMOD##	;BUFFERED MODE?
	CAIL	T1,SD
	JRST	ERRLB1		;NO
	MOVSI	T2,IOEND	;YES, SAVE BIT IN BUFFER S-WORD
	PUSHJ	P,TPMXCI	; TO TELL USER WE SAW EOF
 	EXCTXU <MOVEM T2,-1(T1)>
ERRLB1:	POP	P,T1		;RESTORE TRBSTS
	TRZA	S,IODEND	; TO CONFUSE UUOCON
> ;END IFN FTTLAB
ERROFL:	TLO	S,OFFLIN	;SET OFF-LINE IN DEVIOS
	TRNN	T1,RB.SMO	;MONITOR DIRECTED OFF-LINE ?
	JRST	ERROF1		;NO -
	MOVSI	T1,(1B1)	;MDO IS UNRECOVERABLE
	IORM	T1,TUBTRY(U)	;
	PUSHJ	P,TPELOG	;LOG THE ERROR

ERROF1:	PUSHJ	P,TPMRCW	;RETURN XFER LIST IF ANY
	PUSHJ	P,TPMRIO	;RETURN IORB
	HLLZS	TKBSTS(W)	;SET QUANTA TO ZERO
	PJRST	DEVERR##	;SET ERROR AND RETURN
;HERE WHEN TAPSER EITHER GAVE UP OR RECOVERED THE ERROR

ERRX1:	TRNE	T1,RB.SRE	;RECOVERED?
	JRST	ERRX2		;YES - REPORT IF NECESSARY
	TRNN	T1,RB.SED	;ANY ERROR ?
	JRST	ERRX1A		;NO - LOOK FOR OTHER STUFF
	TRO	S,IODTER	;ASSUME DATA ERROR
	TRNN	T1,RB.SDE	;IS IT DEVICE ?
	TRC	S,IODTER!IODERR	;YES - CLEAR DATA/SET DEVICE
ERRX1A:	TRNE	T1,RB.STL	;READ ENUF ?
	TRO	S,IOBKTL	;SET BLOCK TOO LARGE
	TRNE	T1,RB.SLK!RB.SIL	;ATTEMPT TO WRITE W/O WRITE RING
	TRO	S,IOIMPM
	MOVEM	S,DEVIOS(F)	;SAVE
	TRNE	T1,RB.STL	;IS BLOCK-TOO-LONG
	JRST	ERRX4		;INCLUDING DAEMON CALL

	TLNE	S,IO		;CHECK INPUT/OUTPUT
	AOSA	TUBHWE(U)	;HARD WRITE ERROR
	AOS	TUBHRE(U)	;HARD READ ERROR
	MOVSI	T1,(1B1)	;FLAG FOR DAEMON
	IORM	T1,TUBTRY(U)	;...
	JRST	ERRX3		;GO LOG IT

;HERE ON RECOVERED ERRORS - CHECK IF LOGGING STILL ON
;ALSO DON'T LOG ERRORS THAT RECOVERED ON 1 RETRY

ERRX2:	TLNE	S,IO		;WHICH WAY
	AOSA	TUBSWE(U)	;SOFT WRITE ERROR
	AOS	TUBSRE(U)	;SOFT READ ERROR
	HRRZ	T1,TUBTRY(U)	;NO OF RETRIES
	SKIPE	[MTELOG##]	;LOG ALL ERRORS?
	SOJLE	T1,ERRX4	;NO, GO IF WE WON ON 1ST RETRY
	MOVE	T1,TUBSWE(U)	;CHECK TOTAL SOFT ERRORS
	ADD	T1,TUBSRE(U)
	CAILE	T1,MTDAEM##	;BEYOND THRESHOLD?
	JRST	ERRX4		;YES - DON'T LOG IT
ERRX3:	PUSHJ	P,TPELOG
ERRX4:	TRNE	S,IODERR
	AOS	TUBTDE(U)	;TOTAL DEVICE ERRORS
	TRNE	S,IODTER
	AOS	TUBTME(U)	;TOTAL MEDIA ERRORS
	MOVE	T1,KDBCHN(W)	;GET CDB
	MOVE	T2,CHNNUM(T1)	;GET CHANNEL ERROR BITS
	TLNN	T2,IOCHMP!IOCHNX ;WERE THERE ANY MEMORY ERRORS?
	JRST	(P2)		;NO--RETURN
	HLLZ	T3,CHNCSR(T1)	;GET CHANNEL FLAGS FOR SWEEP
	TRO	T3,UE.PEF	;ASSUME PARITY
	TLNE	T2,IOCHNX	;WAS IT A NXM?
	TRC	T3,UE.PEF!UE.NXM;YES--SET NXM
	SETZM	CHNNUM(T1)	;CLEAR CHNNUM
	IORM	T3,.CPAEF##	;SET REQUEST FOR MEMORY SCAN
	JRST	(P2)		;RETURN
SUBTTL	UTILITY ROUTINES

;ROUTINE TO RELOCATE I/O BUFFER ADDRS
;CALL:;	PUSHJ	P,TPMXCI, OR TPMXCO
;	<INSTR TO EXECUTE W/ T1 RELOCATED>
;	RETURN HERE WITH T1 ALREADY RELOCATED
;ALL ACS EXCEPT T1 ARE PRESERVED
;INSTR MUST NOT REFERENCE P1-P4

TPMXCO:	SKIPA	T1,DEVOAD(F)	;USE OUTPUT BUFFER
TPMXCI:	MOVE	T1,DEVIAD(F)	;USE INPUT BUFFER
	PUSHJ	P,SAVE2##	;SAVE P1-P2
	MOVE	P2,@-3(P)	;GET INSTR TO XCT
	MOVE	P1,DEVTYP(F)	;SEE WHAT WE HAVE
	TRNN	P1,DEPEVM	;SKIP IF NO TM10A
	MOVEI	T1,@T1		;RELOCATE KA STYLE
	CONSZ	PI,II.IPA	;SKIP IF AT UUO LEVEL
	JRST	[PUSHJ P,SVEUF##;ELSE - SET UP UBR
		 PUSHJ P,SPCS##	;AND PCS
		 JRST .+1]	;AND CONTINUE
	SKIPE	DEVEVM(F)	;EVM IN USE?
	TLZ	P2,(<17B12>)	;CLEAR AC FIELD
IFN FTMP,<PUSH	P,T1>		;SAVE ADDRESS
	XCT	P2		;CLANK INSTR
IFE FTMP,<JRST	CPOPJ1##>	;RETURN & SKIP OVER INSTR
IFN FTMP,<
	EXCH	T1,(P)		;SAVE T1, GET ADDR
	PUSHJ	P,OUCHE##	;SWEEP THAT LOC OUT OF CACHE
	JRST	TPOPJ1##	;SKIP XCT'D INSTR AND RETURN
> ;END IFN FTMP

;ROUTINE TO GENERATE A PENDING IORB
;CALL:	MOVE	P2,FUNCTION
;	PUSHJ	P,GENIOR
;	  ...  ERROR IF NO FREE SPACE
;	RETURN HERE  T1 := IORB

GENIOR:	MOVEI	T2,TRBLEN	;WORDS NEEDED FOR AN IORB
	PUSHJ	P,GETWDS##	;ALLOCATE CORE
	  POPJ	P,		;SIGH
	MOVSI	T2,0(T1)	;START ADDRESS
	HRRI	T2,1(T1)	;MAKE A BLT POINTER
	SETZM	(T1)		;CLEAR FIRST WORD
	BLT	T2,TRBLEN-1(T1)	;CLEAR IORB
	MOVEI	T2,RB.RPN	;REQUEST PENDING
	ROT	T2,-RB.RQP-1	;PUT IN PROPER PLACE
	MOVEM	T2,TRBFNC(T1)	;STASH
GNIOR1:	DPB	P2,PRBFCN##	;AND FUNCTION
	LDB	T2,TDYBYT	;GET MODE/PAR/DEN
	TRZ	T2,TDMDBY	;CLEAR ACTUAL DENSITY
	PUSH	P,T1		;SAVE IORB ADDRESS
	PUSH	P,T2		;AND P/D/M CUZ GETDEN TRASHES THEM
	XMOVEI	T2,IRBCCW(T1)	;***POINT TO BASE OF CCW TABLE
	MOVEM	T2,IRBACC(T1)	;***SET AS CURRENT
	PUSHJ	P,GETDEN	;GET THE DENSITY WE SHOULD USE
	LSH	T1,RB.MDS	;POSITION DENSITY AFTER MODE
	IORM	T1,(P)		;SAVE IT IN "BYT"
	POP	P,T2		;GET "BYT" BACK
	POP	P,T1		;AND THE ADDRESS
	DPB	T2,PRBBYT##	;SET INTO IORB
	SETZM	TRBSTS(T1)	;CLEAR REST OF BLOCK
	SETZM	TRBRCT(T1)
	SETZM	IRBIVA(T1)	;...
	JRST	CPOPJ1##	;GIVE GOOD RETURN
;ROUTINE TO SET UP CURRENT IORB

STOIOR:	ROT	T2,-RB.RQP-1	;POSITION STATUS
	HLLM	T2,TRBFNC(T1)	;STORE IN LHS
	JRST	GNIOR1		;CONTINUE SETUP
;ROUTINE TO WAIT FOR TAPE KONTROLLER

KONWAT:	MOVSI	T1,TKSOFL##	;IF UNIT IS OFF-LINE
	TDNN	T1,TUBSTS(U)	; DON'T CALL MSLEEP
	PUSHJ	P,CKREW		;CHECK FOR REWINDING
	JRST	KONWTN		;NOW SEE IF SELECTED
KONWT1:	PUSHJ	P,TAPCNT##	;MAKE SURE SCHED IS LISTENING
	MOVEI	T1,EV.TKW	;WAIT FOR TAPE KONTROLLER
	PUSHJ	P,KSLEEP	;WAIT FOR EVENT
				;RETURN WHEN READY
KONWTN:	MOVSI	T1,TKSSEL##	;SEE IF WE GOT ONE
	TDNN	T1,TUBSTS(U)	;??
	JRST	KONWT1		;NOPE - TRY AGAIN
	HRRZ	P1,TUBQUE(U)	;SET P1 TO POINT TO IORB
	MOVE	W,TUBAKA(U)	;SET UP WITH ACTIVE KDB ADDRESS
	TLZ	W,(1B0)		;CLEAR POSSIBLY INVALID BIT
	CAME	P1,TDVIOR(F)	;THIS THE RIGHT ONE?
	JRST	KONWT2		;NO - SNOOZE SOME MORE
	SETZM	TDVIOR(F)	;CLEAR THIS ONE NOW
IFN FTMP,<PUSHJ P,TAPCPU##>	;MAKE SURE WE'RE ON CPU WITH A VALID KDB
	POPJ	P,		;RETURN
KONWT2:	CAIE	P1,TKBERB(W)	;IS IT THE ERP IORB (NEVER HAS IVA)
	SKIPE	IRBIVA(P1)	;IS THIS A "REAL" IORB?
	JRST	KONWT1		;YES, REST ASSURED THAT SOMETHING WILL HAPPEN
	PUSHJ	P,TAPREM##	;NO, ITS AN IORB WHICH WILL NEVER BE USED
	JRST	KONWTN		; SO FLUSH IT AND TRY THE NEXT IORB

;ROUTINE TO WAIT FOR DRIVE TO FINISH REWINDING

CKREW:	MOVSI	T2,TUSREW##	;CHECK FOR REWIND
	TDNN	T2,TUBSTS(U)	;...
	POPJ	P,		;NOPE - RETURN
	PUSH	P,TDVIOR(F)	;SAVE IORB PNTR

CKREW1:	MOVEI	T1,TUCIRD##	;SEE IF THIS UNIT
	TDNE	T1,TUBCNF(U)	;  WILL GIVE US AN INTERUPT
	JRST	CKREW2		;WHEN IT FINISHES REWINDING
	MOVSI	T1,TKSSTD##	;NO - UNIT ALREADY ACTIVE?
	TDNE	T1,TUBSTS(U)	;...
	JRST	CKREW2		;YES - HAVEN'T STARTED REWINDING YET
	MOVEI	P2,RB.FYB	;QUE UP WAIT REQUEST
	PUSHJ	P,GENIOR	;GEN IORB
	  JRST	CKREW2		;WAIT AND TRY AGAIN
	MOVEM	T1,TDVIOR(F)	;STASH AWAY
	XMOVEI	T2,CKREWD	;GO HERE ON INTERUPT
	MOVEM	T2,IRBIVA(T1)	;...
	PUSHJ	P,CPURQH##	;PUT AT HEAD OF Q
	PUSHJ	P,KONWTN	;WAIT FOR SELECTION
				;RETURN P1 := IORB
	PUSHJ	P,TPSTRT	;GO START I/O?
	MOVEI	T1,EV.REW	;WAIT FOR REWIND STATUS
	PUSHJ	P,MSLEEP	;...
				;FALL INTO CKREW2
				;PREVIOUS PAGE FALLS INTO THIS
CKREW2:	MOVSI	T2,TUSREW##	;SEE IF STILL REWINDING
	TDNN	T2,TUBSTS(U)	;...
	JRST	NOREW		;NO MORE

;AVOID STACK OVERFLOWS BY INSURING THAT IF TAPCNT ENDS UP CALLING THRU
;AND BACK TO CKREW WE WILL BE ON THE CORRECT CPU NEXT TIME.
IFN FTMP,<PUSHJ	P,TAPCPU##>	;MAKE SURE WE STAY ON THE RIGHT CPU
	PUSHJ	P,TAPHLD##	;DON'T USE US WHILE SLEEPING
	MOVEI	T1,2		;SLEEP 2 SEC
	PUSHJ	P,TSLEEP	;ZZZZ
	PUSHJ	P,TAPCNT##	;OK - START LOOKING AGAIN
	JRST	CKREW1		;CHECK SOME MORE
;HERE WHEN NOT REWINDING

NOREW:	POP	P,TDVIOR(F)	;RESTORE WORLD
	POPJ	P,		;RETURN

;HERE ON STATUS INTERUPT

CKREWD:	MOVE	T1,J		;JOB #
	PUSHJ	P,EWAKE##	;WAKE IT
	MOVE	S,DEVIOS(F)	;SET UP S
	PJRST	TPMSTP		;SHUT DOWN CTL

;ROUTINE TO SET UP INTERESTING ACS
;SET UP - U,J

SETACS:	MOVE	U,TDVUDB(F)	;UDB ADDRESS
;IFN FTTLAB,<
;	MOVSI	J,TKSSEL	;IF UNIT IS ALREADY GOING...
;	TDNN	J,TUBSTS(U)	;...DON'T CHANGE TUBCUR
;>;END IFN FTTLAB
;	MOVEM	F,TUBCUR(U)	;LINK UDB TO CURRENT DDB
	LDB	J,PJOBN##	;GET JOB OWNING DDB
	POPJ	P,		;AND RETURN

;SPECIAL ROUTINE USED BY NON-IO REQUESTS

PIOSET:	PUSHJ	P,SETACS	;SET UP ACS
	MOVE	S,DEVIOS(F)
	JUMPE	J,CPOPJ##	;EXIT NOW IF NOBODY THERE
	JRST	IOSET0		;CONTINUE OPERATION
;ROUTINE TO SLEEP,RESTORE S
TSLEE1::MOVEI	T1,1		;SLEEP 1 SEC
TSLEEP:	MOVE	J,.CPJOB##	;SET UP J FOR SLEEP
IFN FTPSCD,<
	AOS	%MTASL##	;COUNT MTA GENERATED SLEEP
>;END IFN FTPSCD
TSLEE2:	PUSHJ	P,SLEEPF##	;SLEEP ZEROES F
	MOVE	S,DEVIOS(F)	;NEW UNIT STATE
	POPJ	P,
;SETUP ROUTINES FOR INPUT AND OUTPUT

INSET:	TLZA	S,IO

OUTSET:	TLO	S,IO
IOSET:	PUSHJ	P,SETACS	;GET GOOD THINGS
	JUMPE	J,CPOPJ##	;RETURN IF NO OWNER
IFN FTTLAB,<
	PUSHJ	P,LBLSLP	;WAIT FOR LABEL PROCESS TO FINISH
	PUSHJ	P,LBLCKS	;DETERMINE IF PROCESSING NEEDED
	  JFCL			;IGNORE THIS RETURN
> ;END IFN FTTLAB
	PUSHJ	P,TAPACC##	;TRY TO FIND AN ONLINE KONTROLLER
	  JFCL			;...
	MOVSI	T1,TKSOFL##	;IF KONTROLLER ISN'T OK
	TLZE	S,OFFLIN	;OFFLINE IN DEVIOS?
	TDNN	T1,TUBSTS(U)	;OFFLINE IN TUBSTS?
	TDNE	T1,TKBSTS(W)	;NO. KONT. OFFLINE?
	JRST	SETOFL		;YES. INDICATE IT
IFN FTTLAB,<
	MOVEI	T1,FINP!LBLNED	;ASSUME INPUT
	TLNE	S,IO		;IS IT?
	MOVEI	T1,FOUT!LBLNED	;NO, CHECK OUTPUT
	TLNE	S,(T1)		;PROCESSING NEEDED?
	JRST	SETLBL		;YES, INVOKE LBL PCS
> ;END IFN FTTLAB
IOSET0:	TLZ	S,OFLUNH	;CLR THIS
	PUSHJ	P,GTMODE	;GET THE RIGHT MODE
	CAILE	T1,RB.M7T	;"REAL" MODE?
	MOVEI	T1,RB.MBY	;NO, INDUSTRY COMPAT. SET UP FOR CORE-DUMP
	DPB	T1,TDYMOD	;PUT IT BACK

	CAIE	T1,RB.M7T	;SEE IF 7 TRACK
	JRST	IOSET2		;NO - DON'T PLAY WITH PARITY
	MOVSI	T1,D.EPAR	;GET BIT
	ANDCAM	T1,TDVSTS(F)
	TRNE	S,IOPAR		;WANT EVEN OR ODD PARITY?
	IORM	T1,TDVSTS(F)
IOSET2:	PJRST	STOIOS##	;STORE S AND RETURN

;ROUTINE TO GET THE RIGHT MODE FOR A TAPE
;RETURNS T1=MODE
GTMODE:	LDB	T1,TDYMOD	;SEE IF WE HAVE A MODE
	JUMPN	T1,CPOPJ##	;JUMP IF MODE SET
	LDB	T1,TDYMD1	;NONE FROM TAPE. SET FORMAT BEEN ISSUED?
	JUMPN	T1,CPOPJ##	;GO IF IT HAS
	MOVEI	T1,RB.MCD	;DEFAULT TO 4.5 BYTE MODE
	LDB	T2,PIOMOD##	;GET MODE
	CAIN	T2,BYTMOD	;BYTE MODE?
	MOVEI	T1,RB.MBY	;YES
	MOVEI	T2,TUC7TK##	;UNLESS 7 TRACK
	TDNE	T2,TUBCNF(U)	;??
	MOVEI	T1,RB.M7T	;THEN USE 7-TRACK MODE
	POPJ	P,
;HANDLE OFF LINE MESSAGES AND CLEAR ERRORS FOR RE-TRY
;ALSO CHECK FOR TC10C SPECIAL ACTION

SETOFL:	PUSHJ	P,CKTC10	;TC10C CROCK!!!
	  PUSHJ	P,HNGSTP##	;OUTPUT MESSAGE
	PJRST	IOSET		;RESET ACS AND RETURN

;TC10C CONTROLLER SPECIAL ACTION FOR OFF-LINE AT BOT

CKTC10:	LDB	T1,TUYKTP##	;GET KONTROLLER TYPE
	CAIN	T1,K.TC1	;IS IT ONE OF THOSE?
	TLCE	S,OFLUNH	;BEEN HERE BEFORE?
	JRST	STOIOS##	;YES, SAY OFF-LINE
	MOVEM	S,DEVIOS(F)	;REMEMBER FIRST TRY
	PUSHJ	P,TSLEE1	;SLEEP FOR 1 SEC
	JRST	CPOPJ1##	;TRY AGAIN - IT MIGHT BE BACK

IFN FTTLAB,<
;ROUTINE TO CHECK TAPE LABEL STATUS AND FIRST OPERATION
;SKIP RETURN IF NO PROCESSING TO BE DONE

LBLCHK:	TLZE	S,IOBEG		;CHECK FOR FIRST I/O
	TLO	S,FSTOP		;AND SET THIS ONE
LBLCKM: PUSH	P,T1		;SAVE T1
	PUSH	P,F		;SAVE F
	TLZ	F,-1-MXSECN	;CLEAR POSSIBLE JUNK
	CAME	F,TUBDDL(U)	;LABEL DDB OURS?
	SKIPN	%SITLP##	;AND IS THE LABELER ALIVE?
	JRST	LBLCK2		;NO PROCESSING
	LDB	T1,TUYLTP	;GET LABEL TYPE
	JUMPE	T1,LBLCK2	;IF NO LABELS, CLEAR SOME FLAGS
	TDZ	S,[IOSTBL!LBLEOF!LBLSTP,,IODEND] ;DON'T LET SEE EOF OR TROUBLE
	PUSHJ	P,STOIOS##	;STORE S
	POP	P,F		;RESTORE F
	JRST	TPOPJ##		;RESTORE T1
LBLCK2:	TLZ	S,LBLNED!FSTOP	;ELSE CLEAR THESE FLAGS
	MOVEM	S,DEVIOS(F)	;...
	POP	P,F		;RESTORE F
	JRST	TPOPJ1##	;SKIP RETURN
> ;END IFN FTTLAB
IFN FTTLAB,<
;ROUTINE TO INVOKE LABELING PROCESS AND SUSPEND JOB

LBLMSG:	PUSHJ	P,SAVE3##	;SAVE P1-P3
	MOVEI	T1,MT.WAT	;GET CODE FOR WAIT
	PUSHJ	P,MTAP		;WAIT FOR THINGS TO DIE DOWN
	PUSHJ	P,TAPHLD##	;SUSPEND UNIT FOR NOW
	TLZ	S,LBLNED	;CLEAR THIS NOW
	TLO	S,LBLWAT	;WE ARE NOW WAITING FOR COMPLETION
	MOVEM	S,DEVIOS(F)
	PUSH	P,W		;SAVE W
	PUSHJ	P,LBLSND	;INFORM LBL PCS
	POP	P,W		;RESTORE W
	SETZ	T1,		;CLEAR
	DPB	T1,TUYINF	;MSG INFO
	DPB	T1,TUYRQT	;AND REQUEST TYPE
	PUSHJ	P,LBLSLP	;WAIT FOR LABEL PROCESS
	LDB	T1,PDVESE##	;GET TERMINATION CODE
	SKIPGE	LBLETB(T1)	;LEGAL TO SET?
	POPJ	P,		;NO
	TDO	S,LBLETB(T1)	;GET ERROR BITS FROM TABLE
	PJRST	STOIOS##	;STORE S AND RETURN


;ROUTINE TO SEND ABORT MSG
LBLABO::MOVEI	T1,LR.ABO	;GET ABORT CODE
	DPB	T1,TUYRQT	;SET REQUEST TYPE
	PJRST	LBLSND		;SEN MESSAGE OFF

;ROUTINE TO SEND IPCF MSG TO LBL PROCESS

LBLSND:	MOVE	T1,DEVNAM(F)	;YES - BUILD MSG
	MOVEM	T1,TUBPHY(U)	;STORE DEVICE NAME
	LDB	J,PJOBN##	;RESET J INCASE IT HAS CHANGED
	DPB	J,TUYJBN	;STORE JOB #
	MOVE	T1,[TLMSIZ,,.IPCTL##] ;LENGTH,,MESSAGE TYPE
	MOVEM	T1,TUBMSG(U)	;STORE

IFE FTXMON,<MOVEI T2,TUBMSG(U)> ;ADDRESS OF MESSAGE
IFN FTXMON,<
LBLSN1:	MOVEI	T2,TLMSIZ	;LENGTH OF MESSAGE
	PUSHJ	P,GETWDS##	;GET CORE
	  SKIPA			;NONE AVAILABLE
	JRST	LBLSN2		;ONWARD
	PUSHJ	P,TSLEE1	;ZZZZZZ
	JRST	LBLSL1		;TRY AGAIN
LBLSN2:	PUSH	P,T1		;SAVE ADDRESS
	MOVEI	T1,TLMSIZ	;LENGTH IN WORDS
	XMOVEI	T2,TUBMSG(U)	;STATIC STORAGE
	MOVE	T3,(P)		;IPCF MESSAGE
	EXTEND	T1,[XBLT]	;COPY
	MOVE	T2,(P)		;ADDRESS OF MESSAGE
> ;END IFN FTXMON

	MOVEI	T1,%SITLP##	;PID
	HLL	T2,TUBMSG(U)	;MESSAGE MSGE
	PUSHJ	P,SENDSI##	;TRANSMIT MESSAGE
	  JFCL			;IGNORE ERRORS
IFN FTXMON,<
	MOVEI	T1,TLMSIZ	;MESSAGE LENGTH
	POP	P,T2		;MESSAGE ADDRESS
	PUSHJ	P,GIVWDS##	;RELEASE CORE
> ;END IFN FTXMON
	POPJ	P,		;RETURN

;ROUTINE TO FIX UP S AS IF LABEL PROCESSING HAPPENED
LBLCKS:	PUSHJ	P,LBLCHK	;FIRST CALL LABEL CHECK
	  POPJ	P,		;NEED LABELLING, DO NOTHING
	TLZN	S,LBLEOF	;HERE FOR EOF?
	JRST	CPOPJ1##	;NO, JUST RETURN
	TLZ	S,IOSTBL	;CLEAR TROUBLE
	TDO	S,[LBLSTP,,IODEND]	;STOP ON LBL ERR
	MOVEM	S,DEVIOS(F)	;STORE STATUS
	JRST	CPOPJ1##	;RETURN

;ROUTINE TO WAIT FOR LABEL PROCESS TO FINISH
LBLSLP:	PUSH	P,T1		;SAVE T1
LBLSL1:	TLNN	S,LBLWAT	;STILL WAITING?
	JRST	TPOPJ##		;NO, RETURN
	MOVEI	T1,EV.LBL	;EW CODE FOR LABELS
	PUSHJ	P,MSLEEP	;GO AWAY
	JRST	LBLSL1		;CHECK IF REALLY DONE

		;;; STILL IN FTTLAB CONDITIONAL

;ENTER HERE FROM IOSET IF LABEL PROCESSING NEEDED
SETLBL:	TLNN	S,FSTOP		;FIRST OPERATION?
	JRST	STLBL1		;NO - PROCEED
	MOVEI	T1,LR.FIN	;ASSUME FIRST INPUT
	TLNE	S,IO		;IS IT REALLY?
	SKIPA	T1,[LR.FOU]	;NO, FIRST OUTPUT THEN
	TLZA	S,FINP		;CLEAR FIRST INPUT
	TLZ	S,FOUT		;CLEAR FIRST OUTPUT
	DPB	T1,TUYRQT	;SET REQUEST TYPE
	MOVEM	S,DEVIOS(F)
STLBL1:	PUSHJ	P,LBLMSG	;INFORM LBL PCS
	TLNN	S,LBLSTP	;LABELING ERROR?
	JRST	IOSET		;NO--PROCEED
	POPJ	P,		;ELSE RETURN UP A LEVEL

;ROUTINE TO CHECK FOR LABEL PCS HNDLING POSITION REQUESTS

LBLPOS:	MOVE	U,TDVUDB(F)	;SET UP U
	DPB	T1,TUYINF	;SET UP MTAPE CODE
	MOVE	S,DEVIOS(F)	;SET UP STATUS
	PUSHJ	P,LBLCKM	;NEED LABELING?
	  SKIPA	T1,[LR.POS]	;YES - SET POSITION REQ.
	JRST	CPOPJ1##	;NO - PROCEED
	DPB	T1,TUYRQT	;SET REQUEST TYPE
	PUSHJ	P,LBLMSG	;XMIT MSG
	TLZ	S,LBLSTP	;NEVER NEED THIS BIT ON POSITIONING
	LDB	T1,PDVESE##	;GET TERMINATION CODE
	CAIN	T1,LE.CON	;DID HE DO ANYTHING?
	AOS	(P)		;NO - SKIP RETURN
	PJRST	STOIOS##	;STORE S AND RETURN

; TABLE TO TRANSLATE LABEL TERM CODE INTO BITS IN IOS
; THE CODE DEPENDS ON THE SIGN BIT **NEVER** BEING USED

LBLETB:	-1			;0 - ILLEGAL
	0			;1 - CONTINUE POSITIONING
	LBLSTP!FSTOP!IOEND,,IODEND ;2 - RETURN EOF + CALL LABEL PCS ON NEXT I/O
	FSTOP!LBLSTP,,IOERRS	;3 - LABEL TYPE ERROR
	FSTOP!LBLSTP,,IOERRS	;4 - HEADER LABEL ERROR
	FSTOP!LBLSTP,,IOERRS	;5 - TRAILER LABER ERROR
	FSTOP!LBLSTP,,IOERRS	;6 - VOLUME LABEL ERROR
	FSTOP!LBLSTP,,IODERR	;7 - DEVICE ERROR
	FSTOP!LBLSTP,,IODTER	;10 - DATA ERROR
	FSTOP!LBLSTP,,IOERRS	;11 - WRITE LOCKED
	FSTOP!LBLSTP,,IOERRS	;12 - POSITIONING ERROR
	FSTOP,,IOBOT		;13 - BEGINNING OF TAPE
	FSTOP!LBLSTP,,IOERRS	;14 - ILLEGAL OPERATION
	FSTOP!LBLSTP,,IOERRS	;15 - FILE NOT FOUND
	FSTOP!LBLSTP,,IOERRS	;16 - OPR CANCELED VOLUME SWITCH
	FSTOP!LBLSTP,,IOERRS	;17 - TOO MANY VOLUMES IN VOLUME SET
	-1			;20 - ILLEGAL FOR MAGTAPES
	-1			;21 - ILLEGAL FOR MAGTAPES
	-1			;22 - ILLEGAL FOR MAGTAPES
	FSTOP!LBLSTP,,IOERRS	;23 - LABELER REQUEST ABORTED BY RESET UUO
	FSTOP!LBLSTP,,IOERRS	;24 - VOLUME PROTECTION FAILURE
	FSTOP!LBLSTP,,IOERRS	;25 - FILE PROTECTION FAILURE
	FSTOP!LBLSTP,,IOERRS	;26 - UNEXPIRED FILE
	-1			;27 - ILLEGAL FOR MAGTAPES

IFN <IOMAX%-<.-LBLETB-1>>,<PRINTX ? LABEL ERROR TRANSLATION TABLE SKEW>

> ;END IFN FTTLAB
;ROUTINE TO GET CURRENT DENSITY SETTING
;RETURN DENSITY ARG IN T1

GETDEN:	LDB	T1,PDENS	;SEE IF CHANGED BY SETSTS
	JUMPN	T1,CPOPJ##	;IF YES - USE IT
	LDB	T1,TDYDN1	;SEE IF CHANGED BY SET DENSITY
	JUMPN	T1,CPOPJ##	;IF YES, TRY IT
	LDB	T1,TDYDEN	;NOT CHANGED, CHECK FOR ACTUAL
	JUMPN	T1,CPOPJ##	;IE WAS, USE IT
GETDN1:	MOVEI	T1,STDENS##	;ELSE USE STANDARD
	MOVE	T2,TUBCNF(U)	;PICK UP CONFIGURATION WORD
	PUSH	P,T1		;SAVE THE DENSITY FOR A MOMENT
GETDN2:	TDNE	T2,DENBIT(T1)	;THIS DENSITY OK?
	  JRST	GETDN4		;YES
	SOJG	T1,GETDN2	;NO, TRY A LOWER ONE
	MOVE	T1,(P)		;NO LOWER ONES ARE ANY GOOD, TRY HIGHER ONES
GETDN3:	TDNN	T2,DENBIT(T1)	;THIS DENSITY OK?
	AOJA	T1,GETDN3	;NO, TRY A HIGHER ONE
GETDN4:	POP	P,(P)		;GET RID OF ORIGINAL DENSITY
	DPB	T1,TDYDN1	;SAVE DEFAULT DENSITY
	POPJ	P,		;AND RETURN

DENBIT=.-1			;SAVE A WORD
	TUCD20##
	TUCD55##
	TUCD80##
	TUCD16##
	TUCD62##

;ROUTINE CALLED TO SWEEP CACHE UNLESS DEVICE IS A TM10A
;DESTROYS T1
TPMSWP:	MOVEI	T1,DEPEVM	;DOES THIS DEVICE NEED
	TDNN	T1,DEVTYP(F)	; EVM (TM10A IF SO)
	POPJ	P,		;YES, DONT SWEEP
IFN FTKL10,<
	PUSHJ	P,SAVE3##	;SAVE SOME ACS
	MOVSI	P1,-MXPORT	;AOBJN POINTER
	XMOVEI	P2,UDBKDB(U)	;POINT TO START OF KONTROLLER TABLE
	SETZ	P3,		;CLEAR A COUNTER

TPMSW1:	SKIPN	T1,(P2)		;GET A KDB ADDRESS
	JRST	TPMSW2		;NONE THERE
	AOS	P3		;COUNT THE KDB
	MOVE	T1,KDBCHN(T1)	;GET CHANNEL DATA BLOCK ADDRESS
	MOVE	T1,CHNTYP(T1)	;AND ASSOCIATED CHANNEL BITS
	TLNN	T1,CP.RH2	;EXTERNAL CHANNEL?
	JRST	TPMSW3		;YES, MUST SWEEP

TPMSW2:	AOS	P2		;ADVANCE TABLE POINTER
	AOBJN	P1,TPMSW1	;LOOP FOR ALL KDBS
	SOJLE	P3,CPOPJ##	;NO CACHE SWEEP IF ONLY ONE PATH
> ;END IFN FTKL10

TPMSW3:	PUSHJ	P,CSDMP##	;WE MUST SWEEP THE CACHE
IFN FTMP,<MOVMS	.CPTAP##>	;TELL ONCE-A-TICK IT DOESNT HAVE TO SWEEP
	POPJ	P,		;RETURN


;ROUTINE TO DO UUO-LEVEL DRIVE ACCESSIBILITY CHECKING
TPMACC::PUSH	P,T1		;SAVE T1
IFN FTMP,<
	LDB	T1,DEYPCL##	;CHECK FOR QUEUED PROTOCOL
	SKIPN	T1		;IF NOT ENABLED,
	PUSHJ	P,TAPCPU##	;GET ON THE RIGHT CPU NOW
> ;END IFN FTMP

TPMAC1:	PUSHJ	P,TAPACC##	;FIND CPU-KDB-UDB PATH
	  TDZA	T1,T1		;CAN'T GET TO DRIVE??
IFE FTMP,<JRST	TPMAC3>		;GO SET ACTIVE KDB
IFN FTMP,<
	MOVE	T1,KDBCAM(W)	;GET ACCESSIBILITY MASK FOR KONTROLLER
	TDNE	T1,.CPBIT##	;ON OUR CPU?
	JRST	TPMAC2		;YES
	MOVSI	T1,TUSREW##	;BIT TO TEST
	TDNN	T1,TUBSTS(U)	;WAITING FOR REWIND COMPLETION?
	JRST	TPOPJ##		;NO, INITIATE QUEUED PROTOCOL I/O
> ;END IFN FTMP
	PUSHJ	P,CKREW		;WAIT FOR REWIND TO FINISH
	JRST	TPMAC1		;CHECK AGAIN
IFN FTMP,<
TPMAC2:	MOVE	T1,.CPCPN##	;GET OUR CPU NUMBER
	PUSHJ	P,ONCPUN##	;MAKE SURE WE STAY THERE
> ;END IFN FTMP

TPMAC3:	MOVEM	W,TUBAKA(U)	;SET ACTIVE KDB
	JRST	TPOPJ1##	;RETURN AND START I/O
;SETUP S AND TRANSLATE ERROR BITS FOUND IN IORB
;NON-SKIP RETURN IF ERROR ENCOUNTERED
;SKIP RETURN IF ALL OK - MAYBE EXCEPTION

SETIOS:	MOVE	S,DEVIOS(F)	;GET STATUS
	HLRZ	T1,TRBSTS(P1)	;GET IORB STATUS
IFN FTTLAB,< TDZ S,[LBLNED!FSTOP!IOEND!IOSTBL!LBLEOF!LBLSTP,,IOBOT!IOTEND!IODEND]>
IFE FTTLAB,< TDZ S,[IOEND!IOSTBL,,IOBOT!IOTEND!IODEND]>
				;CLEAR ALL RELATED BITS
	SKIPL	TRBFNC(P1)	;ANY EXCEPTIONS?
	JRST	SETIOX		;NO - JUST STORE AND EXIT
	TRNE	T1,RB.SOL	;CHECK OFF-LINE
	PJRST	STOIOS##	;STORE S AND RETURN
	TRNE	T1,RB.STM	;TAPE MARK SEEN
IFN FTTLAB,< TDO S,[LBLNED,,IODEND]> ;YES - SAY EOF
IFE FTTLAB,< TRO S,IODEND>	;YES - SET EOF
	TRNE	T1,RB.SBT	;BOT SEEN
	TRO	S,IOBOT		;MARK IT
	TRNE	T1,RB.SET	;TAPE INDICATE
	TRO	S,IOTEND	;SET EOT
IFN FTTLAB,<
	LDB	T2,PDVESE##	;ANY LABELLING ERROR
	SKIPL	LBLETB(T2)	;LEGAL TO SET?
	TDO	S,LBLETB(T2)	;YES
	LDB	T2,TUYLTP	;GET LABEL TYPE
	SKIPE	%SITLP##	;IS THERE A TAPE LABEL PROCESS?
	SKIPN	T2		;BYPASS?
	TLZ	S,LBLNED	;YES - CLEAR BIT
	TLNN	S,LBLNED
	TRNE	T1,RB.SED!RB.SDE!RB.STL!RB.SLK!RB.SIL	;NON-SKIP IF ERRORS OR
	SKIPA			;NEED LABEL ACTION
> ;END IFN FTTLAB
IFE FTTLAB,<
	TRNN	T1,RB.SED!RB.SDE!RB.STL!RB.SLK!RB.SIL	;NON-SKIP IF ERRORS
>
SETIOX:
IFE FTMP,<AOS	(P)>		;INDICATE GOODNESS
IFN FTMP,<
	AOSA	(P)		;INDICATE GOODNESS
	PJRST	STOIOS##	;STORE S AND RETURN
	LDB	T1,PIOMOD##	;IF BUFFERED MODE
	CAIGE	T1,SD
	TRNN	S,IODEND	; IF NOT EOF
	CAIA
	POPJ	P,		;EOF - DON'T STORE IODEND IN DDB
> ;END IFN FTMP
	PJRST	STOIOS##	;STORE S AND RETURN
;ROUTINE TO GENERATE I/O XFER LIST FROM IOWD
;CALL:	MOVE	T2,IOWD
;	MOVE	T4,NUMBER OF BYTES
;	PUSHJ	P,MAKLST
;	... RETURN HERE IF NO ROOM
;	RETURN HERE IF OK

MAKLST:	PUSHJ	P,SAVE4##	;SAVE WORLD
	MOVE	P1,T2		;COPY UNRELOCATED IOWD
	PUSHJ	P,SVEUF##	;MAKE JOB ADDRESSABLE
	PUSHJ	P,SPCS##	;ANS SETUP PCS
	MOVEM	P1,TRBRCT(T1)	;SAVE NUMBER OF WORDS, UVA IN IORB (FOR TM2KON/TD2KON)
	LDB	P4,PRBMOD##	;GET MODE
	MOVE	P4,TMODTB##(P4)	;CHARS/WD TABLE (4,5,6)
	LDB	T3,PBUFRM	;MAX FRAME COUNT USER GAVE
	JUMPE	T3, MAKLS0	;USER SPECIFY MAX FC?
	SKIPE	T4		;YES, T4=0 FOR CORE DUMP
	CAMG	T3,T4		;T4 NON-ZERO MEANS BYTE MODE
	MOVE	T4,T3		;USE MAX FRAME COUNT
MAKLS0:	MOVE	T3,T4
	HRL	P4,T3		;IN LH (P4)
	MOVNS	T3
	SKIPE	T3		;IF BYTE MODE, SAVE
	HRLZM	T3,TRBRCT(T1)	;-BYTE COUNT,,UVA FOR TM2KON/TD2KON
	MOVEI	T1,DEPDER	;ERROR RETRY ENABLED?
	TDNN	T1,DEVSTA(F)
	TDNE	S,[MTSNAR,,IONRCK]
	TLOA	S,IOSRTY	;NO, DON'T LET DX10 RETRY
	TLZ	S,IOSRTY	;YES, TELL DX TO RETRY
	MOVE	P3,KDBCHN(W)	;ADDRS OF CHNCB
	HRRZ	T1,TUBQUE(U)	; RESTORE LOC OF IORB
IFN FTKS10,<
	LDB	P1,PRBFCN##	;GET FUNCTION
	CAIN	P1,RB.FRB	;READ BACKWARDS?
	SETOM	CHNRRV(P3)	;YES -- SET READ REVERSE FLAG
	TLO	P3,400000	;FLAG TO FORCE MAPIO TO STORE EXPECTED FINAL BUS ADDRESS
	MOVEI	P1,0		;INITIAL CALL TO MAPIO
	PUSHJ	P,MAPIO##	;SET UP UNIBUS ADAPTER REGISTERS
	  CAIA			;WE LOST SOMEHOW!!
	AOS	(P)		;SET FOR SKIP RETURN
	SETZM	CHNRRV(P3)	;CLEAR READ REVERSE FLAG
	POPJ	P,		;RETURN
>;END IFN FTKS10
IFE FTKS10,<
	MOVEI	P2,DEPEVM
	TDNN	P2,DEVTYP(F)	;SKIP IF OTHER THAN TM10A
	JRST	MAKLS1		;TRY KA10 STYLE
	MOVEI	P1,0		;INIT CALL TO MAPIOW
	PUSHJ	P,MAPIO##	;MASSAGE IOWD
	  PJRST	MAKLSE		;NO FREE SPACE - RELEASE ANY PARTIAL IOWD LIST
IFN FTKL10,<
;MAKE MULTI-IOWD LIST IF TU70
	MOVEI	T4,1		;AT LEAST ONE RECORD WILL BE DONE
	MOVEM	T4,TKBCNT(W)
IFN FTMP,<
	TLNN	S,IO		;OUTPUT?
	JRST	MAKL0A
	PUSH	P,T1		;YES, FIND OUT HOW MANY BUFS WE CAN DO
	PUSHJ	P,CHKNB##
	POP	P,T1
	MOVSI	T4,-1		;DECREMENT NUMBER OF BUFS SWEPT FOR
	ADDB	T4,DEVNBF(F)
	TLNE	T4,-1		;DONE IF NO MORE AVAILABLE
> ;END IFN FTMP
MAKL0A:	TRNE	S,IOCON		;DISCONTINUOUS MODE?
	JRST	CHNDON		;YES, DONE
	MOVE	T4,KDBDSP(W)	;DRIVER DISPATCH
	SKIPN	TUBCNI(U)	;NO ERRORS DETECTED ON LAST XFER?
	SKIPN	TPKCCF(T4)	; AND DEVICE SUPPORT COMMAND CHAINING?
	JRST	CHNDON		;NO, ONLY DO 1 RECORD
	LDB	T4,PRBFCN##	;YES, IS IT BUFFERRED MODE,
	LDB	T3,PIOMOD##	; AND NOT READ-BACKWARD?
	CAIE	T4,RB.FRB
	CAIL	T3,SD
	JRST	CHNDON		;NO, ONLY 1 RECORD
	TLNE	S,IO		;READING?
	JRST	MAKL0B
	HRROI	T2,-1(T2)	;YES, SET UP TO ASK DX10 TO STORE WRDCNT
	PUSHJ	P,MAPIO##
	  JRST	MAKL0B
	MOVE	T4,KDBDSP(W)	;NOW THAT WE HAVE A "REAL" IOWD
	PUSHJ	P,@TPKCMD(T4)	; ASK TX1KON TO MASSAGE IT INTO WHAT DX10 WANTS
	  JFCL			;ALWAYS COMES BACK NON-SKIP
MAKL0B:	HRRZ	T4,DEVIAD(F)	;YES, GET BUFFER LOC
	TLNE	S,IO
	HRRZ	T4,DEVOAD(F)
	MOVE	T3,T4		;START AT THAT BUFFERS SUCCESSOR
	HRL	P2,T1		;SAVE LOC OF IORB IN P2 (FOR TPKCMD)
;STILL IN FTKL10 CONDITIONAL
;NOTE RACE CONDITION:
;MAPIO GETS NO ROOM TO INSERT WRDCNT READER, BUT IO LIST SPACE IS
;FREED UP BEFORE NEXT CALL TO MAPIO

CHNLS1:	EXCTUX	<HRRZ T1,(T3)>	;STEP TO NEXT BUF
	CAIN	T4,(T1)		;BACK WHERE WE STARTED?
	JRST	CHNDN1		;YES, DONE
	PUSHJ	P,IADRCK##	;WORD 0 OF BUFFER THERE?
	  JRST	CHNDN1		;NO, DONE
	  JRST	CHNDN1		;DONE
	EXCTUX	<HLL T1,(T1)>	;YES, GET LH OF THE BUFFER
	TLNN	S,IO		;IF READING,
	JUMPL	T1,CHNDON	; DONE IF THE USE BIT IS ON
	TLNE	S,IO		;IF WRITING,
	JUMPGE	T1,CHNDON	;DONE IF THE USE BIT IS OFF
	MOVE	T2,KDBDSP(W)	;WE HAVE A RECORD TO WRITE
	PUSHJ	P,@TPKCMD(T2)	;GO SET UP THE DEVICE-COMMAND
	  JRST	CHNDON		;NO ROOM FOR IT IN FREE CORE
	TLNE	S,IO		;READING?
	JRST	CHNLS2		;NO
	LDB	T2,[POINT 17,T1,17]	;YES, GET MAX SIZE OF BUFFER
	MOVNI	T2,-1(T2)	;-SIZE
	JUMPGE	T2,CHNLSX	;DONE IF SIZE WRONG
	JRST	CHNLS4		;OK, CONTINUE
CHNLS2:	MOVEI	T1,1(T1)	;POINT TO WORD COUNT WORD
	PUSHJ	P,IADRCK##	;CHECK IT OUT
	  JRST	CHNDN1		;ILLEGAL ADDRESS
	  JRST	CHNDN1		;ILLEGAL FOR I/O
	MOVEI	T1,-1(T1)	;RESTORE T1
	EXCTUX	<MOVN T2,1(T1)>;WRITING, GET USERS WRDCNT
	JUMPE	T2,CHNLSX	;DONE IF 0
	LDB	T3,PIOMOD##	;BYTE MODE?
	CAIE	T3,BYTMOD
	JRST	CHNLS4
	PUSH	P,T1		;YES. GET MODE OF REQUEST
	HRRE	T1,TUBQUE(U)
	LDB	T3,PRBMOD##
	MOVNS	T2		;+BYTE COUNT
	LDB	T1,PBUFRM	;MAX USER SPECIFIED VIA TAPOP
	JUMPE	T1,CHNLS3
	CAMGE	T1,T2		;IF MORE BYTES THAN MAX
	MOVE	T2,T1		;USE MAX NUMBER HE ASKED FOR
CHNLS3:	POP	P,T1
	HRL	P4,T2		;SET LH(P4)=BYTE COUNT FOR MAPIO
	IDIV	T2,TMODTB##(T3)	;NUMBER OF WORDS
	SKIPE	T3
	ADDI	T2,1
	MOVNS	T2		;T2=-NUMBER OF WORDS
CHNLS4:	HRRZS	T3,T1		;SAVE START ADR
	HRL	T3,T2		; AND WORDCOUNT
	MOVEI	T1,-1(T1)	;MAKE SURE ENTIRE BUFFER, PLUS S-WORD
	MOVNS	T2		; IS IN CORE
	ADDI	T2,2(T1)	;TOP OF BUFFER
	PUSHJ	P,ZRNGE##	;ALL THERE?
	  JRST	CHNLSX		;NO, FORGET ABOUT THIS BUFFER
IFN FTMP,<
	PUSHJ	P,[TLNE S,IO	;INPUT?
		  JRST CPOPJ1##;WRITING, BUF IS OK
	           PUSHJ P,SAVT##
		  HRRZ T1,T3	;IS BUF OK WRT CACHE?
	          PJRST BUFSSN##]
	  JRST	CHNLSX		;NO, DON'T DO BUF
> ;END IFN FTMP
	AOS	T2,T3		;IOWD TO T2, POINT AT DATA-1
	PUSH	P,P1		;SAVE CURRENT END
	PUSH	P,P2		;SAVE P2 (LH=LOC OF IORB)
	PUSHJ	P,MAPIO##	;GO MAP IT
	  JRST	CHNPNT		;NOT ENOUGH FREE CORE
	TLNE	S,IO		;READING?
	JRST	MAKLS5
	HRROI	T2,-1(T2)	;YES
	PUSHJ	P,MAPIO##	;MAKE LIST ENTRY FOR BYTE COUNT
	  JRST	CHNPNT		;NO ROOM
	PUSH	P,T1		;SAVE T1
	MOVE	T1,KDBDSP(W)	;DRIVER DISPATCH
	PUSHJ	P,@TPKCMD(T1)	;SETUP COMMAND CHAINING
	  JFCL			;ALWAYS COMES BACK NON-SKIP
	POP	P,T1		;RESTORE T1
MAKLS5:	POP	P,P2		;RESTORE LOC OF IORB
	POP	P,(P)		;DISCARD PREVIOUS END
	AOS	TKBCNT(W)	;ONE MORE RECORD IN THIS XFER
IFN FTMP,<
	MOVSI	T2,-1		;DECREMENT NO OF BUFFERS SWEPT FOR
	TLNE	S,IO
	ADDB	T2,DEVNBF(F)	; IF OUTPUT
	TLNN	T2,-1		;ANY MORE AVAILABLE?
	JRST	CHNDN1		;NO, WE'RE THROUGH
> ;END IFN FTMP
	SOJA	T3,CHNLS1	;GO TEST NEXT BUFFER
;STILL IN FTKL10 CONDITIONAL
;HERE WHEN MAPIO RAN OUT OF ROOM
CHNPNT:	POP	P,P2
	SETZM	(P1)		;SO RTNIOW WILL KNOW WHEN TO STOP
	POP	P,P1		;RESTORE LOC OF LAST DEVICE COMMAND

;HERE ON BAD WRDCNT, THE DEVICE COMMAND IS ALREADY IN THE LIST
CHNLSX:	SUBI	P1,1		;BACK UP OVER DEVICE COMMAND
	SETZM	(P1)		;CLEAR IT
CHNDON:
CHNDN1:
>;END FTKL10



	MOVE	P3,P1		;SAVE PNTR TO NEXT WORD
MAKLSX:
IFN FTKL10,<MOVE T1,-10(P)>	;GET ADDR OF IORB
IFN FTKS10,<MOVE T1,-6(P)>	;GET ADDR OF IORB
	HRRM	P2,@IRBACC(T1)	;STORE EVA OF IOLIST
	HRLM	P3,@IRBACC(T1)	;POINT TO LAST WORD OF XFER LIST
	LDB	T2,PRBFCN##	;GET FCN
	CAIN	T2,RB.FRB	;READ BACKWARDS?
	JRST	INVERT		;YES - INVERT XFER LIST
	JRST	CPOPJ1##	;NO - RETURN
MAKLS1:	PUSH	P,T2		;SAVE IOWD
	PUSHJ	P,GCH4WD##	;GET BLOCK OF STORAGE
	  JRST	T2POPJ##	;ERROR RETURN

	MOVE	P2,T1		;SAVE IN P2
	SETZM	3(T1)		;CLEAR LAST WORD
	POP	P,0(T1)		;STORE IOWD
	SETZM	1(T1)		;TERMINATE LIST
	MOVEI	P3,1(T1)	;ADDRS OF END OF LIST
	JRST	MAKLSX		;RETURN

;HERE WHEN MAPIO LOST - RETURN ANY PARTIAL STUFF

MAKLSF:
IFN FTKL10,<MOVE P1,-10(P)>	;GET ADDR OF IORB
IFN FTKS10,<MOVE P1,-6(P)>	;GET ADDR OF IORB
	HRRZ	T1,@IRBACC(P1)	;PARTIAL LIST
	PUSHJ	P,RTNIOW##	;RETURN IT
MAKLSE:	SKIPE	T1,P2		;ANYTHING ALLOCATED
	PUSHJ	P,RTNIOW##	;YES - RETURN IT
	POPJ	P,		;GIVE ERROR RETURN
> ;END IFE FTKS10

;HERE TO WAIT FOR A KONTROLLER
KSLEEP:	SKIPA	T3,[FSLEEP##]	;LIKELY THAT EVENT WILL HAPPEN SOON

;HERE TO GO INTO EVENT WAIT
MSLEEP:	MOVEI	T3,ESLEEP##	;LONG TIME UNTIL THE EVENT
	MOVEI	T2,IOACT	;CHECK FOR IOACTIVE
	TDNN	T2,DEVIOS(F)	;DON'T RETURN EVM IF SO
	PUSHJ	P,RTEVM##	;RETURN ANY EVM WHICH WE MAY HAVE
				; SINCE WE MIGHT GET SWAPPED
				; WHILE SLEEPING
	MOVSI	T2,OFLHNG	;IN KONTROLLER WAIT BIT
	IORM	T2,DEVIAD(F)	;LITE IT IN CASE OF HUNG DEVICE
	PUSHJ	P,(T3)		;WAIT FOR EVENT
	MOVE	S,DEVIOS(F)	;NEW STATE OF UNIT
	SKIPL	DEVIAD(F)	;HUNG DEVICE WHILE WAITING FOR THE KONTROLLER?
	PJRST	ERRGOU##	;YES, GET OUT

	MOVSI	T2,OFLHNG	;NO, NO LONGER WAITING
	ANDCAM	T2,DEVIAD(F)	; ..
	POPJ	P,
IFN FTKL10,<
;ROUTINE TO GENERATE XFER LIST FOR READ BACKWARDS
;ENTER WITH P2 := FORWARD XFER LIST
;	    T1 := IORB ADDRS
;	    P4 := CHARS/WD

INVERT:	PUSH	P,U		;WE USE U AS A FLAG TO GETMOR
	MOVE	U,KDBDSP(W)	;POINT TO KONTROLLER DISPATCH
	LDB	U,[POINTR (DRVCF2(U),DR.KTY)] ;GET KONTROLLER TYPE
	CAIE	U,K.T78		;TM78?
	CAIN	U,K.DX2		;OR DX20?
	JRST	[MOVEI U,4
		 JRST	INVL0]
	CAIN	U,K.TX1		;DX10?
	TDZA	U,U		;SET U=0 FOR DX10, U=4 FOR DX20
				;GETMOR USES THIS AS A FLAG FOR WHICH
				;KIND OF CCW JUMP WORDS IT BUILD
	PJRST	UPOPJ1##	;NO, LEAVE THE LIST ALONE
INVL0:	MOVEI	P3,0		;INIT CNTR OF IOWDS
	MOVE	P1,T1		;IORB ADDRESS
	MOVE	T2,P2		;COPY LIST HEAD
INVL1:	MOVE	T1,0(T2)	;IOWD
	JUMPE	T1,INVD1	;DONE IF ZERO
	JUMPG	T1,[MOVE T2,T1	;PERFORM XFER
		    JRST INVL1]	;CONTINUE
	ADDI	P3,1		;INCR COUNTER
	AOJA	T2,INVL1	;AND LOOK AT NEXT

INVD1:	PUSHJ	P,GCH4WD##	;GET SOME STORAGE
	  JRST	[POP	P,U	;RESTORE U
		 JRST	MAKLSE]	;LOSE
	HRRM	T1,@IRBACC(P1)	;SAVE THIS LIST ADDRS
	MOVE	P1,T1		;COPY TO P1
	HRLI	P1,-3		;MAKE AOBJN PNTR
	SETZM	0(P1)		;GRNTEE ZERO AT END
INVL2:	MOVE	T2,P2		;HEAD OF OLD LIST
	MOVE	T3,P3		;ITEM # TO FIND
INVL3:	SKIPN	T1,0(T2)	;LOOK FOR END
	STOPCD	MAKLSF,DEBUG,BFO,	;++BETTER FIND ONE
	JUMPG	T1,[MOVE T2,T1	;LINK TO NEXT
		    JRST INVL3]	;AND PROCEED
	SOJLE	T3,INVD2	;DONE WHEN T3 GOES TO ZERO
	AOJA	T2,INVL3	;LOOK FOR MOVE
INVD2:	HLRE	T3,T1		;GET LH
	ASH	T3,-4		;ADJUST
	JUMPN	U,INVD4		;ALREADY HAVE WORD COUNT IF DX20
	MOVNS	T3		;POSITIVE
	IDIVI	T3,(P4)		;MAKE INTO WORDS
	JRST	INVD5		;JUMP AROUND DX20/RH20 CODE
INVD4:	ANDI	T3,3777		;RH20 USES 11 BIT POSITIVE WORD COUNT
	TLO	T1,(CC.REV)	;SET REVERSE BIT IN RH20 CCW
INVD5:	ADDI	T1,-1(T3)	;ADJUST IOWD TO BUFFER END
	MOVEM	T1,0(P1)	;STORE IN NEW LIST
	SOJLE	P3,INVD3	;DONE IF NO MORE
	AOBJN	P1,INVL2	;NO - DO MORE
	PUSHJ	P,GETMOR##	;NEED MORE STORAGE
	  JRST	[POP	P,U	;RESTORE U
		 PJRST	MAKLSF]	;RETURN TRASH AND LOSE
	JRST	INVL2		;TRY AGAIN

INVD3:	AOBJN	P1,.+1		;POINT TO END OF LIST
	SETZM	0(P1)		;GRNTEE ZERO
	MOVE	T1,-11(P)	;RESTORE IORB
	HRLM	P1,@IRBACC(T1)	;SAVE NEW LIST END
	MOVE	T1,P2		;NOW RETURN OLD LIST
	PUSHJ	P,RTNIOW##
	PJRST	UPOPJ1##	;GIVE GOOD RETURN

>;END IFE FTKL10
;ROUTINE TO SET UP CORRECT READ OP
SETRED:	MOVEI	P2,RB.FRD	;ASSUME NORMAL
	MOVE	T2,TDVSTS(F)	;GET FLAGS
	TLNE	T2,D.NRLT	;LOW THRESHOLD?
	MOVEI	P2,RB.FRL	;YES - SET FCN
	TLNE	T2,D.RDBK	;READ BACKWARDS?
	MOVEI	P2,RB.FRB	;YES - USE THIS
	POPJ	P,		;RETURN

;ROUTINES TO SETUP ASYNCHRONOUS IORB
IFN FTMP,<
PCLOUT:	SKIPA	T3,[TPMOU1]	;OUTPUT
PCLINP:	MOVEI	T3,TPMIN1	;INPUT
	MOVSI	T2,RB.PCL	;QUEUED PROTOCOL BIT
	JRST	QUEIOB		;GO QUEUE UP IORB
> ;END IFN FTMP
QUEOUT:	SKIPA	T3,[TPMOU1]	;OUTPUT
QUEINP:	MOVEI	T3,TPMIN1	;INPUT
	SETZ	T2,		;ASYNCH I/O
QUEIOB:
IFN FTXMON,<XHLLI T3,.>		;INCLUDE SECTION
	MOVEM	T3,IRBIVA(T1)	;SAVE IN INT VECTOR
	PUSH	P,T2		;SAVE IORB BITS
	PUSH	P,T1		;SAVE IORB PNTR
	PUSHJ	P,CKREW		;MAKE SURE NOT REWINDING
	PUSHJ	P,SETACT##	;MAKE (RAD)IOACTIVE
	POP	P,T1		;IORB
	POP	P,T2		;IORB BITS
	MOVEI	T3,DEPAIO	;BIT TO TEST
	TDNE	T3,DEVAIO(F)	;ASYNCH I/O?
	TLO	T2,RB.AIO	;YES
	IORM	T2,TRBFNC(T1)	;...
	PJRST	TAPRQT##	;QUEUE IORB, SELECT IF IDLE

;PROCESS CONTROL-T
TPMCTT::PUSHJ	P,SAVE1##	;SAVE P1
	MOVE	P1,TDVUDB(F)	;UDB POINTER
	PUSHJ	P,INLMES##
	ASCIZ	" file "
	MOVE	T1,TUBFIL(P1)
	PUSHJ	P,PRTDIG##
	PUSHJ	P,INLMES##
	ASCIZ	" record "
	SKIPL	T1,TUBREC(P1)
	PJRST	PRTDIG##
	PUSHJ	P,INLMES##
	ASCIZ	" ???"
	POPJ	P,
SUBTTL	TAPSER CALLED ROUTINES

;ROUTINE CALLED BY TAPSER WHEN KONTROLLER IS GRANTED
;W POINTS TO KDB, U POINTS TO UDB, T1 TO IORB

TPMSIO::MOVE	F,TUBCUR(U)	;POINTER TO DDB
	MOVSI	T2,RB.AIO	;CHECK FOR SPECIAL IORBS
	TDNE	T2,TRBFNC(T1)
	JRST	TPASIO		;START THESE NOW
	PUSH	P,T1		;SAVE IORB PNTR
	LDB	T1,PJOBN##	;JOB NO. IN T1
	JUMPE	T1,TPOPJ##	;NO JOB NUM.?
	PUSHJ	P,EWAKE##	;GET HIM UP
	JRST	TPOPJ##		;RETURN

;HERE TO START ASYNC I/O REQUEST

TPASIO:	PUSHJ	P,SVEUF##	;SET UP UPMP
	PUSHJ	P,SPCS##	;ALSO SETUP PCS
	MOVE	S,DEVIOS(F)	;SET UP S
		;;;;		;FALL INTO TPMDON

;ROUTINE CALLED BY TAPSER WHEN I/O COMPLETE
; U - UDB PNTR , W - KDB PNTR

TPMDON::PUSHJ	P,SAVE2##	;SAVE P1,P2
	MOVE	P1,T1		;PLACE IORB PNTR IN P1
	MOVE	F,TUBCUR(U)	;POINTER TO DDB
	LDB	J,PJOBN##	; J = JOB NUMBER
	LDB	T2,PRBFCN##	;GET SELECTED FUNCTION
	LDB	T1,PRBDEN##	;GET SELECTED DENSITY
	CAIE	T2,RB.FRW	;IF REWIND
	CAIN	T2,RB.FYB	; OR YELOW BALL,
	JRST	TPMDO1		;DON'T UPDATE DENSITY STATUS
	DPB	T1,TDYDEN	;UPDATE ACTUAL DENSITY
IFN FTTLAB,<
	TLO	T1,(ST.FAC)	;UPDATE ACTUAL
	PUSHJ	P,SETODN	;SET IN OTHER GUY, TOO!
> ;END IFN FTTLAB
TPMDO1:	SKIPE	T1,IRBIVA(P1)	;GET ROUTINE ADDRESS
IFE FTXMON,<JRST (T1)>		;DISPATCH
IFN FTXMON,<XJRST T1>		;DISPATCH
	STOPCD	.,STOP,NIV,	;++ NULL INT VECTOR ADDRS
;ROUTINE CALLED TO RESET DDB PARAMETERS PECULIAR TO MAGTAPES
;ENTER AT TPMRES FOR A NORMAL RESET OR TPMREA FOR A REASSIGN
TPMRES::TDZA	T1,T1		;NORMAL RESET ENTRY POINT
TPMREA::MOVE	T1,%SITLP##	;REASSIGN ENTRY POINT
	MOVE	T2,DEVMOD(F)	;GET MODE WORD
	TLNN	T2,DVTTY	;WEED OUT NUL:
	TLNN	T2,DVMTA	;A MAGTAPE?
	POPJ	P,		;NO
	MOVEI	T2,MTSIZ##+1	;GET DEFAULT MAGTAPE BLOCK SIZE
	DPB	T2,PBUFSZ	;RESTORE DEFAULT BLOCK SIZE
	SETZ	T2,		;GET A ZERO
	SKIPN	T1		;TAPE LABELER RUNNING?
	DPB	T2,TDYDEN	;RESET ACTUAL DEN TO SYSTEM DEFAULT
	DPB	T2,TDYDN1	;CLEAR USER SET DEFAULT DENSITY
	DPB	T2,TDYMOD	;FORCE REINIT OF MODE
	DPB	T2,TDYMD1	;CLEAR DEFAULT MODE
	DPB	T2,PBUFRM	;CLEAR MAX FRAME-COUNT
	DPB	T2,PMTRTY	;ENABLE AUTO ERROR-RETRY
	POPJ	P,		;RETURN
;ROUTINE CALLED BY DDB SCANNING TO CONVERT SIXBIT /MT/ INTO
;THE APPROPRIATE NAME FOR 7 OR 9-TRACK DEVICES

TPMDVS::CAMN	P1,[SIXBIT/MT/]	;SANITY CHECK
	POPJ	P,		;DON'T MESS WITH NAME
	MOVE	T3,TDVUDB(F)	;IT'S A MAGTAPE, GET UDB
	HRRZ	T3,TUBCNF(T3)	;GET CONFIG INFO
	TRNN	T3,TUC7TK##	;IS THIS 7-TRACK ?
	SKIPA	T3,[SIXBIT/M9/]	;NO, SETUP 9-TRACK
	MOVSI	T3,'M7 '	;YES, SET UP NAME
	JRST	CPOPJ1##	;RETURN
SUBTTL	ERROR LOGGING ROUTINES -- TPELOG - LOG I/O OR POSITIONING ERRORS


TPELOG::JUMPE	U,CPOPJ##	;NEED A UDB FOR ERROR LOGGING
	PUSHJ	P,SAVT##	;SAVE SOME ACS
	JUMPN	F,TPELO1	;DDB ALREADY SETUP?
	SKIPN	F,TUBCUR(U)	;PICK UP CURRENT DDB
	MOVE	F,UDBDDB(U)	;OR THE "REAL" DDB IF NONE
	JUMPE	F,TPELO2	;ASSUME LOGGING WANTED	 IF NO DDB

TPELO1:	MOVEI	T2,DEPDEL	;BIT TO TEST
	TDNE	T2,DEVSTA(F)	;ERROR LOGGING DISABLED?
	JRST	[AOS   DELCNT##	;YES
		 POPJ  P,]	;JUST RETURN

TPELO2:	MOVE	T2,KDBDSP(W)	;ADDRS OF CTL DEP CODE
	PUSHJ	P,@TPKELG(T2)	;DO KONTROLLER DEPENDENT ERROR LOGGING
	  POPJ	P,		;FAILED
	PUSHJ	P,QUESEB##	;QUEUE UP THE BLOCK
	POPJ	P,		;RETURN


;COMMON ROUTINE CALLED BY MOST DRIVERS
TPELGX::HLLZ	T1,ELGTBL+.EXFLG ;GET -VE LENGTH OF XFER TABLE
	ADD	T1,TUBIEP(U)	;PLUS -VE IEP LENGTH
	ADD	T1,TUBFEP(U)	;PLUS -VE FEP LENGTH
	HLRES	T1		;MOVE TO RH
	MOVMS	T1		;MAKE POSITIVE
	PUSHJ	P,ALCSEB##	;ALLOCATE A SYSTEM ERROR BLOCK
	  POPJ	P,		;NO CORE
	LDB	T2,PJOBN##	;GET OWNER JOB NUMBER
	MOVE	T3,JBTPPN##(T2)	;AND ITS PPN
	MOVEM	T3,TUBUID(U)	;STORE FOR XFER
	MOVE	T3,JBTNAM##(T2)	;GET PROGRAM NAME
	MOVEM	T3,TUBPGM(U)	;STORE FOR XFER
	MOVE	T2,KDBDSP(W)	;POINT TO KONTROLLER DISPATCH
	LDB	T2,[POINTR (DRVCF2(T2),DR.KTY)] ;GET KONTROLLER TYPE
	DPB	T2,[POINT 3,TUBTRY(U),14] ;SAVE FOR SYSERR
	MOVEM	T2,TUBKTY(U)	;STORE FOR XFER
	MOVE	T2,KDBDVC(W)	;GET DEVICE CODE WORD
	MOVEM	T2,TUBDVC(U)	;STORE FOR XFER
	MOVE	T2,KDBCHN(W)	;GET CHANNEL DATA BLOCK
	MOVE	T2,CHNTYP(T2)	;AND CHANNEL TYPE WORD
	SETZ	T3,		;CLEAR TEMP
IFN FTKL10,<
	TLNE	T2,CP.RH2	;RH20?
	TLO	T3,(1B11)	;YES
> ;END IFN FTKL10
IFN FTKS10,<
	TLNE	T2,CP.R11	;RH11?
	TLO	T3,(1B10)	;YES
> ;END IFN FTKS10
	IORM	T3,TUBTRY(U)	;STORE FOR XFER

	XMOVEI	T2,ELGTBL	;POINT TO TRANSFER TABLE
	PUSHJ	P,XFRSEB##	;COPY DATA
	  JFCL			;WON'T FAIL
	MOVEI	T2,ELGEND-ELGTBL-.EXHDR+.EBHDR-1 ;OFFSET TO IEP STORAGE
	HRRM	T2,.EBHDR+10(T1) ;FIXUP AOBJN POINTER
	HLRE	T2,TUBIEP(U)	;GET -VE IEP LENGTH
	MOVMS	T2		;MAKE POSITIVE
	PUSH	P,T2		;SAVE FOR A MOMENT
	HRRZ	T3,TUBIEP(U)	;GET OFFSET WITHIN TUB
	ADD	T3,U		;RELOCATE
	HRRZ	T4,.EBHDR+10(T1) ;GET OFFSET TO STORAGE
	AOS	T4		;PLUS ONE CUZ SYSERR IS WIERD
	ADD	T4,T1		;FORM DESTINATION

IFE FTXMON,<
	HRLZS	T3		;GET SOURCE IN LH
	HRRI	T3,(T4)		;AND DESTINATION IN RH
	ADDI	T4,(T2)		;COMPUTE END OF BLT
	BLT	T3,-1(T4)	;COPY DATA
> ;END IFE FTXMON
IFN FTXMON,<EXTEND T2,[XBLT]>	;COPY INTO ERROR BLOCK

	HRRZ	T2,.EBHDR+10(T1) ;GET OFFSET TO START OF IEP DATA
	ADD	T2,(P)		;PLUS IEP SIZE
	HRRM	T2,.EBHDR+11(T1) ;FIXUP OFFSET TO START OF FEP DATA
	HLRE	T2,TUBFEP(U)	;GET -VE FEP LENGTH
	MOVMS	T2		;MAKE POSITIVE
	HRRZ	T3,TUBFEP(U)	;GET OFFSET WITHIN TUB
	ADD	T3,U		;RELOCATE
	HRRZ	T4,.EBHDR+11(T1) ;GET OFFSET TO STORAGE
	AOS	T4		;PLUS ONE FOR SYSERR
	ADD	T4,T1		;FORM DESTINATION

IFE FTXMON,<
	HRLZS	T3		;GET SOURCE IN LH
	HRRI	T3,(T4)		;AND DESTINATION IN RH
	ADDI	T4,(T2)		;COMPUTE END OF BLT
	BLT	T3,-1(T4)	;COPY DATA
> ;END IFE FTXMON
IFN FTXMON,<EXTEND T2,[XBLT]>	;COPY INTO ERROR BLOCK

	POP	P,(P)		;PHASE STACK
	JRST	CPOPJ1##	;RETURN

ELGTBL:	SEBTBL	(.ERTAP,ELGEND,)
	MOVE	UDBNAM(U)	;(R00) DEVICE NAME
	MOVE	TUBRID(U)	;(R01) REELID
	MOVE	TUBFIL(U)	;(R02) FILES FROM BOT
	MOVE	TUBREC(U)	;(R03) RECORDS FROM LAST EOF
	MOVE	TUBTRY(U)	;(R04) RETRY COUNT + HARD ERROR BIT
	MOVE	TUBCCR(U)	;(R05) CHARACTERS INTO CURRENT RECORD
	MOVE	TUBPBE(U)	;(R06) POSITION BEFORE ERROR
	MOVE	TUBFES(U)	;(R07) FINAL ERROR STATE
	MOVE	TUBIEP(U)	;(R10) INITIAL ERROR POINTER
	MOVE	TUBFEP(U)	;(R11) FINAL ERROR POINTER
	MOVE	TUBUID(U)	;(R12) PPN OF USER
	MOVE	TUBPGM(U)	;(R13) SIXBIT PROGRAM NAME
	MOVE	TUBDVC(U)	;(R14) DEVICE CODE/UNIBUS ADDRESS
	MOVE	TUBKTY(U)	;(R15) KONTROLLER TYPE
ELGEND:!			;END OF TABLE
SUBTTL	ERROR LOGGING ROUTINES -- TPEMOV - MOVE DATA WITHIN TUB


TPEMOV::MOVE	T4,KDBDSP(W)	;POINT TO KONTROLLER DISPATCH
	LDB	T4,[POINTR (DRVCF2(T4),DR.KTY)] ;GET KONTROLLER TYPE
	TRNN	T1,RB.SRE	;LEAVE IEP ALONE IF RECOVERED
	CAIN	T4,K.DX2	;IF A DX20, DON'T COPY
	JRST	TPEMO1		;SINCE TD2KON DOESN'T USER TUBIEP
IFE FTXMON,<
	MOVE	T4,TUBIEP(U)	;INITIAL ERROR POINTER
	ADDI	T4,0(U)		;RELOCATE
	HLRE	T2,T4		;-LEN OF AREA
	MOVNS	T2		; +LEN
	ADDI	T2,-1(T4)	;LOC+N-1
	HRR	T3,TUBFEP(U)	;FINAL ERROR STATUS
	ADDI	T3,0(U)		;RELOCATE
	HRL	T4,T3		; FORM BLT WORD
	BLT	T4,0(T2)	;MAKE COPY FOR DAEMON
> ;END IFE FTXMON
IFN FTXMON,<
	HLRE	T2,TUBIEP(U)	;-LENGTH OF AREA
	MOVNS	T2		;MAKE POSITIVE
	HRRZ	T3,TUBFEP(U)	;UDB OFFSET TO FINAL ERROR STATUS
	ADD	T3,U		;RELOCATE
	HRRZ	T4,TUBIEP(U)	;UDB OFFSET TO INITIAL ERROR STATUS
	ADD	T4,U		;RELOCATE
	EXTEND	T2,[XBLT]	;COPY FOR DAEMON
> ;END IFN FTXMON

TPEMO1:	MOVE	T2,TUBREC(U)	;POSITION BEFORE LAST REC
	SUBI	T2,1		;ASSUME THE TAPE MOVED
	HRL	T2,TUBFIL(U)	;SAVE POSITION BEFORE ERROR
	MOVEM	T2,TUBPBE(U)	; IN CASE TAPERP NOT CALLED
	MOVE	T2,TRBRCT(P1)	;SAVE CHAR COUNT IF REC
	MOVEM	T2,TUBCCR(U)	; IN TUB FOR DAEMON
	LDB	T2,PJOBN
	MOVE	T3,JBTNAM##(T2)	;SAVE PROGRAM NAME
	MOVEM	T3,TUBPGM(U)
	MOVE	T3,JBTPPN##(T2)	; AND PPN
	MOVEM	T3,TUBUID(U)	;FOR DAEMON
	POPJ	P,
SUBTTL	ERROR LOGGING ROUTINES -- TPESTS - LOG TAPE STATISTICS


TPESTS:	PUSHJ	P,SAVT##	;SAVE SOME ACS
	LDB	T1,PJOBN##	;GET OWNER JOB NUMBER
	MOVE	T1,JBTPPN##(T1)	;AND ITS PPN
	MOVEM	T1,TUBUID(U)	;STORE FOR XFER
	SETZ	T1,		;LET XFR ROUTINE ALLOCATE
	XMOVEI	T2,TPSTBL	;POINT TO TRANSFER TABLE
	PUSHJ	P,XFRSEB##	;COPY DATA
	  JFCL			;NO CORE
	SETZM	TUBSTB(U)	;NOW CLEAR AREA

IFE FTXMON,<
	HRLI	T2,TUBSTB(U)	;GEN CLEAR PNTR
	HRRI	T2,TUBSTB+1(U)
	BLT	T2,TUBSTE-1(U)	;END OF AREA TO CLEAR
> ;END IFE FTXMON
IFN FTXMON,<
	MOVEI	T1,TUBSTE-TUBSTB ;LENGTH OF AREA
	XMOVEI	T2,TUBSTB(U)	;SOURCE
	XMOVEI	T3,TUBSTB+1(U)	;MAKE A BLT POINTER
	EXTEND	T1,[XBLT]	;ZERO STORAGE
> ;END IFN FTXMON
	POPJ	P,		;RETURN


TPSTBL:	SEBTBL	(.ERTPS,TPSEND,EX.QUE)
	MOVE	UDBNAM(U)	;(R00) DEVICE NAME
	MOVE	TUBRID(U)	;(R01) REELID
	MOVE	TUBCRD(U)	;(R02) CHARACTERS READ
	MOVE	TUBCWR(U)	;(R03) CHARACTERS WRITTEN
	MOVE	TUBSRE(U)	;(R04) SOFT READ ERRORS
	MOVE	TUBHRE(U)	;(R05) HARD READ ERRORS
	MOVE	TUBSWE(U)	;(R06) SOFT WRITE ERRORS
	MOVE	TUBHWE(U)	;(R07) HARD WRITE ERRORS
	MOVE	TUBUID(U)	;(R10) PPN
TPSEND:!			;END OF TABLE
SUBTTL	COMMAND PROCESSING -- MTABLK - SET BLOCKSIZE


MTABLK::PUSHJ	P,MTFIND	;GET REMAINDER OF COMMAND AND FIND MTA DDB
	  JRST	COMERR##	;NOT NUMERIC
	AOS	P2,T2		;COPY TO WHERE IT'S NEEDED
	PUSH	P,U		;SAVE U
	MOVE	U,TDVUDB(F)	;UDB ADDRESS
	PUSHJ	P,TAPSBS	;VALIDATE BLOCK SIZE
	  SKIPA			;OUT OF RANGE
	JRST	UPOPJ1##	;DONE
	POP	P,U		;RESTORE U
	JRST	COMERR##	;AND TELL USER
SUBTTL	COMMAND PROCESSING -- MTADEN - SET DENSITY


MTADEN::PUSHJ	P,MTFIND	;GET THE REST OF COMMAND AND FIND MTA DDB
	  JRST	COMERR##	;NOT NUMERIC
	MOVE	T1,[-DNTBLN,,DENTAB]
	MOVE	T3,0(T1)	;GET ENTRY FROM TABLE
	CAIE	T2,(T3)		;MATCH?
	AOBJN	T1,.-2		;NO - TRY NEXT
	JUMPGE	T1,COMERA##	;ERROR IF NONE FOUND
	HLRZ	T1,T3		;GET CODE
	MOVEI	T3,TUCD20##	;BIT POSITION OF LOWEST DENSITY
	LSH	T3,-1(T1)	;CHANGE DENSITY CODE INTO BIT POSITION
	MOVE	T2,TDVUDB(F)	;GET POINTER TO THE UDB FOR THIS DRIVE
	TDNE	T3,TUBCNF(T2)	;VALID DENSITY FOR THIS DRIVE?
	JRST	MTADE1		;YES, GO PUT DENSITY IN THE DDB
	JSP	T1,ERRMES##	;ILLEGAL DENSITY FOR THIS DRIVE
	ASCIZ	\Illegal density for drive
\
MTADE1:	DPB	T1,TDYDN1	;YES, STORE CODE IN DDB
IFN FTTLAB,<
	TLZ	T1,(ST.FAC)	;INDICATE A REQUEST ONLY
	PUSHJ P,SETODN		;UPDATE DENSITY ON OTHER DDB
> ;END IFN FTTLAB
	JRST	CPOPJ1##	;RETURN


;TABLE OF DENSITIES
DENTAB:	RB.D2,,^D200
	RB.D5,,^D556
	RB.D8,,^D800
	RB.D16,,^D1600
	RB.D62,,^D6250
DNTBLN==.-DENTAB
SUBTTL	COMMAND PROCESSING -- MTAMOD - SET FORMAT


MTAMOD::PUSHJ	P,MTFIND	;GET REST OF COMMAND AND SET UP F
	  SKIPA	T1,[-MDTBLN,,MODTAB] ;SIXBIT ARGUMENT
	JRST	COMERR##	;NUMERIC - LOSE
	PUSHJ	P,FNDNAM##	;FIND THE ARGUMENT
	  JRST	COMERA##	;SORRY, DON'T KNOW THAT ONE
	CAIE	T1,RB.MCD	;CORE-DUMP?
	JRST	MTAMD1		;NO
	MOVE	T2,TDVUDB(F)	;UDB ADDRESS
	MOVEI	T3,TUC7TK##	;BIT TO TEST
	TDNE	T3,TUBCNF(T2)	;A 7-TRACK DRIVE?
	MOVEI	T1,RB.M7T	;YES. SET 7-TRACK CORE-DUMP
MTAMD1:	DPB	T1,TDYMD1	;SAVE MODE IN DDB
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN


;TABLE OF VALID FORMATS
MODTAB:	SIXBIT	/SYSTEM/	;SYSTEM DEFAULT
	SIXBIT	/DUMP/		;CORE DUMP
	SIXBIT	/BYTE/		;BYTE MODE
	SIXBIT	/SIXBIT/	;SIXBIT
	SIXBIT	/ANSI/		;ANSI-ASCII
	SIXBIT	/??????/	;PLACE MARKER FOR 7-TRACK CORE DUMP
	SIXBIT	/INDUST/	;INDUSTRY COMPATABLE
MDTBLN==.-MODTAB
SUBTTL	COMMAND PROCESSING -- MTARTY - SET RETRY


MTARTY::PUSHJ	P,MTFIND	;GET REST OF COMMAND, SET UP F
	  HLRZS	T2		;NON-NUMERIC RETURN (NORMAL)
	MOVSI	T1,MTSNAR	;NO AUTO-RECOVERY BIT
	CAIN	T2,'ON '	;CLEAR OR SET IF 'ON' OR 'OFF'
	JRST	[ANDCAM	T1,DEVIOS(F)
		 PJRST	CPOPJ1##]
	CAIE	T2,'OF '
	CAIN	T2,'OFF'
	JRST	[IORM	T1,DEVIOS(F)
		 PJRST	CPOPJ1##]
	JRST	COMERR##	;NOT A LEGAL ARGUMENT
SUBTTL	COMMAND PROCESSING -- PARSE MAGTAPE DEVICE SPEC


MTFIND:	TLO	M,CMWRQ		;CAUSE SET COMMAND FORGETS
	PUSHJ	P,CTXDEV##	;PICK UP DEVICE ARGUMENT
	SKIPE	T1,T2		;DEVSRG EXPECTS NAME IN T1
	PUSHJ	P,DEVSRG##	;SEARCH FOR DDB
	  PJRST MTFERR		;NO SUCH DEVICE
	LDB	T1,PJOBN##	;GET OWNER'S JOB NUMBER
	CAME	T1,J		;US?
	PJRST	MTFERR		;NO, LOSE!
	MOVE	T1,DEVMOD(F)
	MOVE	U,TTYTAB##(J)	;RESTORE U
	MOVE	U,DDBLDB##(U)
	TLNN	T1,DVMTA	;IS DEVICE A MAGTAPE?
	PJRST	COMERP##	;NO, LOSE!
	PUSHJ	P,DECIN1##	;GET LAST ARGUMENT
	  PJRST NOTENP##	;NO ARGUMENT FOUND
	  PJRST	CTEXT1##	;NOT NUMERICAL, READ SIXBIT
	JRST	CPOPJ1##	;RETURN.
MTFERR:	MOVE	U,TTYTAB##(J)	;TTY DDB
	MOVE	U,DDBLDB##(U)	;LDB BACK INTO LINE
	PJRST	COMERP##	;TYPE ERROR MESSAGE
	LIT

	$LOW

DIATAP:	BLOCK	1		;NON-ZERO IF DIAG IN PROGRESS

TPMEND::!  END