Google
 

Trailing-Edge - PDP-10 Archives - BB-D868C-BM - language-sources/qsrmda.mac
There are 36 other files named qsrmda.mac in the archive. Click here to see a list.
	TITLE	QSRMDA  --  Mountable Device Manager

;
;
;                COPYRIGHT (c) 1975,1976,1977,1978,1979
;                    DIGITAL EQUIPMENT CORPORATION
;
;     THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;     AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
;     AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS
;     SOFTWARE  OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
;     OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO  TITLE  TO
;     AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;     THE INFORMATION  IN  THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE
;     WITHOUT  NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;     BY DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
;     OF  ITS  SOFTWARE  ON  EQUIPMENT  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.

	SEARCH	QSRMAC,GLXMAC,ORNMAC	;GET QUASAR SYMBOLS
	PROLOGUE(QSRMDA)	;GENERATE NECESSARY SYMBOLS
	SUBTTL	MDA STRUCTURE INTER-RELATIONSHIPS

;	!-----!     		!-----!
;	!     !     		!     !
; MDR	! MDR !<--------------->! MDR !
;CHAIN	!     !     		!     !
;	!-----!     		!-----!
;	/!\  /!\		  /!\
;	 !    !			   !
;	 !    !			   !
;	 !    !---------------!    !-------------------!
;	 !		      !			       !
;	\!/		     \!/		      \!/
;	!-----!     	     !-----!     	     !-----!
;	!     !     	     !     !     	     !     !
; VSL	! VSL !<------------>! VSL !<--------------->! VSL !
;CHAIN	!     !     	     !     !     	     !     !
;	!-----!     	     !-----!     	     !-----!
;	/!\  /!\            /!\  /!\                /!\  /!\
;	 !    !              !    !		     !    !
;	 !    !              !    !		     !    !--------------!
;	 !    !		     !    !		     !			 !    
;	 !    !		     !    !-------------!    !--------!		 !  
;	 !    !----------!   !			!	      !		 !
;	 !		 !   !-----------!      !	      !		 !
;	 !		 !		 !      !--------!    !		 !
;	\!/		\!/		\!/		\!/  \!/	\!/
;	!-----!		!-----!		!-----!		!-----!		!-----!
;	!     !		!     !		!     !		!     !		!     !
; VOL	! VOL !		! VOL !		! VOL !		! VOL !		! VOL !
;CHAIN	!  1  !<------->!  2  !<------->!  3  !<------->!  4  !<------->!  5  !
;	!     !		!     !		!     !		!     !		!     !
;	!-----!		!-----!		!-----!		!-----!		!-----!
;			/!\		/!\		/!\		  /!\
;	     !-----------!		 !		 !		   !
;	     !     	     !-----------!		 !		   !
;	     !		     !		     !-----------!		   !
;	     !		     !		     !		     !-------------!
;	     !		     !		     !		     !
;	    \!/		    \!/		    \!/		    \!/
;	!-----!		!-----!		!-----!		!-----!		!-----!
;	!     !		!     !		!     !		!     !		!     !
; UCB	! MTA !		! MTA !		! MTB !		! MTB !		! MTB !
;CHAIN	!  0  !<------->!  1  !<------->!  0  !<------->!  1  !<------->!  2  !
;	!     !		!     !		!     !		!     !		!     !
;	!-----!		!-----!		!-----!		!-----!		!-----!
SUBTTL	QSRMDA Entry Points

	INTERN	D$CLSV			;CLEAR ALL STR VALID STATUS BITS
	INTERN	D$CSTR			;CHECK TO SEE IF A STRUCTURE IS ON-LINE
	INTERN	D$ESTR			;EXTRACT A STRUCTURE FROM AN FD
	INTERN	D$ASTD			;ADD A STRUCTURE DEPENDENCY
SUBTTL	Local Storage

IFN FTUUOS,<
DSKCBL:	BLOCK	5			;DSKCHR BLOCK
>  ;END IFN FTUUOS

IFN FTJSYS,<
ESTR.A:	BLOCK	^D16			;-20 STRUCTURE NAME
>  ;END IFN FTJSYS
SUBTTL	D$CLSV  --  Clear All STR Valid Status

;D$CLSV is called to clear all the STATUS-VALID indicators for all file-
;	structures in the STR queue.  This will cause the status to be
;	re-verified upon calling D$CSTR.


;Call:	No arguments
;
;T Ret:	Always

D$CLSV:	LOAD	S1,HDRSTR##+.QHLNK,QH.PTF
					;POINT TO FIRST ITEM IN STR QUEUE
	MOVX	S2,STSSSV		;LOAD THE STATUS-VALID BIT

CLSV.1:	JUMPE	S1,.RETT		;RETURN  ON END OF QUEUE
	ANDCAM	S2,STRSTS(S1)		;CLEAR STATUS-VALID FLAG
	LOAD	S1,.QELNK(S1),QE.PTN	;POINT TO NEXT ITEM
	JRST	CLSV.1			;AND LOOP
SUBTTL	D$CSTR  --  Check a structure for on-line

;D$CSTR is called with a STR queue entry to check whether or not it is
;	on line.

;Call:	S1/  address of an STR entry
;
;T Ret: Structure is on-line
;	S1/Addr of STR queue entry
;
;F Ret: Structure is off-line
;	S1/Addr of STR queue entry

D$CSTR:	MOVE	S2,STRSTS(S1)		;GET STRUCTURE STATUS WORD
	TXNN	S2,STSSSV		;IS STATUS VALID?
	JRST	CSTR.2			;NO, GO ASK MONITOR
CSTR.1:	TXNE	S2,STSONL		;YES, IS IT ON-LINE?
	$RETT				;YES, RETURN TRUE
	$RETF				;NO, RETURN FALSE

IFN FTUUOS,<
CSTR.2:	MOVE	S2,STRNAM(S1)		;GET THE STRUCTURE NAME
	MOVEM	S2,DSKCBL+.DCNAM	;STORE IT IN THE DSKCHR BLOCK
	MOVE	S2,[5,,DSKCBL]		;POINT TO DSKCHR ARG
	DSKCHR	S2,			;ASK THE MONITOR FOR STATUS
	  MOVX	S2,DC.OFL		;FAILED, LOAD OFF-LINE BIT
	TXNE	S2,DC.OFL!DC.NNA!DC.SAF	;OFFLINE IFF OFL OR NNA OR SAF
	TDZA	S2,S2			;OFF LINE!!!
	MOVX	S2,STSONL		;ON LINE!!!
	TXO	S2,STSSSV		;SET VALID STATUS
	MOVEM	S2,STRSTS(S1)		;STORE THE STATUS
	JRST	CSTR.1			;AND RETURN CORRECT STATE
>  ;END IFN FTUUOS

IFN FTJSYS,<
CSTR.2:	PUSHJ	P,.SAVE3		;SAVE P1 THRU P3
	MOVE	P1,S1			;SAVE STR ADDRESS IN P1
	MOVE	S1,[2,,.MSGSS]		;LEN,,FUNCTION
	MOVEI	S2,P2			;ADDRESS OF ARG BLOCK
	HRROI	P2,STRNAM(P1)		;FIRST ARG IS POINT TO STR NAME
	MSTR				;GET STRUCTURE STATUS
	ERJMP	CSTR.3			;LOSE, MUST BE OFF-LINE
	MOVX	S2,STSONL		;LOAD THE ON-LINE BIT
	TXNE	P3,MS%DIS		;IS STR BEING DISMOUNTED?
CSTR.3:	SETZ	S2,			;YES, CLEAR ON-LINE FLAG
	TXO	S2,STSSSV		;SET STATUS VALID
	MOVEM	S2,STRSTS(P1)		;SAVE THE STRUCTURE STATUS
	MOVE	S1,P1			;GET STRUCTURE ADDRESS IN S1
	JRST	CSTR.1			;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	D$ESTR  --  Extract a STR from an FD

;D$ESTR is called with an FD to extract the structure and return the
;	address of an STR queue entry for it.

;Call:	S1/  address of an FD
;
;T Ret:	S1/  address of a STR queue entry
;
;F Ret: If an invalid structure field was in the FD (i.e. non-disk device)

IFN FTUUOS,<
D$ESTR:	PUSHJ	P,.SAVE1		;SAVE P1
	SKIPN	S1,.FDSTR(S1)		;GET THE STRUCTURE NAME
	$RETF				;IF NULL,,RETURN FALSE
	MOVE	P1,S1			;AND SAVE IT IN P1
	PUSHJ	P,FNDSTR		;FIND THE STRUCTURE
	JUMPT	.RETT			;RETURN IF FOUND
	MOVEM	P1,DSKCBL+.DCNAM	;STORE STR NAME FOR DSKCHR
	MOVE	S2,[5,,DSKCBL]		;GET DSKCHR ARGS
	DSKCHR	S2,			;SEE IF STR IS ON-LINE
	  JRST	[MOVE S2,P1		;OFF-LINE, PUT STR NAME IN S2
		 DEVCHR S2,		;MAKE SURE ITS NOT A NON-DISK DEVICE
		 JUMPN  S2,.RETF	;IF DEVICE EXISTS, RETURN FALSE
		 JRST ESTR.1]		;ELSE CONTINUE ON
	LOAD	S2,S2,DC.TYP		;GET ARGUMENT TYPE
	CAIE	S2,.DCTFS		;SKIP IF IT WAS A FILE STRUCTURE
	MOVE	P1,DSKCBL+.DCSNM	;ELSE, USE STR NAME RET BY DSKCHR

ESTR.1:	$SAVE	H			;SAVE H
	$SAVE	AP			;SAVE AP
	MOVEI	H,HDRSTR##		;POINT TO THE CORRECT HEADER
	PUSHJ	P,M$GFRE##		;GET A FREE CELL
	MOVEM	P1,STRNAM(AP) 		;SAVE THE STRUCTURE NAME
	PUSHJ	P,M$ELNK##		;LINK IT IN AT THE END
	MOVE	S1,AP			;PUT ADDRESS IN S1
	$RETT				;AND RETURN
>  ;END IFN FTUUOS

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

IFN FTJSYS,<
D$ESTR:	PUSHJ	P,.SAVET		;SAVE T REGISTERS
	SETZM	ESTR.A			;CLEAR DEVICE NAME HOLD AREA
	HRROI	S2,.FDFIL(S1)		;POINT TO THE FILESPEC
	MOVX	S1,GJ%OFG+GJ%SHT	;PARSE-ONLY AND SHORT GTJFN
	GTJFN				;GET A JFN FOR THE FILESPEC
	ERJMP	.RETF			;ILLEGAL FILESPECIFICATION
	MOVE	S2,S1			;PUT THE FILE HANDLE INTO S2
	HRROI	S1,ESTR.A		;PLACE TO PUT THE STRUCTURE NAME
	MOVX	T1,JS%DEV		;ONLY WANT THE DEVICE.
	SETZ	T2,			;CLEAR T2
	JFNS				;GET THE STRUCTURE NAME
	MOVE	S1,S2			;GET THE JFN IN S1
	RLJFN				;RELEASE IT
	ERJMP	.+1			;IGNORE ERRORS
	MOVE	S1,[ASCIZ/TTY/]		;GET AN ASCIZ 'TTY'
	CAMN	S1,ESTR.A		;SPECIAL CASE TTY:
	$RETF				;IF TTY,,THEN RETURN FALSE
	MOVE	S1,[POINT 7,ESTR.A]	;POINT TO THE DEVICE NAME.
	PUSHJ	P,FNDSTR		;FIND THE STRUCTURE
	JUMPT	.RETT			;RETURN NOW IF FOUND
	HRROI	S1,ESTR.A		;GET THE PTR TO THE DEVICE STRING
	STDEV				;CONVERT TO A DEVICE DESIGNATOR
	ERJMP	ESTR.1			;IF NO SUCH DEVICE, WIN
	LOAD	S1,S2,DV%TYP		;GET THE DEVICE TYPE
	CAIE	S1,.DVDSK		;IS IT A DISK?
	$RETF				;NO,,RETURN FALSE

ESTR.1:	$SAVE	H			;SAVE AC H
	$SAVE	AP			; AND AP
	MOVEI	H,HDRSTR##		;GET A STRUCTURE QUEUE
	PUSHJ	P,M$GFRE##		;GET A FREE CELL
	MOVE	S1,[POINT 7,ESTR.A]	;GET THE SOURCE STR BYTE PTR.
	MOVE	S2,[POINT 7,STRNAM(AP)]	;GET THE DESTINATION STR BYTE PTR.
ESTR.2:	ILDB	T1,S1			;GET A STRUCTURE BYTE.
	IDPB	T1,S2			;SAVE IT IN STR LIST.
	JUMPN	T1,ESTR.2		;NOT NULL,,KEEP ON GOING.
	PUSHJ	P,M$ELNK##		;LINK IT IN AT THE END
	MOVE	S1,AP			;PUT ADDRESS IN S1
	$RETT				;RETURN
>  ;END IFN FTJSYS
SUBTTL	D$ASTD  --  Add a structure dependency

;This routine is called to place a structure into the dependency list
;	for a job.

;Call:	S1/  adr of STR entry
;	S2/  adr of QE
;
;T Ret:	always

D$ASTD:	PUSHJ	P,.SAVET		;SAVE THE T REGISTERS
	DMOVE	T1,S1			;PUT ARGUMENTS INTO T1 AND T2
	LOAD	S1,.QEDIN(T2),QE.DLN	;GET DEPENDENCY LIST NUMBER
	PUSHJ	P,L%FIRST		;AND POSITION TO THE START OF THE LIST
	JUMPF	ASTD.3			;EMPTY LIST, ADD IT ON
	JRST	ASTD.2			;JUMP INTO MIDDLE OF LOOP

ASTD.1:	PUSHJ	P,L%NEXT		;POSITION TO THE NEXT ONE
	JUMPF	ASTD.3			;NO NEXT ONE, LINK IT IN
ASTD.2:	LOAD	T3,.DIBDS(S2),DI.TYP	;GET DEPENDENCY TYPE
	CAXE	T3,.DTSTR		;STRUCTURE?
	JRST	ASTD.1			;NO, GET THE NEXT DEPENDENCY
	CAME	T1,.DIBDT(S2)		;YES, SAME STRUCTURE?
	JRST	ASTD.1			;NO, ON TO THE NEXT DEPENDENCY
	JRST	.RETT			;YES, ALREADY RECORDED

ASTD.3:	LOAD	S1,.QEDIN(T2),QE.DLN	;GET LIST NUMBER
	MOVX	S2,DIBSIZ		;GET LIST ENTRY SIZE
	PUSHJ	P,L%CENT		;CREATE AN ENTRY
	MOVX	S1,.DTSTR		;GET CODE FOR STRUCTURE
	STORE	S1,.DIBDS(S2),DI.TYP	;STORE IT
	STORE	T1,.DIBDT(S2)		;STORE THE STR ADDRESS
	$RETT				;AND RETURN
SUBTTL	FNDSTR  --  Find a STR entry

;FNDSTR is called with a structure name to find the STR queue entry for it.
;
;Call:	S1/  Structure Name (6bit on -10, byte-pointer on -20)
;
;T Ret:	S1/  Address of STR queue entry
;
;F Ret: If not in STR queue

FNDSTR:	LOAD	S2,HDRSTR##+.QHLNK,QH.PTF
	EXCH	S1,S2			;EXCHANGE S1 AND S2

IFN FTUUOS,<
FNDS.1:	JUMPE	S1,.RETF		;FAIL WHEN DONE.
	CAMN	S2,STRNAM(S1)		;MATCH?
	$RETT				;YES, JUST RETURN
	LOAD	S1,.QELNK(S1),QE.PTN	;NO, POINT TO NEXT
	JRST	FNDS.1			;AND LOOP
>  ;END IFN FTUUOS

IFN FTJSYS,<
	PUSHJ	P,.SAVE4		;SAVE P1 THRU P4
	MOVE	P4,S2			;SAVE THE SOURCE STR POINTER.
FNDS.1:	JUMPE	S1,.RETF		;FAIL WHEN DONE.
	MOVE	P1,[POINT 7,STRNAM(S1)]	;POINT TO THE STRUCTURE NAME IN STR

FNDS.2:	ILDB	P2,P1			;GET A STR CHARACTER
	ILDB	P3,S2			;GET SOURCE CHARACTER
	CAME	P2,P3			;ARE THEY THE SAME?
	JRST	FNDS.3			;NO, NEXT STR
	JUMPN	P2,FNDS.2		;YES, LOOP IF NOT NULL YET
	$RETT				;WIN IF NULLS MATCH

FNDS.3:	LOAD	S1,.QELNK(S1),QE.PTN	;GET POINTER TO NEXT
	MOVE	S2,P4			;RESET THE SOURCE STR POINTER.
	JRST	FNDS.1			;AND LOOP
>  ;END IFN FTJSYS
	SUBTTL	Mountable Device Allocator (MDA)

	INTERN	D$INIT			;MDA INITIALIZATION
	INTERN	D$MOUNT			;PROCESS A TAPE/DISK MOUNT REQUEST
TOPS10<	INTERN	D$DEASSIGN >		;DEASSIGN/RELEASE A VOLUME SET
TOPS10<	INTERN	D$IDENTIFY >		;IDENTIFY MESSAGE PROCESSOR
TOPS10<	INTERN	D$ENABLE >		;ENABLE AVR FOR A TAPE DRIVE
TOPS10<	INTERN	D$DISABLE >		;DISABLE AVR FOR A TAPE DRIVE
	INTERN	D$DMDR			;DELETE AN MDR
TOPS10<	INTERN	D$RECOGNIZE >		;PROCESS THE RECOGNIZE OPERATOR CMD
TOPS10<	INTERN	D$AVR >			;TAPE AUTOMATIC VOLUME RECOGNIZER
TOPS10<	INTERN	D$DEVSTA >		;PROCESS TAPE/DISK STATUS MESSAGES
TOPS10<	INTERN	D$UNLOAD >		;UNLOAD A TAPE DRIVE
TOPS10<	INTERN	D$DELETE >		;OPERATOR DELETE FOR MOUNT REQUESTS
TOPS10<	INTERN	D$SMDA >		;SET TAPE (UN)AVAILABLE
TOPS10<	INTERN	D$VSR >			;VOLUME SWITCH REQUEST FROM PULSAR
	INTERN	D$LOGOUT		;PROCESS A USER LOGOUT
	INTERN	D$VMDA			;VALIDATE THE MDA DATA STRUCTURES

MDRQUE:: EXP	-1			;TAPE MOUNT QUEUE LIST ID
UCBQUE:: 0,,0				;UCB QUEUE
VSLQUE:: 0,,0				;VOLUME SET LIST QUEUE
VOLQUE:: 0,,0				;VOLUME LIST QUEUE

MDAOBJ::.OTMNT				;MDA OBJECT BLOCK - TYPE .OTMNT
	0,,0				;SPACE FOR SIXBIT UNIT NAME
	0,,0				;NO NODE NAME

MDRDSP:	$BUILD	%MDMAX+1
	 $SET(.MDINV,,.RETF)		;OFFSET 0 IS INVALID
	 $SET(.TMDEN,,MNTDEN)		;DENSITY BLOCK PROCESSOR
	 $SET(.TMDRV,,MNTDRV)		;DRIVE BLOCK PROCESSOR
	 $SET(.TMLT,,MNTLT)		;LABEL TYPE BLOCK PROCESSOR
	 $SET(.TMSET,,MNTSET)		;SET NAME BLOCK PROCESSOR
	 $SET(.TMRMK,,MNTRMK)		;REMARK BLOCK PROCESSOR
	 $SET(.TMSTV,,MNTSTV)		;STARTING VOLUME ID BLOCK PROCESSOR
	 $SET(.TMVOL,,MNTVOL)		;VOLUME ID BLOCK PROCESSOR
	 $SET(.TMVPR,,.RETT)		;VOL PROTECTION CODE BLOCK PROCESSOR
	 $SET(.TMINI,,.RETT)		;VOL INITIALIZATION BLOCK PROCESSOR
	 $SET(.SMNAM,,MNTSET)		;STRUCTURE NAME PROCESSOR
	 $SET(.SMALI,,MNTVOL)		;ALIAS BLOCK PROCESSOR
	 $SET(.TMLNM,,MDRLNM)		;LOGICAL NAME PROCESSOR
	$EOB


TMPVSL:	BLOCK	VSLLEN			;TEMPLATE VSL (TILL REAL ONE IS BUILT)

STRVOL:	BLOCK	1			;STARTING VOLUME SAVE AREA
VOLNBR:	BLOCK	1			;VOLUME COUNT IN A VOLUME SET

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE



	;DEFINE A MACRO TO PACK A BLOCK OF STORAGE INTO ITSELF STARTING AT
	;THE ADDRESS CONTAINED IN 'AC'

DEFINE	$PACK(AC,%A,%B),<
%A:	AOBJP	AC,%B		;;CHECK THE AC,,IF POSITIVE,,SKIP
XLIST
	MOVE	TF,0(AC)	;;STILL NEGATIVE,,GET THE VALUE AT 0(AC)
	MOVEM	TF,-1(AC)	;;AND STORE IT AT ADDRESS AC-1
	JRST	%A		;;HEAD BACK FOR MORE
%B:	SETZM	-1(AC)		;;WE'RE DONE,,ZERO THE LAST ENTRY
LIST>


	;GENERALIZED VOLUME LABEL TYPE DEFINITIONS

	%UNLBL==1			;VOLUME IS UNLABELED
	%LABEL==2			;VOLUME IS LABELED

	SYSPRM	%TFLBP,.TFLBP,-1	;DEFINE BLP LABEL TYPE (INVALID FOR -20)

LABELS:: [ASCIZ/Bypass/]
	[ASCIZ/ANSI/]
	[ASCIZ/ANSI/]
	[ASCIZ/IBM/]
	[ASCIZ/IBM/]
	[ASCIZ/No/]
	[ASCIZ/Non-Standard/]
	[ASCIZ/No/]
	[ASCIZ/Cobol Sixbit/]
	[ASCIZ/Cobol Ascii/]
	[ASCIZ/No/]

DENSTY:	[ASCIZ/Default/]
	[ASCIZ/200/]
	[ASCIZ/556/]
	[ASCIZ/800/]
	[ASCIZ/1600/]
	[ASCIZ/6250/]

WRTENA:	[ASCIZ/Enabled/]
	[ASCIZ/Locked/]

AVA:	[ASCIZ/Available/]
	[ASCIZ/Unavailable/]

DEMO:	ITEXT	(<User: ^W6/.MRNAM(AP)/^W/.MRNAM+1(AP)/ ^U/.MRUSR(AP)/ Job# ^D/.MRJOB(AP),MD.PJB/ Request: ^W/.MRREQ(AP)/>)

	MDBSIZ==^D50			;SIZE OF THE ACK BUFFER
MDBPTR:	BLOCK	1			;SPACE FOR A BYTE POINTER
MDABUF:	BLOCK	MDBSIZ			;THE ACK BUFFER ITSELF
	SUBTTL	D$INIT - ROUTINE TO INITIALIZE THE MDA DATA BASE

D$INIT:	PUSHJ	P,L%CLST		;CREATE A LIST FOR THE MDR
	MOVEM	S1,MDRQUE		;SAVE THE ID
	PUSHJ	P,L%CLST		;CREATE A LIST FOR THE VSL SET CHAIN
	MOVEM	S1,VSLQUE		;SAVE THE ID
	PUSHJ	P,L%CLST		;CREATE A LIST FOR THE VOLUME LIST
	MOVEM	S1,VOLQUE		;SAVE THE ID

	;NOTE:::: The UCB chain will be built by I$INIT (QSRT10)

TOPS10 <
	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;POSITION TO THE FIRST UCB
	SKIPT				;THERE MUST BE ONE !!!
	PUSHJ	P,S..NUE		;NO,,UH OH !!!
INIT.1:	LOAD	TF,.UCBST(S2),UC.AVA	;GET AVAILABLE BIT
	LOAD	S1,.UCBST(S2),UC.KTP	;GET THE CONTROLLER TYPE IN S1
	SKIPE	TF			;IS THE DEVICE UNAVAILABLE?
	CAXN	S1,.TFKD2		;OR IS THIS A DX20 CONTROLLER ???
	JRST	INIT.2			;YES TO EITHER,,SKIP THIS
	MOVE	S1,.UCBNM(S2)		;GET THE DEVICE NAME IN S1
	PUSHJ	P,SNDREC		;SEND RECOGNIZE MSG TO TAPE LABELER

INIT.2:	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB
	JUMPT	INIT.1			;FOUND ONE,GO PROCESS IT
>
	$RETT				;RETURN
	SUBTTL	D$MOUNT - Process a Tape/Disk Mount Request

	EXTERN	BELLS			;WANT TO REFERENCE ELSEWHERE

	;CALL: 	M/ The Mount Message Address
	;
	;RET:	An Ack to the user (If he wants one)

D$MOUNT: SKIPE	G$QUEUE##		;ARE QUEUE CREATES VALID ???
	JRST	E$OHR##			;NO,,RETURN AN ERROR
	PUSHJ	P,D$CMDR		;GO CREATE THE MDR ENTRY
	JUMPF	.RETT			;RETURN IF AN ERROR OCCURED
	MOVE	AP,S1			;SAVE THE MDR ADDRESS
	PUSHJ	P,I$MNTR##		;SEND THE MESSAGE TO MOUNTR (TOPS20 ONL
	JUMPF	D$DMDR			;NO GOOD,,DELETE THE MDR AND RETURN
	PUSHJ	P,USRACK		;GO ACK THE USER IF NECCESSARY

TOPS10<
MOUNT:	$SAVE	<P1,P2>			;SAPCE FOR VSL, VOL PTRS
	LOAD	P1,.MRVSL(AP)		;GET THE VSL ADDRESS
	LOAD	S2,.VSCVL(P1),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	S2,.VSVOL(P1)		;POINT TO THE ADDR OF THE CURRENT VOLUME
	MOVE	P2,0(S2)		;PICK UP THE CURRENT VOLUME ADDRESS
	SKIPN	S1,.VLUCB(P2)		;IS THERE A UCB ALREADY ATTACHED?
	JRST	MOUN.1			;NOT YET, MUST ASK OPR
	PUSHJ	P,MATUNI		;TRY TO GIVE THAT UNIT TO THE USER
	SKIPF				;CAN'T DO IT, ASK OPERATOR
	$RETT				;DID IT, ALL DONE!

;Here after trying to reassign the device 'on-the-fly', but it didn't work
;Set things up the way they were so we can ask the operator

MOUN.1:	LOAD	S1,.VSFLG(P1),VS.WLK	;GET THE WRITE-LOCKED CODE
	LOAD	S2,.VSFLG(P1),VS.LBT	;GET THE REQUESTED LABEL TYPE
	$WTO	(< Tape Mount Request #^D/.MRRID(AP),MR.RID/ >,<From ^I/DEMO/^M^JTape Volume(s): ^W/.VLNAM(P2)/ Write-^T/@WRTENA(S1)/ ^T/@LABELS(S2)/ Labels^T/BELLS/>,,<$WTFLG(WT.SJI)>)
>;END TOPS10
	$RETF
	SUBTTL	D$DEASSIGN - DEASSIGN/RELEASE A VOLUME SET

	;CALL:	M / The Deassign Message Address
	;
	;RET:	True Always

TOPS10 <
D$DEAS:	PUSHJ	P,.SAVE3		;SAVE P1 & P2 FOR A MINUTE
	LOAD	S1,.TDDEV(M)		;GET THE RELEASED DEVICE NAME
	PUSHJ	P,GETUCB		;FIND THE DEVICE IN THE UCB CHAIN
	JUMPF	.RETF			;NOT FOUND,,THATS AN ERROR
	MOVE	P1,S1			;SAVE THE UCB ADDRESS IN P1

	LOAD	S1,.UCBST(P1),UC.AVA	;GET THE DEVICE AVAILABLE BIT
	SKIPN	P2,.UCBVS(P1)		;DOES THE UCB POINT TO A VSL ???
	SKIPE	S1			;NO,,IS THE DEVICE AVAILABLE ???
	SKIPA				;DEV OWNED OR NOT AVAILABLE,,SKIP
	 $STOP(DUD,Deassign for Unassigned Device) ;NO,,DEEEP TROUBLE !!!
	JUMPE	P2,.RETT		;NO OWNER,,JUST IGNORE THIS
	MOVE	AP,.VSMDR(P2)		;GET THE MDR ADDRESS
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE OWNERS JOB NUMBER
	CAME	S1,.TDJBN(M)		;THESE MUST MATCH !!!
	 $STOP(IOS,Invalid Owner Specified in Reassign Message) ;NO,,UH OH !!

	$WTO	( Released ,<^I/DEMO/>,MDAOBJ) ;TELL OPR WHATS GOING ON

	LOAD	S1,.MRRID(AP),MR.CNT	;GET THE VSL COUNT FOR THIS MDR
	CAIN	S1,1			;ONLY 1 VSL ???
	PJRST	D$DMDR			;YES,,DELETE ALL THIS MDR'S STRUCTURES

	MOVE	S1,P2			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,DELVSL		;DELETE ONLY THIS VSL

	LOAD	S1,.MRRID(AP),MR.CNT	;GET THE VSL COUNT IN S1
	MOVNS	S1			;MAKE THE VSL COUNT NEGATIVE
	HRLZS	S1			;MOVE RIGHT TO LEFT
	HRRI	S1,.MRVSL(AP)		;POINT TO THE VSL ADDRESS LIST

DEAS.5:	CAME	P2,0(S1)		;FIND THE VSL POS IN THE MDR VSL LIST
	JRST	[AOBJN	S1,DEAS.5	;NOT FOUND,,TRY ALL VSL ADDRESSES
		 PUSHJ	P,S..VAM]	;NOT THERE,,WE'RE IN DEEP TROUBLE !!!
	$PACK	S1			;PACK THE MDR VSL LIST

	DECR	.MRRID(AP),MR.CNT	;AND DECREMENT THE MDR VSL COUNT BY 1

	$RETT				;RETURN
>
	SUBTTL	D$CMDR - ROUTINE TO CREATE AN ENTRY IN THE MDR QUEUE

	;CALL:	M/The MOUNT Message Address
	;
	;RET:	S1/ The MDR address

D$CMDR:	LOAD	S1,.MSTYP(M),MS.CNT	;GET THE MESSAGE LENGTH
	CAILE	S1,.MMHSZ		;MUST BE GREATER THEN .MMHSZ AND
	CAIL	S1,.MMUMX		;   LESS THEN .MMUMX
	PJRST	E$IMM##			;ELSE ITS AN ERROR
	PUSHJ	P,.SAVE4		;SAVE 4 P AC'S

	MOVE	S1,MDRQUE		;GET THE QUEUE ID
	PUSHJ	P,L%LAST		;POSITION TO THE LAST ENTRY
	MOVE	S1,MDRQUE		;GET THE QUEUE ID
	SKIPG	S2,.MMARC(M)		;CHECK AND LOAD THE VOLUME SET COUNT
	PJRST	E$IMM##			;INVALID,,RETURN AN ERROR
	ADDI	S2,MDRLEN-1		;ADD MDR LENGTH-1
	PUSHJ	P,L%CENT		;GO CREATE A QUEUE ENTRY
	MOVE	AP,S2			;GET THE ENTRY ADDRESS
	MOVE	P4,.MMARC(M)		;GET THE VOLUME SET COUNT IN P4

	AOS	S1,REQIDN##		;GET A REQUEST ID
	STORE	S1,.MRRID(AP),MR.RID	;SAVE IT
	MOVE	S1,G$SID##		;GET THE OWNERS ID
	MOVEM	S1,.MRUSR(AP)		;SAVE IT IN THE QUEUE
	MOVE	S1,G$SND##		;GET THE SENDERS PID
	MOVEM	S1,.MRPID(AP)		;SAVE IT
	MOVE	S1,.MMNAM(M)		;GET THE REQUEST NAME
	MOVEM	S1,.MRREQ(AP)		;SAVE IT FOR LATER
	MOVE	S1,G$PRVS##		;GET THE SENDERS CAPABILITIES
	MOVEM	S1,.MRJOB(AP)		;SAVE IT IN THE QUEUE
	LOAD	S1,.MMFLG(M),MM.WAT	;GET USER REQUEST FOR WAITING
	STORE	S1,.MRFLG(AP),MR.WAT	;SAVE IN MDR
	LOAD	S1,.MMFLG(M),MM.NOT	;AND GET USER NOTIFY BIT
	STORE	S1,.MRFLG(AP),MR.NOT	;AND SAVE THAT IN MDR
	JUMPE	S1,CMDR.A		;NO NOTIFY, SO SKIP THE DATA FETCH

	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE REQUESTING JOB NUMBER
	MOVX	S2,JI.JLT		;CODE TO GET LOGIN TIME
	$CALL	I%JINF			;ASK THE LIBRARY
	MOVEM	S2,.MRLOG(AP)		;SAVE IN MDR FOR NOTIFY

CMDR.A:	MOVE	S1,AP			;GET THE MDR ADDRESS IN S1
	PUSHJ	P,I$DFMR##		;FILL IN SYSTEM DEPENDENT DATA
	MOVEI	P2,.MMHSZ(M)		;POINT TO THE FIRST MOUNT ENTRY
	MOVEI	P3,.MRVSL(AP)		;GET THE ADDRESS OF THE VSL ADDR LIST

CMDR.0:	MOVE	S1,P2			;GET THE MOUNT MSG ENTRY ADDRESS IN S1
	PUSHJ	P,BLDVSL		;GO BUILD THE VOLUME SET LIST
	MOVEM	S1,0(P3)		;LINK THE VSL TO THE MDR
	MOVEM	AP,.VSMDR(S1)		;LINK THE MDR TO THE VSL
	INCR	.MRRID(AP),MR.CNT	;BUMP THE VSL COUNT BY 1

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	JUMPF	CMDR.1			;CHK BLDVSL - NO GOOD,,DELETE THIS MDR
	AOS	P3			;POINT TO THE NEXT VSL ADDRESS
	LOAD	S1,.MEHDR(P2),AR.LEN	;GET THIS ENTRIES LENGTH
	ADDI	P2,0(S1)		;POINT TO THE NEXT ENTRY
	SOJG	P4,CMDR.0		;CONTINUE THROUGH ALL VOLUME SETS
	MOVE	S1,AP			;RETURN THE MDR ADDRESS IN S1
	$RETT				;AND RETURN

CMDR.1:	PUSHJ	P,D$DMDR		;DELETE THIS MDR
	SKIPN	G$ERR##			;DID WE ALREADY SEE AN ERROR?
	PJRST	E$IMM##			;NO, RETURN THROUGH 'INVALID MOUNT MSG'
	$RETF				;YES, BUBBLE IT UP!
	SUBTTL	D$LOGOUT - DELETE A USER MDR'S ON LOGOUT

	;CALL:	S1/ The User Job Number
	;
	;RET:	True Always

TOPS10 <
D$LOGO:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE JOB NUMBER IN P1
	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST MDR ENTRY
	JUMPF	.RETT			;NONE THERE,,JUST RETURN

LOGO.A:	MOVE	AP,S2			;SAVE THE MDR ADDRESS IN AP
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE MDR JOB NUMBER
	CAMN	S1,P1			;DO THE JOB NUMBERS MATCH ???
	PUSHJ	P,D$DMDR 		;YES,,DELETE THIS MDR
	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT ENTRY
	JUMPT	LOGO.A			;THERE IS ONE,,GO CHECK IT
	$RETT				;NO MORE,,RETURN
>
TOPS20<
D$LOGO:	$RETT	>			;JUST RETURN ON THE -20
	SUBTTL	D$DMDR - ROUTINE TO UNWIND AND DELETE AN MDR

	;CALL:	AP/ The MDR Address
	;
	;RET:	True Always

	;AC Usage:	AP/ MDR Entry
	;		P1/ VSL AOBJN AC

D$DMDR:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	S1,MDRQUE		;GET THE MOUNT QUEUE ID
	MOVE	S2,AP			;GET THE MDR ADDRESS IN S2
	PUSHJ	P,L%APOS		;GET THE ENTRY
	SKIPN	S1,.MRVSL(AP)		;CHECK AND LOAD THE FIRST VSL ADDRESS
	$STOP	(VAF,VSL Address not Found in MDR) ;NONE THERE,,UH OH !!!
	CAIN	S1,TMPVSL		;ARE WE POINTING TO THE TEMP VSL ???
	JRST	DMDR.2			;YES,,JUST DELETE THE MDR

	LOAD	P1,.MRRID(AP),MR.CNT	;GET THE VSL COUNT
	MOVNS	P1			;MAKE IT NEGATIVE
	HRLZS	P1			;CREATE A VSL AOBJN AC
	HRRI	P1,.MRVSL(AP)		;GET THE VSL LIST ADDRESS IN RIGHT HALF

DMDR.1:	MOVE	S1,0(P1)		;PICK UP THE CURRENT VSL ADDRESS
	PUSHJ	P,DELVSL		;GO DELETE IT
	AOBJN	P1,DMDR.1		;CONTINUE THROUGH ALL VOLUME SETS

DMDR.2:	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%DENT		;DELETE THIS MDR
	$RETT				;RETURN
	SUBTTL	D$IDENTIFY - ROUTINE TO PROCESS THE IDENTIFY COMMAND

	;CALL:	M /The Identify Message Address
	;
	;RET:	True Always

TOPS10 <
D$IDEN:	PUSHJ	P,.SAVE4		;SAVE SOME REGS

	MOVX	S1,.TAPDV		;GET THE DEVICE BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	E$IMO##			;NOT THERE,,THATS AN ERROR
	PUSHJ	P,FNDUCB		;GO FIND THE AFFECTED UCB
	JUMPF	.RETF			;NOT THERE,,DEVICE DOES NOT EXIST !!!
	MOVE	P1,S1			;SAVE POINTER TO UCB

	;A Small Security Check Before We Start !!!

	SKIPN	P3,.UCBVL(P1)		;CHECK AND LOAD THE VOL BLOCK ADDRESS
	PJRST	E$NVM##			;NO VOLUME MOUNTED ON THE DRIVE !!!
	LOAD	S1,.VLOWN(P3),VL.CNT	;GET THE VOLUME REQUEST COUNT
	LOAD	S2,.UCBST(P1),UC.VSW	;AND GET THE DEVICE VOLUME SWITCH STATUS
	SKIPE	S1			;CAN'T BE REQUESTED BY ANYONE
	JUMPN	S2,E$CIU##		;   AND BE SWITCHING VOLS ON SAME DEVICE

	;Check for a VOLID Block and process it if there is one.

	MOVX	S1,.VOLID		;GET THE VOLID BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	IDEN.A			;NOT THERE,,CONTINUE ON
	HRROI	S1,0(S1)		;POINT TO THE ASCIZ VOLID
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVE	P4,S2			;SAVE THE NEW VOL ID FOR A MINUTE
	MOVE	S1,S2			;GET THE VOL ID IN S1
	PUSHJ	P,CHKVOL		;SEE IF ITS ALREADY IN OUT DATA BASE
	SKIPF				;NOT THERE,,CONTINUE ONWARD
	JUMPN	S2,.RETT		;IF FOUND AND MOUNTED,,JUST RETURN
	MOVE	S1,.UCBVL(P1)		;LOAD THE ADDRESS OF THE VOLUME BLOCK
	LOAD	TF,.VLOWN(P3),VL.OFF	;GET THE OWNERS OFFSET
	CAIE	TF,-1			;IS THE MOUNTED VOLUME OWNED ???
	PJRST	E$DAU##			;YES,,CAN THE REQUEST
	LOAD	S1,.VLFLG(P3),VL.LBT	;GET THE VOLUME LABEL TYPE
	PUSHJ	P,GETLBT		;RECODE IT TO SOMETHING UNDERSTANDABLE
	CAXN	S1,%LABEL		;IS THE VOLUME LABELED ???
	PJRST	E$VIL##			;YES,,CAN'T DO THIS !!!
	MOVEM	P4,.VLNAM(P3)		;SAVE THE NEW VOLUME ID
	$ACK	(<Unlabeled Volume ^W/.VLNAM(P3)/ Mounted>,,MDAOBJ,.MSCOD(M))
	$RETT				;ACK THE OPR AND RETURN

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

IDEN.A:	MOVX	S1,.ORREQ		;GET THE REQUEST-ID BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	E$IMO##			;NOT THERE,,THATS AN ERROR
	MOVE	S1,0(S1)		;LOAD THE USER REQUEST ID NUMBER
	PUSHJ	P,FNDMDR		;GET THE REQUESTED MDR ENTRY IN AP
	JUMPF	.RETT			;NOT FOUND,,JUST RETURN

	MOVE	P4,.MRVSL(AP)		;GET ADDR OF VOLUME SET LIST
	LOAD	TF,.UCBST(P1),UC.VSW	;GET THE VOLUME SWITCH BIT
	SKIPE	TF			;NOT SWITCHING VOLS,,SKIP NEXT CHECK !!
	CAMN	P4,.UCBVS(P1)		;YES,,DOES THIS USER OWN THE DEVICE ???
	SKIPA				;NO VOL SWTCH OR USER OWNS IT,,CONTINUE
	JRST	E$DAU##			;UH OH,,DEVICE IS IN USE BY SOMEONE ELSE

IDEN.0:	LOAD	S2,.VSCVL(P4),VS.OFF	;GET OFFSET TO CURRENT VOLUME IN SET
	ADDI	S2,.VSVOL(P4)		;AIM AT THAT POINTER
	MOVE	P2,0(S2)		;GET ADDR OF THAT VOLUME BLOCK
	SKIPE	S1,.VLUCB(P2)		;IS THE REQUESTED VOLUME MOUNTED?
	CAMN	S1,P1			;YES, IS THE OPR DOING THE RIGHT THING?
	SKIPA				;NOT MOUNTED OR CORRECT DRIVE, SKIP
	PJRST	E$VND##			;OPR PICKED WRONG DRIVE.. TELL HIM
	LOAD	S1,.VLOWN(P2),VL.OFF	;GET OFFSET OF CURRENT OWNER OF VOLUME
	CAIE	S1,-1			;IS THERE AN OWNER?
	PJRST	E$VAU##			;YES THERE IS, CAN'T USE THIS VOLUME
	LOAD	S1,.VLOWN(P3),VL.OFF	;GET OFFSET TO CURRENT OWNER OF VOLUME
	CAIE	S1,-1			;ANY OWNER AT ALL?
	PJRST	E$DAU##			;YES, MUST BE DIFFERENT VOLUME

	;Check Volume Characteristics

	DMOVE	S1,P3			;GET THE VOL AND VSL ADDRESSES

	PUSHJ	P,CVLVSL		;CHECK THE REQUESTED CHARACTERISTICS
					;AGAINST THE ACTUALS
	JUMPF	.RETF			;THEY DON'T MATCH .. COMPLAIN TO OPR

	LOAD	S2,.VSFLG(P4),VS.LBT	;GET THE REQUESTED LABEL TYPE
	CAXN	S2,.TFLBP		;USER WANTS BYPASS?
	JRST	IDEN.1			;YES,,JUST GO REASSIGN THE VOLUME

	LOAD	S1,.VLFLG(P3),VL.LBT	;GET VOLUME'S LABEL TYPE
	PUSHJ	P,GETLBT		;GET EASY CODE
	CAXE	S1,%LABEL		;IS THE MOUNTED VOLUME LABELED?
	JRST	IDEN.C			;NO,,CHECK VOLIDS
	LOAD	S1,.VLFLG(P2),VL.SCR	;YES,,GET THE VOLUME'S SCRATCH BIT
	JUMPE	S1,E$VIL##		;CAN'T HAVE LABELS & NOT BE SCRATCH

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

IDEN.C:	SKIPN	.VLNAM(P2)		;REQUESTED VOL MUST HAVE A NAME !!
	SKIPE	.VLNAM(P3)		; OR ELSE MOUNTED VOL MUST HAVE A NAME
	SKIPA				;YES TO EITHER,,WIN !!
	PJRST	E$NVI##			;BOTH NULL,,CAN'T DO THIS !!!

;FOUND A VOLUME MATCHUP.
;THERE MAY BE A VOL BLOCK OFF THE VSL FROM THE REQESTING MDR, AND
;ANOTHER FROM THE UCB FOR THE MOUNTED VOLUME.
;WE MAY HAVE TO MERGE THEM TOGETHER, AND THROW ONE AWAY.

IDEN.1:	CAIN	P2,0(P3)		;ARE OLD AND NEW VOL'S THE SAME ???
	JRST	IDEN.2			;YES,,DONT DELETE ANY - JUST CONTINUE
	MOVE	S1,.VLFLG(P3)		;GET ALL THE FLAGS FOR THIS UNIT'S VOL
	MOVEM	S1,.VLFLG(P2)		;SAVE IN REAL VOL BLOCK
	MOVE	S1,.VLNAM(P3)		;GET VOL NAME FOR THIS UNITS VOL BLK
	SKIPN	.VLNAM(P2)		;IS THERE A NAME IN THE USERS VOL BLOCK
	MOVEM	S1,.VLNAM(P2)		;NO,,SAVE UNITS NAME AS USERS NAME
	ZERO	.VLFLG(P2),VL.SCR	;CLEAR SCRATCH BIT
	MOVE	S1,VOLQUE		;GET LIST HANDLE FOR VOLUMES
	MOVE	S2,P3			;AIM AT THIS UNIT'S VOL
	PUSHJ	P,L%APOS		;POSITION TO THE VOL BLOCK OFF THE UCB
	PUSHJ	P,L%DENT		;AND GIVE IT THE GONG
	SETZM	.UCBVL(P1)		;UNLINK UCB FROM DESTROYED VOL
IDEN.2:	LOAD	S1,.VSFLG(P4),VS.LBT	;GET THE VOLUME SET LABEL TYPE
	STORE	S1,.VLFLG(P2),VL.LBT	;SAVE AS THE VOLUME LABEL TYPE
	MOVE	S1,P1			;AIM AT THIS UCB
	PJRST	REASSIGN		;TRY TO GIVE IT TO THE USER
					;RETURN AND COMPLAIN IF WE CAN'T
>;END TOPS10
	SUBTTL	REASSIGN - Try to give a unit to a user

	;CALL:	S1/ The UCB Address
	;	AP/ The MDR Address
	;
	;RET:	True - The device was reassigned with the specified logical name
	;       False - The device is owned, the Volume is owned,
	;		or he has Conflicting logical names

REASSIGN:
TOPS10 <
	PUSHJ	P,.SAVE4		;SAVE SOME REGS
	MOVE	P1,S1			;GET THE UCB ADDRESS IN P1
	MOVE	S1,.UCBNM(P1)		;GET THE DEIVCE NAME IN S1
	MOVEM	S1,MDAOBJ+OBJ.UN	;SAVE AS THE CURRENT UNIT
	MOVE	P2,.MRVSL(AP)		;GET THE VSL ADDRESS IN S1
	LOAD	P3,.VSCVL(P2),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	P3,.VSVOL(P2)		;POINT TO THE CURRENT VOL ADDRESS
	MOVE	P3,0(P3)		;GET THE VOLUME ADDRESS
	LOAD	T1,.VLOWN(P3),VL.OFF	;GET THE OFFSET TO THE VOLUME OWNER
	CAIE	T1,-1			;IS THERE ONE ???
	$RETF				;YES,,THATS AN ERROR
	MOVEM	P3,.UCBVL(P1)		;NO,,LINK THE VOL TO THE UCB
	MOVEM	P1,.VLUCB(P3)		;AND LINK THE UCB TO THE VOL
	MOVX	T1,%STAMN		;GET 'VOLUME MOUNTED' STATUS CODE
	STORE	T1,.VLFLG(P3),VL.STA	;SET IT IN THE VOLUME FLAG WORD
	LOAD	T1,.VLOWN(P3),VL.CNT	;GET THE VOLUME REQUEST COUNT
	MOVNS	T1			;NEGATE IT
	HRLS	T1			;MOVE RIGHT TO LEFT
	HRRI	T1,.VLVSL(P3)		;CREATE AN AOBJN AC

REAS.1:	CAME	P2,0(T1)		;FIND OUR VSL ADDRESS IN
	JRST	[AOBJN T1,REAS.1	;THE VOL VSL LIST. NOT THIS ONE,TRY NEXT
		 PUSHJ P,S..VSA ]	;NOT THERE,,WE'RE IN DEEP TROUBLE !!
	SUBI	T1,.VLVSL(P3)		;CALCULATE THE OWNER OFFSET
	STORE	T1,.VLOWN(P3),VL.OFF	;MAKE THIS GUY THE VOLUME OWNER

	LOAD	TF,.VSFLG(P2),VS.VSW	;IS THIS GUY IN VOLUME SWITCH MODE ???
	JUMPN	TF,REAS.S		;YES, THEN SWITCH UNITS

	MOVE	T2,.VSLNM(P2)		;GET THE LOGICAL NAME IN T2
	MOVE	T1,.UCBNM(P1)		;GET THE DEVICE NAME IN T1
	DEVLNM	T1,			;ASSIGN A LOGICAL NAME
	 $STOP(LNA,Logical Name Assignment Failed)
	LOAD	T1,.MRJOB(AP),MD.PJB	;GET THE JOB NUMBER IN T1
	MOVE	T2,.UCBNM(P1)		;GET THE DEVICE NAME IN T2
	REASSI	T1,			;REASSIGN THE DEVICE TO THE USER
	JUMPLE	T1,REAS.2		;FAILED, SEE WHY
	MOVEM	T2,MDAOBJ+OBJ.UN	;SAVE THE DEVICE NAME FOR LATER
	STORE	P1,.VSUCB(P2)		;LINK THE UCB TO THIS USER
	STORE	P2,.UCBVS(P1)		;LINK THIS USER TO THIS DEVICE

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

;Tell everyone who's interested!

	MOVE	S1,.MRVSL(AP)		;AIM AT THE VOLUME SET LIST
	PUSHJ	P,LBLNOT		;TELL THE LABEL PROCESSOR OF THE CHANGE
	$WTO	(<Volume ^W/.VLNAM(P3)/ Reassigned>,<^I/DEMO/>,MDAOBJ)
	$TEXT	(<-1,,MDABUF>,<Volume ^W/.VLNAM(P3)/ Mounted on ^W/.UCBNM(P1)/ as Logical Name ^W/.VSLNM(P2)/^0>)
	PUSHJ	P,USRNOT		;AND TELL THE USER
	$RETT				;AND RETURN

;Here if reassignment failed

REAS.2:	$WTO	(<User Reassignment Error, Request Deleted>,<^I/DEMO/>,MDAOBJ)
	$TEXT	(<-1,,MDABUF>,<Duplicate Logical Name for Volume-Set ^T/.VSVSN(P2)/, Request Deleted^0>)
	PUSHJ	P,USRNOT		;TELL THE USER THAT
	PJRST	D$DMDR			;REASSIGN FAILED,,DELETE THE MDR
	SUBTTL	REAS.S - Routine to Perform Volume Switch Processing

	;CALL:	P1/ New UCB addr
	;	P2/ VSL addr
	;	P3/ VOL addr
	;	P4/ Old UCB Addr
	;	AP/ MDR

REAS.S:	MOVE	P4,.VSUCB(P2)		;GET THE OLD UNIT BLOCK
	STORE	P1,.VSUCB(P2)		;LINK THE UCB TO THIS USER
	SETZM	.UCBVS(P4)		;AND THE OLD UNIT ISN'T TIED UP...
	STORE	P2,.UCBVS(P1)		;LINK THIS USER TO THIS DEVICE
	ZERO	.UCBST(P4),UC.VSW	;...WAITING FOR VOLUME SWITCH
	ZERO	.VSFLG(P2),VS.VSW	;...AND VSL ISN'T SWITCHING, EITHER
	MOVX	S1,.QOVSD		;VOLUME SWITCH DIRECTIVE BLOCK
	PUSHJ	P,LBLHDR		;START THE MESSAGE

;Build the First Block, Describing the Units Involved

	AOS	MDABUF+.OARGC		;ONE MORE BLOCK
	MOVEI	S2,MDABUF+.OHDRS	;AIM AT THE FIRST BLOCK SPACE
	MOVX	S1,.VSDBL		;BLOCK TYPE - DEVICES
	STORE	S1,ARG.HD(S2),AR.TYP	;SET IN BLOCK
	MOVX	S1,ARG.DA+VSDLEN	;SIZE OF THE BLOCK
	STORE	S1,ARG.HD(S2),AR.LEN	;LENGTH OF THIS ONE
	ADDI	S2,ARG.DA		;POINT AT THE DATA
	ADDM	S1,G$SAB##+SAB.LN	;AND SEND LENGTH, TOO
	MOVSS	S1			;TO LH
	ADDM	S1,MDABUF+.MSTYP	;UPDATE MESSAGE LENGTH
	LOAD	S1,.UCBNM(P4)		;GET OLD UNIT NAME
	STORE	S1,.VSDID(S2)		;SAVE IN MESSAGE
	LOAD	S1,.UCBNM(P1)		;GET NEW UNIT NAME
	STORE	S1,.VSDCD(S2)		;SAVE AS NEW UNIT NAME
	ADDI	S2,VSDLEN		;UPDATE POINTER PAST BLOCK

;Build the Second Block, Describing the Volume Set and User who Owns The Drive

	AOS	MDABUF+.OARGC		;ONE MORE BLOCK
	MOVX	S1,.VOLMN		;GET THE NEXT BLOCK TYPE
	STORE	S1,ARG.HD(S2),AR.TYP	;SAVE AS BLOCK TYPE
	MOVX	S1,.VMNSZ+ARG.DA	;GET THE LENGTH OF THE BLOCK
	STORE	S1,ARG.HD(S2),AR.LEN	;AND SAVE IN BLOCK HEADER
	ADDM	S1,G$SAB+SAB.LN		;UPDATE SEND LENGTH
	MOVSS	S1			;GET TO  LH
	ADDM	S1,MDABUF+.MSTYP	;UPDATE TOTAL MESSAGE LENGTH
	MOVEI	S2,ARG.DA(S2)		;AIM AT THE DATA PORTION OF THE BLOCK
	LOAD	S1,.VLNAM(P3)		;GET THE VOLUME NAME
	STORE	S1,.VMNIV(S2)		;SAVE AS INITIAL VOLUME NAME
	MOVEI	S1,.VSVOL(P2)		;AIM AT THE FIRST VOLUME BLOCK ADR
	MOVE	S1,(S1)			;GET THE ADR OF THE FIRST VOL BLOCK
	LOAD	S1,.VLNAM(S1)		;GET THE NAME OF THE FIRST VOLUME
	STORE	S1,.VMNFV(S2)		;SAVE IN MESSAGE TO LABELLER

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	LOAD	S1,.VSFLG(P2),VS.LBT	;GET THE LABEL TYPE
	STORE	S1,.VMNIN(S2),VI.LTY	;SAVE IN MESSAGE
	LOAD	S1,.VSFLG(P2),VS.WLK	;GET THE WRITE LOCK BIT
	STORE	S1,.VMNIN(S2),VI.WLK	;SAVE IN INFO WORD OF MESSAGE
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE JOB NUMBER
	STORE	S1,.VMNIN(S2),VI.JOB	;TEL THE LABELLER WHO'S THERE

;Tell everyone about it

	DMOVE	S1,[EXP SAB.SZ,G$SAB##]	;AIM AT THE SEND ARG BLOCK
	$CALL	C%SEND			;TELL THE LABELLER
	$WTO	(<Volume ^W/.VLNAM(P3)/ Reassigned>,<^I/DEMO/>,MDAOBJ) ;TELL OPR
	$TEXT	(<-1,,MDABUF>,<Logical name ^W/.VSLNM(P2)/ Switched to Volume ^W/.VLNAM(P3)/ on ^W/.UCBNM(P1)/^0>)
	PUSHJ	P,USRNOT		;TELL THE USER, IF INTERESTED
	MOVE	S1,P4			;GET TO THE OLD UNIT
	PUSHJ	P,MATUNI		;TRY TO GIVE IT AWAY
	$RETT				;RETURN TRUE IN ANY CASE
>
TOPS20<	$RETT	>			;REASSIGN FAILS ON THE -20
	SUBTTL	D$ENABLE/D$DISABLE TAPE DRIVE AVR STATUS

	;CALL:	M/ The Enable/Disable Message Address
	;
	;RET: True Always

TOPS10 <
D$ENABLE:  TDZA  S1,S1			;INDICATE 'ENABLE' ENTRY POINT
D$DISABLE: SETOM S1			;INDICATE 'DISABLE' ENTRY POINT
	PUSHJ	P,.SAVE2		;SAVE P1 AND P2 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE ENTRY POINT INDICATOR IN P1
	SETZM	P2			;ASSUME ALL TAPE DRIVES
	MOVX	S1,.TAPDV		;GET DRIVE BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN OUR MESSAGE
	JUMPF	ABLE.1			;NOT THERE,,THEN DO ALL DRIVES

	SETOM	P2			;ENABLE/DISABLE 1 UCB
	PUSHJ	P,FNDUCB		;GO FIND THE AFFECTED UCB
	JUMPF	.RETF			;NOT THERE,,DEVICE DOES NOT EXIST !!!
	MOVX	S2,UC.AVR		;GET THE AVR BIT IN S1
	SKIPN	P1			;IS THIS 'ENABLE' ???
	IORM	S2,.UCBST(S1)		;YES,,LITE THE AVR BIT
	SKIPE	P1			;OR IS THIS 'DISABLE' ???
	ANDCAM	S2,.UCBST(S1)		;YES,,CLEAR THE AVR BIT
	JRST	ABLE.4			;ACK THE OPERATOR AND RETURN

ABLE.1:	SETZM	P2			;ENABLE/DISABLE 'ALL' UCB'S
	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
ABLE.2:	LOAD	S1,.UCBST(S2),UC.AVA	;IS THIS DRIVE 'KNOWN' TO MDA?
	JUMPE	S1,ABLE.3		;NOPE, LEAVE ITS BITS ALONE
	MOVX	S1,UC.AVR		;GET THE AVR BIT IN S1
	SKIPN	P1			;IS THIS 'ENABLE' ???
	IORM	S1,.UCBST(S2)		;YES,,LITE THE AVR BIT
	SKIPE	P1			;OR IS THIS 'DISABLE' ???
	ANDCAM	S1,.UCBST(S2)		;YES,,CLEAR THE AVR BIT

ABLE.3:	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB ENTRY
	JUMPT	ABLE.2			;FOUND ONE,,GO PROCESS IT

ABLE.4:	SKIPN	P2			;WAS IT ALL TAPE DRIVES ???
	$ACK	(<AVR ^T/@DISENA+1(P1)/ for all Tape Drives>,,,.MSCOD(M))
	SKIPE	P2			;WAS IT A PARTICULAR TAPE DRIVE ???
	$ACK	(<AVR ^T/@DISENA+1(P1)/>,,MDAOBJ,.MSCOD(M))
	$RETT				;ACK THE OPERATOR AND RETURN

DISENA:	[ASCIZ/Disabled/]
	[ASCIZ/Enabled/]
>
	SUBTTL	D$RECOGNIZE - PROCESS THE OPR RECOGNIZE COMMAND

	;CALL:	M/ The Recognize Message Address
	;
	;RET:	True Always

TOPS10 <
D$RECO:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVX	S1,.TAPDV		;GET THE TAPE DEVICE NAME BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	E$IMO##			;NOT THERE,,THATS AN ERROR
	PUSHJ	P,FNDUCB		;FIND THE AFFECTED UCB
	JUMPF	.RETF			;NOT THERE,,THATS AN ERROR
	MOVE	S2,S1			;GET THE UCB ADDRESS IN S2

RECO.2:	SKIPN	S1,.UCBVL(S2)		;CHECK AND LOAD THE VOLUME ADDRESS
	JRST	RECO.3			;NO VOL ADDRESS,,ALLS OK
	LOAD	S1,.VLOWN(S1),VL.OFF	;GET THE OWNERS OFFSET
	CAIE	S1,-1			;IS THE VOLUME OWNED BY SOMEONE ???
	PJRST	E$VAU##			;YES, CAN'T DO RECOGNIZE

RECO.3:	MOVE	S1,.UCBNM(S2)		;PASS THE DEVICE NAME IN S1
	PJRST	SNDREC			;   AND SEND THE RECOGNIZE MESSAGE TO
>
					;   THE TAPE LABELER
	SUBTTL	D$AVR - Tape automatic volume recognizer


TOPS10 <
D$AVR:	LOAD	S1,.TONST(M),TON.TY	;GET DEVICE TYPE FROM MESSAGE
	CAXN	S1,.TYMTA		;IS IT A MAGTAPE?
	JRST	D$TAVR			;YES, GO DO AVR ON THE TAPE
	$RETT				;NO, COULD BE DISK, ETC, IGNORE IT
>
	SUBTTL	D$TAVR - Tape automatic volume recognizer

;This routine accepts unit on-line message from the monitor, and
; perhaps kicks the labeller to read the labels
; Call with M/ adr of message from monitor

TOPS10 <
D$TAVR:	$SAVE	<P1>
	LOAD	S1,.TONDV(M)		;GET DEVICE NAME
	PUSHJ	P,GETUCB		;FIND OUR BLOCK ON THIS GUY
	JUMPF	.RETT			;STRANGE, MONITOR IS FUNNY
	MOVE	S2,S1			;SAVE UCB ADR
	MOVX	S1,UC.AVR		;GET AVR ENABLED BIT
	TDNN	S1,.UCBST(S2)		;IS THIS DRIVE ENABLED?
	$RETT				;NO, IGNORE THE MESSAGE
	SKIPN	P1,.UCBVL(S2)		;GET ATTACHED VOLUME BLOCK, IF ANY
	JRST	TAVR.R			;NO VOLUME, GO READ THE LABELS
	LOAD	S1,.VLOWN(P1),VL.OFF	;THERE IS A VOLUME, IS IT OWNED?
	CAIN	S1,-1			;IS IT OWNED?
	JRST	TAVR.R			;NO, READ THE LABELS (AGAIN)
	LOAD	S1,.VLFLG(P1),VL.LBT	;IT IS OWNED, GET LABEL TYPE
	CAXN	S1,.TFLBP		;IS IT A BYPASS LABEL TAPE?
	$RETT				;YES, LEAVE IT ALL UP TO THE USER

TAVR.R:	MOVE	S1,.UCBNM(S2)		;GET BACK DRIVE NAME
	PJRST	SNDREC			;AND ASK PULSAR FOR SERVICE
>
	SUBTTL	D$DEVSTA - PROCESS TAPE/DISK STATUS MESSAGES

	;CALL:	M/ The Status Message Address
	;
	;RET:	True Always

TOPS10 <
D$DEVS:	PUSHJ	P,.SAVE4		;SAVE P1 TO P4
	MOVX	S1,.TLVOL		;GET THE VOLUME STATUS BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	MISC.3			;NOT THERE,,THATS AN ERROR
	MOVE	P1,S1			;SAVE THE MESSAGE DATA ADDRESS
	MOVE	S1,.TLDRV(P1)		;GET THE DEVICE NAME IN S1
	PUSHJ	P,GETUCB		;FIND THE DEVICE IN THE UCB CHAIN
	JUMPF	.RETF			;NOT FOUND,,THATS AN ERROR

DEV.1:	MOVE	P2,S1			;SAVE THE UCB ADDRESS IN P2
	LOAD	S1,.TLSTS(P1),TS.OFL	;IS THE STATUS OFFLINE ???
	JUMPN	S1,DEV.12		;YES,,GO PROCESS IT
	SKIPN	P3,.UCBVL(P2)		;CHECK AND LOAD THE VOL ADDRESS
	JRST	DEV.2			;NO VOLUME YET !!!

	LOAD	S1,.VLOWN(P3),VL.OFF	;GET THE OFFSET TO THE CURRENT OWNER
	CAIE	S1,-1			;IS THE VOLUME CURRENTLY OWNED ???
	JRST	DEV.2			;YES,,THEN GO CHECK LABEL TYPES
					;NO -
	SETZM	.VLUCB(P3)		;DELINK THE VOLUME FROM THE UCB
	SETZM	.UCBVL(P2)		;DELINK THE UCB FROM THE VOLUME
	LOAD	S1,.VLOWN(P3),VL.CNT	;ANY REQUESTORS FOR THIS VOLUME ???
	JUMPN	S1,DEV.2		;YES,,GO CHECK LABEL TYPES
	MOVE	S1,VOLQUE		;NO,,GET THE VOL QUEUE ID
	MOVE	S2,P3			;AND GET THE VOL ADDRESS
	PUSHJ	P,L%APOS		;POSITION TO IT
	PUSHJ	P,L%DENT		;AND DELETE IT !!
	SETZM	P3			;INDICATE NO VOLUME FOUND !!!

DEV.2:	LOAD	S1,.TLSTS(P1),TS.LAB	;GET THE MOUNTED VOLUME LABEL TYPE
	PUSHJ	P,GETLBT		;RECODE IT
	CAXN	S1,%UNLBL		;IS IT UNLABELED ???
	JRST	DEV.8			;YES,,CREATE A VOL BLOCK FOR IT

	;Here for a Labeled Volume Mount

DEV.3:	JUMPE	P3,DEV.4		;NO VOL MOUNTED,,FIND IT IN VOL QUEUE
	MOVE	S1,.VLNAM(P3)		;GET THE VOLUME ID
	CAMN	S1,.TLVOL(P1)		;DO THEY MATCH ???
	JRST	DEV.9			;YES,,JUST UPDATE THE STATUS
	$WTO	(<Mount Labeled Volume ^W/S1/ on This Drive>,,MDAOBJ)
	MOVE	S1,.UCBNM(P2)		;GET THE DEVICE THE VOL IS MOUNTED ON
	PUSHJ	P,UNLOAD		;UNLOAD THE DEVICE
	$RETT				;AND RETURN

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

DEV.4:	MOVE	S1,.TLVOL(P1)		;GET THE VOLUME NAME
	PUSHJ	P,CHKVOL		;FIND IT IN OUR DATA BASE
	JUMPF	DEV.8			;NOT THERE,,CREATE A NEW VOL BLOCK
	MOVE	P3,S1			;SAVE THE VOL BLOCK ADDRESS
	JUMPE	S2,DEV.9		;NOT MOUNTED,,LINK THIS VOL TO THE UCB
	MOVE	S1,.UCBNM(P2)		;GET THE DEVICE THE VOL IS MOUNTED ON
	PUSHJ	P,UNLOAD		;UNLOAD THE DEVICE
	$RETT				;ALREADY MOUNTED,,JUST RETURN

	;We could not find the mounted volume in our volume list,
	;so we will have to create an entry for it.

DEV.8:	MOVE	S1,VOLQUE		;GET THE VOL QUEUE ID
	MOVX	S2,VOLLEN		;GET THE VOL ENTRY LENGTH
	PUSHJ	P,L%CENT		;CREATE A VOL ENTRY
	MOVE	P3,S2			;SAVE THE ENTRY ADDRESS
	MOVE	S1,.TLVOL(P1)		;PICK UP THE VOLUME NAME
	MOVEM	S1,.VLNAM(P3)		;SAVE IT IN THE VOL ENTRY
	SETOM	S1			;GET A NEGATIVE 1
	STORE	S1,.VLOWN(P3),VL.OFF	;SET NO CURRENT OWNER YET !!!

	;Having set everything up, link the VOL and UCB together
	;and go finish updating the volume status

DEV.9:	MOVEM	P3,.UCBVL(P2)		;LINK THE VOLUME TO THE UCB
	MOVEM	P2,.VLUCB(P3)		;LINK THE UCB TO THE VOLUME

	;Update the volume status and tell the operator whats going on.

DEV.10:	ZERO	.UCBST(P2),UC.OFL	;ZAP THE OFFLINE BIT
	LOAD	S1,.TLSTS(P1),TS.LOK	;GET THE WRITE LOCK STATUS
	STORE	S1,.UCBST(P2),UC.WLK	;SAVE THE WRITE LOCK STATUS
	LOAD	S1,.TLSTS(P1),TS.DEN	;GET THE TAPE DENSITY
	SETZM	S2			;CLEAR S2
	CAXN	S1,.TFD20		;IS THE DENSITY 200 BPI ???
	TXO	S2,UC.200		;YES,,SET IT
	CAXN	S1,.TFD55		;IS THE DENSITY 556 BPI ???
	TXO	S2,UC.556		;YES,,SET IT
	CAXN	S1,.TFD80		;IS THE DENSITY 800 BPI ???
	TXO	S2,UC.800		;YES,,SET IT
	CAXN	S1,.TFD16		;IS THE DENSITY 1600 BPI ???
	TXO	S2,UC.1600		;YES,,SET IT
	CAXN	S1,.TFD62		;IS THE DENSITY 6250 BPI ???
	TXO	S2,UC.6250		;YES,,SET IT
	CAXE	S1,.TFD00		;IS IT SYSTEM DEFAULT (UNREADABLE TAPE)
	TDNE	S2,.UCBST(P2)		;MUST BE A SUPPORTED DENSITY !!!
	SKIPA				;DEFAULT, OR SUPPORTED DENSITY, GO ON
	$STOP	(ITD,Invalid Tape Density Specified for ^W/.UCBNM(P2)/)
	STORE	S1,.VLFLG(P3),VL.DEN	;OK,,SAVE THE VOLUME DENSITY

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVE	P4,S1			;SAVE HERE ALSO FOR WTO
	LOAD	S1,.TLSTS(P1),TS.LAB	;GET THE VOLUME LABEL TYPE
	STORE	S1,.VLFLG(P3),VL.LBT	;SAVE IT
	MOVE	P1,S1			;HERE ALSO

	;If Unlabeled,,Just Tell OPR Whats Going On

	PUSHJ	P,GETLBT		;RECODE THE LABEL TYPE
	CAXE	S1,%LABEL		;IS IT LABELED ???
	JRST	DEV.11			;NO,,FINISH UP

	;If Labeled,See is we can Give the Volume Away

	MOVE	S1,P2			;GET UCB ADR
	PUSHJ	P,MATUNI		;TRY TO MATCH THIS UNIT WITH A REQUEST
	JUMPT	.RETT			;DONE, DON'T BOTHER THE OPERATOR
	LOAD	S1,.UCBST(P2),UC.WLK	;GET THE WRITE LOCKED BIT
	$WTO	(<Volume ^W/.VLNAM(P3)/ Mounted>,<^T/@LABELS(P1)/ Labels, ^T/@DENSTY(P4)/ BPI, Write-^T/@WRTENA(S1)/>,MDAOBJ)
	$RETT				;AND RETURN

DEV.11:	LOAD	S1,.UCBST(P2),UC.WLK	;GET THE WRITE LOCKED BIT
	$WTO	(< Unlabeled Volume Mounted >,<Density ^T/@DENSTY(P4)/ BPI, Write-^T/@WRTENA(S1)/>,MDAOBJ)
	$RETT				;TELL OPR AND RETURN

	;Here for device offline

DEV.12:	MOVX	S1,UC.OFL		;GET THE OFFLINE BIT
	IORM	S1,.UCBST(P2)		;LIGHT IT
	$WTO	( Offline ,,MDAOBJ)	;TELL THE OPERATOR
	$RETT				;AND RETURN
>
	SUBTTL	MATUNI - Routine to match a unit with a request

	;CALL:	S1/ The UCB Address
	;
	;RET:	True if UCB is Reassigned to a Request
	;      False if an Error Occured

TOPS10 <
MATUNI:	$SAVE	<P1,AP>
	MOVE	P1,S1			;COPY UCB ADR INTO PROTECTED REG
	SKIPN	S1,.UCBVL(P1)		;CHECK VOLUME BLOCK ADR
	$RETF				;NO VOLUME, CAN'T REASSIGN
	LOAD	S1,.VLFLG(S1),VL.LBT	;GET THE VOLUME LABEL TYPE
	PUSHJ	P,GETLBT		;RECODE IT TO SOMETHING INTELLIGENT
	CAXE	S1,%LABEL		;IS THE VOLUME LABELED ???
	$RETF				;NO,,RETURN NOW !!!
	MOVE	S1,.UCBVL(P1)		;GET THE VOL ADDRESS IN S1
	PUSHJ	P,PIKVSL		;CHOOSE A VSL FOR THIS VOLUME
	JUMPF	.RETF			;CAN'T, SO WE CAN'T REASSIGN
	MOVE	AP,.VSMDR(S1)		;GOT A VSL, STEP TO MDR
	MOVE	S1,P1			;PASS THE UCB ADDRESS IN S1
	PJRST	REASSIGN		;TRY TO REASSIGN, AND PASS SUCCESS ON UP
>;END TOPS10
	SUBTTL	PIKVSL - PICK A VSL FOR VOLUME ASSIGNMENT

; This routine takes a VOL block adr in S1 and chooses one
; of its attached VSLs for the volume to be given to.
;Call with S1/ VOL block adr
;Returns True, VSL adr in S1 if one was chosen
;False if no VSL was chosen

TOPS10<
PIKVSL:	$SAVE	<P1,P2>			;SAVE SOME WORK REGS
	LOAD	S2,.VLOWN(S1),VL.CNT	;GET THE NUMBER OF REQUESTORS
	JUMPE	S2,.RETF		;NO REQUESTORS, SO NO VSL MATCH
	LOAD	S2,.VLOWN(S1),VL.OFF	;SOME, GET OFFSET TO CURRENT OWNER
	CAIE	S2,-1			;ANY OWNER AT ALL?
	$RETF				;YES, CAN'T GIVE AWAY THIS VOLUME
	MOVE	P1,S1			;PRESERVE VOL BLOCK ADDR

	;Check the UCB for Volume Switch Status. If Switching Volumes,
	;	Only check the VSL which Controls The Unit.

	MOVE	S1,.VLUCB(P1)		;GET THE VOLUME'S UCB ADDRESS
	LOAD	P2,.UCBST(S1),UC.VSW	;GET THE VOLUME SWITCH BIT
	JUMPE	P2,PIKV.0		;NOT IN VOLUME SWITCH,,SKIP THIS
	LOAD	P2,.UCBVS(S1)		;YES,,GET THE OWNER (VSL) ADDRESS IN P2
	LOAD	S1,.VSCVL(P2),VS.OFF	;YES,,GET THE OWNERS CURRENT VOL OFFSET
	ADDI	S1,.VSVOL(P2)		;AND POINT TO THE CURRENT VOL ADDRESS
	CAME	P1,0(S1)		;IS IT POINTING TO THIS VOLUME ???
	$RETF				;NO,,JUST RETURN
	MOVE	S1,P1			;YES,,GET THE VOL ADDRESS IN S1
	PUSHJ	P,CVLVSB		;CHECK VOLUME CHARACTERISTICS
	JUMPF	.RETF			;THEY DON'T MATCH
	MOVE	S1,P2			;GET THE VSL ADDRESS IN S1
	$RETT				;AND RETURN

	;Here if the Device can be Assigned to any Requestor.

PIKV.0:	LOAD	P2,.VLOWN(P1),VL.CNT	;GET THE COUNT OF VOLUME REQUESTORS
	MOVNS	P2			;GET NEGATIVE NUMBER OF REQUESTORS
	MOVSS	P2			;IN LEFT HALF
	HRRI	P2,.VLVSL(P1)		;AND MAKE AOBJN PTR TO VSL LIST
PIKV.1:	MOVE	S2,0(P2)		;GET THE CURRENT VSL
	LOAD	S1,.VSCVL(S2),VS.OFF	;GET THIS VSL'S OFFSET TO ITS CURR VOL
	ADDI	S1,.VSVOL(S2)		;POINT TO THE ADDR OF ITS CURRENT VOLUME
	CAME	P1,0(S1)		;IS THIS VSL POINTING TO THIS VOL ???
	JRST	PIKV.2			;NO,,TRY NEXT VSL !!!
	MOVE	S1,P1			;POINT S1 AT THE VOL BLOCK
	PUSHJ	P,CVLVSB		;COMPARE ATTRIBUTES OF VOL AND VSL
	JUMPT	[MOVE S1,0(P2)		;THEY MATCH, GET POINT AT WINNING VSL
		 $RETT]			;AND TELL CALLER
PIKV.2:	AOBJN	P2,PIKV.1		;THEY DON'T, TRY THE NEXT VSL
	$RETF				;NONE MATCH, TELL CALLER
>;END TOPS10
	SUBTTL	CVLVSL - Compare Volume with Volume Set

;This routine will check the user requested attributes of the
; mount request with the attributes of a particular mounted volume
; The caller must make sure that the volume is free to be
; reassigned to the user should the attributes match.
; Call with
;	S1/ addr of VOL block
;	S2/ addr of VSL block
; Returns
;	TRUE, if all the attributes match
;	FALSE, if they don't. G$ERR will have an appropriate error code.
;		eg. ER$URW, ER$URE, etc
; Alternate entry at CVLVSB which will not match bypass requests

TOPS10<
	.TFLNV==12	;DEFINE HERE TILL PUT IN UUOSYM

CVLVSB:	LOAD	TF,.VSFLG(S2),VS.LBT	;GET THE REQUESTED LABEL TYPE
	CAXN	TF,.TFLBP		;BYPASS REQUESTED?
	PJRST	E$URB##			;YES, MUST COME THRU IDENTIFY

CVLVSL:	$SAVE	<P1,P2,P3>
	DMOVE	P1,S1			;COPY THE VOL, AND VSL PTRS
	SKIPN	P3,.VLUCB(P1)		;GET THE UNIT BLOCK
	PJRST	E$NVM##			;SHOULDN'T HAPPEN BUT KEEP GOING

	;Check the state of the write-ring against the user request

	LOAD	S1,.UCBST(P3),UC.WLK	;GET THE LOCK BIT FOR THIS VOLUME
	LOAD	S2,.VSFLG(P2),VS.WLK	;GET THE ENABLE BIT FOR THE REQUEST
	CAME	S1,S2			;DO THEY MATCH ???
	PJRST	[JUMPN S2,E$URW##	;NO MATCH HERE - USER WANTS LOCKED
		 PJRST E$URE##  ]	;USER ASKED FOR ENABLED

	;Check for conflicting label types

	LOAD	S1,.VSFLG(P2),VS.LBT	;GET REQUESTED LABEL TYPE
	CAXN	S1,.TFLNV		;IS IT NO LABELS/NO EOV PROCESSING ???
	MOVX	S1,.TFLNL		;YES,,MAKE IT NO LABELS, PERIOD !
	LOAD	S2,.VLFLG(P1),VL.LBT	;GET LABEL TYPE OF THIS VOLUME
	CAXN	S2,.TFLNV		;IS IT NO LABELS/NO EOV PROCESSING ???
	MOVX	S2,.TFLNL		;YES,,MAKE IT NO LABELS, PERIOD !
	CAME	S1,S2			;MATCH?
	CAXN	S1,.TFLBP		;NO, BUT ASKING FOR BYPASS LABELS?
	SKIPA				;MATCH.. OR REQUESTING BLP, WIN
	JRST	[CAXN S1,.TFLNL		;USER WANTED UNLABELED?
		PJRST	E$VIL##		;NO, VOLUME IS LABELED
		PJRST	E$URL##]	;YES, COMPLAIN ABOUT THAT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	;Check for density conflicts

	LOAD	P3,.VSATR(P2),VS.DEN	;GET REQUESTED DENSITY
	CAXN	P3,.TFD00		;DEFAULT?
	$RETT				;YES, TAKE WHATEVER IS THERE
	LOAD	S1,.VLFLG(P1),VL.DEN	;GET DENSITY OF THIS VOLUME
	CAME	S1,S2			;REQUESTED MATCH ACTUAL?
	PJRST	E$RDD##			;NO, TOO BAD
	$RETT				;YES, WIN
>;END TOPS10
	SUBTTL	D$UNLOAD - ROUTINE TO UNLOAD A TAPE DRIVE

	;CALL:	M/ The Unload Message Address
	;
	;RET:	True Always

TOPS10 <
D$UNLO:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVX	S1,.TAPDV		;GET THE DRIVE BLOCK TYPE CODE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	E$IMO##			;INVALID ORION MESSAGE SENT !!!
	PUSHJ	P,FNDUCB		;FIND THE AFFECTED UCB
	JUMPF	.RETF			;NOT THERE,,THATS AN ERROR
	MOVE	P1,S1			;SAVE THE UCB ADDRESS IN P1
	MOVE	S1,.UCBNM(P1)		;GET THE DEVICE NAME IN S1
	SKIPN	S2,.UCBVL(P1)		;CHECK AND LOAD THE VOLUME ADDRESS
	PJRST	UNLOAD			;NO VOLUME ON IT,,JUST SEND THE MSG
	LOAD	S1,.UCBST(P1),UC.VSW	;IS THIS UNIT IN VOLUME SWITCH MODE ??
	JUMPN	S1,UNLO.1		;YES,,OK TO UNLOAD THE TAPE !!!
	LOAD	S1,.VLOWN(S2),VL.OFF	;GET THE OFFSET TO THE VOL OWNER
	CAIE	S1,-1			;IS THERE AN OWNER ???
	PJRST	E$VAU##			;YES, CAN'T UNLOAD THAT ONE
UNLO.1:	$ACK	( Unloading ,,MDAOBJ,.MSCOD(M)) ;TELL THE OPERATOR
	MOVE	S1,.UCBVL(P1)		;POINT AT THIS VOLUME
	PJRST	VLUNLOAD		;AND DELINK ALL THE GOOD STUFF
>;END TOPS10
	SUBTTL	VLUNLOAD - Unload a unit and break UCB-VOL links

	;CALL:	S1/ The Volume Block Address
	;
	;RET:	True Always

	;This routine will break the VOL - UCB links and request PULSAR
	;	to unload the drive. In addition, if there are no more
	;	requestors for the volume, the volume block is deleted.

TOPS10<
VLUNLO:	MOVE	S2,.VLUCB(S1)		;GET THE UCB ADDRESS IN S2
	ZERO	.UCBVL(S2)		;DELINK UCB FROM THE VOL
	ZERO	.VLUCB(S1)		;DELINK THE VOL FROM THE UCB
	SETOM	TF			;GET A -1
	STORE	TF,.VLOWN(S1),VL.OFF	;INDICATE NO CURRENT OWNER FOR THIS VOL
	MOVX	TF,UC.OFL		;GET 'DEVICE OFFLINE' BIT
	IORM	TF,.UCBST(S2)		;LITE IT IN THE UCB
	LOAD	TF,.VLOWN(S1),VL.CNT	;GET THE NUMBER OF REMAINING REQUESTORS
	EXCH	S1,S2			;GET S1=UCB, S2=VOL ADDRESS
	MOVE	S1,.UCBNM(S1)		;GET THE NAME OF THE UNIT
	JUMPN	TF,UNLOAD		;ANY MORE REQUESTORS ?? YES,JUST UNLOAD
	PUSH	P,S1			;SAVE UNIT NAME
	MOVE	S1,VOLQUE		;GET A HANDLE FOR THE VOLUME LIST
	$CALL	L%APOS			;POSITION TO THIS VOLUME BLOCK (IN S2)
	$CALL	L%DENT			;AND DELETE THIS VOLUME BLOCK
	POP	P,S1			;GET BACK UNIT NAME
	PJRST	UNLOAD			;AND UNLOAD THE DRIVE
>;END TOPS10
	SUBTTL	D$DELETE - ROUTINE TO DELETE AN MDR VIA OPERATOR REQUEST

	;CALL:	M/ The Delete Msg Address
	;
	;RET:	True Always

TOPS10 <
D$DELE:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVX	S1,.ORREQ		;GET THE REQUEST ID BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	E$CNI##			;NOT THERE,,THATS AN ERROR
	MOVE	S1,0(S1)		;PICK UP THE REQUEST ID IN S1
	MOVE	P1,S1			;SAVE IT IN P1 FOR LATER
	PUSHJ	P,FNDMDR		;GO FIND THE REQUESTED MDR
	JUMPF	.RETT			;NOT FOUND,,JUST RETURN
	LOAD	T1,.MRRID(AP),MR.CNT	;GET THE VSL COUNT FOR THIS MDR
	MOVNS	T1			;NEGATE IT
	HRLZS	T1			;MOVE RIGHT OT LEFT
	HRRI	T1,.MRVSL(AP)		;CREATE AN AOBJN AC FOR THE VSL LIST

DELE.1:	MOVE	T2,0(T1)		;PICK UP A VSL ADDRESS
	SKIPE	.VSUCB(T2)		;IS VSL ALLOCATED TO A DEVICE ???
	PJRST	E$CDA##			;YES,,TOO BAD - CAN'T DO THE DELETE !!
DELE.2:	AOBJN	T1,DELE.1		;CONTINUE CHECK THROUGH ALL THE VSL'S

	$ACK	(Mount Request ^D/P1/ Canceled,,,.MSCOD(M)) ;TELL THE OPR
	MOVE	S1,[POINT 7,MDABUF]	;GET A FRESH BUFFER POINTER
	MOVEM	S1,MDBPTR		;SAVE FOR TEXT OUTPUT ROUTINE
	$TEXT	(MDADBP,<Mount Request ^W/.MRREQ(AP)/ Canceled by the Operator^A>)
	MOVX	S1,.ORREA		;GET THE REASON BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	SKIPF				;NOT THERE,,OH WELL
	$TEXT	(MDADBP,<^M^JReason:^T/0(S1)/^A>) ;ADD THE REASON
	SETZM	S1			;GET A NULL BYTE (ALSO NO 2OND ACK)
	PUSHJ	P,MDADBP		;MAKE THE MESSAGE ASCIZ
	PUSHJ	P,USRNOT		;TELL THE SAD STORY TO THE USER
	PJRST	D$DMDR			;RETURN THROUGH THE DELETE MDR CODE
>;END TOPS10
	SUBTTL	D$SMDA - Set tape drive un/available

	;CALL:	M/ The message Address
	;
	;RET:	True Always

TOPS10<
D$SMDA:	$SAVE	<P1,P2>			;SAVE SOME SPACE
	MOVX	S1,.TAPDV		;CODE TO FIND A TAPE DEVICE BLOCK
	PUSHJ	P,A$FNDB##		;FIND THAT IN THE MESSAGE
	JUMPF	I$CNI##			;CAN'T THAT'S AN ERROR
	MOVE	P2,S1			;SAVE ADDR OF ASCII DEVICE NAME
	SETZM	P1			;ASSUME WE ARE 'SET AVAILABLE'
	MOVX	S1,.DVAVL		;CODE FOR SET AVAILABLE
	PUSHJ	P,A$FNDB##		;TRY TO FIND THAT ONE
	JUMPT	STAP.1			;SET AVAILABLE.. GO DO IT
	MOVEI	P1,1			;MAKE IT 'SET UNAVAILABLE'
	MOVX	S1,.DVUAV		;CODE FOR SET UNAVAILABLE
	PUSHJ	P,A$FNDB##		;TRY FOR THAT ONE
	JUMPF	I$CNI##			;NEITHER, THAT'S AN ERROR (PROBABLY INITIALIZE)
	MOVE	S1,P2			;GET BACK ADDR OF ASCII DEV NAME
	PUSHJ	P,FNDUCB		;FIND THE AVAILABLE UCB
	JUMPF	.RETF			;CAN'T... GO AWAY AND COMPLAIN
	MOVE	P2,S1			;FOUND THE UCB.. SAVE IT
	SKIPN	S2,.UCBVL(P2)		;IS THERE A VOLUME ON THIS DRIVE?
	JRST	STAP.2			;NO, THAT'S OKAY
	LOAD	S1,.VLOWN(S2),VL.OFF	;GET OFFSET TO CURRENT OWNER
	CAIE	S1,-1			;IS THERE AN OWNER
	PJRST	E$VAU##			;YES, CAN'T SET UNAVAILABLE
	MOVE	S1,.UCBVL(P2)		;AIM AT THE VOLUME
	PUSHJ	P,VLUNLOAD		;DELINK THIS VOLUME, AND UNLOAD IT
	JRST	STAP.2			;DO THE WORK

;Here to check for setting available

STAP.1:	MOVE	S1,P2			;GET BACK ADDR OF ASCII DEVICE NAME
	PUSHJ	P,LOCUCB		;FIND UCB, UNAVAILABLE OR NOT
	JUMPF	.RETF			;COULDN'T... MUST BE BAD DEVICE
	MOVE	P2,S1			;FOUND IT.. SAVE ADDR OF UCB
	LOAD	S1,.UCBST(P2),UC.AVA	;IS IT ALREADY AVAILABLE?
	JUMPN	S1,E$DAD##		;YES, TELL OPR
	MOVE	S1,.UCBNM(P2)		;GET DRIVE NAME
	PUSHJ	P,I$CKAV##		;IS IT IN USE (ACCORDING TO MONITOR)?
	JUMPT	E$DAU##			;YES, CAN'T KILL THAT DRIVE
	MOVE	S1,.UCBNM(P2)		;NOT IN USE, GET DEVICE NAME AGAIN
	PUSHJ	P,SNDREC		;TELL THE TAPE LABELLER TO READ LABELS
;	PJRST	STAP.2			;FALL THRU TO CLEAN UP THE BITS

STAP.2:	MOVE	S1,.UCBNM(P2)		;GET BACK DEVICE NAME
	PUSHJ	P,@[I$MDAS##		;SET MDA CONTROL (AVAILABLE)
		    I$MDAC##](P1)	;NO MDA CONTROL (UNAVAILABLE)
	JUMPF	STAP.3			;COULD NOT DO IT

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVX	S2,UC.AVA+UC.AVR	;GET AVAILABLE+AVR BITS
	XCT	[IORM S2,.UCBST(P2)	;AVAILABLE, LIGHT THE BITS
		ANDCAM S2,.UCBST(P2)](P1) ;UNAVAILABLE, CLEAR THE BITS
	$ACK	(< ^T/@AVA(P1)/ For Use >,,MDAOBJ,.MSCOD(M))
	$RETT				;RETURN

STAP.3:	$ACK	(<Could Not Set Device ^T/@AVA(P1)/ For Use>,,MDAOBJ,.MSCOD(M))
	$RETT				;RETURN

>;END TOPS10
	SUBTTL	D$VSR - VOLUME SWITCH REQUEST FROM PULSAR

	;CALL:	M/ The VSR Message Address
	;
	;RET:	True Always

TOPS10	<
D$VSR:	PUSHJ	P,.SAVE4		;SAVE SOME AC'S FOR A MINUTE
	MOVX	S1,.RECDV		;GET THE DEVICE BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	MISC.3			;NOT THERE,,PULSAR MESSAGE ERROR
	MOVE	S1,0(S1)		;GET THE SIXBIT DEVICE NAME
	PUSHJ	P,GETUCB		;FIND ITS UCB ENTRY
	JUMPF	.RETF			;NOT THERE,,JUST RETURN
	MOVE	P1,S1			;SAVE THE UCB ADDRESS

	;A Little Security Check

	LOAD	TF,.UCBST(P1),UC.VSW	;GET THE VOLUME SWITCH BIT
	SKIPE	P3,.UCBVL(P1)		;MUST BE A VOLUME ON THE DRIVE
	SKIPE	TF			;AND MUST NOT BE SWITCCHING VOLUMES !!!
	$STOP(IVR,Invalid Volume Switch Requested) ;STOPCODE FOR THE TIME BEING
	LOAD	S1,.VLOWN(P3),VL.OFF	;GET THE OFFSET TO THE CURRENT OWNER
	CAIN	S1,-1			;IS THERE AN OWNER ???
	PUSHJ	P,S..IVR		;NO,,WE'RE IN DEEP TROUBLE

	;So Far, So Good

	ADDI	S1,.VLVSL(P3)		;POINT TO THE CURRENT OWNER VSL
	MOVE	P2,0(S1)		;AND LOAD THE VSL ADDRESS INTO P2
	MOVX	S1,.RLVOL		;GET THE RELATIVE VOLUME BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN OUR MESSAGE
	JUMPF	MISC.3			;NOT THERE,,ANOTHER PULSAR ERROR
	MOVE	S2,0(S1)		;GET THE BLOCK DATA IN S2
	SETZM	P4			;DEFAULT TO READING THE VOLUME SET
	TXNE	S2,%VWRT		;IS HE WRITING THE VOLUME SET ???
	SETOM	P4			;YES,,INDICATE WRITING VOLUME
	LOAD	S2,S2,RLV.CD		;GET THE OFFSET CODE FOR THE NEXT VOLUME
	LOAD	T1,.VSCVL(P2),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	CAXN	S2,%RLNXT		;DO WE WANT THE NEXT VOLUME ???
	ADDI	T1,1			;YES,,BUMP OFFSET BY 1
	CAXN	S2,%RLPRV		;DO WE WANT THE PREVIOUS VOLUME ???
	SUBI	T1,1			;YES,,DECRIMENT OFFSET BY 1
	CAXN	S2,%RLFIR		;DO WE WANT THE FIRST VOLUME ???
	SETZM	T1			;YES,,OFFSET IS 0

	SKIPGE	T1			;OFFSET CAN'T BE NEGATIVE !!
	$STOP	(ONV,Offset of New Volume is Invalid) ;LEAVE THIS FOR A WHILE

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	;P4 = -1 Writing Volume Set. 
	;P4 =  0 Reading Volume Set.
	;P4 =  1 Extending Volume Set.

	LOAD	S2,.VSCVL(P2),VS.CNT	;GET THE VOLUME COUNT IN S2
	CAIG	T1,-1(S2)		;NEW OFFSET MUST BE LESS OR EQUAL
	JRST	VSR.0			;OK,,SKIP THIS
	CAILE	T1,^D60			;MORE THEN 60 VOLUMES ???
	SETZM	P4			;YES,,MAKE SURE WE EXIT THROUGH VSREOV
	MOVE	S1,P1			;GET THE UCB ADDRESS IN S1
	JUMPE	P4,VSREOV		;P4=0,,SEND EOV MSG TO PULSAR
	MOVEI	P4,1			;SET FLAG INDICATING VOL SET EXTENSION

VSR.0:	MOVE	S1,.UCBNM(P1)		;GET THE DEVICE NAME IN S1
	PUSHJ	P,REWIND		;REWIND THE LAST VOLUME
	MOVX	S1,UC.VSW		;GET THE VOLUME SWITCH STATUS BITS
	IORM	S1,.UCBST(P1)		;LITE IT IN THE UCB
	MOVX	S1,VS.VSW		;GET THE VOLUME SWITCH STATUS BITS
	IORM	S1,.VSFLG(P2)		;LITE IT IN THE VSL
	SETOM	S1			;GET A -1
	STORE	S1,.VLOWN(P3),VL.OFF	;CLEAR CURRENT OWNER INDICATION
	MOVEM	P1,.VSUCB(P2)		;LINK THIS UCB TO THIS VSL
	STORE	T1,.VSCVL(P2),VS.OFF	;SAVE THE OFFSET TO THE NEW VOLUME
	JUMPG	P4,VSR.1		;IF EXTENDING VOLUME SET,,SKIP THIS

	MOVE	AP,.VSMDR(P2)		;SETUP THE MDR ADDRESS
	PUSHJ	P,MOUNT			;TRY TO MOUNT THE NEXT VOLUME
	$RETT				;WIN OR LOSE, KEEP GOING

	;Here if we need the next volume in the volume set and there are no
	;more volumes in the VSL. If reading the volume set, return EOV. If
	;writing the volume set, generate a new VOL block for another volume
	;and ask the OPR to mount another volume. Only add volumes up
	;to a max of 60, after which send the EOV msg to PULSAR.

VSR.1:	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID
	MOVE	S2,P2			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,L%APOS		;POSITION TO THE VSL IN THE QUEUE
	PUSHJ	P,L%SIZE		;GET THIS VSL'S LENGTH (IN S2)
	MOVE	P4,S2			;SAVE THE OLD VSL LENGTH
	ADDI	S2,1			;ADD 1 FOR NEW VOL BLOCK
	PUSHJ	P,L%CENT		;CREATE A NEW VSL FOR THIS GUY
	MOVE	P3,S2			;SAVE THE NEW VSL ADDRESS
	HRL	S2,P2			;GET OLD VSL ADDR,,NEW VSL ADDR
	ADDI	P4,-1(P3)		;GET NEW VSL END -1
	BLT	S2,0(P4)		;COPY OLD VSL TO NEW VSL
	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID
	MOVE	S2,P2			;GET THE OLD VSL ADDRESS
	PUSHJ	P,L%APOS		;POSITION TO THE OLD VSL
	PUSHJ	P,L%DENT		;AND DELETE IT !!!

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVE	AP,.VSMDR(P3)		;GET THE MDR ADDRESS
	LOAD	S1,.MRRID(AP),MR.CNT	;GET THE VSL COUNT
	MOVNS	S1			;NEGATE IT
	MOVSS	S1			;MOVE RIGHT TO LEFT
	HRRI	S1,.MRVSL(AP)		;CREATE AOBJN FOR VSL LIST

VSR.2:	CAMN	P2,0(S1)		;IS THIS THE VSL WE WANT ???
	MOVEM	P3,0(S1)		;YES,,CHANGE OLD VSL PTR TO NEW VSL
	AOBJN	S1,VSR.2		;CHECK AGAIN

	LOAD	S1,.VSCVL(P3),VS.CNT	;GET THE VOL COUNT FOR THIS VSL
	MOVNS	S1			;NEGATE IT
	MOVSS	S1			;MOVE RIGHT TO LEFT
	HRRI	S1,.VSVOL(P3)		;CREATE AOBJN FOR VOL LIST

VSR.3:	MOVE	P4,0(S1)		;GET FIRST/NEXT VOL ADDRESS IN P4
	LOAD	S2,.VLOWN(P4),VL.CNT	;GET THE VSL COUNT FOR THIS VOLUME
	MOVNS	S2			;NEGATE IT
	MOVSS	S2			;MOVE RIGHT TO LEFT
	HRRI	S2,.VLVSL(P4)		;CREATE AOBJN FOR VSL LIST

VSR.4:	CAMN	P2,0(S2)		;IS THIS VOL POINTING AT OLD VSL ???
	JRST	[MOVEM P3,0(S2)		;YES,,POINT IT AT THE NEW VSL
		 JRST  VSR.5  ]		;AND CONTINUE
	AOBJN	S2,VSR.4		;CONTINUE THROUGH ALL VSL'S
VSR.5:	AOBJN	S1,VSR.3		;CONTINUE THROUGH ALL VOL'S

	MOVE	S1,.VSUCB(P3)		;GET THE DEVICE THIS GUY OWNS
	MOVEM	P3,.UCBVS(S1)		;AND POINT IT AT THE OWNERS NEW VSL
	MOVE	S1,P3			;GET OUR VSL ADDRESS
	PUSHJ	P,GENVOL		;CREATE A 'SCRATCH' VOL BLOCK

	LOAD	S1,.VSFLG(P3),VS.WLK	;GET THE WRITE LOCKED BIT IN S1
	LOAD	S2,.VSFLG(P3),VS.LBT	;GET THE LABEL TYPE IN S2
	$WTO	(< Tape Mount Request #^D/.MRRID(AP),MR.RID/ >,<From ^I/DEMO/^M^JScratch Volume, Write-^T/@WRTENA(S1)/, ^T/@LABELS(S2)/ Labels^T/BELLS/>,,<$WTFLG(WT.SJI)>)
	$RETT				;NOTIFY THE OPERATOR AND RETURN
>
	SUBTTL	VSREOV - ROUTINE TO SEND END OF VOLUME MSG TO TAPE LABELER

	;Send a End Of Volume-Set Message to the Tape Labeler on a Volume
	;	Switch Request in which there are no more Volumes in the
	;	Set.


	;CALL:	S1/ The UCB Address
	;
	;RET:	True Always

TOPS10	<
VSREOV:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE UCB ADDRESS
	MOVX	S1,.QOVSD		;GET VOLUME SET DIRECTIVE MSG TYPE
	PUSHJ	P,LBLHDR		;SETUP THE MSG TO TAPE LABELER
	AOS	MDABUF+.OARGC		;BUMP ARG COUNT BY 1
	MOVX	S1,%VEOF		;GET THE END OF VOLUME SET FLAG
	STORE	S1,MDABUF+.MSFLG	;SAVE IT IN THE MESSAGE
	MOVEI	S2,MDABUF+.OHDRS	;GET THE FIRST BLOCK ADDRESS
	MOVX	S1,.VSDBL		;GET THE BLOCK TYPE
	STORE	S1,ARG.HD(S2),AR.TYP	;SAVE IN THE MESSAGE
	MOVX	S1,ARG.DA+VSDLEN	;GET THE BLOCK LENGTH
	STORE	S1,ARG.HD(S2),AR.LEN	;SAVE IT IN THE MESSAGE
	ADDM	S1,G$SAB##+SAB.LN	;BUMP THE SAB LENGTH
	MOVSS	S1			;MOVE RIGHT TO LEFT
	ADDM	S1,MDABUF+.MSTYP	;AND BUMP THE MESSAGE LENGTH
	ADDI	S2,ARG.DA		;POINT TO THE BLOCK DATA
	MOVE	S1,.UCBNM(P1)		;GET THE OLD DEVICE NAME
	MOVEM	S1,.VSDID(S2)		;SAVE IT IN THE MESSAGE
	SETZM	.VSDCD(S2)		;NO NEW DEVICE NAME !!!
	DMOVE	S1,[EXP SAB.SZ,G$SAB##]	;GET THE SAB LENGTH AND ADDRESS
	$CALL	C%SEND			;SEND THE MSG OFF
	$RETT				;AND RETURN

> ;END TOPS10 CONDITIONAL
	SUBTTL	DELVSL - ROUTINE TO DELETE A VSL

	;CALL:	S1/ The VSL Address
	;
	;RET:	True Always

	;AC Usage in this Subroutine
	;
	;		P1/ VSL Entry
	;		P2/ VOL Entry
	;		P3/ UCB Entry
	;		P4/ VOL AOBJN AC

TOPS10 <
DELVSL:	PUSHJ	P,.SAVE4		;SAVE P1-P4
	MOVE	P1,S1			;GET THE VSL ADDRESS IN P1

	;Clean Up the Unit Control Block if He Owned the Device

	SKIPN	P3,.VSUCB(P1)		;CHECK AND LOAD THE UCB ADDRESS
	JRST	DELV.0			;NO DEVICE OWNED,,SKIP THIS
	SETZM	.UCBVS(P3)		;BREAK THE VSL LINKS FRRM THIS UCB
	ZERO	.UCBST(P3),UC.VSW	;CLEAR VOLUME SWITCH STATUS BITS

DELV.0:	LOAD	P4,.VSCVL(P1),VS.CNT 	;GET THE VOLUME COUNT
	MOVNS	P4			;MAKE IT NEGATIVE
	HRLZS	P4			;CREATE A VOL AOBJN AC (-COUNT,,0)
	HRRI	P4,.VSVOL(P1)		;GET THE VOL LIST ADDRESS IN RIGHT HALF
DELV.1:	MOVE	P2,0(P4)		;PICK UP THE CURRENT VOL ADDRESS
	LOAD	S1,.VLOWN(P2),VL.CNT	;GET THE VSL COUNT IN S1
	MOVNS	S1			;MAKE IT NEGATIVE
	HRLZS	S1			;MOVE RIGHT TO LEFT
	HRRI	S1,.VLVSL(P2)		;CREATE A VSL AOBJN AC

DELV.2:	MOVE	S2,0(S1)		;PICK UP THE VSL ADDRESS IN S2
	CAIN	P1,0(S2)		;FIND THIS USERS VSL ADDRESS IN THE VOL
	JRST	DELV.3			;   ENTRY.
	AOBJN	S1,DELV.2		;CONTINUE TILL FOUND
	$STOP	(CFV,Can't Find VSL Address in VOL Entry)

DELV.3:	HRRZ	S2,S1			;SAVE THE VSL'S ADDRESS IN S2
	$PACK	S1			;PACK THE VOL VSL LIST
	DECR	.VLOWN(P2),VL.CNT	;AND DECRIMENT THE USER REQUEST COUNT 
	SUBI	S2,.VLVSL(P2)		;CALC OFFSET OF USER VSL ADDRESS
	LOAD	S1,.VLOWN(P2),VL.OFF	;PICK UP THE OWNER OFFSET
	CAIN	S1,-1			;IS THE VOLUME OWNED BY ANYONE ???
	JRST	DELV.5			;NO,,THEN SKIP THIS
	CAILE	S1,0(S2)		;IS IT GREATER THEN OUR USERS VSL ??
	DECR	.VLOWN(P2),VL.OFF	;YES,,MUST RESET THE OWNER OFFSET BY -1

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	SETOM	TF			;GET A -1
	CAIN	S1,0(S2)		;WAS THIS USER THE VOLUME OWNER ???
	STORE	TF,.VLOWN(P2),VL.OFF	;YES,,INDICATE NO CURRENT OWNER

DELV.5:	LOAD	S1,.VLOWN(P2),VL.CNT	;GET THE THE OF VOLUME REQUESTORS
	SKIPE	S1			;ARE THERE ANY MORE REQUESTORS?
	JRST	DELV.6			;YES, SEE IF THEY CAN HAVE VOL NOW
	SKIPE	S2,.VLUCB(P2)		;NO REQUESTORS, IS VOLUME MOUNTED?
	JRST	DELV.7			;MOUNTED, LEAVE IT ALONE
	MOVE	S1,VOLQUE		;ELSE GET THE VOLUME QUEUE ID
	MOVE	S2,P2			;AND GET THE VOL ENTRY ADDRESS
	PUSHJ	P,L%APOS		;POSITION TO THIS VOL ENTRY
	PUSHJ	P,L%DENT		;AND DELETE IT !!!
	JRST	DELV.8			;CONTINUE WITH THE ALL VOLUMES LOOP

;Here when a volume referenced by the VSL has other requestors
;See if we can give the volume to another requestor.

DELV.6:	LOAD	S1,.VLOWN(P2),VL.OFF	;GET OFFSET TO CURRENT OWNER
	CAIN	S1,-1			;DOES SOMEONE HAVE IT NOW?
	SKIPN	S2,.VLUCB(P2)		;NO, IS IT MOUNTED?
	JRST	DELV.8			;SOMEONE OWNS IT, OR IT'S REQUESTED
					;BY OTHERS, BUT NOT MOUNTED
	LOAD	S1,.VLFLG(P2),VL.LBT	;GET LABEL TYPE
	PUSHJ	P,GETLBT		;AND MAP TO EASY CODE
	CAXE	S1,%LABEL		;IS IT A LABELED VOLUME?
	JRST	DELV.7			;NO, UNLOAD THIS USER'S TAPE
	MOVE	S1,.VLUCB(P2)		;COPY UCB NAME TO ARG REG
	PUSHJ	P,MATUNI		;TRY TO GIVE IT AWAY
	JRST	DELV.8			;CONTINUE WITH NEXT VOLUME

DELV.7:	MOVE	S1,P2			;GET THE VOL ADDRESS IN S1
	MOVE	S2,P1			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,CVLVSL		;COULD WE EVER HAVE OWNED THIS VOL
	JUMPF	DELV.8			;NO,,SKIP THIS
	MOVE	S1,P2			;AIM AT THIS VOLUME
	PUSHJ	P,VLUNLOAD		;UNLOAD AND BREAK LINKS FOR THIS VOL

DELV.8:	AOBJN	P4,DELV.1		;CONTINUE THROUGH ALL VOLUMES

	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID IN S1
	MOVE	S2,P1			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,L%APOS		;POSITION TO THE VSL ENTRY
	PUSHJ	P,L%DENT		;DELETE THIS VSL ENTRY
	$RETT				;AND RETURN
>
	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

TOPS20 <
DELVSL:	PUSHJ	P,.SAVE4		;SAVE P1-P4
	MOVE	P1,S1			;GET THE VSL ADDRESS IN P1
	LOAD	P4,.VSCVL(P1),VS.CNT 	;GET THE VOLUME COUNT
	MOVNS	P4			;MAKE IT NEGATIVE
	HRLZS	P4			;CREATE A VOL AOBJN AC (-COUNT,,0)
	HRRI	P4,.VSVOL(P1)		;GET THE VOL LIST ADDRESS IN RIGHT HALF
DELV.1:	MOVE	P2,0(P4)		;PICK UP THE CURRENT VOL ADDRESS
	SKIPE	P3,.VLUCB(P2)		;PICK UP THE CURRENT UCB ADDRESS
	SETZM	.UCBVL(P3)		;CLEAR THE VOL POINTER IN THE UCB
	MOVE	S1,VOLQUE		;GET THE VOL QUEUE ID
	MOVE	S2,P2			;GET THE VOLUME ENTRY ADDRESS
	PUSHJ	P,L%APOS		;POSITION TO THE VOLUME ENTRY
	PUSHJ	P,L%DENT		;AND DELETE IT
	AOBJN	P4,DELV.1		;CONTINUE THROUGH ALL VOLUMES
	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID
	MOVE	S2,P1			;GET THE VSL ADDRESS
	PUSHJ	P,L%APOS		;POSITION TO THE VSL
	PUSHJ	P,L%DENT		;AND DELETE IT
	$RETT				;RETURN
>
	SUBTTL	GETLBT - ROUTINE TO RECODE THE VOLUME LABEL TYPE

	;CALL:	S1/ The Volume Label Type
	;
	;RET:	S1/ either %UNLBL (Unlabeled) or %LABEL (Labeled)

TOPS10 <
GETLBT:	CAXE	S1,.TFLBP		;IS THE LABEL TYPE BYPASS LABELS ???
	CAXN	S1,.TFLTM		;OR IS IT LEADING TAPE MARK ???
	JRST	GETL.1			;YES,,EXIT
	CAXE	S1,.TFLNS		;IS THE LABEL TYPE NON-STANDARD LABESL ?
	CAXN	S1,.TFLNL		;OR IS IT NO LABELS ???
	SKIPA				;YES,,UNLABELED !!!
	CAXN	S1,.TFLNV		;UNLABELED/NO EOV PROCESSING,,UNLABELED
GETL.1:	SKIPA	S1,[%UNLBL]		;RETURN %UNLBL IN S1
	MOVX	S1,%LABEL		;IF LABELED,,RETURN %LABEL IN S1
	$RETT				;RETURN
>
	SUBTTL	USRACK - ROUTINE TO SEND AN ACK TO THE USER
;USRACK  is called to generate the initial acknowledgement of
; the queue entry request.
;Call with the MDR adrs in AP.

USRACK:	SKIPN	G$ACK##			;DOES THE USER WANT AN ACK?
	$RETT				;NO, ALL DONE
	SETZM	G$ACK##			;WE'RE DOING THE ACK RIGHT HERE!
	$TEXT	(<-1,,MDABUF>,<Mount Request ^W/.MRREQ(AP)/ Queued, Request-ID ^D/.MRRID(AP),MR.RID/^0>)
	PUSH	P,.MRFLG(AP)		;SAVE THE USER REQUESTED ACK BITS
	MOVX	S1,MR.WAT		;GET JUST A WAITING BIT
	MOVEM	S1,.MRFLG(AP)		;FUDGE FLAGS FOR THIS ACK
	PUSHJ	P,USRA.1		;ENTER COMMON SEND CODE
	POP	P,.MRFLG(AP)		;RESTORE THE FLAG BITS
	$RETT

	SUBTTL	USRNOT - Notify the user of Mount request completion

;This routine is called when the mount reqeust has been satisfied
; It will send either an IPCF acknowledgement or ask ORION to NOTIFY
; the User by writing on his terminal
;The caller must $TEXT all interesting info into MDABUF.

TOPS10 <
USRNOT:	LOAD	S1,.MRFLG(AP)		;GET MDR FLAGS
	TXNN	S1,MR.WAT!MR.NOT	;WANT ANY STYLE NOTIFICATION?
	$RETT				;NOPE, QUIT NOW!
					;YES,,TRY TO SEND HIM ONE
>
USRA.1:	$SAVE	<P1>
	$CALL	M%GPAG			;GET A PAGE TO BUILD THE ACK IN
	MOVE	P1,S1			;SAVE THE ADRS OF THE TEXT PAGE
	STORE	P1,G$SAB##+SAB.MS	;AIM THE GLOBAL SAB AT THE PAGE
	SETZM	G$SAB##+SAB.PB		;NO 'ON-BEHALF' SENDER PID
	LOAD	S1,.MRFLG(AP),MR.WAT	;GET THE WAITING FOR IPCF BIT
	JUMPE	S1,USRA.N		;NO WAITING, TRY NOTIFY
	SETZM	G$SAB##+SAB.SI		;CLEAR OUT THE SPECIAL SEND BITS
	MOVE	S1,.MRPID(AP)		;GET USER'S PID
	MOVEM	S1,G$SAB##+SAB.PD	;SEND ACK TO USER

	MOVX	S1,.OMTXT		;MESSAGE TYPE
	STORE	S1,.MSTYP(P1),MS.TYP	;SAVE IN HEADER
	MOVX	S1,.OHDRS+MDBSIZ+ARG.DA	;LENGTH OF THE MESSAGE
	STORE	S1,.MSTYP(P1),MS.CNT	;SAVE IN MESSAGE HEADER
	MOVX	S1,PAGSIZ		;GET THE PAGE SIZE
	STORE	S1,G$SAB##+SAB.LN	;SAVE IN SEND BLOCK
	MOVE	S1,.MSCOD(M)		;GET THE MESSAGE ACK CODE
	MOVEM	S1,.MSCOD(P1)		;SAVE IT IN THE MESSAGE
	MOVX	S1,1			;ONE ARG BLOCK
	STORE	S1,.OARGC(P1)		;SAVE IN HEADER

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVX	S1,.CMTXT		;BLOCK TYPE-- TEXT
	STORE	S1,.OHDRS+ARG.HD(P1),AR.TYP ;SET BLOCK TYPE
	MOVX	S1,MDBSIZ+ARG.DA	;SIZE OF THIS BLOCK
	STORE	S1,.OHDRS+ARG.HD(P1),AR.LEN ;LENGTH INTO BLOCK HEADER
	MOVSI	S1,MDABUF		;FROM MDABUF
	HRRI	S1,.OHDRS+ARG.DA(P1)	;TO BLOCK IN MESSAGE
	BLT	S1,.OHDRS+ARG.DA+MDBSIZ-1(P1) ;DUMP THE DATA INTO THE PAGE
	DMOVE	S1,[EXP SAB.SZ,G$SAB##]	;LEN,,ADR OF SAB
	$CALL	C%SEND			;ACK THE USER
	JUMPT	.RETT			;WINS, ALL DONE ACKING 
	CAXE	S1,ERNSP$		;LOST BECAUSE SENDER WENT AWAY?
	$RETT				;NO, GIVE UP.
					;YES, TRY TO TYPE ON HIS TERMINAL

;HERE TO NOTIFY USER VIA ORION TYPING ON HIS TERMINAL

TOPS10 <
USRA.N:	LOAD	S1,.MRFLG(AP),MR.NOT	;WANT TO BE NOTIFIED?
	JUMPE	S1,.RETT		;NOPE, SEE YOU LATER
	MOVX	S2,SI.FLG+SP.OPR	;SEND VIA INDEX TO OPR
	STORE	S2,G$SAB##+SAB.SI	;SAVE IN SAB
	SETZM	G$SAB##+SAB.PD		;BE TIDY.. NO PID
	MOVX	S1,.OHDRS+JBI.SZ+MDBSIZ+ARG.DA ;SIZE OF THE MESSAGE
	STORE	S1,.MSTYP(P1),MS.CNT	;SAVE IN MESSAGE ITSELF
	MOVX	S1,PAGSIZ		;GET THE PAGE LENGTH
	STORE	S1,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	MOVX	S1,.OMNFY		;MESSAGE TYPE -- NOTIFY
	STORE	S1,.MSTYP(P1),MS.TYP	;SAVE IN HEADER
	MOVX	S1,2			;TWO BLOCKS
	STORE	S1,.OARGC(P1)		;SAVE IN HEADER
	MOVE	S1,[XWD JBI.SZ,.JOBID]	;LEN,,SIZE OF JOB INFO BLOCK
	MOVEM	S1,.OHDRS+ARG.HD(P1)	; SAVE IN FIRST BLOCK
	MOVE	S1,.MRLOG(AP)		;GET JOB'S UNIV. LOGIN TIME
	MOVEM	S1,.OHDRS+JBI.LI(P1)	;SAVE AS DATA FOR THIS BLOCK
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET JOB NUMBER
	STORE	S1,.OHDRS+JBI.JB(P1)	;SAVE AS MORE DATA IN JOB INFO BLOCK
	MOVEI	P1,.OHDRS+JBI.SZ(P1)	;POINT TO THE LAST BLOCK
	MOVX	S1,.CMTXT		;BLOCK TYPE-- TEXT
	STORE	S1,ARG.HD(P1),AR.TYP	;SET BLOCK TYPE
	MOVX	S1,MDBSIZ+ARG.DA	;SIZE OF THIS BLOCK
	STORE	S1,ARG.HD(P1),AR.LEN	;LENGTH INTO BLOCK HEADER
	$TEXT	(<-1,,ARG.DA(P1)>,<^M^J[From System: ^T/MDABUF/^T/BELLS/]>)
	DMOVE	S1,[EXP SAB.SZ,G$SAB##]	;LEN,,ADR OF SAB
	$CALL	C%SEND			;ACK THE USER
	$RETT				;IGNORE IMPOSSIBLE ERROR FROM TO ORION

>
TOPS20 <
USRA.N:	$RETT	>			;JUST RETURN ON THE -20
	SUBTTL	LBLNOT - ROUTINE TO NOTIFY LABEL PROCESS OF DEVICE REASSIGNMENT

TOPS10<	;CALL:	S1/ The volume set list adrs, which points back to
	;	the MDR, and whose current offset points to the VOL just
	;	mounted, and which points to the UCB.

LBLNOT:	$SAVE	<P1,P2,P3>
	MOVE	P1,S1			;SAVE THE VSL ADDR
	MOVX	S1,.QOVMN		;MESSAGE TYPE - VOLUME MOUNTED
	PUSHJ	P,LBLHDR		;SET THE HEADER FOR MESSAGE, SAB, ETC
	MOVEI	P2,MDABUF+.OHDRS	;AIM AT FIRST BLOCK

;Build the First Block, Which Describes the Device Reassigned

	AOS	MDABUF+.OARGC		;ONE MORE BLOCK
	MOVX	S1,.RECDV		;FIRST BLOCK TYPE - RECOGNIZE DEVICE
	STORE	S1,ARG.HD(P2),AR.TYP	;SET THIS BLOCK TYPE
	MOVX	S1,.RECSZ+ARG.DA	;GET LENGTH OF THIS BLOCK
	STORE	S1,ARG.HD(P2),AR.LEN	;SAVE IN BLOCK
	ADDM	S1,G$SAB+SAB.LN		;UPDATE SEND LENGTH
	MOVSS	S1			;GET TO  LH
	ADDM	S1,MDABUF+.MSTYP	;UPDATE TOTAL MESSAGE LENGTH
	LOAD	S1,.VSCVL(P1),VS.OFF	;GET OFFSET TO CURRENT VOLUME
	ADDI	S1,.VSVOL(P1)		;POINT TO THIS VOLUME'S ENTRY
	MOVE	P3,0(S1)		;NOW GET THE VOLUME ADDRS
	MOVE	S2,.VLUCB(P3)		;AND GET TO UCB ADDR
	MOVE	S1,.UCBNM(S2)		;GET THE DEVICE NAME
	MOVEM	S1,.RECDN+ARG.DA(P2)	;SAVE IN MESSAGE
	MOVEI	P2,.RECSZ+ARG.DA(P2)	;ADVANCE TO NEXT BLOCK

;Build the Second Block, Which Describes the Volume Set and User to
;	Which the Drive was Given.

	AOS	MDABUF+.OARGC		;ONE MORE BLOCK
	MOVX	S1,.VOLMN		;GET THE NEXT BLOCK TYPE
	STORE	S1,ARG.HD(P2),AR.TYP	;SAVE AS BLOCK TYPE
	MOVX	S1,.VMNSZ+ARG.DA	;GET THE LENGTH OF THE BLOCK
	STORE	S1,ARG.HD(P2),AR.LEN	;AND SAVE IN BLOCK HEADER
	ADDM	S1,G$SAB+SAB.LN		;UPDATE SEND LENGTH
	MOVSS	S1			;GET TO  LH
	ADDM	S1,MDABUF+.MSTYP	;UPDATE TOTAL MESSAGE LENGTH
	MOVEI	P2,ARG.DA(P2)		;AIM AT THE DATA PORTION OF THE BLOCK
	LOAD	S1,.VLNAM(P3)		;GET THE VOLUME NAME
	STORE	S1,.VMNIV(P2)		;SAVE AS INITIAL VOLUME NAME
	MOVEI	S1,.VSVOL(P1)		;AIM AT THE FIRST VOLUME BLOCK ADR
	MOVE	S1,(S1)			;GET THE ADR OF THE FIRST VOL BLOCK
	LOAD	S1,.VLNAM(S1)		;GET THE NAME OF THE FIRST VOLUME
	STORE	S1,.VMNFV(P2)		;SAVE IN MESSAGE TO LABELLER
	SETZM	.VMNIN(P2)		;CLEAN OUT THE GARBAGE
	LOAD	S1,.VSFLG(P1),VS.LBT	;GET THE LABEL TYPE
	STORE	S1,.VMNIN(P2),VI.LTY	;SAVE IN MESSAGE

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	LOAD	S1,.VSFLG(P1),VS.WLK	;GET THE WRITE LOCK BIT
	STORE	S1,.VMNIN(P2),VI.WLK	;SAVE IN INFO WORD OF MESSAGE
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE JOB NUMBER
	STORE	S1,.VMNIN(P2),VI.JOB	;TELL THE LABELLER WHO'S THERE
	DMOVE	S1,[EXP SAB.SZ,G$SAB##]	;AIM AT THE SEND ARG BLOCK
	$CALL	C%SEND			;TELL THE LABELLER
	$RETT

>;END TOPS10
SUBTTL	LBLHDR - Set up for a message to MDA

;Thie routine will set up G$SAB for a message to MDA which
;	will be in MDABUF
;Call -
;	S1/ Message type

TOPS10<
LBLHDR:	STORE	S1,MDABUF+.MSTYP,MS.TYP	;SAVE THE MESSAGE TYPE
	MOVX	S1,.OHDRS		;SIZE OF HEADER ALONE
	STORE	S1,MDABUF+.MSTYP,MS.CNT	;LENGTH SO FAR
	MOVEM	S1,G$SAB##+SAB.LN	;LENGTH TO SEND
	SETZM	G$SAB##+SAB.PD		;NO PID...
	MOVX	S1,<SI.FLG+SP.TLP>	;.. SEND BY SPECIAL INDEX
	MOVEM	S1,G$SAB##+SAB.SI	;MARK IN SAB
	SETZM	G$SAB##+SAB.PB		;SEND ON MY BEHALF
	SETZM	MDABUF+.MSFLG		;NO MESSAGE FLAGS
	SETZM	MDABUF+.MSCOD		;NO ACK CODE
	SETZM	MDABUF+.OFLAG		;AND NO FLAGS (YET)
	SETZM	MDABUF+.OARGC		;NO ARG BLOCKS (YET)
	MOVEI	S1,MDABUF		;THE ADR OF THE MESSAGE
	MOVEM	S1,G$SAB##+SAB.MS	;AIM THE SAB AT US
	$RETT				;ALL SET UP
>;END TOPS10
	SUBTTL	SNDREC - ROUTINE TO SEND A RECOGNIZE MSG TO THE TAPE LABELER

	;CALL:	S1/ The Device Name in Sixbit
	;
	;RET:	True Always


TOPS10 <
RECMSG:	$BUILD	.OHDRS+ARG.DA+1
	 $SET(.MSTYP,MS.TYP,.QOREC)		;TYPE 'RECOGNIZE MESSAGE'
	 $SET(.MSTYP,MS.CNT,.OHDRS+ARG.DA+1)	;MESSAGE LENGTH
	 $SET(.OARGC,,1)			;A BLOCK COUNT OF 1
	 $SET(.OHDRS+ARG.HD,AR.LEN,2)		;THE BLOCK LENGTH
	 $SET(.OHDRS+ARG.HD,AR.TYP,.RECDV)  	;THE BLOCK TYPE
	$EOB



SNDREC:	STORE	S1,RECMSG+.OHDRS+ARG.DA	;SAVE THE DEVICE NAME IN THE MESSAGE
	MOVEI	S1,.OHDRS+ARG.DA+1	;GET THE MESSAGE LENGTH
	STORE	S1,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	MOVEI	S1,RECMSG		;GET THE MESSAGE ADDRESS
	STORE	S1,G$SAB##+SAB.MS	;SAVE IT IN THE SAB
	MOVX	S1,SI.FLG+SP.TLP	;GET THE SPECIAL INDEX FOR TAPE LABELER
	STORE	S1,G$SAB##+SAB.SI	;SAVE IT IN THE SAB
	SETZM	G$SAB##+SAB.PD		;ZAP THE SAB PID WORD
	SETZM	G$SAB##+SAB.PB		;ZAP THE SAB PIB WORD
	MOVEI	S1,SAB.SZ		;GET THE SAB LENGTH
	MOVEI	S2,G$SAB##		;GET THE SAB ADDRESS
	PUSHJ	P,C%SEND		;SEND THE MESSAGE OFF
	$RETT				;AND RETURN


	SUBTTL	UNLOAD	- TELL PULSAR TO UNLOAD THE TAPE DRIVE

	;CALL:	S1/ The Device Name in Sixbit
	;
	;RET:	True Always

REWIND:	SKIPA	S2,[.QOREW]		;REWIND ENTRY POINT,,GET REWIND MSG TYPE
UNLOAD:	MOVX	S2,.QOUNL		;UNLOAD ENTRY POINT,,GET UNLOAD MSG TYPE
	STORE	S2,RECMSG+.MSTYP,MS.TYP	;MAKE THE RECOGNIZE MSG AN UNLOAD MSG
	PUSHJ	P,SNDREC		;SEND THE UNLOAD MSG OFF TO PULSAR
	MOVX	S2,.QOREC		;GET 'RECOGNIZE' MSG TYPE
	STORE	S2,RECMSG+.MSTYP,MS.TYP	;RESTORE THE RECOGNIZE MSG TYPE
	$RETT				;AND RETURN
>
	SUBTTL	FNDUCB - ROUTINE TO FIND A UCB IN THE UCB CHAIN

	;CALL:	FNDUCB - S1/ The Address of the message asciz device name
	;	GETUCB - S1/ The sixbit device name
	;
	;RET:	True - S1/ The UCB Address
	;	False - The UCB Was Not Found or the Device Name was Invalid,
	;	Or the 'Device Available' bit was not on in the UCB

TOPS10 <
LOCUCB:	TDZA	TF,TF			;SET FLAG FOR LOCATE UCB ENTRY POINT
FNDUCB:	SETOM	TF			;SET FLAG FOR FIND UCB ENTRY POINT
	$SAVE	T1			;SAVE T1
	MOVE	T1,TF			;SAVE THE ENTRY POINT FLAGS IN T1
	HRROI	S1,0(S1)		;GET A BYTE POINTER TO THE DEVICE NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	JRST	GETU.1			;CONTINUE TO SEARCH UCB CHAIN

GETUCB:	$SAVE	T1			;SAVE T1 FOR A MINUTE
	SETOM	T1			;WANT TO FAIL ON 'UNAVAILABLE' DEVICES
	MOVE	S2,S1			;GET THE DEVICE NAME IN S2

GETU.1:	MOVEM	S2,MDAOBJ+OBJ.UN	;SAVE THE DEVICE NAME IN THE OBJ BLOCK
	DEVNAM	S2,			;GET THE REAL DEVICE NAME
	PJRST	E$NSD##		;RETURN THROUGH 'NO SUCH DEVICE'
	MOVEM	S2,MDAOBJ+OBJ.UN	;SAVE THE DEVICE NAME IN THE OBJ BLOCK
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S2			;SAVE THE DEVICE NAME IN P1 ALSO
	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;POSITION TO THE FIRST ENTRY
	SKIPT				;THERE MUST BE ONE !!!
	 $STOP(NUE,Null UCB Chain Encountered)  ;NO,,UH OH !!!
FNDU.1:	CAMN	P1,.UCBNM(S2)		;FIND THE UCB WE WANT
	JRST	FNDU.2			;FOUND,,SEE IF WE OWN IT !!!
	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB ENTRY
	JUMPT	FNDU.1			;THERE IS ONE,,TRY IT OUT
	PJRST	E$NSD##			;RETURN THROUGH 'NO SUCH DEVICE'

FNDU.2:	MOVE	S1,S2			;PLACE UCB ADDR IN RETURN REG
	JUMPE	T1,.RETT		;DONE CARE IF DEVICE IS AVAILABLE,,RETURN
	LOAD	S2,.UCBST(S2),UC.AVA	;GET THE DEVICE AVAILABLE BIT
	JUMPN	S2,.RETT		;WE OWN THE DEVICE,,SO RETURN
	JRST	E$IUD##			;RETURN 'UNAVAILABLE DEVICE'
>
	SUBTTL	CHKVOL - ROUTINE TO FIND A VOLUME IN THE VOL DATA BASE

	;CALL:	S1/ The Volume We are Looking For
	;
	;RET:	True	S1/ The VOL Block Address
	;		S2/ The UCB Address if The Volume is Mounted or 0
	;
	;	False	Volume not Found

CHKVOL:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE VOLUME WE ARE LOOKING FOR

	;See if we can find the mounted volume in our requested volume list.

	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%FIRST		;POSITION TO THE FIRST ENTRY
	JRST	CHKV.2			;SKIP THE FIRST TIME THROUGH
CHKV.1:	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT VOL ENTRY
CHKV.2:	JUMPF	.RETF			;MSG VOLUME NOT FOUND,,RETURN
	MOVE	S1,S2			;GET THE VOLUME ADDRESS IN S1
	CAME	P1,.VLNAM(S1)		;HAVE WE FOUND THE MSG VOLUME ???
	JRST	CHKV.1			;NO,,TRY THE NEXT VOL ENTRY

	;Found the Volume in Our VOL Data Base,,Make Sure its not Mounted

	SKIPE	S2,.VLUCB(P3)		;FOUND IT,,IS THE VOL ALREADY MOUNTED ?
	$WTO	(<Volume ^W/.VLNAM(S1)/ Already Mounted On ^W/.UCBNM(S2)/>,,MDAOBJ)
	$RETT				;AND RETURN TRUE (FOUND)
	SUBTTL	FNDMDR - ROUTINE TO FIND AN MDR GIVEN ITS REQUEST-ID

	;CALL:	S1/ The MDR Request-Id
	;
	;RET:	AP/ The MDR Address If Found
	;	False if the MDR Can't be Found

FNDMDR:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE REQUEST ID FOR A MINUTE
	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST MDR ENTRY
	JRST	FNDM.2			;JUMP THE FIRST TIME THROUGH
FNDM.1:	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT MDR ENTRY
FNDM.2:	JUMPF	FNDM.3			;MDR NOT FOUND !!!
	LOAD	S1,.MRRID(S2),MR.RID	;GET THIS MDR'S RID
	CAIE	P1,0(S1)		;DO THEY MATCH ???
	JRST	FNDM.1			;NO,,TRY THE NEXT MDR
	MOVE	AP,S2			;YES,,GET THE MDR ADDRESS IN AP
	$RETT				;AND RETURN

FNDM.3:	$ACK	(Mount Request ^D/P1/ Does Not Exist,,,.MSCOD(M)) ;ACK THE OPR
	$RETF				;AND RETURN FALSE
	SUBTTL	GENVOL - ROUTINE TO CREATE A 'SCRATCH' VOLUME BLOCK

	;CALL:	S1/ The VSL Address of the User
	;
	;RET:	True Always


GENVOL:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	MOVE	S1,VOLQUE		;GET THE VOLUME LIST QUEUE ID
	MOVX	S2,VOLLEN		;GET THE VOL ENTRY LENGTH
	PUSHJ	P,L%CENT		;CREATE SPACE FOR THE VOL ENTRY
	LOAD	S1,.VSCVL(P1),VS.OFF	;GET THE OFFSET TO THE CURRENT VOL
	ADDI	S1,.VSVOL(P1)		;POINT TO THE VOL BLOCK ADDRESS
	MOVEM	S2,0(S1)		;LINK THE VOL TO THE VSL
	MOVEM	P1,.VLVSL(S2)		;LINK THE VSL TO THE VOL
	MOVX	S1,%STAWT		;GET 'WAITING' STATUS CODE
	STORE	S1,.VLFLG(S2),VL.STA	;SAVE IT IN THE VOL FLAG WORD
	SETOM	S1			;GET A -1
	STORE	S1,.VLOWN(S2),VL.OFF	;SAVE AS THE OFFSET TO THE CURRENT OWNER
	INCR	.VLOWN(S2),VL.CNT	;BUMP THE REQUEST COUNT BY 1
	LOAD	S1,.VSFLG(P1),VS.LBT	;GET THE REQUESTED LABEL TYPE
	STORE	S1,.VLFLG(S2),VL.LBT	;AND SAVE IT IN THE VOL FLAG WRD
	MOVX	S1,VL.SCR		;GET THE VOLUME SCRATCH BIT
	IORM	S1,.VLFLG(S2)		;LITE IT IN THE VOL FLAG WORD
	INCR	.VSCVL(P1),VS.CNT	;MAKE THE VSL COUNT = 1
	$RETT				;AND RETURN
	SUBTTL	MISC ROUTINES

TOPS10 <

MISC.3:	$WTO	(Invalid Message From PULSAR,,,<$WTFLG(WT.SJI)>)
	$RETT


;Coroutine for outputting text to MDABUF
;Caller should initialize MDBPTR before first $TEXT.
MDADBP:	IDPB	S1,MDBPTR		;JUST DUMP THE CHAR
	$RETT				;AND WIN
>
	SUBTTL	D$VMDA - ROUTINE TO VALIDATE THE MDA STRUCTURES

	;CALL:	No Parameters
	;
	;RET:	True Always or a Stopcode

D$VMDA:	PUSHJ	P,.SAVET		;SAVE THE T AC'S
	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST MDR ENTRY
	JUMPF	.RETT			;NONE THERE,,JUST RETURN
	JRST	VMDA.2			;SKIP THE FIRST TIME THROUGH
VMDA.1:	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT MDR ENTRY
	JUMPF	.RETT			;NO MORE,,RETURN
VMDA.2:	MOVE	AP,S2			;SAVE THE MDR ADDRESS IN AP
	LOAD	T1,.MRRID(AP),MR.CNT	;GET THE VSL COUNT IN T1
	MOVNS	T1			;MAKE IT NEGATIVE
	HRLZS	T1			;MOVE RIGHT TO LEFT
	HRRI	T1,.MRVSL(AP)		;GET VSL LIST ADDRESS IN RIGHT HALF
VMDA.3:	SKIPN	T2,0(T1)		;CHECK AND LOAD A VSL ADDRESS INTO T2
	$STOP	(VAM,VSL Address is Missing in a MDR) ;NONE THERE,,END IT
	CAME	AP,.VSMDR(T2)		;MDR <----- -----> VSL ???
	$STOP	(IMV,Invalid MDR/VSL Forward/Backchain Pointers)
	LOAD	T3,.VSCVL(T2),VS.CNT	;GET THE VOLume COUNT
	MOVNS	T3			;MAKE IT NEGATIVE
	HRLZS	T3			;MOVE RIGHT TO LEFT
	HRRI	T3,.VSVOL(T2)		;GET VOL LIST ADDRESS IN RIGHT HALF
VMDA.4:	SKIPN	T4,0(T3)		;CHECK AND LOAD A VOL ADDRESS INTO T4
	$STOP	(VMV,VOL Address is Missing in a VSL) ;NONE THERE,,END IT
	LOAD	S2,.VLOWN(T4),VL.CNT	;GET THE COUNT OF VOLUME OWNERS IN S2
	MOVNS	S2			;MAKE IT NEGATIVE
	HRLZS	S2			;MOVE RIGHT TO LEFT
	HRRI	S2,.VLVSL(T4)		;GET VSL LIST ADDRESS IN RIGHT HALF
VMDA.5:	SKIPN	0(S2)			;CHECK FOR A VSL ADDRESS
	$STOP	(VSA,VSL Address is Missing in a VOL) ;NONE THERE,,END IT
	CAMN	T2,0(S2)		;FIND THE VOL VSL POINTER
	JRST	VMDA.6			;FOUND IT,,CONTINUE
	AOBJN	S2,VMDA.5		;LOOP THROUGH ALL VOL VSL POINTERS
	$STOP	(IVV,Invalid VSL/VOL Forward/Backchain Pointers) ;NOT FOUND !!!
VMDA.6:	SKIPE	S2,.VLUCB(T4)		;CHECK AND LOAD THE VOLUME UCB POINTER
	CAMN	T4,.UCBVL(S2)		;VOL <---- ----> UCB ???
	SKIPA				;NO UCB OR POINTERS MATCH,,SKIP
	$STOP	(IVU,Invalid VOL/UCB Forward/Backchain Pointers)
	AOBJN	T3,VMDA.4		;CONTINUE THROUGH ALL VOLUMES
	AOBJN	T1,VMDA.3		;CONTINUE THROUGH ALL VOL SET LISTS
	JRST	VMDA.1			;CONTINUE THROUGH ALL MDR'S
	SUBTTL	BLDVSL - ROUTINE TO BREAK DOWN MOUNT MSG ENTRIES

	;CALL:	S1/ The Address of the Mount Msg Entry
	;
	;RET:	S1/ The VSL Address if Mount Entry was Valid

BLDVSL:	PUSHJ	P,.SAVE4		;SAVE P1 & P2 & P3 & P4 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE MOUNT MSG ENTRY ADDR
	MOVEI	S1,VSLLEN		;GET THE VSL LENGTH
	MOVEI	S2,TMPVSL		;GET THE TEMP VSL ADDRESS
	PUSHJ	P,.ZCHNK		;CLEAR THE TEMP VSL
	SETZM	VOLNBR			;CLEAR THE VOLUME-SET VOLUME COUNT
	SETZM	STRVOL			;AND THE STARTING VOLUME ID
	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID
	PUSHJ	P,L%LAST		;POSITION TO THE END OF THE VSL
	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%LAST		;POSITION TO THE END OF THE LIST
	MOVEI	P2,TMPVSL		;POINT TO OUR TEMP VSL
	LOAD	S1,.MEHDR(P1),AR.TYP	;GET THE ENTRY TYPE
	MOVX	S2,%TAPE		;DEFAULT TO A TAPE REQUEST
	CAXN	S1,.MNTST		;IS IT A STRUCTURE ???
	MOVX	S2,%DISK		;YES,,SAY SO
	CAXN	S1,.DSMST		;IS IT DISMOUNT STRUCTURE ???
	MOVX	S2,%DSMT		;YES,,SAY SO
	STORE	S2,.VSFLG(P2),VS.TYP	;SAVE THE REQUEST TYPE
	LOAD	S1,.MEFLG(P1)		;GET THE REQUEST FLAG WORD
	LOAD	S2,.VSFLG(P2)		;GET OUR FLAG WORD
	TXNE	S1,TM%SCR		;IS THIS A TEMP VOLUME SET ???
	TXO	S2,VS.TMP		;YES,,SAY SO
	TXNE	S1,TM%NEW		;IS THIS A NEW VOLUME SET ???
	TXO	S2,VS.NEW		;YES,,SAY SO
	TXNE	S1,TM%VFY		;DO WE WANT TO VALIDATE SET NAMES ???
	TXO	S2,VS.VFY		;YES,,SAY SO
	TXNE	S1,TM%OSV		;WILL OPR BE ASKED FOR VOLUMES ??
	TXO	S2,VS.OPR		;YES,,SAY SO
	TXNN	S1,TM%WEN		;ARE WE WRITE LOCKED ???
	TXO	S2,VS.WLK		;YES,,SAY SO
	TXNE	S1,TM%NUL		;UNLOAD AT EOV AND DISMOUNT ???
	TXO	S2,VS.NUL		;NO,,SAY SO
	MOVEM	S2,.VSFLG(P2)		;SAVE OUR FLAG WORD
	MOVE	P3,P1			;SAVE THE MSG ENTRY START ADDRESS
	ADDI	P1,.MEHSZ		;POINT TO THE FIRST MESSAGE BLOCK
	MOVE	P4,.MECNT(P3)		;GET THE VOLUME SET BLOCK COUNT IN P4

BLDV.1:	LOAD	S1,ARG.HD(P1),AR.TYP	;GET THE BLOCK TYPE
	SKIPE	S1			;BLOCK TYPE CANT BE 0
	CAILE	S1,%MDMAX		;OR GREATER THEN DEFINE BLOCK TYPES
	PJRST	BLDV.4			;ELSE THATS AN ERROR !!!
	LOAD	S1,MDRDSP(S1)		;GET THE BLOCK PROCESSOR ADDRESS

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

BLDV.2:	PUSHJ	P,0(S1)			;GO PROCESS THE BLOCK
	JUMPF	BLDV.4			;NO GOOD,,THATS AN ERROR
	LOAD	S1,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	ADD	P1,S1			;POINT TO THE NEXT BLOCK
	SOJG	P4,BLDV.1		;CONTINUE THROUGH ALL VOL-SET BLOCKS
	LOAD	S1,.MEHDR(P3),AR.LEN	;GET THE ENTRY LENGTH
	ADD	P3,S1			;CALCULATE THE ENTRY END ADDRESS
	CAIE	P3,0(P1)		;CALC & ACTUAL END ADDRS MUST BE EQUAL
	JRST	BLDV.4			;ELSE THATS AN ERROR

TOPS10<	MOVE	S1,.VSFLG(P2)		;GET THE VSL STATUS BITS
	TXNE	S1,VS.TMP		;WAS /SCRATCH SPECIFIED ???
	SKIPN	.VSVOL(P2)		;YES,,IS THERE A VOLUME LIST ???
	SKIPA				;NOT /SCRATCH or NO VOL SET
	JRST	BLDV.4			;/SCRATCH+VOLUME SET LIST IS AN ERROR
	CAIE	P2,TMPVSL		;ARE WE POINTING TO THE TEMP VSL ???
	JRST	BLDV.3			;NO,,THEN ALL'S OK.
	TXC	S1,VS.WLK		;MUST BE WRITE ENABLED
	TXNN	S1,VS.NEW+VS.OPR+VS.WLK+VS.TMP ;ANY OF THESE BITS LIT ???
	JRST	BLDV.4			;NO,,THATS AN ERROR (IF WE'RE HERE)
> ;END TOPS10 CONDITIONAL

TOPS20<	CAIE	P2,TMPVSL		;POINTING TO TEMP VSL ???
	JRST	BLDV.3			;NO,,THEN ALLS OK
> ;END TOPS20 CONDITIONAL

	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID
	MOVX	S2,VSLLEN		;GET THE VSL ENTRY LENGTH
	PUSHJ	P,L%CENT		;CREATE SPACE FOR THE VSL ENTRY
	MOVE	P2,S2			;SAVE THE NEW VSL ENTRY ADDRESS
	HRLI	S1,TMPVSL		;GET THE SOURCE VSL ADDRESS
	HRRI	S1,0(P2)		;GET THE DEST VSL ENTRY ADDRESS
	BLT	S1,VSLLEN-1(P2)		;COPY THE VSL OVER
	MOVE	S1,P2			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,GENVOL		;CREATE A 'SCRATCH' VOL FOR THIS GUY

BLDV.3:	MOVE	S1,P2			;RETURN THE VSL ADDRESS IN S1
	$RETT				;RETURN OK

BLDV.4:	MOVE	S1,P2			;RETURN THE VSL ADDRESS IN S1
	$RETF				;RETURN WITH AN ERROR RETURN
	SUBTTL	MOUNT REQUEST BLOCK PROCESSOR ROUTINES

	;DENSITY BLOCK PROCESSOR

MNTDEN:	LOAD	S1,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	CAIE	S1,2			;MUST BE 2
	$RETF				;ELSE RETURN
	MOVE	S1,ARG.DA(P1)		;GET THE DENSITY
	STORE	S1,.VSATR(P2),VS.DEN	;AND SAVE IT
	$RETT				;AND RETURN

	;DRIVE TYPE BLOCK PROCESSOR

MNTDRV:	LOAD	S1,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	CAIE	S1,2			;MUST BE 2
	$RETF				;ELSE RETURN
	MOVE	S1,ARG.DA(P1)		;GET THE DRIVE TYPE
	STORE	S1,.VSATR(P2),VS.TRK	;AND SAVE IT
	$RETT				;AND RETURN

	;LABEL TYPE BLOCK PROCESSOR

MNTLT:	LOAD	S1,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	CAIE	S1,2			;MUST BE 2
	$RETF				;ELSE RETURN
	MOVE	S1,ARG.DA(P1)		;GET THE LABEL TYPE
	STORE	S1,.VSFLG(P2),VS.LBT	;AND SAVE IT
	CAXE	S1,%TFLBP		;DOES HE WANT BYPASS PROCESSING
	$RETT				;NO, LET HIM THROUGH
;	PUSHJ	P,I$WHEEL##		;YES, IS HE A BIG GUY?
;	JUMPF	E$PRB##			;NOPE, TOO BAD
	$RETT				;YES HE IS, LET HIM THROUGH

	;VOLUME SET NAME BLOCK PROCESSOR

MNTSET:	LOAD	S1,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	SUBI	S1,1			;SUBTRACT OFF THE HEADER LENGTH
	CAILE	S1,VSNLEN		;MUST BE LESS OR EQUAL VSNLEN
	$RETF				;ELSE RETURN

TOPS10<	HRLI	S1,ARG.DA(P1)		;GET THE SOURCE VOLUME SET NAME ADDR
	HRRI	S1,.VSVSN(P2)		;GET THE DEST VOL SET NAME ADDRESS
	BLT	S1,VSNLEN-1(P2) >	;COPY THE VSN OVER

TOPS20<	$TEXT	(<-1,,.VSVSN(P2)>,<^W/ARG.DA(P1)/^0>) > ;SIXBIT VSN TO ASCII

	$RETT				;RETURN
	;LOGICAL NAME BLOCK PROCESSOR

MDRLNM:	LOAD	S1,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	CAIE	S1,2			;LENGTH MUST BE 2
	$RETF				;ELSE RETURN
	MOVE	S1,ARG.DA(P1)		;GET THE LOGICAL NAME
	MOVEM	S1,.VSLNM(P2)		;SAVE IT
	SKIPE	.VSVSN(P2)		;ANY VOLUME SET NAME YET ???
	$RETT				;YES,,JUST RETURN
	$TEXT	(<-1,,.VSVSN(P2)>,<^W/S1/^0>) ;NO,,GEN ONE
	$RETT				;AND RETURN

	;STARTING VOLUME BLOCK PROCESSOR

MNTSTV:	LOAD	S2,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	MOVE	S1,ARG.DA(P1)		;GET THE FIRST DATA WORD
	CAIN	S2,2			;IS THE BLOCK LENGTH 2 ???
	JRST	MNTS.1			;YES,,GO PROCESS THIS FORMAT
	CAIE	S2,3			;OR IS THE BLOCK LENGTH 3 ???
	$RETF				;ELSE THATS AN ERROR
	SKIPE	ARG.DA(P1)		;THIS MUST BE NULL
	$RETF				;ELSE THATS AN ERROR
	MOVE	S1,ARG.DA+1(P1)		;GET THE SIXBIT STARTING VOLUME ID
MNTS.1:	MOVEM	S1,STRVOL		;SAVE IT HERE FOR A MINUTE
	CAIE	P2,TMPVSL		;ARE WE POINTING AT THE TEMP VSL ???
	PJRST	UPDSVL			;NO,,GO UPDATE STARTING VOLUME INFO
	$RETT				;RETURN

	;REMARK BLOCK PROCESSOR

MNTRMK:	$SAVE	<P4>			;SAVE P4 FOR A MINUTE
	LOAD	P4,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	SUBI	P4,1			;GET THE TEXT LENGTH
	IMULI	P4,5			;GET THE LENGTH IN BYTES
	CAILE	P4,^D59			;WILL WE FIT ???
	MOVEI	P4,^D59			;NO,,MAKE IT FIT
	MOVEI	S1,ARG.DA(P1)		;POINT TO THE SOURCE TEXT
	HRLI	S1,(POINT 7,0)		;MAKE IT A BYTE POINTER
	MOVE	S2,[POINT 7,.VSREM(P2)] ;GET THE DESTINATION BYTE POINTER
MNTR.1:	ILDB	TF,S1			;GET A BYTE
	IDPB	TF,S2			;SAVE IT
	JUMPE	TF,.RETT		;END ON A NULL
	SOJG	P4,MNTR.1		;OR 59 CHARACTERS (WHICHEVER IS FIRST)
	$RETT				;AND RETURN
	;VOLUME LIST BLOCK PROCESSOR

MNTVOL:	CAIE	P2,TMPVSL		;MUST BE POINTING AT THE TEMP VSL !!!
	$RETF				;NO,,THATS AN ERROR

	;WEED OUT DUPLICATE MSG VOLUME BLOCKS (only last one counts)

	MOVE	S1,P1			;GET THE VOL BLOCK HDR ADDR IN S!
	MOVE	S2,.MECNT(P3)		;GET THE REMAINING BLOCK CNT IN S2
MNTV.A:	LOAD	TF,ARG.HD(S1),AR.LEN	;GET THE BLOCK LENGTH
	ADD	S1,TF			;POINT TO THE NEXT MSG BLOCK
	LOAD	TF,ARG.HD(S1),AR.TYP	;GET ITS TYPE
	CAXE	TF,.TMVOL		;IF THE A TAPE VOLUME ???
	CAXN	TF,.SMALI		;OR IS IT A STRUCTURE VOLUME ???
	$RETT				;YES,,IGNORE THE CURRENT VOL BLOCK
	SOJG	S2,MNTV.A		;NO,,TRY NEXT MSG BLOCK

	LOAD	S2,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	SOJLE	S2,.RETF		;CANT BE 1 OR NEGATIVE !!!
	CAILE	S2,^D60			;MUST BE LESS THE 60 VOLUMES 
	$RETF				;ELSE THAT AN ERROR
	MOVEM	S2,VOLNBR		;SAVE THE VOLUME COUNT
	STORE	S2,.VSCVL(P2),VS.CNT	;SAVE THE VOLUME COUNT IN THE VSL
	ADDI	S2,VSLLEN-1		;CALC THE VSL LENGTH
	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID
	PUSHJ	P,L%CENT		;CREATE SPACE FOR THE VSL ENTRY
	MOVE	P2,S2			;SAVE THE NEW VSL ADDRESS
	HRLI	S1,TMPVSL		;GET THE SOURCE VSL ADDRESS
	HRRI	S1,0(P2)		;GET THE DEST VSL ADDRESS
	BLT	S1,VSLLEN-1(P2)		;COPY THE PROTOTYPE VSL OVER
	MOVE	T1,VOLNBR		;GET THE VOLUME COUNT
	MOVEI	T2,.VSVOL(P2)		;POINT T2 AT THE VSL VOL ADDRESSES
	MOVEI	T3,ARG.DA(P1)		;POINT T3 AT THE VOLUME LIST

MNTV.0:	MOVE	S1,0(T3)		;PICK UP THE VOLUME NAME IN S1
	MOVE	S2,P2			;GET THE VSL POINTER IN S2
	PUSHJ	P,SCNVOL		;GO FIND THE REQUESTED VOLUME
	JUMPT	[MOVEM S1,0(T2)		;FOUND IT,,LINK VOL TO VSL
		 JRST  MNTV.1 ]		;   AND SKIP THE NEW VOL CREATE
	MOVE	S1,VOLQUE		;GET THE VOLUME LIST QUEUE ID
	MOVX	S2,VOLLEN		;GET THE VOL LIST ENTRY LENGTH
	PUSHJ	P,L%CENT		;CREATE SPACE FOR THE VOL ENTRY
	MOVEM	S2,0(T2)		;LINK THE VOL TO THE VSL
	MOVEM	P2,.VLVSL(S2)		;LINK THE VSL TO THE VOL
	MOVE	S1,0(T3)		;PICK UP THIS VOL'S VOLUME NAME
	MOVEM	S1,.VLNAM(S2)		;SAVE IT IN THE VOL
	MOVX	S1,%STAWT		;GET 'VOLUME WAITING' CODE
	STORE	S1,.VLFLG(S2),VL.STA	;SAVE IT AS THE VOLUME STATUS
	SETOM	S1			;GET A -1
	STORE	S1,.VLOWN(S2),VL.OFF	;SAVE AS THE OFFSET TO THE CURRENT OWNER
	INCR	.VLOWN(S2),VL.CNT	;BUMP THE REQUEST COUNT BY 1

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

MNTV.1:	AOS	T2			;POINT TO THE NEXT VSL VOLUME
	AOS	T3			;POINT TO THE NEXT MSG VOLUME
	SOJG	T1,MNTV.0		;CONTINUE TILL DONE
	SKIPE	S1,STRVOL		;CHECK AND LOAD THE STARTING VOLUME ID
	PJRST	UPDSVL			;SOMETHING THERE,,UPDATE STARTING VOLUME
	$RETT				;RETURN
	SUBTTL	SCNVOL - ROUTINE TO FIND COMMON VOLUMES REQUESTS AND LINK THEM

	;CALL	S1/ The Volume Name in Sixbit
	;	S2/ The VSL Address
	;
	;RET:	S1/ The VOL Address

TOPS10 <
SCNVOL:	PUSHJ	P,.SAVE4		;SAVE THE P AC'S FOR A MINUTE
	STKVAR	<LENGTH>		;ALLOCATE SOME STORAGE FOR ENTRY LENGTH
	DMOVE	P1,S1			;SAVE THE VOLUME NAME AND VSL ADDRESS
	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%FIRST		;POINT THE THE FIRST VOLUME IN THE QUEUE
	JUMPF	.RETF			;NONE THERE,,JUST RETURN
	JRST	SCNV.2			;SKIP THE FIRST TIME THROUGH
SCNV.1:	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT VOLUME
	JUMPF	.RETF			;NO MORE,,RETURN
SCNV.2:	CAME	P1,.VLNAM(S2)		;DO VOLUME NAMES MATCH ???
	JRST	SCNV.1			;NO,,TRY NEXT VOLUME
	MOVE	P1,S2			;YES,,SAVE THE VOLUME ENTRY ADDRESS
	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%SIZE		;GET THIS ENTRY'S LENGTH
	MOVEM	S2,LENGTH		;SAVE THE ENTRY LENGTH FOR LATER
	SUBI	S2,VOLLEN-1		;GET THE TOTAL .VLVSL BLOCK LENGTH
	LOAD	S1,.VLOWN(P1),VL.CNT	;GET THE TOTAL ALLOCATED LENGTH
	CAIN	S1,0(S2)		;ARE THEY EQUAL ???
	JRST	SCNV.3			;YES,,WE NEED MORE ROOM !!!
	CAIL	S1,0(S2)		;IS ALLOCATED MORE THEN TOTAL ???
	$STOP	(AMT,Allocated is More then Total (VOL .VLVSL BLOCKS))
	ADDI	S1,.VLVSL(P1)		;GET THE NEXT BLOCK ADDRESS
	MOVEM	P2,0(S1)		;LINK THE VSL TO THE VOL
	INCR	.VLOWN(P1),VL.CNT	;BUMP THE REQUEST COUNT BY 1
	MOVE	S1,P1			;GET THE VOL ADDRESS IN S1
	$RETT				;AND RETURN

SCNV.3:	AOS	S2,LENGTH		;GET LENGTH+1 IN S2
	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%CENT		;CREATE A NEW VOL ENTRY
	HRL	TF,P1			;GET THE OLD VOL ADDRESS
	HRR	TF,S2			;GET THE NEW VOL ADDRESS
	MOVE	S1,LENGTH		;GET THE ENTRY LENGTH
	ADDI	S1,-2(S2)		;GET VOL ENTRY END ADDRESS -1
	BLT	TF,0(S1)		;COPY OLD VOL TO NEW VOL
	LOAD	S1,.VLOWN(S2),VL.CNT	;GET THE REQUEST COUNT
	ADDI	S1,.VLVSL(S2)		;POINT TO VOL VSL ADDRESS
	MOVEM	P2,0(S1)		;LINK THE VOL TO THE VSL
	MOVE	P2,S2			;GET THE NEW VOL ADDRESS IN P2

	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVIOUS PAGE

	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	MOVE	S2,P1			;GET THE OLD VOL ADDRESS IN S2
	PUSHJ	P,L%APOS		;POSITION TO THE OLD ENTRY
	PUSHJ	P,L%DENT		;DELETE THE OLD ENTRY

	;Now that we have deleted the old VOL entry and created a new one,
	;   we must go back through this volumes VSL chain and
	;   fixup the VSL's VOL pointer so that it now points to the new VOL
	;   entry instead of the old one.

	LOAD	P3,.VLOWN(P2),VL.CNT	;GET THE VSL COUNT FOR THIS VOL ENTRY
	MOVEI	S1,.VLVSL(P2)		;POINT S1 TO THE VSL ADDRESS LIST
SCNV.4:	MOVE	S2,0(S1)		;PICK UP A VSL ADDRESS IN S2
	LOAD	P4,.VSCVL(S2),VS.CNT	;GET THE VOL COUNT FOR THIS VSL IN P4
	MOVEI	S2,.VSVOL(S2)		;POINT TO THIS VSL'S VOL LIST
SCNV.5:	CAMN	P1,0(S2)		;WE ARE LOOKING FOR THE OLD VOL PTR
	JRST	SCNV.6			;FOUND IT,,CONTINUE ON
	AOS	S2			;POINT TO NEXT VOL POINTER
	SOJG	P4,SCNV.5		;CONTINUE TILL FOUND
	$STOP	(VPF,Volume Pointer Not Found) ;NOT THERE,,DEEEEP TROUBLE !!
SCNV.6:	MOVEM	P2,0(S2)		;LINK VSL TO NEW VOL ENTRY
	AOS	S1			;POINT TO NEXT VSL ADDRESS
	SOJG	P3,SCNV.4		;CONTINUE THROUGH ALL VSL'S
	INCR	.VLOWN(P2),VL.CNT	;BUMP THE REQUEST COUNT BY 1 (FOR CURRENT)
	SKIPE	S1,.VLUCB(P2)		;CHECK AND LOAD THE UCB ADDRESS
	MOVEM	P2,.UCBVL(S1)		;FOUND IT,,RELINK IT TO THIS VOL ENTRY
	MOVE	S1,P2			;RETURN THE VOL POINTER IN S1
	$RETT				;AND RETURN
>

TOPS20 <
SCNVOL:	$RETF				;RETURNS FALSE ON THE -20
>
	SUBTTL	UPDSVL - UPDATE THE STARTING VOLUME FOR A VOLUME SET

	;CALL:	S1/ The Sixbit Volume name or the Volume number
	;
	;RET:	True Always

UPDSVL:	TLNE	S1,770000		;IS IT A SIXBIT ID ???
	JRST	UPDS.2			;YES,,GO PROCESS IT
	CAMLE	S1,VOLNBR		;MUST BE LESS OR EQUAL TO VOLUME COUNT
	$RETF				;NO,,OFFSET TOO GREAT - THATS AN ERROR
	SUBI	S1,1			;MAKE THE COUNT AN OFFSET
	STORE	S1,.VSCVL(P2),VS.OFF	;AND SET IT IN VSL
	$RETT				;RETURN

UPDS.2:	LOAD	T1,.VSCVL(P2),VS.CNT	;GET THE VOLUME COUNT
	MOVNS	T1			;MAKE IT NEGATIVE
	HRLZS	T1			;MOVE RIGHT TO LEFT
	HRRI	T1,.VSVOL(P2)		;POINT TO THE VOLUME LIST
	SETZM	T2			;START OFFSET OUT AT 0
UPDS.3:	MOVE	S2,0(T1)		;GET A VOLUME POINTER
	CAMN	S1,0(S2)		;DO WE MATCH - VOLUME FOR VOLUME ???
	JRST	[STORE  T2,.VSCVL(P2),VS.OFF	;YES,,SAVE THE VOLUME OFFSET
		 $RETT  ]		;AND RETURN
	AOS	T2			;BUMP OFFSET COUNT
	AOBJN	T1,UPDS.3		;CONTINUE THROUGH ALL VOLUMES
	$RETF				;NOT FOUND,,TOUGH BREAKEEEE
	END