TITLE TAPUUO - MAGTAPE USER INTERFACE FOR TOPS10- V353
SUBTTL T.HESS/TAH/TW/GMU/DPM	5 MAR 86
	SEARCH	F,S
	$RELOC
	$HIGH



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
.CPYRT<1974,1986>
;COPYRIGHT (C) 1974,1975,1976,1977,1978,1979,1980,1982,1984,1986
;BY DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
;ALL RIGHTS RESERVED.

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

TAPUUO::	ENTRY	TAPUUO

;DISPATCH TABLE

	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##
>
;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
TDYHNI::POINT DESHCT,DEVXTR(F),DENHCI	;INITIALIZATION FOR Q"D/ASYNC HUNGS
TDYHNG::POINT DESHCT,DEVXTR(F),DENHCT	;COUNTER FOR Q"D/ASYNC HUNGS
	DESHCT==:^D3			;ALSO DEFINED IN COMDEV
	DENHCI==:^D2
	DENHCT==:^D5
PDENS::	POINT 2,DEVIOS(F),28

;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)

COMPAT==:<RB.D16>B31+<RB.MBY>B35

;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
>
;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

;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

PMTRTY::POINT	1,DEVIOS(F),9

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		;...
>
TPMINA:	PUSHJ	P,SETRED	;SET READ OP
	PUSHJ	P,GENIOR	;GENERATE IORB
	  JRST	TPMINF		;WHOOPS (UNABLE TO GET STORAGE)
IFN FTMP,<
	PUSHJ	P,TAPCP		;IF CONT ON OTHER CPU
	  PJRST	PCLINP		; DO IT DIFFERENTLY
>
	MOVEI	T2,DEPAIO	;ASYNC I/O?
	TDNE	T2,DEVAIO(F)
	JRST	ASYNCI		;YES - GO TO IT
	MOVEM	T1,TDVIOR##(F)	;NO - REMEMBER THIS IORB
	PUSHJ	P,TAPRQT##	;PLACE AT END OF QUEUE
	PUSHJ	P,KONWAT	;WAIT FOR KONTROLLER
				;RETURN HERE P1 := IORB
	SKIPGE	TRBLNK(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)
>
	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
IFE FTMP,<
	PUSHJ	P,STOIOS##	;SET/RESET HUNG DEVICE TIMER
>
IFN FTMP,<
	PUSHJ	P,STORS7##	;SAVE S,WORRYING ABOUT OTHER CPU
	PUSHJ	P,SETHNG##	;RESET HUNG TIME
>
	MOVEI	T1,INPDUN	;WHERE TO GO WHEN DONE
	HRRM	T1,TRBIVA(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##

;ROUTINE TO SET IMPROPER MODE AND RETURN

TPMINF:	PUSHJ	P,RTEVM##	;RETURN RESOURCES

	TRO	S,IOIMPM	;LITE A BIT
	PJRST	STOIOS##
;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 FTKL10&FTMP,<
	PUSHJ	P,STONBF##	;UPDATE LH(DEVNBF) IF POSSIBLE
	AOS	DEVNBF(F)	;COUNT 1 MORE RECORD READ
>
	PUSHJ	P,SVEUF##	;MAKE JOB ADDRESSABLE
	PUSHJ	P,SPCS##	;ALSO SETUP PCS
IFN FTDX10,<	;ONLY FOR TU70'S

	MOVE	T1,TKBCNT##(W)	;NUMBER OF RECORDS WE DID
	SOJLE	T1,INPDN2	;IF MORE THAN 1,
IFN FTKL10&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:>
IFE FTDX10,<
IFN FTKL10&FTMP,<
	AOS	DEVNBF(F)	;1 MORE RECORD DONE
>>
	LDB	T4,PRBMD2##	;GET MODE
IFN FTDX10,<
	MOVSI	T2,RB.SEN	;IS THERE 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]
>
	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 FTKL10&FTMP,<
	HRRZ	T1,DEVIAD(F)	;NEXT BUFFER OK WRT CACHE
	PUSHJ	P,BUFSSN##
	  JRST	TPSWSP		;NO, STOP I/O
>
	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 IOACTIVE
	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,TRBXCW(P1)	;FETCH CHL LIST
	CAIG	T1,100		;ALLOW FOR COUNT
	POPJ	P,		;RETURN
	PJRST	RTNIOW##	;ELSE RETURN WHOLE LIST
>
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		;GIV4WD LIKES IT IN T2
	MOVEI	T1,1		;# OF BLOCKS
	PJRST	GIV4WD##	;RETURN 4-WD BLOCK

;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
>
	MOVEI	P2,RB.FWT	;FUNCTION WRITE
	PUSHJ	P,GENIOR	;MAKE AN IORB
	  JRST	TPMINF		;UNABLE TO GET STORAGE
IFN FTMP,<
	PUSHJ	P,TAPCP		;IF ON OTHER CPU
	  JRST	PCLOUT		; DO IT DIFFERENTLY
>
	MOVEI	T2,DEPAIO	;ASYNC I/O?
	TDNE	T2,DEVAIO(F)
	JRST	ASYNCO		;YES - GO TO IT
	MOVEM	T1,TDVIOR##(F)	;NO - WAIT FOR THIS ONE
	PUSHJ	P,TAPRQT##	;QUEUE IT UP
	PUSHJ	P,KONWAT	;WAIT FOR CONTROLLER
				;RETURN WITH P1 := IORB
	SKIPGE	TRBLNK(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)
>
	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
IFE FTMP,<
	PUSHJ	P,STOIOS##	;SET/RESET HUNG DEVICE TIMER
>
IFN FTMP,<
	PUSHJ	P,STORS7##	;STORE S
	PUSHJ	P,SETHNG##	;RESET HUNG TIMER
>
	MOVEI	T1,OUTDUN	;WHERE TO GO WHEN FINISHED
	HRRM	T1,TRBIVA(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
>
IFN FTDX10,<	;ONLY FOR TU70'S
	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:>
	PUSHJ	P,ADVBFE##	;ADVANCE BUFFER
	  JRST	TPMSTP		;NO MORE STOP IO
	MOVEI	P2,RB.FWT	;TRY TO WRITE ON
IFN FTKL10&FTMP,<
	MOVSI	T2,-1		;IF NEXT BUFFER WAS NOT SWEPT
	TDNE	T2,DEVNBF(F)	; SHUT DOWN THE TAPE
>
	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 FTKL10&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
>
	PUSHJ	P,ADVBFE##	;CYCLE
	  SKIPA			;NO NEXT BUFFER
	JRST	TPMOU1		;TRY THIS ONE
	PUSHJ	P,SETIOD##	;REVIVE USER
	PUSHJ	P,CLRACT##	;...
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
>
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
>
	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		;MOVE 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:>
	PUSHJ	P,ADJIOW	;ADJUST IOWDS IF NECESSARY
				;RETURNS IOWD IN T2
	PUSHJ	P,TPMDGO	;START I/O
	  JRST	TPMFLS		;CAN'T - MAKLST LOST
	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
>
	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
	MOVEI	T1,DMPDUN	;WHERE TO GO WHEN DONE
	HRRM	T1,TRBIVA(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,TRBLNK(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
	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
	HLRZ	U,TDVUDB##(F)	;GET UDB PNTR
IFN FTTLAB,<
	TLNE	S,LBLWAT	;WAITING FOR LABELS
	PJRST	LBLABO		;YES,JUST TELL LBL PCS
>
	PUSHJ	P,TPMRLW	;WAIT TILL DESELECTED
TPMRL2:	PUSHJ	P,TAPKIL##	;KLANK CTL
IFN FTKL10&FTMP,<
	SETZM	DEVNBF(F)	;NO SWEPT-FOR BUFFERS
	SETZM	DEVSBF(F)
>
	PJRST	TPMDQ		;UNWIND Q , PNTR IN T1

TPMRLW:	MOVSI	T1,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 FTKL10&FTMP,<
	SETZM	DEVNBF(F)	;NO BUFFERS SWEPT FOR
	SETZM	DEVSBF(F)
>
	HLRZ	U,TDVUDB##(F)	;SET UP UDB ADDRS
IFN FTTLAB,<
	LDB	J,PJOBN##	;RESTORE J
	PUSHJ	P,LBLCHK	;NEED LABELING?
	  JRST	TPCLSO		;YES - SEND CLOSE MSG
>
	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
	PUSHJ	P,CPURQT##	;Q IT UP
	PUSHJ	P,GENIOR	;ANOTHER REQUEST
	  JRST	TPMINF
	PUSHJ	P,CPURQT##	;ADD TO QUEUE
	MOVEI	P2,RB.FBR	;BACK OVER LAST TM
	PUSHJ	P,GENIOR	;MAKE ANOTHER IORB
	  JRST	TPMINF		;LOSER
	PUSHJ	P,CPURQT##	;Q IT
	PUSHJ	P,KONWAT	;NOW WAIT YOUR TURN
				;P1 := FIRST IORB
	PUSHJ	P,SETACT##	;SET I/O ACTIVE
	MOVEI	T1,CLSDUN	;WHERE TO GO ON ENDING INT
	HRRZM	T1,TRBIVA(P1)	;STORE IN IORB
	MOVEI	T1,1		;SET FOR ONE OP
	HRRM	T1,TRBXCW(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?
	MOVEI	P2,CLSDN1	;YES - GO HERE INSTEAD
	HRRZM	P2,TRBIVA(T1)	;SAVE NEXT INT ADDRS
	HLLOS	TKBSTS##(W)	;GRNTEE STILL KEEP KONTROLLER
	MOVEI	T2,1		;ONLY ONE OP PSE
	HRRM	T2,TRBXCW(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:	HLRZ	U,TDVUDB##(F)	;SET UDB ADDRS
	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 FTKL10&FTMP,<
	PUSHJ	P,WAIT1##	;WAIT FOR IO TO STOP
	SETZM	DEVNBF(F)	;CLEAR COUNTERS OF NUMBER OF BUFS SWEPT FOR
	SETZM	DEVSBF(F)
>
	PJRST	LBLMSG		;INFORM LBL PCS
>
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
	CAIE	T3,"."		;MAKE SURE IT'S LEGAL
	JRST	TPMLK1		;NEED PERIOD
	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
	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)
	CAIGE	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
	HLRZ	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
	MOVSI	T2,TUBLIB##(U)	;START OF LABEL INFO BLOCK
	HRRI	T2,TUBLIB##+1(U) ;MAKE A BLT POINTER
	SETZM	TUBLIB##(U)	;CLEAR FIRST WORD
	BLT	T2,TUBLIB##+TLPMAX##-1(U) ;CLEAR ENTIRE BLOCK
	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
	CAIL	T3,"0"		;CHECK
	CAILE	T3,"9"		; DIGITS
	CAIL	T3,"A"		;CHECK
	CAILE	T3,"Z"		; LETTERS
	POPJ	P,		;NO MATCH
	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##(U)	;POINT TO UDB INFO AREA
MTACH1:	MOVE	T1,0(P1)	;GET VALUE
	PUSHJ	P,PUTWR1##	;STORE IN USER BLOCK (INCR M)
	  JRST	RTM1##		;OUT OF BOUNDS
	AOBJN	P1,MTACH1	;LOOP TILL DONE
	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
	TLNN	T1,DVTTY	;...

	TLNN	T1,DVMTA	;....
	JRST	RTM1##		;ERROR RETURN
	HLRZ	U,TDVUDB##(F)	;SET UP UDB PNTR
	MOVE	T1,TUBCRD##(U)	;SEE IF ANY READS OR WRITES
	IOR	T1,TUBCWR##(U)	;SINCE LAST UNLOAD
	JUMPE	T1,MTARIX	;OK IF ZERO
	PUSHJ	P,TPDCPY	;NO - COPY TO SHADOW AREA
	LDB	T1,PJOBN##	;GET OWNING JOB #
	CAME	T1,J		;IS IT US?
	JUMPN	T1,MTARIX	;OK IF NO ERROR
	MOVEI	T1,.ERTPS	;SET UP CODE FOR DAEMON
	HRL	T1,F		;GET DDB ADDRESS FOR DAEMON
	PUSHJ	P,DAERPT##	; WAKE DAEMON

MTARIX:	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
	HLRZ	U,TDVUDB##(F)	;SET U := UDB ADDRS
	PUSHJ	P,GETDEN	;GET CURRENT DENSITY
	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

;ROUTINE TO SAVE DAEMON INFO IN SHADOW AREA AND CLEAR
;STATISTICS BLOCK FOR MOUNT OR UNLOAD PROCESSING

TPDCPY:	HRLI	T2,TUBRID##(U)	;GEN COPY PNTR
	HRRI	T2,TUBDDA##(U)	;  TO DAEMON DUMP AREA
	BLT	T2,TUBDDE##(U)	;...
	SETZM	TUBRID##(U)	;NOW CLEAR AREA
	HRLI	T2,TUBRID##(U)	;GEN CLEAR PNTR
	HRRI	T2,TUBRID##+1(U)
	BLT	T2,TUBCLE##(U)	;END OF AREA TO CLEAR
	POPJ	P,		;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
	HLRZ	U,TDVUDB##(F)	;SET UP UDB PNTR
	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:	JUMPE	P2,TAPDN1	;TEST FOR DEFAULT DENSITY
	MOVEI	T3,TUCD20##	;GET LOWEST DENSITY
	LSH	T3,-1(P2)	;CONVERT DENSITY TO BIT POSITION
	TDNN	T3,TUBCNF##(U)	;SETTING VALID DENSITY?
	  PJRST	ECOD15##	;NO, ERROR
TAPDN1:	DPB	P2,0(P3)	;SET THE DENSITY
IFN FTTLAB,<
	MOVE	T1,P2		;IF TAPE LABELING
	PUSHJ	P,SETODN	; THEN SET OTHER DDB
>
	JRST	CPOPJ1##	;RETURN OK
;
;SET LABEL TYPE
IFN FTTLAB,<
TAPLBT:	DPB	P2,TUYLTP	;SET THE LABEL TYPE
	HRRZ	T1,TUBDDB(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
	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
>
IFE FTTLAB,<				;;; DUMMIES
	0				;15
	0				;16
	0				;17
	0				;20
	0				;21
	0				;22
>
	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
>
IFE FTTLAB,<				;;; DUMMIES
	0				;1024
	0				;1025
	0				;1026
>
	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
>
IFE FTTLAB,<
	0			;1033 - DUMMY
>
TAPLN1==.-TAPTB1
;RANGE TABLE FOR TAPOP UUO

TAPSRT:	0,,5			;1 - DENSITY
	NOISEW##,,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

;SPECIAL RANGE TABLE FOR BLOCK SIZE, INDEXED BY KONTROLLER TYPE
BSZTBL:	377777			;K.TMA (TM10A)
	16K			;K.TMB (TM10B)
	16K			;K.TC1 (TM10C)
	377777			;K.TX1 (TX01)
	16K			;K.TM2 (TM02)
	16K			;K.TM2H (TM02/RH11)
	16K			;K.DX2 (DX20)
	16K			;K.T78 (TM78)
IFN	K.MAX+1-<.-BSZTBL>,<
PRINTX	%NEED TO DEFINE A NEW TAPE BLOCKSIZE MAXIMUM IN BSZTBL
>
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)	
	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?
	  MOVEI	T1,K.TM2	;NO, ASSUME A SMALL ONE
	CAMLE	P2,BSZTBL(T1)	;OK FOR THIS KONTROLLER TYPE?
	  PJRST	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##(U)	;BASE ADDRS OF STATS
TAPOPL:	MOVE	T1,0(P1)	;FETCH WORD
	PUSHJ	P,PUTWR1##	;STORE IN USER AREA
	  JRST	RTM1##		;OUT OF BOUNDS
	AOBJN	P1,TAPOPL	;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
	ADDI	P1,0(U)		;RELOCATE 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
	JRST	TAPOPL		;JOIN COMMON CODE
;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
>
	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:	MOVEI	T1,WRTDUN	;WHERE TO GO ON COMPLETION
	HRRZM	T1,TRBIVA(P1)	;SAVE IT
	MOVEI	T1,DSETIM##	;SET A LONG HUNG TIMER GOING
	MOVEM	T1,TKBTIM##(W)	; TO CATCH PROBLEMS (SINCE IOACT=0)
	PJRST	TPSTRT		;GO START THE OPERATION

;HERE ON KONTROLLER AVAILABLE

TPMDE1:	MOVEI	T1,^D14		;SET COUNT
	HRRM	T1,TRBXCW(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
>
	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#
	SKIPE	T1		;ANY OWNER?
	CAMN	T1,J		;OR WE OWN IT?
	JRST	TPLBG1		;YES, GIVE IT TO CALLER
	JRST	ECOD14##	;SOMEONE ELSE OWNS IT

TPLBGA:	MOVEI	T2,SPROTO	;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,LPROTO	;LOC IF PROTOTYPE
	BLT	T1,SPROTO-1(F)	;MOVE INTO PLACE
	POP	P,DEVNAM(F)	;GIVE IT A NAME
	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,TDVKDB##(P1)	;GET UDB / KDB PNTRS
	MOVEM	T1,TDVKDB##(F)	;INTO NEW DDB
	MOVE	T1,TDVSTS##(P1)	;GET PAR/DEN/MODE, USERS SET
	MOVEM	T1,TDVSTS##(F)	; AND STORE IN LABEL DDB
	HRLM	F,TUBDDB##(U)	;LINK TO SECONDARY PNTR IN UDB
	TAPOFF			;FIGHT RACE
	MOVSI	T1,TUBQUE##(U)	;AND SET UP NEW EMPTY QUEUE
	EXCH	T1,TUBQUE##(U)	;EXCHANGE PNTRS
	MOVEM	T1,TDVSVQ(F)	;SAVE IN NEW DDB
	TAPON			;OK NOW
	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:	HLRZ	P1,TUBDDB##(U)	;2ND DDB ADDRS
	JUMPE	P1,TPLBR1	;OK IF NO DDB
	HRRZS	TUBDDB##(U)	;CLEAR SECONDARY DDB
TPLBR1:	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	P2,T2		;SAVE PREDECESSOR
IFN FTPI,<
	PUSH	P,F		;SAVE TAPE LABELER'S DDB
	HLRZ	T1,TDVUDB##(F)	;POINT TO THE TUB
	HRRZ	F,TUBDDB##(T1)	;AND NOW THE REAL DDB
	PUSHJ	P,PSIRSW##	;SIGNAL THE REEL SWITCH
	POP	P,F		;AND ITS DDB
> ;END IFN FTPI
	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
	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
	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
	EXCH	F,P1		;CONFUSE THINGS
	PUSH	P,J		;SAVE J
	LDB	J,PJOBN##	;REAL OWNERS JOB #
	PUSHJ	P,SETDVL##	;FIX UP LOGICAL NAME TABLE
	EXCH	F,P1		;PUT THINGS BACK
	POP	P,J		;...
				;FALL INTO TPLSU1
TPLSU1:	HLRZ	T1,DEVSER(P1)	;SUCCESSOR TO 1ST UNIT
	HLRZ	T2,DEVSER(F)	;SUCCESSOR TO 2ND UNIT
	DDBSRL			;DONT LET ANY OTHER CPU SCAN CHAIN
	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)
	MOVEI	T1,GTLEN##-1	;GET LENGTH OF TABLE
TPLSU2:	HRRZ	T2,GENTAB##(T1)	;GET ADDR OF THIS GENERIC DDB
	CAIN	T2,(F)		;IS 1ST DDB GENERIC ?
	HRRM	P1,GENTAB##(T1)	;YES, UPDATE NEW DDB AS GENERIC
	CAIN	T2,(P1)		;IS 2ND DDB GENERIC ?
	HRRM	F,GENTAB##(T1)	;YES, ITS THE OLD ONE NOW
	SOJGE	T1,TPLSU2
	DDBSRU			;GIVE UP INTERLOCK
	MOVE	T1,TDVKDB##(P1)	;EXCHANGE UNIT / KONTROLLER PNTRS
	EXCH	T1,TDVKDB##(F)
	MOVEM	T1,TDVKDB##(P1)
	HRRM	F,TUBDDB##(U)	;FIX UDB / DDB PNTR
	MOVE	P2,U		;OLD UDB PNTR
	HLRZ	U,TDVKDB##(P1)	;GET NEW UDB ADRS
	MOVE	T2,TUBLBL##(U)	;EXCHANGE LABEL INFO IN UDBS
	EXCH	T2,TUBLBL##(P2)
	MOVEM	T2,TUBLBL##(U)	;...
	HRRM	P1,TUBDDB##(U)	;AND SET PNTR
	MOVE	F,P1		;MAKE F POINT AT NEW DDB
	HLRZ	P1,TUBDDB##(P2)	;GET OLD SECONDARY DDB PNTR
	JUMPE	P1,CPOPJ1##	;QUIT NOW IF NONE
	MOVE	T1,TDVKDB##(F)	;GET NEW UNIT/KONTROLLE PNTR
	MOVEM	T1,TDVKDB##(P1)	;SAVE IT IN LABEL DDB
	HRLM	P1,TUBDDB##(U)	;MAKE NEW UDB HAVE SECOND DDB
	HRRZS	TUBDDB##(P2)	;AND OLD DDB HAVE NONE
	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:	HLRZ	T1,TUBDDB##(U)	;GET 2ND DDB ADDR
	JUMPN	T1,ECOD12##	;THRERE IS ONE, ERROR
	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
	SKIPN	T1		;ANY OWNER AT ALL?
	SKIPA			;WE OWN IT, OR NO OWNER
	  JRST	ECOD6##		;NO, ERROR - NOT ASSIGNED
	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
	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:
IFN FTPI,<
	SKIPE	DEVPSI##(F)	;ON THE PSI SYSTEM?
	PUSHJ	P,PSIRMV##	;YES, REMOVE IT
>
	MOVEI	T1,SPROTO	;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
	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
	HLRZ	T2,TUBDDB##(U)	;GET SECOND DDB
	CAIE	T2,(F)		;OURS
	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##(U)	;BASE OF LABEL PARAMETER AREA
	JRST	TAPOPL		;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::HLRZ	T3,TDVKDB(F)	;GET DOWN TO UDB
	HLRZ	T2,TUBDDB(T3)	;GET LABEL DDB ADDRESS
	JUMPE	T2,CPOPJ##	;NO OTHER, DON'T BOTHER
	CAIN	T2,(F)		;SET DENSITY ON LABEL DDB
	HRRZ	T2,TUBDDB(T3)	; GET ADDRESS OF REGULAR DDB
	SKIPN	T2		;BETTER BE ONE!
	STOPCD	CPOPJ##,DEBUG,RDN ;++ REGULAR DDB NOT FOUND
	EXCH	T2,F		;AIM AT OTHER
	DPB	T1,TDYDN1	;SET DENSITY
	EXCH	T2,F		;BACK TO NORMAL
	POPJ	P,		;BYE
>;END IFN FTTLAB
;ROUTINE TO TAKE CTL OFF-LINE AND SET MAINT MODE

TPMSMM:	HRRZ	W,TUBKDB##(U)	;GET KDB ADDRS
	MOVE	T3,TKBIUN##(W)	;GET UDB PNTR
TPMSM1:	SKIPN	T2,0(T3)	;SEE IF UNIT EXISTS
	JRST	TPMSM2		;NO - TRY NEXT
	HRRZ	F,TUBDDB##(T2)	;GET DDB PNTR
	LDB	T1,PJOBN##	;OWING JOB NUMBER
	CAME	T1,J		;IT HAD BETTER BE ME
	JRST	ECOD11##	;ELSE ERROR
TPMSM2:	AOBJN	T3,TPMSM1	;LOOP TILL ALL UNITS DONE
	CONO	PI,PI.OFF	;TURN OFF WORLD
	HLLZS	TKBCSO##(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
	MOVE	T1,TKBICP##(W)	;INFO USER WOULD LIKE
	PJRST	STOTC1##	;AND SKIP RETURN

;ROUTINE TO RESTORE CTL AND CLEAR MAINT MODE

TPMCMM:	HRRZ	W,TUBKDB##(U)	;GET KDB PNTR
TPMCM1:	HRRZ	T4,TKBJOB##(W)	;DOES THIS JOB HAVE KONTROLLER?
	CAIE	T4,(J)		;?
	JRST	ECOD11##	;NO - LOSE
	HLLZS	TKBJOB##(W)	;YES, HE DOESN'T ANY MORE
	HRRZ	T4,TKBDSP##(W)	;ADDRS OF CTL DEP CODE
	PUSHJ	P,@TPKINX##(T4)	;DISPATCH TO LOWER LEVEL INIT
	MOVSI	T1,TKSMNT##	;BIT TO CLEAR NOW
	ANDCAM	T1,TKBSTS##(W)	; IN KDB
	PJRST	CPOPJ1##	;AND RETURN

;ROUTINE CALLED ON TAPE ON-LINE
TPMONL::
IFN FTMDA,<
	PUSH	P,W		;IPCSER WIPES W
	HRRZ	T1,TUBDDB##(U)
	MOVE	T1,DEVNAM(T1)	;SIXBIT NAME
	MOVEI	T2,.TYMTA/.TYEST ;A MAGTAPE
	PUSHJ	P,SNDMDC##	;TELL MDC
	  JFCL
	POP	P,W		;RESTORE W
>; END IFN FTMDA
IFN FTPI,<
	PUSH	P,F		;SAVE F
	HRRZ	F,TUBDDB##(U)	;GET DDB
	PUSHJ	P,PSIONL##	;TELL PSISER
	POP	P,F		;RESTORE F
>; END IFN FTPI
	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	TUBSRE##(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
	PJRST	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
>
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
	HRRM	P3,TRBIVA(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
	HRRZ	T1,TRBIVA(P1)	;GET ROUT ADDRS
	JUMPN	T1,0(T1)	;DO SPECIAL ROUTINE
MTAPG1:	MOVEI	T1,1		;ONE OP ONLY
MTAPGO:	HRRM	T1,TRBXCW(P1)	;...
	MOVEI	T1,TPMISP	;WHERE TO GO WHEN DONE
MTAPG2:	HRRZM	T1,TRBIVA(P1)	;SAVE IT
	MOVEI	T1,TAPTIM##	;SET A HUNG TIMER GOING
	MOVEM	T1,TKBTIM##(W)	; (NOT DEVCHK SINCE IOACT=0)
	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.FSR,,TPMFSF		;16-FORWARD SKIP FILE
	RB.FBR,,TPMBSF		;17-BACKWARD SKIP FILE

;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,TRBXCW(P1)	;STORE FOR DRIVER
TPMWR1:	MOVEI	T1,WRTDUN	;WHERE TO GO
	JRST	MTAPG2		;START OP

;HERE WHEN DONE (CHECK ERRORS)

WRTDUN:	SETZM	TKBTIM##(W)	;CLEAR HUNG TIMER
	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:	SETZM	TKBTIM##(W)	;NO LONGER HAVE MTAPE GOING
	PUSHJ	P,SETIOS	;SET UP S
	  JSP	P2,SPERR	;HANDLE SPACING ERROR
	PUSHJ	P,TPMRIO	;RETURN IORB
	HLLZS	TKBSTS##(W)	;CLEAR KON STATUS
	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
	CAIE	T1,MT.DEC	;IS IT DEC MODE?
	JRST	TPSETI		;NO - SET INDUSTRY COMPAT
	MOVEI	T2,RB.MCD	;YES - SET NORMAL MODE
	DPB	T2,TDYMOD	;SET IN MODE FIELD OF DDB
	POPJ	P,		;RETURN

;HERE TO SET INDUSTRY COMPATIBLE MODE (WHATEVER THAT IS)

TPSETI:	MOVEI	T1,COMPAT	;SET BYTE IN STATUS WORD
	DPB	T1,TDYBYT
	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 FTKL10&FTMP,<
	SETZM	DEVNBF(F)
	SETZM	DEVSBF(F)
>
	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##
TPMRW1:	TRO	S,IOBOT		;SET BOT
	MOVSI	T1,TKSOFL##
	TDNN	T1,TUBSTS##(U)	;CHECK OFF-LINE
	PJRST	STOIOS##
	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
	HLRZ	P2,TDVUDB(F)	;GET UDB ADDRESS
	HRRZ	P1,TUBDDB(P2)	;GET DDB ADDRESS
	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?
	LDB	J,PJOBN##	;GET CORRECT J
	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,TPDCPY	;COPY STATS TO SHADOW AREA
	MOVEI	T1,.ERTPS	;SET UP CODE FOR DAEMON
	HRL	T1,F		;SET UP DDB FOR DAEMON
	PUSHJ	P,DAEDSJ##	;PROD DAEMON

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 AS MULTIPLE SKIP RECORDS

TPMFSF:	PUSHJ	P,TPSKPS	;CALL SKIP SET
				;RETURN WITH S SETUP
	TRNE	S,IODEND!IODERR	;SEEN EOF OR DEVICE ERROR?
	POPJ	P,		;RETURN
TPMFS0:	MOVEI	T1,MT.FSF	;GO 'ROUND AGAIN
	JRST	MTAP		;...

;ROUTINE TO PERFORM BACKSPACE FILE
;USES MULTIPLE BACKSPACE RECORDS UNTIL BOT OR EOF IS SEEN

TPMBSF:	PUSHJ	P,TPSKPS	;CALL SKIP SET
				;RETURN WITH S SETUP
	TRNE	S,IODEND!IOBOT!IODERR
	POPJ	P,		;RETURN
	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
IFE FTKS10,<
;ENTER WITH P1=NO OF ARGS,  P2=FUNCTION,  P3 AVAILABLE
MTADIA::MOVE	P3,W
	HRRZ	W,TUBKDB##(U)
	JRST	@TPDFNC(P2)

TPDFNC:	TPDCLR			;(0)ENTRY FROM ^C
	TPDASU			;(1)ASSIGN SINGLE UNIT
	TPDAAU			;(2)ASSIGN ALL UNITS
	TPDRCU			;(3)RELEASE CHAN AND ALL UNITS
	TPDSCP			;(4)SPECIFY CHANNEL PROGRAM
	TPDRCP			;(5)RELEASE CHAN PROGRAM
	TPDGCS			;(6)GET CHAN STATUS
	TPDKUN			;(7)GET KONTROLLER AND UNIT
	CPOPJ##			;(10)ILLEGAL
	CPOPJ##			;(11)ILLEGAL
	TPDSCR			;(12)SPECIFY CHAN PROGRAM FOR REVERSE READ
	CPOPJ##			;(13)ILLEGAL
	CPOPJ##			;(14)ILLEGAL
	CPOPJ##			;(15)STOP I/O ON KON (DISPATCHED SEPARATELY)
	CPOPJ##			;(16)START I/O ON KON (  "		"  )
	TPDELD			;(17) ENABLE MICROCODE LOADING
	TPDDLD			;(20) DISABLE MICROCODE LOADING
	TPDLOD			;(21) LOAD MICROCODE
	CPOPJ##			;(22) ILLEGAL FOR TAPE
	CPOPJ##			;(23) ILLEGAL FOR TAPE
MXDIAG==:.-TPDFNC

ERCODE	DIANPV,1		;NOT ENOUGH PRIVS
ERCODE	WRONGN,2		;ILLEGAL NUMBER OF ARGS
ERCODE	ILLKON,3		;ILLEGAL CONTROLLER NUMBER
ERCODE	ILLUNI,4		;ILLEGAL UNIT NUMBER
ERCODE	DIUNAA,5		;SOME UNITS ALREADY ASSIGNED
ERCODE	UNNDMD,6		;UNIT NOT IN DIAG MODE
ERCODE	UNAAJB,7		;UNIT ASS'D TO ANOTHER JOB
ERCODE	DINEFC,10		;NOT ENOUGH FREE CORE
ERCODE	NOASUN,11		;NO ASSIGNED UNITS
ERCODE	IOWCPB,12		;IOWD CROSSES PAGE BOUNDARY
ERCODE	BADFNC,13		;BAD FUNCTION
ERCODE	DIAVRT,14		;JOB IS VIRTUAL
ERCODE	DIANSC,15		;NO SUCH CPU
ERCODE	DIACNR,16		;CPU NOT RUNNING
ERCODE	DIABAL,17		;SOME ARGUMENT IS ILLEGAL
ERCODE	DIAMRF,23		;MICROCODE LOAD ERROR
ERCODE	DIAMNA,24		;MICROCODE NOT AVAILABLE
; ENABLE/DISABLE MICROCODE LOADING
TPDDLD:	TDZA	T1,T1		;DISABLE
TPDELD:	MOVEI	T1,1		;ENABLE
	HRRZ	T2,TKBDSP##(W)	;GET DISPATCH TABLE
	PUSHJ	P,@TPKEDL##(T2)	;TOGGLE THE BIT
	  JRST	DIAMNA		;MICROCODE NOT AVAILABLE
	JRST	CPOPJ1##	;RETURN


; LOAD MICROCODE
TPDLOD:	HRRZ	T2,TKBDSP##(W)	;GET DISPATCH TABLE
	PUSHJ	P,@TPKLOD##(T2)	;LOAD MICROCODE
	  JRST	DIAMRF		;COULDN'T
	JRST	CPOPJ1##	;RETURN
;HERE TO ASSIGN SOME UNIT
TPDASU:	JUMPN	F,DIUNAA
	PUSHJ	P,TPDTST
	  POPJ	P,
	MOVEM	T1,TUBCNF##(U)
	JRST	TPDHVF

;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	DIANPV				;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	ILLUNI	]		;DONE
	HRRZ	W,TDVKDB##(F)			;POINT TO KDB
	SETZ	F,				;**NOT AN I/O UUO***
	JUMPE	W,ILLUNI			;?NO KDB?
;FALL INTO TPDKI0

TPDKI0:	SYSPIF
	HLRZ	T1,TKBJOB(W)			;GET MAINTENANCE JOB
	CAIE	T1,(J)				;IS IT ME?
	JUMPN	T1,[SYSPIN			;NO
		    JRST	UNAAJB	]	;SOMEONE ELSE ALREADY
	HRLM	J,TKBJOB##(W)			;IT'S US NOW
	SYSPIN
	MOVSI	T1,TKSNS##
	IORM	T1,TKBSTS##(W)
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,TKBIUN##(W)			;GET UDB POINTERS
	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:	AOBJN	P1,TPDKI3			;CHECK NEXT
	JRST	CPOPJ1				;DONE

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

TPDKI6:	SKIPA	W,CNFMTK##
TPDKI7:	HRRZ	W,TKBKDB##(W)
	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 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	DIANPV				;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	ILLUNI	]		;CAN'T FIND DEVICE
	HRRZ	W,TDVKDB##(F)			;GET KDB
	SETZ	F,				;**DON'T OWN THIS DDB**
	JUMPE	W,ILLUNI			;NO SUCH DEVICE

TPDSI0:	HLRZ	T1,TKBJOB##(W)			;GET MAINTENACE OWNER
	CAIE	T1,(J)				;IS IT ME?
	JRST	UNAAJB				;OWNED BY SOMEONE ELSE
	MOVSI	T1,TKSNS##
	ANDCAM	T1,TKBSTS##(W)
	HRRZS	TKBJOB##(W)			;WE DON'T ANY MORE
	AOS	(P)
IFN FTMP,<
	LDB	T1,TKYCPU##			;GET CPU # KON IS ON
	PUSHJ	P,ONCPUS##			;GET ON THE RIGHT CPU
	  POPJ	P,				;OH WELL NO I/O TO START
>;END IFN FTMP
	HRRZ	T1,TKBDSP##(W)			;CLANK SCHED TO LOOK
	PJRST	@TPKSCH##(T1)

TPDSIA::
	SKIPA	W,CNFMTK##
TPDSI6:	HRRZ	W,TKBKDB##(W)
	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:	JUMPN	F,DIUNAA
	MOVE	T3,TKBIUN##(W)
TPDAA1:	SKIPE	U,(T3)
	PUSHJ	P,TPDTST
	  JUMPN	U,CPOPJ##
	AOBJN	T3,TPDAA1
	MOVE	T3,TKBIUN##(W)
	MOVEI	T1,TUCDIG##
	SKIPE	U,(T3)
	IORM	T1,TUBCNF##(U)
	AOBJN	T3,.-2
	MOVE	U,TKBIUN##(W)
	MOVE	U,(U)
TPDHVF:	SKIPN	DIATAP##
	JRST	TPDSCH
	MOVEI	T1,2
	PUSHJ	P,SLEEPF##
	JRST	TPDHVF
TPDSCH:	HRROM	F,.PDDIA##(P3)
	HRRZM	T1,DIATAP##
	MOVEI	P2,RB.FYB
	PUSHJ	P,GENIOR
	  JRST	DINEFC
	MOVEM	T1,TDVIOR##(F)
	PUSHJ	P,SETACS	;QUEUE UP THE IORB
	PUSHJ	P,TAPRQT##
	MOVSI	T1,TKSOFL##
	ANDCAM	T1,TKBSTS##(W)
	PUSHJ	P,KONWAT
	MOVSI	T1,NSWP!NSHF
	IORM	T1,JBTSTS##(J)
	PUSHJ	P,GETWDU##
	HLLZ	T2,T1		;GET KONTROLLER DEVICE CODE
	LSH	T2,-3
	TLO	T2,(CONO)	;MAKE A CONO DEV,0
	XCT	T2		; AND EXECUTE IT
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN

;PRESERVES T3
TPDTST:	HRRZ	F,TUBDDB##(U)
	MOVE	T1,TUBCNF##(U)
	TRNN	T1,TUCDMS##	;DIAGNOSTIC MODE?
	JRST	UNNDMD
	LDB	T2,PJOBN##
	CAME	T2,.CPJOB##
	JUMPN	T2,UNAAJB
	TROE	T1,TUCDIG##
	JUMPE	T2,UNAAJB	;ASS'D TO ANOTHER JOB
	JRST	CPOPJ1##


;HERE ON ^C, HALT, EXIT, ETC   WITH F=DIAGING DDB
TPDCLR:	HLRZ	U,TDVKDB##(F)
	HRRZ	W,TDVKDB##(F)
	SOS	(P)

;HERE TO RELEASE ALL UNITS
TPDRCU:	JUMPE	F,CPOPJ1##
	PUSHJ	P,TPDRCX
	MOVEI	T1,TUCDIG##
	MOVE	T2,TKBIUN##(W)
	PUSH	P,U
TPDRC1:	SKIPE	U,(T2)
	TDNN	T1,TUBCNF##(U)
	JRST	TPDRC2
	MOVE	F,TUBDDB##(U)
	LDB	T3,PJOBN##
	CAMN	T3,J
	ANDCAM	T1,TUBCNF##(U)
TPDRC2:	AOBJN	T2,TPDRC1
	POP	P,U
	SETZM	.PDDIA##(P3)
	SETZM	DIATAP##
	HRRZ	T1,TUBQUE##(U)
	JUMPE	T1,CPOPJ1##
	PUSHJ	P,TPMFLS	;GIVE UP IORB, START SOME OTHER TAPE
	JRST	CPOPJ1##

;HERE TO SET UP A CHANNEL PROGRAM
TPDSCR:	TLO	W,-1		;READ REVERSE - SET A FLAG
TPDSCP:	JUMPE	F,NOASUN	;NO ASS'D UNITS
	PUSHJ	P,TPDRCX	;RETURN ANY IOWD
	PUSHJ	P,GETWD1##	;GET IOWD
	HLRE	T2,T1		;LENGTH OF IOWD
	JUMPE	T2,IOWCPB	;TOO BIG IF 0
	SKIPGE	W		;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	IOWCPB		;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	DINEFC		;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	DINEFC
	HRRZ	T3,TRBXCW(T1)
	HRRZ	T1,TKBICP##(W)
	MOVE	T2,TKBCDB##(W)
	MOVE	T2,CHB22B##(T2)
	TLNE	T2,CP.RH2##
	TLO	T3,RH2JMP##
	MOVEM	T3,(T1)
	PUSHJ	P,STOTAC##	;TELL USER ICWA
IFN FTKL10,<
	JUMPGE	W,TPDSC2	;REVERSE?
	TLZN	T3,RH2JMP##	;YES, RH20 - DEVICE?
	JRST	TPDSC2		;CAN'T REVERSE LIST
	HLRE	T2,P3	;REVERSE IT
	MOVNS	T2
	PUSHJ	P,REVCCD##
TPDSC2:	PUSHJ	P,CSDMP##	;SWEEP CACHE
>
	JRST	CPOPJ1##	;AND TAKE GOOD RETURN

;HERE TO RETURN A CHANNEL PROGRAM
TPDRCP:	JUMPE	F,CPOPJ1##
	AOS	(P)
TPDRCX:	HRRZ	T2,TUBQUE##(U)
	JUMPE	T2,CPOPJ##
	HRRZ	T1,TRBXCW(T2)
	HLLZS	TRBXCW(T2)
	JUMPN	T1,RTNIOW##
	POPJ	P,

;HERE TO TELL USER FINAL CHANNEL STATISTICS
TPDGCS:	JUMPE	F,CPOPJ1##
	MOVE	P2,TKBICP##(W)
	PJRST	DIAGCS##

;ROUTINE TO GET CONTROLLER/UNIT NUMBERS
TPDKUN::HLRZ	U,TDVUDB##(F)	;UNIT
	HRRZ	T1,TUBKDB##(U)	;GET ADDRESS OF KDB
	LDB	T2,[POINT 7,TKBCSO##(T1),9] ;GET DEVICE CODE
	HLRE	T1,TKBUNI##(T1)	;UNIT
	SKIPGE	T1		;MULTI UNIT?
	TDZA	T1,T1		;NO, JUST USE SLAVE ADDR
	LSH	T1,3		;YES. SHIFT
	ADD	T1,TUBADR##(U)	;ADD IN SLAVE 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:
IFN FTKL10,<
	HRRZ	T1,TDVKDB##(F)	;POINT TO KON
	MOVE	T1,TKBSTS##(T1)	;GET STS
	TLNE	T1,TKSNS	;CONFIG DOING ITS THING?
	  JRST	TPMHOK		;DON'T REALLY HANG IT THEN
>
	HLRZ	U,TDVUDB##(F)	;GET UNIT PNTR
	SKIPN	T1,TUBQUE(U)	;GET HEAD OF IORB QUEUE
	JRST	TPMHN0		;NONE?
	HLRZ	T1,TRBLNK(T1)	;GET BITS
	MOVE	T2,TUBSTS##(U)	;AND UDB BITS
	TRNE	T1,RB.AIO!RB.PCL;IS THIS AN ASYNCH OR QUEUED REQ?
	TLNE	T2,TKSSEL##!TKSSTD##;YES, IS IT SELECTED/STARTED?
	JRST	TPMHN0		;NO OR YES&YES
	LDB	T1,TDYHNG	;# OF TIMES HUNG
	SOJLE	T1,TPMHN0	;TOO MANY, HANG IT ANYWAY
	DPB	T1,TDYHNG	;STORE OLD COUNT
TPMHOK:	AOS	(P)		;ELSE DON'T HANG IT YET
	PJRST	SETHNG##	;AND RESET TIMER
TPMHN0:
	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,TOCPU##	;GET ONTO OWNING CPU
>
TPMDQ1:	CAIN	P1,TKBERB##(W)	;CHECK FOR ERROR IORB
	JRST	[HRRZ P2,TRBLNK(P1)	;TRY NEXT IF IT IS
		 JRST TPMDQ2]	;CHECK DONE
	PUSHJ	P,TPMRCW	;RETURN XFER LIST IF ANY
	MOVE	T2,P1		;SET FOR GIV4WD
	MOVEI	T1,1		;ONE BLOCK
	HRRZ	P2,TRBLNK(P1)	;GET LINK
	PUSHJ	P,GIV4WD##	;RETURN IORB
TPMDQ2:	SKIPE	P1,P2		;CHECK FOR MORE
	JRST	TPMDQ1		;YES - RETURN IT
	POPJ	P,		;DONE - EXIT
;HERE FROM GIVRES IN ERRCON

TPFREE::SKIPN	CNFMTK##	;ANY TAPES AT ALL ON SYSTEM?
	POPJ	P,		;NO, GO AWAY
	MOVEI	F,MT0DDB##	;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
	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,CNFMTK##	;START AT FIRST KONTROLLER
	PUSH	P,M
	TLO	M,400000
TPFRE3:	PUSHJ	P,TPMCM1	;RELEASE MAINT MODE IF SET
	  JFCL
	HRRZ	W,TKBKDB##(W)	;NEXT KONTROL
	JUMPN	W,TPFRE3	;TEST IT IF THERE
	POP	P,M
	PJRST	UPOPJ##		;DONE IF NONE LEFT

TPMHLD::HLRZ	U,TDVUDB##(F)	;SET UP UDB PNTR
	HRRZ	W,TUBAKA##(U)	;AND KDB IF SELECTED
IFN FTTLAB,<
	HLRZ	T1,TUBDDB##(U)	;CHECK 2ND DDB
	JUMPE	T1,TPHLD1	;IF NONE THEN OK
	CAIE	T1,(F)		;IS THIS OURS
	POPJ	P,		;NO - THEN EXIT
>
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,TKBNAM##(P2)	;NAME
	ADD	T2,['A'-'0',,0]
	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
	SUB	T1,['A'-'0',,0]	;ADJUST FOR CTL NAME
	PUSH	P,W		;SAVE W
	SKIPN	W,CNFMTK##	;GET FIRST KDB
	JRST	TPMSLX		;NO TAPES ANYWHERE
TPMSLL:	CAMN	T1,TKBNAM##(W)	;THIS ONE?
	JRST	TPMSL1		;YES - SET BIT
	HRRZ	W,TKBKDB##(W)	;NO - LINK TO NEXT
	JUMPN	W,TPMSLL	;CHECK NEXT IF IT EXISTS
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::
IFE FTAUTC,<
	HLRZ	T1,MT0KDB##+TKBCDB## ;ALREADY SET UP CHANNEL RING?
	JUMPN	T1,TPMINO	;YES (FOR 1ST MAGTAPE DDB). LEAVE ALONE
	SKIPE	.CPAID##	;BEEN HERE BEFORE?
	JRST	TPMINO		;YES. DON'T NEED TO DO THIS AGAIN
	MOVEI	W,MT0KDB##	;NO. START AT 1ST KDB IN SYSTEM
	MOVE	T4,W
TPMINN:	SKIPN	T1,TKBKDB##(W)	;NEXT KDB
	MOVE	T1,T4
	MOVE	T2,TKBCDB##(T1)	;ITS CHANNEL
	CAME	T2,TKBCDB##(W)	;SAME CHAN AS THIS?
	EXCH	T1,T4		;NO. POINT AT 1ST KDB ON CHAN
	HRLM	T1,TKBCDB##(W)	;POINT AT NEXT (OR 1ST) KDB ON THIS CHAN
	MOVE	W,TKBKDB##(W)	;STEP TO NEXT
	JUMPN	W,TPMINN	;GO SET UP ITS LH(TKBCDB)
>
TPMINO:	HRRZ	W,TDVKDB##(F)	;GET ADDRS OF KDB
	HRRZ	T4,TKBDSP##(W)	;GET KONTROLLER SERVICE ROUT ADDRS
	SKIPN	.CPAID##	;DEVICES ALREADY INITIALIZED ONT HIS CPU?
	PUSHJ	P,@TPKINI##(T4)	;NO, DO FULL INITIALIZATION
	SKIPE	.CPAID##
	PUSHJ	P,@TPKINX##(T4)	;ELSE DO SECONDARY INITIALIZATION
TPMINQ:	LDB	T2,PUNIT##	;GET UNIT #
	ADDI	T2,TKBUDB##(W)	;PLUS INDEX INTO TABLE
	HRRZ	U,(T2)
	HRLM	U,TDVUDB##(F)	;STASH IN DDB
	HRRZM	F,TUBDDB##(U)	;PNTR TO DDB
	MOVEI	T1,TUBQUE##(U)	;QUEUE HEADER ADDRS
	HRLZM	T1,TUBQUE##(U)	;INITIATE EMPTY QUE
	HLRZ	F,DEVSER(F)	;PEEK AT NEXT DDB
	JUMPE	F,CPOPJ##
	MOVSI	T1,DVMTA	;CHECK FOR MTA
	TDNN	T1,DEVMOD(F)	;IS IT
	POPJ	P,		;NO -RETURN
	HRRZ	T1,TDVKDB##(F)	;YES - SEE IF SAME KDB
	CAMN	T1,W		;IS IT?
	JRST	TPMINQ		;YES - LOOP TO NEXT
	HRLZ	P3,F		;FAKE OUT IOGO
	POPJ	P,
;OUTPUT ERROR DETECTED - CHECK FOR WRITE LOCK

DMPERR:				;DUMP MODE ERRORS
OUTERR:	TRNE	S,IOIMPM	;WRITE LOCKED?
	JRSTF	@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
>
	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

TPEMOV::LDB	T4,TUYKTP##	;GET KONTROLLER TYPE
	TRNN	T1,RB.SRE	;LEAVE IEP ALONE IF RECOVERED
	CAIN	T4,K.DX2	;IF A DX20, DON'T COPY
	JRST	INPER1		;SINCE TD2KON DOESN'T USER TUBIEP
	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
INPER1:	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,
;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
>
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)	;
	MOVEI	T1,.ERTAP	;INDICATE TAPE ERROR
	LDB	T2,TUYKTP##	;GET KONTROLLER TYPE
	CAIN	T2,K.DX2	;THIS A DX20?
	MOVEI	T1,.ERDXE	;YES, MAKE IT A DX20 DEVICE ERROR INSTEAD
	HRL	T1,F		;WITH DDB
	PUSHJ	P,DAEERR##	;GO TELL DAEMON

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
	HRRZ	T1,TKBCDB##(W)	;GET CDB
	MOVE	T2,CHNNUM##(T1)	;GET CHANNEL ERROR BITS
	TLNN	T2,IOCHMP!IOCHNX ;WERE THERE ANY MEMORY ERRORS?
	JRSTF	@P2		;NO--RETURN
	HLLZ	T3,.CHCSR(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
	JRSTF	@P2		;RETURN
TPELOG::	MOVEI	T1,.ERTAP	;CODE FOR DAEMON
	LDB	T2,TUYKTP##	;GET KONTROLLER TYPE
	CAIN	T2,K.DX2	;THIS A DX20?
	MOVEI	T1,.ERDXE	;YES, MAKE IT A DX20 DEVICE ERROR INSTEAD
	HRL	T1,F		;SET UP DDB ADDR FOR DAEMON
	PJRST	DAEERR##	;LOG IT

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&FTKL10,<
	PUSH	P,T1		;SAVE ADDRESS
>
	XCT	P2		;CLANK INSTR
IFE FTMP&FTKL10,<
	JRST	CPOPJ1##	;RETURN & SKIP OVER INSTR
>
IFN FTMP&FTKL10,<
	EXCH	T1,(P)		;SAVE T1, GET ADDR
	PUSHJ	P,OUCHE##	;SWEEP THAT LOC OUT OF CACHE
	JRST	TPOPJ1##	;SKIP XCT'D INSTR AND RETURN
>

;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,1		;ONLY WANT ONE
	PUSHJ	P,GET4WD##	;GET 4 WORDS
	  POPJ	P,		;SIGH
	MOVEI	T2,RB.RPN	;REQUEST PENDING
	ROT	T2,-RB.RQP-1	;PUT IN PROPER PLACE
	MOVEM	T2,TRBLNK(T1)	;STASH
GNIOR1:	DPB	P2,PRBFCN##	;AND FUNCTION
	LDB	T2,TDYBYT	;GET MODE/PAR/DEN
	DPB	T2,PRBBYT##	;SET INTO IORB
	SETZM	TRBSTS(T1)	;CLEAR REST OF BLOCK
	SETZM	TRBRCT(T1)
	SETZM	TRBIVA(T1)	;...
	JRST	CPOPJ1##	;GIVE GOOD RETURN
;ROUTINE TO SET UP CURRENT IORB

STOIOR:	ROT	T2,-RB.RQP-1	;POSITION STATUS
	HLLM	T2,TRBLNK(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)	; DONT CALL MSEEP
	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
	HRRZ	W,TUBAKA##(U)	;SET UP W - KDB ADDRS
	CAME	P1,TDVIOR##(F)	;THIS THE RIGHT ONE?
	JRST	KONWT2		;NO - SNOOZE SOME MORE
	SETZM	TDVIOR##(F)	;CLEAR THIS ONE NOW
	POPJ	P,		;RETURN
KONWT2:	CAIE	P1,TKBERB##(W)	;IS IT THE ERP IORB (NEVER HAS IVA)
	SKIPE	TRBIVA(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
	PUSHJ	P,CPURQH##	;PUT AT HEAD OF Q
	PUSHJ	P,KONWTN	;WAIT FOR SELECTION
				;RETURN P1 := IORB
	MOVEI	T1,CKREWD	;GO HERE ON INTERUPT
	HRRM	T1,TRBIVA(P1)	;...
	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
	PUSHJ	P,TAPHLD##	;DON'T USE US WHILE SPEEPING
	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:	HLRZ	U,TDVUDB##(F)	;GET UNIT PNTR
IFN FTTLAB,<
	MOVSI	J,TKSSEL	;IF UNIT IS ALREADY GOING...
	TDNN	J,TUBSTS(U)	;...DON'T CHANGE TUBCUR
>;END IFN FTTLAB
	HRRM	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
>
	HRRZ	W,TUBKDB##(U)
	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
>
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:	PUSHJ	P,GETDEN	;GET CORRECT DENSITY
	DPB	T1,TDYDEN	;STORE IN DDB
	PJRST	STOIOS##	;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
	HLRZ	T1,TUBDDB##(U)	;GET 2ND DDB
	CAIE	T1,(F)		;OURS?
	SKIPN	%SITLP##	;SKIP IF OK TO SEND
	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 THIS GUY SEE EOF OR TROUBLE
	PUSHJ	P,STOIOS##	;SET NEW STATUS
	JRST	TPOPJ##		;RESTORE T1
LBLCK2:	TLZ	S,LBLNED!FSTOP	;ELSE CLEAR THESE FLAGS
	MOVEM	S,DEVIOS(F)	;...
	JRST	TPOPJ1##	;SKIP RETURN
>
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
	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
	TLO	S,LBLWAT	;WE ARE NOW WAITING FOR COMPLETION
	MOVEM	S,DEVIOS(F)
	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
	JRST	STOIOS##	;SAVE 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
	DPB	J,TUYJBN	;STORE JOB #
	MOVEI	T1,%SITLP##	;PID
	MOVEI	T2,TUBMSG##(U)	;ADDRS OF MSG
	HLL	T2,TUBMSG##(U)	;MESSAGE MSGE
	PUSHJ	P,SENDSI##	;TRANSMIT MESSAGE
	  JFCL			;IGNORE ERRORS
	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:	HLRZ	U,TDVUDB##(F)	;SET UP U
	DPB	T1,TUYINF	;SET UP MTAPE CODE
	MOVE	S,DEVIOS(F)	;SET UP STATUS
	LDB	J,PJOBN##	;SET UP JOB #
	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##

; 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
	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,<
	MOVE	T1,TKBCDB##(W)	;NO. RH20?
	MOVE	T1,CHB22B##(T1)
	TLNE	T1,CP.RH2##
	POPJ	P,		;YES, DONT SWEEP
>
	PUSHJ	P,CSDMP##	;NO, WE MUST SWEEP THE CACHE
IFN FTMP,<
	MOVMS	.CPTAP##	;TELL ONCE-A-TICK IT DOESNT HAVE TO SWEEP
>
	POPJ	P,		;RETURN
IFN FTMP,<
;ROUTINE TO PRESERVE T1, CALL CHKCPI
TAPCP:	PUSH	P,T1
TAPCP1:	PUSHJ	P,CHKCPI##	;ARE WE ALREADY ON RIGHT CPU?
	  JRST	[MOVSI	T1,TUSREW##	;WE ARE ON THE WRONG CPU.
		 TDNN	T1,TUBSTS##(U)	;ARE WE STILL DOING A REWIND
		  JRST	TPOPJ##	;NOPE - WE CAN GO AHEAD WITH OUR PCL I/O
		 PUSHJ	P,CKREW	;YEP - WAIT UNTIL IT FINISHES AND
		 JRST	TAPCP1]	;  CHECK AGAIN (MAY HAVE CHANGED)
	MOVE	T1,.CPCPN##	;YES, MAKE SURE WE STAY THERE
	PUSHJ	P,ONCPUN##
	JRST	TPOPJ1##	;AND SKIP
>
;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	TRBLNK(P1)	;ANY EXCEPTIONS?
	JRST	SETIOX		;NO - JUST STORE AND EXIT
	TRNE	T1,RB.SOL	;CHECK OFF-LINE
	PJRST	STOIOS##	;YES - HANDLE SPECIAL
	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
>
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
	PJRST	STOIOS##	;SAVE S IN DDB AND EXIT
>
IFN FTMP,<
	AOSA	(P)		;INDICATE GOODNESS
	PJRST	STOIOS##	;ERROR - SAVE S AND RETURN
	LDB	T1,PIOMOD##	;IF BUFFERED MODE
	CAIGE	T1,SD
	TRNN	S,IODEND	; IF NOT EOF
	PJRST	STOIOS##	;SAVE S IN DDB
	POPJ	P,		;EOF - DON'T STORE IODEND IN DDB
>
;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
IFN FTDX10,<
	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
>
	HRRZ	P3,TKBCDB##(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
	  POPJ	P,		;ERROR - NO FREE SPACE
IFN FTDX10,<	;THIS ONLY WORKS FOR TU70'S
;MAKE MULTI-IOWD LIST IF TU70
	MOVEI	T4,1		;AT LEAST ONE RECORD WILL BE DONE
	MOVEM	T4,TKBCNT##(W)
IFN FTKL10&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
>
MAKL0A:	TRNE	S,IOCON		;DISCONTINUOUS MODE?
	JRST	CHNDON		;YES, DONE
	MOVE	T4,TKBDSP##(W)	;DOES DEVICE SUPPORT COMMAND CHAINING?
	SKIPN	TUBCNI##(U)	; AND NO ERRORS DETECTED ON LAST XFER?
	SKIPN	TPKCMD##(T4)
	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,TKBDSP##(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 FTDX10 CONDITIONAL
;*************RACE - 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
	HRRZ	T2,TKBDSP##(W)	;WE HAVE A RECORD TO WRITE
	SKIPE	TPKCMD##(T2)	;SKIP IF NO SUPPORT FOR COMMAND CHAINING
	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:	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 FTKL10&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
>
	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
	HRR	T2,TKBDSP##(W)
	SKIPE	TPKCMD##(T2)	;SKIP IF NO SUPPORT FOR COMMAND CHAINING
	PUSHJ	P,@TPKCMD##(T2)
	  JFCL			;ALWAYS COMES BACK NON-SKIP
MAKLS5:	POP	P,P2		;RESTORE LOC OF IORB
	POP	P,(P)		;DISCARD PREVIOUS END
	AOS	TKBCNT##(W)	;ONE MORE RECORD IN THIS XFER
IFN FTKL10&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
>
	SOJA	T3,CHNLS1	;GO TEST NEXT BUFFER
;STILL IN FTDX10 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 FTDX10



	MOVE	P3,P1		;SAVE PNTR TO NEXT WORD
MAKLSX:IFE	FTKL10,<
	MOVE	T1,-6(P)	;GET ADDR OF IORB
>
IFN	FTKL10,<	;SVEUF USES MORE STACK ON KL
	MOVE	T1,-10(P)	;GET ADDR OF IORB
>
	HRRM	P2,TRBXCW(T1)	;STORE EVA OF IOLIST
	HRLM	P3,TRBEXL(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:IFE	FTKL10,<
	MOVE	P1,-6(P)	;GET ADDR OF IORB
>
IFN	FTKL10,<	;SVEUF USES MORE STACK ON KL
	MOVE	P1,-10(P)	;GET ADDR OF IORB
>
	HRRZ	T1,TRBXCW(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
IFN FTPI,<
	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,
IFE FTKS10,<
;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
	LDB	U,TUYKTP##	;UNIT 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,TRBXCW(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,RH2REV##	;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,TRBEXL(T1)	;SAVE NEW LIST END
	MOVE	T1,P2		;NOW RETURN OLD LIST
	PUSHJ	P,RTNIOW##
	PJRST	UPOPJ1##	;GIVE GOOD RETURN

>;END IFE FTKS10
;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:	TLOA	T1,-1
PCLINP:	TLOA	T1,-1
>
ASYNCO:	SKIPA	T2,[TPMOU1]	;OUTPUT
ASYNCI:	MOVEI	T2,TPMIN1	;INPUT
	HRRM	T2,TRBIVA(T1)	;SAVE IN INT VECTOR
	PUSH	P,T1		;SAVE IORB PNTR
	PUSHJ	P,CKREW		;MAKE SURE NOT REW'D
	LDB	T1,TDYHNI	;PICK UP HUNG COUNT INITIALIZATION
	DPB	T1,TDYHNG	;SET HUNG COUNT NOW
	PUSHJ	P,SETACT##	;MAKE (RAD)IOACTIVE
	POP	P,T1		;IORB
	MOVSI	T2,RB.AIO	;SPECIAL IORB
IFN FTMP,<
	SKIPGE	T1
	TLO	T2,RB.PCL
>
	IORM	T2,TRBLNK(T1)	;...
	PJRST	TAPRQT##	;QUEUE IORB, SELECT IF IDLE
;PROCESS CONTROL-T
TPMCTT::PUSHJ	P,SAVE1##	;SAVE P1
	HLRZ	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::HRRZ	F,TUBCUR##(U)	;PNTR TO DDB
	MOVSI	T2,RB.AIO	;CHECK FOR SPECIAL IORBS
	TDNE	T2,TRBLNK(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
	HRRZ	F,TUBCUR##(U)	;PNTR TO DDB
	LDB	J,PJOBN##	; J = JOB NUMBER
	LDB	T1,PRBDEN##	;GET SELECTED DENSITY
	DPB	T1,TDYDN1	;SAVE FOR ALL TO SEE
IFN FTTLAB,<
	PUSHJ	P,SETODN	;SET IN OTHER GUY, TOO!
>;IFN FTTLAB
	HRRZ	T1,TRBIVA(P1)	;GET ROUTINE ADDRS
	JUMPN	T1,0(T1)	;DIPATCH
	STOPCD	.,STOP,NIV,	;++ NULL INT VECTOR ADDRS
IFN FTTLAB,<

	SUBTTL	TAPE LABELING DDB PROTOTYPE

LPROTO:	0			;(0)  DEVNAM
	<^D5*HUNGST>,,MTSIZ##+1	;(1)  DEVCHR
	0			;(2)  DEVIOS
	TPMDSP			;(3)  DEVSER
	1023,,ASSCON+154403	;(4)  DEVMOD
	0			;(5)  DEVLOG
	0			;(6)  DEVBUF
	0			;(7)  DEVIAD
	0			;(10) DEVOAD
	0			;(11) DEVSTS
	.TYMTA!DEPLEN!DEPRAS,,0	;(12) DEVSTA
	0			;(13) DEVXTR
	0			;(14) DEVEVM
	0			;(15) DEVPSI
	0			;(16) DEVESE
	0			;(17) DEVHCW
	0			;(20) DEVCPU
	0			;(21) DEVJOB
	PHASE	DEVLSD

	0			;(22) LH = UDB PNTR
				;     RH = KDB PNTR
	0			;(23) UNIT STATUS INFO
	0			;(24) IORB TO WAIT FOR
IFN FTKL10&FTMP,<
	0			;(25) NO OF BUFFERS SWEPT FOR
	0			;(26) SAVED DEVNBF
	0			;(27) CACHE SWEEP NO. FOR ABOVE
>
IFN FTXMON,<			;(30) SECTION NUMBER FOR I/O
	0
>
	0			;(31) SAVED USER UPPER LIMIT
	0			;(32) SAVED USER LOWER LIMIT
	0			;(33) SAVED M FOR DUMP MODE
	0			;(34) REMAINDER FOR MODE 16
TDVSVQ:! 0			;(35) PLACE TO SAVE 'Q' FOR LABELING PCS

	DEPHASE
SPROTO==.-LPROTO
>
	LIT
TPMEND::!  END