Google
 

Trailing-Edge - PDP-10 Archives - bb-h138e-bm_tops20_v6_1_distr - galaxy-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
	SUBTTL	Preliminaries

;
;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
;	1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985
;
;     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

	.DIRECT	FLBLST			;SQUASH LITERAL EXPANSION

	MDAMAN==:3			;Maintenance edit number
	MDADEV==:14			;Development edit number
	VERSIN (MDA)			;Generate edit number

	EXTERNAL DSPEDT,FSSEDT,IPCEDT
	QSRED2==:DSPEDT+FSSEDT+IPCEDT+MDAEDT
	SUBTTL	Table of Contents


;		Table of Contents for QSRMDA
;
;
;			   Section			      Page
;   1. Preliminaries. . . . . . . . . . . . . . . . . . . . .    1
;   2. Table of Contents. . . . . . . . . . . . . . . . . . .    2
;   3. Revision history . . . . . . . . . . . . . . . . . . .    3
;   4. MDA STRUCTURE INTER-RELATIONSHIPS. . . . . . . . . . .    4
;   5. QSRMDA Entry Points. . . . . . . . . . . . . . . . . .    5
;   6. Local Storage. . . . . . . . . . . . . . . . . . . . .    6
;   7. D$CLSV
;        7.1.   Clear All STR Valid Status. . . . . . . . . .    7
;   8. D$CSTR
;        8.1.   Check a structure for on-line . . . . . . . .    8
;   9. D$ESTR
;        9.1.   Extract a STR from an FD. . . . . . . . . . .    9
;  10. D$ASTD
;       10.1.   Add a structure dependency. . . . . . . . . .   11
;  11. FNDSTR
;       11.1.   Find a STR entry. . . . . . . . . . . . . . .   12
;  12. Mountable Device Allocator (MDA) . . . . . . . . . . .   13
;  13. D$INIT - ROUTINE TO INITIALIZE THE MDA DATA BASE . . .   18
;  14. HOLD/RELEASE/MOUNT interface for QSRQUE. . . . . . . .   19
;  15. D$MOUNT - Process a Tape/Disk Mount Request. . . . . .   21
;  16. D$DEASSIGN - DEASSIGN/RELEASE A VOLUME SET . . . . . .   22
;  17. D$CMDR - ROUTINE TO CREATE AN ENTRY IN THE MDR QUEUE .   23
;  18. D$LOGOUT - DELETE A USER MDR'S ON LOGOUT . . . . . . .   26
;  19. D$XCH - Exchange disk units. . . . . . . . . . . . . .   27
;  20. D$DMDR - ROUTINE TO UNWIND AND DELETE AN MDR . . . . .   28
;  21. D$IDENTIFY - ROUTINE TO PROCESS THE IDENTIFY COMMAND .   29
;  22. REASSIGN - Try to give a unit to a user. . . . . . . .   32
;  23. REAS.S - Routine to Perform Volume Switch Processing .   34
;  24. D$ASGN - ROUTINE TO ASSIGN FOREIGN DEVICES UNDER MDA .   36
;  25. D$ENABLE/D$DISABLE DRIVE AVR STATUS. . . . . . . . . .   38
;  26. D$RECOGNIZE - PROCESS THE OPR RECOGNIZE COMMAND. . . .   40
;  27. D$AVR - TAPE/DISK ONLINE PROCESSOR . . . . . . . . . .   41
;  28. D$DEVSTA - PROCESS TAPE/DISK STATUS MESSAGES . . . . .   42
;  29. TAPDEV - TAPE STATUS MESSAGE PROCESSOR . . . . . . . .   43
;  30. DSKDEV - DISK STRUCTURE DEVICE STATUS MESSAGE PROCESSOR  46
;  31. SETOWN - ROUTINE TO SET UP OWNERSHIP FOR A VSL . . . .   49
;  32. MNTVSL - ROUTINE TO ATTEMPT TO MOUNT A USERS REQUESTS.   50
;  33. MNTVSR - ROUTINE TO MOUNT A VOLUME AT VOLUME SWITCH TIME   53
;  34. VSLCHK - ROUTINE TO TRY TO MOUNT A VOLUME FROM THE VSL   54
;  35. MATUNI - ROUTINE TO GIVE A VOLUME TO ANY VALID REQUESTOR   56
;  36. CVLVSL - Compare Volume with Volume Set. . . . . . . .   57
;  37. CHKOWN - ROUTINE TO CHECK IF A USER OWNS A VOLUME. . .   58
;  38. D$UNLOAD - ROUTINE TO UNLOAD A TAPE DRIVE. . . . . . .   59
;  39. D$DISMOUNT - STRUCTURE DISMOUNT PROCESSOR. . . . . . .   60
;  40. VLUNLOAD - Unload a unit and break UCB-VOL links . . .   61
;  41. D$DELETE - ROUTINE TO DELETE REQUESTS FROM THE MOUNT QUEUE   62
;  42. D$SMDA - Set tape drive un/available/ initialize . . .   66
;  43. D$VSR - VOLUME SWITCH REQUEST FROM PULSAR. . . . . . .   68
;  44. D$DVS - DISMOUNT/DEALLOCATE VOLUME SET PROCESSOR . . .   72
;  45. D$RCATALOG - RESPONSE TO CATALOG INFO REQUEST MSG PROCESSOR  74
;  46. D$GENC - ROUTINE TO GENERATE CATALOG ENTRIES FROM THE UCB'S  76
;  47. D$ACK - ROUTINE TO PROCESS MDA ACK MESSAGES. . . . . .   77
;  48. Structure mount ACK processing . . . . . . . . . . . .   78
;  49. D$RMS - Routine to process the structure removed message   79
;  50. DSMACK - ROUTINE TO PROCESS DISMOUNT ACKS FROM TAPE LABELER  80
;  51. DSMOPR - Tell OPR about a structure just dismounted. .   83
;  52. CATACK - ROUTINE TO PROCESS CATALOG ACKS FROM TAPE LABELER   84
;  53. ASLACK - ROUTINE TO PROCESS ACKS FOR ADDING STR TO A SEARCH LIST   85
;  54. RMSACK - ROUTINE TO PROCESS 'REMOVE STRUCTURE' ACKS. .   86
;  55. D$ALIAS - ROUTINE TO MOUNT A STRUCTURE WITH AN ALIAS .   87
;  56. CHKSTR - ROUTINE TO CHECK FOR STRUCTURE AVAILABILITY .   89
;  57. D$LOCK - PROCESS LOCK AND UNLOCK MESSAGES. . . . . . .   90
;  58. TIMER ROUTINES FOR LOCK AND UNLOCK . . . . . . . . . .   93
;  59. LOCNOT - Notify users (countdown) of pending locks . .   95
;  60. CLEAR LOCKS ON STRUCTURE DISMOUNT. . . . . . . . . . .   96
;  61. LNEVENT - Set up a Lock notification event . . . . . .   97
;  62. D$LCKM - ROUTINE TO PROCESS THE RESET AFTER LOCK MESSAGE   98
;  63. VSREOV - ROUTINE TO SEND END OF VOLUME MSG TO TAPE LABELER   99
;  64. DELETE - ROUTINE TO DELETE ALL NEW VOL SETS FOR A USER  100
;  65. REMOVE - ROUTINE TO DELETE A SPECIFIC VSL AND RETRY THE MOUNT 101
;  66. DELVSL - ROUTINE TO DELETE A VSL . . . . . . . . . . .  102
;  67. ALCVSL - ROUTINE TO RETURN A VSL TO THE ALLOCATION POOL 105
;  68. DELMDR - ROUTINE TO DELETE AN MDR. . . . . . . . . . .  106
;  69. DELVOL - ROUTINE TO DELETE VOL BLOCKS FROM THE VOL QUEUE  107
;  70. GETLBT - ROUTINE TO RECODE THE VOLUME LABEL TYPE . . .  108
;  71. FNDDSK - ROUTINE TO FIND A DSK VOL BLOCK USING VOLUME ID  109
;  72. CREVOL - ROUTINE TO CREATE A VOL BLOCK IN VOL QUEUE. .  110
;  73. USRACK - ROUTINE TO GENERATE AN ACK TO THE USER FOR MOUNT/ALLOC 111
;  74. ACKUSR - ROUTINE TO CREATE AN ACK AFTER THE VOL SET IS MOUNTED  112
;  75. TELOPR - ROUTINE TO NOTIFY THE OPERATOR TO MOUNT DEVICES  115
;  76. MNTOPR - ROUTINE TO NOTIFY THE OPR OF PENDING MOUNT REQUESTS  120
;  77. SETSEL - ROUTINE TO FIND THOSE UCB'S WHICH ARE FREE. .  122
;  78. USRNOT - SEND A MESSAGE TO THE USER. . . . . . . . . .  123
;  79. NSTUSR - Notify users of pending structure locks . . .  125
;  80. LBLNOT - ROUTINE TO NOTIFY LABEL PROCESS OF DEVICE REASSIGNMENT 126
;  81. LBLHDR - Set up for a message to MDA . . . . . . . . .  128
;  82. SNDREC - ROUTINE TO SEND A RECOGNIZE MSG TO THE TAPE LABELER  129
;  83. UNLOAD . . . . . . . . . . . . . . . . . . . . . . . .  129
;  84. SNDVDM - Send volume dismount message to tape labeler.  130
;  85. FNDUCB - ROUTINE TO FIND A UCB IN THE UCB CHAIN. . . .  131
;  86. GETRSN - ROUTINE TO RETURN THE FIRST AVAILABLE RESOURCE NUMBER  132
;  87. GIVRSN - Return a slot of the A matrix . . . . . . . .  133
;  88. FNTAPE - ROUTINE TO FIND A TAPE VOLUME IN THE VOL DATA BASE 134
;  89. FNDOWN - FIND ANY OWNER OF A VOLUME  . . . . . . . . .  135
;  90. FNDMDR - ROUTINE TO FIND AN MDR GIVEN ITS JOB NUMBER .  136
;  91. D$CCAT - Compare catalogue entries . . . . . . . . . .  137
;  92. D$FCAT - ROUTINE TO SEARCH THE CATALOG CACHE FOR A VOL SET  140
;  93. D$TCAT - Type a catalogue entry. . . . . . . . . . . .  141
;  94. D$UCAT - Find the number users of a catalogue entry. .  143
;  95. FNDVSL - ROUTINE TO FIND A PARTICULAR VSL IN AN MDR. .  144
;  96. FNDVSN - ROUTINE TO FIND A VOLUME SET VIA THE VOL SET NAME  145
;  97. FNDLNM - ROUTINE TO FIND A USERS VSL GIVEN A LOGICAL NAME 146
;  98. VSLFND - ROUTINE TO FIND A VSL IN A USERS REQUEST. . .  147
;  99. GENVOL - ROUTINE TO CREATE A 'SCRATCH' VOLUME BLOCK. .  148
; 100. ADDVOL -  ROUTINE TO ADD A VOL BLOCK DURING MOUNT PROCESSING  149
; 101. CKUVOL - CHECK FOR MULTIPLE USER REQUESTS FOR THE SAME TAPE VOL 150
; 102. MISC ROUTINES. . . . . . . . . . . . . . . . . . . . .  151
; 103. D$MDAE - ROUTINE TO NOTIFY THE OPERATOR OF ANY ERRORS.  152
; 104. DSKRSN - ROUTINE TO RETURN RESOURCE NUMBERS FOR DISK DRIVES 153
; 105. TAPRSN - ROUTINE TO RETURN RESOURCE NUMBERS FOR TAPE DRIVES 154
; 106. D$TNRS - GET A TAPE RESOURCE NUMBER. . . . . . . . . .  155
; 107. STRRSN - ROUTINE TO RETURN RESOURCE NUMBERS FOR STRUCTURES  156
; 108. D$T/SVRS - Generate resource #s for Tape/Structure volumes  158
; 109. VALMSG - ROUTINE TO VALIDATE THE MOUNT/ALLOCATE MESSAGE 159
; 110. CHKBAT - ROUTINE TO CHECK FOR BATCH REQUESTS DOING MOUNTS 160
; 111. BLDVSL - ROUTINE TO BREAK DOWN MOUNT MSG ENTRIES . . .  161
; 112. VSL DEFAULTING ROUTINES. . . . . . . . . . . . . . . .  164
; 113. MOUNT REQUEST BLOCK PROCESSOR ROUTINES . . . . . . . .  165
; 114. Count the number of requests needing a structure . . .  170
; 115. BLDSTR - ROUTINE TO PIECE TOGETHER VOL BLKS AND MAKE A STRUCTURE  171
; 116. SNDBLD - ROUTINE TO LINK THE STR VOL BLKS AND SEND STR BUILD MSG  172
; 117. ASLMSG - ROUTINE TO BUILD AN 'ADD STRUCTURE' MSG . . .  174
; 118. GETCAT - ROUTINE TO SEND A REQUEST FOR CATALOG INFO MESSAGE 176
; 119. D$BCAT - BLISS INTERFACE TO ROUTINE GETCAT . . . . . .  177
; 120. SCNVOL - ROUTINE TO FIND COMMON VOLUMES REQUESTS AND LINK THEM  178
; 121. UPDSVL - UPDATE THE STARTING VOLUME FOR A VOLUME SET .  180
; 122. D$INID - Initialization done for tape handler. . . . .  181
; 123. D$ALOC - ROUTINE TO PERFORM DEVICE ALLOCATION. . . . .  182
; 124. D$BMTX - ROUTINE TO FIND A USERS ENTRY IN THE 'B' MATRIX  186
; 125. DEADLK - BLISS INTERFACE ROUTINE FOR DEADLOCK AVOIDANCE ROUTINE 187
; 126. D$DLCK - ROUTINE TO SET UP THE DEADLOCK AVOIDANCE CHECK 188
; 127. RETA%C - ROUTINE TO RETURN RESOURCES TO THE 'A' & 'C' MATRICIES 191
; 128. RETBMA - ROUTINE TO RETURN RESOURCES TO THE 'B' MATRIX  192
; 129. ADDBMA - ROUTINE  TO UPDATE A RESOURCE NUMBER FOR A USER  193
; 130. SUBCMA - ROUTINE TO RETURN RESOURCES TO THE 'C' MATRIX  195
; 131. SUBBMA - ROUTINE TO RETURN 'B' MATRIX RESOURCES. . . .  195
; 132. ADDAMA - ROUTINE TO REMOVE 'A' MATRIX RESOURCES. . . .  196
; 133. ADJAMA - ROUTINE TO ADJUST THE 'A' MATRIX. . . . . . .  197
; 134. VSLRSN - ROUTINE TO FIND A VSL'S RESOURCE NUMBERS. . .  198
; 135. SETSTK - Setup a queue for VSL, RSN pairs. . . . . . .  200
; 136. GETADD - ROUTINE TO CALC THE 'A', 'B', 'C' MATRIX ADD VALUE 201
; 137. MISC ROUTINES. . . . . . . . . . . . . . . . . . . . .  202
; 138. MDA PSEUDO PROCESS ACTION ROUTINES . . . . . . . . . .  203
; 139. D$PPRE - ROUTINE TO RESET A REAL PROCESS TO A PSEUDO PROCESS  204
; 140. D$PMDR - ROUTINE TO LOOK AT THE MDR LOOKING FOR PSEUDO PROCESSES  205
; 141. D$MODR - ROUTINE TO MODIFY A USERS ALLOCATION ON THE 'FLY'  206
; 142. SHUFFL - Routine to shuffle resources around for a requestor  207
; 143. MODALC - Routine to modify a users resource number for a request  208
; 144. D$ALCT - ROUTINE TO ALLOCATE TAPE VOLUMES FOR 'IDENTIFY' COMMAND  209
SUBTTL	Revision history

COMMENT \

*****  Release 4.2 -- begin maintenance edits  *****

2	4.2.1591	13-Sep-84
	Set flag G$CRS instead of setting an error on a GTJFN error in D$ESTR 
so as to prevent CRS and RRF crashes due to a GTJFN failure.

3	4.2.1597	7-Nov-84
	For mount requests, send the user an ACK before sending the mount
message to MOUNTR. This prevents a race between MOUNTR's ACK and QUASAR's
ACK.

*****  Release 5.0 -- begin development edits  *****

10	5.1003		7-Jan-83
	Move to new development area.  Add version vector.  Clean up
edit organization.  Update TOC.

11	5.1137		20-Apr-84
	Subtotal QUASAR edit version number in QSRED2.

12	5.1162		21-Sep-84
	Add table entry for SNA object type.

13	5.1182		30-Nov-84
	Do not trash tape mount requests if MOUNTR is not running. Inform
the user that MOUNTR is not running and that all tape mount requests will
be trashed upon MOUNTR startup.

14	5.1210		25-Mar-85
	Add the first tape volume identifier to the end of the VSL 
corresponding to the tape volume set.

\   ;End of Revision History
	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

TOPS10	<
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 TOPS10 CONDITIONAL

TOPS20	<
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 TOPS20 CONDITIONAL
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
	CAXE	S2,.DCTFS		;IF IT WAS A FILE STRUCTURE
	CAMN	P1,DSKCBL+.DCSNM	;  OR SAME NAME AS WE ENTERED WITH ???
	JRST	ESTR.1			;THEN GO ADD IT
	MOVE	P1,DSKCBL+.DCSNM	;ELSE, USE STR NAME RET BY DSKCHR
	MOVE	S1,P1			;GET THE NAME IN S1
	PUSHJ	P,FNDSTR		;TRY ONCE MORE TO LOCATE IT
	JUMPT	.RETT			;WIN,,RETURN

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	[ MOVEM	S1,G$CRS##	    ;Place error code in flag
		  $RETT ]		    ;Quit and clean up
	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$DISMOUNT >		;STRUCTURE DISMOUNT PROCESSOR
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
TOPS10<	INTERN	D$DVS >			;DISMOUNT/DEALLOCATE MESSAGE PROCESSOR
TOPS10<	INTERN	D$RCATALOG >		;RESPONSE TO CATALOG INFO REQUEST
TOPS10<	INTERN	D$ACK >			;MDA ACK MESSAGE
TOPS10<	INTERN	D$LOCK >		;LOCK A FILE STRUCTURE
TOPS10<	INTERN	D$ULOK >		;UNLOCK A FILE STRUCTURE
	INTERN	D$CMDR 			;CREATE AN MDR FOR A USER
TOPS10<	INTERN	D$ALIAS >		;MOUNT WITH ALIAS PROCESSOR
TOPS10<	INTERN	D$TNRS >		;DEFINE A TAPE RESOURCE NUMBER
TOPS10<	INTERN	D$DNRS >		;DEFINE A DISK RESOURCE NUMBER
	INTERN	D$LOGOUT		;PROCESS A USER LOGOUT
	EXTERN	BELLS			;MAKE THIS REFERENCE'ABLE
	EXTERN	G$MSG			;MESSAGE BUFFER
	EXTERN	G$ACKB 			;GENERIC ACK BUFFER ADDRESS
TOPS10<	EXTERN	DEVNTB >		;%UNKN DEVICE TRANSLATION TABLE
TOPS10<	INTERN	D$ASR >			;AUTOMATIC STR RECOGNITION FLAG
TOPS10<	INTERN	AMATRX >		;'A' MATRIX ADDRESS
TOPS10<	INTERN	BMATRX >		;'B' MATRIX LIST ID
TOPS10<	INTERN	CMATRX >		;'C' MATRIX LIST ID
TOPS10<	INTERN	D$INCA >		;INCRIMENT 'A' MATRIX BY 1
TOPS10<	INTERN	D$DECA >		;DECRIMENT 'A' MATRIX BY 1
	INTERN	ERRACK			;USER ERROR ACK FLAG
	INTERN	MDAOBJ			;MDA OBJECT BLOCK
TOPS10<	INTERN	D$ALOC >		;VSL ALLOCATION ROUTINE
	INTERN	D$PPRE 			;REAL TO PSEUDO PROCESS CONVERSION
	INTERN	D$PPRL 			;DELETE A PSEUDO PROCESS MDR
	INTERN	D$PMDR 			;RESET PSEUDO PROCESSES ON BATCON HELLO
TOPS10<	INTERN	D$DLCK >		;VSL CLAIM & DEADLOCK CHECK ROUTINE
TOPS10<	INTERN	D$FCAT >		;REQUEST SYSTEM CATALOG DATA
TOPS10<	INTERN	D$CMTX >		;LOCATE A USERS 'C' MATRIX ENTRY
TOPS10<	INTERN	D$BMTX >		;LOCATE A USERS 'B' MATRIX ENTRY

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

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,,MNTPRT)		;VOL PROTECTION CODE BLOCK PROCESSOR
	 $SET(.TMINI,,.RETT)		;VOL INITIALIZATION BLOCK PROCESSOR
TOPS20<	 $SET(.SMNAM,,MNTSET) >		;STRUCTURE NAME PROCESSOR
TOPS10<	 $SET(.SMNAM,,.RETF) >		; (ILLEGAL ON TOPS10)
TOPS20<	 $SET(.SMALI,,MNTVOL) >		;ALIAS BLOCK PROCESSOR
TOPS10<	 $SET(.SMALI,,.RETF) >		; (ILLEGAL ON TOPS10)
	 $SET(.TMLNM,,MDRLNM)		;LOGICAL NAME PROCESSOR
	$EOB


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

DEFINE	$PACK(AC),<
	AOBJP	AC,.+4		;;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	.-3		;;HEAD BACK FOR MORE
	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

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/]

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

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

D$DEN::	0		;SYSTEM DEFAULT
	UC.200		;200 BPI
	UC.556		;556 BPI
	UC.800		;800 BPI
	UC.1600		;1600 BPI
	UC.6250		;6250 BPI

	DENLEN==.-D$DEN

TRK::	SIXBIT/     /
	SIXBIT/ 7   /
	SIXBIT/ 9   /

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

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

LCKTB1:	SIXBIT	/LOCK/
	SIXBIT	/UNLOCK/

LCKTB2:	SIXBIT	/UNLOCK/
	SIXBIT	/LOCK/

RID:	BLOCK	1			;REQUEST ID SAVE AREA
D$ASR:	EXP	-1			;AUTOMATIC STRUCTURE RECOGNITION FLAG
AMATRX: EXP	0			;'A' MATRIX ADDRESS INITIALLY NONE
BMATRX: 0,,0				;'B' MATRIX LIST ID
CMATRX: 0,,0				;'C' MATRIX LIST ID
STRVOL:	BLOCK	1			;STARTING VOLUME SAVE AREA
VOLNBR:	BLOCK	1			;VOLUME COUNT IN A VOLUME SET
ERRACK: BLOCK	1			;ACK BEING SENT IS A FATAL ACK
PROCNT:	0,,0				;'B' & 'C' MATRIX PROCESS COUNTS
MDAOBJ:	.OTMNT				;MDA OBJECT BLOCK - TYPE .OTMNT
	0,,0				;SPACE FOR SIXBIT UNIT NAME
	0,,0				;NO NODE NAME
VOLNAM:	BLOCK	2			;PLACE FOR AN ASCIZ STR NAME
WRTLCK:	BLOCK	1		;WRITE-LOCKED FLAG FOR STR MOUNTS
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
CATQUE:: 0,,0				;CATALOG CACHE ID
CATOLD:	BLOCK	1			;OLD CATALOG ENTRY ADDRESS
CATNEW:	BLOCK	1			;NEW CATALOG ENTRY ADDRESS
CATOBJ:	BLOCK	OBJ.SZ			;OBJECT BLOCK FOR WTO MSG
CATTXT:	BLOCK	<CATSIZ==100>		;TEXT BLOCK
CATCNT:	BLOCK	1			;CHARACTER COUNT
CATPTR:	BLOCK	1			;BYTE POINTER

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

TOPS10<
	;This structure defines the initial 'A' matrix for Resource Allocation
	;  Call: X(Res-Name,Res-Type,Kontroler type,Unit type,Track,Density)

	MAXNCH==^D39			;MAX # OF CHARS IN A RESOURCE NAME
	AMNMLN==<MAXNCH+1+4>/5		;WORDS REQ'D TO STORE ONE OF THESE
	DEFINE	GENRES,<XLIST

	X	(RD10,%DISK,.DCCFH,.DCUFD,0,UC.SHR)
	X	(RS04,%DISK,.DCCFS,.DCUS4,0,UC.SHR)
	X	(RP04,%DISK,.DCCRP,.DCUR4,0,UC.SHR)
	X	(RM10B,%DISK,.DCCFH,.DCUFM,0,UC.SHR)
	X	(RP02,%DISK,.DCCDP,.DCUD2,0,UC.SHR)
	X	(RP06,%DISK,.DCCRP,.DCUR6,0,UC.SHR)
	X	(RP03,%DISK,.DCCDP,.DCUD3,0,UC.SHR)
	X	(RM03,%DISK,.DCCRP,.DCUR3,0,UC.SHR)
	X	(RP07,%DISK,.DCCRP,.DCUR7,0,UC.SHR)
	X	(RP20,%DISK,.DCCRN,.DCUN0,0,UC.SHR)
	X	(<7 TK 200/556/800>,%TAPE,0,0,%TRK7,UC.200+UC.556+UC.800)
	X	(<9 TK 800/1600>,%TAPE,0,0,%TRK9,UC.800+UC.1600)
	X	(<9 TK 1600/6250>,%TAPE,0,0,%TRK9,UC.1600+UC.6250)
	X	(<9 TK 200/556/800>,%TAPE,0,0,%TRK9,UC.200+UC.556+UC.800)
	LIST>

	DEFINE	X(TYP7,TYPE,KON,UNIT,TRK,DEN),<XLIST
	$BUILD	AMALEN
		$SET	(.AMNAM,AM.NAM,[ASCIZ^TYP7^])
		$SET	(.AMNAM,AM.PRM,1)
		$SET	(.AMNAM,AM.USE,1)
		$SET	(.AMSTA,,<FLD(KON,UC.KTP)+FLD(UNIT,UC.UTP)+FLD(TRK,UC.TRK)+FLD(TYPE,UC.DVT)+DEN>)
	$EOB
	LIST>

	DEFINE	BLDPRM,<XLIST
	  GENRES			;BUILD THE PERMANENT 'A' MATRIX
	LIST >

;Generate the permanent A-matrix - Build block 0, the header

AMATPM:	$BUILD	AMALEN
	$SET	(.AMHDR,AM.CNT,RESCNT)	;HIGHEST IN USE
	$SET	(.AMHDR,AM.MCN,RESCNT)	;BIGGEST MATRIX HAS SPACE FOR
	$SET	(.AMHDR,AM.LEN,RESLEN)	;LENGTH OF THIS BLOCK
	$EOB

	BLDPRM				;BUILD THE PERMANENT 'A' MATRIX
	RESLEN==.-AMATPM		;THE LENGTH OF THE PERMANENT A MATRIX
	RESCNT==<RESLEN/AMALEN>-1	;THE NUMBER OF BLOCKS IN USE

> ;END TOPS10 CONDITIONAL

TMPVSL:	BLOCK	VSLLEN			;MAKE SURE WE AT LEAST HAVE ENOUGH SPACE

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

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

	DEFINE	X(CODE,STRING),<XLIST
	EXP	[ASCIZ/STRING/]
	LIST >

MDAERS:	MDAERR			;GENERATE THE ERROR STRINGS
	SUBTTL	D$INIT - ROUTINE TO INITIALIZE THE MDA DATA BASE

D$INIT:	SKIPN	G$MDA##			;MDA SUPPORT HERE ???
	$RETT				;NO,,RETURN
	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
TOPS20<	$RETT	>			;RETURN NOW ON THE -20
TOPS10<					;...BUT ON THE -10...
	;NOTE:::: The UCB chain will be built by I$INIT (QSRT10)

	MOVEI	S1,MDADAE		;GET DEADLOCK FLAG
	MOVEM	S1,G$DEAD##		;AND SET IT
	PUSHJ	P,L%CLST		;CREATE A LIST FOR THE CATALOG CACHE
	MOVEM	S1,CATQUE		;SAVE THE ID
	PUSHJ	P,L%CLST		;CREATE A LIST FOR THE 'B' MATRIX
	MOVEM	S1,BMATRX		;SAVE IT
	PUSHJ	P,L%CLST		;CREATE A LIST FOR THE 'C' MATRIX
	MOVEM	S1,CMATRX		;SAVE IT
	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;POSITION TO THE FIRST UCB
	JUMPT	INIT.2			;IF FOUND,,CONTINUE
	$STOP	(NUE,Null UCB chain encountered) ;NO,,DEEP TROUBLE
INIT.1:	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB ENTRY
INIT.2:	JUMPF	INIT.4			;NO MORE,,SETUP PERM STRS
	MOVE	T1,S2			;SAVE THE UCB ADDRESS IN T1
	LOAD	S1,.UCBST(T1),UC.AVA	;GET AVAILABLE BIT
	JUMPE	S1,INIT.1		;NOT AVAILABLE,,SKIP THIS
	MOVE	S1,T1			;GET THE UCB ADDRESS IN S1
	PUSHJ	P,D$INCA		;INCRIMENT THE 'A' MATRIX
	JRST	INIT.1			;AND GO TRY THE NEXT UCB

INIT.4:	PUSHJ	P,I$ISTR##		;INITIALIZE SYSTEM STRUCTURE LIST
	PUSHJ	P,I$PERM##		;SETUP 'PERMENANT STRUCTURES'

	MOVN	P1,G$MAXJ##		;GET NUMBER OF JOBS IN THE SYSTEM
	HRLZS	P1			;GET -NUMBER,,0
	AOS	P1			;START WITH JOB NUMBER 1
	MOVEI	S1,0(P1)		;GET A JOB NUMBER
	PUSHJ	P,I$SSRL##		;CREATE THE GUYS MDR ENTRY
	AOBJN	P1,.-2			;CONTINUE FRO ALL JOBS
	PJRST	MNTOPR			;RETURN,,SETTING UP MOUNTS PENDING EVENT
> ;END TOPS10 CONDITIONAL
SUBTTL	HOLD/RELEASE/MOUNT interface for QSRQUE


; Here while processing a HOLD or RELEASE command to notify the
; operator of mount queue changes.
; Call:	MOVE	S1, QE address
;	MOVE	S2, 0 for HOLD or 1 for RELEASE
;	PUSHJ	P,D$HOLD/D$RELE
;
D$HOLD::
TOPS20	<POPJ	P,>			;CAN'T DO THIS HERE

TOPS10	<				;TOPS-10 ONLY
	SKIPN	.QEMDR(S1)		;HAVE AN MDR?
	POPJ	P,			;NO
	$SAVE	<P1,P2,P3,P4>		;SAVE SOME ACS
	$SAVE	<T1,T2>			;SAVE MORE ACS
	$SAVE	<AP>			;SAVE AP
	MOVE	AP,.QEMDR(S1)		;GET THE MDR ADDRESS
	MOVE	T1,S2			;REMEMBER WHAT WE'RE DOING
	LOAD	P1,.MRCNT(AP),MR.CNT	;GET VSL COUNT FOR THIS MDR
	MOVNS	P1			;NEGATE IT
	HRLI	P1,.MRVSL(AP)		;GET ADDRESS OF FIRST VSL
	MOVSS	P1			;MAKE AN AOBJN POINTER

HOLD.1:	HRRZ	P2,(P1)			;GET A VSL ADDRESS
	MOVX	S1,VS.ALC!VS.ABO	;GET SOME BITS
	TDNE	S1,.VSFLG(P2)		;ALLOCATED OR ABORTED?
	JRST	HOLD.4			;YES - IGNORE THIS VSL
	LOAD	P3,.VSCVL(P2),VS.CNT	;GET NUMBER OF VOLS IN THE VSN
	MOVNS	P3			;NEGATE IT
	HRLI	P3,.VSVOL(P2)		;GET ADDRESS OF FIRST VOL
	MOVSS	P3			;MAKE AN AOBJN POINTER

HOLD.2:	HRRZ	P4,(P3)			;GET A VOL ADDRESS
	HRRZ	S1,.VLVSL(P4)		;GET A VSL BACK POINTER
	MOVX	S2,VL.ASN		;GET THE VOL ASSIGNED BIT
	CAMN	S1,P2			;SAME VSL?
	TDNE	S2,.VLVSL(P4)		;AND VOL ASSIGNED?
	JRST	HOLD.3			;TRY ANOTHER VOL
	LOAD	S1,.VSRID(P2),VS.RID	;GET MOUNT REQUEST ID
	MOVE	S2,.MRQEA(AP)		;GET QE ADDRESS
	MOVE	S2,.QERID(S2)		;GET QE REQUEST ID
	LOAD	T2,.MRFLG(AP),MR.QUE	;GET OBJECT TYPE
	$WTO	(<Mount request #^D/S1/>,<^I/HOLD.5/>,,<$WTFLG(WT.SJI)>)
	JUMPE	T1,HOLD.3		;ONWARD IF HOLDING THIS JOB
	MOVX	S1,VS.OPR		;GET A BIT
	IORM	S1,.VSFLG(P2)		;AND WAKE UP THE SLEEPING OPERATOR

HOLD.3:	AOBJN	P3,HOLD.2		;LOOP THROUGH ALL VOL BLOCKS
HOLD.4:	AOBJN	P1,HOLD.1		;LOOP THROUGH ALL VSL BLOCKS
	POPJ	P,			;RETURN

HOLD.5:	ITEXT	(<^T/@HOLD.6(T1)/ the queue due to ^T/@MNTTAB(T2)/
request #^D/S2/ being ^T/@HOLD.7(T1)/>)

HOLD.6:	[ASCIZ	|Removed from|]		;HOLD
	[ASCIZ	|Added to|]		;RELEASE

HOLD.7:	[ASCIZ	|held|]			;HOLD
	[ASCIZ	|released|]		;RELEASE
; Translation table of object type to text for mount displays
;
MNTTAB:	[0,,0]				;INVALID
	[0,,0]				;.OTRDR (READER QUEUE)
	[0,,0]				;.OTNET (NETWORK QUEUE)
	[ASCIZ	|Print|]		;.OTLPT (PRINTER QUEUE)
	[ASCIZ	|Batch|]		;.OTBAT (BATCH QUEUE)
	[ASCIZ	|Card punch|]		;.OTCDP (CARD PUNCH QUEUE)
	[ASCIZ	|Paper tape punch|]	;.OTPTP (PAPER TAPE PUNCH QUEUE)
	[ASCIZ	|Plotter|]		;.OTPLT (PLOTTER QUEUE)
	[0,,0]				;.OTJOB
	[0,,0]				;.OTTRM
	[0,,0]				;.OTOPR
	[0,,0]				;.OTIBM
	[0,,0]				;.OTMNT
	[ASCIZ	|File transfer|]	;.OTFTS (FILE TRANSFER QUEUE)
	[ASCIZ	|Interpreter|]		;.OTBIN (SPRINT)
	[ASCIZ	|Retrieval|]		;.OTRET
	[0,,0]				;.OTNOT
	[0,,0]				;.OTDBM
	[0,,0]				;.OTFAL
	[0,,0]				;.OTSNA

> ;END TOPS-10 CONDITIONAL
	SUBTTL	D$MOUNT - Process a Tape/Disk Mount Request

	;CALL: 	M/ The Mount Message Address
	;	S1/ The QE address if entry point D$MNTP
	;
	;RET:	An Ack to the user (If he wants one)

D$MNTP:: SKIPA				;'MNTP' ENTRY POINT (CALLED FROM I$BMDR)
D$MOUNT: SETZM	S1			;'MOUNT' ENTRY POINT
	JUMPN	S1,.+3			;IF 'MNTP' ENTRY,,SKIP G$QUEUE CHECK
	SKIPE	G$QUEUE##		;ARE CREATES VALID ???
	JRST	E$OHR##			;NO,,RETURN AN ERROR !!!
	SKIPN	G$MDA##			;IS MDA SUPPORTED ???
	JRST	E$MDA##			;NO,,RETURN AN ERROR !!!
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	MOVE	P1,S1			;SAVE THE QE ADDRESS IF THERE IS ONE
	PUSHJ	P,D$CMDR		;GO CREATE THE MDR ENTRY
	JUMPF	.RETT			;RETURN IF AN ERROR OCCURED
	JUMPE	P1,.+3			;NO QE,,SKIP NEXT 2 INSTRUCTIONS
	MOVEM	AP,.QEMDR(P1)		;YES,,SAVE THE MDR ADDRESS
	MOVEM	P1,.MRQEA(AP)		;SAVE THE QE ADDRESS IF ANY
	MOVE	P1,S1			;SAVE THE VSL ADDRESS (FROM D$CMDR)
	MOVE	S2,G$ACK##		;GET THE ACK REQUEST CODE
	STORE	S2,.MRFLG(AP),MR.ACK	;SAVE IT
	SETZM	G$ACK##			;CLEAR THE ACK REQUEST
	PUSHJ	P,I$MNTR##		;SEND THE MESSAGE TO MOUNTR (TOPS20 ONL
TOPS20<	$RETT 				;And return
>
TOPS10<	MOVE	S1,P1			;GET THE VSL ADDRESS
	PUSHJ	P,D$ALOC		;TRY TO PERFORM ALLOCATION
	JUMPF	[JUMPL	S1,.RETT	;ALLOCATION POSTPONED,,JUST RETURN
		 MOVE	S1,P1		;NO GOOD,,GET THE VSL ADDRESS BACK
		 PJRST	DELETE ]	;RETURN,,DELETING VOL SETS JUST ADDED
	MOVE S1,P1			;GET THE	VSL ADDRESS
	PUSHJ	P,MNTVSL		;TRY TO MOUNT IT
	$RETT				;RETURN
>
	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
	MOVE	S1,.TDDEV(M)		;GET THE RELEASED DEVICE NAME
	PUSHJ	P,UCBLOC		;FIND THE DEVICE IN THE UCB CHAIN
	JUMPT	DEAS.1			;CONTINUE IF WE KNOW ABOUT THIS DEVICE
	MOVE	S1,.TDDEV(M)		;PICK UP THE DEVICE NAME
	PUSHJ	P,I$MDAC##		;CLEAR THE MDA BIT
	$WTO	(<Released>,,MDAOBJ)	;TELL THE OPERATOR
	$RETT				;RETURN

DEAS.1:	MOVE	P1,S1			;SAVE THE UCB ADDRESS IN P1
	SKIPN	P2,.UCBVS(P1)		;DOES THE UCB POINT TO A VSL ???
	$RETT				;NO OWNER,,STRANGE !!!
	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
	MOVE	S1,P2			;GET THE VSL ADDRESS IN S1
	MOVE	S2,.TDDVT(M)		;GET THE DEVICE TYPE
	CAIN	S2,.TYDTA		;A DECTAPE?
	JRST	DEAS.2			;YES
	CAIE	S2,.TYMTA		;A MAGTAPE?
	JRST	DEAS.3			;NOPE - A RANDOM DEVICE
	JRST	DEAS.4			;YES


; Here for DECtape deassign
;
DEAS.2:	PUSHJ	P,I$DDSM##		;YES,,ACCOUNT FOR ITS USAGE
	MOVE	S1,.TDDEV(M)		;PICK UP THE DEVICE NAME
	PUSHJ	P,I$MDAC##		;CLEAR THE MDA BIT


; Here for random device deassign
;
DEAS.3:	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	MOVE	S2,.VSUCB(P2)		;GET THE UCB ADDRESS
	PUSHJ	P,L%APOS		;POSITION TO THAT ENTRY
	PUSHJ	P,L%DENT		;DELETE THAT ENTRY
	SETZM	.VSUCB(P2)		;ZAP THAT POINTER
	MOVE	S1,P2			;GET THE VSL ADDRESS
	PUSHJ	P,DELVSL		;DELETE IT
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE USERS REQUEST COUNT
	JUMPE	S1,DELMDR		;NOTHING LEFT,,DELETE THE MDR
	$RETT				;AND EXIT


; Here for magtape deassign
;
DEAS.4:	PUSHJ	P,I$TDSM##		;PERFORM TAPE ACCOUNTING
	MOVE	S1,P2			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,ALCVSL		;RETURN THIS VSL TO THE ALLOCATION POOL
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE USERS REQUEST COUNT
	JUMPE	S1,DELMDR		;NOTHING LEFT,,DELETE THE MDR
	$RETT				;AND EXIT
>
	SUBTTL	D$CMDR - ROUTINE TO CREATE AN ENTRY IN THE MDR QUEUE

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

D$CMDR:	PUSHJ	P,VALMSG		;GO VALIDATE SOME OF THE MESSAGE
	JUMPF	.RETF			;NO GOOD,,THATS AN ERROR
	PUSHJ	P,.SAVE4		;SAVE 4 P AC'S
	MOVE	S1,REQIDN##		;SAVE THE LAST VALID REQUEST ID
	MOVEM	S1,RID			;  FOR A FEW MINUTES

	LOAD	S1,G$PRVS##,MD.PJB	;GET THE SENDERS JOB NUMBER
	PUSHJ	P,FNDMDR		;FIND THIS USERS MDR
	JUMPF	CMDR.1			;NOT THERE,,CREATE ONE

	;Here to check to see if there is enough room for the next VSL
	;and if not, create a new MDR

	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%SIZE		;GET HIS CURRENT MDR LENGTH
	MOVE	P4,S2			;SAVE THE MDR LENGTH
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT
	SUBI	S2,MDRLEN(S1)		;DELETE BASE MDR LEN+VSL CNT FROM TOTAL
	SUB	S2,.MMARC(M)		;SUBTRACT NEW REQUEST NUMBER
	JUMPGE	S2,CMDR.2		;NEW REQUEST WILL FIT INTO OLD MDR !!
	MOVNS	S2			;GET POSITIVE DIFFERENCE
	ADD	S2,P4			;ADD IT TO THE OLD MDR LENGTH
	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%CENT		;CREATE A NEW MDR FOR THE USER
	MOVE	P3,S2			;SAVE THE NEW MDR ADDRESS
	HRL	P3,AP			;CREATE SOURCE,,DEST BLT AC
	ADDI	P4,-1(S2)		;GET BLT END ADDRESS
	BLT	P3,0(P4)		;COPY OLD MDR TO NEW MDR
	EXCH	AP,S2			;EXCHANGE OLD AND NEW MDR ADDRESSES
	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%APOS		;POSITION TO THE OLD MDR
	PUSHJ	P,L%DENT		;   AND DELETE IT
	SKIPE	S1,.MRQEA(AP)		;POINTING TO A QE ???
	MOVEM	AP,.QEMDR(S1)		;YES,,RESET POINTER !
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT (CURRENT)
	MOVNS	S1			;NEGATE IT
	MOVSS	S1			;MOVE RIGHT TO LEFT
	HRRI	S1,.MRVSL(AP)		;CREATE AOBJN AC FOR VSL ADDRESS LIST

CMDR.0:	MOVE	S2,0(S1)		;GET A VSL ADDRESS
	MOVEM	AP,.VSMDR(S2)		;RESET MDR POINTER FOR NEW MDR
	AOBJN	S1,CMDR.0		;RESET ALL VSL MDR POINTERS
	JRST	CMDR.2			;AND CONTINUE PROCESSING

	;CONTINUED ON THE NEXT PAGE
	;Here to create a new MDR for a user who does not already have one

CMDR.1:	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$MRP##			;NONE,,THEN 'MOUNT/WAIT' W/NONE PENDING
	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	S1,AP			;GET THE MDR ADDRESS IN S1
	PUSHJ	P,I$DFMR##		;FILL IN SYSTEM DEPENDENT DATA

CMDR.2:	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,.MSCOD(M)		;GET THE SENDERS ACK CODE
	MOVEM	S1,.MRACK(AP)		;SAVE IT
	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
	LOAD	S1,.MMFLG(M),MM.GFR	;GET CREATED BY [SYSTEM]GOPHER BIT
	LOAD	S2,.MSTYP(M),MS.TYP	;GET THE MESSAGE TYPE
	CAXE	S2,.QIFNC		;IS THIS AN INTERNAL CALL ???
	SETZM	S1			;NO,,CLEAR [SYSTEM]GOPHER BIT
	STORE	S1,.MRFLG(AP),MR.GFR	;SET/CLEAR THE BIT

	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE REQUESTING JOB NUMBER
	TXNE	S1,BA%JOB		;IS THIS A BATCH REQUEST ???
	JRST	CMDR.3			;YES,,SKIP THIS
	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.3:	INCR	.MRCNT(AP),MR.LNK	;GEN A NEW VSL LINK CODE
	MOVEI	P2,.MMHSZ(M)		;POINT TO THE FIRST MOUNT ENTRY
	SKIPN	P4,.MMARC(M)		;GET THE VOLUME SET COUNT IN P4
	JRST	CMDR.6			;NONE,,THEN .MOUNT/WAIT...

CMDR.4:	MOVE	S1,P2			;GET THE MOUNT MSG ENTRY ADDRESS IN S1
	PUSHJ	P,BLDVSL		;GO BUILD THE VOLUME SET LIST
	JUMPF	CMDR.5			;CHK BLDVSL - NO GOOD,,DELETE THIS MDR
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	LOAD	S1,.MEHDR(P2),AR.LEN	;GET THIS ENTRIES LENGTH
	ADDI	P2,0(S1)		;POINT TO THE NEXT ENTRY
	SOJG	P4,CMDR.4		;CONTINUE THROUGH ALL VOLUME SETS
	MOVE	S1,P1			;RETURN THE LAST VSL ADDRESS
	$RETT				;RETURN

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

CMDR.5:	PUSHJ	P,DELETE		;DELETE THE VOL SETS JUST ADDED
	MOVE	S1,RID			;GET THE LAST VALID REQUEST ID
	MOVEM	S1,REQIDN##		;SAVE IT
	SKIPN	G$ERR##			;DID WE ALREADY SEE AN ERROR?
	PJRST	E$IMM##			;NO, RETURN THROUGH 'INVALID MOUNT MSG'
	$RETF				;YES, BUBBLE IT UP!

	;Here if MOUNT/WAIT<CRLF> was typed

CMDR.6:	LOAD	P1,.MRCNT(AP),MR.LNK	;GET CURRENT LINK CODE
	LOAD	P2,.MRCNT(AP),MR.CNT	;GET REQUEST COUNT
	MOVNS	P2			;NEGATE THE REQUEST COUNT
	MOVSS	P2			;GET COUNT IN LEFT HALF
	HRRI	P2,.MRVSL(AP)		;CREATE ABOJN AC
	SETZM	P3			;SET MOUNT PENDING FLAG

CMDR.7:	MOVE	S1,0(P2)		;PICK UP A VSL ADDRESS
	LOAD	S2,.VSFLG(S1),VS.ALC	;IS IT JUST ALLOCATED ???
	JUMPN	S2,CMDR.8		;YES,,TRY NEXT
	PUSHJ	P,CHKOWN		;CHECK FOR OWNERSHIP
	JUMPT	[MOVX  S2,VL.ASK	;OWNED,,CHECK TO SEE IF 'ASK' IS SET
		 TDNN  S2,0(S1)		;IS IT REALLY MOUNTED ???
		 JRST  CMDR.8		;YES,,TRY NEXT REQUEST
		 JRST  .+1  ]		;NO,,ADD'EM UP
	MOVE	P3,0(P2)		;SAVE THE VSL ADDRESS
	STORE	P1,.VSRID(P3),VS.LNK	;RESET LINK CODE
CMDR.8:	AOBJN	P2,CMDR.7		;GET NEXT REQUEST
	JUMPE	P3,E$MRP##		;NONE WAITING,,TELL THE USER
	MOVE	S1,P3			;RETURN THE LAST VSL ADDRESS
	$RETT				;LETERRIP
	SUBTTL	D$LOGOUT - DELETE A USER MDR'S ON LOGOUT

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

TOPS10 <
D$LOGO:	SKIPN	G$MDA##			;MUST BE RUNNING WITH MDA ENABLED
	$RETT				;NO,,RETURN
	$SAVE	<AP>			;SAVE AP FOR A SECOND
	PUSHJ	P,FNDMDR		;FIND THIS USERS MDR
	JUMPF	.RETT			;NO MORE,,RETURN
	PUSHJ	P,D$DMDR		;DELETE THIS MDR
	$RETT				;RETURN
>

TOPS20<
D$LOGO:	$RETT	>			;JUST RETURN ON THE -20
	SUBTTL	D$XCH - Exchange disk units

; Here when the monitor sends us an exchange message (.IPCXC). This can
; happen when an operator issues the priv'ed command XCHANGE to swap two
; disk units.
;
;CALL:	M/ The Message address
;
;RET:	True always

TOPS10<	INTERN	D$XCH			;EXCHANGE DISK UNITS

D$XCH:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	S1,.XCHU1(M)		;GET UNIT 1 NAME
	PUSHJ	P,UCBLOC		;FIND THE UCB
	  JUMPF	XCH.1			;CAN'T - EXIT
	MOVE	P1,S1			;SAVE ADDRESS
	MOVE	S1,.XCHU2(M)		;GET UNIT 2 NAME
	PUSHJ	P,UCBLOC		;FIND THE UCB
	  JUMPF	XCH.2			;CAN'T - EXIT
	MOVE	S2,.UCBNM(P1)		;GET OLD UNIT 1 NAME
	EXCH	S2,.UCBNM(S1)		;SET NEW UNIT 2 NAME, GET OLD UNIT 2
	MOVEM	S2,.UCBNM(P1)		;SET NEW UNIT 1 NAME
	MOVE	S2,.UCBAU(P1)		;GET OLD UNIT 1 ALT PORT
	EXCH	S2,.UCBAU(S1)		;SAVE OLD ALT PORT,,GET NEW ALT PORT
	MOVEM	S2,.UCBAU(P1)		;SAVE NEW ALT PORT NAME
	$WTO	(<Disk unit ^W/.XCHU1(M)/ exchanged with ^W/.XCHU2(M)/>,,,<$WTFLG(WT.SJI)>)
	$RETT				;RETURN

XCH.1:	SKIPA	S1,.XCHU1(M)		;FIRST DEVICE FAILED
XCH.2:	MOVE	S1,.XCHU2(M)		;SECOND DEVICE FAILED
	$WTO	(<MDA data base update failure>,<Cannot find UCB for ^W/S1/>,,<$WTFLG(WT.SJI)>)
	$RETT				;RETURN

> ;END TOPS10 CONDITIONAL
	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
	SKIPN	S1,.MRVSL(AP)		;CHECK AND LOAD THE FIRST VSL ADDRESS
	PJRST	DELMDR			;NONE THERE,,JUST DELETE THE MDR
	CAIN	S1,TMPVSL		;ARE WE POINTING TO THE TEMP VSL ???
	JRST	DELMDR			;YES,,JUST DELETE THE MDR AND RETURN

	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT

DMDR.1:	MOVE	S1,.MRVSL(AP)		;PICK UP THE CURRENT VSL ADDRESS
	PUSHJ	P,DELVSL		;GO DELETE IT
	SOJG	P1,DMDR.1		;CONTINUE THROUGH ALL VSL'S
	PUSHJ	P,DELMDR		;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,.CMDEV		;GET THE DEVICE BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	E$IMO##			;NOT THERE,,THATS AN ERROR
	PUSHJ	P,LOCUCB		;GO FIND THE AFFECTED UCB
	JUMPF	D$ASGN			;NO UCB,,TRY REASSIGNMENT ANYWAY !!!
	MOVE	P1,S1			;SAVE POINTER TO UCB
	LOAD	S1,.UCBST(P1),UC.AVA	;GET THE AVAILABLE STATUS BIT
	SKIPN	S1			;IS THE DEVICE AVAILABLE ???
	 $ERJMP	MD$IUD			;NO,,RETURN ERROR

	;A Small Security Check Before We Start !!!

	SKIPN	P3,.UCBVL(P1)		;CHECK AND LOAD THE VOL BLOCK ADDRESS
	 $ERJMP	MD$NVM			;RETURN NO VOLUME MOUNTED ON 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,[$ERJMP MD$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.1			;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,FNTAPE		;SEE IF ITS ALREADY IN OUT DATA BASE
	SKIPF				;NOT THERE,,CONTINUE ONWARD
	JUMPN	S2,.RETT		;IF FOUND AND MOUNTED,,JUST RETURN
	MOVE	S1,P3			;GET THE VOLUME ADDRESS IN S1
	PUSHJ	P,FNDOWN		;ANY OWNERS OF THE VOLUME ???
	SKIPF				;NO,,SKIP
	 $ERJMP	MD$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 ???
	 $ERJMP	MD$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.1:	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,FNDVSL		;GET THE REQUESTED VSL ENTRY
	JUMPF	E$MRP##			;NOT THERE,,OPERATOR ERROR !!!
	MOVE	P4,S1			;SAVE THE VSL ADDRESS

	LOAD	S1,.VSFLG(P4),VS.ABO	;WAS IT CANCELLED ???
	JUMPN	S1,E$MRP##		;YES,,EXIT NOW
	LOAD	S1,.UCBST(P1),UC.VSW	;GET THE VOLUME SWITCH BIT
	SKIPE	S1			;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
	 $ERJMP	MD$DAU			;UH OH,DEVICE IS IN USE BY SOMEONE ELSE

	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
	 $ERJMP	MD$VND,P4		;OPR PICKED WRONG DRIVE.. TELL HIM
	MOVE	S1,P2			;GET THE VOLUME ADDRESS IN S1
	PUSHJ	P,FNDOWN		;ANY OWNERS OF THE VOLUME ???
	SKIPF				;NO,,SKIP
	 $ERJMP	MD$VAU			;YES,,CAN THE REQUEST
	SKIPE	S1,.VLNAM(P3)		;DID THE OPR SPECIFY A VOLUME?
	SKIPN	S2,.VLNAM(P2)		;GET USER'S REELID
	JRST	IDN.1A			;NO REELID OR SCRATCH
	CAME	S1,S2			;IS IT WHAT THE USER SPECIFIED
	 $ERJMP	MD$RDM,P4		;NO, GIVE ERROR
IDN.1A:	MOVE	S1,P3			;GET THE VOLUME ADDRESS IN S1
	PUSHJ	P,FNDOWN		;ANY OWNERS OF THE VOLUME ???
	SKIPF				;NO,,SKIP
	 $ERJMP	MD$DAU			;YES,,CAN THE REQUEST

	LOAD	S2,.VSFLG(P4),VS.LBT	;GET THE REQUESTED LABEL TYPE
	CAXN	S2,.TFLBP		;USER WANTS BYPASS?
	JRST	IDEN.3			;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.2			;NO,,CHECK VOLIDS
	LOAD	S1,.VLFLG(P2),VL.SCR	;YES,,GET THE VOLUME'S SCRATCH BIT
	JUMPE	S1,[$ERJMP MD$VIL,P4]	;CAN'T HAVE LABELS & NOT BE SCRATCH

IDEN.2:	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 !!
	 $ERJMP	MD$NVI,P4		;BOTH NULL,,CAN'T DO THIS !!!

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

IDEN.3:	DMOVE	S1,P3			;GET THE VOL AND VSL ADDRESSES
	PUSHJ	P,CVLVSL		;CHECK THE REQUESTED CHARACTERISTICS
	JUMPF	.RETF			;NO GOOD,,JUST RETURN

	;Found a matching volume - there may be a VOL block off the VSL from
	;the requesting MDR, and another from the UCB for the mounted volume.
	;If so, we will have to merge them together, and throw one away.

	CAIN	P2,0(P3)		;ARE OLD AND NEW VOL'S THE SAME ???
	JRST	IDEN.4			;YES,,DONT DELETE ANY - JUST CONTINUE
	MOVE	T1,.VLFLG(P2)		;SAVE THE OLD FLAG BITS (JUST IN CASE)
	LOAD	S1,.VLFLG(P3),VL.FLG	;GET ALL THE FLAGS FOR THIS UNIT'S VOL
	STORE	S1,.VLFLG(P2),VL.FLG	;SAVE IN REAL VOL BLOCK
	MOVE	S1,.VLNAM(P3)		;GET VOL NAME FOR THIS UNITS VOL BLK
	SKIPE	.VLNAM(P2)		;IS THERE A NAME IN THE USERS VOL BLOCK
	JRST	IDN.3A			;YES,,NO NEED TO ALLOCATE THE NEW ONE !!

	;Update the VOL volid and allocate it

	MOVEM	S1,.VLNAM(P2)		;NO,,SAVE UNITS VOLID AS USERS VOLID
	MOVE	S1,P4			;GET THE VSL ADDRESS
	PUSHJ	P,CKTVOL		;VALIDATE THIS VOLID FOR THIS USER
	JUMPF	[SETZM .VLNAM(P2)	;NO GOOD,,BACK TO SCRATCH
	 	 MOVEM T1,.VLFLG(P2)	;RESTORE THE OLD FLAG BITS
		 $RETF ]		;AND RETURN
	PUSHJ	P,D$BMTX		;LOCATE THIS GUYS 'B' MATRIX ENTRY
	MOVE	S1,P2			;GET THE VOL ADDRESS
	PUSHJ	P,D$TVRS		;CONVERT TO A RESOURCE NUMBER
	MOVE	S2,P4			;GET THE VSL ADDRESS
	PUSHJ	P,ADDBMA		;UPDATE THE USERS 'B' MATRIX

IDN.3A:	MOVX	S1,VL.SCR		;GET THE SCRATCH VOLUME BIT
	ANDCAM	S1,.VLFLG(P2)		;  AND CLEAR IT 
	MOVE	S1,P3			;GET THE VOL BLK WE WANT TO DELETE
	PUSHJ	P,DELVOL		;GO DELETE IT
	MOVEM	P2,.UCBVL(P1)		;LINK THE USERS VOL TO THE UCB
	MOVEM	P1,.VLUCB(P2)		;LINK THE UCB TO THE USERS VOL

IDEN.4:	LOAD	S1,.VSFLG(P4),VS.LBT	;GET THE VOLUME SET LABEL TYPE
	STORE	S1,.VLFLG(P2),VL.LBT	;SAVE AS THE VOLUME LABEL TYPE

	;Check to make sure there is no deadlock

	MOVE	S1,P4			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,D$ALCT		;ALLOCATE/DEADLOCK CHECK THE VSL
	JUMPF	.RETF			;NO GOOD,,OH WELL WE TRIED !!!!!

	;So far so good, go off and reassign the tape

	MOVE	S1,P1			;AIM AT THIS UCB
	MOVE	S2,P4			;AND THIS VSL
	PUSHJ	P,REASSIGN		;TRY TO REASSIGN THE DEVICE
	JUMPF	.RETT			;CAN'T,,RETURN
	MOVE	S1,P4			;OK,,GET THE VSL ADDRESS BACK
	PUSHJ	P,MNTVSL		;TRY TO MOUNT OTHER VOLS
	$RETT				;AND RETURN
>;END TOPS10
	SUBTTL	REASSIGN - Try to give a unit to a user

	;CALL:	S1/ The UCB Address
	;	S2/ The VSL 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
	$SAVE	<T1,T2>			;SAVE T1 AND T2 ALSO
	DMOVE	P1,S1			;GET THE UCB IN P1, VSL IN P2
	MOVE	S1,.UCBNM(P1)		;GET THE DEIVCE NAME IN S1
	MOVEM	S1,MDAOBJ+OBJ.UN	;SAVE AS THE CURRENT UNIT
	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
	MOVX	T1,%STAMN		;GET 'VOLUME MOUNTED' STATUS CODE
	STORE	T1,.VLFLG(P3),VL.STA	;SET IT IN THE VOLUME FLAG WORD
	MOVE	P4,.VSUCB(P2)		;GET THE OLD UNIT ADDRESS
	MOVE	S1,P2			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,SETOWN		;UPDATE VOLUME OWNERSHIP
	LOAD	S2,.VSFLG(P2),VS.VSW	;IS THIS GUY IN VOLUME SWITCH MODE ???
	JUMPN	S2,REAS.S		;YES, THEN SWITCH UNITS
	MOVX	S1,VL.SRD		;GET SET REQUESTED DENSITY FOR USER BIT
	TDNN	S1,.VLFLG(P3)		;NEED TO DO IT?
	JRST	REAS.0			;NOPE
	MOVE	S1,.UCBNM(P1)		;GET DEVICE NAME
	LOAD	S2,.VSATR(P2),VS.DEN	;GET THE REQUESTED DENSITY
	PUSHJ	P,I$SDEN##		;SET IT
	JUMPT	REAS.0			;ONWARD
	MOVEI	S1,[ITEXT (<Can't set density to ^T/@DENSTY(S2)/ on unit ^W/.UCBNM(P1)/>)]
	LOAD	S2,.VLFLG(P3),VL.DEN	;GET THE REQUESTED DENSITY AGAIN
	JRST	REAS.E			;PROCESS ERROR

REAS.0:	LOAD	S2,.MRJOB(AP),MD.PJB	;GET THE USERS JOB NUMBER
	TXNE	S2,BA%JOB		;FOR A PSEUDO PROCESS ???
	JRST	REAS.3			;YES,,SKIP THE REST OF THIS !!
	$COUNT	(TAPM)			;COUNT TAPE MOUNTS (NOT VOL SWITCHES)

REAS.1:	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,,RETURN NO GOOD
	MOVEM	T2,MDAOBJ+OBJ.UN	;SAVE THE DEVICE NAME FOR LATER
	MOVEM	P1,.VSUCB(P2)		;LINK THE UCB TO THIS USER
	MOVEM	P2,.UCBVS(P1)		;LINK THIS USER TO THIS DEVICE
	MOVX	S1,VS.DDN+VS.DTK	;GET DEFAULT DENSITY+TRACK STATUS BITS
	ANDCAM	S1,.VSATR(P2)		;CLEAR THEM - NO MORE DEFAULTING !!!!!
	MOVE	S1,P2			;GET THE VSL ADDRESS
	PUSHJ	P,I$TMNT##		;PERFORM TAPE ACCOUNTING
	MOVE	S1,P2			;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)
	$RETT				;AND RETURN

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

REAS.2:	SKIPE	.VSLNM(P2)		;ANY LOGICAL NAME ???
	JRST	[SETZM .VSLNM(P2)	;YES,,ZAP IT
		 JRST  REAS.1 ]		;AND RETRY THE REASSIGN
	MOVE	S1,P2			;NO,,GET THE VSL ADDRESS
	PUSHJ	P,CLROWN		;CLEAR THE OWNERSHIP STATUS
	MOVX	S1,%STAWT		;GET WAITING STATUS
	STORE	S1,.VLFLG(P3),VL.STA	;SET IT
	MOVEI	S1,[ITEXT (<REASSI UUO failed on volume ^W/.VLNAM(P3)/>)]

REAS.E:	$WTO	(<Reassignment failure>,<^I/(S1)/ for ^I/DEMO/>,MDAOBJ)
	$TEXT	(<-1,,G$MSG>,<^I/(S1)/, request deleted^M^J^0>)
	SETOM	ERRACK			;THIS IS AN ERROR
	PUSHJ	P,USRNOT		;TELL THE USER
	MOVE	S1,P2			;NO GOOD,,GET THE VSL ADDRESS
	PUSHJ	P,ALCVSL		;RETURN THIS VSL TO THE ALLOCATION POOL
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE USERS REQUEST COUNT
	SKIPN	S1			;STILL MORE REQUESTS,,SKIP
	PUSHJ	P,DELMDR		;NOTHING LEFT,,DELETE THE MDR
	$RETF				;AND RETURN 'REASSIGN FAILED'

REAS.3:	DOSCHD				;FORCE A SCHEDULING PASS
	MOVX	S1,VS.NMT		;GET THE 'NOT REALLY MOUNTED' FLAG BIT
	IORM	S1,.VSFLG(P2)		;SET IT FOR THIS PSEUDO PROCESS
	MOVE	S1,.MRQEA(AP)		;GET THE QE ADDRESS
	MOVX	S2,QE.WAM		;GET 'WAITING FOR MOUNT' STATUS
	ANDCAM	S2,.QESEQ(S1)		;AND CLEAR IT
	MOVEM	P1,.VSUCB(P2)		;LINK THE UCB TO THIS USER
	MOVEM	P2,.UCBVS(P1)		;LINK THIS USER TO THIS DEVICE
	MOVE	S1,.QERID(S1)		;GET ITS REQUEST ID
	$WTO	(<Volume ^W/.VLNAM(P3)/ reassigned>,<User: ^W6/.MRNAM(AP)/^W/.MRNAM+1(AP)/ ^U/.MRUSR(AP)/ batch req# ^D/S1/>,MDAOBJ)
	$RETT				;RETURN
	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:	$COUNT	(VSWM)			;count volume switches
	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	G$MSG+.OARGC		;ONE MORE BLOCK
	MOVEI	S2,G$MSG+.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,G$MSG+.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	G$MSG+.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,G$MSG+.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

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

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

	;Here to make sure the density is set correctly
	LOAD	S1,.VLFLG(P3),VL.DEN	;Get the density for this volume
	LOAD	S2,.VSATR(P2),VS.DEN	;Get the density code for this vol set
	CAMN	S1,S2			;Are they the same??
	 JRST	REA.S0			;Yes, no need to set it then
	STORE 	S2,.VLFLG(P3),VL.DEN	;Store it away for next time
	LOAD	S1,.UCBNM(P1)		;Get the name of the drive
	PUSHJ	P,I$SDEN##		;Set it
	;Tell everyone about it
REA.S0:	PUSHJ	P,C$SEND##		;TELL THE LABELLER
	MOVE	S1,P2			;GET THE VSL ADDRESS
	PUSHJ	P,I$TMNT##		;PERFORM TAPE ACCOUNTING
	$WTO	(<Volume ^W/.VLNAM(P3)/ reassigned>,<^I/DEMO/>,MDAOBJ) ;TELL OPR
	$TEXT	(<-1,,G$MSG>,<Logical name ^W/.VSLNM(P2)/ switched to volume ^W/.VLNAM(P3)/ on ^W/.UCBNM(P1)/^M^J^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
	$RETF				;RETURN FALSE IN ANY CASE
>
TOPS20<	$RETT	>			;REASSIGN FAILS ON THE -20
	SUBTTL	D$ASGN - ROUTINE TO ASSIGN FOREIGN DEVICES UNDER MDA

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

TOPS10<
D$ASGN:	PUSHJ	P,.SAVE3		;SAVE P1 AND P2 AND P3
	MOVX	S1,.CMDEV		;GET THE DEVICE BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND THE DEVICE BLOCK
	HRROI	S1,0(S1)		;POINT TO THE ASCIZ DEVICE NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	DEVNAM	S2,			;IS IT VALID ???
	 JRST	[MOVEI S1,[ASCIZ/Unknown device specified/] ;NO,,GET ERROR TEXT
		 JRST  ASGN.3 ]		;AND EXIT
	MOVEM	S2,MDAOBJ+OBJ.UN	;SAVE THE DEVICE NAME
	MOVE	S1,S2			;S1:= DEVICE NAME
	PUSHJ	P,I$CKAV##		;IS IT FREE ?
	  JUMPT	[MOVEI S1,[ASCIZ/Device not available/] ;NO
		 JRST  ASGN.3 ]		;EXIT
	MOVE	S2,MDAOBJ+OBJ.UN	;GET THE DEVICE
	DEVTYP	S2,			;GET ITS CHARACTERISTICS
	  JRST	[MOVEI S1,[ASCIZ/Unknown device specified/] ;CAN'T
		 JRST  ASGN.3 ]		;EXIT
	LOAD	P1,S2,TY.DEV		;SAVE THE DEVICE TYPE
	MOVX	S1,.ORREQ		;GET THE REQUEST ID BLOCK TYPE
	PUSHJ	P,A$FNDB##		;GET THE REQUEST TO ASSIGN TO
	JUMPF	[MOVEI S1,[ASCIZ/Request ID must be specified/] ;NOT THERE
		 JRST  ASGN.3 ]		;GET ERROR TEXT AND EXIT
	MOVE	S1,0(S1)		;GET THE REQUEST ID
	PUSHJ	P,FNDVSL		;FIND THE USER
	JUMPF	[MOVEI S1,[ASCIZ/Invalid request ID specified/] ;NOT THERE
		 JRST  ASGN.3 ]		;GET ERROR TEXT AND EXIT
	MOVE	P2,S1			;SAVE THE VSL ADDRESS
	LOAD	S1,.VSFLG(P2),VS.TYP	;GET THE REQUEST TYPE
	CAXE	S1,%UNKN		;S IS 'UNKNOWN' ?
	CAXN	S1,%DTAP		;OR A DECTAPE ?
	SKIPA				;YES TO EITHER
	JRST	[MOVEI S1,[ASCIZ/User requested disk or tape volumes/] ;NO,,
		 JRST  ASGN.3 ]		;GET ERROR TEXT AND EXIT
	HRROI	S1,.VSVSN(P2)		;GEN POINTER TO VOL SET NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	DEVTYP	S2,			;GET THE REQUESTED DEVICE TYPE
	 SKIPA	S2,P1			;ON ERROR FORCE A MATCH !!!
	LOAD	S2,S2,TY.DEV		;GET THE DEVICE TYPE
	CAME	S2,P1			;DOES REQUESTED MATCH IDENTIFIED ???
	 JRST	[MOVEI S1,[ASCIZ/Specified device does not match requested device/]
		 JRST  ASGN.3 ]		;NO,,GET ERROR TEXT AND EXIT
	MOVE	S1,MDAOBJ+OBJ.UN	;GET THE DEVICE NAME
	PUSHJ	P,I$MDAS##		;SET THE MDA BIT (DVCMDA)
ASGN.1:	MOVE	S1,MDAOBJ+OBJ.UN	;GET THE DEVICE NAME
	MOVE	S2,.VSLNM(P2)		;GET THE LOGICAL NAME
	DEVLNM	S1,			;ASSIGN A LOGICAL NAME TO THE DEVICE
	JFCL				;IGNORE THE ERROR

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

	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE USERS JOB NUMBER
	MOVE	S2,MDAOBJ+OBJ.UN	;GET THE DEVICE NAME
	REASSI	S1,			;ASSIGN IT TO THE USER
	JUMPLE	S1,ASGN.2		;IF IT FAILED,,PROCESS THE ERROR
	$COUNT	(GENM)			;count generic mounts
	$ACK	(<Reassigned>,<^I/DEMO/>,MDAOBJ,.MSCOD(M)) ;TELL THE OPR
	MOVE	S1,P2			;GET THE VSL ADDRESS
	PUSHJ	P,SETOWN		;SET SOME OWNERSHIP BITS
	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%LAST		;POSITION TO THE LAST ENTRY
	MOVX	S2,UCBLEN		;GET THE UCB LENGTH
	PUSHJ	P,L%CENT		;CREATE A UCB FOR THIS DEVICE
	MOVEM	S2,.VSUCB(P2)		;LINK THE UCB TO THE VSL
	MOVEM	P2,.UCBVS(S2)		;LINK THE VSL TO THE UCB
	MOVE	S1,MDAOBJ+OBJ.UN	;GET THE DEVICE NAME
	MOVEM	S1,.UCBNM(S2)		;SAVE IT
	PUSHJ	P,ASGN.A		;ACK THE USER AND GET NEXT VSL
	MOVE	P1,S1			;SAVE THE NEXT MOUNT VSL ADDRESS
	MOVE	S1,P2			;GET THE VSL ADDRESS IN S1
	LOAD	TF,.VSFLG(P2),VS.TYP	;GET THE REQUEST TYPE
	CAXN	TF,%DTAP		;A DECTAPE ?
	PUSHJ	P,I$DMNT##		;YES - MAKE ACCOUNTING ENTRY
	MOVX	S2,VS.WAL		;GET THE WAITING FOR ALLOCATION STATUS
	IORM	S2,.VSFLG(P2)		;LITE IT (WE NEVER WERE ALLOCATED)
	SKIPE	S1,P1			;ANY MORE REQUESTS ???
	PUSHJ	P,MNTVSL		;YES,,TRY TO MOUNT THEM
	$RETT				;RETURN

	;Here if the reassignment fails

ASGN.2:	SKIPE	.VSLNM(P2)		;ANY LOGICAL NAME ???
	JRST	[SETZM .VSLNM(P2)	;YES,,ZAP IT
		 JRST  ASGN.1 ]		;AND RETRY THE REASSIGNMENT
	$ACK	(<Reassignment failure>,<Can't reassign device to ^I/DEMO/>,MDAOBJ,.MSCOD(M))
	MOVEI	S1,[ITEXT (<Reassignment failed - request deleted>)]
	SETOM	ERRACK			;LITE ERROR ACK FLAG
	PUSHJ	P,ASGN.A		;ACK THE USER AND GET NEXT VSL
	MOVE	P1,S1			;SAVE THE NEXT VSL ADDRESS
	MOVE	S1,P2			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,DELVSL		;DELETE THIS REQUEST
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET HIS REQUEST COUNT
	JUMPE	S1,DELMDR		;IF NO MORE REQUESTS,,DELETE THE MDR
	SKIPE	S1,P1			;ANY MORE REQUESTS ???
	PUSHJ 	P,MNTVSL		;YES,,TRY TO MOUNT THEM
	$RETT				;RETURN

ASGN.3:	$ACK (<Can't identyfy this device>,<^T/0(S1)/>,MDAOBJ,.MSCOD(M))
	$RETT				;RETURN

	;Here to ACK the user and find the next mount request

ASGN.A:	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE USERS REQUEST COUNT
	MOVNS	P1			;NEGATE IT
	MOVSS	P1			;MOVE RIGHT TO LEFT
	HRRI	P1,.MRVSL(AP)		;CREATE VSL AOBJN SEARCH AC
	LOAD	S2,.VSRID(P2),VS.LNK	;GET THIS REQUESTS LINK CODE

ASGN.B:	MOVE	P3,0(P1)		;GET A VSL ADDRESS
	LOAD	S1,.VSRID(P3),VS.LNK	;GET ITS LINK CODE
	CAME	P3,P2			;IS THIS THE CURRENT VSL ???
	CAME	S1,S2			;NO,,DO LINK CODES MATCH ???
	AOBJN	P1,ASGN.B		;CURRENT VSL OR NO MATCH,,TRY NEXT
	MOVE	S1,P2			;GET THE VSL ADDRESS
	PUSHJ	P,ACKUSR		;ACK THE USER
	SKIPL	P1			;DID WE FIND A MATCH ???
	SETZM	P3			;NO,,CLEAR THE LAST VSL ADDRESS
	MOVE	S1,P3			;RETURN NEXT VSL ADDRESS
	$RETT				;RETURN

> ;END TOPS10 CONDITIONAL
	SUBTTL	D$ENABLE/D$DISABLE DRIVE AVR STATUS

	;CALL:	M/ The Enable/Disable Message Address
	;
	;The following cases for enable/disable can occur:
	;	.TAPDV	A particular tape/disk drive - change AVR
	;	.ALTAP	All tape drives - change AVR
	;	.ALDSK	All disk drives - change AVR
	;	.ALSTR	Change automatic structure recognition
	;		(defaults if all others fail)
	;
	;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

	MOVX	S1,.TAPDV		;GET DRIVE BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN OUR MESSAGE
	JUMPT	ABLE.0			;Found specific unit, go process it

	MOVX	S1,.ALTAP		;GET ALL TAPE DRIVE MSG BLOCK
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPT	ABLE.1			;FOUND IT,,GO SET ALL TAPE DRIVES

	MOVX	S1,.ALDSK		;Get all disk drive msg block
	PUSHJ	P,A$FNDB##		;Find it in the message
	JUMPT	ABLE.2			;Go process it

	;Fall through assuming .ALSTR

	;Here to Enable/Disable Automatic Structure Recognition

	SKIPN	P1			;IS THIS AN ENABLE FUNCTION ???
	SETOM	D$ASR			;YES,,LITE THE ASR FLAG
	SKIPE	P1			;IS THIS A DISABLE FUNCTION ???
	SETZM	D$ASR			;YES,,CLEAR THE ASR FLAG
	$ACK	(<Structure recognition is ^T/@DISENA+1(P1)/>,,,.MSCOD(M))
	$RETT				;RETURN

	;Here to Enable/Disable Automatic Volume Recognition for a unit

ABLE.0:	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
	$ACK	(<Volume recognition is ^T/@DISENA+1(P1)/>,,MDAOBJ,.MSCOD(M))
	$RETT				;ACK THE OPERATOR AND RETURN

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

	;Here to Enable/Disable Automatic Volume Recognition for all units

ABLE.1:	TDZA	P2,P2			;Indicate all tapes
ABLE.2:	SETOM	P2			;Indicate all disks
	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
ABLE.3:	LOAD	S1,.UCBST(S2),UC.AVA	;IS THIS DRIVE 'KNOWN' TO MDA?
	JUMPE	S1,ABLE.5		;NOPE, LEAVE ITS BITS ALONE
	LOAD	S1,.UCBST(S2),UC.DVT	;Get the device type
	CAIN	S1,%TAPE		;Is it a tape?
	JUMPE	P2,ABLE.4		;Yes, do we want tapes?
	CAIN	S1,%DISK		;No, is it a disk?
	JUMPL	P2,ABLE.4		;Yes, do we want disks?
	JRST	ABLE.5			;No, don't like this one
ABLE.4:	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.5:	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB ENTRY
	JUMPT	ABLE.3			;FOUND ONE,,GO PROCESS IT

	MOVEI	S1,[ASCIZ/tape drives/]	;DEFAULT TO TAPE DRIVES
	SKIPE	P2			;UNLESS IT WAS DISK DRIVES
	MOVEI	S1,[ASCIZ/disk drives/]	;   THEN MAKE IT DISKS
	$ACK	(<Volume recognition is ^T/@DISENA+1(P1)/ for all ^T/0(S1)/>,,,.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	S1,S2			;GET THE DEVICE CHECKED AGAINST
	PJRST	SNDREC			;   AND SEND THE RECOGNIZE MESSAGE TO
					;   THE TAPE LABELER
>
	SUBTTL	D$AVR - TAPE/DISK ONLINE PROCESSOR

	;CALL:	M/ The TAPE/DISK Online Message Address
	;
	;RET:	True Always


	;This routine fields Tape/Disk Online IPCF Messages from the
	;monitor and possibly kicks the Tape Label Processor to read the
	;labels from the volume mounted on the unit and send the Info 
	;back to QUASAR


TOPS10 <
D$AVR:	LOAD	S1,.TONST(M),TON.TY	;GET DEVICE TYPE FROM MESSAGE
	CAXE	S1,.TYDSK		;IS IT A DISK ONLINE MESSAGE ???
	CAXN	S1,.TYMTA		;OR IS IT A MAGTAPE?
	SKIPA				;YES,,GO PROCESS IT
	$RETT				;ELSE IGNORE IT

	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	S1,.TONDV(M)		;GET DEVICE NAME
	PUSHJ	P,UCBLOC		;FIND OUR UCB BLOCK ON THIS GUY
	JUMPF	.RETT			;STRANGE, MONITOR IS FUNNY
	LOAD	S2,.UCBST(S1),UC.AVA	;IS IT AVAILABLE ???
	JUMPE	S2,.RETT		;NO,,RETURN NOW
	MOVE	S2,S1			;SAVE UCB ADR
	MOVX	S1,UC.AVR		;GET AVR ENABLED BIT
	SKIPN	.UCBVS(S2)		;IS THE DRIVE OWNED ???
	TDNE	S1,.UCBST(S2)		;IS THIS DRIVE ENABLED?
	SKIPA				;AVR OR DRIVE OWNED,,LETERRIP
	JRST	AVR.2			;NO,,GO FINISH UP
	LOAD	S1,.UCBST(S2),UC.DVT	;GET THE UNIT TYPE
	CAXN	S1,%DISK		;IS IT A DISK UNIT ???
	JRST	AVR.1			;YES,,JUST READ THE LABELS

	SKIPN	P1,.UCBVL(S2)		;GET ATTACHED VOLUME BLOCK, IF ANY
	JRST	AVR.1			;NO VOLUME, GO READ THE LABELS
	MOVE	S1,P1			;GET THE VOLUME ADDRESS IN S1
	PUSHJ	P,FNDOWN		;ANY OWNERS OF THE VOLUME ???
	JUMPF	AVR.1			;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

AVR.1:	MOVE	S1,.TONDV(M)		;GET DEVICE NAME SUPPLIED IN MESSAGE
	PJRST	SNDREC			;AND ASK PULSAR FOR SERVICE

AVR.2:	LOAD	S1,.TONST(M),TON.TY	;GET DEVICE TYPE FROM MESSAGE
	CAXE	S1,.TYDSK		;IS IT A DISK ONLINE MESSAGE ???
	$RETT				;NO,,RETURN
	LOAD	S1,.TONDV(M)		;GET DEVICE NAME
	MOVE	S2,[.DUCLM,,S1]		;GET DISK. PARM LIST
	DISK.	S2,			;CLEAR DEVICE UNISTS WORD
	JFCL				;IGNORE THE ERROR
	$RETT				;RETURN
>
	SUBTTL	D$DEVSTA - PROCESS TAPE/DISK STATUS MESSAGES

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

TOPS10 <
D$DEVS:	MOVX	S1,.STSTS		;GET THE STATUS BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	MISC.3			;NOT THERE,,THATS AN ERROR
	MOVE	T1,S1			;SAVE THE STATUS BLOCK ADDRESS
	MOVE	S1,.STUNT(T1)		;GET THE UNIT NAME
	PUSHJ	P,UCBFND		;FIND IT IN OUR DATA BASE
	JUMPF	MISC.3			;NOT THERE,,THATS AN ERROR
	MOVE	T2,S1			;SAVE THE UCB ADDRESS
	MOVSI	S1,.DUCLM		;'CLEAR MDA WAIT' FUNCTION
	HRRI	S1,.UCBNM(T2)		;MUST POINT TO PRIMARY PORT NAME
	DISK.	S1,			; EVEN IF .STUNT HAS ALTERNATE PORT
	  JFCL				;IGNORE ERRORS
	LOAD	S1,.STFLG(T1),ST.OFL	;GET THE UNIT OFFLINE BIT
	STORE	S1,.UCBST(T2),UC.OFL	;AND SAVE IT
	JUMPN	S1,DEVS.1		;IF OFFLINE,,GO PROCESS IT
	MOVX	S1,UC.INI		;GET THE 'DRIVE INITIALIZING' BIT
	TDNE	S1,.UCBST(T2)		;IS THIS DRIVE WRITING LABELS?
	$RETT				;YES, IGNORE THE STATUS MESSAGE
	MOVX	S1,.TLSTA		;GET THE TAPE DEVICE STATUS BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPT	[MOVE  T3,S1		;GET THE TAPE STATUS BLK ADDRESS IN T3
		 PJRST TAPDEV ]		;AND GO PROCESS IT
	MOVX	S1,.DSSTA		;GET STRUCTURE DEVICE STATUS BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPT	[MOVE  T3,S1		;GET THE DISK STATUS BLK ADDRESS IN T3
		 PJRST DSKDEV ]		;AND GO PROCESS IT
	PJRST	MISC.3			;NOT THERE,,INVALID STATUS MESSAGE

	;Here if unit is offline

DEVS.1:	$WTO	(<Offline>,,MDAOBJ)	;TELL OPR
	LOAD	S1,.UCBST(T2),UC.DVT	;GET THE UNIT DEVICE TYPE
	CAXN	S1,%DISK		;IS IT A STRUCTURE ???
	SKIPN	S1,.UCBVL(T2)		;YES,,IS THERE A VOLUME MOUNTED ???
	$RETT				;NO TO EITHER,,JUST RETURN
	PUSHJ	P,DELVOL		;YES,,DELETE THE VOLUME
	$RETT				;AND RETURN
>
	SUBTTL	TAPDEV - TAPE STATUS MESSAGE PROCESSOR

	;CALL:	T1/ The .STSTS block address
	;	T2/ The UCB address
	;	T3/ The .TLSTA block address
	;
	;RET:	Usually True

TOPS10 <
TAPDEV:	PUSHJ	P,.SAVE4		;SAVE P1-P4
	MOVE	P1,T3			;SAVE THE MESSAGE DATA ADDRESS

TAPD.1:	MOVE	P2,T2			;SAVE THE UCB ADDRESS IN P2
	SKIPN	P3,.UCBVL(P2)		;CHECK AND LOAD THE VOL ADDRESS
	JRST	TAPD.2			;NO VOLUME YET !!!

	MOVE	S1,P3			;GET THE VOLUME ADDRESS IN S1
	PUSHJ	P,FNDOWN		;ANY OWNERS OF THE VOLUME ???
	JUMPT	[TXO   P3,<1B0>		;YES,,INDICATE PREVIOUS VOL WAS OWNED
		 JRST  TAPD.2 ]		;    AND THEN GO CHECK LABEL TYPES
					;NO -
	SETZM	.VLUCB(P3)		;DELINK THE VOLUME FROM THE UCB
	SETZM	.UCBVL(P2)		;DELINK THE UCB FROM THE VOLUME
	MOVX	S1,%STAWT		;GET VOLUME WAITING STATUS
	STORE	S1,.VLFLG(P3),VL.STA	;   AND SET IT
	MOVE	S1,P3			;AIM AT THE VOL BLK
	PUSHJ	P,DELVOL		;DELETE IT
	SETZM	P3			;INDICATE NO VOLUME FOUND !!!

TAPD.2:	LOAD	S1,.STFLG(T1),TS.LAB	;GET THE MOUNTED VOL LABEL TYPE
	PUSHJ	P,GETLBT		;RECODE IT TO SOMETHING USEFULL
	JUMPGE	P3,[CAXE S1,%LABEL	;PREVIOUS VOL NOT OWNED AND CURRENT
		    JRST TAPD.8		;   VOL UNLABELED,,GEN A NEW VOL BLK
		    JRST TAPD.4  ]	;   VOL LABELED,,FIND IN VOL DATA BASE
	MOVE	P4,S1			;SAVE THE MOUNTED VOL LABEL TYPE
	LOAD	S1,.VLFLG(P3),VL.LBT	;GET THE PREVIOUS VOL LABEL TYPE
	PUSHJ	P,GETLBT		;RECODE IT TO SOMETHING USEFULL
	CAMN	S1,P4			;PREVIOUS VOL OWNED,,CHECK LABEL TYPES
	JRST	[CAXE  S1,%LABEL	;LABELS MATCH,,IS IT A LABELED VOL ???
		 JRST  TAPD.A		;PREV VOL OWNED AND UNLABELED,,UPDATE
		 JRST  TAPD.3 ]		;PREV VOL OWNED AND LABELED,,CHK VOL Q
	LOAD	S1,.VLFLG(P3),VL.LBT	;GET THE PREV VOL LABEL TYPE
	$WTO	(<Unloading>,<User requested ^T/@0(S1)/ labels>,MDAOBJ)
	MOVE	S1,.UCBNM(P2)		;GET THE UNIT NAME
	PUSHJ	P,UNLOAD		;UNLOAD THE UNIT
	$RETT				;AND RETURN

	;CONTINUED ON THE NEXT PAGE
	;Here for a Labeled Volume Mount

TAPD.3:	MOVE	S1,.VLNAM(P3)		;GET THE VOLUME ID
	CAMN	S1,.TLVOL(P1)		;DO THEY MATCH ???
	JRST	TAPD.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

TAPD.4:	SKIPN	S1,.TLVOL(P1)		;GET THE VOLUME NAME
	JRST	TAPD.5			;NULL,,THATS AN ERROR !!!
	PUSHJ	P,FNTAPE		;FIND IT IN OUR DATA BASE
	JUMPF	TAPD.8			;NOT THERE,,CREATE A NEW VOL BLOCK
	MOVE	P3,S1			;SAVE THE VOL BLOCK ADDRESS
	JUMPE	S2,TAPD.9		;NOT MOUNTED,,LINK THIS VOL TO THE UCB
	SKIPA				;SKIP OVER WTO
TAPD.5:	$WTO	(<No volume-ID found in this tapes labels>,,MDAOBJ) ;TELL OPR 
	MOVE	S1,.UCBNM(P2)		;GET THE DEVICE THE VOL IS MOUNTED ON
	PUSHJ	P,UNLOAD		;UNLOAD THE DEVICE
	$RETT				;RETURN

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

TAPD.8:	PUSHJ	P,CREVOL		;CREATE A VOL QUEUE ENTRY
	MOVE	P3,S1			;SAVE THE ENTRY ADDRESS
	MOVE	S1,.TLVOL(P1)		;PICK UP THE VOLUME NAME
	MOVEM	S1,.VLNAM(P3)		;SAVE IT IN THE VOL ENTRY
	SKIPN	S1			;IS THIS REALLY A VOL BLK?
	JRST	TAPD.9			;NO NAME... NO RESOURCE NUMBER
	MOVE	S1,P1			;AIM AT THIS NEW VOL BLK
	PUSHJ	P,D$TVRS		;GO GENERATE A RESOURCE NUMBER

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

TAPD.9:	HRRZM	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.

TAPD.A:	LOAD	S1,.STFLG(T1),ST.LOK	;GET THE WRITE LOCK STATUS
	STORE	S1,.UCBST(P2),UC.WLK	;SAVE THE WRITE LOCK STATUS
	LOAD	S1,.STFLG(T1),TS.DEN	;GET THE TAPE DENSITY
	CAXLE	S1,DENLEN		;VALIDATE THE RETURNED CODE
	PUSHJ	P,S..ITD		;DEEP TROUBLE !!!
	MOVE	S2,D$DEN(S1)		;CONVERT THE CODE TO A BIT MAP

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

	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
	MOVE	P4,S1			;SAVE HERE ALSO FOR WTO
	LOAD	S1,.STFLG(T1),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	TAPD.B			;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

TAPD.B:	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
>
	SUBTTL	DSKDEV - DISK STRUCTURE DEVICE STATUS MESSAGE PROCESSOR

	;CALL:	T1/ The .STSTS block address
	;	T2/ The UCB address
	;	T3/ The .DSSTA block address
	;
	;RET:	Usually True

TOPS10 <
DSKDEV:	PUSHJ	P,.SAVE1		;SAVE P1
	SKIPN	P1,.UCBVL(T2)		;CHECK AND LOAD ANY MOUNTED VOL ADDRESS
	JRST	DSKD.1			;NONE THERE,,SKIP THIS
	MOVE	S1,.VLSTR(P1)		;GET THE MOUNTED STRUCTURE NAME
	LOAD	S2,.VLFLG(P1),VL.LUN	;AND GET ITS LOGICAL UNIT NUMBER
	CAMN	S1,.DSSNM(T3)		;DOES STRUCTURE NAME MATCH
	CAME	S2,.DSLUN(T3)		;   AND ALSO LOGICAL UNIT NUMBER ???
	SKIPA				;NO,,CONTINUE ON
	JRST	DSKD.8			;YES,,JUST UPDATE THE VOLUME STATUS
	MOVE	S1,P1			;GET THE VOL ADDRESS IN S1

DSKD.A:	MOVE	S2,S1			;SAVE THE VOL ADDRESS IN S2
	LOAD	S1,.VLPTR(S2),VL.PRV	;FIND THE PRIMARY VOL BLOCK
	JUMPN	S1,DSKD.A		;NOT 0,,CONTINUE BACK CHAINING !!!
	LOAD	S1,.VLFLG(S2),VL.STA	;GET THE STRUCTURE STATUS
	CAXN	S1,%STAMN		;IS THE STRUCTURE MOUNTED ???
	JRST	DSK.10			;YES,,WE HAVE AN ERROR !!!

DSKD.0:	SETZM	.VLUCB(P1)		;NOT MOUNTED,,ZAP THE VOL/UCB POINTER
	SETZM	.UCBVL(T2)		;ALSO ZAP THE UCB/VOL POINTER
	MOVE	S1,P1			;GET THE VOL ADDRESS IN S1
	PUSHJ	P,DELVOL		;AND TRY TO DELETE THE VOL BLOCK(S)

DSKD.1:	SKIPN	S1,.DSHID(T3)		;GET THE VOLUME BLOCK ID
	JRST	DSK.11			;NONE THERE,,UH OHHHHH !!!!
	PUSHJ	P,FNDDSK		;FIND IT IN THE VOL QUEUE
	JUMPF	[MOVE  S1,.DSSNM(T3)	;NOT THERE,,GET THE STRUCTURE NAME
		 PUSHJ P,FNDISK		;TRY TO FIND THE PRI VOL BLOCK
		 JUMPF DSKD.4		;NOT THERE,,CREATE A NEW VOL BLOCK
		 MOVE  P1,S1		;FOUND,,SAVE THE VOL ADDRESS
		 SKIPE .VLVID(P1)	;IS A VOLID PRESENT ???
		 JRST  DSKD.4		;YES,,CREATE A NEW VOL BLOCK
		 JRST  DSKD.5 ]		;NO,,USE THIS VOL BLOCK
	MOVE	P1,S1			;SAVE THE VOL BLOCK ADDRESS
	MOVE	S1,.VLSTR(P1)		;GET THE MOUNTED STRUCTURE NAME
	LOAD	S2,.VLFLG(P1),VL.LUN	;AND GET ITS LOGICAL UNIT NUMBER
	CAMN	S1,.DSSNM(T3)		;DOES STRUCTURE NAME MATCH
	CAME	S2,.DSLUN(T3)		;   AND ALSO LOGICAL UNIT NUMBER ???
	JRST	DSKD.3			;NO,,PROCESS DUPLICATE VOL BLK
	PUSHJ	P,FNDISK		;FIND ITS PRIMARY VOL BLOCK ADDRESS
	JUMPF	DSKD.2			;NOT THERE,,SKIP MOUNTED CHECK
	LOAD	S1,.VLFLG(S1),VL.STA	;GET THE STRUCTURE STATUS
	MOVE	S2,.DSHID(T3)		;GET GET THE UNIT ID
	CAIN	S1,%STAMN		;MOUNTED?
	CAME	S2,.VLVID(P1)		;AND THE SAME UNIT ID?
	JRST	DSKD.2			;NO PROBLEMS
	JRST	DSKD.9			;YES,,THATS AN ERROR

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

DSKD.2:	SKIPE	S1,.VLUCB(P1)		;GET THE VOL UCB ADDRESS
	SETZM	.UCBVL(S1)		;ZAP THAT UNITS POINTER TO THE VOL BLK
	JRST	DSKD.7			;AND CONTINUE

DSKD.3:	SKIPN	S1,.VLUCB(P1)		;IS THE DUPLICATE VOLUME MOUNTED ???
	JRST	DSKD.4			;NO,,SKIP THIS
	$WTO	(<Warning: ^W/.VLVID(P1)/ is mounted on drive ^W/.UCBNM(S1)/>,,MDAOBJ)
	MOVE	S1,.UCBNM(S1)		;GET THE UNIT ON WHICH VOL IS MOUNTED
	PUSHJ	P,SNDREC		;REQUEST DEVICE STATUS FOR THE VOL

DSKD.4:	PUSHJ	P,CREVOL		;GO CREATE A VOL ENTRY FOR IT
	MOVE	P1,S1			;SAVE THE NEW VOL ADDRESS

DSKD.5:	MOVE	S1,.DSHID(T3)		;GET THIS VOL'S VOLUME NAME
	MOVEM	S1,.VLVID(P1)		;SAVE IT
	MOVE	S1,.DSLUN(T3)		;GET THIS VOL'S LOGICAL UNIT NUMBER
	STORE	S1,.VLFLG(P1),VL.LUN	;SAVE IT
	MOVE	S1,.DSNXV(T3)		;GET THE NEXT VOLUME NAME
	MOVEM	S1,.VLNXT(P1)		;SAVE IT
	MOVE	S1,.DSSNM(T3)		;GET THE STRUCTURE NAME FOR THIS VOL
	MOVEM	S1,.VLSTR(P1)		;SAVE IT
	MOVE	S1,.DSPPN(T3)		;GET OWNER PPN
	MOVEM	S1,.VLOID(P1)		;SAVE IT
	MOVX	S1,%LABEL		;GET 'LABELED' LABEL TYPE
	STORE	S1,.VLFLG(P1),VL.LBT	;AND SET IT

DSKD.7:	MOVEM	P1,.UCBVL(T2)		;LINK THE VOL TO THE UCB
	MOVEM	T2,.VLUCB(P1)		;LINK THE UCB TO THE VOL
	MOVE	S1,.VLSTR(P1)		;GET THE STRUCTURE NAME
	SKIPE	.DSLUN(T3)		;THE THE FIRST UNIT IN THE STRUCTURE ??
	JRST	DSKD.8			;NO, DON'T MAKE A RESOURCE NUMBER
	STORE	S1,.VLNAM(P1)		;YES,,SET THE STR NAME (PRIMARY VOL)
	MOVE	S1,P1			;AIM AT THE STR VOL BLK
	PUSHJ	P,D$SVRS		;GENERATE A STRUCTURE RESOURCE NUMBER

DSKD.8:	LOAD	S1,.STFLG(T1),ST.LOK	;GET THE UNIT WRITE LOCK BIT
	STORE	S1,.UCBST(T2),UC.WLK	;SAVE IT
	MOVEI	S2,[ASCIZ ||]		;ASSUME WRITE ENABLED
	SKIPE	S1			;WAS IT?
	MOVEI	S2,[ASCIZ |Unit is hardware write protected|]
	$WTO	(<Volume ^W/.VLVID(P1)/ for structure ^W/.DSSNM(T3)/ mounted>,<^T/(S2)/>,MDAOBJ)

	MOVE	S1,.VLSTR(P1)		;GET THE STRUCTURE NAME IN S1
	SETZM	S2			;NO ALIAS...
	SKIPE	D$ASR			;IS AUTOMATIC STR RECOGNITION ENABLED ???
	PUSHJ	P,BLDSTR		;YES,,TRY TO BUILD A STR WITH WHAT WE HAVE
	$RETT				;RETURN

DSKD.9:	MOVE	S2,.VLUCB(P1)		;GET THE VOLS UCB ADDRESS
	$WTO	(<Error - Can't mount volume ^W/.DSHID(T3)/ on this unit>,<The volume is already mounted on ^W/.UCBNM(S2)/>,MDAOBJ)
	$RETT				;AND RETURN

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

DSK.10:	$WTO	(<Error - Can't mount volume ^W/.DSHID(T3)/ on this Unit>,<Volume ^W/.VLVID(P1)/ for structure ^W/.VLSTR(P1)/ is mounted on this unit>,MDAOBJ)
	SKIPA				;SKIP OVER OTHER ERROR
DSK.11:	$WTO	(<Error - Pack on this unit has a null volume0-ID>,,MDAOBJ,<$WTFLG(WT.SJI)>)
	MOVE	S1,.UCBNM(T2)		;GET THE UNIT NAME
	PUSHJ	P,UNLOAD		;UNLOAD IT
	$RETT				;AND RETURN
>
	SUBTTL	SETOWN - ROUTINE TO SET UP OWNERSHIP FOR A VSL

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

SETASK:	TDZA	TF,TF			;INDICATE 'SET MOUNT REQUESTED'
CLRASK:	SETOM	TF			;INDICATE 'CLEAR MOUNT REQUESTED'
	MOVX	S2,VL.ASK		;GET 'MOUNT REQUESTED' STATUS BIT
	JRST	COMMON			;CONTINUE

D$SETO::				;MAKE 'SETOWN' GLOBAL
SETOWN:	TDZA	TF,TF			;INDICATE 'SET ASSIGNED' 
CLROWN:	SETOM	TF			;INDICATE 'CLEAR ASSIGNED'
	MOVX	S2,VL.ASN		;GET THE 'ASSIGNED' STATUS BIT
	SKIPN	TF			;ARE WE SETTING THE BIT ???
	TXO	S2,VL.OWN		;YES,,ALSO LIGHT THE VOLUME OWNED BIT

COMMON:	$SAVE	<S1,P1,P2,P3>		;SAVE SOME ACS
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	MOVE	P2,S2			;SAVE THE BIT TO CLEAR/LITE
	MOVE	P3,TF			;SAVE THE SET/CLEAR FUNCTION CODE
	PUSHJ	P,CHKOWN		;LOCATE THIS GUYS VSL ADDR IN THE VOL
	JUMPN	P3,[ANDCAM P2,0(S1)	;IF CLEAR FUNCTION,,CLEAR THE BIT
		    SETZM  .VSUCB(P1)	;ZAP THE UNIT POINTER
		    $RETT  ]		;AND RETURN
	IORM	P2,0(S1)		;IF SET FUNCTION,,LITE THE BIT(S)
	ZERO	.VSFLG(P1),VS.NMT	;CLEAR THE PSEUDO MOUNTED STATUS BIT
	TXNN	P2,VL.ASN		;IF JUST 'ASKING' THEN
	$RETT				;RETURN NOW
	LOAD	P3,.VSCVL(P1),VS.OFF	;GET THE CURRENT VOLUME OFFSET
	ADDI	P3,.VSVOL(P1)		;POINT TO THE VOL ADDRESS
	MOVE	P3,0(P3)		;GET THE VOL ADDRESS
	MOVE	P3,.VLUCB(P3)		;GET THE UNIT ADDRESS
	MOVEM	P3,.VSUCB(P1)		;AND LINK THE UCB TO THIS VSL
	MOVX	P2,VL.ASK		;GET THE 'ASK' BIT
	ANDCAM	P2,0(S1)		;AND CLEAR IT
	$RETT				;RETURN
	SUBTTL	MNTVSL - ROUTINE TO ATTEMPT TO MOUNT A USERS REQUESTS

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

TOPS10<
D$MNTV::				;MAKE IT GLOBAL
MNTVSL:	PUSHJ	P,.SAVE4		;SAVE P1 & P2 & P3 & P4
	$SAVE	<AP,T3,T4>		;SAVE AP & T3 & T4 ALSO
	STKVAR	<NOACK,<VSLIST,^D20>,<MNTLST,^D40>> ;GEN A FLAG & SOME QUEUES
	MOVE	P4,S1			;SAVE THE INITIAL VSL ADDRESS
	MOVE	AP,.VSMDR(P4)		;SETUP THE MDR ADDRESS 
	SETZM	P3			;INDICATE NORMAL MOUNT REQUEST
	SETZM	NOACK			;CLEAR NO ACK FLAG
	MOVX	S1,QE.WAM		;GET WAITING FOR MOUNT STATUS
	LOAD	S2,.MRJOB(AP),MD.PJB	;GET THE REQUEST JOB NUMBER
	TXNE	S2,BA%JOB		;IS THIS A PSEUDO REQUEST ???
	SKIPN	P3,.MRQEA(AP)		;YES,,PICK UP THE QE ADDRESS
	SKIPA				;NOT A PSEUDO REQUEST,,SKIP
	IORM	S1,.QESEQ(P3)		;SET 'MOUNT WAIT' (CLEARED LATER)

MNTV.0:	MOVEI	T4,VSLIST		;GET THE PRIMARY VSL QUEUE ADDRESS
	HRLI	T4,-^D20		;GEN THE PRIMARY VSL QUEUE STACK POINTER
	PUSH	T4,[-1]			;MARK END OF VSL QUEUE
	MOVEI	T3,MNTLST		;GET THE MOUNT VSL QUEUE ADDRESS
	HRLI	T3,-^D40		;GEN MOUNT VSL QUEUE STACK POINTER
	PUSH	T3,[-1]			;MARK END OF VSL QUEUE
	PUSH	T3,[-1]			;HERE ALSO

	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE VSL REQUEST COUNT
	LOAD	P2,.VSRID(P4),VS.LNK	;GET THE VSL LINK CODE
	MOVNS	P1			;NEGATE THE VSL COUNT
	MOVSS	P1			;MOVE RIGHT TO LEFT
	HRRI	P1,.MRVSL(AP)		;CREATE VSL AOBJN AC

MNTV.1:	MOVE	S1,0(P1)		;GET A VSL ADDRESS
	LOAD	S2,.VSRID(S1),VS.LNK	;GET THE VSL LINK CODE
	CAME	S2,P2			;DO THEY MATCH ???
	JRST	MNTV.2			;NO,,TRY NEXT
	MOVE	S2,.VSFLG(S1)		;GET THE VSL FLAG BITS
	TXNE	S2,VS.ALC+VS.WAL	;JUST ALLOCATED OR AWAITING ALLOCATION ?
	JRST	[JUMPE  P3,.RETF	;YES,,IF NOT A PSEUDO PROCESS - RETURN
		 MOVX   S2,QE.WAM	;IF A PSEUDO PROCESS,,GET 'MOUNT WAIT'
		 ANDCAM S2,.QESEQ(P3)	;   AND CLEAR IT
		 $RETF	]		;THEN RETURN
	PUSH	T4,S1			;QUEUE UP THE VSL ADDRESS
	LOAD	S1,.VSFLG(S1),VS.TYP	;GET THE REQUEST TYPE
	CAXN	S1,%UNKN		;IS IT UNKNOWN ???
	JRST	[SETZM P2		;YES,,ZAP VSL QUEUE PTR
		 JRST  MNTV.8 ]		;   AND EXIT
MNTV.2:	AOBJN	P1,MNTV.1		;LOOK FOR ALL VSL'S WITH THAT LINK CODE
	MOVE	P2,T4			;SAVE THE PRIMARY VSL QUEUE STACK PTR

	;CONTINUED ON THE NEXT PAGE
	;Here to perform deadlock avoidance check

	MOVE	S1,P4			;GET THE INITIAL VSL ADDRESS BACK
	SKIPN	G$DEAD##		;DEADLOCK AVOIDANCE TURNED ON?
	 PUSHJ	P,TELOPR		;NO,,ALWAYS TELL THE OPR ABOUT MOUNTS
	MOVE	S1,P4			;GET BACK VSL ADDRESS IN CASE OF MDA
	PUSHJ	P,D$DLCK		;DO DEADLOCK CHECKING
	JUMPF	.RETF			;IF DEADLOCKED,,JUST RETURN

	;Here to check to make sure we can mount ALL the required volumes

MNT.2A:	POP	T4,S1			;GET A VSL ADDRESS OFF THE QUEUE
	CAMN	S1,[-1]			;END OF THE QUEUE ???
	JRST	MNT.2B			;YES,,CONTINUE ONWARD !!!
	PUSHJ	P,VSLCHK		;CAN WE MOUNT THIS VOLUME ???
	JUMPF	MNTV.9			;NO - TELL THE OPERATOR
	JUMPE	S1,MNT.2A		;THAT VSL ALREADY MOUNTED,,TRY NEXT
	JUMPL	S1,MNTV.8		;REQUIRED VOLUME NOT MOUNTED,,TELL OPR
	PUSH	T3,S1			;QUEUE UP THE VSL ADDRESS
	PUSH	T3,S2			;QUEUE UP THE UCB/VOL ADDRESS
	JRST	MNT.2A			;CONTINUE ON

	;Now check to see if the pseudo process has been allocated 

MNT.2B:	JUMPE	P3,MNTV.3		;NOT A PSEUDO PROCESS,,CONTINUE
	MOVX	S1,QE.WAM		;GET 'WAITING FOR MOUNT' STATUS BIT
	ANDCAM	S1,.QESEQ(P3)		;CLEAR IT FOR THE PSEUDO PROCESS
	MOVE	S1,P3			;GET THE QE ADDRESS IN S1
	PUSHJ	P,I$RALC##		;REQUEST ALLOCATION

	;Try to mount the Volume(s)

MNTV.3:	POP	T3,S2			;RESTORE A VOL/UCB ADDRESS
	POP	T3,S1			;RESTORE A VSL ADDRESS
	CAMN	S1,[-1]			;END OF THE QUEUE ???
	JRST	MNTV.7			;YES,,GO ACK THE USER
	JUMPN	P3,MNTV.4		;IF A PSEUDO PROCESS,,GO MOUNT IT
	LOAD	P1,.VSFLG(S1),VS.TYP	;ELSE GET THE VOLUME TYPE
	CAXN	P1,%TAPE		;IS THIS A TAPE REQUEST ???
	JRST	MNTV.5			;YES,,GO PROCESS IT
	JRST	MNTV.6			;NO,,ASSUME %DISK

	;Here to perform mounts for Pseudo Processes

MNTV.4:	SETOM	NOACK			;LITE 'DEFERED ACK' FLAG
	DOSCHD				;FORCE A SCHEDULING PASS
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	PUSH	P,S2			;SAVE THE VOL/UCB ADDRESS
	PUSHJ	P,SETOWN		;SET VOLUME OWNERSHIP
	POP	P,S2			;RESTORE THE VOL/UCB ADDRESS
	MOVX	S1,VS.NMT		;GET THE 'NOT REALLY MOUNTED' FLAG BIT
	IORM	S1,.VSFLG(P1)		;SET IT FOR THIS PSEUDO PROCESS
	LOAD	S1,.VSFLG(P1),VS.TYP	;GET THE VOLUME TYPE
	CAXE	S1,%TAPE		;IS IT TAPE ???
	JRST	MNTV.3			;NO,,GET NEXT VSL
	MOVEM	S2,.VSUCB(P1)		;LINK THE UCB TO THIS USER
	MOVEM	P1,.UCBVS(S2)		;LINK THIS USER TO THIS DEVICE
	JRST	MNTV.3			;GET THE NEXT VSL

	;CONTINUED ON THE NEXT PAGE
	;Here to mount tape volumes

MNTV.5:	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	EXCH	S1,S2			;GET UCB ADDR IN S1, VSL IN S2
	PUSHJ	P,REASSIGN		;TRY TO REASSIGN THE DEVICE
	JRST	MNTV.3			;CONTINUE

	;Here to mount structures

MNTV.6:	SETOM	NOACK			;LITE 'DEFERED ACK' FLAG
	PUSH	P,S2			;SAVE THE VOL ADDRESS
	PUSHJ	P,SETASK		;SET THE 'MOUNT REQUESTED' STATUS
	POP	P,S2			;RESTORE THE VOL ADDRESS
	PUSHJ	P,ASLMSG		;GEN 'ADD TO SEARCH LIST' & SEND IT
	JRST	MNTV.3			;CONTINUE

	;Here to ack the user that his request has been satisfied

MNTV.7:	SKIPE	NOACK			;IS 'NO ACK' SET ???
	$RETT				;YES,,RETURN
	MOVE	S1,P4			;GET THE VSL ADDRESS BACK
	PUSHJ	P,ACKUSR		;NOTIFY THE USER
	$RETT				;AND RETURN

MNTV.8:	MOVE	S1,P4			;GET THE ORIGIONAL VSL ADDRESS
	SKIPE	G$DEAD##		;DEADLOCK AVOIDANCE TURNED ON?
	 PUSHJ	P,TELOPR		;ASK THE OPR TO MOUNT THE DEVICES
	JUMPE	P2,.RETF		;NO VSL QUEUE,,EXIT NOW

MNTV.9:	POP	P2,S1			;PICK UP THE VSL ADDRESS OFF THE QUEUE
	CAMN	S1,[-1]			;END OF THE QUEUE ???
	$RETF				;YES,,RETURN
	PUSHJ	P,RETA%C		;RETURN THE 'A' AND 'C' MATRIX ENTRIES
	JRST	MNTV.9			;CONTINUE FOR ALL VSL'S
> ;END TOPS10 CONDITIONAL
	SUBTTL	MNTVSR - ROUTINE TO MOUNT A VOLUME AT VOLUME SWITCH TIME

	;CALL:	S1/ The VSL Address
	;
	;RET:	True if the mount wins, False otherwise

TOPS10<
MNTVSR:	$SAVE	<AP,P1,P2>		;SAVE AP AND P1 & P2 FOR A SECOND
	MOVE	AP,.VSMDR(S1)		;SETUP A NEW MDR POINTER
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	PUSHJ	P,D$CMTX		;LOCATE THIS GUYS 'C' MATRIX ENTRY
	LOAD	S1,.VSCVL(P1),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	S1,.VSVOL(P1)		;POINT TO THE CURRENT VOL ADDRESS
	MOVE	S1,0(S1)		;GET THE CURRENT VOL ADDRESS
	PUSHJ	P,D$TVRS		;CONVERT TO A RESOURCE NUMBER
	MOVE	P2,S1			;SAVE THE RSN FOR LATER IF WE NEED IT
	MOVE	S2,P1			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,ADDAMA		;CLAIM THIS RESOURCE IN 'A' MATRIX
	PUSHJ	P,ADDCMA		;CLAIM THIS RESOURCE IN 'C' MATRIX
	PUSHJ	P,DEADLK		;DEADLOCK CHECK THE WORLD !!!
	JUMPF	TVSR.1			;TOUGH NOUGEEEES !!!
	MOVE	S1,P1			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,VSLCHK		;CAN WE MOUNT THE VOLUME ???
	JUMPF	TVSR.1			;NO,,THIS GUY JUST CAN'T WIN !!!
	JUMPE	S1,.RETT		;SHOULD NOT HAPPEN !!!
	JUMPL	S1,TVSR.0		;NOT MOUNTED,,TELL OPR TO MOUNT IT
	EXCH	S1,S2			;GET UCB ADDR IN S1, VSL ADDR IN S2
	PUSHJ	P,REASSIGN		;REASSIGN THE VOLUME
	$RETT				;RETURN

TVSR.0:	MOVE	S1,P1			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,TELOPR		;TELL THE OPR TO MOUNT THE VOLUME

TVSR.1:	MOVE	S1,P2			;GET THE VOLUME RSN BACK
	MOVE	S2,P1			;GET THE VSL ADDRESS BACK
	PUSHJ	P,SUBAMA		;DELETE THE CLAIM FROM THE 'A' MATRIX
	PUSHJ	P,SUBCMA		;DELETE THE CLAIM FROM THE 'C' MATRIX
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	VSLCHK - ROUTINE TO TRY TO MOUNT A VOLUME FROM THE VSL

	;CALL:	S1/ The VSL Address
	;
	;RET:	S1/ The VSL Address if %TAPE
	;	S2/ The UCB Address if %TAPE
	;
	;	S1/ The VSL Address if %DISK
	;	S2/ The VOL Address if %DISK
	;
	;Error Return Codes:
	;
	;	S1/  0 If the User Already has the Volume Mounted
	;	S1/ -1 If the requested volume needs mounting

TOPS10<
VSLCHK:	PUSHJ	P,.SAVE3		;SAVE P1 TO P3
	MOVE	P2,S1			;SAVE THE VSL ADDRESS
	LOAD	S1,.VSCVL(P2),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	S1,.VSVOL(P2)		;POINT TO THE CURR VOL ADDRESS
	MOVE	P1,0(S1)		;GET THE CURRENT VOLUME ADDRESS
	SKIPN	P3,.VLUCB(P1)		;CHECK AND LOAD THE UCB ADDRESS
	JRST	[SETOM S1		;NOT MOUNTED,,SET RETURN CODE
		 $RETT  ]		;   AND EXIT
	MOVE	S2,.UCBNM(P3)		;GET THE UNIT NAME
	MOVEM	S2,MDAOBJ+OBJ.UN	;SAVE IT IN THE MDA OBJECT BLOCK
	LOAD	S1,.VSFLG(P2),VS.NMT	;GET THE PSEUDO MOUNTED FLAG BIT
	JUMPE	S1,VSLC.1		;NOT CURRENTLY MOUNTED,,SKIP THIS
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE JOB NUMBER
	TXNN	S1,BA%JOB		;STILL A PSEUDO PROCESS ???
	JRST	VSLC.5			;NO,,MOUNT IT FOR REAL !!!!
	SETZM	S1			;YES,,SET 'MOUNTED' RETURN CODE
	$RETT				;AND RETURN NOW

VSLC.1:	LOAD	S1,.VSFLG(P2),VS.TYP	;GET REQUEST TYPE
	CAXN	S1,%DISK		;DISK REQUEST?
	JRST	VSLC.6			;YES - DON'T CHECK OWNERSHIP
	MOVE	S1,P2			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,CHKOWN		;DOES THIS GUY OWN THE VOLUME ???
	JUMPT	[SETZM S1		;YES,,SET 'MOUNTED' RETURN CODE
		 $RETT  ]		;AND RETURN

VSLC.2:	LOAD	S1,.VSFLG(P2),VS.TYP	;GET THE VOLUME SET TYPE
	CAXE	S1,%TAPE		;IS IT A TAPE REQUEST ???
	JRST	VSLC.6			;NO,,TRY DISK

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

	;Here to process Tape Requests

	LOAD	S1,.VSFLG(P2),VS.VSW	;IS THIS VSL IN VOLUME SWITCH ???
	JUMPN	S1,VSLC.3		;YES,,SKIP LABEL CHECK
	LOAD	S1,.VLFLG(P1),VL.LBT	;GET THE MOUNTED VOL LABEL TYPE
	PUSHJ	P,GETLBT		;RECODE IT TO SOMETHING UNDERSTANDABLE
	CAXE	S1,%LABEL		;IS IT LABELED ???
	$RETF				;NO,,RETURN

VSLC.3:	MOVE	S1,P1			;GET THE VOL ADDRESS IN S1
	PUSHJ	P,FNDOWN		;IS THE VOLUME OWNED ???
	JUMPT	.RETF			;YES,,RETURN

VSLC.4:	DMOVE	S1,P1			;GET VOL ADDR IN S1, VSL ADDR IN S2
	PUSHJ	P,CVLVSB		;GO CHECK DEVICE ATTRIBUTES
	JUMPF	.RETF			;NO MATCH,,RETURN
	LOAD	S1,.UCBST(P3),UC.VSW	;ARE WE SWITCHING VOLUMES ON THIS UNIT ?
	JUMPE	S1,VSLC.5		;NO,,SKIP THIS
	CAME	P2,.UCBVS(P3)		;DOES THIS USER OWN THE UNIT ???
	$RETF				;NO,,RETURN

VSLC.5:	MOVE	S1,P2			;GET THE VSL ADDRESS IN S1
	LOAD	S2,.VSFLG(P2),VS.TYP	;GET THE REQUEST TYPE
	CAXE	S2,%TAPE		;IS IT A STRUCTURE REQUEST ???
	MOVE	P3,.UCBVL(P3)		;YES,,LOAD UP THE VOL BLOCK ADDRESS
	MOVE	S2,P3			;GET THE UCB OR VOL ADDRESS IN S2
	$RETT				;RETURN OK

	;Here to process Disk requests

VSLC.6:	CAXE	S1,%DISK		;IS THIS A DISK REQUEST ???
	$RETF				;NO,,RETURN
	LOAD	S1,.VLFLG(P1),VL.STA	;GET THE STRUCTURE STATUS
	LOAD	S2,.VLFLG(P1),VL.LCK	;GET THE STR LOCK STATUS
	CAIN	S1,%STAWT		;IS IT WAITING TO BE MOUNTED?
	JRST	[MOVX	S1,-1		;YES - SET RETURN CODE
		 $RETT]			;AND RETURN
	CAXN	S1,%STAMN		;MUST BE MOUNTED AND
	CAXN	S2,%LOCKD		;   NOT LOCKED
	SKIPA				;     OR NOT LOCKED
	CAXN	S2,%ULCKP		;        WITH A PENDING UNLOCK
	$RETF				;IF SO,,THATS NO GOOD !!!
	MOVE	S1,P2			;GET THE VSL ADDRESS 
	MOVE	S2,P1			;GET THE VOL ADDRESS
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	MATUNI - ROUTINE TO GIVE A VOLUME TO ANY VALID REQUESTOR

	;CALL:	S1/ The UCB Address of the unit on which the volume is mounted
	;
	;RET:	True Always

TOPS10<
MATUNI:	PUSHJ	P,.SAVE3		;SAVE P1& P2 & P3 FOR A SECOND
	SKIPN	P2,.UCBVL(S1)		;CHECK AND LOAD THE VOL BLOCK ADDRESS
	$RETF				;SHOULD NOT HAPPEN
	LOAD	P1,.VLOWN(P2),VL.CNT	;GET THE REQUEST COUNT
	JUMPE	P1,.RETF		;NONE THERE,,RETURN
	MOVNS	P1			;NEGATE IT
	MOVSS	P1			;MOVE RIGHT TO LEFT
	HRRI	P1,.VLVSL(P2)		;GEN VSL SEARCH AOBJN AC
	LOAD	S1,.UCBST(S1),UC.DVT	;GET THE DEVICE TYPE
	CAXE	S1,%TAPE		;IS IT A TAPE REQUEST ???
	JRST	MATU.2			;NO,,TRY DISK

	;Here to try to satisfy tape mount requests

MATU.0:	MOVE	S1,0(P1)		;GET A VSL ADDRESS
	LOAD	S2,.VSCVL(S1),VS.OFF	;GET THE CURRENT VOLUME OFFSET
	ADDI	S2,.VSVOL(S1)		;POINT TO THE CURRENT VOL ADDRESS
	CAMN	P2,0(S2)		;IS HE POINTING AT THIS VOL BLOCK ???
	TXNE	S1,VL.ASN		;OR DOES HE ALREADY HAVE IT ASSIGNED ??
	JRST	MATU.1			;ALREADY ASSGNED OR WRONG VOL,,SKIP THIS
	HRRZS	S1			;GET ONLY THE VSL ADDRESS (CLEAR FLAGS)
	LOAD	P3,.VSFLG(S1),VS.VSW	;GET THE VOLUME SWITCH STATUS
	SKIPE	P3			;ARE WE SWITCHING VOLUMES ???
	PUSHJ	P,MNTVSR		;YES,,GO PROCESS IT
	SKIPN	P3			;ARE WE SWITCHING VOLUMES ???
	PUSHJ	P,MNTVSL		;NO,,TRY GENERAL MOUNT
	JUMPT	.RETT			;WIN,,RETURN
MATU.1:	AOBJN	P1,MATU.0		;NO GO,,TRY NEXT VSL
	$RETF				;CAN'T,,JUST RETURN

	;Here to try to satisfy structure mount requests

MATU.2:	MOVE	S1,0(P1)		;GET A VSL ADDRESS
	TXNN	S1,VL.ASK+VL.ASN	;ASSIGNED OR PENDING ???
	JRST	[HRRZS	S1		;GET ONLY THE VSL ADDRESS (CLEAR FLAGS)
		 PUSHJ	P,MNTVSL	;TRY TO MOUNT IT FOR THIS USER
		 JRST	MATU.3 ]	;AND CONTINUE
MATU.3:	AOBJN	P1,MATU.2		;CHECK THROUGH ALL VSL'S
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL
	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:	S1/ addr of VOL block
	;	S2/ addr of VSL block
	;RET:	TRUE, if all the attributes match, FALSE if they don't
	; Alternate entry at CVLVSB which will not match bypass requests

TOPS10<
CVLVSB:	LOAD	TF,.VSFLG(S2),VS.LBT	;GET THE REQUESTED LABEL TYPE
	CAXN	TF,.TFLBP		;BYPASS REQUESTED?
	 $ERJMP	MD$URB,S2		;YES,,MUST COME THROUGH IDENTIFY

CVLVSL:	$SAVE	<P1,P2,P3>
	DMOVE	P1,S1			;COPY THE VOL, AND VSL PTRS
	SKIPN	P3,.VLUCB(P1)		;GET THE UNIT BLOCK
	 $ERJMP	MD$NVM,P2		;SHOULD NOT HAPPEN !!!

	;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	[SKIPE S2		;S2 NOT EQUAL TO 0,,WRITE LOCKED
		 $ERJMP MD$URW,P2	;SO TELL THE OPERATOR
		 $ERJMP MD$URE,P2 ]	;ELSE USER WANTS WRITE 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?
		 $ERJMP MD$VIL,P2	;NO,,VOLUME IS LABELED !!!
		 $ERJMP MD$URL,P2 ]	;YES,,COMPLAIN ABOUT THAT !!!
	DMOVE	S1,P2			;GET VSL IN S1, UCB IN S2
	PUSHJ	P,D$MODR		;CHECK TRACK/DENSITY REQUIREMENTS
	JUMPF	.RETF			;NO GOOD,,RETURN
	$RETT				;ELSE OK
>;END TOPS10
	SUBTTL	CHKOWN - ROUTINE TO CHECK IF A USER OWNS A VOLUME

	;CALL:	S1/ The VSL Address
	;
	;RET:	S1/ The VOL block pointer to the VSL address

D$FOWN::				;GLOBALIZE IT
CHKOWN:	LOAD	S2,.VSCVL(S1),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	S2,.VSVOL(S1)		;POINT TO THE OFFSET
	MOVE	S2,0(S2)		;GET THE VOL BLOCK ADDRESS
	EXCH	S1,S2			;WANT S1=VOL ADDR,  S2=VSL ADDR
	PUSH	P,S2			;SAVE THE VSL ADDRESS
	LOAD	S2,.VLOWN(S1),VL.CNT	;GET THE VOLUME REQUEST COUNT
	MOVNS	S2			;NEGATE IT
	MOVSS	S2			;MOVE RIGHT TO LEFT
	HRRI	S2,.VLVSL(S1)		;CREATE AOBJN AC FOR VSL ADDR SEARCH
	MOVE	S1,S2			;GET THE POINTER IN S1
	POP	P,S2			;GET THE VSL ADDRESS BACK

CHKO.1:	CAIN	S2,@0(S1)		;FIND THE USERS VSL ADDR IN THE VOL LIST
	JRST	[MOVX  S2,VL.ASK+VL.ASN	;FOUND,,GET REQUEST+ASSIGNED BITS
		 TDNE  S2,0(S1)		;IF LIT,,THIS GUY WAS ALREADY PROCESSED
		 $RETT			;RETURN VOLUME OWNED
		 $RETF  ]		;RETURN VOLUME NOT OWNED
	AOBJN	S1,CHKO.1		;NOT THIS ONE,,TRY NEXT
	$STOP	(IVV,Invalid VSL/VOL Forward/Backchain Pointers) ;NOT FOUND !!!
	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 !!!
	MOVE	S1,S2			;GET THE VOLUME ADDRESS IN S1
	PUSHJ	P,FNDOWN		;ANY OWNERS FOR THIS VOLUME ???
	SKIPF				;NO,,SKIP
	 $ERJMP	MD$VAU			;YES,,CAN THE REQUEST
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	D$DISMOUNT - STRUCTURE DISMOUNT PROCESSOR

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

TOPS10	<
D$DISM:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVX	S1,.STRDV		;GET THE STRUCTURE DEVICE BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	E$IMO##			;NOT THERE,,THATS AN ERROR
	HRROI	S1,0(S1)		;GET POINTER TO ASCIZ STRUCTURE NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVE	S1,S2			;PUT IT IN S1
	MOVE	P1,S1			;HERE ALSO
	PUSHJ	P,FNDISK		;FIND THE VOLUME IN THE VOL BLOCK
	JUMPF	DISM.2			;NOT THERE,,THATS AN ERROR
	LOAD	S2,.VLFLG(S1),VL.STA	;GET THE STRUCTURE STATUS BITS
	CAXE	S2,%STAMN		;IS IT MOUNTED ???
	JRST	DISM.1			;NO,,THATS AN ERROR
	MOVX	S2,%STADM		;GET THE DISMOUNT STRUCTURE STATUS BITS
	STORE	S2,.VLFLG(S1),VL.STA	;SET IT IN STRUCTURE BLOCK
	LOAD	S2,.OFLAG(M),.DMRMV	;GET THE /REMOVE BIT
	STORE	S2,.VLFLG(S1),VL.REM	;AND SAVE IT
	MOVX	S2,.DMNCK		;GET THE /NOCHECK FLAG BIT
	TDNN	S2,.OFLAG(M)		;DID HE SPECIFY NO CHECK ???
	SETZM	S2			;NO,,CLEAR IT !!!
	PUSHJ	P,SNDDSM		;SEND DISMOUNT MESSAGE TO TAPE LABELER
	$RETT				;RETURN

DISM.1:	$ACK	(Structure ^W/P1/ is not mounted,,,.MSCOD(M),<$WTFLG(WT.SJI)>)
	$RETT				;RETURN

DISM.2:	$ACK	(Structure ^W/P1/ does not exist,,,.MSCOD(M),<$WTFLG(WT.SJI)>)
	$RETT				;RETURN

>
	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.
	;	Alternate entry - VLBREAK which just breaks the
	;	UCB - VOL link, but does not unload.

TOPS10<
VLBREAK: TDZA	S2,S2			;INDICATE 'JUST BREAK' ENTRY
VLUNLO:	MOVEI	S2,1			;INDICATE 'BREAK AND UNLOAD ENTRY'
	$SAVE	<P1>			;SAVE P1 FOR A SECOND
	MOVE	P1,S2			;SAVE THE ENTRY FLAG
	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
	MOVX	TF,UC.OFL		;GET 'DEVICE OFFLINE' BIT
	IORM	TF,.UCBST(S2)		;LITE IT IN THE UCB
	MOVX	TF,%STAWT		;GET VOLUME WAITING STATUS CODE
	STORE	TF,.VLFLG(S1),VL.STA	;AND SET IT
	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,VLUN.1		;ANY MORE REQUESTORS ?? YES, KEEP VOL
	PUSH	P,S1			;SAVE UNIT NAME
	MOVE	S1,S2			;GET THE VOL ADDRESS IN S1
	PUSHJ	P,DELVOL		;AND DELETE THE VOLUME
	POP	P,S1			;GET BACK UNIT NAME
VLUN.1:	JUMPE	P1,.RETT		;IF VLBREAK ENTRY, QUIT
	PJRST	UNLOAD			;IF VLUNLO ENTRY, GO UNLOAD THE TAPE
>;END TOPS10
	SUBTTL	D$DELETE - ROUTINE TO DELETE REQUESTS FROM THE MOUNT QUEUE

	;CALL:	M/ The Delete Message Address
	;
	;RET:	True if deleted, False otherwise

TOPS10 <
D$DELE:	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	MOVX	S1,.ORREA		;GET THE REASON BLOCK TYPE
	SETZM	P4			;DEFAULT TO NO REASON BLOCK
	PUSHJ	P,A$FNDB##		;FIND IT
	SKIPF				;LOSE,,SKIP
	MOVE	P4,S1			;SAVE THE REASON BLOCK ADDRESS
	MOVEI	P1,1			;GET THE BLOCK COUNT
DELZ.1:	MOVE	S1,[EXP .ORREQ,.STRDV,](P1)  ;GET THE BLK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT
	JUMPT	@[EXP DELRID,DELSTR](P1) ;FOUND,,PROCESS IT
	SOJGE	P1,DELZ.1		;NOT FOUND,,TRY NEXT
	SETZM	MDAOBJ+OBJ.UN		;ZAP THE UNIT WORD OF MDA OBJECT BLK
	PJRST	E$IMO##			;RETURN INVALID MESSAGE FROM ORION




	;Routine to delete a mount request by request ID

DELRID:	MOVE	S1,0(S1)		;GET THE REQUEST ID
	CAMN	S1,[-1]			;IS THIS ALL REQUESTS ???
	JRST	DELALL			;YES,,OK YOU ASKED FOR IT !!!
	MOVE	P1,S1			;NO,,SAVE IT
	PUSHJ	P,FNDVSL		;LOCATE THE REQUEST
	JUMPF	DELD.1			;NOT THERE,,RETURN AN ERROR
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	PUSHJ	P,CHKOWN		;DOES HE ALREADY OWN THE VOLUME ???
	JUMPT	DELD.0			;YES,,CAN'T DO THIS
	MOVE	S1,P1			;GET THE VSL ADDRESS BACK
	PUSHJ	P,DELREQ		;DELETE THE REQUEST
	$RET				;AND RETURN

DELD.0:	LOAD	P1,.VSRID(P1),VS.RID	;PICK UP THE REQUEST ID
DELD.1:	$ACK	(<Mount request #^D/P1/ does not exist>,,,.MSCOD(M))
	$RETT				;RETURN


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


	;Routine to delete all pending mount requests

DELALL:	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST
	JRST	DELA.2			;JUMP THE FIRST TIME THROUGH

DELA.1:	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT ENTRY
DELA.2:	JUMPF	.RETT			;DONE,,RETURN
	MOVE	P1,S2			;SAVE THE VSL ADDRESS
	LOAD	S1,.VSFLG(P1),VS.NMT	;GET THE PSEUDO MOUNTED FLAG BIT
	JUMPN	S1,DELA.1		;IF SET,,GET NEXT VSL
	MOVE	S1,P1			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,CHKOWN		;DOES THIS GUY OWN THIS VOLUME ???
	JUMPT	DELA.1			;YES,,GET THE NEXT VSL
	MOVE	S1,P1			;NO,,GET THE VSL ADDRESS IN S1
	PUSHJ	P,DELREQ		;DELETE THE REQUEST
	JRST	DELA.1			;AND GO GET ANOTHER



	;Routine to delete all requests for a specific structure

DELSTR:	HRROI	S1,0(S1)		;GET THE STRUCTURE NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVEM	S2,MDAOBJ+OBJ.UN	;SAVE IT
	MOVE	S1,S2			;GET IT IN S1
	PUSHJ	P,D$FNDV		;LOCATE IT
	JUMPF	E$NSD##			;NOT THERE,,RETURN NO SUCH DEVICE
	MOVE	P1,S1			;SAVE THE VOL ADDRESS
	SETZM	P3			;CLEAR REQUEST DELETION COUNTER
DELS.1:	LOAD	P2,.VLOWN(P1),VL.CNT	;GET THE REQUESTOR COUNT
	JUMPE	P2,DELS.3		;NO MORE,,FINISH UP
	MOVNS	P2			;NEGATE IT
	MOVSS	P2			;MOVE RIGHT TO LEFT
	HRRI	P2,.VLVSL(P1)		;CREATE AOBJN SEARCH AC
DELS.2:	MOVE	S1,0(P2)		;GET A REQUESTED VSL
	TXNN	S1,VL.ASN+VL.ASK	;ASSIGNED OR REQUESTED ???
	JRST	[PUSHJ	P,DELREQ	;NO,,DELETE IT !!!
		 AOS	P3		;BUMP DELETION COUNTER
		 JRST	DELS.1 ]	;START OVER
	AOBJN	P2,DELS.2		;TRY NEXT REQUESTOR
DELS.3:	JUMPN	P3,.RETT		;DELETED SOME,,RETURN
	$ACK	(No requests for this structure deleted,,MDAOBJ,.MSCOD(M))
	$RETT				;RETURN

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


	;Routine to delete the VSL pointed to by S1

DELREQ:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVEI	P1,(S1)			;SAVE THE VSL ADDRESS
	MOVE	AP,.VSMDR(P1)		;SETUP THE MDR ADDRESS
	DOSCHD				;FORCE A SCHEDEULING PASS
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE PROCESS JOB NUMBER
	TXC	S1,BA%JOB		;SWAP REQUEST STATES
	TXNE	S1,BA%JOB		;IS THIS A REAL REQUEST ???
	$ACK	(<Mount request #^D/.VSRID(P1),VS.RID/ cancelled>,<^I/DEMO/^M^JVolume-set-name: ^T/.VSVSN(P1)/>,,.MSCOD(M))
	TXNN	S1,BA%JOB		;IS IT A PSEUDO PROCESS ???
	$ACK	(<Mount request #^D/.VSRID(P1),VS.RID/ cancelled>,<User: [SYSTEM] for ^15/.MRFLG(AP),MR.QUE/ Request #^D/S1/^M^JVolume-set-name: ^T/.VSVSN(P1)/>,,.MSCOD(M))
	MOVE	S1,[POINT 7,G$MSG]	;GET A FRESH BUFFER POINTER
	MOVEM	S1,MDBPTR		;SAVE FOR TEXT OUTPUT ROUTINE
	LOAD	S1,.VSFLG(P1),VS.VSW	;SWITCHING VOLUMES ????
	JUMPN	S1,DELVSW		;YES,,PROCESS DIFFERENTLY !!!
	$TEXT	(MDADBP,<Mount request ^T/.VSVSN(P1)/ canceled by the operator^A>)
	SKIPE	P4			;NO REASON,,SKIP
	$TEXT	(MDADBP,<^M^JReason:^T/0(P4)/^A>) ;ADD THE REASON
	SETZM	S1			;GET A NULL BYTE 
	IDPB	S1,MDBPTR		;MAKE THE MESSAGE TEXT ASCIZ
	SETOM	ERRACK			;INDICATE THIS IS AN ERROR ACK
	PUSHJ	P,USRNOT		;TELL THE SAD STORY TO THE USER
	MOVE	S1,P1			;GET THE VSL ADDRESS
	LOAD	P1,.VSRID(P1),VS.LNK	;GET THIS VSL'S LINK CODE
	PUSHJ	P,DELVSL		;DELETE THIS REQUEST
	LOAD	S2,.MRCNT(AP),MR.CNT	;GET THE USERS REQUEST COUNT
	JUMPE	S2,DELMDR		;NOTHING LEFT,,DELETE THE MDR
	MOVNS	S2			;NEGATE IT
	MOVSS	S2			;MOVE RIGHT TO LEFT
	HRRI	S2,.MRVSL(AP)		;CREATE VSL AOBJN SEARCH AC

DELR.1:	MOVE	S1,0(S2)		;GET A VSL ADDRESS
	LOAD	TF,.VSRID(S1),VS.LNK	;GET ITS LINK CODE
	CAMN	TF,P1			;DOES IT MATCH THE ONE WE CANCELED ???
	PJRST	MNTVSL			;YES,,RETRY THE MOUNT
	AOBJN	S2,DELR.1		;NO,,TRY NEXT VSL
	$RETT				;AND RETURN

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


	;Here if user was switching volumes

DELVSW:	$TEXT	(MDADBP,<Volume switch request ^T/.VSVSN(P1)/ canceled by the operator^A>)
	SKIPE	P4			;NO REASON,,SKIP
	$TEXT	(MDADBP,<^M^JReason:^T/0(P4)/^A>) ;ADD THE REASON
	SETZM	S1			;GET A NULL BYTE 
	IDPB	S1,MDBPTR		;MAKE THE MESSAGE TEXT ASCIZ
	SETOM	ERRACK			;INDICATE THIS IS AN ERROR ACK
	PUSHJ	P,USRNOT		;TELL THE SAD STORY TO THE USER
	MOVE	S1,.VSUCB(P1)		;GET THE UNIT HE CURRENTLY OWNS
	MOVE	S2,.VSFLG(P1)		;GET THE VSL FLAG BITS
	TXZ	S2,VS.VSW		;NO SWITCHING VOLS
	TXO	S2,VS.ABO		;ABORTED BY THE OPERATOR
	MOVEM	S2,.VSFLG(P1)		;SAVE THE NEW STATUS
	MOVX	S2,UC.VSW		;GET UNIT VOL SWITCH STATUS
	ANDCAM	S2,.UCBST(S1)		;CLEAR IT
	MOVX	S2,%VABT		;GET 'CANCELLED' STATUS
	PUSHJ	P,VSREOV		;GET USER OUT OF 'EW'
	LOAD	S1,.VSCVL(P1),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	S1,.VSVOL(P1)		;POINT OT THE VOL BLOCK ADDRESS
	MOVE	S2,0(S1)		;GET THE VOL BLOCK ADDRESS
	SETZM	0(S1)			;ZAP THE VOL BLOCK ADDRESS
	DECR	.VSCVL(P1),VS.CNT	;SUBTRACT 1 FROM VOLUME COUNT
	DECR	.VSCVL(P1),VS.OFF	;POINT TO THE PREVIOUS VOLUME
	MOVE	S1,VOLQUE		;GET THE VOL QUEUE ID
	PUSHJ	P,L%APOS		;POSITION TO THE VOL BLOCK
	PUSHJ	P,L%DENT		;AND DELETE IT
	$RETT				;RETURN
>;END TOPS10
	SUBTTL	D$SMDA - Set tape drive un/available/ initialize

	;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	E$IMO##			;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	STAP.3			;NEITHER OF THOSE, PERHAPS INITIALIZE

	;Here to set unavailable

	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
	SKIPE	S1,.UCBVS(P2)		;ANY OWNERS FOR THIS UNIT ???
	 $ERJMP	MD$VAU,S1		;YES,,CAN THE REQUEST
	SKIPE	S1,.UCBVL(P2)		;AIM AT THE VOLUME
	PUSHJ	P,VLBREAK		;DELINK THIS VOLUME
STAP.0:	MOVEI	S1,[ITEXT (<Drive is currently initializing>)]
	LOAD	S2,.UCBST(P2),UC.INI	;GET THE INIT BIT FOR THIS DRIVE
	JUMPN	S2,STAP.E		;IF INITIALIZING, CAN'T SET UNAVAILABLE
	MOVE	S1,.UCBNM(P2)		;GET THE UNIT NAME
	PUSHJ	P,I$MDAC##		;CLEAR DVCMDA MONITOR BIT
	MOVX	S2,UC.AVA+UC.AVR	;GET AVAILABLE+AVR BITS
	ANDCAM	S2,.UCBST(P2)		;CLEAR THEM
	MOVEI	S1,[ITEXT (< Unavailable for use >)]
	PUSHJ	P,STAP.E		;ACK THE OPR
	MOVE	S1,P2			;GET THE UCB ADDRESS IN S1
	PUSHJ	P,D$DECA		;DECRIMENT THE 'A' MATRIX
	PUSHJ	P,DEADLK		;CHECK WITH DEADLOCK AVOIDANCE ROUTINE
	JUMPT	.RETT			;THAT WINS,,GOOD !!!
	$WTO	(<Warning: ^T/BELLS/System deadlock detected>,<Reason: Unit ^W/.UCBNM(P2)/ was set unavailable>,,<$WTFLG(WT.SJI)>)
	$RETT				;RETURN
	;Here to set 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	S2,.UCBST(P2),UC.AVA	;GET THE AVAILABLE BIT
	JUMPN	S2,[MOVEI S1,[ITEXT (< Already available for use >)]
		    PJRST STAP.E ]	;ALREADY AVAILABLE,,TELL OPR AND RETURN
	PUSHJ	P,I$GATR##		;GET THE DEVICE ATTRIBUTES
	LOAD	S2,.UCBST(P2),UC.AVA	;GET THE AVAILABLE BIT
	JUMPE	S2,STAP.6		;SET AVAILABLE LOST,,COMPLAIN AND QUIT
	MOVEI	S1,[ITEXT (< Available for use >)]
	PUSHJ	P,STAP.E		;TELL THE OPR
	MOVE	S1,.UCBNM(P2)		;GET THE UNIT NAME
	PUSHJ	P,SNDREC		;YES,,SEND A RECOGNIZE MSG TO PULSAR
	MOVE	S1,P2			;GET THE UCB ADDRESS IN S1
	PUSHJ	P,D$INCA		;INCRIMENT THE 'A' MATRIX
	$RETT				;RETURN

	;Here to see if it is a SET TAP x INITIALIZE

STAP.3:	MOVX	S1,.DVINI		;GET BLOCK TYPE - INTIALIZE
	PUSHJ	P,A$FNDB##		;TRY FOR THAT BLOCK
	JUMPF	E$IMO##			;CAN'T, SO COMPLAIN
	MOVE	S1,P2			;GET BACK ADRS OF DRIVE NAME
	PUSHJ	P,FNDUCB		;FIND THIS GUY'S DATA BASE
	JUMPF	.POPJ			;NOT THERE??!! OH WELL
	MOVE	P2,S1			;SAVE ADRS OF UCB
	MOVX	S1,.SIABO		;GET BLOCK TYPE - /ABORT
	PUSHJ	P,A$FNDB##		;TRY FOR THAT BLOCK
	JUMPT	STAP.5			;FOUND IT,,ABORT THE INITIALIZATION
	MOVEI	S1,[ITEXT (<Already initializing>)]
	MOVE	S2,.UCBST(P2)		;GET DRIVE STATUS
	TXNE	S2,UC.INI		;ALREADY BEEN HERE?
	JRST	STAP.E			;YES, TELL THE OPR THAT
	MOVEI	S1,[ITEXT (<Unavailable for initialization>)]
	TXNN	S2,UC.AVA		;IS DRIVE SET UNAVAILABLE?
	JRST	STAP.E			;TELL THE OPR THE BAD NEWS
	MOVX	S1,UC.VSW		;GET THE VOLUME SWITCH STATE BIT
	TDNN	S1,.UCBST(P2)		;IF SWITCHING REELS,,LETERRIP !!
	SKIPN	S1,.UCBVL(P2)		;GET ADRS OF LOADED VOL BLOCK
	JRST	STAP.4			;NO VOL BLOCK, DO THE INITIALIZE
	PUSHJ	P,FNDOWN		;FIND THIS VOL'S OWNER
	SKIPF				;SKIP IF UNOWNED
	$ERJMP	MD$VAU			;THERE IS ONE! CAN'T INIT THAT TAPE
	MOVE	S1,.UCBVL(P2)		;NO OWNER, AIM AT VOL BLOCK AGAIN
	PUSHJ	P,VLBREAK		;BREAK THIS VOL - UCB LINK
STAP.4:	MOVX	S1,UC.INI		;GET THE INITIALIZING BIT
	IORM	S1,.UCBST(P2)		;LITE SO OTHERS WILL SEE
	PJRST	I$FPLR##		;LET PULSAR DO THE WORK

	;Here for /ABORT processing

STAP.5:	MOVX	S1,UC.INI		;GET THE INITIALIZATION BIT
	ANDCAM	S1,.UCBST(P2)		;CLEAR IT
	PJRST	I$FPLR##		;TELL PULSAR NOT TO CONTINUE

	;Here for could not set available

STAP.6:	MOVE	S1,.UCBNM(P2)		;GET THE DEVICE NAME
	PUSHJ	P,I$GOWN##		;TRY TO FIND THE OWNER
	MOVEI	P1,(S1)			;SAVE THE NUMBER IF ANY
	MOVEI	S1,[ITEXT (<Could not set device available for use>)]
	MOVEI	S2,[ITEXT (<Device ^W/.UCBNM(P2)/ already owned by job ^D/P1/>)]
	SKIPT				;IF OWNED,,GO FINISH UP
	MOVEI	S2,[ITEXT (<No such device or error determining owning job number>)]
	$ACK	(<^I/0(S1)/>,<^I/0(S2)/>,MDAOBJ,.MSCOD(M))
	$RETT
	
STAP.E:	$ACK	(<^I/0(S1)/>,,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,UCBFND		;FIND ITS UCB ENTRY
	JUMPF	.RETF			;NOT THERE,,JUST RETURN
	MOVE	P1,S1			;SAVE THE UCB ADDRESS

	SKIPN	P2,.UCBVS(P1)		;GET THE OWNERS VSL ADDRESS
	 PJRST	[MOVE  S1,P1		;NONE,,THATS WIERD !!!
		 MOVX  S2,%VTMV		;   GET 'TOO MANY VOLUMES' STATUS
		 PJRST VSREOV ]		;   END EXIT THROUGH VSREOV
	MOVE	AP,.VSMDR(P2)		;GET THE OWNER MDR ADDRESS
	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

	;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 ???
	PJRST	[MOVE  S1,P1		;YES,,GET THE UCB ADDRESS IN S1
		 MOVX  S2,%VTMV		;GET 'TOO MANY VOLUMES' STATUS
		 PJRST VSREOV ]		;END EXIT THROUGH VSREOV
	MOVE	S1,P1			;GET THE UCB ADDRESS IN S1
	MOVX	S2,%VEOF		;GET 'END OF FILE' STATUS
	JUMPE	P4,VSREOV		;P4=0,,SEND EOV MSG TO PULSAR
	MOVEI	P4,1			;SET FLAG INDICATING VOL SET EXTENSION

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

VSR.0:	MOVE	S1,P2			;GET THE VSL ADDRESS
	PUSHJ	P,I$TDSM##		;PERFORM TAPE ACCOUNTING
	MOVE	S1,.UCBNM(P1)		;GET THE DEVICE NAME IN S1
	PUSHJ	P,REWIND		;REWIND THE LAST VOLUME
	LOAD	S1,.VSFLG(P2),VS.ABO	;GET ABORTED BY OPERATOR STATUS
	JUMPN	S1,VSR.1		;IF ABORTED,,DON'T DEALLOCATE

	;Deallocate the current volume Resource Number

	PUSHJ	P,D$CMTX		;LOCATE THIS GUYS 'C' MATRIX ENTRY
	LOAD	S1,.VSCVL(P2),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	S1,.VSVOL(P2)		;POINT TO ITS ADDRESS
	MOVE	S1,0(S1)		;GET THE CURRENT VOLUME ADDRESS
	PUSHJ	P,D$TVRS		;CONVERT TO A VOLUME RESOURCE NUMBER
	MOVE	S2,P2			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,SUBAMA		;REMOVE FROM THE 'A' MATRIX
	PUSHJ	P,SUBCMA		;REMOVE FROM THE 'C' MATRIX
	MOVE	S1,P2			;GET THE VSL ADDRESS
	PUSHJ	P,CLROWN		;CLEAR OWNERSHIP FLAG

	;Update the VSL status

VSR.1:	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
	MOVX	S1,VS.ABO		;GET ABORT FLAG
	ANDCAM	S1,.VSFLG(P2)		;CLEAR IT
	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.2		;IF EXTENDING VOLUME SET,,SKIP THIS

	MOVE	S1,P2			;GET THE VSL ADDRESS
	PUSHJ	P,MNTVSR		;TRY TO MOUNT THE NEXT VOLUME
	$RETT				;WIN OR LOSE, KEEP GOING

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

	;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.2:	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 !!!
	MOVE	AP,.VSMDR(P3)		;GET THE MDR ADDRESS
	LOAD	S1,.MRCNT(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.2A:	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.2A		;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:	CAIN	P2,@0(S2)		;IS THIS VOL POINTING AT OLD VSL ???
	JRST	[HRRM 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

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

	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 
	LOAD	S2,.VSFLG(P3),VS.LBT	;GET THE LABEL TYPE
	LOAD	P1,.VSATR(P3),VS.TRK	;GET THE TRACK STATUS
	LOAD	P2,.VSATR(P3),VS.DEN	;GET THE REQUESTED DENSITY
	$WTO	(<Magtape mount request #^D/.VSRID(P3),VS.RID/>,<^I/DEMO/^M^JVolume-set-name: ^T/.VSVSN(P3)/^T/MTAHDR/Scratch    ^T9/@WRTENA(S1)/^T9/@LABELS(S2)/^W6/TRK(P1)/^T/@DENSTY(P2)/^T/BELLS/>,,<$WTFLG(WT.SJI)>)
	$RETT				;NOTIFY THE OPERATOR AND RETURN
>
	SUBTTL	D$DVS - DISMOUNT/DEALLOCATE VOLUME SET PROCESSOR

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

TOPS10	<
D$DVS:	SKIPN	G$MDA##			;IS MDA SUPPORTED ???
	JRST	E$MDA##			;NO,,RETURN AN ERROR !!!
	PUSHJ	P,.SAVE3		;SAVE P1 - P3
	LOAD	S1,G$PRVS##,MD.PJB	;GET THE SENDERS JOB NUMBER
	PUSHJ	P,FNDMDR		;FIND HIS MDR
	JUMPF	E$SDY##			;NOT THERE,,THATS AN ERROR
	MOVE	S1,G$SND##		;GET THIS USERS PID
	MOVEM	S1,.MRPID(AP)		;SAVE IT FOR THE ACK
	MOVE	S1,.MSCOD(M)		;GET THE SENDERS ACK CODE
	MOVEM	S1,.MRACK(AP)		;SAVE IT
	SETZM	S1			;NO GENERAL ACK
	STORE	S1,.MRFLG(AP),MR.ACK	;SO CLEAR ACK FLAG BIT
	LOAD	S1,.OFLAG(M),MM.WAT	;GET 'WAITING' FLAG BIT
	STORE	S1,.MRFLG(AP),MR.WAT	;SET/CLEAR IT
	LOAD	S1,.OFLAG(M),MM.NOT	;GET 'NOTIFY' FLAG BIT
	STORE	S1,.MRFLG(AP),MR.NOT	;SET/CLEAR IT
	LOAD	P3,.OFLAG(M),MM.DLC	;SET DISMOUNT(0)/DEALLOCATE(1)
	SETZM	STRVOL			;CLEAR VSL PROCESSED FLAG
	SETZM	G$MSG			;CLEAR THE MDA BUFFER
	MOVX	S1,.RECDV		;GET THE DEVICE NAME BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPT	DVS.3			;FOUND IT,,GO PROCESS IT
	MOVX	S1,.RCTVS		;GET THE VOLUME SET NAME BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	E$IFD##			;NOT THERE,,THATS AN ERROR
DVS.1:	MOVE	P2,S1			;SAVE THE VOLUME SET NAME ADDRESS

	;Here if he passed a Volume Set Name

DVS.2:	PUSHJ	P,FNDLNM		;LOOK FOR A VSL WITH THAT LOGICAL NAME
	JUMPT	DVS.5			;FOUND IT,,GO PROCESS THE VSL
	MOVE	S1,P2			;NOT FOUND,,POINT TO ASCIZ VOL SET NAME
	PUSHJ	P,FNDVSN		;LOOK FOR THE VSL WITH THIS NAME
	JUMPT	DVS.5			;FOUND IT,,GO PROCESS THIS VSL
	JRST	E$IVN##			;RETURN INVALID VOL SET NAME SPECIFIED

	;Here if he passed a device name

DVS.3:	MOVE	P2,0(S1)		;SAVE THE DEVICE NAME
	MOVE	S1,P2			;GET THE SIXBIT DEVICE NAME IN S1
	PUSHJ	P,UCBFND		;GET THE UCB FOR THIS DEVICE
	JUMPF	DVS.4			;NOT THERE,,TRY VOL SET/LOGICAL NAME
	MOVE	P1,S1			;SAVE THE UCB ADDRESS
	SKIPE	S1,.UCBVS(P1)		;CHECK AND LOAD THE OWNING VSL ADDRESS
	CAME	AP,.VSMDR(S1)		;DOES HE OWN THE DEVICE ???
	JRST	E$SDY##			;SPECIFIED DEVICE IS NOT HIS !!!
	PJRST	DVS.5			;HE OWNS THE DEVICE,,PROCESS THE VSL

	;CONTINUED ON THE NEXT PAGE
DVS.4:	$TEXT	(<-1,,TMPVSL>,<^W/P2/^0>) ;NO,,GEN ASCIZ VOL SET NAME
	MOVEI	S1,TMPVSL		;POINT TO THE VOL SET NAME
	JRST	DVS.1			;AND TRY TO FIND A VOL SET BY THAT NAME

	;Here to process the VSL whose address is in S1.

DVS.5:	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	SETZM	G$ACK##			;DO NOT ACK TWICE !!!
	SKIPN	S1,.VSUCB(P1)		;CHECK AND LOAD THE UNIT ADDRESS
	JRST	DVS.6			;NOT THERE,,CONTINUE ON
	LOAD	S2,.UCBST(S1),UC.DVT	;GET THE DEVICE TYPE
	CAXE	S2,%DISK		;IS IT A STRUCTURE ???
	JRST	DVS.7			;NO,,THATS AN ERROR
	MOVE	S1,P1			;GET THE VSL ADDRESS
	MOVX	S2,VS.ARD		;GET THE ALWAYS RECOMPUTE BIT
	ANDCAM	S2,.VSFLG(S1)		;CLEAR IT
	MOVE	S2,.VSVOL(S1)		;GET THE VOLUME BLOCK ADDRESS
	PUSHJ	P,DSLMSG		;GEN 'DELETE FROM SEARCH LIST' & SEND IT
	SKIPE	P3			;IS THIS A DEALLOCATE ???
	ZERO	.VSFLG(P1),VS.UAL	;YES,,ZAP THE USER ALLOCATE FLAG
	LOAD	S1,.OFLAG(M),MM.REM	;GET REMOVE STR FLAG BIT
	STORE	S1,.VSFLG(P1),VS.REM	;SET/CLEAR IT
	$RETT				;WAIT FOR PULSAR ACK !!!

DVS.6:	JUMPE	P3,DVS.6A		;IF DISMOUNT,,THATS AN ERROR
	$TEXT	(<-1,,G$MSG>,<Volume set ^T/.VSVSN(P1)/ has been Deallocated^M^J^0>)
	PUSHJ	P,USRNOT		;ACK THE USER
	MOVE	S1,P1			;GET THE VSL ADDRESS
	LOAD	S2,.OFLAG(M),MM.REM	;GET /REMOVE STR FLAG BIT
	SKIPE	S2			;DID USER SPECIFY /REMOVE ???
	PUSHJ	P,TELREM		;YES,,TELL THE OPERATOR
	LOAD	S1,.VSFLG(P1),VS.ALC	;WERE WE JUST ALLOCATED ???
	SKIPN	S1			;YES,,DON'T BOTHER THE OPERATOR
	$WTO	(<Mount Request #^D/.VSRID(P1),VS.RID/ cancelled by user>,<  ^I/DEMO/^M^J  Volume-set-name: ^T/.VSVSN(P1)/>,,<$WTFLG(WT.SJI)>)
	MOVE	S1,P1			;GET THE VSL ADDRESS
	PUSHJ	P,DELVSL		;DEALLOCATE/DELETE THIS VOLUME SET
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT
	JUMPE	S1,DELMDR		;NO MORE,,DELETE THE MDR AND RETURN
	$RETT				;ELSE RETURN

DVS.6A:	$TEXT	(<-1,,G$MSG>,<Volume set ^T/.VSVSN(P1)/ is not Mounted^M^J^0>)
	SETOM	ERRACK			;INDICATE THIS IS AN ERROR
	PUSHJ	P,USRNOT		;TELL THE USER
	$RETT				;AND RETURN

DVS.7:	MOVEI	S2,[ASCIZ/Dismount/]	;DEFAULT TO A DISMOUNT
	SKIPE	P3			;UNLESS IT IS DEALLOCATE
	MOVEI	S2,[ASCIZ/Deallocate/]	;  THEN MAKE IT DEALLOCATE
	$TEXT	(<-1,,G$MSG>,<Can't ^T/0(S2)/ volume set ^T/.VSVSN(P1)/^M^J Unit ^W/.UCBNM(S1)/ must be deassigned^M^J^0>)
	SETOM	ERRACK			;THIS IS AN ERROR
	PUSHJ	P,USRNOT		;TELL THE USER
	$RETT				;AND RETURN
>
	SUBTTL	D$RCATALOG - RESPONSE TO CATALOG INFO REQUEST MSG PROCESSOR

	;CALL:	M/ The Catalog Response Message Address
	;
	;RET:	True Always

TOPS10<
D$RCAT:	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	MOVX	S1,.RCTVS		;GET THE VOLUME SET NAME BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	MISC.3			;NOT THERE,,THATS AN ERROR
	HRROI	S1,0(S1)		;POINT TO THE ASCIZ VOL SET NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVEM	S2,MDAOBJ+OBJ.UN	;SAVE IT IN THE OBJECT BLOCK

	SETZM	P4			;NOT A USER REQUEST...
	MOVX	S1,.CVSFS		;GET THE VOL SET STR DESCRIPTION BLK
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	MISC.3			;NOT THERE,,THATS AN ERROR
	MOVE	P2,S1			;SAVE THE DESCRIPTION BLK ADDR IN P2

	SKIPN	S1,.MSCOD(M)		;GET THE ACK CODE (MDR ID)
	JRST	MISC.3			;NONE THERE,,THATS AN ERROR
	CAMN	S1,[-1]			;IS IT -1 ???
	JRST	RCAT.0			;YES,,NOT A USER REQUEST
	PUSHJ	P,FNDVSL		;FIND THE VSL FOR THIS USER
	JUMPF	RCAT.0			;NOT THERE,,SKIP THIS
	MOVE	P4,S1			;SAVE THE VSL ADDRESS

RCAT.0:	SETZM	CATOLD			;CLEAR OLD CATALOG ENTRY ADDRESS
	MOVE	S1,MDAOBJ+OBJ.UN	;GET BACK THE VOLUME SET NAME
	PUSHJ	P,D$FCAT		;TRY TO FIND THE VOL SET IN THE CATALOG
	SKIPF				;FOUND IT?
	MOVEM	S1,CATOLD		;YES - REMEMBER THE ADDRESS

	;Here to create an entry in the Vol Set Catalog

	MOVE	S1,CATQUE		;GET THE CATALOG QUEUE ID
	PUSHJ	P,L%LAST		;POSITION TO LAST ENTRY
	MOVE	S1,CATQUE		;GET THE CATALOG QUEUE ID
	LOAD	S2,.CVSNV(P2),CVS.NV	;GET THE # OF VOLUMES IN THE VOLUME SET
	IMULI	S2,CATBLN		;ADD LENGTH OF EACH ENTRY
	ADDI	S2,CATLEN		;ADD THE HEADER LENGTH
	PUSHJ	P,L%CENT		;CREATE AN ENTRY
	MOVEM	S2,CATNEW		;REMEMBER IT FOR LATER
	MOVE	S1,MDAOBJ+OBJ.UN	;GET BACK THE VOLUME SET NAME
	MOVEM	S1,.CTVSN(S2)		;SAVE IT 
	MOVE	S1,.CVSOW(P2)		;GET THE OWNER ID FROM THE CATALOG
	MOVEM	S1,.CTOID(S2)		;SAVE IT
	MOVE	S1,.CVSON+0(P2)		;GET THE OWNER NAME (WORD 1)
	MOVEM	S1,.CTNAM+0(S2)		;SAVE IT
	MOVE	S1,.CVSON+1(P2)		;GET THE OWNER NAME (WORD 2)
	MOVEM	S1,.CTNAM+1(S2)		;SAVE IT
	MOVEI	P1,.CTVOL(S2)		;POINT TO THE CAT ENTRY BLOCKS
	MOVEI	P3,.CVSLN(P2)		;POINT TO THE FIRST VOLUME BLOCK
	LOAD	P2,.CVSNV(P2),CVS.NV	;GET THE VOLUME COUNT
	MOVEM	P2,.CTCNT(S2)		;SAVE IT

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

RCAT.1:	LOAD	S1,ARG.HD(P3),AR.TYP	;GET THE BLOCK TYPE
	CAXE	S1,.CVLPR		;MUST BE THE CORRECT TYPE
	JRST	RCAT.4			;NO,,THATS AN ERROR
	MOVE	S1,ARG.DA+.CVLID(P3)	;GET THE VOLUME ID
	MOVEM	S1,.CTVID(P1)		;SAVE IT
	SETZM	S1			;ZERO S1
	LOAD	S2,ARG.DA+.CVLST(P3),CVL.KT ;GET THE KONTROLLER TYPE
	STORE	S2,S1,UC.KTP		;SAVE IT
	LOAD	S2,ARG.DA+.CVLST(P3),CVL.UT ;GET THE UNIT TYPE
	STORE	S2,S1,UC.UTP		;SAVE IT
	PUSHJ	P,DSKRSN		;GET ITS RESOURCE NUMBER
	JUMPF	RCAT.4			;NO GOOD,,THATS AN ERROR
	MOVEM	S1,.CTRSN(P1)		;SAVE IT
	ADDI	P1,CATBLN		;POINT TO THE NEXT BLOCK
	MOVEI	P3,ARG.DA+.CVLLN(P3)	;HERE ALSO
	SOJG	P2,RCAT.1		;CONTINUE FOR ALL VOLUMES

RCAT.2:	SKIPN	S1,CATOLD		;HAVE AN OLD ENTRY?
	JRST	RCAT.3			;NO
	MOVE	S2,CATNEW		;GET NEW ENTRY ADDRESS
	MOVEI	P3,.CTCAT		;SET THE BUILD CODE TO SAY
	MOVEM	P3,.CTBLD(S2)		; THIS ENTRY CAME FROM STRLST
	PUSHJ	P,D$CCAT		;COMPARE THE TWO
	MOVE	P1,S1			;GET THE ENTRY ADDRESS TO USE
	MOVE	S2,S1			;...
	MOVE	S1,CATQUE		;GET QUEUE HEADER
	PUSHJ	P,L%APOS		;POSITION THERE

RCAT.3:	JUMPE	P4,.RETT		;RETURN IF AN INTERNAL REQUEST
	MOVE	S1,P4			;GET THE VSL ADDRESS
	PUSHJ	P,D$ALOC		;TRY TO COMPLETE ALLOCATION
	JUMPF	[JUMPL	S1,.RETT	;ALLOCATION POSTPONED,,JUST RETURN
		 MOVE	S1,P4		;NO GOOD,,GET THE VSL ADDRESS BACK
		 PJRST	DELETE ]	;  AND DELETE THE VOL SETS JUST ADDED
	LOAD	S2,.MRJOB(AP),MD.PJB	;GET THE PROCESS JOB NUMBER
	MOVE	S1,P4			;GET THE VSL ADDRESS BACK
	TXNE	S2,BA%JOB		;IS THIS A PSEUDO PROCESS ??
	MOVE	S1,.MRVSL(AP)		;YES,,MOUNT TO THE FIRST VSL
	PUSHJ	P,MNTVSL		;TRY TO MOUNT THE USERS REQUEST
	$RETT				;RETURN IN ANY CASE

RCAT.4:	MOVE	S1,CATQUE		;GET THE QUEUE ID
	PUSHJ	P,L%DENT		;DELETE THE CURRENT ENTRY
	JUMPE	P4,.RETT		;AN INTERNAL REQUEST,,RETURN
	$TEXT	(<-1,,G$MSG>,<Can't mount volume set ^T/.VSVSN(P4)/ - No drives available^M^J^0>)
	SETOM	ERRACK			;INDICATE AN ERROR ACK
	PUSHJ	P,USRNOT		;TELL THE USER
	MOVE	S1,P4			;GET THE VSL ADDRESS
	PUSHJ	P,REMOVE		;DELETE THIS VSL AND RETRY THE MOUNT
	$RETT				;RETURN
>
	SUBTTL	D$GENC - ROUTINE TO GENERATE CATALOG ENTRIES FROM THE UCB'S

	;CALL:	S1/ The Primary Vol Block Address
	;
	;RET:	True Always

TOPS10<	INTERN	D$GENC			;MAKE IT GLOBAL

D$GENC:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;COPY VOLUME BLOCK ADDRESS
	MOVE	S1,.VLNAM(P1)		;GET THE STR NAME
	PUSHJ	P,D$FCAT		;LOOK FOR IT IN THE CATALOG
	SKIPT				;FOUND IT?
	SETZ	S1,			;NO
	MOVEM	S1,CATOLD		;REMEMBER IT FOR LATER
	MOVE	S1,CATQUE		;GET THE CATALOG QUEUE ID
	PUSHJ	P,L%LAST		;POSITION TO THE END OF THE Q
	MOVE	S1,P1			;GET THE VOL BLK ADDRESS BACK
	SETZM	S2			;ZERO THE VOLUME COUNTER
	LOAD	S1,.VLPTR(S1),VL.NXT	;GET THE NEXT VOL BLK ADDRESS
	AOS	S2			;BUMP THE VOLUME COUNT
	JUMPN	S1,.-2			;CONTINUE FOR ALL VOLUMES
	PUSH	P,S2			;SAVE THE VOLUME COUNT
	IMULI	S2,CATBLN		;CALC NUMBER OF WORDS TO GET
	ADDI	S2,CATLEN		;INCLUDE THE CATALOG HEADER
	MOVE	S1,CATQUE		;GET THE CATALOG QUEUE ID BACK
	PUSHJ	P,L%CENT		;CREATE A NEW CATALOG ENTRY
	JUMPF	GENC.2			;FAILD FOR SOME REASON
	MOVEM	S2,CATNEW		;SAVE NEW ADDRESS FOR LATER
	MOVE	S1,.VLNAM(P1)		;GET THE STR NAME BACK
	MOVEM	S1,.CTVSN(S2)		;SET IT
	MOVE	S1,.VLOID(P1)		;GET THE OWNER PPN
	MOVEM	S1,.CTOID(S2)		;SAVE IT
	MOVEI	S1,.CTQSR		;SET THE BUILD CODE TO SAY
	MOVEM	S1,.CTBLD(S2)		; THIS ENTRY WAS CREATED BY QUASAR
	POP	P,.CTCNT(S2)		;INSERT VOLUME COUNT
	MOVEI	S2,.CTVOL(S2)		;POINT TO VOLUME BLOCKS

GENC.1:	MOVE	S1,.VLVID(P1)		;GET THE VOLID
	MOVEM	S1,.CTVID(S2)		;SET IT
	MOVE	S1,.VLUCB(P1)		;GET THE UNIT THIS VOLUME IS ON
	LOAD	S1,.UCBST(S1),UC.RSN	;GET THE UNIT RESOURCE NUMBER
	MOVEM	S1,.CTRSN(S2)		;SET IT
	ADDI	S2,CATBLN		;POINT TO THE NEXT VOLID BLOCK
	LOAD	P1,.VLPTR(P1),VL.NXT	;GET THE NEXT VOL BLK ADDRESS
	JUMPN	P1,GENC.1		;CONTINUE IF THERE IS ONE
	SKIPN	S1,CATOLD		;WAS THERE AN OLD ENTRY?
	$RETT				;NO
	MOVE	S2,CATNEW		;GET THE NEW ENTRY
	PUSHJ	P,D$CCAT		;COMPARE THE TWO
	POPJ	P,			;RETURN TRUE OR FALSE

GENC.2:	$WTO	(<Cannot cache STRLST.SYS entry for ^W/.VLNAM(P1)/>,,,<$WTFLG(WT.SJI)>)
	$RETF				;RETURN

> ;END TOPS10 CONDITIONAL
	SUBTTL	D$ACK - ROUTINE TO PROCESS MDA ACK MESSAGES

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

TOPS10	<
D$ACK:	MOVX	S1,.RCTVS		;GET VOL SET NAME BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN OUR MESSAGE
	JUMPF	MISC.3			;NOT THERE,,THATS AN ERROR
	HRROI	S1,0(S1)		;GET POINTER TO ASCIZ VOL SET NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVE	S1,S2			;GET STRUCTURE NAME IN S1
	PUSHJ	P,FNDISK		;FIND ITS VOL BLOCK ADDRESS
	JUMPF	.RETT			;NOT THERE,,RETURN
	LOAD	S2,.MSFLG(M),AK.TYP	;GET THE ACK TYPE
	CAILE	S2,ACKLEN		;VALIDATE IT
	SETZM	S2			;NO GOOD,,ZERO IT
	PJRST	@ACKDSP(S2)		;DISPATCH OFF TO PROCESS THE ACK

ACKDSP:	EXP	MISC.3			;ACK TYPE 0 IS INVALID
	EXP	MNTACK			;ACK TYPE 1 IS MOUNT ACK
	EXP	DSMACK			;ACK TYPE 2 IS DISMOUNT ACK
	EXP	CATACK			;ACK TYPE 3 IS CATALOG ACK (ERROR ONLY)
	EXP	ASLACK			;ACK TYPE 4 IS ADD STR TO SRCH LIST ACK
	EXP	RMSACK			;ACK TYPE 5 REMOVE STR FROM SRCH LIST 
	EXP	MNTOPC			;ACK TYPE 6 IS MOUNT ACK (OWNER PPN CL)

	ACKLEN==.-ACKDSP		;DISPATCH TABLE LENGTH
>
SUBTTL	Structure mount ACK processing


; Here on ACK types %MOUNT and %MNTOPC
; Call:	MOVE	S1, primary VOL block address
;	PUSHJ	P,MNTACK	for normal structure mount ACKs
;	PUSHJ	P,MNTOPC	when owner PPN is cleared
;
; TRUE return:	always
;
TOPS10	<
MNTACK:	TDZA	S2,S2			;INDICATE NORMAL MOUNT ACK
MNTOPC:	MOVEI	S2,1			;INDICATE OWNER PPN CLEARED
	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE VOL BLOCK ADDRESS
	LOAD	S1,.MSFLG(M),AK.NAK	;IS THIS A NAK ???
	JUMPN	S1,MNTA.4		;YES,,OH WELL !!!
	$COUNT	(STRM)			;count # of successful str mounts
	MOVX	S1,%STAMN		;GET STRUCTURE MOUNTED BIT
	STORE	S1,.VLFLG(P1),VL.STA	;SAVE IT AS NEW STRUCTURE STATUS
	MOVE	S1,G$NOW##		;GET THE CURRENT TIME
	MOVEM	S1,.VLMTM(P1)		;SAVE THE MOUNTED TIME
	JUMPE	S2,MNTA.3		;SKIP LOOP IF NORMAL MOUNT ACK
	SKIPA	S1,P1			;GET PRIMARY VOL BLOCK ADDRESS

MNTA.1:	LOAD	S1,.VLPTR(S1),VL.NXT	;GET THE NEXT VOL BLK ADDRESS
	JUMPE	S1,MNTA.2		;DONE ALL VOL BLOCKS?
	SETZM	.VLOID(S1)		;CLEAR OWNER PPN
	JRST	MNTA.1			;LOOP FOR ALL VOL BLOCKS

MNTA.2:	MOVE	S1,.VLNAM(P1)		;GET STR NAME
	PUSHJ	P,D$FCAT		;GET CATALOG ENTRY
	  SKIPF				;WE BLEW IT SOMEWHERE - AVOID A MESS
	SETZM	.CTOID(S1)		;CLEAR THE OWNER PPN IN THE CATALOG

MNTA.3:	MOVEI	S1,[ASCIZ ||]		;ASSUME NOT WRITE-LOCKED
	MOVX	S2,.MTWLK		;GET A BIT TO TEST
	TDNE	S2,.OFLAG(M)		;WRITE-LOCKED FOR ALL USERS?
	MOVEI	S1,[ASCIZ |Structure is software write-locked for all users|]
	$WTO	(<Structure ^W/.VLNAM(P1)/ mounted>,<^T/(S1)/>,,<$WTFLG(WT.SJI)>)
	DOSCHD				;FORCE A SCHEDULING PASS
	MOVE	S1,P1			;GET THE VOL BLK ADDR IN S1
	PUSHJ	P,I$STRM##		;PERFORM STRUCTURE ACCOUNTING
	MOVE	S1,.VLUCB(P1)		;GET THE UCB ADDRESS
	PUSHJ	P,MATUNI		;TRY TO ASSIGN THE DEVICE
	$RETT				;RETURN

MNTA.4:	$WTO	(<Can't mount structure ^W/.VLNAM(P1)/>,,,<$WTFLG(WT.SJI)>)
	MOVE	S1,.VLSTR(P1)		;GET THE REAL STRUCTURE NAME
	MOVEM	S1,.VLNAM(P1)		;AND SAVE IT

MNTA.5:	LOAD	S1,.VLPTR(P1),VL.NXT	;GET THE NEXT VOL ADDRESS
	SETZM	.VLPTR(P1)		;CLEAR THE OLD POINTERS
	MOVE	P1,S1			;GET THE NEXT VOL ADDRESS IN P1
	JUMPN	P1,MNTA.5		;ANOTHER,,RESET IT ALSO
	$RETT				;DONE,,RETURN
>
	SUBTTL	D$RMS - Routine to process the structure removed message

	;CALL:	M/ The Message address
	;
	;RET:	Through DSMACK (as if from PULSAR)

TOPS10<
D$RMS::	MOVE	S1,1(M)			;GET THE STRUCTURE NAME
	PUSHJ	P,FNDISK		;FIND ITS VOL BLOCK ADDRESS
	JUMPF	.RETT			;NOT THERE,,RETURN
	MOVX	S2,VL.REM		;GET THE /REMOVE FLAG BIT
	ANDCAM	S2,.VLFLG(S1)		;AND CLEAR IT
	SETZM	.MSFLG(M)		;CLEAR THE FLAG BITS (JUST IN CASE)
	PJRST	DSMACK			;REALLY CLEAN THINGS UP AND RETURN
>
	SUBTTL	DSMACK - ROUTINE TO PROCESS DISMOUNT ACKS FROM TAPE LABELER

	;CALL:	S1/ The VOL Address of the Primary VOL Block
	;
	;RET:	True Always

TOPS10	<
DSMACK:	PUSHJ	P,.SAVE4		;SAVE P1 - P4 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE VOL BLOCK ADDRESS
	LOAD	TF,.MSFLG(M),AK.NAK	;IS THIS A NAK ???
	JUMPN	TF,DSMA.4		;YES,,OH WELL !!!!
	PUSHJ	P,DSMOPR		;TELL OPR ITS GONE
	MOVE	S1,P1			;GET THE VOL BLK ADDR IN S1
	PUSHJ	P,I$STRD##		;PERFORM STRUCTURE ACCOUNTING

	;Here to clear mounted bits for the structure since its now offline

	MOVX	S1,%STAWT		;GET 'WAITING' VOLUME STATUS
	STORE	S1,.VLFLG(P1),VL.STA	;SET IT
	LOAD	P2,.VLOWN(P1),VL.CNT	;GET THE REQUEST COUNT
	JUMPE	P2,DSMA.1		;NO REQUESTORS,,SKIP THIS
	$TEXT	(<-1,,G$MSG>,<[Structure ^W/.VLNAM(P1)/ dismounted]^0>)
	PUSH	P,[-1]			;INDICATE END OF VSL QUEUE
	MOVNS	P2			;NEGATE THE COUNT
	MOVSS	P2			;MOVE RIGHT TO LEFT
	HRRI	P2,.VLVSL(P1)		;CREATE AOBJN AC TO VSL ADR LIST
	PUSH	P,0(P2)			;QUEUE UP A VSL ADDRESS
	AOBJN	P2,.-1			;CONTINUE FOR ALL REQUESTORS

	;Here to update the poor users status since the structure is now gone

DSMA.0:	POP	P,P3			;PICK OFF A VSL ADDRESS
	CAMN	P3,[-1]			;IS THIS THE LAST ???
	JRST	DSMA.1			;YES,,CONTINUE ON
	TXNN	P3,VL.ASN+VL.ASK	;DOES HE HAVE IT MOUNTED ?
	JRST	DSMA.0			;NO,,TRY NEXT
	LOAD	AP,.VSMDR(P3)		;SET UP POINTER TO MDR
	PUSHJ	P,USRNOT		;TELL THE USER IT'S GONE
	LOAD	P4,.MRCNT(AP),MR.CNT	;SAVE THE CURRENT REQUEST COUNT
	MOVE	S1,.VSFLG(P3)		;DID USER ALLOCATE THIS STR OR IS VSL
	TXNN	S1,VS.UAL!VS.CTL	; PART OF PSEUDO PROCESS ALLOCATION?
	JRST	DSMA.Z			;NO TO EITHER - RETURN RESOURCES
	TXO	S1,VS.UAL		;INSURE ALLOC BIT ON INCASE CTL ONLY
	TXZ	S1,VS.NMT		;CLEAR MOUNTED FOR PSEUDO PROCESS
	MOVEM	S1,.VSFLG(P3)		;UPDATE FLAG WORD
	PUSHJ	P,DSMALC		;RETURN ALLOCATED RESOURCES
	MOVE	S1,P3			;GET VSL ADDRESS
	PUSHJ	P,MNTVSL		;TRY TO RE-MOUNT IT
	JRST	DSMA.0			;ON TO THE NEXT VSL

DSMA.Z:	PUSHJ	P,DSMALC		;RETURN ALLOCATED RESOURCES
	JRST	DSMA.0			;GET THEM ALL
	MOVE	S1,P3			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,ALCVSL		;RETURN THE USERS RESOURCES
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE USERS NEW REQUEST COUNT
	CAMN	S1,P4			;WAS THE VSL DELETED ???
	ZERO	.VSFLG(P3),VS.ALC	;NO,,REMOUNT IT !!!
	SKIPN	S1			;STILL SOME REQUESTS LEFT,,SKIP
	PUSHJ	P,DELMDR		;ELSE DELETE THE MDR
	JRST	DSMA.0			;GET THEM ALL !!!

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

	;Here to unload the volumes if /REMOVE was specified

DSMA.1:	PUSH	P,P1			;SAVE THE VOL BLK ADDRESS FOR A SECOND
	LOAD	P2,.VLFLG(P1),VL.REM	;SAVE THE 'REMOVE' STRUCTURE STATUS

DSMA.2:	SKIPN	S1,.VLUCB(P1)		;GET THE UCB ADDRESS IN S1
	$STOP	(IVU,Invalid VOL/UCB Forward/Backchain Pointers)
	SETZM	.VLUCB(P1)		;ZAP VOL LINK TO UCB
	SETZM	.UCBVL(S1)		;ZAP UCB LINK TO VOL
	MOVE	S1,.UCBNM(S1)		;GET THE UNIT NAME
	SKIPE	P2			;IF 'REMOVING THE STRUCTURE',,THEN
	PUSHJ	P,UNLOAD		;   UNLOAD THE DEVICE
	LOAD	P1,.VLPTR(P1),VL.NXT	;GET THE NEXT VOLUME IN THE STRUCTURE
	JUMPN	P1,DSMA.2		;IF ANOTHER VOLUME,,GO PROCESS IT

	;Here to clear all LOCK status and events

DSMA.3:	MOVE	S1,0(P)			;GET THE VOL BLK ADRS BACK
	MOVE	S1,.VLNAM(S1)		;AND GET THE STR NAME
	PUSHJ	P,DMSLOK		;CLEAR ANY PENDING LOCKS, UNLOCKS
	MOVE	S1,0(P)			;GET THE VOL BLK ADRS BACK
	MOVE	S1,.VLNAM(S1)		;AND GET THE STR NAME
	PUSHJ	P,CLRELN		;CLEAR ANY LOCK NOTIFICATION, TOO
	POP	P,P1			;RESTORE THE VOL BLK ADDRESS
	ZERO	.VLFLG(P1),VL.REM	;CLEAR THE REMOVE BIT
	MOVX	S1,%UNLCK		;GET NORMAL UNLOCKED STATUS
	STORE	S1,.VLFLG(P1),VL.LCK	;SET NEW STATUS FOR NEXT MOUNT

	;Here to update the 'A' matrix if a permanent structure

	MOVE	S1,.VLNAM(P1)		;GET THE STRUCTURE NAME
	PUSHJ	P,D$SRSN		;GET THE STRUCTURE RESOURCE NUMBER
	IMULI	S1,AMALEN		;GET 'A' MATRIX OFFSET
	ADD	S1,AMATRX		;GET THE ENTRY ADDRESS
	LOAD	S2,.AMNAM(S1),AM.PRR	;GET THE PERMANENT RESOURCE BIT
	JUMPE	S2,DSMA.X		;NOT PERMANENT,,SKIP THIS
	MOVX	S2,AM.PRR		;GET THE PERMANENT STRUCTURE BIT
	ANDCAM	S2,.AMNAM(S1)		;CLEAR IT FOR THIS STRUCTURE
	MOVE	S1,.VLNAM(P1)		;GET THE STRUCTURE NAME
	PUSHJ	P,D$FCAT		;GET THE CATALOG ENTRY
	SKIPT				;IT MUST BE THERE !!!
	PUSHJ	P,S..SCE		;NO,,THATS AN ERROR
	MOVEI	S2,.CTVOL(S1)		;POINT THE THE CAT VOL LIST
	MOVE	S1,.CTCNT(S1)		;GET THE VOL COUNT
DSMA.A:	MOVE	T1,.CTRSN(S2)		;GET THE VOL RESOURCE NUMBER
	IMULI	T1,AMALEN		;GET THE ENTRY OFFSET
	ADD	T1,AMATRX		;GET THE ENTRY ADDRESS
	INCR	.AMCNT(T1),AM.AVA	;INCRIMENT THE AVAILABLE COUNT BY 1
	ADDI	S2,2			;POINT TO THE NEXT VOL BLK
	SOJG	S1,DSMA.A		;CONTINUE FOR ALL VOLUMES

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


	;Here when done to try to delete the VOL blocks

DSMA.X:	MOVE	S1,P1			;GET PRIMARY VOL ADDRESS IN S1
	PUSHJ	P,DELVOL		;TRY TO DELETE THE VOL BLOCKS
	$RETT				;RETURN

	;Here if the structure could not be dismounted

DSMA.4:	MOVX	S1,%STAMN		;GET STRUCTURE MOUNTED BIT
	STORE	S1,.VLFLG(P1),VL.STA	;RESET STATUS TO 'MOUNTED'
	$WTO	(<Can't dismount structure ^W/.VLNAM(P1)/>,,,<$WTFLG(WT.SJI)>)
	ZERO	.VLFLG(P1),VL.REM	;CLEAR ANY REMOVE BITS
	MOVE	S1,.VLUCB(P1)		;GET THE UCB ADDRESS
	PUSHJ	P,MATUNI		;CHECK FOR ANY MOUNTS
	$RETT				;RETURN

; Return the user's allocated resources
DSMALC:	MOVE	S1,P3			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,ALCVSL		;RETURN THE USERS RESOURCES
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE USERS NEW REQUEST COUNT
	CAMN	S1,P4			;WAS THE VSL DELETED ???
	ZERO	.VSFLG(P3),VS.ALC	;NO,,REMOUNT IT !!!
	SKIPN	S1			;STILL SOME REQUESTS LEFT,,SKIP
	PUSHJ	P,DELMDR		;ELSE DELETE THE MDR
	POPJ	P,			;RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	DSMOPR - Tell OPR about a structure just dismounted

;This routine informs the operator that a structure dismount
;	is complete, and on which units
;Call -
;	S1/	Addr of Primary VOL block (VOLs, UCBs still linked)
;Returns -
;	True, after WTOing the OPR

TOPS10<
DSMOPR:
	$SAVE	<P1>
	MOVE	P1,S1			;SAVE ADR OF PRIMARY VOL BLOCK
	MOVE	TF,[POINT 7,G$MSG]	;AIM AT THE BUFFER SPACE
	MOVEM	TF,MDBPTR		;SET THE POINTER
DSMO.1:	SKIPN	S2,.VLUCB(S1)		;GET ADRS OF THIS VOLUME'S UNIT BLK
	PUSHJ	P,S..IVU		;GONG, CAN'T GET HERE
	$TEXT	(MDADBP,<^W/.UCBNM(S2)/,^A>)
	LOAD	S1,.VLPTR(S1),VL.NXT	;GET POINTER TO NEXT VOL
	JUMPN	S1,DSMO.1		;ANOTHER,,CONTINUE

DSMO.2:	SETZ	S1,			;MAKE A ZERO
	DPB	S1,MDBPTR		;AND TERMINATE THE TEXT
	SKIPE	.VLPTR(P1)		;WAS THERE MORE THAN ONE?
	MOVE	S1,[ASCII/s/]		;YES,,PLURALIZE IT..
	$WTO	(<Structure ^W/.VLNAM(P1)/ dismounted>,<  From unit^T/S1/: ^T/G$MSG/>,,<$WTFLG(WT.SJI)>)
	$RETT
>;END TOPS10
	SUBTTL	CATACK - ROUTINE TO PROCESS CATALOG ACKS FROM TAPE LABELER

	;This routine is run when a volume set cannot be located in
	; the volume set catalog
	;
	;CALL:	S1/ The VOL Address of the Primary VOL Block
	;
	;RET:	True Always

TOPS10	<
CATACK:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	SKIPG	S1,.MSCOD(M)		;GET THE ACK CODE
	$RETT				;INTERNAL REQUEST,,RETURN NOW
	PUSHJ	P,FNDVSL		;FIND THE VSL
	JUMPF	.RETT			;NOT THERE,,JUST RETURN
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	MOVE	AP,.VSMDR(P1)		;SETUP THE MDR ADDRESS
	$TEXT	(<-1,,G$MSG>,<Structure ^T/.VSVSN(P1)/ not in System Catalog^M^J^0>)
	SETOM	ERRACK			;THIS IS AN ERROR ACK
	PUSHJ	P,USRNOT		;ACK THE USER
	MOVE	S1,P1			;GET THE VSL ADDRESS BACK
	PUSHJ	P,REMOVE		;GO AND DELETE THIS VSL & RETRY MOUNT
	$RETT				;RETURN

>
	SUBTTL	ASLACK - ROUTINE TO PROCESS ACKS FOR ADDING STR TO A SEARCH LIST

	;CALL:	S1/ The VOL Address of the Primary VOL Block
	;
	;RET:	True Always

TOPS10	<
ASLACK:	PUSHJ	P,.SAVE3		;SAVE P1 & P2 FOR A MINUTE
	MOVE	P3,S1			;SAVE THE VOL ADDRESS
	MOVE	S1,.MSCOD(M)		;GET THE ACK CODE (REQUEST ID)
	PUSHJ	P,FNDVSL		;FIND THE USER.
	JUMPF	.RETT			;NOT THERE,,OH WELL...
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	SETZM	P2			;NO ADDITIONAL TEXT YET
	MOVX	S1,.OMTXT		;GET SECONDARY TEXT BLOCK
	PUSHJ	P,A$FNDB##		;FIND IT
	SKIPF				;SKIP IN NOT THERE
	MOVE	P2,S1			;ELSE SAVE THE TEXT ADDRESS
	JUMPE	P2,ASLA.1		;NO SECONDARY TEXT,,SKIP THIS
	LOAD	S1,-ARG.DA(P2),AR.LEN	;GET THE BLOCK LENGTH
	PUSHJ	P,M%GMEM		;GET SOME MEMORY
	STORE	S1,.VSTXT(P1),VS.LEN	;SAVE THE BLOCK LENGTH
	STORE	S2,.VSTXT(P1),VS.ADR	;SAVE THE BLOCK ADDRESS
	ADD	S1,S2			;POINT TO THE END OF THE BLOCK
	HRL	S2,P2			;GET SOURCE,,DESTINATION ADDRESS
	BLT	S2,-1(S1)		;COPY THE TEXT AND SAVE IT
ASLA.1:	MOVX	S1,AK.NAK		;GET A BIT
	TDNE	S1,.MSFLG(M)		;WAS IT A NAK?
	JRST	ASLA.2			;YES
	$COUNT	(USTM)			;# of user structure mounts
	MOVE	S1,P1			;GET VSL BLOCK ADDRESS
	MOVE	S2,P3			;GET VOL BLOCK ADDRESS
	PUSHJ	P,AASCLR		;CLEAR VL.AAS
	MOVE	S1,P1			;GET THE VSL ADDRESS
	PUSHJ	P,SETOWN		;SAY THIS GUY OWNS THE UNIT
	MOVE	S1,P1			;GET THE VSL ADDRESS
	PUSHJ	P,I$SMNT##		;PERFORM STRUCTURE ACCOUNTING
	MOVE	S1,P1			;GET THE VSL ADDRESS
	PUSHJ	P,ACKUSR		;TELL THE USER
	$RETT				;AND RETURN

ASLA.2:	SKIPN	P2			;ANY ADDITIONAL TEXT ???
	MOVEI	P2,[0]			;NO,,POINT TO A NULL BLOCK
	$TEXT	(<-1,,G$MSG>,<Can't mount structure ^T/.VSVSN(P1)/^M^J^T/0(P2)/^M^J^0>)
	SETOM	ERRACK			;INDICATE THIS IS AN ERROR ACK
	PUSHJ	P,USRNOT		;NOTIFY THE USER
	MOVE	S1,P1			;GET THE VSL ADDRESS BACK
	PUSHJ	P,ALCVSL		;RETURN THIS VSL TO THE ALLOCATION POOL
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE USERS REQUEST COUNT
	JUMPE	S1,DELMDR		;NOTHING LEFT,,DELETE THE MDR
	$RETT				;AND RETURN
>
	SUBTTL	RMSACK - ROUTINE TO PROCESS 'REMOVE STRUCTURE' ACKS

	;CALL:	S1/ The VOL Address of the Primary VOL Block
	;
	;RET:	True Always

TOPS10<
RMSACK:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2 FOR A SECOND
	MOVE	P1,S1			;SAVE THE VOL BLOCK ADDRESS
	MOVE	S1,.MSCOD(M)		;GET THE ACK CODE (REQUEST ID)
	PUSHJ	P,FNDVSL		;FIND THE VSL
	JUMPF	RMSA.1			;NOT THERE,,GO CHECK OUT THE STR
	PUSH	P,S1			;SAVE THE VSL ADDRESS FOR A SECOND
	MOVX	S1,.OMTXT		;GET THE REASON BLOCK
	PUSHJ	P,A$FNDB##		;FIND IT
	SKIPT				;NOT THERE ???
	MOVEI	S1,[0]			;NOT THERE,,POINT TO NULL WORD
	MOVE	P2,S1			;GET TEXT ADDRESS
	LOAD	TF,.MSFLG(M),AK.NAK	;IS THIS A NAK ???
	JUMPN	TF,RMSA.2		;YES,,OH WELL !!!!
	MOVE	S1,(P)			;GET THE VSL ADDRESS BACK
	$TEXT	(<-1,,G$MSG>,<^T/(P2)/[Structure ^T/.VSVSN(S1)/ dismounted]^M^J^0>)
	PUSHJ	P,I$SDSM##		;PERFORM STRUCTURE ACCOUNTING
	MOVE	S1,.MRFLG(AP)		;GET WAIT/NOTIFY/ACK FLAGS ETC.
	TXNE	S1,MR.WAT		;WAITING?
	TXO	S1,MR.ACK		;THEN WE WANT TO ACK VIA IPCF
	MOVEM	S1,.MRFLG(AP)		;RESTORE FLAG WORD
	MOVX	S1,MR.DMO		;GET DISMOUNT BIT
	IORM	S1,.MRFLG(AP)		;LITE IT SO USRNOT DOES PRETTY THINGS
	PUSHJ	P,USRNOT		;NOTIFY THE USER
	MOVE	S1,0(P)			;GET THE VSL ADDRESS BACK
	LOAD	S2,.VSFLG(S1),VS.REM	;GET THE /REMOVE STR FLAG BIT
	SKIPE	S2			;DID USER SPECIFY /REMOVE ???
	PUSHJ	P,TELREM		;YES,,TELL THE OPERATOR
	POP	P,S1			;RESTORE THE VSL ADDRESS
	PUSHJ	P,ALCVSL		;DEALLOCATE IF WE CAN
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE VSL REQUEST COUNT
	SKIPN	S1			;ANY MORE REQUESTS ???
	PUSHJ	P,DELMDR		;NO,,DELETE THIS MDR

RMSA.1:	MOVE	S1,P1			;GET THE VOL BLOCK ADDR BACK
	PUSHJ	P,CHKSTR		;CHECK FOR STRUCTURE AVAILABILITY
	$RETT				;THEN RETURN

RMSA.2:	POP	P,S1			;RESTORE THE VSL ADDRESS
	$TEXT	(<-1,,G$MSG>,<Can't dismount structure ^T/.VSVSN(S1)/^M^J^T/(P2)/^0>)
	SETOM	ERRACK			;IS THIS AN ERROR
	PUSHJ	P,USRNOT		;SEND IT OFF TO THE USER
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	D$ALIAS - ROUTINE TO MOUNT A STRUCTURE WITH AN ALIAS

	;CALL:	M/ The Mount Message Address (From ORION)
	;
	;RET:	True Always

TOPS10<
D$ALIAS: PUSHJ	P,.SAVE2		;SAVE P1 & P2 FOR A SECOND
	MOVX	S1,.STRDV		;GET STRUCTURE NAME BLOCK TYPE
	PUSHJ	P,A$FNDB##		;LOCATE IT IN THE MESSAGE
	JUMPF	E$IMO##			;NOT THERE,,THATS AN ERROR
	HRLI	S1,(POINT 7,)		;MAKE A POINTER
	$CALL	S%SIXB			;CONVERT TO SIXBIT
	MOVE	P1,S2			;GET THE STRUCTURE NAME
	MOVEM	P1,MDAOBJ+OBJ.UN	;SAVE IT IN THE OBJECT BLOCK
	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JRST	ALIA.2			;SKIP THE FIRST TIME THROUGH

ALIA.1:	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT ENTRY
ALIA.2:	JUMPF	ALIA.9			;NO MORE,,THATS AN ERROR
	SKIPE	S1,.VLUCB(S2)		;VOLUME MUST BE MOUNTED !!!
	CAME	P1,.VLNAM(S2)		;AND STRUCTURE NAMES MUST MATCH !!!
	JRST	ALIA.1			;NO,,TRY NEXT VOLUME
	LOAD	S1,.UCBST(S1),UC.DVT	;GET THE DEVICE TYPE
	CAXE	S1,%DISK		;IS IT A STRUCTURE ???
	JRST	ALIA.1			;NO,,TRY NEXT VOLUME
	LOAD	S1,.VLFLG(S2),VL.STA	;GET THE VOLUME STATUS
	CAXE	S1,%STAWT		;IS IT WAITING ???
	JRST	ALIA.1			;NO,,TRY NEXT VOLUME

	;Here to process the primary vol block we found

	MOVE	P1,S2			;SAVE THE PRIMARY VOL BLOCK ADDRESS

ALIA.3:	SKIPN	S1,.VLNXT(S2)		;ANY 'NEXT' VOLUME FOR THIS STRUCTURE ??
	JRST	ALIA.4			;NO,,LETERRIP !!!
	PUSHJ	P,FNDDSK		;YES,,GO FIND IT IN OUR DATA BASE
	JUMPF	ALIA.9			;NOT FOUND,,THATS AN ERROR
	SKIPN	.VLPTR(S1)		;ANY POINTERS SET UP ???
	JRST	ALIA.9			;YES,,THATS AN ERROR
	MOVE	S2,S1			;OK,,SET POINTER TO THIS VOLUME
	JRST	ALIA.3			;AND CHECK OUT THIS VOLUME

ALIA.4:	MOVE	P2,.VLNAM(P1)		;DEFAULT TO THE STRUCTURE NAME
	MOVX	S1,.STALS		;GET THE ALIAS BLOCK TYPE
	PUSHJ	P,A$FNDB##		;FIND IT IN THE MESSAGE
	JUMPF	ALIA.5			;NOT THERE,,JUST MOUNT IT

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

	HRLI	S1,(POINT 7,)		;MAKE A POINTER TO IT
	$CALL	S%SIXB			;CONVERT IT
	MOVE	P2,S2			;SAVE THE ALIAS NAME
	MOVE	S1,P2			;GET THE ALIAS NAME IN S1
	PUSHJ	P,I$VDEV##		;VALIDATE THE DEVICE NAME
	  JUMPT	ALIA.7			;NO GOOD IF DEVICE ALREADY EXISTS

ALIA.5:	MOVE	S1,P2			;GET THE ALIAS NAME
	PUSHJ	P,D$FCAT		;FIND THE CATALOG ENTRY
	JUMPF	ALIA.6			;ITS OK IF WE CAN'T
	MOVE	S1,CATLEN+.CTVID(S1)	;GET THE PRIMARY VOL NAME
	PUSHJ	P,FNDDSK		;FIND ITS VOL BLOCK
	JUMPF	ALIA.6			;DOESN'T HAVE TO BE THERE
	CAMN	S1,P1			;SAME AS THE ONE WE'RE MOUNTING?
	JRST	ALIA.6			;YES
	LOAD	S2,.VLFLG(S1),VL.STA	;GET STR STATUS
	CAIN	S2,%STAMN		;MOUNTED?
	JRST	ALIA.6			;THEN NOTHING TO DO
	MOVEI	S2,.OTMNT		;GET OBJECT TYPE MOUNT
	MOVEM	S2,CATOBJ+OBJ.TY	;SAVE IT
	MOVE	S2,.VLUCB(S1)		;GET UCB ADDR
	MOVE	S2,.UCBNM(S2)		;GET UNIT NAME
	MOVEM	S2,CATOBJ+OBJ.UN	;SAVE IN OBJECT BLOCK
	SETZM	CATOBJ+OBJ.ND		;NO NODE INFO
	$WTO	(<Deleting duplicate volume>,<Unit ^W/.VLVID(S1)/ for structure ^W/.VLNAM(S1)/>,CATOBJ,<$WTFLG(WT.SJI)>)
	PUSHJ	P,DELVOL		;DELETE THE OLD ONE

ALIA.6:	EXCH	P2,.VLNAM(P1)		;SWAP ALIAS NAME WITH OLD NAME
	MOVE	S1,P1			;GET THE VOLUME BLOCK ADDRESS
	PUSHJ	P,D$GENC		;GENERATE A CATALOG ENTRY
	JUMPF	ALIA.8			;CAN'T
	LOAD	S1,.OFLAG(M),.MTWLK	;GET WRITE LOCKED BIT
	MOVEM	S1,WRTLCK		;SAVE IT
	MOVE	S1,P1			;GET VOL BLOCK ADDRESS
	MOVE	S2,.VLNAM(P1)		;GET STR NAME
	PUSHJ	P,SNDBLD		;BUILD THE STRUCTURE
	$RETT				;RETURN

ALIA.7:	MOVEI	S1,[ITEXT (<Device ^W/P2/ already exists>)]
	JRST	ALIA.E			;ACK THE ERROR AND RETURN
ALIA.8:	EXCH	P2,.VLNAM(P1)		;RESTORE ORIGINAL STR NAME
	SKIPA	S1,[EXP [ITEXT (<^W/P2/ has outstanding allocations>)]] 
ALIA.9:	MOVEI	S1,[ITEXT (<All required volumes are not spinning>)]
ALIA.E:	$ACK	(<Invalid mount request>,<^I/(S1)/>,MDAOBJ,.MSCOD(M))
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	CHKSTR - ROUTINE TO CHECK FOR STRUCTURE AVAILABILITY

	;CALL:	S1/ The VOL Address of the Primary VOL Block
	;
	;RET:	True Always

TOPS10<
CHKSTR:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	$SAVE	AP			;SAVE AP ALSO
	MOVE	P1,S1			;SAVE THE VOL BLOCK ADDRESS
	LOAD	S1,.VLFLG(P1),VL.STA	;GET THE STRUCTURE STATUS
	LOAD	S2,.VLFLG(P1),VL.LCK	;GET THE STRUCTURE LOCK CODE
	CAXN	S1,%STAMN		;IS THE STRUCTURE MOUNTED ???
	CAXE	S2,%LOCKD		;   AND IS IT LOCKED ???
	JRST	CHKS.1			;NO,,TRY REASSIGNMENT
	MOVE	S1,P1			;GET THE VOL BLOCK ADDRESS BACK
	PUSHJ	P,FNDOWN		;ANYONE STILL OWN IT ???
	JUMPT	.RETT			;YES,,RETURN NOW
	MOVE	S1,.VLNAM(P1)		;GET THE STRUCTURE NAME
	MOVEM	S1,MDAOBJ+OBJ.UN	;SAVE IT
	$WTO	(<This locked structure has a zero mount count^T/BELLS/>,,MDAOBJ)
	MOVE	S1,P1			;GET THE VOL BLK ADDR IN S1
	SETZ	S2,			;NO DISMOUNT FLAGS
	PUSHJ	P,SNDDSM		;DISMOUNT THE STRUCTURE
	$RETT				;RETURN

CHKS.1:	CAXE	S1,%STAMN		;ARE WE MOUNTED AT LEAST ??
	$RETT				;NO,,RETURN
	MOVE	S1,.VLUCB(P1)		;YES,,GET THE UCB ADDRESS 
	PUSHJ	P,MATUNI		;GO TRY TO REASSIGN THE UNIT
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	D$LOCK - PROCESS LOCK AND UNLOCK MESSAGES

	;CALL:	M/ Addrs of incoming LOCK and UNLOCK message
	;
	;RET:	True, with some of the VOL database changed

TOPS10<
D$LOCK:	TDZA	S1,S1			;FLAG THE LOCK ENTRY POINT
D$ULOK:	MOVEI	S1,1			;FLAG UNLOCK ENTRY
	$SAVE	<P1,P2>			;SAVE P1 AND P2
	MOVE	P1,S1			;SAVE THE ENTRY FLAG
	MOVX	S1,.STRDV		;BLOCK TYPE - STRUCTURE NAME
	PUSHJ	P,A$FNDB##		;FIND OUT WHAT STR OPR IS TALKING ABOUT
	JUMPF	E$IMO##			;NOT THERE, TOO BAD
	HRROI	S1,0(S1)		;AIM AT THE STR NAME
	$CALL	S%SIXB			;CONVERT IT TO 6BIT
	MOVE	S1,S2			;MOVE THE STR NAME INTO PLACE
	PUSHJ	P,FNDISK		;FIND THE VOL BLOCK FOR THAT STR
	JUMPF	E$NSD##			;CAN'T, THAT'S AN ERROR
	MOVE	P2,S1			;SAVE ADDR OF VOL BLOCK
	LOAD	S1,.VLFLG(P2),VL.LCK	;GET THE LOCK CODE
	MOVEI	S2,[ASCIZ/not/]		;TRYING UNLOCK BUT STR NOT LOCKED !!!
	CAXN	S1,%UNLCK		;IS IT UNLOCKED?
	JUMPN	P1,LOCK.1		;YES, DON'T ALLOW ANOTHER UNLOCK
	MOVEI	S2,[ASCIZ/already/]	;ALREADY LOCKED AND TRYING AGAIN !!!
	CAXN	S1,%LOCKD		;IS IT LOCKED?
	JUMPE	P1,LOCK.1		;YES, DON'T ALLOW ANOTHER LOCK

	MOVX	S1,VL.REM		;ON A LOCK
	SKIPN	P1			;   DEFAULT TO UNLOADING
	IORM	S1,.VLFLG(P2)		;      THE STRUCTURE
	LOAD	S2,.OFLAG(M),LC.NUL	;GET THE /NOUNLOAD BIT
	SKIPN	P1			;ON AN UNLOCK
	SKIPE	S2			;   OR A LOCK /NOUNLOAD
	ANDCAM	S1,.VLFLG(P2)		;      DON'T UNLOAD THE STRUCTURE
	LOAD	S1,.VLFLG(P2),VL.LCK	;GET THE LOCK CODE BACK

	CAXN	S1,%LOCKP		;IS A LOCK PENDING?
	JUMPN	P1,CLRPND		;YES, 'UNLOCK' CLEARS THE LOCK REQUEST
	CAXN	S1,%ULCKP		;IS AN UNLOCK PENDING?
	JUMPE	P1,CLRPND		;YES, 'LOCK' CLEARS THE UNLOCK REQUEST
	CAXE	S1,%LOCKP		;WAS IT PENDING A LOCK
	CAXN	S1,%UNLCK		;  OR AN UNLOCK?
	SKIPA				;ONE OF THOSE, GOT SOME WORK TO DO
	JRST	LOCK.0			;NO PENDING REQUEST, CONTINUE
	LOAD	S1,.VLNAM(P2)		;GET BACK THE STR NAME
	PUSHJ	P,DMSLOK		;PENDING EITHER, CANCEL IT
	LOAD	S1,.VLNAM(P2)		;GET BACK THE STR NAME
	PUSHJ	P,CLRELN		;CLEAR THE EVENT NOTIFICATION, TOO

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

	;Now we've ruled out the funny state transitions

LOCK.0:	MOVX	S1,.ORTIM		;BLOCK TYPE FOR DATE/TIME ARGUMENT
	PUSHJ	P,A$FNDB##		;GET THAT BLOCK
	SKIPT				;IS THERE ONE?
	SKIPA	S1,G$NOW##		;NO, ASSUME ACTION NOW
	MOVE	S1,0(S1)		;YES, GET THE LOCK TIME
	CAMGE	S1,G$NOW##		;IS TIME IN THE FUTURE?
	MOVE	S1,G$NOW##		;NO, MAKE IT THE PRESENT
	MOVX	S2,%LOCKP		;SAY PENDING
	SKIPE	P1			;IS IT A LOCK?
	MOVX	S2,%ULCKP		;NO, SAY UNLOCK PENDING
	STORE	S2,.VLFLG(P2),VL.LCK	;SAVE THE STATUS
	MOVEM	S1,.VLLTM(P2)		;AND NOTE THE TIME AT WHICH IT HAPPENED
	CAMN	S1,G$NOW##		;IS IT TO HAPPEN NOW?
	PJRST	LOKSTR			;YES, GO DO IT!
	$ACK	(<Structure ^W/.VLNAM(P2)/>,<^W/LCKTB1(P1)/ set for ^H/.VLLTM(P2)/>,,.MSCOD(M))
	MOVX	S2,INSVL.(%EVLCK,EV.TYP) ;GET EVENT TYPE OF LOCK
	MOVEM	S2,TMPVSL+.EVTYP	;SAVE IN TEMP BLOCK
	MOVEM	S1,TMPVSL+.EVUDT	;AND SAVE THE TIME TO WAKE UP
	MOVEI	S1,LOCTIM		;ROUTINE TO CALL AT THAT TIME
	MOVEM	S1,TMPVSL+.EVRTN	;SAVE THAT
	LOAD	S1,.VLNAM(P2)		;GET THE STR NAME
	MOVEM	S1,TMPVSL+.EVMSZ	;SAVE THAT, TOO
	MOVEI	S1,.EVMSZ+1		;MINIMAL BLOCK, WITH 1 DATA WORD
	MOVEI	S2,TMPVSL		;THERE'S THE ARG BLOCK
	PUSHJ	P,S$EVENT##		;CALL ME BACK IN A MINUTE OR AN HOUR
	JUMPN	P1,.RETT		;IF AN UNLOCK, THAT'S ALL
	MOVE	S1,P2			;GET THE VOL BLK ADRS
	PJRST	LOCN.I			;NOTIFY THE USERS

LOCK.1:	$ACK	(<Structure ^W/.VLNAM(P2)/ is ^T/0(S2)/ locked>,,,.MSCOD(M))
	MOVE	S1,P2			;GET THE VOL BLK ADDR IN S1
	PUSHJ	P,CHKSTR		;CHECK THE MOUNT STATUS
	$RETT				;TELL OPR HE IS IN ERROR AND RETURN

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

;Here to clear a pending lock or unlock and set the
;	state of the vol block back to unlocked or locked, respectively
;	P1/	0 for LOCK, -1 for UNLOCK
;	P2/	VOL BLK adrs

CLRPND:	MOVX	S2,%LOCKD		;ASSUME CANCELLING AN UNLOCK
	SKIPE	P1			;OPR SAID LOCK?
	MOVX	S2,%UNLCK		;NO, CANCELLING A LOCK
	STORE	S2,.VLFLG(P2),VL.LCK	;SAVE IN THE VOL BLOCK
	ZERO	.VLLTM(P2)		;NO MORE LOCK TIME
	$ACK(<Structure ^W/.VLNAM(P2)/ pending ^W/LCKTB2(P1)/ canceled>,,,.MSCOD(M))
	MOVE	S1,.VLNAM(P2)		;GET THE STRUCTURE NAME
	PUSHJ	P,DMSLOK		;REMOVE ALL THE PENDING TIMERS
	MOVE	S1,.VLNAM(P2)		;GET THE STRUCTURE NAME
	PUSHJ	P,CLRELN		;REMOVE THE PENDING NOTIFICATION TIMER
	MOVE	S1,P2			;GET THEN PRIMARY VOL BLOCK
	MOVEI	S2,[ITEXT(<LOCK for structure ^W/.VLNAM(P2)/ canceled>)]
	PUSHJ	P,NSTUSR		;TELL THE USERS THE GOOD NEWS
	$RETT
	SUBTTL	TIMER ROUTINES FOR LOCK AND UNLOCK

;These routines are called when the lock or unlock timer
;	goes off.  The scheduler calls here as the action routine
;	for the timer.
;	S1/	Event block adrs

LOCTIM:	$SAVE	<P1>
	LOAD	S1,.EVMSZ(S1)		;GET THE STRUCTURE NAME
	PUSHJ	P,FNDISK		;GET THE VOL BLOCK
	JUMPF	.RETT			;STR WENT AWAY. STRANGE.
	MOVE	P1,S1			;SAVE THE ADRS OF THE BLOCK
	LOAD	S1,.VLFLG(P1),VL.LCK	;GET THE LOCK STATE
	CAXN	S1,%LOCKP		;LOCK PENDING TIMER GONE OFF?
	JRST	LOKS.1			;YES, LOCK IT UP!
	CAXN	S1,%ULCKP		;UNLOCK PENDING TIMER?
	JRST	UNLOCK			;YES, UNLOCK IT
	$RETT				;WIERD,,TIMER WITH NOTHING PENDING

	;Here to lock or unlock a structure and inform the operator
	;
	;CALL:	P1/	0 for LOCK, -1 for UNLOCK
	;	P2/	VOL block adrs

LOKSTR:	EXCH	P1,P2			;SWAP VOL BLK ADRS AND LOCK/UNLOCK FLAG
	JUMPN	P2,UNLOCK		;GO  UNLOCK THE STR
LOKS.1:	LOAD	S1,.VLNAM(P1)		;GET THE STR NAME BACK
	PUSHJ	P,I$LOCK##		;LOCK IT UP
	JUMPF	[$WTO(<Can't LOCK structure ^W/.VLNAM(P1)/>,,,$WTFLG(WT.SJI))
		 JRST	UNLC.2]		;AND CLEAR THE STATUS
	$WTO	(<Structure ^W/.VLNAM(P1)/ locked>,,,$WTFLG(WT.SJI))
	MOVE	S1,.VLNAM(P1)		;GET THE STR NAME
	PUSHJ	P,CLRELN		;CLEAR ANY OUTSTANDING LOCK NOTIFY EVENTS
					;DON'T CLEAR LOCK TIMER EVENTS,
					;SINCE WE MAY BE HERE ON ONE OF THOSE
					;EVENTS, AND THE SERVICE ROUTINE EXPECTS
					;TO CLEAN IT UP
	MOVE	S1,P1			;AIM AT THE PRIMARY VOL BLOCK
	MOVEI	S2,[ITEXT(<Structure ^W/.VLNAM(P1)/ locked>)]
	PUSHJ	P,NSTUSR		;TELL ALL THE USERS THE BAD NEWS
LOKS.2:	MOVX	S1,%LOCKD		;GET LOCKED STATUS
	STORE	S1,.VLFLG(P1),VL.LCK	;SAVE THE LOCK STATUS
	SETZM	.VLLTM(P1)		;NO TIME, EITHER
	MOVE	S1,P1			;GET THE VOL BLK ADDR IN S1
	PUSHJ	P,CHKSTR		;CHECK FOR OTHER USERS
	$RETT				;RETURN

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

	;Here if it is an UNLOCK command. P1/ VOL block adrs

UNLOCK:	LOAD	S1,.VLNAM(P1)		;GET THE STR NAME BACK
	PUSHJ	P,I$UNLK##		;CLEAR THE LOCK
	JUMPT	UNLC.1			;WINS, TELL OPR
	$WTO	(<Can't UNLOCK structure ^W/.VLNAM(P1)/>,,,$WTFLG(WT.SJI))
	PJRST	LOKS.2			;AND SET IT STILL LOCKED

UNLC.1:	MOVEI	S2,[ITEXT(<Structure ^W/.VLNAM(P1)/ unlocked>)]
	$WTO	(<^I/0(S2)/>,,,$WTFLG(WT.SJI)) ;TELL THE OPERATOR
	MOVE	S1,P1			;GET THE VOL ADDRESS IN S1
	PUSHJ	P,NSTUSR		;TELL THE USERS ALSO

UNLC.2:	MOVX	S1,%UNLCK		;GET UNLOCKED CODE
	STORE	S1,.VLFLG(P1),VL.LCK	;SET THE FIELD
	SETZM	.VLLTM(P1)		;NO TIME, EITHER
	MOVE	S1,P1			;GET THE VOL ADDRESS IN S1
	SKIPE	S1,.VLUCB(P1)		;GET THE UCB ADDRESS (SHOULD NOT SKIP)
	PUSHJ	P,MATUNI		;TRY TO MOUNT THE VOLUME
	$RETT				;RETURN IN ANY CASE
>;END TOPS10
	SUBTTL	LOCNOT - Notify users (countdown) of pending locks

;This routine is called when an event timer for a structure lock goes off
; It finds the structure data base, and notifies all remaining users
; of that structure of the time remaining on the str.
; If there are some left, then another entry is put into the timer queue
; for the next countdown time to notify.
;Call -
;	S1/	Adrs of Event block for the countdown notification

TOPS10<
DEFINE	UDTMIN(N),<<<N>*^O1000000>/^D<24*60>> ;UDT REPRESENTATION OF N MINUTES

	MAXLMN==^D7		;MAX EXP OF 2 AT WHICH TO NOTIFY USERS

LMNTAB:	UDTMIN	(^D128)		;2**8 = TOO BIG AN ELEMENT, SAY THE MAX
	UDTMIN	(^D1)		;2**0 = 1 MINUTE
	UDTMIN	(^D2)		;2**1 = 2 MINUTES
	UDTMIN	(^D4)		;2**2 = 4 MINUTES
	UDTMIN	(^D8)		;2**3 = 8 MINUTES
	UDTMIN	(^D16)		;2**4 = 16 MINUTES
	UDTMIN	(^D32)		;2**5 = 32 MINUTES
	UDTMIN	(^D64)		;2**6 = 64 MINUTES


LOCNOT:	MOVE	S1,.EVMSZ+0(S1)		;GET THE STRUCTURE NAME
	PUSHJ	P,FNDISK		;FIND THE PRIMARY VOLUME BLOCK
	JUMPF	.RETT			;NOT THERE, QUIT, NO RE-RENTRY TO TIMER QUEUE

	;Internal entry with S1/  Vol block adrs

LOCN.I:	$SAVE	<P1,P2,P3,P4>		;SOME WORK SPACE
	MOVE	P1,S1			;SAVE PRI VOL BLK ADRS
	MOVE	P2,.VLLTM(P1)		;GET T=0
	SUB	P2,G$NOW##		;FIGURE UDT LEFT IN THIS TIMER
	JUMPLE	P2,.RETT		;WE'RE HERE TOO LATE, GET OUT
	MOVE	P3,P2			;NO, GET UDT LEFT
	IDIVI	P3,UDTMIN(1)		;CONVERT TO MINUTES LEFT
	MOVEI	S2,[ITEXT(<Structure ^W/.VLNAM(P1)/ will be locked in ^D/P3/ minutes>)]
	TLNE	P2,-1			;MORE THAN A DAY LEFT?
	MOVEI	S2,[ITEXT(<Structure ^W/.VLNAM(P1)/ will be locked at ^H/.VLLTM(P1)/>)]
	PUSHJ	P,NSTUSR		;NOTIFY ALL USERS OF THE STRUCTURE
	JFFO	P3,.+2			;FIND ORDER OF MAGNITUDE OF TIME LEFT
	$RETT				;?? CAN'T GET HERE, QUIT
	SUBI	P4,^D35			;CONVERT TO  -35 TO 0  RANGE
	JUMPE	P4,.RETT		;LESS THAN A MINUTE,, QUIT
	MOVNS	P4			;TO 0 TO 35
	CAIL	P4,MAXLMN		;BIGGER THAN MAX LOG MINUTES?
	SETZ	P4,			;YES, JUST SAY THE MOST WE KNOW
	MOVE	S2,LMNTAB(P4)		;GET THEN NUMBER OF MINUTES TO WAIT
	ADD	S2,G$NOW##		;SET THAT AS NEXT NOTIFY TIME
	MOVE	S1,.VLNAM(P1)		;GET THE STR NAME AGAIN
	PJRST	LNEVENT			;MAKE A NEW LOCK NOTIFY EVENT BLOCK
> ;END TOPS10 CONDITIONAL
	SUBTTL	CLEAR LOCKS ON STRUCTURE DISMOUNT

;This routine is called when a structure is dismounted, so that
;	Any pending event blocks can be cleaned up.
;	If we don't clean 'em up, and another structure gets mounted
;	before the timer goes off, then that (new) structure
;	will bear the brunt of the OPRs old LOCK or UNLOCK.
;	Also, any notify request blocks for this structure are cleaned up.

;Call -
;	S1/	Structure name just dismounted
;Returns -
;	TRUE (always)

TOPS10<
CLRELN:	MOVEI	S2,%EVNLC		;GET EVENT TYPE - LOCK NOTIFY
	SKIPA				;ENTER THE COMMON CODE
DMSLOK:	MOVEI	S2,%EVLCK		;GET EVENT TYPE - PENDING LOCK

	$SAVE	<P1,P2>
	DMOVE	P1,S1			;PRESERVE THE STR NAME, EVENT TYPE
	MOVE	S1,G$EVENT##		;GET THE LIST HANDLE
	$CALL	L%FIRST			;GET THE FIRST GUY
DSML.1:	JUMPF	.RETT			;NONE THERE, OH WELL
	LOAD	TF,.EVTYP(S2),EV.TYP	;GET THE EVENT TYPE
	CAMN	TF,P2			;IS IT THE RIGHT TYPE OF EVENT?
	CAME	P1,.EVMSZ(S2)		;YES, IS THIS THE STR BEING DISMOUNTED?
	SKIPA				;NOT A LOCK OR WRONG STRUCTURE,,SKIP
	$CALL	L%DENT			;LOCK OR NOTIFY FOR THIS STR, DELETE IT
	PUSHJ	P,L%NEXT		;EITHER WAY,,GET THE NEXT ENTRY
	JRST	DSML.1			;AND CHECK IT OUT
> ;END TOPS10 CONDITIONAL
	SUBTTL	LNEVENT - Set up a Lock notification event

;This routine is called whenever someone wants to put up a lock
; notification event for a particular structure.
; LOCNOT will be called at the specified time with
; the adrs of the lock notication event block.
; Call -
;	S1/	SIXBIT	 structure name
;	S2/	UDT at which to be notified
;Returns
;	TRUE	 (ALWAYS)

TOPS10<
LNEVENT: MOVEM	S1,TMPVSL+.EVMSZ+0	;SAVE STR NAME AS FIRST (ONLY) DATA ARG
	MOVEM	S2,TMPVSL+.EVUDT	;SAVE WAKE-UP TIME
	MOVX	S1,INSVL.(%EVNLC,EV.TYP) ;EVENT TYPE
	MOVEM	S1,TMPVSL+.EVTYP	;NO FLAGS,
	MOVEI	S1,LOCNOT		;ROUTINE TO RUN AT THAT TIME
	MOVEM	S1,TMPVSL+.EVRTN	;SAVE THAT TOO
	MOVEI	S1,.EVMSZ+1		;MINIMAL EVENT BLOCK, WITH 1 DATUM
	MOVEI	S2,TMPVSL		;THERE'S THE BLOCK
	PJRST	S$EVENT##		;SEE ME LATER!
> ;END TOPS10 CONDITIONAL
	SUBTTL	D$LCKM - ROUTINE TO PROCESS THE RESET AFTER LOCK MESSAGE

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

TOPS10<	INTERN	D$LCKM			;MAKE IT GLOBAL

D$LCKM:	PUSHJ	P,.SAVE2		;SAVE P1 & P2 FOR A SECOND
	MOVE	S1,.RSTJB(M)		;GET THE USERS JOB NUMBER
	PUSHJ	P,FNDMDR		;FIND HIS MDR
	JUMPF	.RETT			;NOT THERE,,RETURN NOW
LCKM.0:	LOAD	P2,.MRCNT(AP),MR.CNT	;GET THE VSL REQUEST COUNT
	MOVNS	P2			;NEGATE IT
	MOVSS	P2			;MOVE RIGHT TO LEFT
	HRRI	P2,.MRVSL(AP)		;CREATE VSL SEARCH AOBJN AC

LCKM.1:	MOVE	S1,0(P2)		;PICK UP A VSL ADDRESS
	LOAD	P1,.VSFLG(S1),VS.TYP	;GET THE VOL SET TYPE
	SKIPE	.VSUCB(S1)		;IS THE VOL SET MOUNTED
	CAXE	P1,%DISK		;  AND IS IT A STRUCTURE ???
	JRST	LCKM.2			;NO TO EITHER,,TRY NEXT
	MOVE	S2,.VSVOL(S1)		;PICK UP THE VOL BLK ADDRESS
	LOAD	P1,.VLFLG(S2),VL.LCK	;GET THE VOL LOCK CODE
	CAXN	P1,%LOCKD		;IS IT LOCKED ???
	PUSHJ	P,D$DSLM		;YES,,TAKE THE STRUCTURE AWAY !!!

LCKM.2:	AOBJN	P2,LCKM.1		;CHECK ALL VSL'S
	$RETT				;THEN RETURN
> ;END TOPS10 CONDITIONAL
	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
	;	S2/ Returned status (%VEOF, %VABT, %VTMV)
	;
	;RET:	True Always

TOPS10	<
VSREOV:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE UCB ADDRESS
	PUSH	P,S2			;SAVE THE STATUS BITS
	MOVX	S1,.QOVSD		;GET VOLUME SET DIRECTIVE MSG TYPE
	PUSHJ	P,LBLHDR		;SETUP THE MSG TO TAPE LABELER
	AOS	G$MSG+.OARGC		;BUMP ARG COUNT BY 1
	POP	P,G$MSG+.MSFLG		;INSERT THE STATUS BITS
	MOVEI	S2,G$MSG+.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,G$MSG+.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 !!!
	PUSHJ	P,C$SEND##		;SEND THE MSG OFF
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	DELETE - ROUTINE TO DELETE ALL NEW VOL SETS FOR A USER

	;CALL:	S1/ The VSL Address of one of those to be deleted
	;	AP/ The MDR Address
	;
	;RET:	True Always

	;A NEW Volume Set is defined to be one whose LINK code is the
	;same as the one in the VSL that was passed as an argument
	;to this routine AND whose VS.WAL bit is still up.

D$DLVS::				;MAKE IT GLOBAL
DELETE:	PUSHJ	P,.SAVE3		;SAVE P1 & P2 & P3 FOR A MINUTE
	LOAD	P2,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT
	JUMPE	P2,DELMDR		;NOTHING THERE,,DELETE THE MDR
	LOAD	P1,.VSRID(S1),VS.LNK	;GET THE LINK CODE WE ARE LOOKING FOR
	MOVEI	P3,.MRVSL(AP)		;POINT TO THE VSL LIST

DELE.1:	MOVE	S1,0(P3)		;GET A VSL ADDRESS
	LOAD	S2,.VSRID(S1),VS.LNK	;GET ITS LINK CODE
	LOAD	TF,.VSFLG(S1),VS.WAL	;GET THE WAITING FOR ALLOCATION BIT
	CAMN	P1,S2			;DO THE LINK CODES MATCH ???
	SKIPN	TF			;  AND IS HE WAITING FOR ALLOCATION ???
	JRST	DELE.2			;WRONG LINK CODE OR NOT WAITING,,SKIP
	PUSHJ	P,DELVSL		;YES,,DELETE THE VSL
	SKIPA				;LOOK AT NEXT VSL

DELE.2:	AOS	P3			;POINT TO THE NEXT VSL ADDRESS
	SOJG	P2,DELE.1		;CONTINUE FOR ALL VSL'S
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT
	SKIPN	S1			;THERE ARE MORE,,DON'T DELETE THE MDR
	PUSHJ	P,DELMDR		;NO MORE REQUESTS,,DELETE THIS MDR
	$RETT				;RETURN
	SUBTTL	REMOVE - ROUTINE TO DELETE A SPECIFIC VSL AND RETRY THE MOUNT

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

TOPS10<
D$REMO::
REMOVE:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	LOAD	P1,.VSRID(S1),VS.LNK	;GET THE VSL LINK CODE
	PUSHJ	P,DELVSL		;DELETE THE BAD VSL
	LOAD	S2,.MRCNT(AP),MR.CNT	;ANY REQUESTS LEFT ???
	JUMPE	S2,DELMDR		;NO,,DELETE HIS MDR
	MOVNS	S2			;NEGATE THE COUNT
	MOVSS	S2			;MOVE RIGHT TO LEFT
	HRRI	S2,.MRVSL(AP)		;CREATE VSL SEARCH AOBJN AC
REMO.1:	MOVE	S1,0(S2)		;GET A VSL ADDRESS
	LOAD	TF,.VSRID(S1),VS.LNK	;GET ITS LINK CODE
	CAME	TF,P1			;DO THEY MATCH ???
	JRST	[AOBJN S2,REMO.1	;NO,,TRY NEXT
		 $RETT ]		;NO MORE,,RETURN
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	PUSHJ	P,D$ALOC		;TRY TO PERFORM ALLOCATION ONCE AGAIN
	JUMPF	[JUMPL	S1,.RETT	;ALLOCATION POSTPONED,,JUST RETURN
		 MOVE	S1,P1		;NO GOOD,,GET THE VSL ADDRESS BACK
		 PJRST	DELETE ]	;  AND DELETE THE VOL SETS JUST ADDED
	MOVE	S1,P1			;GET THE VSL ADDRESS BACK
	PUSHJ	P,MNTVSL		;RETRY THE MOUNT
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	DELVSL - ROUTINE TO DELETE A VSL

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

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

TOPS10<
D$DVSL::
DELVSL:	PUSHJ	P,.SAVE4		;SAVE P1-P4
	MOVEI	P1,(S1)			;GET THE VSL ADDRESS IN P1
	CAIN	P1,TMPVSL		;IS THIS TEMPORARY VSL?
	JRST	DELV.0			;YES..DON'T TRY TO DELETE IT
	MOVE	S2,.VSFLG(P1)		;GET THE VSL FLAG WORD
	TXO	S2,VS.UAL		;LITE 'USER ALLOCATED' TO STOP RECURSION
	MOVEM	S2,.VSFLG(P1)		;SAVE THE NEW VSL STATE
	MOVE	S1,P1			;GET BACK VSL ADRS
	PUSHJ	P,ALCVSL		;RETURN HIS RESOURCES TO THE ALLOC POOL
	MOVE	S1,P1			;RESTORE THE VSL ADDRESS

	LOAD	S2,.VSFLG(S1),VS.WAL	;GET THE 'WAITING FOR ALLOCATION' BIT
	SKIPN	S2			;IF ALLOCATED,,THEN
	PUSHJ	P,RETBMA		;  REMOVE HIS CLAIM ON THESE RESOURCES

DELV.0:	LOAD	P4,.VSCVL(P1),VS.CNT 	;GET THE VOLUME COUNT
	JUMPE	P4,DEL.8A		;NO VOLUMES,,SKIP THIS
	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	P3,0(S1)		;PICK UP THE VSL ADDRESS + FLAGS IN P3
	CAIN	P1,0(P3)		;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:	$PACK	S1			;PACK THE VOL VSL LIST
	DECR	.VLOWN(P2),VL.CNT	;AND DECRIMENT THE USER REQUEST COUNT 

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

DELV.5:	SKIPN	S2,.VLUCB(P2)		;IS THE VOLUME MOUNTED ???
	JRST	[MOVE  S1,P2		;NO,,GET THE VOL ADDRESS IN S1
		 PUSHJ P,DELVOL		;   DELETE THE VOLUME
		 JRST  DELV.8 ]		;   AND GET THE NEXT VOLUME
	LOAD	S1,.UCBST(S2),UC.DVT	;GET THE DEVICE TYPE
	CAXE	S1,%TAPE		;IS IT A TAPE VOLUME ???
	JRST	DELV.8			;NO,,GET NEXT VOLUME
	LOAD	S1,.VLOWN(P2),VL.CNT	;GET THE REQUEST COUNT
	JUMPG	S1,DELV.6		;MULTIPLE REQUESTORS,,TRY ALLOCATION
	JRST	DELV.7			;OTHERWISE UNLOAD THE DRIVE

;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,.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			;AIM AT THIS VOLUME
	TXNE	P3,VL.OWN		;DID WE EVER OWN THIS VOLUME ???
	PUSHJ	P,VLUNLOAD		;UNLOAD AND BREAK LINKS FOR THIS VOL

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

DEL.8A:	LOAD	S1,.MRCNT(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

DELV.9:	CAME	P1,0(S1)		;FIND THE VSL POS IN THE MDR VSL LIST
	JRST	[AOBJN	S1,DELV.9	;NOT FOUND,,TRY ALL VSL ADDRESSES
		 $STOP(VAM,VSL Address is Missing in a MDR) ] ;NONE,,TROUBLE !
	$PACK	S1			;PACK THE MDR VSL LIST
	DECR	.MRCNT(AP),MR.CNT	;AND DECREMENT THE MDR VSL COUNT BY 1

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

	CAIN	P1,TMPVSL		;IS THIS THE TEMP VSL ???
	$RETT				;YES,,JUST RETURN NOW
	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				;RETURN
>


TOPS20 <
D$DVSL::
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
	JUMPE	P4,DELV.2		;NO VOLUMES,,JUST DELETE THE VSL
	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
DELV.2:	LOAD	S1,.MRCNT(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

DELV.3:	CAME	P1,0(S1)		;FIND THE VSL POS IN THE MDR VSL LIST
	JRST	[AOBJN	S1,DELV.3	;NOT FOUND,,TRY ALL VSL ADDRESSES
		 $STOP(VAM,VSL Address is Missing in a MDR) ] ;NONE,,TROUBLE !
	$PACK	S1			;PACK THE MDR VSL LIST
	DECR	.MRCNT(AP),MR.CNT	;AND DECREMENT THE MDR VSL COUNT BY 1

	CAIN	P1,TMPVSL		;IS THIS THE TEMPORARY VSL ???
	$RETT				;YES,,THEN NOTHING TO DELETE !!
	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	ALCVSL - ROUTINE TO RETURN A VSL TO THE ALLOCATION POOL

	;CALL:	S1/ The VSL Address
	;
	;RET:	TRUE ALWAYS

TOPS10<
D$ALCV::				;MAKE IT GLOBAL
ALCVSL:	PUSHJ	P,.SAVE1		;SAVE P1
	HRRZ	P1,S1			;SAVE THE VSL ADDRESS
	MOVE	S1,P1			;GET JUST THE VSL ADDRESS
	PUSHJ	P,CHKOWN		;LOCATE THIS GUYS VSL ADDRESS 
	MOVX	S2,VL.ASK+VL.ASN	;GET ASKED+ASSIGNED STATUS BITS
	ANDCAM	S2,0(S1)		;   AND CLEAR THEM
	MOVE	S1,P1			;RESTORE THE VSL ADDRESS
	PUSHJ	P,RETA%C		;RETURN THE 'A' AND 'C' MATRIX RESOURCES
	SKIPN	S1,.VSUCB(P1)		;GET ANY UCB ADDRESS
	JRST	ALCV.2			;NONE THERE,,SKIP THIS
	SETZM	.VSUCB(P1)		;CLEAR THE VSL'S UCB POINTER
	SETZM	.UCBVS(S1)		;CLEAR THE UCB'S VSL POINTER
	MOVX	S2,UC.VSW		;GET THE VOLUME SWITCH FLAG
	ANDCAM	S2,.UCBST(S1)		;CLEAR IT 
	LOAD	S2,.VSFLG(P1),VS.TYP	;GET VOLUME SET TYPE
	CAXN	S2,%TAPE		;IS THIS A TAPE VOLUME SET?
	PUSHJ	P,SNDVDM		;TELL TAPE LABELER USER IS GONE
ALCV.2:	MOVX	S1,VS.ALC+VS.OPR	;GET THE 'ALLOCATION'+'OPR' BITS
	IORM	S1,.VSFLG(P1)		;LITE THEM
	ZERO	.VSFLG(P1),VS.VSW	;CLEAR THE VOLUME SWITCH FLAG
	ZERO	.VSCVL(P1),VS.OFF	;RESET THE CURRENT VOL OFFSET
	ZERO	.VSRID(P1),VS.LNK	;ALSO ZAP THE LINK CODE
	SKIPN	S1,.VSTXT(P1)		;ANY SECONDARY TEXT ???
	JRST	ALCV.3			;NO,,SKIP THIS
	LOAD	S2,S1,VS.ADR		;GET THE TEXT ADDRESS IN S2
	LOAD	S1,S1,VS.LEN		;GET THE TEXT LENGTH IN S1
	PUSHJ	P,M%RMEM		;RETURN IT TO THE FREE POOL
	SETZM	.VSTXT(P1)		;AND ZAP THE POINTER

ALCV.3:	MOVE	S1,P1			;GET THE VSL ADDRESS
	LOAD	S2,.VSFLG(S1),VS.UAL	;GET THE 'USER ALLOCATED' BIT
	SKIPN	S2			;IF 'USER ALLOC',DONT DELETE VSL
	PUSHJ	P,DELVSL		;DELETE THE VSL
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	DELMDR - ROUTINE TO DELETE AN MDR

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

DELMDR:
TOPS10<	PUSHJ	P,D$BMTX		;FIND THE USERS 'B' MATRIX ENTRY
	JUMPF	DELM.1			;NONE THERE,,SKIP THIS
	PUSHJ	P,L%DENT		;DELETE IT
	PUSHJ	P,D$CMTX		;FIND THE USERS 'C' MATRIX ENTRY
	SKIPF				;NONE THERE,,SKIP
	PUSHJ	P,L%DENT		;DELETE IT
	SOS	PROCNT			;ADJUST THE PROCESS COUNT
> ;END TOPS10 CONDITIONAL

DELM.1:	SKIPE	S1,.MRQEA(AP)		;ANY QE ???
	SETZM	.QEMDR(S1)		;YES,,ZAP IT
	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	MOVE	S2,AP			;GET THE MDR ADDRESS
	PUSHJ	P,L%APOS		;POSITION TO THAT MDR ENTRY
	PUSHJ	P,L%DENT		;DELETE IT
	$RETT				;AND RETURN
	SUBTTL	DELVOL - ROUTINE TO DELETE VOL BLOCKS FROM THE VOL QUEUE

	;CALL:	S1/ The VOL Address of the VOL you want deleted
	;
	;RET:	True Always

	;This routine will delete the volume whose address is passed in S1 
	;And also delete any VOL Blocks connected to that VOL which can
	;Be Deleted

TOPS10	<
DELVOL:	PUSHJ	P,.SAVE3		;SAVE P1 & P2 & P3 FOR A MINUTE
	MOVE	P2,S1			;SAVE ORIGIONAL VOL ADDR HERE
DELX.0:	MOVE	P1,S1			;SAVE AS CURRENT ALSO
	LOAD	S1,.VLPTR(P1),VL.PRV	;FIND THE PRI VOLUME BLOCK
	JUMPN	S1,DELX.0		;   IN THE VOL QUEUE

	LOAD	S1,.VLFLG(P1),VL.STA	;GET THE STRUCTURE STATUS BITS
	CAXN	S1,%STAMN		;IS IT MOUNTED ???
	$RETT				;YES,,JUST RETURN
	SKIPE	S1,.VLUCB(P2)		;IS THE ARG VOLUME MOUNTED ON A DRIVE ?
	SETZM	.UCBVL(S1)		;YES,,BREAK UCB VOL LINK
	SETZM	.VLUCB(P2)		;BREAK VOL UCB LINKS
	LOAD	S1,.VLOWN(P1),VL.CNT	;GET THE REQUEST COUNT
	JUMPN	S1,.RETT		;NOT ZERO,,DON'T DELETE THE VOLUME
	LOAD	S1,.VLFLG(P1),VL.RSN	;GET THE VOLUME RESOURCE NUMBER
	PUSHJ	P,GIVRSN		;GIVE BACK THAT RESOURCE

DELX.1:	MOVE	S2,P1			;GET THE PRI VOL BLK ADDRESS IN S2
	LOAD	P1,.VLPTR(P1),VL.NXT	;GET NEXT VOL BLK ADDRESS
	SKIPE	S1,.VLUCB(S2)		;IS THE VOLUME MOUNTED ???
	SETZM	.UCBVL(S1)		;YES,,ZAP UCB/VOL POINTER
	MOVE	S1,VOLQUE		;NO,,GET THE VOLUME QUEUE ID
	PUSHJ	P,L%APOS		;POSITION TO THAT ENTRY
	PUSHJ	P,L%DENT		;AND DELETE IT
	JUMPN	P1,DELX.1		;IF MORE VOL BLKS,,PROCESS'EM
	$RETT				;ELSE 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 <
D$GLBT::
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	FNDDSK - ROUTINE TO FIND A DSK VOL BLOCK USING VOLUME ID

	;CALL:	S1/ The Volume ID in Sixbit
	;
	;RET:	S1/ The VOL Block Address

TOPS10 <
FNDDSK:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE VOL ID WE ARE LOOKING FOR
	MOVE	S1,VOLQUE		;GET THE VOL QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JRST	FNDD.2			;SKIP THE FIRST TIME THROUGH

FNDD.1:	MOVE	S1,VOLQUE		;GET THE VOL QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT VOL BLOCK
FNDD.2:	JUMPF	.RETF			;NO MORE,,RETURN VOL NOT FOUND
	CAME	P1,.VLVID(S2)		;YES,,IS THIS THE VOL WE WANT ???
	JRST	FNDD.1			;NO,,SKIP IT
	MOVE	S1,S2			;RETURN THE VOL BLOCK ADDRESS IN S1
	$RETT				;AND RETURN

> ;END TOPS10
	SUBTTL	CREVOL - ROUTINE TO CREATE A VOL BLOCK IN VOL QUEUE

	;CALL:	No Calling Parms
	;
	;RET:	S1/ The VOL Queue Entry

D$CVOL::
CREVOL:	MOVE	S1,VOLQUE		;GET THE VOL QUEUE ID
	PUSHJ	P,L%LAST		;POSITION TO THE LAST VOL ENTRY
	MOVE	S1,VOLQUE		;GET THE VOL QUEUE ID
	MOVX	S2,VOLLEN		;AND THE VOL ENTRY LENGTH
	PUSHJ	P,L%CENT		;CREATE A VOL QUEUE ENTRY
	MOVE	S1,S2			;GET THE ENTRY ADDRESS IN S1
	$RETT				;AND RETURN
	SUBTTL	USRACK - ROUTINE TO GENERATE AN ACK TO THE USER FOR MOUNT/ALLOC

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

USRACK::PUSHJ	P,.SAVE3		;Save P1 - P3
	MOVE	S1,[POINT 7,G$MSG]	;GET OUTPUT BYTE POINTER
	MOVEM	S1,MDBPTR		;SAVE IT FOR LATER
	SETZM	G$MSG##			;CLEAR THE FIRST WORD...
	SKIPN	G$OPRA##		;OPERATOR ON DUTY?
	$TEXT	(MDADBP,<% No operator on duty>) ;NO
	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT
	MOVNS	P1			;NEGATE IT
	MOVSS	P1			;MOVE RIGHT TO LEFT
	HRRI	P1,.MRVSL(AP)		;CREATE VSL AOBJN AC
	LOAD	S2,.MRCNT(AP),MR.LNK	;GET THE CURRENT VSL LINK CODE

USRA.0:	MOVE	P2,0(P1)		;GET A VSL ADDRESS
	LOAD	S1,.VSRID(P2),VS.LNK	;GET THE VSL LINK CODE
	CAME	S1,S2			;DO THEY MATCH ???
	JRST	USRA.2			;NO,,SKIP IT
	LOAD	P3,.VSFLG(P2),VS.ALC	;GET THE ALLOCATE BIT
	JUMPE	P4,USRA.1		;If MOUNTR is running, skip the next
	LOAD	S1,.VSFLG(P2),VS.TYP	;Get the mount request type
	CAIE	S1,.MNTST		;A structure mount request?
	JRST	[ $TEXT (MDADBP,<[MOUNTR not running]^J^M[^T/@TYPE(P3)/ request ^T/.VSVSN(P2)/ will be rejected upon MOUNTR startup]>)
		  JRST USRA.2 ]		;Get the next VSL
USRA.1:	$TEXT	(MDADBP,<[^T/@TYPE(P3)/ request ^T/.VSVSN(P2)/ queued, request #^D/.VSRID(P2),VS.RID/]>)

USRA.2:	AOBJN	P1,USRA.0		;LOOP THROUGH ALL VSL'S
	SETZM	S1			;GET A NULL BYTE
	PUSHJ	P,MDADBP		;MAKE IT ASCIZ
	PUSHJ	P,USRNOT		;NOTIFY THE USER
	$RETT				;AND RETURN

TYPE:	[ASCIZ/Mount/]
	[ASCIZ/Allocate/]
	SUBTTL	ACKUSR - ROUTINE TO CREATE AN ACK AFTER THE VOL SET IS MOUNTED

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

ACKUSR:	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	STKVAR	<<QUE,^D30>>		;SETUP A QUEUE FOR VSL'S
	LOAD	P1,.VSRID(S1),VS.LNK	;GET THE VOL SET LINK CODE
	MOVE	AP,.VSMDR(S1)		;GET THE MDR ADDRESS
	SETZM	G$MSG##			;CLEAR THE FIRST WORD OF ACK BUFFER
	MOVE	S1,[POINT 7,G$MSG]	;GET A BYTE POINTER TO IT
	MOVEM	S1,MDBPTR		;AND SAVE IT FOR LATER
	LOAD	P2,.MRCNT(AP),MR.CNT	;GET THE VSL REQUEST COUNT
	MOVNS	P2			;NEGATE IT
	MOVSS	P2			;MOVE RIGHT TO LEFT
	HRRI	P2,.MRVSL(AP)		;CREATE VSL AOBJN AC
	MOVEI	P3,QUE			;GET THE VSL QUEUE ADDRESS
	HRLI	P3,-^D30		;GEN THE QUEUE STACK POINTER
	PUSH	P3,[-1]			;MARK THE END OF THE QUEUE

	;Check to make sure user has all required volume sets assigned

ACKU.1:	MOVE	P4,0(P2)		;GET A VSL ADDRESS
	LOAD	S2,.VSRID(P4),VS.LNK	;GET ITS LINK CODE
	CAME	S2,P1			;DO THEY MATCH ???
	JRST	ACKU.2			;NO,,TRY NEXT VSL
	MOVE	S1,P4			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,CHKOWN		;DOES HE OWN THE VOLUME ???
	MOVE	S2,(S1)			;GET FLAGS
	TXNN	S2,VL.AAS		;BUT WAS IT ALREADY ASSIGNED BEFORE?
	TXNN	S2,VL.ASN		;IS IT ASSIGNED?
	$RETF				;NO,,RETURN
	PUSH	P3,P4			;YES,,QUEUE UP THE VSL ADDRESS
ACKU.2:	AOBJN	P2,ACKU.1		;LOOK FOR ANOTHER

	;If we get this far, its OK to ack the user

ACKU.3:	POP	P3,P4			;GET A VSL ADDRESS OFF THE QUEUE
	CAMN	P4,[-1]			;ARE WE DONE ???
	JRST	ACKU.6			;YES,,ACK THE USER !!!
	LOAD	P1,.VSCVL(P4),VS.OFF	;GET THE OFFSET TO THE CURRENT VOL
	ADDI	P1,.VSVOL(P4)		;POINT TO ITS ADDRESS
	MOVE	P1,0(P1)		;SAVE THE VOL ADDRESS IN P1
	SKIPE	P2,.VLUCB(P1)		;GET THE UCB ADDRESS IN P2
	JRST	ACKU.4			;MUST BE A NON-MDA DEVICE
; Here for non-MDA devices
TOPS10<
	MOVE	S1,P4			;GET VSL ADDRESS
	PUSHJ	P,I$CGEN##		;GET DEVICE TYPE
	  JUMPF	ACKU.3			;SHOULDN'T HAPPEN
	MOVE	T1,S1			;GET INDEX INTO DEVICE NAME TABLE
	MOVEI	S2,ACKU.X		;ASSUME NO LOGICAL NAME ASSIGNED
	SKIPE	.VSLNM(P4)		;HAVE A LOGICAL NAME?
	MOVEI	S2,ACKU.Y		;YES
	TDZA	TF,TF			;NO JUNK FOR DEVICE TYPE
>

TOPS20 <JRST	ACKU.3			;TOPS20 DOESN'T UNDERSTAND REAL DEVICES
>
; Here for MDA devices
ACKU.4:	LOAD	TF,.UCBST(P2),UC.DVT	;GET THE DEVICE TYPE
	SKIPN	S1,.VSTXT(P4)		;ANY ADDITIONAL TEXT ???
	MOVEI	S1,[0]			;NO,,GET A NULL
	CAXN	TF,%DISK		;IS THIS A STRUCTURE ???
	MOVEI	S2,ACKU.D		;YES,,GET TEXT ADDRESS
	CAXN	TF,%TAPE		;IS IT A TAPE REQUEST ???
	PUSHJ	P,[MOVEI S2,ACKU.T	;YES,,DEFAULT TO NO LOGICAL NAME
		   SKIPE .VSLNM(P4)	;UNLESS HE SPECIFIED ONE
		   MOVEI S2,ACKU.L	;  THEN GET TEXT WITH LOGICAL NAME
		   POPJ  P,  ]		;RETURN
	$TEXT	(MDADBP,<^T/(S1)/^I/(S2)/>) ;TAKES ALOT TO BE PRETTY !!!
	SKIPN	S1,.VSTXT(P4)		;ANY ADDITIONAL TEXT ???
	JRST	ACKU.3			;NO,,GET NEXT VSL
	LOAD	S2,S1,VS.ADR		;GET THE TEXT ADDRESS IN S2
	LOAD	S1,S1,VS.LEN		;GET THE TEXT LENGTH IN S1
	PUSHJ	P,M%RMEM		;RETURN IT TO THE FREE POOL
	SETZM	.VSTXT(P4)		;ZAP THE TEXT POINTER
	JRST	ACKU.3			;GET NEXT VSL

ACKU.6:	SETZM	S1			;GET A NULL BYTE
	IDPB	S1,MDBPTR		;MAKE THE ACK ASCIZ
	PUSHJ	P,USRNOT		;SEND THE MESSAGE OFF
	ZERO	.MRFLG(AP),MR.WAT	;CLEAR THE WAITING FOR ACK BIT
	$RETT				;AND RETURN

ACKU.D:	ITEXT	(<[Structure ^W/.VLNAM(P1)/ mounted]>) 
ACKU.T:	ITEXT	(<[Magtape ^W/.VLNAM(P1)/ mounted on ^W/.UCBNM(P2)/]>)
ACKU.L:	ITEXT	(<[Magtape ^W/.VLNAM(P1)/ mounted on ^W/.UCBNM(P2)/ with logical name ^W/.VSLNM(P4)/]>)
TOPS10 <
ACKU.X:	ITEXT (<[^T/@DEVNTB(T1)/ ^W/.VLNAM(P1)/ mounted on ^W/MDAOBJ+OBJ.UN/]>)
ACKU.Y:	ITEXT (<[^T/@DEVNTB(T1)/ ^W/.VLNAM(P1)/ mounted on ^W/MDAOBJ+OBJ.UN/ with logical name ^W/.VSLNM(P4)/]>)
>
	SUBTTL	TELOPR - ROUTINE TO NOTIFY THE OPERATOR TO MOUNT DEVICES

	;CALL:	S1/ The VSL Address of Any VSL to be Mounted
	;	AP/ The MDR Address
	;
	;RET:	True Always

TOPS10<
TELOPR:	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	PUSHJ	P,.SAVET		;SAVE THE 'T' ACs ALSO
	$SAVE	<.FP>			;SAVE THE FRAME POINTER AC
	TRVAR	<<VOLID,2>,<RMK,15>,STRFLG> ;GEN A FLAG WORD FOR STRS
	SETOM	STRFLG			;AND SET IT
	LOAD	P1,.VSRID(S1),VS.LNK	;GET THE VSL LINK CODE
	LOAD	P2,.MRCNT(AP),MR.CNT	;GET THE USERS VOL SET REQUEST COUNT
	MOVNS	P2			;NEGATE IT
	MOVSS	P2			;MOVE RIGHT TO LEFT
	HRRI	P2,.MRVSL(AP)		;CREATE VSL AOBJN SEARCH AC

TELO.1:	MOVE	T1,0(P2)		;GET A VSL ADDRESS
	LOAD	S2,.VSRID(T1),VS.LNK	;GET ITS LINK CODE
	CAME	S2,P1			;DO THEY MATCH ???
	JRST	TELO.2			;NO,,GET NEXT
	MOVE	S2,.VSFLG(T1)		;GET THE VSL FLAG BITS
	TXNN	S2,VS.OPR+VS.VSW	;SWITCHING VOLS OR NOTIFY OPR ???
	JRST	TELO.2			;NO,,SKIP THIS
	LOAD	P3,.VSCVL(T1),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	P3,.VSVOL(T1)		;POINT TO THE CURRENT VOLUME ADDRESS
	MOVE	P3,0(P3)		;POINT P3 AT THE CURRENT VOLUME
	LOAD	S2,.VLFLG(P3),VL.STA	;GET THE VOLUME STATUS
	CAXN	S2,%STAMN		;IS IT MOUNTED ???
	JRST	TELO.2			;YES,,DON'T TELL OPR TO REMOUNT IT
	PUSHJ	P,CHKBAT		;CHECK TO SEE IF BATCH REQUEST
	JUMPF	TELO.2			;YES,,DON'T TELL OPR
	SETZM	RMK			;NO REMARK HERE YET !!!
	SKIPE	.VSREM(T1)		;DID HE SPECIFY ANY ???
	$TEXT	(<-1,,RMK>,<^M^JRemark: ^T/.VSREM(T1)/^0>) ;YES,,GEN IT
	ZERO	.VSFLG(T1),VS.OPR	;CLEAR OPR BIT,,WE'RE TELLING OPR NOW 
	MOVE	S2,G$NOW##		;GET THE CURRENT TIME
	MOVEM	S2,.VSSCH(T1)		;SAVE AS THE SCHEDULED TIME
	LOAD	S2,.VSFLG(T1),VS.TYP	;GET THE REQUEST TYPE
	PUSHJ	P,@TELTAB(S2)		;DISPATCH TO PROPER 'TELL' PROCESSOR
	  $RETIF			;RETURN IF FALSE

TELO.2:	AOBJN	P2,TELO.1		;CONTINUE FOR ALL VSL'S
	$RETT				;RETURN


TELTAB:	TELUNK				;%UNKN - UNKNOWN DEVICE
	TELMTA				;%TAPE - MAGTAPE
	TELDSK				;%DISK - STRUCTURE
	TELDTA				;%DTAP - DECTAPE
	.POPJ				;%DSMT - DISMOUNT STRUCTURE (IGNORED)
	.POPJ				;%STRC - STRUCTURE (IGNORED)
	.POPJ				;%TVOL - MAGTAPE VOLUME (IGNORES)
	.POPJ				;%DTVOL- DECTAPE VOLUME (IGNORED)
; Tell OPR about magtape request (%TAPE)
;
TELMTA:	DMOVE	T3,[ASCIZ/Scratch/]	;YES,,GET A SCRATCH VOLID
	DMOVEM	T3,VOLID		;DEFAULT TO THIS !!!
	MOVX	T3,VS.SCR+VS.NEW	;GET 'SCRATCH+NEW' STATUS BITS
	MOVEI	S2,NEWTXT		;ASSUME /NEW OR /SCRATCH
	TDNE	T3,.VSFLG(T1)		;IS THIS A SCRATCH OR NEW VOLUME SET ?
	JRST	TMTA.1			;NOT SPECIFIED, EVERYTHING OK
	$TEXT	(<-1,,VOLID>,<^W/.VLNAM(P3)/^0>) ;NO,,GEN ASCIZ VOLID
	MOVEI	S2,NONEWT		;GET THE TEXT TO LABEL THE TAPES

TMTA.1:	PUSHJ	P,GETLBT		;GO SEE IF USER SPECIFIED LABELS
	CAXN	S1,%UNLBL		;DID HE?
	MOVEI	S2,NONEWT		;DON'T PROMPT FOR INITIALIZATION AT ALL
	LOAD	P4,.VSFLG(T1),VS.WLK	;GET THE WRITE-LOCKED CODE
	LOAD	T2,.VSFLG(T1),VS.LBT	;GET THE REQUESTED LABEL TYPE
	LOAD	T3,.VSATR(T1),VS.TRK	;GET THE TRACK STATUS
	LOAD	T4,.VSATR(T1),VS.DEN	;GET THE REQUESTED DENSITY
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE PROCESS JOB NUMBER
	TXC	S1,BA%JOB		;SWAP REQUEST STATES
	TXNE	S1,BA%JOB		;IS THIS A REAL REQUEST ???
	$WTO	(<Magtape mount request #^D/.VSRID(T1),VS.RID/>,<^I/DEMO/^T/RMK/^M^JVolume-set-name: ^T/.VSVSN(T1)/^T/MTAHDR/^T11/VOLID/^T9/@WRTENA(P4)/^T9/@LABELS(T2)/^W6/TRK(T3)/^T/@DENSTY(T4)/^I/(S2)/>,,<$WTFLG(WT.SJI)>)

	TXNN	S1,BA%JOB		;IS IT A PSEUDO PROCESS ???
	$WTO	(<Magtape mount request #^D/.VSRID(T1),VS.RID/>,<User: [SYSTEM] for ^15/.MRFLG(AP),MR.QUE/ Request #^D/S1/^T/RMK/^M^JVolume-set-name: ^T/.VSVSN(T1)/^T/MTAHDR/^T11/VOLID/^T9/@WRTENA(P4)/^T9/@LABELS(T2)/^W6/TRK(T3)/^T/@DENSTY(T4)/^I/(S2)/>,,<$WTFLG(WT.SJI)>)
	$RETT				;RETURN

NEWTXT:	ITEXT	(<^M^JInitialize new tape with volume-id: ^W/.VLNAM(P3)/ protection: ^O3/.VSATR(T1),VS.PRT/^T/BELLS/>)
NONEWT:	ITEXT	(<^T/BELLS/>)	;IF /NEW OR /SCRA NOT SEEN
MTAHDR:	ASCIZ/

Volume-ID   Write   Labels  Track  Density
---------  -------  ------  -----  -------
/
; Tell OPR about structure request (%DISK)
;
TELDSK:	MOVE	S1,.VLNAM(P3)		;GET THE STRUCTURE NAME
	MOVEM	S1,MDAOBJ+OBJ.UN	;SAVE IT IN THE MDA OBJECT BLOCK
	PUSHJ	P,D$FCAT		;FIND ITS CATALOG ENTRY
	SKIPT				;IT MUST BE THERE !!!
	PUSHJ	P,S..SCE		;NO,,DEEEP TROUBLE !!!
	MOVE	T2,.CTCNT(S1)		;GET # OF VOLUMES WORD
	MOVEI	P3,.CTVOL(S1)		;POINT TO THE FIRST BLOCK !!!
	MOVE	S1,[POINT 7,G$MSG]	;SETUP A BYTE POINTER
	MOVEM	S1,MDBPTR		;   FOR VOLUME BUFFER
	SETZM	T1			;CLEAR LOGICAL UNIT NUMBER COUNTER
	AOSG	STRFLG			;MODIFY AND CHK THE STRUTCURE MOUNT FLAG
	PUSHJ	P,SETSEL		;FIRST TIME THROUGH,,SET UNIT SELECTED
	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;POSITION TO THE FIRST ENTRY

TELD.1:	MOVE	P4,.CTRSN(P3)		;GET THE RESOURCE NUMBER

TELD.2:	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB ADDRESS
	JUMPF	.RETF			;NO MORE AVAILABLE,,JUST RETURN
	LOAD	S1,.UCBST(S2),UC.DVT	;GET THE DEVICE TYPE
	CAXE	S1,%DISK		;IS IT A STRUCTURE ???
	JRST	TELD.2			;NO,,TRY NEXT UCB
	LOAD	S1,.UCBST(S2),UC.RSN	;GET THE DEVICE RESOURCE NUMBER
	CAME	S1,P4			;DO THEY MATCH ???
	JRST	TELD.2			;NO,,TRY NEXT
	LOAD	S1,.UCBST(S2),UC.SEL	;GET THE UNIT SELECTED BIT
	JUMPN	S1,TELD.2		;IF LIT,,SKIP THIS UNIT !!!
	MOVX	S1,UC.SEL		;ELSE GET THE UNIT SELECTED BIT
	IORM	S1,.UCBST(S2)		;  AND SET IT
	IMULI	P4,AMALEN		;GET 'A' MATRIX OFFSET
	ADD	P4,AMATRX		;GET THE 'A' MATRIX ENTRY ADDRESS
	$TEXT(<-1,,TMPVSL>,<^W/MDAOBJ+OBJ.UN/^O/T1/^0>) ;GEN LOGICAL UNIT NAME
	$TEXT(MDADBP,<^T8/TMPVSL/^W8/.CTVID(P3)/^T6/@.AMNAM(P4)/^W/.UCBNM(S2)/>) 
	ADDI	P3,CATBLN		;BUMP TO THE NEXT CATALOG ENTRY
	AOS	T1			;BUMP THE LOGICAL UNIT NUMBER
	SOJG	T2,TELD.1		;CONTINUE FOR ALL VOLUME BLOCKS
	SETZM	S1			;GET A NULL BYTE
	IDPB	S1,MDBPTR		;MAKE THE TEXT ASCIZ
	MOVE	T1,0(P2)		;PICK UP THE VSL ADDRESS AGAIN
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE PROCESS JOB NUMBER
	TXC	S1,BA%JOB		;SWAP REQUEST STATES
	TXNE	S1,BA%JOB		;IS THIS A REAL REQUEST ???
	$WTO	(<Structure mount request #^D/.VSRID(T1),VS.RID/^T/BELLS/>,<^I/DEMO/^T/RMK/^T/DSKHDR/^T/G$MSG/>,MDAOBJ)

	TXNN	S1,BA%JOB		;IS IT A PSEUDO PROCESS ???
	$WTO	(<Structure mount request #^D/.VSRID(T1),VS.RID/^T/BELLS/>,<User: [SYSTEM] for ^15/.MRFLG(AP),MR.QUE/ Request #^D/S1/^T/RMK/^T/DSKHDR/^T/G$MSG/>,MDAOBJ)
	$RETT				;RETURN


DSKHDR:	ASCIZ/

 Unit   Volume  Type  Drive
------  ------  ----  -----
/
; Tell OPR about DECtape request (%DTAP)
;
TELDTA:	DMOVE	T3,[ASCIZ/Scratch/]	;YES,,GET A SCRATCH VOLID
	DMOVEM	T3,VOLID		;DEFAULT TO THIS !!!
	MOVX	T3,VS.SCR+VS.NEW	;GET 'SCRATCH+NEW' STATUS BITS
	TDNN	T3,.VSFLG(T1)		;IS THIS A SCRATCH OR NEW VOLUME SET ???
	$TEXT	(<-1,,VOLID>,<^W/.VLNAM(P3)/^0>) ;NO,,GEN ASCIZ VOLID
	LOAD	P4,.VSFLG(T1),VS.WLK	;GET THE WRITE-LOCKED CODE
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE PROCESS JOB NUMBER
	TXC	S1,BA%JOB		;SWAP REQUEST STATES
	TXNE	S1,BA%JOB		;IS THIS A REAL REQUEST ???
	$WTO	(<DECtape mount request #^D/.VSRID(T1),VS.RID/>,<^I/DEMO/^T/RMK/^M^JVolume-set-name: ^T/.VSVSN(T1)/^T/DTAHDR/^T11/VOLID/^T9/@WRTENA(P4)/^T/BELLS/>,,<$WTFLG(WT.SJI)>)

	TXNN	S1,BA%JOB		;IS IT A PSEUDO PROCESS ???
	$WTO	(<DECtape mount request #^D/.VSRID(T1),VS.RID/>,<User: [SYSTEM] for ^15/.MRFLG(AP),MR.QUE/ Request #^D/S1/^T/RMK/^M^JVolume-set-name: ^T/.VSVSN(T1)/^T/DTAHDR/^T11/VOLID/^T9/@WRTENA(P4)/^T/BELLS/>,,<$WTFLG(WT.SJI)>)
	$RETT				;RETURN


DTAHDR:	ASCIZ/

Volume-ID   Write
---------  -------
/
TELUNK:	MOVE	S1,T1			;GET THE VSL ADDRESS
	PUSHJ	P,I$CGEN##		;GET THE DEVICE TYPE AND INDEX
	MOVE	P4,S1			;SAVE THE DEVICE INDEX
	HRROI	S1,.VSVSN(T1)		;POINT TO THE VOLUME SET NAME
	PUSHJ	P,S%SIXB		;CONVERT TO SIXBIT
	MOVEM	S2,MDAOBJ+OBJ.UN	;SAVE IT IN THE OBJECT BLOCK
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE PROCESS JOB NUMBER
	TXC	S1,BA%JOB		;SWAP REQUEST STATES
	TXNE	S1,BA%JOB		;IS THIS A REAL REQUEST ???
	$WTO	(<Device mount request #^D/.VSRID(T1),VS.RID/^T/BELLS/>,<^I/DEMO/^T/RMK/^M^JDevice: ^T/@DEVNTB(P4)/>,MDAOBJ)

	TXNN	S1,BA%JOB		;IS IT A PSEUDO PROCESS ???
	$WTO	(<Device mount request #^D/.VSRID(T1),VS.RID/^T/BELLS/>,<User: [SYSTEM] for ^15/.MRFLG(AP),MR.QUE/ Request #^D/S1/^T/RMK/^M^JDevice: ^T/@DEVNTB(P4)/>,MDAOBJ)
	$RETT				;RETURN

> ;END TOPS10 CONDITIONAL
	SUBTTL	MNTOPR - ROUTINE TO NOTIFY THE OPR OF PENDING MOUNT REQUESTS

	;CALL:	No Args
	;
	;RET:	Nothing - Notifies the operator if mounts are pending

MNTOPR:	SKIPN	G$OPRA##		;OPERATOR ON DUTY?
	JRST	MNTO.9			;NOPE - JUST RESCHEDULE THE EVENT
	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	STKVAR	<KOUNT>			;GET SPACE FOR A COUNT
	SETZM	KOUNT			;CLEAR MOUNT COUNTER
	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST VOL IN THE QUEUE
	JRST	MNTO.2			;JUMP THE FIRST TIME THROUGH
MNTO.1:	MOVE	S1,VOLQUE		;GET THE VOLUME QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT VOLUME IN THE QUEUE
MNTO.2:	JUMPF	MNTO.7			;NO MORE,,GO FINISH UP...
	MOVE	P2,S2			;SAVE THE VOL ENTRY ADDRESS
	LOAD	P4,.VLOWN(P2),VL.CNT	;GET THE VOLUME REQUEST COUNT..
	JUMPE	P4,MNTO.1		;NO REQUESTORS,,SKIP IT..
	MOVNS	P4			;NEGATE THE REQUEST COUNT
	MOVSS	P4			;MOVE RIGHT TO LEFT
	HRRI	P4,.VLVSL(P2)		;CREATE VSL AOBJN AC
	MOVE	P3,.VLUCB(P2)		;GET THE UCB ADDRESS

MNTO.3:	MOVE	P1,0(P4)		;GET A VSL ADDRESS
	MOVE	AP,.VSMDR(P1)		;GET THE MDR ADDRESS
	MOVE	S1,.VSFLG(P1)		;GET THE VSL FLAG BITS
	TXNN	P1,VL.ASN		;DOES HE OWN THE VOLUME ???
	TXNE	S1,VS.ALC+VS.ABO	;JUST ALLOCATED OR ABORTED ???
	JRST	MNTO.6			;YES,,TRY NEXT VSL
	SKIPN	S1,.MRQEA(AP)		;CHECK AND LOAD QE ADDRESS
	JRST	MNTO.4			;NO QE, NO BATCH JOB TO CHECK
	PUSHJ	P,S$INPS##		;FOUND,,CHECK SCHEDULABILITY
	JUMPF	MNTO.6			;NO GO,,SKIP IT
	MOVE	S1,.MRQEA(AP)		;GET THE QE AGAIN
	MOVX	S2,QE.HBO		;GET 'HELD BY OPERATOR BIT'
	TDNE	S2,.QESEQ(S1)		;IS IT?
	JRST	MNTO.6			;HELD JOBS CAN'T MOUNT THINGS

MNTO.4:	LOAD	S1,.VSCVL(P1),VS.OFF	;GET THE OFFSET TO HIS CUR VOL
	ADDI	S1,.VSVOL(P1)		;POINT TO HIS CURRENT VOL ADDR
	CAME	P2,0(S1)		;IS THIS THE VOL HE NEEDS ???
	JRST	MNTO.6			;NO,,SKIP THIS
	LOAD	S1,.VSFLG(P1),VS.TYP	;GET THE VOLUME SET TYPE
	CAXE	S1,%DISK		;IS THIS A STRUCTURE REQUEST ???
	JRST	MNTO.5			;NO,,ADD UP THE TAPE REQUEST
	LOAD	S1,.VLFLG(P2),VL.STA	;GET THE VOLUME STATUS
	CAXN	S1,%STAMN		;IS THE STRUCTURE MOUNTED ???
	JRST	MNTO.6			;YES,,SKIP THIS REQUEST

MNTO.5:	AOS	KOUNT			;BUMP THE MOUNT COUNTER

MNTO.6:	AOBJN	P4,MNTO.3		;CONTINUE THROUGH ALL USERS
	JRST	MNTO.1			;CONTINUE THROUGH ALL VOLUMES

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

MNTO.7:	SKIPN	P1,KOUNT		;ANY MOUNTS PENDING ???
	JRST	MNTO.9			;NO,,JUST ADD THE EVENT BACK
	MOVE	S1,[ASCII/is/]		;DEFAULT TO 1 MOUNT
	SETZM	S2			;GET A NULL
	CAIG	P1,1			;MORE THEN 1 MOUNT ???
	JRST	MNTO.8			;NO,,LETERRIP !!!
	MOVE	S1,[ASCII/are/]		;YES,,SET IT UP
	MOVE	S2,[ASCII/s/]		;TAKES A LOT TO BE NICE !!!
MNTO.8:	$WTO	(<There ^T/S1/ ^D/KOUNT/ mount request^T/S2/ pending^T/BELLS/>,,,<$WTFLG(WT.SJI)>)
MNTO.9:	SETZM	G$MSG+.EVTYP		;CLEAR THE EVENT TYPE WORD
	MOVX	S1,%EVAFT		;WANT TYPE 'AFTER'
	STORE	S1,G$MSG+.EVTYP,EV.TYP	;SET IT
	MOVEI	S1,3			;GET 3 MINUTES
	PUSHJ	P,A$AFT##		;COMPUTE IT
	MOVEM	S1,G$MSG+.EVUDT		;SET IT
	MOVEI	S1,MNTOPR		;GET THIS ROUTINE ADDRESS
	MOVEM	S1,G$MSG+.EVRTN		;SET IT
	MOVX	S1,.EVMSZ		;GET THE EVENT BLOCK LENGTH
	MOVEI	S2,G$MSG		;AND ITS ADDRESS
	PUSHJ	P,S$EVENT##		;ADD TO THE EVENT LIST
	$RETT				;AND RETURN
	SUBTTL	SETSEL - ROUTINE TO FIND THOSE UCB'S WHICH ARE FREE

	;CALL:	No Args
	;
	;RET:	True Always

TOPS10<
SETSEL:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVX	P1,UC.SEL		;GET THE UNIT SELECTED BIT
	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;POSITION TO THE FIRST ENTRY
	JRST	SETS.2			;JUMP THE FIRST TIME THROUGH

SETS.1:	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT ENTRY
SETS.2:	JUMPF	.RETT			;DONE,,RETURN
	MOVE	P2,S2			;SAVE THE UCB ADDRESS
	ANDCAM	P1,.UCBST(P2)		;CLEAR THE UNIT SELECTED STATUS BIT
	LOAD	S1,.UCBST(P2),UC.DVT	;GET THE UNIT TYPE
	CAXN	S1,%DISK		;IS IT A DISK UNIT ???
	SKIPN	S1,.UCBVL(P2)		;YES,,ANY VOLUME MOUNTED ???
	JRST	SETS.1			;NOT A DISK OR NO VOL MOUNTED,,GET NEXT

SETS.3:	LOAD	S2,.VLPTR(S1),VL.PRV	;FIND THE PRIMARY VOL BLOCK
	JUMPE	S2,SETS.4		;FOUND IT,,SEE IF ANYONE OWNS IT
	MOVE	S1,S2			;ELSE SAVE THIS VOL BLOCK ADDRESS
	JRST	SETS.3			;AND KEEP LOOKING

SETS.4:	PUSHJ	P,FNDOWN		;ANY OWNERS OF THE MOUNTED VOLUME ???
	JUMPF	SETS.1			;NO,,GET NEXT UCB
	IORM	P1,.UCBST(P2)		;YES,,LITE UNIT SELECTED
	JRST	SETS.1			;AND GO GET THE NEXT UCB
> ;END TOPS10 CONDITIONAL
	SUBTTL	USRNOT - SEND A MESSAGE TO THE USER

	;CALL:	AP/ The Users MDR Address
	;	G$MSG/ The Message to be sent
	;
	;RET:	True Always

D$USRN::				;MAKE IT GLOBAL
USRNOT:	MOVE	S1,.MRFLG(AP)		;GET MDR FLAGS
	TXNE	S1,MR.GFR		;IS THIS FROM [SYSTEM]GOPHER ???
	JRST	[ZERO .MRFLG(AP),MR.GFR	;YES,,CLEAR IT AND
		 $RETT  ]		;RETURN (GOPHER DOESN'T WANT THIS ACK)
	LOAD	S2,.MRJOB(AP),MD.PJB	;GET THE USERS JOB NUMBER
	TXNN	S2,BA%JOB		;IS IT AN INTERNAL REQUEST ???
	TXNN	S1,MR.WAT!MR.NOT!MR.ACK	;OR WANT SOME STYLE NOTIFICATION ???
	JRST	[SETZM ERRACK		;PSEUDO REQ OR NO ACK,,ZAP ERROR
		 $RETT ]		;AND RETURN

USRN.0:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	TXNN	S1,MR.WAT!MR.ACK	;WAITING FOR AN ACK ???
	JRST	USRN.N			;NO,,MUST BE NOTIFY
	TXZN	S1,MR.ACK		;ACK REQUESTED ???
	TXZ	S1,MR.WAT		;NO,,CLEAR WAITING
	MOVEM	S1,.MRFLG(AP)		;SAVE THE NEW STATUS
	$CALL	M%GPAG			;GET A PAGE TO BUILD THE ACK IN
	MOVE	P1,S1			;SAVE THE ADRS OF THE TEXT PAGE
	MOVEM	P1,G$SAB##+SAB.MS	;AIM THE GLOBAL SAB AT THE PAGE
	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,MF.FAT		;GET FATAL ACK BIT
	SKIPE	ERRACK			;IS THIS AN 'ERROR' ACK ???
	MOVEM	S1,.MSFLG(P1)		;YES,,SET THE BIT
	MOVX	S1,.OHDRS+ARG.DA+MSGLN## ;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,.MRACK(AP)		;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
	MOVX	S1,.CMTXT		;BLOCK TYPE-- TEXT
	STORE	S1,.OHDRS+ARG.HD(P1),AR.TYP ;SET BLOCK TYPE
	MOVX	S1,ARG.DA+MSGLN##	;SIZE OF THIS BLOCK
	STORE	S1,.OHDRS+ARG.HD(P1),AR.LEN ;LENGTH INTO BLOCK HEADER
	MOVSI	S1,G$MSG		;GET THE SOURCE ADDRESS
	HRRI	S1,.OHDRS+ARG.DA(P1)	;GET DESTINATION ADDRESS
	BLT	S1,.OHDRS+ARG.DA+MSGLN##-1(P1) ;COPY THE TEXT OVER
	PUSHJ	P,C$SEND##		;ACK THE USER
	JUMPT	[SETZM ERRACK		;CLEAR THE ERROR FLAG
		 $RETT ]		;AND RETURN
	;HERE TO NOTIFY USER VIA ORION TYPING ON HIS TERMINAL

TOPS10 <
USRN.N:	LOAD	S1,.MRFLG(AP),MR.NOT	;WANT TO BE NOTIFIED?
	JUMPE	S1,[SETZM ERRACK	;NO,,CLEAR THE ERROR FLAG
		    $RETT ]		;AND RETURN
	SKIPA				;ENTER THE COMMON STUFF

USRN.W:	$SAVE	<P1>			;SAVE A REG
	MOVX	S1,BA%JOB		;GET THE BATCH JOB BIT
	TDNE	S1,.MRJOB(AP)		;IS THIS REQUEST A BATCH REQUEST?
	JRST	USRN.6			;YES, SKIP THE NOTIFICATION
	$CALL	M%GPAG			;GET A PAGE TO BUILD THE ACK IN
	MOVE	P1,S1			;SAVE THE ADRS OF THE TEXT PAGE
	MOVEM	P1,G$SAB##+SAB.MS	;AIM THE GLOBAL SAB AT THE PAGE
	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+ARG.DA+MSGLN## ;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,ARG.DA+MSGLN##	;SIZE OF THIS BLOCK
	STORE	S1,ARG.HD(P1),AR.LEN	;LENGTH INTO BLOCK HEADER
	MOVE	S1,[BYTE(7) 15,12,0,0,0] ;GET A CRLF
	SKIPE	ERRACK			;UNLESS THIS IS AN ERROR ACK !!
	MOVE	S1,[BYTE(7) 15,12,77,0,0] ;  THEN GET A <CRLF>?
	MOVX	S2,MR.DMO		;GET DISMOUNT STR BIT
	TDNE	S2,.MRFLG(AP)		;IS THAT WHAT WE'RE DOING?
	SKIPA	S2,[ASCIZ | |]		;YES
	MOVE	S2,[BYTE (7) 15,12,0]	;ELSE USE A CRLF
	$TEXT	(<-1,,ARG.DA(P1)>,<^T/S1/From system:^T/S2/^T/G$MSG/^T/BELLS/>)
	PUSHJ	P,C$SEND##		;ACK THE USER
USRN.6:	SETZM ERRACK			;CLEAR THE ERROR FLAG
	$RETT				;AND RETURN
>
TOPS20 <
USRN.N:	$RETT	>			;JUST RETURN ON THE -20
	SUBTTL	NSTUSR - Notify users of pending structure locks

;this routine will notify all the users of a given structure that a
; LOCk has been given by the operator for a structure they own,
; and will not be available for long
;Call -
;	S1/	Prime volume block address
;	S2/	Addrs of ITEXT for message (ITEXT should stay in P acs)
;Returns -
;	TRUE,	messages sent to all requestors

TOPS10<
NSTUSR:	$TEXT	(<-1,,G$MSG>,<^I/0(S2)/^M^J^0>) ;DUMP THE TEXT OF THE MESSAGE
	$SAVE	<P1,AP>			;SAVE P1 AND AP
	MOVE	P1,S1			;COPY ADRS OF PRIMARY VOL BLOCK
	LOAD	S1,.VLOWN(P1),VL.CNT	;FIND OUT HOW MANY REQUESTORS
	JUMPE	S1,.RETT		;NONE, NOTHING TO DO!
	MOVNS	S1			;GET NEGATIVE # OF REQUESTORS
	HRL	P1,S1			;MAKE LOOP POINTER
	SETZM	ERRACK			;DO THE NORMAL STUFF IN USRNOT
NSTU.1:	HRRZ	S1,.VLVSL(P1)		;GET THE NEXT VSL ENTRY
	SKIPN	S1			;BETTER BE ONE!!
	$STOP	(VSA,VSL Address is Missing in a VOL) ;NONE THERE,,END IT
	SKIPN	AP,.VSMDR(S1)		;GOT IT, GET BACK TO THE MDR
	$STOP	(IMV,Invalid MDR/VSL Forward/Backchain Pointers)
	PUSHJ	P,USRN.W		;WRITE ON THE REQUESTORS TERMINAL
	AOBJN	P1,NSTU.1		;CHECK ALL REQUESTORS
	$RETT				;DONE
> ;END TOPS10 CONDITIONAL
	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,G$MSG+.OHDRS	;AIM AT FIRST BLOCK

;Build the First Block, Which Describes the Device Reassigned

	AOS	G$MSG+.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,G$MSG+.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	G$MSG+.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,G$MSG+.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
	PUSHJ	P,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 G$MSG
;Call -
;	S1/ Message type

TOPS10<
LBLHDR:	STORE	S1,G$MSG+.MSTYP,MS.TYP	;SAVE THE MESSAGE TYPE
	MOVX	S1,.OHDRS		;SIZE OF HEADER ALONE
	STORE	S1,G$MSG+.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	G$MSG+.MSFLG		;NO MESSAGE FLAGS
	SETZM	G$MSG+.MSCOD		;NO ACK CODE
	SETZM	G$MSG+.OFLAG		;AND NO FLAGS (YET)
	SETZM	G$MSG+.OARGC		;NO ARG BLOCKS (YET)
	MOVEI	S1,G$MSG		;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



D$SREC::				;MAKE IT GLOBAL
SNDREC:	SKIPN	S1			;*** MUST BE NON-ZERO ***
	$STOP	(QBI,<QUASAR blew it>)	;++ WE'RE IN TROUBLE NOW
	MOVEM	S1,RECMSG+.OHDRS+ARG.DA	;SAVE THE DEVICE NAME IN THE MESSAGE
	MOVEI	S1,.OHDRS+ARG.DA+1	;GET THE MESSAGE LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	MOVEI	S1,RECMSG		;GET THE MESSAGE ADDRESS
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE IT IN THE SAB

SNDLBR:	MOVX	S1,SI.FLG+SP.TLP	;GET THE SPECIAL INDEX FOR TAPE LABELER
	MOVEM	S1,G$SAB##+SAB.SI	;SAVE IT IN THE SAB
	SETZM	G$SAB##+SAB.PD		;ZAP THE SAB PID WORD
	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
LBLCOM:	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

	;STILL IN TOPS10
	;CONTINUED ON THE NEXT PAGE
	;CONTINUED FROM THE PREVOIUS PAGE
	;STILL IN TOPS10

	SUBTTL	SNDVDM - Send volume dismount message to tape labeler

;Call -
;	S1/	UCB adrs of drive just deassigned
;Returns -
;	message to tape labeler informing of drive no longer in use

SNDVDM:	LOAD	S1,.UCBNM(S1)		;GET DRIVE NAME
	MOVX	S2,.QOVDM		;MESSAGE TYPE - VOLUME DISMOUNTED
	PJRST	LBLCOM			;GO SEND MESSAGE TO LABELER

>;END TOPS10
	SUBTTL	FNDUCB - ROUTINE TO FIND A UCB IN THE UCB CHAIN

	;CALL:	FNDUCB - S1/ The Address of the message asciz device name
	;	UCBFND - S1/ The sixbit device name
	;	LOCxxx	Get UCB regardless of un/available bit
	;	FNDxxx	Only return UCB if drive is available
	;
	;RET:	True - S1/ The UCB Address, S2/ sixbit device name checked/
	;	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	<P1,P2>			;SAVE P1 AND P2
	MOVE	P1,TF			;SAVE THE ENTRY POINT FLAGS IN P1
	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

UCBLOC:	TDZA	TF,TF			;SET FLAG FOR LOCATE UCB ENTRY POINT
D$GUCB::				;GLOBAL ENTRY POINT
UCBFND:	SETOM	TF			;SET FLAG FOR FIND UCB ENTRY POINT
	$SAVE	<P1,P2>			;SAVE P1 AND P2
	MOVE	P1,TF			;SAVE THE ENTRY POINT FLAGS IN T1
	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
	  SKIPA	S2,MDAOBJ+OBJ.UN	;CAN'T - USE WHAT WE HAVE
	MOVEM	S2,MDAOBJ+OBJ.UN	;SAVE THE DEVICE NAME IN THE OBJ BLOCK
	MOVE	P2,S2			;SAVE THE DEVICE NAME IN P2 ALSO
	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%FIRST		;POSITION TO THE FIRST ENTRY
	JUMPF	E$NSD##			;NOT THERE,,RETURN NOW

FNDU.1:	CAME	P2,.UCBAU(S2)		;IS THIS THE UCB WE WANT ???
	CAMN	P2,.UCBNM(S2)		;   OR DO WE MATCH HERE ???
	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
	EXCH	S2,P2			;SWAP SIXBIT DEVICE NAME WITH UCB ADDR
	JUMPE	P1,.RETT		;OK IF DEVICE IS AVAILABLE,,RETURN
	LOAD	P2,.UCBST(P2),UC.AVA	;GET THE DEVICE AVAILABLE BIT
	JUMPN	P2,.RETT		;WE OWN THE DEVICE,,SO RETURN
	 $ERJMP	MD$IUD			;RETURN ERROR
>
	SUBTTL	GETRSN - ROUTINE TO RETURN THE FIRST AVAILABLE RESOURCE NUMBER

	;CALL:	No Args
	;
	;RET:	S1/ The Next Resource Number

TOPS10<
GETRSN:	MOVE	S1,AMATRX		;GET THE 'A' MATRIX ADDRESS
	LOAD	S2,.AMHDR(S1),AM.MCN	;GET THE NUMBER OF SLOTS IN BLOCK
	JUMPE	S2,GETR.2		;NULL COUNT,,SHOULD NOT HAPPEN
	MOVNS	S2			;NEGATE IT
	HRLZS	S2			;TO LH
	ADDI	S2,1			;1 IN RH

GETR.1:	ADDI	S1,AMALEN		;GET NEXT MATRIX ENTRY
	SKIPGE	.AMNAM(S1)		;IS THIS RESOURCE ALLOCATED ???
	AOBJN	S2,GETR.1		;YES, TRY THE NEXT ONE
	JUMPGE	S2,GETR.2		;NO FREE BLOCKS
	HRRZ	S1,S2			;EXTRACT WINNING INDEX
	MOVE	S2,AMATRX		;AIM AT CURRENT BASE
	LOAD	TF,.AMHDR(S2),AM.CNT	;GET HIGHEST SLOT IN USE
	CAIGE	TF,0(S1)		;IS THIS A NEW HIGH?
	STORE	S1,.AMHDR(S2),AM.CNT	;YES, SAVE THE NEW HIGH WATER MARK
	$RETT				;GIVE THE CALLER THE INDEX

	;Here if we have to expand the 'A' matrix

GETR.2:	MOVE	S1,AMATRX		;GET THE 'A' MATRIX ADDRESS
	INCR	.AMHDR(S1),AM.CNT	;BUMP THE HIGH WATER MARK
	INCR	.AMHDR(S1),AM.MCN	;AND THERE WILL BE SPACE FOR 1 MORE, TOO
	PUSH	P,AMATRX		;SAVE THE OLD 'A' MATRIX FOR LATER
	LOAD	S1,.AMHDR(S1),AM.LEN	;GET THE CURRENT MATRIX LENGTH
	ADDI	S1,AMALEN		;ADD 1 MORE ENTRY
	PUSHJ	P,M%GMEM		;GET SOME CORE FOR NEW 'A' MATRIX
	EXCH	S2,AMATRX		;SWAP OLD AND NEW 'A' MATRIX ADDRESSES
	MOVSS	S2			;GET OLD,,0
	HRR	S2,AMATRX		;GET OLD,,NEW ADDRESSES
	ADDI	S1,-AMALEN(S2)		;GET NEW MATRIX END ADDRESS
	BLT	S2,-1(S1)		;COPY OLD MATRIX TO NEW MATRIX
	MOVE	S2,AMATRX		;GET THE NEW 'A' MATRIX ADDRESS
	LOAD	S1,.AMHDR(S2),AM.LEN	;GET THE OLD MATRIX LENGTH
	ADDI	S1,AMALEN		;ADD ANOTHER ENTRY LENGTH
	STORE	S1,.AMHDR(S2),AM.LEN	;AND SAVE THE NEW 'A' MATRIX LENGTH
	POP	P,S2			;GET THE OLD 'A' MATRIX ADDRESS BACK
	LOAD	S1,.AMHDR(S2),AM.LEN	;GET THE OLD 'A' MATRIX LENGTH BACK
	PUSHJ	P,M%RMEM		;RETURN THE MEMORY
	MOVE	S1,AMATRX		;GET THE 'A' MATRIX ADDRESS
	LOAD	S1,.AMHDR(S1),AM.CNT	;RETURN THE LAST MATRIX ENTRY AS A RSN
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	GIVRSN - Return a slot of the A matrix

	;This routine marks a slot of the A matrix as free
	;This routine also keeps track of AM.CNT, the highest
	; slot in use in the A matrix.
	;
	;CALL:	S1/ Resource number
	;
	;RET:	True Always

TOPS10<
GIVRSN:	JUMPE	S1,.RETT		;IF NO RSN, JUST RETURN
	MOVE	S2,S1			;GET THE RSN IN S2
	IMULI	S2,AMALEN		;GET THE OFFSET TO THE 'A' MATRIX ENTRY
	ADD	S2,AMATRX		;GET THE 'A' MATRIX ENTRY ADDRESS
	LOAD	S2,.AMCNT(S2),AM.ALO	;GET THE ALLOCATION COUNT
	JUMPN	S2,.RETT		;NOT ZERO,,DON'T DELETE THE ENTRY

	MOVE	S2,AMATRX		;GET THE BASE OF THE MATRIX
	LOAD	TF,.AMHDR(S2),AM.CNT	;GET CURRENT HIGHEST SLOT #
	CAIE	TF,0(S1)		;RETURNING THE HIGHEST SLOT IN USE?
	JRST	GIVR.3			;NO, KEEP GOING
	PUSH	P,S1			;SAVE RSN BEING RETURNED
	IMULI	S1,AMALEN		;INDEX INTO THE TABLE
	ADDI	S1,0(S2)		;AIM AT THIS SLOT

GIVR.1:	SUBI	S1,AMALEN		;BACK OFF TO NEXT LOWER SLOT
	SOJLE	TF,GIVR.2		;ANY SLOTS LEFT?
	SKIPL	.AMNAM(S1)		;IS THIS SLOT FREE?
	JRST	GIVR.1			;YES, TRY THE NEXT

GIVR.2:	STORE	TF,.AMHDR(S2),AM.CNT	;SAVE PRESENT HIGH WATER MARK
	POP	P,S1			;GET BACK RETURNED RSN

GIVR.3:	IMULI	S1,AMALEN		;INDEX INTO THE BLOCK
	ADD	S1,AMATRX		;AIM AT THE ENTRY
	MOVE	S2,.AMNAM(S1)		;GET THE NAME, AND PERMANENT BIT
	SETZM	.AMNAM(S1)		;CLEAR IT ALL OUT
	TXNE	S2,AM.PRM		;IS NAME IN PERMANENT A MATRIX?
	$RETT				;YES, LEAVE IT THERE
	LOAD	S2,S2,AM.NAM		;GET JUST THE STRING ADRS
	MOVEI	S1,AMNMLN		;LENGTH OF THE BLOCK
	$CALL	M%RMEM			;GIVE BACK THE STORAGE
	$RETT
> ;END TOPS10 CONDITIONAL
	SUBTTL	FNTAPE - ROUTINE TO FIND A TAPE VOLUME IN THE VOL DATA BASE
	;	FNDISK -   ""   ""   ""    DISK   ""   ""  ""  ""  ""   ""
	;CALL:	S1/ The Volume We are Looking For
	;
	;FNDISK RET:	S1/ The Volume block Address
	;
	;FNTAPE RET:	S1/ The Volume block Address
	;		S2/ The UCB Address if The Volume is Mounted or 0

D$FNDV::				;MAKE 'FNDISK' GLOBAL
FNDISK:	SKIPA	S2,[%DISK]		;WANT TO FIND STRUCTURE VOLUMES
FNTAPE:	MOVX	S2,%TAPE		;WANT TO FIND TAPE VOLUMES
	SETZM	TF			;WANT TO WTO THE OPERATOR
	JRST	CHKV.0			;CONTINUE ON

FNTAPX:	MOVX	S2,%TAPE		;WANT A TAPE VOL
	SETOM	TF			;  BUT NO WTO IF MOUNTED

CHKV.0:	PUSHJ	P,.SAVE3		;SAVE P1 - P3  FOR A MINUTE
	MOVE	P1,S1			;SAVE THE VOL WE ARE LOOKING FOR
	MOVE	P2,S2			;SAVE THE ENTRY POINT INDICATOR
	MOVE	P3,TF			;SAVE THE WTO FLAG

	;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
	SKIPE	S2,.VLVSL(S1)		;GET A VSL ADDRESS
	LOAD	S2,.VSFLG(S2),VS.TYP	;GET THE VOLUME TYPE
	JUMPE	S2,[MOVE S2,.VLUCB(S1)	;NO VSL ADDRESS,,GET UCB ADDRESS
		    LOAD S2,.UCBST(S2),UC.DVT ;GET THE VOLUME TYPE
		    JRST CHKV.3 ]	;AND CONTINUE
CHKV.3:	CAME	S2,P2			;DO WE HAVE THE CORRECT VOLUME TYPE ???
	JRST	CHKV.1			;NO,,TRY NEXT

	CAXE	P2,%TAPE		;LOOKING FOR TAPE VOLUMES ???
	$RETT				;NO,,RETURN

	JUMPN	P3,.RETT		;NO WTO,,RETURN

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

	SKIPE	S2,.VLUCB(S1)		;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	FNDOWN - FIND ANY OWNER OF A VOLUME 

	;CALL:	S1/ The VOL Block Address
	;
	;RET:	S1/ The Address of The VSL Address of The First Owner
	;
	;	False if the Volume is not owned

D$VOWN::
FNDOWN:	LOAD	TF,.VLOWN(S1),VL.CNT	;GET THE VOLUME REQUEST COUNT
	JUMPE	TF,.RETF		;NO REQUESTORS,,NO OWNERS...
	MOVNS	TF			;NEGATE IT
	HRL	S1,TF			;GET NEGATIVE COUNT IN LEFT HALF
	MOVX	TF,VL.ASN+VL.ASK	;GET THE VOLUME ASSIGNED+ASK BITS
FNDO.1:	TDNE	TF,.VLVSL(S1)		;DOES THIS USER OWN THE VOLUME ???
	JRST	[MOVEI  S1,.VLVSL(S1)	;YES,,GET THE ADDRESS OF THE VSL ADDRESS
		 $RETT ]		;AND RETURN IT
	AOBJN	S1,FNDO.1		;NO,,TRY NEXT
	$RETF				;AND RETURN
	SUBTTL	FNDMDR - ROUTINE TO FIND AN MDR GIVEN ITS JOB NUMBER

	;CALL:	FNDMDR:	S1/ The Users Job #
	;
	;RET:	AP/ The MDR Address If Found
	;	False if the MDR Can't be Found

D$FMDR::
FNDMDR:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A MINUTE
	MOVE	P1,S1			;SAVE THE JOB NUMBER
	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	.RETF			;MDR NOT FOUND !!!
	LOAD	S1,.MRJOB(S2),MD.PJB	;LOAD THE MDR JOB NUMBER
	CAIE	S1,0(P1)		;DO THEY MATCH ???
	JRST	FNDM.1			;NO,,TRY THE NEXT MDR
	MOVE	AP,S2			;YES,,GET THE MDR ADDRESS IN AP
	$RETT				;RETURN
SUBTTL	D$CCAT - Compare catalogue entries


; Call:	MOVE	S1, old entry address
;	MOVE	S2, new entry address
;	PUSHJ	P,D$CCAT
;
; TRUE return:	match, duplicate (new) entry deleted, or old entry
;		updated to reflect changed parameters if possible.
;
; FALSE return:	mismatch, attempt to update the old entry failed.
;		to purge the old entry will be made
;
; Note:		On either return, the operator will be notified of a
;		catalogue update or failure to do so.  S1 will always
;		contain the entry address to use.
;
TOPS10	<				;TOPS-10 ONLY
D$CCAT::$SAVE	<P1,P2,P3,P4>		;SAVE SOME ACS
	DMOVE	P1,S1			;COPY ARGUMENTS
	DMOVE	P3,P1			;THIS WAY WE'LL NEVER FORGET!
	MOVE	S1,.CTVSN(P1)		;GET OLD VSN
	MOVE	S2,.CTOID(P1)		;GET OLD OWNER
	CAMN	S1,.CTVSN(P2)		;SAME AS NEW VSN?
	CAME	S2,.CTOID(P2)		;SAVE AS NEW OWNER?
	JRST	CCAT.2			;NO
	MOVE	TF,.CTCNT(P1)		;GET OLD VOLUME COUNT
	CAME	TF,.CTCNT(P2)		;SAVE AS NEW VOLUME COUNT?
	JRST	CCAT.2			;NO
	MOVEI	P1,CATLEN(P1)		;POINT TO START OF VOLUME BLOCKS
	MOVEI	P2,CATLEN(P2)		;HERE TOO

CCAT.1:	MOVE	S1,.CTVID(P1)		;GET AN OLD UNIT ID
	MOVE	S2,.CTRSN(P1)		;GET AN OLD RESOURCE NUMBER
	CAMN	S1,.CTVID(P2)		;SAME AS NEW UNIT ID?
	CAME	S2,.CTRSN(P2)		;SAVE AS NEW RESOURCE NUMBER?
	JRST	CCAT.2			;NO
	ADDI	P1,CATBLN		;POINT TO NEXT ENTRY
	ADDI	P2,CATBLN		;HERE TOO
	SOJG	TF,CCAT.1		;LOOP
	MOVE	S1,P4			;GET DUPLICATE (NEW) ENTRY ADDRESS
	PUSHJ	P,CCAT.Z		;DELETE IT
	MOVE	S1,P3			;GET ENTRY ADDRESS TO USE
	$RETT				;AND RETURN
CCAT.2:	PUSHJ	P,CCAT.T		;SET UP TEXT AND WTO STUFF
	$TEXT	(CATTYO,<Old ^A>)	;INTRO
	MOVE	S1,P3			;GET OLD ADDRESS
	PUSHJ	P,D$TCAT		;TYPE ENTRY
	$TEXT	(CATTYO,<New ^A>)	;INTRO
	MOVE	S1,P4			;GET NEW ADDRESS
	PUSHJ	P,D$TCAT		;TYPE ENTRY
	MOVE	S1,.CTVSN(P4)		;GET NEW VSN
	PUSHJ	P,D$UCAT		;FIND ALL USERS OF THIS ENTRY
	SKIPE	P1,S1			;GET # ALLOCATED
	JRST	CCAT.3			;THERE AREN'T ANY
	JUMPE	P1,CCAT.3		;ARE THERE ANY?
	MOVEI	S1,[ASCIZ |user|]	;ASSUME ONLY ONE
	CAIE	P1,1			;IS IT?
	MOVEI	S1,[ASCIZ |users|]	;MAKE IT PLURAL
	$TEXT	(CATTYO,<^W/.CTVSN(P4)/ is allocated by ^D/P1/ ^T/(S1)/>)
	$WTO	(<Internal catalogue entry conflict>,<^T/CATTXT/>,CATOBJ,<$WTFLG(WT.SJI)>)
	MOVE	S1,P4			;GET DUPLICATE (NEW) ENTRY ADDRESS
	PUSHJ	P,CCAT.Z		;DELETE IT
	MOVE	S1,P3			;GET ENTRY TO USE
	$RETF				;AND RETURN

CCAT.3:	$TEXT	(CATTYO,<Deleting old entry^0>)
	$WTO	(<Internal catalogue entry conflict>,<^T/CATTXT/>,CATOBJ,<$WTFLG(WT.SJI)>)
	MOVE	S1,P3			;GET OLD ENTRY ADDRESS
	PUSHJ	P,CCAT.Z		;DELETE IT
	MOVE	S1,P4			;GET ENTRY TO USE
	$RETT				;AND RETURN
; Set up text buffer
;
CCAT.T:	MOVEI	S1,.OTMNT		;GET OBJECT TYPE MOUNT
	MOVEM	S1,CATOBJ+OBJ.TY	;SAVE IT
	MOVE	S1,.CTVSN(P3)		;GET VSN
	MOVEM	S1,CATOBJ+OBJ.UN	;SAVE IT
	SETZM	CATOBJ+OBJ.ND		;NO NODE INFO
	MOVEI	S1,<CATSIZ*5>-1		;GET CHARACTER COUNT
	MOVEM	S1,CATCNT		;SAVE IT
	MOVE	S1,[POINT 7,CATTXT]	;GET BYTE POINTER
	MOVEM	S1,CATPTR		;SAVE IT
	POPJ	P,			;RETURN


; Character sticker
;
CATTYO:	SOSLE	CATCNT			;COUNT CHARACTERS
	IDPB	S1,CATPTR		;STUFF ONE IN THE BUFFER
	$RETT				;RETURN


; Delete an entry
; Call:	MOVE	S1, entry address
;
CCAT.Z:	MOVE	S2,S1			;GET ENTRY ADDRESS
	SETZM	.CTVSN(S2)		;BE DEFENSIVE
	MOVE	S1,CATQUE		;GET QUEUE HEADER
	$CALL	L%APOS			;POSITION TO IT
	  SKIPF				;SHOULDN'T HAPPEN
	$CALL	L%DENT			;DELETE IT
	POPJ	P,			;AND RETURN

> ;END TOPS-10 CONDITIONAL
	SUBTTL	D$FCAT - ROUTINE TO SEARCH THE CATALOG CACHE FOR A VOL SET

	;CALL:	S1/ The Vol Set Name (SIXBIT)
	;
	;Ret:	S1/ The Entry Address

TOPS10<
D$FCAT:	PUSHJ	P,.SAVE1		;SAVE P1 FOR A SECOND
	MOVE	P1,S1			;SAVE THE VOL SET NAME
	MOVE	S1,CATQUE		;GET THE CATALOG QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JRST	FCAT.2			;JUMP THE FIRST TIME THROUGH

FCAT.1:	MOVE	S1,CATQUE		;GET THE CATALOG QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT ENTRY
FCAT.2:	JUMPF	.RETF			;NOT THERE,,RETURN NO GOOD
	CAME	P1,.CTVSN(S2)		;IS THIS THE ONE WE WANT ???
	JRST	FCAT.1			;NO,,TRY NEXT
	MOVE	S1,S2			;YES,,GET ENTRY ADDRESS
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL
SUBTTL	D$TCAT - Type a catalogue entry


; Call:	MOVE	S1, entry address
;	PUSHJ	P,D$TCAT
;
TOPS10	<				;TOPS-10 ONLY
D$TCAT::$SAVE	<P1,P2>			;SAVE SOME ACS
	MOVE	P1,S1			;SAVE ENTRY ADDRESS
	MOVEI	S1,0			;ASSUME NO WILDCARDING
	MOVE	S2,.CTOID(P1)		;GET THE OWNER PPN
	TRC	S2,-1			;CHECK FOR A WILD
	TRCN	S2,-1			; PROGRAMMER NUMBER
	MOVEI	S1,1			;GOT ONE
	TLC	S2,-1			;CHECK FOR A WILD
	TLCN	S2,-1			; PROJECT NUMBER
	IORI	S2,2			;GOT ONE
	SKIPN	S2			;REALLY HAVE A PPN?
	SETO	S1,			;NO
	MOVE	S1,TCAT.A(S1)		;GET APPROPRIATE ITEXT BLOCK
	MOVEI	S2,[ITEXT (<>)]		;ASSUME NO USER NAME
	SKIPE	.CTNAM+0(P1)		;HAVE WORD 1?
	MOVEI	S2,[ITEXT (< user ^W/.CTNAM(P1)/>)] ;YES
	SKIPE	.CTNAM+1(P1)		;HAVE WORD 2?
	MOVEI	S2,[ITEXT (< user ^W6/.CTNAM(P1)/^W/.CTNAM+1(P1)/>)] ;YES
	$TEXT	(CATTYO,<^W/.CTVSN(P1)/ Owned by ^I/(S1)/^I/(S2)/, ^A>)
	MOVE	S1,.CTBLD(P1)		;GET BUILD CODE
	$TEXT	(CATTYO,<^T/@TCAT.B(S1)/>) ;SAY WHERE IT CAME FROM
	MOVE	P2,.CTCNT(P1)		;GET THE UNIT COUNT
	MOVEI	S1,[ASCIZ |unit:|]	;ASSUME ONE
	CAIE	P2,1			;IS IT
	MOVEI	S1,[ASCIZ |units:|]	;MAKE IT PLURAL
	$TEXT	(CATTYO,<    ^D/P2/ ^T/(S1)/ ^A>)
	MOVEI	P1,CATLEN(P1)		;POINT TO START OF VOLUME BLOCKS
TCAT.1:	MOVE	S1,UCBQUE		;GET THE UCB QUEUE HEADER
	$CALL	L%FIRST			;POSITION TO FIRST ENTRY
	JRST	TCAT.3			;ONWARD

TCAT.2:	MOVE	S1,UCBQUE		;GET THE UCB QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT UCB ADDRESS

TCAT.3:	JUMPF	TCAT.4			;NO MORE AVAILABLE,,JUST RETURN
	LOAD	S1,.UCBST(S2),UC.RSN	;GET THE DEVICE RESOURCE NUMBER
	CAME	S1,.CTRSN(P1)		;THE ONE WE'RE LOOKING FOR?
	JRST	TCAT.2			;NO
	IMULI	S1,AMALEN		;GET 'A' MATRIX OFFSET
	ADD	S1,AMATRX		;GET THE 'A' MATRIX ENTRY ADDRESS
	LOAD	S1,.AMNAM(S1),AM.NAM	;GET ADDRESS OF ASCIZ RESOURCE NAME
	MOVEI	S2,[ITEXT (<>)]		;ASSUME LAST UNIT
	CAIE	P2,1			;IS IT?
	MOVEI	S2,[ITEXT (<, ^A>)]	;NO
	$TEXT	(CATTYO,<^W/.CTVID(P1)/(^T/(S1)/)^I/(S2)/>)
	ADDI	P1,CATBLN		;POINT TO NEXT VOL BLOCK
	SOJG	P2,TCAT.1		;LOOP
	POPJ	P,			;RETURN

TCAT.4:	$TEXT	(CATTYO,<Can't find UCBs for units>)
	POPJ	P,			;RETURN


; Table of PPN ITEXT blocks
;
	[ITEXT (<no one>)]
TCAT.A:	[ITEXT (<[^O/.CTOID(P1),LHMASK/,^O/.CTOID(P1),RHMASK/]>)]
	[ITEXT (<[^O/.CTOID(P1),LHMASK/,*]>)
	[ITEXT (<[*,.CTOID(P1),RHMASK/>)]
	[ITEXT (<[*,*]>)]](S1)


; Table of build code strings
;
TCAT.B:	[ASCIZ	|entry came from STRLST.SYS|]
	[ASCIZ	|entry created by QUASAR|]

> ;END TOPS-10 CONDITIONAL
SUBTTL	D$UCAT - Find the number users of a catalogue entry


; Call:	MOVE	S1, sixbit VSN
;	PUSHJ	P,D$UCAT
;
; Note:	Change the call to D$SRSN if we ever cache
;	other things besides disks.
;
TOPS10	<				;TOPS-10 ONLY
D$UCAT::PUSHJ	P,D$SRSN		;CONVERT STR NAME TO RESOURCE NUMBER
	IMULI	S1,AMALEN		;GET 'A' MATRIX OFFSET
	ADD	S1,AMATRX		;GET THE ENTRY ADDRESS
	LOAD	S2,.AMCNT(S1),AM.CLM	;GET # MOUNTED
	LOAD	S1,.AMCNT(S1),AM.ALO	;GET # ALLOCATED
	HRL	S1,S2			;PUT MOUNT COUNT IN LH
	MOVSS	S1			;MAKE IT # ALLOCATED,,# MOUNTED
	POPJ	P,			;RETURN

> ;END TOPS-10 CONDITIONAL
	SUBTTL	FNDVSL - ROUTINE TO FIND A PARTICULAR VSL IN AN MDR

	;CALL:	S1/ The VSL Request ID
	;
	;RET:	S1/ The VSL Address if Found
	;	AP/ The MDR Address

D$FVSL::
FNDVSL:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	P1,S1			;SAVE THE VSL REQUEST ID
	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST VSL ENTRY
	JRST	FNDV.2			;JUMP THE FIRST TIME THROUGH

FNDV.1:	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT VSL ENTRY
FNDV.2:	JUMPF	.RETF			;NO MORE,,RETURN
	LOAD	S1,.VSRID(S2),VS.RID	;GET THE VSL REQUEST ID
	CAME	P1,S1			;DO THEY MATCH ???
	JRST	FNDV.1			;NO,,TRY NEXT VSL
	MOVE	AP,.VSMDR(S2)		;YES,,SETUP THE MDR POINTER
	MOVE	S1,S2			;AND THE VSL ADDRESS
	$RETT				;RETURN
	SUBTTL	FNDVSN - ROUTINE TO FIND A VOLUME SET VIA THE VOL SET NAME

	;CALL:	S1/ The Asciz Vol Set Name Address
	;
	;RET:	S1/ The VSL Address

TOPS10<
D$FVSN::
FNDVSN:	PUSHJ	P,.SAVE2		;SAVE P1 & P2 FOR A MINUTE
	HRROI	P2,0(S1)		;GET -1,,VOL SET NAME ADDR
	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT
	MOVNS	P1			;NEGATE IT
	MOVSS	P1			;MOVE RIGHT TO LEFT
	HRRI	P1,.MRVSL(AP)		;CREATE VSL SEARCH AOBJN AC

DVSN.1:	MOVE	S1,0(P1)		;GET A VSL ADDRESS
	HRROI	S1,.VSVSN(S1)		;POINT TO THE VSL VOL SET NAME
	MOVE	S2,P2			;GET THE SOURCE VOL SET NAME POINTER
	PUSHJ	P,S%SCMP		;PERFORM THE STRING COMPARE
	TXNN	S1,SC%LSS+SC%SUB+SC%GTR	;ANY OF THESE BITS LIT ???
	JRST	[MOVE	S1,0(P1)	;NO SO WE MATCH,,GET THE VSL ADDRESS
		 $RETT	]		;AND RETURN

	AOBJN	P1,DVSN.1		;NO MATCH,,TRY NEXT VSL
	$RETF				;NOT THERE !!!
> ;END TOPS10 CONDITIONAL
	SUBTTL	FNDLNM - ROUTINE TO FIND A USERS VSL GIVEN A LOGICAL NAME

	;CALL:	S1/ The Asciz Vole Set Name Address
	;	AP/ The MDR Address
	;
	;RET:	S1/ The VSL Address if Found

TOPS10<
D$FLNM::				;MAKE IT GLOBAL
FNDLNM:	PUSHJ	P,.SAVE1		;SAVE P1 
	HRROI	S1,0(S1)		;POINT TO ASCIZ VOLUME SET NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	LDB	S1,S1			;GET TERMINATOR
	JUMPN	S1,.RETF		;MUST BE NULL FOR LOGICAL NAMES
	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT
	MOVNS	P1			;NEGATE IT
	MOVSS	P1			;MOVE RIGHT TO LEFT
	HRRI	P1,.MRVSL(AP)		;CREATE VSL SEARCH AOBJN AC

FNDL.1:	MOVE	S1,0(P1)		;GET A VSL ADDRESS
	CAMN	S2,.VSLNM(S1)		;DO THE LOGICAL NAMES MATCH ???
	$RETT				;FOUND IT,,RETURN NOW
	AOBJN	P1,FNDL.1		;CONTINUE THROUGH ALL VSL'S
	$RETF				;NOT THERE,,RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	VSLFND - ROUTINE TO FIND A VSL IN A USERS REQUEST

	;CALL:	S1/ The Mount Msg Entry Address
	;	AP/ The MDR Address
	;
	;RET:	S1/ The VSL Address 

	;This routine searches the users request queue looking for a VSL
	;which has the same name as one which he is currently trying
	;to mount. It first looks for a VSL which has the same logical
	;name, then the one which has the same Vol Set Name.

TOPS10<
VSLFND:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVEI	P1,.MEHSZ(S1)		;POINT TO THE FIRST ENTRY BLOCK
	MOVE	P2,.MECNT(S1)		;GET THE ENTRY COUNT
	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE REQUEST COUNT
	JUMPE	S1,.RETF		;NONE THERE,,RETURN

VSLF.1:	LOAD	S1,ARG.HD(P1),AR.TYP	;GET THIS BLOCK TYPE
	CAXE	S1,.SMNAM		;IS IT THE VOL SET NAME ???
	CAXN	S1,.TMSET		;IS IT THE VOL SET NAME BLOCK ???
	JRST	VSLF.2			;YES,,CHECK IT OUT
	LOAD	S1,ARG.HD(P1),AR.LEN	;NO,,GET THIS BLOCKS LENGTH
	ADD	P1,S1			;POINT TO THE NEXT BLOCK
	SOJG	P2,VSLF.1		;CONTINUE FOR ALL BLOCKS
	$RETF				;NO VOL SET NAME BLOCK FOUND !!!

VSLF.2:	AOS	P1			;POINT TO THE ASCIZ VOL SET NAME
	MOVE	S1,P1			;GET ITS ADDRESS IN S1
	PUSHJ	P,FNDLNM		;LOOK FOR THE LOGICAL NAME 
	JUMPT	.RETT			;FOUND,,RETURN NOW
	MOVE	S1,P1			;GET THE VOL SET NAME ADDR BACK
	PJRST	FNDVSN			;RETURN LOOKING FOR THE VOL SET NAME
> ;END TOPS10 CONTITIONAL

TOPS20<	
VSLFND:	$RETF	>			;ALWAYS RETURN FALSE ON THE -20
	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
	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	ADDVOL -  ROUTINE TO ADD A VOL BLOCK DURING MOUNT PROCESSING

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

ADDVOL:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2 FOR A SECOND
	DMOVE	P1,S1			;SAVE THE CALLING ARGS
	PUSHJ	P,SCNVOL		;GO FIND THE REQUESTED VOLUME
	JUMPT	.RETT			;FOUND ONE,,RETURN NOW
	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	P1,.VLNAM(S2)		;SAVE THE VOLID IN THE VOL
	MOVEM	P2,.VLVSL(S2)		;LINK THE VSL TO THE VOL
	MOVX	S1,%STAWT		;GET 'VOLUME WAITING' CODE
	STORE	S1,.VLFLG(S2),VL.STA	;SAVE IT AS THE VOLUME STATUS
	INCR	.VLOWN(S2),VL.CNT	;BUMP THE REQUEST COUNT BY 1
	MOVE	S1,S2			;GET THE VOL BLK ADDR IN S1
	$RETT				;RETURN
	SUBTTL	CKUVOL - CHECK FOR MULTIPLE USER REQUESTS FOR THE SAME TAPE VOL
;		CKOVOL - SAME - BUT OPERATOR ENTRY POINT

	;CALL:	S1/ The VSL address
	;	AP/ The MDR Address
	;
	;RET:	True - if ok
	;	False - The error text inserted into the generic ack buffer

TOPS10<
CKTVOL:	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	$SAVE	<T1,T2>			;SAVE T1 AND T2 ALSO
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	LOAD	P2,.MRCNT(AP),MR.CNT	;GET THE VSL COUNT
	MOVNS	P2			;NEGATE IT
	MOVSS	P2			;MOVE RIGHT TO LEFT
	HRRI	P2,.MRVSL(AP)		;CREATE VSL AOBJN AC
CKTV.1:	MOVE	P3,0(P2)		;GET A VSL ADDRESS
	LOAD	S1,.VSFLG(P3),VS.TYP	;GET THE VSL TYPE
	CAXE	S1,%TAPE		;IS IT A TAPE VOLUME SET ???
	JRST	CKTV.6			;NO,,TRY NEXT
CKTV.2:	LOAD	S1,.VSCVL(P1),VS.CNT	;GET THE VOLUME COUNT
	MOVNS	S1			;NEGATE IT
	MOVSS	S1			;MOVE RIGHT TO LEFT
	HRRI	S1,.VSVOL(P1)		;CREATE VOL AOBJN AC
CKTV.3:	LOAD	S2,.VSCVL(P3),VS.CNT	;GET THE VOLUME COUNT
	MOVNS	S2			;NEGATE IT
	MOVSS	S2			;MOVE RIGHT TO LEFT
	HRRI	S2,.VSVOL(P3)		;CREATE VOL AOBJN AC
	MOVE	P4,0(S1)		;GET THE MASTER VOL ADDRESS
	SKIPN	P4,.VLNAM(P4)		;AND GET ITS VOLID
	JRST	CKTV.6			;NONE,,ASSUME A SCRATCH TAPE & CONTINUE
	SETZM	T2			;CLEAR VOLUME COUNTER
CKTV.4:	AOS	T2			;BUMP VOLUME COUNTER BY 1
	MOVE	T1,0(S2)		;GET THE TARGET VOL ADDRESS
	CAME	P4,.VLNAM(T1)		;DO VOLIDS MATCH ???
	JRST	CKTV.5			;NO,,CONTINUE ONWARD !!!
	CAMN	P1,P3			;YES,,SAME VOLUME SET ???
	CAME	S1,S2			;YES,,SAME VOLUME SET INDEX ???
	JRST	CKTV.7			;NO,,THATS AN ERROR
CKTV.5:	AOBJN	S2,CKTV.4		;CHECK THROUGH ALL TARGET VOLUMES
	AOBJN	S1,CKTV.3		;CHECK THROUGH ALL MASTER VOLIDS
CKTV.6:	AOBJN	P2,CKTV.1		;CHECK THROUGH ALL VSL'S
	$RETT				;OK,,RETURN

CKTV.7:	$TEXT	(<-1,,@G$ACKB>,<Volume ^W/P4/ is volume # ^D/T2/ in volume set ^T/.VSVSN(P3)/^0>)
	PJRST	E$XXX##			;RETURN THE ERROR
> ;END TOPS10 CONDITIONAL

TOPS20<
CKTVOL:	$RETT	>			;RETURN OK ON THE -20
	SUBTTL	MISC ROUTINES

TOPS10<
MISC.3:	$WTO	(<Invalid message from PULSAR>,<^M^JMSG: ^O/0(M)/, ^O/1(M)/, ^O/2(M)/, ^O/3(M)/, ^O/4(M)/^M^J^O/5(M)/, ^O/6(M)/, ^O/7(M)/, ^O/10(M)/, ^O/11(M)/>,,<$WTFLG(WT.SJI)>)
	$RETT

	;BLISS General Stopcode
	;Call -
	;	S1/ Address of ASCIZ explanation
	;Return -
	;	NEVER

D$STOP:: $STOP(BLI,^T/0(S1)/)

	;Routine to tell the operator that a user requested a structure
	;be dismounted
	;
	;CALL:	S1/ The VSL Address
	;	AP/ The MDR Address

TELREM:	MOVE	S2,.VSVOL(S1)		;GET THE VOL BLOCK ADDRESS
	MOVE	S1,.VLNAM(S2)		;GET THE STR NAME
	MOVEM	S1,MDAOBJ+OBJ.UN	;SAVE IT IN THE OBJECT BLOCK
	$WTO	(<User requests this structure be dismounted^T/BELLS/>,<^I/DEMO/>,MDAOBJ)
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL

	;$TEXT Action routine and byte pointer

MDADBP:: SKIPN	G$MSG+MSGLN##-1		;CHECK FOR END OF BUFFER
	 IDPB	S1,MDBPTR		;JUST DUMP THE CHAR
	 $RETT				;AND WIN
MDBPTR:: BLOCK	1			;SPACE FOR A BYTE POINTER
	SUBTTL	D$MDAE - ROUTINE TO NOTIFY THE OPERATOR OF ANY ERRORS

	;This routine notifies the operator of any MDA related error
	;
	;CALL:	P/ The address of the Parameter Word
	;
	;RET:	False Always

TOPS10<
D$MDAE::SETZM	TF			;NO VSL ADDRESS
	LOAD	TF,@0(P),AC.VSL		;GET THE AC WHICH CONTAINS THE VSL ADDR
	TXO	TF,MOVE			;CREATE 'MOVE TF,AC' INSTRUCTION
	XCT	TF			;GET THE VSL ADDRESS IN TF
	POP	P,S1			;GET THE ERROR CODE & AC ADDRESS
	LOAD	S1,0(S1),ER.CDE		;PICK UP THE ERROR CODE 
	TXNN	TF,MOVE			;DO WE HAVE A VSL ADDRESS ???
	JRST	MDAE.1			;YES,,PROCESS A LITTLE DIFFERENTLY !!!
	$WTO	(<^T/@MDAERS-1(S1)/>,,MDAOBJ) ;ELSE TELL OPERATOR
	$RETF				;RETURN

MDAE.1:	$SAVE	<S2,T1,AP>		;SAVE SOME AC'S
	MOVE	S2,TF			;GET THE VSL ADDRESS IN S2
	MOVE	AP,.VSMDR(S2)		;GET THE MDR ADDRESS IN AP
	LOAD	T1,.VSCVL(S2),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	T1,.VSVOL(S2)		;POINT TO THE ADDRESS
	MOVE	T1,0(T1)		;LOAD THE CURRENT VOLUME ADDRESS
	LOAD	TF,.MRJOB(AP),MD.PJB	;GET THE USERS JOB NUMBER
	TXNE	TF,BA%JOB		;A PSEUDO PROCESS?
	JRST	MDAE.2			;YES
	$WTO	(<^T/@MDAERS-1(S1)/>,<^I/DEMO/^M^JVolume Set:^T/.VSVSN(S2)/  Volid:^W/.VLNAM(T1)/  Request-ID: ^D/.VSRID(S2),VS.RID/>,MDAOBJ)
	$RETF				;RETURN

MDAE.2:	$WTO	(<^T/@MDAERS-1(S1)/>,<User: [SYSTEM] for ^15/.MRFLG(AP),MR.QUE/ request #^D/TF/^M^JVolume Set:^T/.VSVSN(S2)/  Volid:^W/.VLNAM(T1)/  Request-ID: ^D/.VSRID(S2),VS.RID/>,MDAOBJ)
	$RETF				;RETURN

> ;END TOPS10 CONDITIONAL
	SUBTTL	DSKRSN - ROUTINE TO RETURN RESOURCE NUMBERS FOR DISK DRIVES

	;CALL:	S1/ The .UCBST status word with Kontroller type & Unit Type
	;
	;RET:	S1/ The Device Resource Number

TOPS10<
DSKRSN:	PUSHJ	P,.SAVE2		;SAVE P1 & P2 FOR A SECOND
	LOAD	P1,S1,UC.KTP		;GET THE KONTROLLER TYPE IN P1
	LOAD	P2,S1,UC.UTP		;GET THE UNIT TYPE IN P2
	MOVE	S1,AMATRX		;GET THE 'A' MATRIX ADDRESS
	LOAD	S2,.AMHDR(S1),AM.CNT	;GET THE ENTRY COUNT
	JUMPE	S2,.RETF		;NULL MATRIX,,SHOULD NOT HAPPEN !!!

DSKR.1:	ADDI	S1,AMALEN		;BUMP TO NEXT MATRIX ELEMENT
	LOAD	TF,.AMSTA(S1),AM.DVT	;GET THE RESOURCE TYPE
	SKIPGE	.AMNAM(S1)		;IS THIS ENTRY VALID?
	CAXE	TF,%DISK		;YES,, IS THIS A DISK RESOURCE?
	JRST	DSKR.2			;NO,,TRY NEXT ENTRY
	LOAD	TF,.AMSTA(S1),UC.KTP	;GET THE ENTRY KONTROLLER TYPE
	CAME	TF,P1			;THEY MUST MATCH..
	JRST	DSKR.2			;NO,,TRY NEXT ENTRY
	LOAD	TF,.AMSTA(S1),UC.UTP	;GET THE ENTRY UNIT TYPE
	CAME	TF,P2			;THEY MUST MATCH..
	JRST	DSKR.2			;NO,,TRY NEXT ENTRY
	SUB	S1,AMATRX		;CALC OFFSET INTO MATRIX OF THIS ENTRY
	IDIVI	S1,AMALEN		;CALC RESOURCE NUMBER
	$RETT				;RETURN

DSKR.2:	SOJG	S2,DSKR.1		;LOOK AT ALL MATRIX ENTRIES
	$RETF				;NOT THERE !!!
> ;END TOPS10 CONDITIONAL
	SUBTTL	TAPRSN - ROUTINE TO RETURN RESOURCE NUMBERS FOR TAPE DRIVES

	;CALL:	S1/ The Density Status Bits
	;	S2/ The Track Status Code
	;	T1/ The starting RSN if ANYTAP entry
	;
	;RET:	S1/ The Device Resource Number


TOPS10<
ANYTAP:	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	DMOVE	P1,S1			;SAVE THE DENSITY AND TRACK TYPE
	MOVEI	P3,0			;SET THE ENTRY INDICATOR
	MOVE	S1,AMATRX		;GET THE 'A' MATRIX ADDRESS
	LOAD	P4,.AMHDR(S1),AM.CNT	;GET THE ENTRY COUNT
	SUB	P4,T1			;GET REMAINING COUNT
	JUMPLE	P4,.RETF		;NO MORE ENTRIES,,RETURN
	MOVE	S1,T1			;GET THE STARTING RSN IN S1
	IMULI	S1,AMALEN		;GET THE OFFSET
	ADD	S1,AMATRX		;AND THE RESOURCE ADDRESS
	JRST	TAPR.1			;MEET AT THE PASS

TAPRSN:	PUSHJ	P,.SAVE4		;SAVE P1 & P2 FOR A SECOND
	DMOVE	P1,S1			;SAVE THE DENSITY AND TRACK TYPE 
	MOVEI	P3,1			;SET THE ENTRY INDICATOR
	MOVE	S1,AMATRX		;GET THE 'A' MATRIX ADDRESS
	LOAD	P4,.AMHDR(S1),AM.CNT	;GET THE ENTRY COUNT
	JUMPE	P4,.RETF		;NULL MATRIX,,SHOULD NOT HAPPEN !!!

TAPR.1:	ADDI	S1,AMALEN		;BUMP TO NEXT MATRIX ENTRY
	LOAD	S2,.AMSTA(S1),AM.DVT	;GET THE RESOURCE TYPE
	SKIPGE	.AMNAM(S1)		;IS THIS ENTRY VALID AT ALL?
	CAXE	S2,%TAPE		;YES,, IS THIS A TAPE RESOURCE?
	JRST	TAPR.2			;NO,,TRY NEXT ENTRY
	LOAD	S2,.AMSTA(S1),UC.TRK	;GET THE ENTRY TRACK TYPE
	CAME	S2,P2			;THEY MUST MATCH..
	JRST	TAPR.2			;NO,,TRY NEXT ENTRY
	MOVE	S2,.AMSTA(S1)		;GET THE STATUS BITS
	AND	S2,[UC.200+UC.556+UC.800+UC.1600+UC.6250] ;SAVE ONLY THESE BITS
	XCT	[TDNN S2,P1		;ANY BITS CAN MATCH !!!
		 CAME S2,P1](P3)	;ALL BITS MUST MATCH !!!
	 JRST	TAPR.2			;NO GOOD,,TRY NEXT ENTRY
	SUB	S1,AMATRX		;CALC OFFSET INTO MATRIX OF THIS ENTRY
	IDIVI	S1,AMALEN		;CALC THE RESOURCE NUMBER
	$RETT				;RETURN

TAPR.2:	SOJG	P4,TAPR.1		;LOOK AT ALL MATRIX ENTRIES
	$RETF				;NOT THERE !!!
> ;END TOPS10 CONDITIONAL
	SUBTTL	D$TNRS - GET A TAPE RESOURCE NUMBER
	;	D$DNRS - GET A DISK RESOURCE NUMBER


	;CALL:	D$TNRS:	S1/ The Density Status Bits
	;		S2/ The Track Status Code
	;
	;	D$DNRS:	S1/ The UCB Status Word
	;
	;RET:	S1/ The Resource Number if valid, False otherwise

TOPS10<
D$TNRS:	$SAVE	<T1>			;SAVE T1
	MOVEI	T1,TAPRSN		;GET STATUS CHECK ROUTINE EXACT MATCH
	PJRST	KNOWRS			;TRY TO FIND ONE , OR A NEW ONE

D$DNRS:	$SAVE	<T1>			;SAVE T1
	MOVEI	T1,DSKRSN		;GET THE SERVICE ROUTINE ADRS
	PJRST	KNOWRS			;GO FIND A KNOWN RESOURCE

	;This routine will find an existing resource of a given type
	; or look in the permanent A matrix for drives which match
	; If the entry is found in the permanent matrix, it is added
	; to the existing A matrix and the new resource number is returned

KNOWRS:	$SAVE	<P1,P2,P3>		;SAVE P1 - P3
	DMOVE	P1,S1			;SAVE THE CALLING ARGS
	PUSHJ	P,0(T1)			;TRY TO FIND IN THE EXISTING A MATRIX
	JUMPT	.RETT			;IF THAT WINS, WE'RE GOLDEN!
	DMOVE	S1,P1			;GET BACK STATUS BITS
	MOVEI	P1,AMATPM		;AIM AT THE PERMANENT A MATRIX
	EXCH	P1,AMATRX		;AND POINT THE WORLD AT THAT
	PUSHJ	P,0(T1)			;TRY TO FIND ONE OF THOSE
	JUMPF	[MOVEM	P1,AMATRX	;CAN'T GET IT THERE, RESTORE AMATRIX
		$RETF]			;GIVE THE BAD NEWS
	MOVE	P3,S1			;GOT IT, SAVE ITS INDEX
	EXCH	P1,AMATRX		;GET BACK TO OLD A MATRIX
	PUSHJ	P,GETRSN		;FIND A FREE SLOT
	PUSH	P,S1			;SAVE THE NEW RESOURCE NUMBER
	IMULI	S1,AMALEN		;INDEX INTO THE EXISTING A MATRIX
	IMULI	P3,AMALEN		;INDEX INTO PERMANENT A MATRIX
	ADD	S1,AMATRX		;AIM AT EXISTING SLOT
	ADDI	P3,0(P1)		;AIM AT PERMANENT SLOT
	HRL	S1,P3			;SET SOURCE FOR BLT
	MOVE	P3,S1			;COPY FOR TERMINATION ADRS
	BLT	S1,AMALEN-1(P3)		;MOVE THE DATA IN
	POP	P,S1			;GET BACK THE NEW RESOURCE NUMBER
	$RETT
> ;END TOPS10 CONDITIONAL
	SUBTTL	STRRSN - ROUTINE TO RETURN RESOURCE NUMBERS FOR STRUCTURES

	;CALL:	S1/ The Sixbit Structure Name
	;
	;RET:	S1/ The Structure Resource Number

TOPS10<
D$SRSN::
	MOVX	S2,%STRC		;GET RESOURCE TYPE -- FILE STRUCTURE

DEVRSN:	PUSHJ	P,.SAVE3		;SAVE SOME SCRATCH REGS
	MOVE	P3,S2			;SAVE THE RESOURCE TYPE
	$TEXT	(<-1,,TMPVSL>,<^W/S1/^0>) ;CONVERT STR NAME TO ASCII
	MOVE	P1,AMATRX		;GET THE 'A' MATRIX ADDRESS
	LOAD	P2,.AMHDR(P1),AM.CNT	;GET THE ENTRY COUNT
	JUMPE	P2,STRR.2		;NULL MATRIX,,SHOULD NOT HAPPEN !!!

STRR.1:	ADDI	P1,AMALEN		;BUMP TO THE NEXT MATRIX ELEMENT
	LOAD	S2,.AMSTA(P1),AM.DVT	;GET THE RESOURCE TYPE
	SKIPGE	S1,.AMNAM(P1)		;IS THIS ENTRY IN USE?
	CAME	S2,P3			;YES,, IS THIS THE CORRECT TYPE OF RESOURCE??
	JRST	STR.1A			;NOPE, TRY THE NEXT ENTRY
	HRLI	S1,-1			;AIM AT THE STRING
	HRROI	S2,TMPVSL		;AIM AT THE DESIRED NAME
	$CALL	S%SCMP			;COMPARE THE NAMES
	TXNE	S1,SC%LSS!SC%SUB!SC%GTR	;ANY BITS ON?
	JRST	STR.1A			;YES, THAT'S NOT EXACT MATCH
	SUB	P1,AMATRX		;NO,,CALC THE RESOURCE OFFSET
	IDIVI	P1,AMALEN		;CALC THE RESOURCE NUMBER
	MOVE	S1,P1			;MOVE IT INTO RETURN SLOT
	$RETT				;AND RETURN

STR.1A:	SOJG	P2,STRR.1		;LOOK AT ALL MATRIX ENTRIES

	;CONTINUED ON NEXT PAGE
	;CONTINUED FROM PREVIOUS PAGE

	;Here if the structure is not in the 'A' matrix,
	; so add an entry for it!
	;P1-P3 saved
	;P3/	Resource type
	;TMPVSL/	Resource name (ASCIZ)

STRR.2:	PUSHJ	P,GETRSN		;GET A RESOURCE NUMBER
	MOVE	P1,S1			;SAVE IT
	IMULI	P1,AMALEN		;CALC OFFSET INTO THE MATRIX
	ADD	P1,AMATRX		;LOCATE THE ENTRY
	MOVEI	S1,AMNMLN		;GET THE NAME SPACE SIZE
	$CALL	M%GMEM			;GET THE SPACE
	IORX	S2,AM.USE		;LITE THE IN-USE BIT
	MOVEM	S2,.AMNAM(P1)		;SAVE THE ADRS OF THE NAME
	HRLI	S2,TMPVSL		;AIM AT THIS STRUCTURE NAME
	HRRZI	S1,AMNMLN(S2)		;FIGURE TERMINATION ADRS
	BLT	S2,-1(S1)		;MOVE TH NAME IN
	SETZM	.AMSTA(P1)		;ZERO THE STATUS WORD
	STORE	P3,.AMSTA(P1),AM.DVT	;SET DESIRED RESOURCE TYPE
	MOVEI	S2,1			;GET DEFAULT NUMBER AVAILABLE
	CAXN	P3,%STRC		;IS THIS A SHARABLE RESOURCE?
	MOVX	S2,MAXRES		;YES,,GET MAX RESOURCE COUNT
	STORE	S2,.AMCNT(P1),AM.AVA	;MAKE IT THE NUMBER AVAILABLE
	SUB	P1,AMATRX		;CALC THE MATRIX OFFSET
	IDIVI	P1,AMALEN		;CALC THE RESOURCE NUMBER
	MOVE	S1,P1			;COPY THE RSN OVER
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	D$T/SVRS - Generate resource #s for Tape/Structure volumes

	;CALL:	S1/ VOL Block Address
	;
	;RET:	S1/ The Volume RSN
	;	Volume resource number in the vol block

TOPS10<
	INTERN	D$TVRS			;GLOBALIZE IT
	INTERN	D$SVRS			;HERE ALSO

D$TVRS:	SKIPA	S2,[EXP %TVOL]		;RESOURCE TYPE - TAPE VOLUME
D$SVRS:	MOVX	S2,%STRC		;RESOURCE TYPE - STRUCTURE
	LOAD	TF,.VLFLG(S1),VL.RSN	;IS THERE ALREADY A RSN?
	JUMPN	TF,[MOVE S1,TF		;YES, COPY IT
		    $RETT ]		;AND WIN
	$SAVE	<P1,P2>			;SAVE SOME SPACE
	DMOVE	P1,S1			;SAVE VOL BLK, RESOURCE TYPE
	MOVE	S1,.VLNAM(S1)		;GET THE SIXBIT VOLUME NAME
	PUSHJ	P,DEVRSN		;MAKE UP A RSN
	STORE	S1,.VLFLG(P1),VL.RSN	;SAVE THE RSN
	$RETT				;WIN
> ;END TOPS10 CONDITIONAL
	SUBTTL	VALMSG - ROUTINE TO VALIDATE THE MOUNT/ALLOCATE MESSAGE

	;CALL:	M/ The Mount/Allocate Message Address
	;
	;RET:	True if valid, False otherwise

VALMSG:	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	STKVAR	<MSGLEN,MNTALC>		;GET SPACE FOR MSG LEN & MOUNT STATUS
	LOAD	S1,.MSTYP(M),MS.CNT	;GET THE MESSAGE LENGTH
	CAIL	S1,.MMHSZ		;MUST BE GREATER THEN .MMHSZ AND
	CAIL	S1,.MMUMX		;   LESS THEN .MMUMX
	PJRST	E$IBL##			;ELSE ITS AN ERROR
	ADD	S1,M			;POINT TO THE END OF THE MESSAGE
	MOVEM	S1,MSGLEN		;AND SAVE IT
	MOVE	P1,.MMARC(M)		;GET THE VOLUME SET COUNT IN P1
	JUMPL	P1,E$IBL##		;CAN'T BE NEGATIVE
	JUMPE	P1,VALM.3		;IF 0, THEN REST OF MESSAGE MBZ
	MOVEI	P2,.MMHSZ(M)		;POINT TO THE FIRST MOUNT ENTRY
	LOAD	P3,.MSTYP(M),MS.TYP	;GET THE MSG TYPE (.QIFNC IS INTERNAL)
	LOAD	S1,.MEFLG(P2),ME%ALC	;GET THE FIRST ENTRY'S MOUNT/ALLOC BIT
	MOVEM	S1,MNTALC		;SAVE IT FOR LATER

VALM.1:	CAMLE	P2,MSGLEN		;MUST BE LESS OR EQUAL TO END OF MSG
	PJRST	E$IBL##			;NO GOOD,,RETURN INVALID MESSAGE
	LOAD	S1,.MEFLG(P2),ME%ALC	;GET THE MOUNT/ALLOCATE STATUS BIT
	CAXE	P3,.QIFNC		;IS THIS AN INTERNAL REQUEST ???
	CAMN	S1,MNTALC		;CAN'T MIX MOUNT/ALLOCATE IN SAME MSG
	SKIPA				;INTERNAL OR MATCHING TYPES,,SKIP
	PJRST	E$IBL##			;HE DID,,RETURN INVALID MESSAGE
	LOAD	S1,.MEHDR(P2),AR.LEN	;GET THIS ENTRIES LENGTH
	ADD	S1,P2			;POINT TO THE END OF THE ENTRY
	MOVEI	S2,.MEHSZ(P2)		;POINT TO THE DATA BLOCK AREA
	CAIG	S2,0(S1)		;MUST BE LESS OR EQUAL TO END OF ENTRY
	SKIPG	P4,.MECNT(P2)		; AND ENTRY COUNT MUST BE POSITIVE
	PJRST	E$IBL##			;NO,,THATS AN ERROR

VALM.2:	LOAD	TF,ARG.HD(S2),AR.LEN	;GET THIS BLOCK'S LENGTH
	ADD	S2,TF			;POINT TO THE NEXT BLOCK
	CAILE	S2,0(S1)		;MUST STILL BE WITHIN THE ENTRY
	PJRST	E$IBL##			;NO,,THATS AN ERROR
	SOJG	P4,VALM.2		;CONTINUE CHECKING ALL ENTRY BLOCKS
	MOVE	P2,S2			;POINT TO NEXT 'ME' ENTRY

	SOJG	P1,VALM.1		;CONTINUE THROUGH ALL VOLUME SETS

	CAME	P2,MSGLEN		;CALC AND ACTUAL END ADDRS MUST BE EQUAL
	PJRST	E$IBL##			;NO,,THATS AN ERROR
	$RETT				;RETURN OK

VALM.3:	MOVEI	P1,.OFLAG(M)		;GET FLAG WORD ADDRESS
VALM.4:	AOS	P1			;POINT TO NEXT WORD
	SKIPE	0(P1)			;MUST BE ZERO...
	JRST	E$IBL##			;NO,,THATS AN ERROR
	CAMGE	P1,MSGLEN		;ARE WE DONE ???
	JRST	VALM.4			;NO,,CHECK NEXT
	$RETT				;YES,,RETURN
	SUBTTL	CHKBAT - ROUTINE TO CHECK FOR BATCH REQUESTS DOING MOUNTS

	;CALL:	AP/ The MDR Address
	;
	;RET:	True if OK, False if Illegal

D$CHKB::				;GLOBALIZE IT
CHKBAT:	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE SENDERS JOB NUMBER
	TXNE	S1,BA%JOB		;ARE WE EXECUTING YET ????
	JRST	CHKB.4			;NO,,THEN CHECK SCHEDULABILITY
	SKIPE	S1,.MRQEA(AP)		;LOAD UP THE QE ADDRESS
	SKIPN	S1,.QEOBJ(S1)		;ONE MORE CHECK BEFORE WE DO IT !!
	$RETT				;NOT A SCHEDULED JOB,,THEN RETURN
	LOAD	S2,OBJPRM+.OBFLG(S1),.OPRIN ;GET THE OPR INTERVENTION FLAG
	CAXN	S2,.OPINY		;IS INTERVENTION ALLOWED ???
	$RETT				;YES,,THEN HE IS OK !!!

	MOVE	S2,OBJPID(S1)		;GET THE PROCESSORS PID
	MOVEM	S2,G$SAB##+SAB.PD	;SET IT
	MOVE	S2,OBJUNI(S1)		;GET THE STREAM NUMBER
	MOVEM	S2,ABOSTM		;SET IT
	MOVE	S2,OBJNOD(S1)		;GET THE NODE NUMBER
	MOVEM	S2,ABONOD		;SET IT
	MOVX	S1,ABOLEN		;GET THE MSG LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SET IT
	MOVEI	S2,ABOMSG		;GET THE MSG ADDRESS
	MOVEM	S2,G$SAB##+SAB.MS	;SET IT
	PUSHJ	P,C$SEND##		;SEND THE CANCEL MSG
	$RETF				;RETURN

CHKB.4:	SKIPN	S1,.MRQEA(AP)		;CHECK AND LOAD QE ADDRESS
	$STOP	(MQE,Missing QE for a pseudo process)
	PJRST	S$INPS##		;CHECK SCHEDULABILITY AND RETURN

	;Gen cancel msg here (Cheaper then generating 'on the fly')

ABOMSG:	ABOLEN,,.OMCAN			;.MSTYP - LENGTH,,CANCEL MSG
	0,,0				;.MSFLG - NO FLAG BITS
	-1				;.MSCOD - ACK CODE -1 IS $LOG
	0,,0				;.OFLAG - NO FLAG BITS
	0,,3				;.OARGC - 3 DATA BLOCKS
	4,,.OROBJ			;OBJECT BLOCK
	.OTBAT				;   BATCH QUEUE
ABOSTM:	0,,0				;   STREAM #
ABONOD:	0,,0				;   NODE NAME
	2,,.CANTY			;CANCEL TYPE
	.CNERR				;   WITH ERROR PROCESSING
	5,,.ORREA			;CANCEL REASON
	ASCIZ/MOUNT request in 'No Operator Intervention' batch job is illegal/

	ABOLEN==.-ABOMSG		;MESSAGE LENGTH
	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	P3,S1			;SAVE THE MOUNT MSG ENTRY ADDR
	PUSHJ	P,VSLFND		;LOOK FOR ANOTHER VSL BY THE SAME VSN
	JUMPT	[MOVE	P2,S1		;FOUND ONE,,SAVE THE VSL ADDRESS
		 TLO	P2,400000	;MARK THIS VSL AS A DUPLICATE REQUEST
		 JRST	BLDV.3 ]	;AND CONTINUE
	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
	MOVX	S1,VS.OPR+VS.WAL+VS.ALC	;GET NOTIFY OPR+ALLOCATE WAIT BITS
	MOVEM	S1,.VSFLG(P2)		;SET THEM
	LOAD	S1,.MEHDR(P3),AR.TYP	;GET THE ENTRY TYPE
	MOVX	S2,%UNKN		;DEFAULT TO UNKNOWN
	CAXN	S1,.MNTTP		;IS THIS A TAPE MOUNT REQUEST ???
	MOVX	S2,%TAPE		;YES,,SAY SO
	CAXN	S1,.MNTST		;IS IT A STRUCTURE ???
	MOVX	S2,%DISK		;YES,,SAY SO
TOPS20<	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(P3),ME%ALC	;GET THE ALLOCATE BIT
	STORE	S1,.VSFLG(P2),VS.UAL	;SET/CLEAR USER ALLOCATED
TOPS10<	MOVX	S1,DEFLBT		;GET THE DEFAULT LABEL TYPE
	STORE	S1,.VSFLG(P2),VS.LBT >	;AND SAVE IT
	AOS	S1,REQIDN##		;BUMP AND LOAD THE REQUEST COUNT
	STORE	S1,.VSRID(P2),VS.RID	;SAVE IT FOR THIS VOLUME SET REQUEST
	MOVE	S1,G$NOW##		;GET THE CURRENT TIME
	MOVEM	S1,.VSCRE(P2)		;SAVE AS REQUEST CREATION TIME

	MOVE	P1,P3			;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
	SKIPN	.VSVSN(P2)		;ANY VOL SET NAME SPECIFIED ???
	PJRST	E$IVN##			;NO,,THEN INVALID VOLUME SET NAME !!!
	MOVE	S1,P2			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,I$CUNK##		;CHECK FOR 'UNKNOWN' REQUEST TYPES
	CAIE	P2,TMPVSL		;POINTING TO TEMP VSL ???
	JRST	BLDV.3			;NO,,THEN ALLS OK

	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
	LOAD	S1,.VSFLG(P2),VS.TYP	;GET THE REQUEST TYPE
	CAXE	S1,%TAPE		;IS IT A TAPE REQUEST ???
	JRST	BLD.2A			;NO,,GEN A VOL BLOCK FOR THE REQUEST
	MOVE	S1,P2			;YES,,GET THE VSL ADDRESS
	PUSHJ	P,GENVOL		;GEN A SCRATCH VOL BLOCK
	MOVX	S1,TM%NEW+TM%SCR	;GET SCRATCH OR NEW STATUS BITS
	TDNE	S1,.MEFLG(P3)		;WAS /SCRATCH OR /NEW REQUESTED ???
	JRST	BLDV.3			;YES,,CONTINUE
	PUSHJ	P,E$RNS##		;UH OH,,A REEL ID IS REQUIRED !!!
	JRST	BLDV.4 			;RETURN THE ERROR !!!

BLD.2A:	HRROI	S1,.VSVSN(P2)		;POINT TO THE VOL SET NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVE	S1,S2			;SAVE THE VOLUME NAME IN S1
	MOVE	S2,P2			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,ADDVOL		;ADD A VOL BLOCK
	MOVEM	S1,.VSVOL(P2)		;LINK THE VOL TO THE VSL
	INCR	.VSCVL(P2),VS.CNT	;BUMP THE VOLUME COUNT

BLDV.3:	TDZA	P4,P4			;INDICATE A NORMAL RETURN
BLDV.4:	SETOM	P4			;INDICATE AN ERROR RETURN
	LOAD	S1,.MRCNT(AP),MR.LNK	;GET THE VSL LINK CODE
	STORE	S1,.VSRID(P2),VS.LNK	;SET IT
	JUMPN	P4,BLDV.5		;IF AN ERROR,,SKIP THIS
	LOAD	P1,.VSFLG(P2),VS.TYP	;GET THE VSL TYPE
	CAXN	P1,%DISK		;IS IT A STRUCTURE ???
	PUSHJ	P,DEFDSK		;YES,,DEFAULT IT

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

	CAXN	P1,%TAPE		;IS IT A TAPE REQUEST ???
	PUSHJ	P,DEFTAP		;YES,,DELAULT IT
	CAXN	P1,%DTAP		;IS IT A DECTAPE REQUEST ?
	PUSHJ	P,DEFDTA		;YES - DEFAULT IT
	JUMPF	[SETOM P4		;CAN'T DEFAULT,,INDICATE AN ERROR RETURN
		 PJRST BLDV.5 ]		;AND EXIT
	LOAD	S1,.MEFLG(P3),ME%ALC	;GET THE ALLOCATE/MOUNT BIT
	LOAD	S2,.VSFLG(P2),VS.ALC	;GET THE VOL SET STATE BIT
	AND	S1,S2			;PERFORM SOME MAGIC !!!
	STORE	S1,.VSFLG(P2),VS.ALC	;SET/CLEAR THE ALLOCATE/MOUNT BIT

	TLZE	P2,400000		;WAS THIS A DUPLICATE VOL SET REQUEST ??
	JRST	[MOVE	S1,P2		;YES,,GET THE VSL ADDR IN S1
		 $RETT	]		;   AND RETURN NOW

	;Here to Link to MDR and VSL together and Update the request count

BLDV.5:	LOAD	S1,.MRCNT(AP),MR.CNT	;GET THE VSL REQUEST COUNT
	ADDI	S1,.MRVSL(AP)		;POINT TO THE CURRENT VSL ADDRESS
	MOVEM	P2,0(S1)		;LINK THE VSL TO THE MDR
	MOVEM	AP,.VSMDR(P2)		;LINK THE MDR TO THE VSL
	INCR	.MRCNT(AP),MR.CNT	;BUMP THE VSL COUNT BY 1
	MOVE	S1,P2			;GET THE VSL ADDRESS
	JUMPN	P4,.RETF		;NO GOOD,,RETURN NOW
	CAXN	P1,%TAPE		;IS THIS A TAPE MOUNT ???
	PUSHJ	P,CKTVOL		;CHECK OUT THE TAPE VOLUMES REQUESTED
	MOVE	S1,P2			;GET THE VSL ADDRESS BACK
	POPJ	P,			;RETURN GOOD OR BAD...
	SUBTTL	VSL DEFAULTING ROUTINES

DEFTAP:	MOVE	S1,.MEFLG(P3)		;GET THE REQUEST FLAG WORD
	MOVE	S2,.VSFLG(P2)		;GET OUR FLAG WORD
	TLNN	P2,400000		;IS THIS THE FIRST TIME AROUND ??
	TXO	S2,VS.WLK		;YES,,DEFAULT TO WRITE-LOCKED
	TXNE	S1,TM%SCR		;IS THIS A TEMP VOLUME SET ???
	TXO	S2,VS.SCR		;YES,,SAY SO
	TXNE	S1,TM%NEW		;IS THIS A NEW VOLUME SET ???
	TXO	S2,VS.NEW		;YES,,SAY SO
	TXNE	S1,TM%WEN+TM%SCR+TM%NEW	;WRITE ENABLED OR SCRATCH OR NEW ???
	TXZ	S2,VS.WLK		;YES,,MAKE IT WRITE ENABLED !!!
	TXNE	S1,TM%WLK		;ARE WE WRITE LOCKED ???
	TXO	S2,VS.WLK		;YES,,SAY SO
	MOVEM	S2,.VSFLG(P2)		;SAVE OUR FLAG WORD

TOPS10<	TLNE	P2,400000		;IS THIS A DUPLICATE MOUNT REQUEST ???
	$RETT				;YES,,CAN'T MODIFY THE ATTRIBUTES !!!!
	MOVE	S1,.VSATR(P2)		;GET THE REQUESTED ATTRIBUTES
	LOAD	S2,S1,VS.TRK		;GET THE REQUESTED TRACK TYPE
	SKIPN	S2			;SPECIFY ANY TRACK TYPE ???
	TXO	S1,FLD(DEFTRK,VS.TRK)+VS.DTK ;NO,,DEFAULT IT
	LOAD	S2,S1,VS.DEN		;GET THE REQUESTED DENSITY
	JUMPN	S2,DEFT.1		;IF SPECIFIED,,DO NOT DEFAULT
	LOAD	S2,S1,VS.TRK		;GET THE TRACK TYPE
	CAXN	S2,%TRK7		;IS IT A 7 TRACK REQUEST ???
	TXO	S1,FLD(DEF7TK,VS.DEN)+VS.DDN ;YES,,DEFAULT DENSITY
	CAXE	S2,%TRK7		;IS IT A 9 TRACK REQUEST ???
	TXO	S1,FLD(DEF9TK,VS.DEN)+VS.DDN ;YES,,DEFAULT DENSITY

DEFT.1:	MOVEM	S1,.VSATR(P2)		;SAVE THE ATTRIBUTES.

	LOAD	S1,.VSATR(P2),VS.DEN	;GET THE DENSITY STATUS CODE
	MOVE	S1,D$DEN(S1)		;CONVERT IT TO A BIT MASK
	LOAD	S2,.VSATR(P2),VS.TRK	;GET THE TRACK STATUS CODE
	SETZM	T1			;START AT THE TOP OF THE RESOURCE LIST
	PUSHJ	P,ANYTAP		;GET THE TAPE RESOURCE NUMBER
	JUMPF	E$NUA##			;NO,,RETURN 'NO UNITS AVAILABLE'
	STORE	S1,.VSATR(P2),VS.RSN	;SAVE THE REQUESTED DEVICE TYPE
> ;END TOPS10 CONDITIONAL
	$RETT				;RETURN

DEFDSK:
TOPS10<	MOVE	S1,.MEFLG(P3)		;GET THE REQUEST FLAG WORD
	MOVE	S2,.VSFLG(P2)		;GET OUR FLAG WORD
	TXZ	S2,VS.WLK!VS.PAS!VS.NOC!VS.ARD ;RESET BITS FROM MOUNT MESSAGE
	TXNE	S1,TM%WLK		;ARE WE WRITE LOCKED ???
	TXO	S2,VS.WLK		;YES,,SAY SO
	TXNE	S1,SM%PAS		;WANT IT IN PASSIVE HALF?
	TXO	S2,VS.PAS		;YES, LITE IT
	TXNE	S1,SM%NOC		;WANT NO-CREATE?
	TXO	S2,VS.NOC		;YES, LITE THAT
	TXNE	S1,SM%ARD		;WANT TO ALWAYS RECOMPUTE DISK USAGE?
	TXO	S2,VS.ARD		;YES
	TXNE	S1,SM%EXC		;WANT SINGLE ACCESS?
	TLNE	P2,400000		;IS THIS THE FIRST TIME AROUND ?
	SKIPA				;NOT /SINGLE OR MOUNTED AGAIN !
	TXO	S2,VS.SIN		;YES, SAY SO
	MOVEM	S2,.VSFLG(P2)		;SAVE FLAG WORD
	HRRZ	S1,P2			;GET THE VSL ADDR IN S1
	PUSHJ	P,GETCAT		;MAKE SURE ITS IN OUR CATALOG
> ;END TOPS10 CONDITIONAL
	$RETT				;RETURN

DEFDTA:
TOPS10<	MOVE	S1,.MEFLG(P3)		;GET THE REQUEST FLAG WORD
	MOVE	S2,.VSFLG(P2)		;GET OUR FLAG WORD
	TLNN	P2,400000		;IS THIS THE FIRST TIME AROUND ??
	TXO	S2,VS.WLK		;YES,,DEFAULT TO WRITE-LOCKED
	TXNE	S1,TM%SCR		;IS THIS A TEMP VOLUME SET ???
	TXO	S2,VS.SCR		;YES,,SAY SO
	TXNE	S1,TM%NEW		;IS THIS A NEW VOLUME SET ???
	TXO	S2,VS.NEW		;YES,,SAY SO
	TXNE	S1,TM%WEN+TM%SCR+TM%NEW	;WRITE ENABLED OR SCRATCH OR NEW ???
	TXZ	S2,VS.WLK		;YES,,MAKE IT WRITE ENABLED !!!
	TXNE	S1,TM%WLK		;ARE WE WRITE LOCKED ???
	TXO	S2,VS.WLK		;YES,,SAY SO
	MOVEM	S2,.VSFLG(P2)		;SAVE OUR FLAG WORD
> ;END TOPS10 CONDITIONAL
	$RETT				;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
	PJRST	E$IDE##			;Else bad density
	MOVE	S1,ARG.DA(P1)		;GET THE DENSITY
	JUMPL	S1,E$IDE		;CAN'T BE NEGATIVE
	CAXLE	S1,DENLEN		;CAN'T BE GREATER THEN TABLE LENGTH
	PJRST	E$IDE			;YES,,THATS AN ERROR
	STORE	S1,.VSATR(P2),VS.DEN	;STORE DENSITY INDEX
	PJRST	CHKTAP			;MAKE SURE THIS WAS A TAPE REQUEST !!!

MNTPRT:
TOPS10<	LOAD	S1,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	CAIE	S1,2			;MUST BE 2
	$RETF				;ELSE BAD BLOCK
	MOVE	S1,ARG.DA(P1)		;GET THE PROTECTION
	CAIG	S1,777			;SEE IF WITHIN RANGE
	SKIPGE	S1			; .  .  .
	$RETF				;NO, RETURN FALSE
	STORE	S1,.VSATR(P2),VS.PRT	;STORE THE PROTECTION CODE
> ;END TOPS10 CONDITIONAL
	PJRST	CHKTAP			;MAKE SURE THIS WAS A TAPE REQUEST !!!


	;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
	MOVX	S2,%TRK9		;DEFAULT TO A 9 TRACK REQUEST
	CAXN	S1,.TMDR7		;IS IT A SEVEN TRACK REQUEST ???
	MOVX	S2,%TRK7		;YES,,SAY SO
	STORE	S2,.VSATR(P2),VS.TRK	;SAVE THE REQUEST TRACK TYPE
	PJRST	CHKTAP			;MAKE SURE THIS WAS A TAPE REQUEST !!!

	;LABEL TYPE BLOCK PROCESSOR

MNTLT:	LOAD	S1,ARG.HD(P1),AR.LEN	;GET THE BLOCK LENGTH
	CAIE	S1,2			;MUST BE 2
	PJRST	E$ILT##			;ELSE INVALID LABEL TYPE
	MOVE	S1,ARG.DA(P1)		;GET THE LABEL TYPE
	CAXL	S1,%TFMIN		;CHECK RANGE
	CAXLE	S1,%TFMAX		;MUST BE BETWEEN THE MIN AND MAX VALUES
	 PJRST	E$ILT##			;INVALID LABEL TYPE
	STORE	S1,.VSFLG(P2),VS.LBT	;AND SAVE IT
	CAXN	S1,%TFLBP		;DOES HE WANT BYPASS PROCESSING ???
	SKIPE	[NPRTLB]		;YES,,IS IT OK FOR ALL USERS ???
	PJRST	CHKTAP			;NOT BLP OR OK FOR ALL USERS,,WIN
	PUSHJ	P,A$WHEEL##		;IS HE PRIV'D ???
	JUMPF	E$PRB##			;NO,,TOO BAD !!!
	PJRST	CHKTAP			;MAKE SURE THIS WAS A TAPE REQUEST !!!
	;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
	PJRST	E$IVN##			;RETURN INVALID VOL SET NAME !

TOPS10<	HRROI	S1,ARG.DA(P1)		;GET THE SOURCE VOLUME SET NAME
	HRROI	S2,.VSVSN(P2)		;GET THE DESTINATION ADDRESS
	PUSHJ	P,STRVSN		;STORE IT
	JUMPF	.RETF			;RETURN IF INVALID VOL SET NAME
> ;End TOPS10 conditional

TOPS20<
SETVSN:	$TEXT	(<-1,,.VSVSN(P2)>,<^W/ARG.DA(P1)/^0>)  ;SIXBIT VSN TO ASCII
	MOVE	S2,ARG.DA(P1)		;Get SIXBIT VSN
> ;End TOPS20 conditional

	SKIPN	.VSLNM(P2)		;Do we have logical name?
	MOVEM	S2,.VSLNM(P2)		;No..store default
	$RETT				;RETURN

	;Here to make sure the request is a tape request

CHKTAP:	LOAD	S1,.VSFLG(P2),VS.TYP	;GET THE VOL SET TYPE
	CAXN	S1,%TAPE		;IS IT A TAPE REQUEST ???
	$RETT				;YES..ALL IS FINE
	CAXE	S1,%UNKN		;IS IT AN UNKNOWN REQUEST ???
	PJRST	E$ISA##			;NO,,Invalid structure attribute
	MOVX	S1,%TAPE		;GET 'TAPE' REQUEST TYPE
	STORE	S1,.VSFLG(P2),VS.TYP	;SET IT
	$RETT				;RETURN


	;Here to make sure the request is a disk request

CHKDSK:	LOAD	S1,.VSFLG(P2),VS.TYP	;GET THE VOL SET TYPE
	CAXN	S1,%DISK		;IS IT A DISK REQUEST??
	$RETT				;YES..ALL IS FINE
	CAXE	S1,%UNKN		;IS IT AN UNKNOWN REQUEST??
	PJRST	E$ITA##			;NO,,Invalid tape attribute
	MOVX	S1,%DISK		;GET 'DISK' REQUEST TYPE
	STORE	S1,.VSFLG(P2),VS.TYP	;SET IT
	$RETT				;RETURN
TOPS10 <

;STRVSN - Routine to validate and store Volume Set name

;Translates lower case to upper and checks to make sure
;that only characters "A-Z", "0-9" and "_" are included

;ACCEPTS	S1/ Pointer to source string
;		S2/ Pointer to destination address

;RETURNS TRUE	S1/ Sixbit equivalent of string or 0
;		S2/ Sixbit abbriviation of string

;RETURNS FALSE	E$IVN (Invalid Volume Set Name)

STRVSN:	$SAVE	<P1,P2>			;Save some AC's
	TLCE	S1,-1			;Make real pointers
	TLCN	S1,-1
	 HRLI	S1,(POINT 7)
	TLCE	S2,-1
	TLCN	S2,-1
	 HRLI	S2,(POINT 7)
	MOVE	P1,S1			;Copy source pointer
STRVS1:	ILDB	P2,P1			;Get a source byte
	CAIL	P2,"a"			;Lower case?
	SUBI	P2,"a"-"A"		;Yes..raise it
	CAIL	P2,"A"			;Alpha?
	CAILE	P2,"Z"
	 JRST	[CAIL	P2,"0"		;No..numeric?
		 CAILE	P2,"9"
		  JRST	[CAIE	P2,"-"	;No..hypen or null?
			 JUMPN	P2,E$IVN##
			 JRST	.+1]	;Yes..then store it
		 JRST	.+1]		;Store numeric
	IDPB	P2,S2			;Store the character
	JUMPN	P2,STRVS1		;Terminate after null
	$CALL	S%SIXB			;Get sixbit abbriv.
	LDB	S1,S1			;Get terminator
	SKIPN	S1			;Was it null?
	SKIPA	S1,S2			;Yes..return sixbit
	SETZM	S1			;No..return 0
	$RETT

> ;End TOPS10 conditional
	;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
	$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
	PJRST	CHKTAP			;MAKE SURE THIS WAS A TAPE REQUEST !!!

	;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
TOPS10<	LOAD	S1,.VSFLG(P2),VS.TYP	;GET THE REQUEST TYPE
	CAXN	S1,%DISK		;CAN'T BE A STRUCTURE
	PJRST	E$ISS##			;YES,,THATS AN ERROR
> ;END TOPS10 CONDITIONAL

	;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
	ADDI	S2,VSLLEN		;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.B:	MOVE	S1,0(T3)		;PICK UP THE VOLUME NAME IN S1
	MOVE	S2,P2			;GET THE VSL POINTER IN S2
	PUSHJ	P,ADDVOL		;ADD A VOL BLOCK
	MOVEM	S1,0(T2)		;LINK THE VOL TO THE VSL
	INCR	.VSCVL(P2),VS.CNT	;BUMP THE VOLUME COUNT BY 1
	SKIPN	.VLNAM(S1)		;WAS IT VALID ???
	PJRST	E$VID##			;UH OH,,NULL VOLIDS ARE ILLEGAL !!!

MNTV.C:	AOS	T2			;POINT TO THE NEXT VSL VOLUME
	AOS	T3			;POINT TO THE NEXT MSG VOLUME
	SOJG	T1,MNTV.B		;CONTINUE TILL DONE
	MOVE	S1,.VSVOL(P2)		;Pick up the first volume name
	MOVE	S1,0(S1)		;Get the first volume name
	MOVEM	S1,0(T2)		;Used by INFORMATION MOUNT/ALL
TOPS20<	SKIPN	.VSVSN(P2)		;ANY VOLUME SET NAME YET ???
	PUSHJ	P,SETVSN  >		;NO,,GEN ONE !!!

	SKIPE	S1,STRVOL		;CHECK AND LOAD THE STARTING VOLUME ID
	PJRST	UPDSVL			;SOMETHING THERE,,UPDATE STARTING VOLUME
	MOVX	S1,VS.REL		;GET REEL ID SPECIFIED FLAG
	IORM	S1,.VSFLG(P2)		;SET IT
	$RETT				;RETURN
SUBTTL	Count the number of requests needing a structure


; Count up the number of requests requiring a structure
; Call:	MOVE	S1, VOL block address
;	PUSHJ	P,D$NREQ
; On return, S1:= #requests
;
TOPS10	<				;MDA ONLY
D$NREQ::
CTNREQ:	$SAVE	<P1,P2,P3,P4>		;SAVE SOME ACS
	MOVE	P1,S1			;SAVE THE VOL BLK ADRS
	LOAD	P2,.VLOWN(P1),VL.CNT	;GET THE NUMBER OF REQUESTORS
	JUMPE	P2,NREQ.4		;NONE, SAY SO
	MOVNS	P2			;NEGATE IT
	MOVSS	P2			;TO LEFT HALF
	HRRI	P2,.VLVSL(P1)		;AIM AT THE LIST OF VSL POINTERS
	SETZ	P1,			;CLEAR COUNT OF USERS
NREQ.1:	MOVX	TF,VL.ASN		;GET THE 'MOUNTED' BIT
	TDNN	TF,0(P2)		;DOES THIS REQUESTOR (VSL) OWN IT?
	JRST	NREQ.3			;NO, TRY THE NEXT VSL
	MOVE	S1,0(P2)		;AIM AT THE VSL
	SKIPN	S1,.VSMDR(S1)		;BACK UP TO THE MDR
	PUSHJ	P,S..IMV		;OOPS!!
	MOVE	P4,S1			;SAVE THE MDR ADDRESS
	LOAD	S2,.MRJOB(P4),MD.PJB	;GET THE JOB NUMBER
	TXNE	S2,BA%JOB		;PSEUDO PROCESS ???
	AOS	P1			;COUNT IT
NREQ.3:	AOBJN	P2,NREQ.1		;CHECK ALL THE REQUESTORS
	SKIPA	S1,P1			;GET NUMBER OF REQUESTS
NREQ.4:	SETZ	S1,			;HERE IF NO REQUESTS
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	BLDSTR - ROUTINE TO PIECE TOGETHER VOL BLKS AND MAKE A STRUCTURE

	;CALL:	S1/ The Structure Name we want 
	;	S2/ The Alias Name or 0
	;
	;RET:	True if a Structure Can be Built, False Otherwise

TOPS10 <
BLDSTR:	PUSHJ	P,.SAVE2		;SAVE P1 - P2
	SKIPN	S2			;IS S2 NULL ???
	MOVE	S2,S1			;MAKE THE ALIAS THE STRUCTURE NAME
	MOVE	P2,S2			;SAVE THE ALIAS FOR LATER
	MOVE	P1,S1			;SAVE THE STRUCTURE NAME
	PUSHJ	P,FNDISK		;FIND THE PRIMARY STR IN THE VOL QUEUE
	$RETIF				;RETURN IF NOT FOUND
	MOVE	P1,S1			;SAVE THE PRI STR VOL ADDRESS

BLDS.1:	SKIPN	.VLUCB(S1)		;IS THE VOLUME SPINNING ???
	$RETF				;NO
	SKIPN	S1,.VLNXT(S1)		;ANOTHER VOL IN THE STRUCTURE ?
	JRST	BLDS.2			;NO,,WE HAVE ALL THE REQUIRED VOLS !!!
	PUSHJ	P,FNDDSK		;YES,,GO FIND IT IN OUR DATA BASE
	JUMPT	BLDS.1			;FOUND IT,,GO CHECK IT OUT
	$RETF				;RETURN

BLDS.2:	LOAD	S1,.VLFLG(P1),VL.STA	;GET THE STRUCTURE STATUS BITS
	CAXN	S1,%STAMN		;IS IT MOUNTED ???
	$RETT				;YES,,RETURN
	MOVE	S1,P1			;GET PRIMARY VOL BLOCK ADDRESS
	PUSHJ	P,D$GENC		;GENERATE A CATALOG ENTRY
	JUMPF	BLDS.3			;CAN'T DO IT
	DMOVE	S1,P1			;GET VOL ADDR AND ALIAS NAME
	SETZM	WRTLCK			;CLEAR WRITE-LOCKED FLAG
	PUSHJ	P,SNDBLD		;TELL PULSAR TO BUILD THE STRUCTURE
	$RETT				;AND RETURN

BLDS.3:	$WTO	(<Cannot mount structure ^W/P2/>,,,<$WTFLG(WT.SJI)>)
	$RETF				;RETURN

> ;END TOPS-10 CONDITIONAL
	SUBTTL	SNDBLD - ROUTINE TO LINK THE STR VOL BLKS AND SEND STR BUILD MSG
	;	SNDDSM - ROUTINE TO SEND DISMOUNT STR MSG AND DELETE VOL BLKS

	;CALL:	S1/ The Primary STR VOL Block Address
	;	S2/
	;		SNDBLD - The Structure Name
	;		SNDDSM - Any flag bits (.DMNCK)
	;
	;RET:	True Always

TOPS10	<
SNDDSM:	PUSHJ	P,.SAVE4		;SAVE ALL THE P'S
	MOVE	P3,S2			;SAVE THE FLAGS
	LOAD	S2,.VLNAM(S1)		;GET THE STRUCTURE NAME
	SETZB	TF,WRTLCK		;INDICATE 'SNDDSM' ENTRY POINT
	JRST	SNDB.0			;AND ENTER THE COMMON CODE

SNDBLD:	PUSHJ	P,.SAVE4		;SAVE ALL P AC'S
	SETOM	TF			;INDICATE 'SNDBLD' ENTRY POINT
	SETZ	P3,			;NO FLAGS
SNDB.0:	MOVE	P1,S1			;SAVE THE PRI STR VOL ADDRESS
	MOVE	P2,TF			;SAVE THE ENTRY POINT INDICATOR
	PUSH	P,S2			;SAVE THE STRUCTURE NAME 
	PUSHJ	P,M%GPAG		;GET A PAGE FOR IPCF
	MOVEM	S1,G$SAB##+SAB.MS	;SAVE ITS ADDRESS IN THE SAB
	MOVE	S2,[.OHDRS+1,,.QOBLD]	;DEFAULT TO BUILD STR MSG HEADER
	SKIPN	P2			;UNLESS WE ARE SENDING DISMOUNT MSG
	MOVE	S2,[.OHDRS+1,,.QODSM]	;   THEN GET THE DISMOUNT MESSAGE HDR
	MOVEM	S2,.MSTYP(S1)		;SAVE IT
	MOVEI	S2,2			;WE ARE PASSING 2 BLOCKS
	MOVEM	S2,.OARGC(S1)		;SO SET THE BLOCK COUNT IN THE MSG
	IORM	P3,.OFLAG(S1)		;LITE ANY FLAG BITS
	MOVEI	P3,.OHDRS(S1)		;POINT TO THE FIRST MSG BLOCK
	JUMPN	P2,SNDB.Y		;SKIP REQUEST COUNT STUFF IN MOUNTING
	PUSH	P,S1			;SAVE S1
	MOVEI	S1,(P1)			;GET VOL BLOCK ADDRESS
	PUSHJ	P,CTNREQ		;GET THE NUMBER OF REQUESTS NEEDING STR
	MOVE	S2,S1			;GET COUNT
	POP	P,S1			;RESTORE MESSAGE ADDRESS
	STORE	S2,.OFLAG(S1),.DMNRQ	;SAVE IN MESSAGE

SNDB.Y:	MOVE	S1,[ARG.DA+.BLDLN,,.BLDSN] ;GET THE BLOCK HEADER
	MOVEM	S1,ARG.HD(P3)		;SET IT UP
	POP	P,ARG.DA+.BLDNM(P3)	;INSERT THE ALIAS NAME (STRUCTURE NAME)
	SETZM	ARG.DA+.BLDOW(P3)	;NO OWNER YET !!!
	JUMPE	P2,SNDB.X		;DISMOUNT,,THEN SKIP OWNER ID
	MOVE	S1,.VLNAM(P1)		;MOUNT,,GET STRUCTURE NAME
	PUSHJ	P,D$FCAT		;GET THE CATALOG ENTRY ADDRESS
	JUMPF	SNDB.X			;NOT THERE,,OH WELL WE TRIED !!!
	MOVE	S1,.CTOID(S1)		;GET THE OWNERS ID
	MOVEM	S1,ARG.DA+.BLDOW(P3)	;SAVE IN MESSAGE
SNDB.X:	MOVSI	S1,ARG.DA+.BLDLN	;GET THE BLOCK LENGTH
	ADDM	S1,@G$SAB##+SAB.MS	;ADD TO THE TOTAL MESSAGE LENGTH
	MOVEI	P3,ARG.DA+.BLDLN(P3)	;POINT TO NEXT MSG BLOCK
	MOVE	S1,[1,,.BLDUN]		;GET UNIT NAME(S) BLOCK HEADER
	MOVEM	S1,ARG.HD(P3)		;SAVE IT IN THE MESSAGE
	MOVE	S1,P1			;GET THE FIRST (PRI) VOL BLOCK ADDRESS
	MOVE	P4,P1			;MAKE THIS THE CURRENT VOLUME
	PUSH	P,P3			;SAVE THIS MSG BLOCK ADDRESS

SNDB.1:	MOVE	S2,.VLUCB(S1)		;GET THE UNIT WE ARE MOUNTED ON.
	LOAD	TF,.UCBST(S2),UC.WLK	;GET WRITE-LOCKED BIT
	IORM	TF,WRTLCK		;REMEMBER IT
	MOVE	S2,.UCBNM(S2)		;GET ITS SIXBIT NAME
	MOVEM	S2,ARG.DA(P3)		;SAVE IT IN THE MESSAGE

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

	MOVE	S2,.VLVID(S1)		;GET THE HOME BLOCK ID
	MOVEM	S2,ARG.DA+1(P3)		;SAVE IT IN THE MESSAGE
	MOVEI	P3,2(P3)		;POINT TO THE NEXT UNIT ENTRY
	SKIPN	S1,.VLNXT(S1)		;GET THE NEXT VOLUME NAME
	JRST	SNDB.3			;NO MORE,,SEND THE MESSAGE OFF
	PUSHJ	P,FNDDSK		;FIND IT IN OUR DATA BASE
	JUMPE	P2,SNDB.2		;DOING 'DISMOUNT',,SKIP VOL LINK CODE
	STORE	P4,.VLPTR(S1),VL.PRV	;LINK THE NEXT TO THE LAST
	STORE	S1,.VLPTR(P4),VL.NXT	;LINK THE LAST TO THE NEXT
SNDB.2:	MOVE	P4,S1			;MAKE THIS VOL THE CURRENT VOL BLOCK
	JRST	SNDB.1			;AND GO PROCESS THE NEW VOLUME BLK

SNDB.3:	POP	P,S1			;RESTORE OLD BLOCK ADDRESS
	SUBI	P3,0(S1)		;GET THE BLOCK LENGTH
	MOVSS	P3			;MOVE RIGHT TO LEFT
	ADDM	P3,@G$SAB##+SAB.MS	;BUMP TOTAL MESSAGE LENGTH
	ADDM	P3,ARG.HD(S1)		;AND BUMP THE MSG BLOCK LENGTH
	HRRZ	S1,G$SAB##+SAB.MS	;GET MESSAGE ADDRESS
	MOVX	S2,.MTWLK		;GET WRITE-LOCKED FLAG
	SKIPE	WRTLCK			;WANT TO SET IT?
	IORM	S2,.OFLAG(S1)		;YES
	MOVX	S1,PAGSIZ		;GET THE PAGE LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT
	PUSHJ	P,SNDLBR		;SEND THE MSG OFF TO THE TAPE LABELER
	$RETT				;AND RETURN
>
	SUBTTL	ASLMSG - ROUTINE TO BUILD AN 'ADD STRUCTURE' MSG
	;	DSLMSG - ROUTINE TO BUILD A 'DELETE FROM SEARCH LIST' MSG

	;CALL:	S1/ The VSL Block Address
	;	S2/ The VOL Block Address
	;	AP/ The MDR adrs
	;
	;RET:	TRUE ALWAYS

TOPS10<	INTERN	D$DSLM			;MAKE IT GLOBAL

ASLMSG:	TDZA	TF,TF			;NO FLAG BITS IF ENTRY IS HERE
D$DSLM: MOVX	TF,ASL.RM+ASL.NRD+ASL.NQ;REMOVE STR + NO RECOMP + NO QTA CHECK
	SKIPA				;SKIP NEXT ENTRY POINT
DSLMSG:	MOVX	TF,ASL.RM		;GET THE 'REMOVE STRUCTURE' FLAG BIT
	PUSHJ	P,.SAVE2		;SAVE SOME ACS
	DMOVE	P1,S1			;SAVE ARGS
	MOVEM	TF,TMPVSL+.OFLAG	;SAVE THE ACTION BITS
	MOVE	TF,[.OHDRS+ARG.DA+.BLDLN,,.QOASL] ;GET MSG LENGTH,,MSG TYPE
	MOVEM	TF,TMPVSL		;SAVE IT IN THE MESSAGE
	SETZM	TMPVSL+.MSFLG		;NO FLAG BITS
	MOVEI	TF,1			;1 BLOCK
	MOVEM	TF,TMPVSL+.OARGC	;  IN THE MESSAGE
	MOVE	TF,[.BLDLN+1,,.BLDSN]	;GET THE BLOCK LENGTH,,BLOCK TYPE
	MOVEM	TF,TMPVSL+.OHDRS+ARG.HD ;SAVE IT IN THE MESSAGE
	MOVE	TF,.VLNAM(S2)		;GET THE STRUCTURE NAME
	MOVEM	TF,TMPVSL+.OHDRS+ARG.DA+.BLDNM ;SAVE IT IN THE MESSAGE
	LOAD	TF,.VSRID(S1),VS.RID	;GET THE USERS REQUEST ID
	MOVEM	TF,TMPVSL+.MSCOD	;SAVE IT AS THE ACK CODE
	MOVE	TF,.MRUSR(AP)		;GET THE USERS PPN
	MOVEM	TF,TMPVSL+.OHDRS+ARG.DA+.BLDOW ;SAVE IT IN THE MESSAGE
	LOAD	TF,.MRJOB(AP),MD.PJB	;GET THE USERS JOB NUMBER
	IOR	TF,TMPVSL+.OFLAG	;KEEP THE REMOVAL BIT
	MOVE	S1,.VSFLG(P1)		;GET THE USERS FLAG BITS FROM THE VSL
	TXNE	S1,VS.PAS		;WANT TO BE PASSIVE?
	TXO	TF,ASL.PS		;YES, SAY SO
	TXNE	S1,VS.NOC		;WANT NO-CREATE?
	TXO	TF,ASL.NC		;YES, SAY THAT
	TXNE	S1,VS.WLK		;WANT IT WRITE-LOCKED?
	TXO	TF,ASL.WL		;SAY THAT
	TXNE	S1,VS.SIN		;WANT SINGLE ACCESS
	TXO	TF,ASL.SA		;SAY SO
	TXNE	S1,VS.ARD		;WANT TO ALWAYS RECONPUTE DISK USAGE?
	TXO	TF,ASL.AR		;YES
	MOVEM	TF,TMPVSL+.OFLAG	;SAVE IT IN THE MESSAGE
	MOVEI	TF,TMPVSL		;GET THE MESSAGE ADDRESS
	MOVEM	TF,G$SAB##+SAB.MS	;SAVE IT IN THE SAB
	LOAD	TF,TMPVSL+.MSTYP,MS.CNT	;GET THE MESSAGE LENGTH
	MOVEM	TF,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	DMOVE	S1,P1			;GET VSL AND VOL BLOCK ADDRESSES
	PUSHJ	P,AASSET		;SET VL.AAS IF NECESSARY
	PUSHJ	P,SNDLBR		;SEND THE MESSAGE OFF
	$RETT				;RETURN
; Set or clear VL.AAS bit.
; Call:	MOVE	S1, VSL block address
;	MOVE	S2, VOL block address
;	PUSHJ	 P,AASSET/ASSCLR
;
AASSET:	TDZA	TF,TF			;SETTING VL.AAS
AASCLR:	MOVEI	TF,1			;CLEARING VL.AAS
	PUSHJ	P,.SAVE2		;SAVE SOME ACS
	DMOVE	P1,S1			;SAVE VOL BLOCK ADDRESS
	LOAD	S1,.VLOWN(P2),VL.CNT	;GET REQUESTOR COUNT
	MOVNS	S1			;NEGATE IT
	HRLI	S1,.VLVSL(P2)		;POINT TO FIRST VSL
	MOVSS	S1			;BUILD AN AOBJN POINTER

AASX.1:	HRRZ	S2,(S1)			;GET A VSL ADDRESS
	CAME	S2,P1			;FOUND THE VSL?
	AOBJN	S1,AASX.1		;LOOP FOR TILL WE FIND A MATCH
	JUMPGE	S1,.POPJ		;AOBJN POINTER RAN OUT?
	MOVE	S2,(S1)			;GET FLAGS,,ADDR
	SKIPN	TF			;ALWAYS CLEAR BIT?
	TXNN	S2,VL.ASN		;BUT IS IT ASSIGNED?
	TXZA	S2,VL.AAS		;NO
	TXO	S2,VL.AAS		;YES - THEN LITE ALREADY ASSIGNED
	MOVEM	S2,(S1)			;REPLACE FLAGS,,ADDR
	POPJ	P,			;RETURN

> ;END TOPS10 CONDITIONAL
	SUBTTL	GETCAT - ROUTINE TO SEND A REQUEST FOR CATALOG INFO MESSAGE

	;CALL:	S1/ -1,,Asciz Vol Set Name (Not a User Request) 
	;	S1/ 0,,VSL Address (If a User Request)
	;
	;RET:	True if found, False otherwise

TOPS10<
D$GCAT::
GETCAT:	PUSHJ	P,.SAVE2		;SAVE P1 & P2 FOR A MINUTE
	SKIPL	P1,S1			;SAVE CALLING PARMS, SKIP IF INTERNAL
	HRROI	S1,.VSVSN(P1)		;POINT TO THE ASCIZ VOLUME SET NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVE	S1,S2			;MOVE THE VOL SET NAME TO S1
	PUSHJ	P,D$FCAT		;FIND IT IN OUR CATALOG CACHE
	JUMPF	GETC.0			;NOT THERE,,GO REQUEST IT
	MOVX	S2,%DISK		;GET TYPE 'STRUCTURE'
	SKIPL	P1			;SKIP IF AN INTERNAL REQUEST
	STORE	S2,.VSFLG(P1),VS.TYP	;MARK THIS VOLUME SET
	$RETT				;RETURN (WITH CAT ENTRY ADDR IN S1)

	;Here to send a catalog request to PULSAR

GETC.0:	MOVEI	P2,TMPVSL		;GET A TEMP MSG BUFFER
	MOVEM	P2,G$SAB##+SAB.MS	;SAVE IT IN THE SAB
	MOVE	S1,[.OHDRS+1,,.QORCT]	;GET THE REQUEST FOR CATALOG INFO HEADER
	MOVEM	S1,.MSTYP(P2)		;SAVE IT
	SETOM	S2			;INDICATE 'NOT A USER' REQUEST
	SKIPL	P1			;UNLESS WE POINT TO A VSL
	LOAD	S2,.VSRID(P1),VS.RID	;THEN GET THE REQUEST ID
	MOVEM	S2,.MSCOD(P2)		;SAVE THE ACK CODE (RID OR -1)
	SETZM	.MSFLG(P2)		;NO FLAG WORD
	SETZM	.OFLAG(P2)		;NO MESSAGE FLAG WORD
	MOVEI	S1,1			;GET A BLOCK COUNT OF 1
	MOVEM	S1,.OARGC(P2)		;SAVE IT
	MOVEI	P2,.OHDRS(P2)		;POINT TO THE FIRST (ONLY) MSG BLOCK
	MOVE	S1,[1,,.RCTVS]		;GET VOLUME SET NAME BLOCK HEADER
	MOVEM	S1,ARG.HD(P2)		;SAVE IT
	SETZM	S1			;CLEAR S1 (USE AS BYTE COUNTER)
	SKIPL	P1			;IF INTERNAL,,SKIP
	MOVEI	P1,.VSVSN(P1)		;POINT TO THE VOL SET NAME
	HRLI	P1,(POINT 7,0)		;MAKE THE VOL SET NAME ADDR A BYTE PTR
	MOVE	S2,[POINT 7,ARG.DA(P2)]	;GET THE DESTINATION ADDRESS
GETC.1:	ILDB	TF,P1			;GET A VOLUME SET NAME BYTE
	IDPB	TF,S2			;INSERT IT INTO THE MESSAGE
	AOS	S1			;BUMP BYTE COUNT BY 1
	JUMPN	TF,GETC.1		;CONTINUE TILL ASCIZ
	IDIVI	S1,5			;CALC # OF WORDS USED
	SKIPE	S2			;ANY REMAINDER ???
	AOS	S1			;YES,,ROUND UP !!
	MOVSS	S1			;MOVE RIGHT TO LEFT
	ADDM	S1,.MSTYP+TMPVSL	;BUMP TOTAL MESSAGE LENGTH
	ADDM	S1,.OHDRS+ARG.HD+TMPVSL	;BUMP BLOCK LENGTH
	LOAD	S1,.MSTYP+TMPVSL,MS.CNT ;GET THE MESSAGE LENGTH
	MOVEM	S1,G$SAB##+SAB.LN	;SAVE IT IN THE SAB
	PUSHJ	P,SNDLBR		;SEND IT OFF TO THE TAPE LABELER
	$RETF				;AND RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	D$BCAT - BLISS INTERFACE TO ROUTINE GETCAT

	;CALL:	S1/ The Structure Resource Number
	;
	;RET:	S2/ The Catalog Entry Address or STOPCODE

TOPS10<
D$BCAT:: IMULI	S1,AMALEN		;CALC THE 'A' MATRIX OFFSET
	ADD	S1,AMATRX		;POINT TO THE RESOURCE ENTRY
	HRRO	S1,.AMNAM(S1)		;GET THE STRUCTURE NAME (VOL SET NAME)
	$CALL	S%SIXB			;CONVERT TO SIXBIT
	MOVE	S1,S2			;GET IT AS AN ARGUMENT
	PUSHJ	P,D$FCAT		;FIND IT IN THE CATALOG
	SKIPT				;SKIP IF FOUND...
	$STOP(SCE,Structure Catalog Entry is Missing) ;NO,,OH WELL !!!
	MOVE	S2,S1			;RETURN THE ADDRESS IN S2 (FOR BLISS)
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL
	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

	LOAD	P3,.VSFLG(P2),VS.TYP	;GET THE VOLUME TYPE
	MOVX	TF,FALSE		;MAKE FLAG AC FALSE
	CAXN	P3,%TAPE		;IS IT A TAPE REQUEST ???
	PUSHJ	P,FNTAPX		;YES,,FIND IT IN OUR DATA BASE
	CAXN	P3,%DISK		;IS IT A STRUCTURE REQUEST ???
	PUSHJ	P,FNDISK		;YES,,FIND IT IN OUR DATA BASE
	JUMPF	.RETF			;NOT THERE,,RETURN NOW
	MOVE	P1,S1			;SAVE THE VOL BLOCK 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	S1,.VLPTR(P2),VL.NXT	;GET THE SECONDARY VOL BLOCK ADDRESS
	SKIPE	S1			;NONE THERE,,SKIP
	STORE	P2,.VLPTR(S1),VL.PRV	;FOUND,,SAVE NEW VOL BLK ADDR AS PRIMARY

	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
	SUBTTL	D$INID - Initialization done for tape handler

;This code is executed when the tape labeler send a message saying
; 'done with label initialization' for a particular drive
; This routine clear the UC.INI bit, and arranges to have the labels
; of the drive just freed up read.

TOPS10<
D$INID:: MOVX	S1,.RECDV		;GET THE BLOCK TYPE TO LOOK FOR
	PUSHJ	P,A$FNDB##		;FIND IT
	JUMPF	MISC.3			;CAN'T, SO COMPLAIN
	MOVE	S1,.RECDN(S1)		;GET THE SIXBIT DRIVE NAME
	PUSHJ	P,UCBFND		;GET THE DRIVE DATA BLOCK
	JUMPF	MISC.3			;CAN'T SO COMPLAIN ABOUT THAT
	MOVE	S2,.UCBST(S1)		;GET THE STATUS BITS
	TXZN	S2,UC.INI		;DID WE THINK IT WAS INITING?
	$RETT				;NO, FORGET THE JUNK MAIL
	MOVEM	S2,.UCBST(S1)		;SAVE BITS WITHOUT UC.INI
	$WTO	(<Volume initialization complete>,<Drive is available for use>,MDAOBJ,$WTFLG(WT.SJI))
	MOVE	S1,.UCBNM(S1)		;GET SIXBIT DRIVE NAME
	PJRST	SNDREC			;READ THE (NEW) LABELS

;These bits are defined so that flags can be traced from the point
; of lighting to the point of testing among various calls/levels

;Flag used to signify that a user's request has other volumes
; (already) mounted

	AF.OVL==1B0

;Flag used to signify that during resource removal, there are no
; other users of a 'high level' shared resource

	RF.RSN==RHMASK			;FIELD WHICH HOLDS THE RESOURCE #
	RF.OTU==1B0			;OTHER USERS OF A SHARED DISK DRIVE
> ;END TOPS10 CONDITIONAL
	SUBTTL	D$ALOC - ROUTINE TO PERFORM DEVICE ALLOCATION

	;CALL:	S1/ The VSL Address
	;	AP/ The MDR Address
	;
	;RET:	True if Allocation Wins, False Otherwise
	;
	;	If False is returned then...
	;
	;	S1/  0 if failed because deadlock detected
	;	S1/ -1 if failed because allocation deferred

TOPS10<
D$ALOC:	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	PUSHJ	P,.SAVET		;SAVE T1 - T4
	LOAD	P1,.VSRID(S1),VS.LNK	;GET THE REQUEST LINK CODE
	LOAD	P2,.MRCNT(AP),MR.CNT	;GET THE VSL REQUEST COUNT
	MOVNS	P2			;NEGATE THE COUNT
	MOVSS	P2			;MOVE RIGHT TO LEFT
	HRRI	P2,.MRVSL(AP)		;CREATE VSL SEARCH AOBJN AC
	$SAVE	<M>			;PRESERVE WHATEVER IS IN M
	PUSHJ	P,SETSTK		;SETUP THE VSL, RSN STACK

ALOC.1:	MOVE	P3,0(P2)		;GET A VSL ADDRESS
	LOAD	S1,.VSRID(P3),VS.LNK	;GET ITS LINK CODE
	CAME	P1,S1			;DO WE WANT THIS VSL ???
	JRST	ALOC.2			;NO,,SKIP IT
	LOAD	S1,.VSFLG(P3),VS.WAL	;IS THIS VSL AWATING ALLOCATION ???
	JUMPE	S1,ALOC.2		;NO,,THEN SKIP IT
	MOVE	S1,P3			;COPY VSL POINTER
	PUSHJ	P,VSLRSX		;GET ALL THE RSNS ONTO THE M STACK
	JUMPF	[SETOM S1		;CAN'T, SO RETURN -1
		$RETF ]			;MEANING DEFERRED ALLOCATION

ALOC.2:	AOBJN	P2,ALOC.1		;CHECK ALL VSL'S

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

	;Here to find the users 'B' matrix entry, and create one if not there

ALOC.3:	PUSHJ	P,D$BMTX		;FIND THE USERS ENTRY IN THE 'B' MATRIX
	JUMPT	ALOC.4			;FOUND IT,,CONTINUE
	MOVE	S1,BMATRX		;GET THE 'B' MATRIX ID
	PUSHJ	P,L%LAST		;POSITION TO THE END OF THE 'B' MATRIX
	MOVE	S1,BMATRX		;GET THE 'B' MATRIX ID
	MOVX	S2,SMALEN		;GET THE 'B' MATRIX LENGTH
	PUSHJ	P,L%CENT		;CREATE AN ENTRY FOR THE USER
	MOVE	BM,S2			;SAVE THE ENTRY ADDRESS
	MOVE	S1,CMATRX		;GET THE 'C' MATRIX ID
	PUSHJ	P,L%LAST		;POSITION TO THE END OF THE 'C' MATRIX
	MOVE	S1,CMATRX		;GET THE 'C' MATRIX ID
	MOVX	S2,SMALEN		;GET THE 'C' MATRIX LENGTH
	PUSHJ	P,L%CENT		;CREATE AN ENTRY FOR THE USER
	MOVE	CM,S2			;SAVE THE ENTRY ADDRESS
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE USERS JOB NUMBER
	MOVEM	S1,.SMJOB(BM)		;SAVE IT IN THE 'B' MATRIX ENTRY
	MOVEM	S1,.SMJOB(CM)		;SAVE IT IN THE 'C' MATRIX ENTRY
	MOVEI	S1,1			;GET MAX RSN OFFSET OF 1
	STORE	S1,.SMFLG(BM),SM.CNT	;SET IT
	STORE	S1,.SMFLG(CM),SM.CNT	;HERE ALSO
	AOS	PROCNT			;BUMP THE PRECESS COUNT BY 1

	;Here to create a secondary 'B' Matrix entry for the user which
	;will be used in the deadlock avoidance check. The origional is ignored
	;until the return from the deadlock routine. If the routine returns
	;true, the origional is deleted, if false the secondary is deleted.

ALOC.4:	MOVE	S1,BMATRX		;GET THE 'B' MATRIX ID
	PUSHJ	P,L%RENT		;REMEMBER THE ORIGIONAL ENTRY
	PUSHJ	P,L%SIZE		;GET ITS LENGTH
	MOVE	P3,S2			;SAVE IT FOR A SECOND
	PUSHJ	P,L%CENT		;CREATE A NEW ENTRY
	MOVE	P2,S2			;SAVE ITS ADDRESS FOR A SECOND
	ADDI	P3,0(S2)		;CALC ENTRY END ADDRESS
	HRL	S2,BM			;GET SOURCE,,DESTINATION FOR BLT
	BLT	S2,-1(P3)		;COPY OLD ENTRY TO NEW ENTRY
	MOVX	S1,SM.IGN		;GET THE 'IGNORE' BIT
	IORM	S1,.SMFLG(BM)		;LITE IT FOR THE OLD ENTRY
	MOVE	BM,P2			;POINT TO NEW ENTRY

ALO.4A:	MOVE	T4,[IOWD MSGLN##,G$MSG]	;GET A QUEUE FOR VSL ADDRESSES
	PUSH	T4,[-1]			;SET END OF QUEUE INDICATOR


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

	;Here to perform the actual device allocation ('B' Matrix Update)

ALOC.5:	POP	M,S1			;GET A RSN OFF THE Q
	POP	M,P2			;GET THE VSL ADDRESS OFF THE QUEUE
	CAMN	P2,[-1]			;ARE WE DONE ???
	JRST	ALOC.8			;YES,,GO FINISH UP
	PUSH	T4,P2			;QUEUE UP THE VSL ADDRESS
	LOAD	S1,S1,RF.RSN		;EXTRACT JUST THE RSN
	MOVE	S2,P2			;LOAD UP THE VSL ADDRESS
	PUSHJ	P,ADDBMA		;YES,,UPDATE THE RESOURCE COUNT
	JRST	ALOC.5			;   AND GO PROCESS THE NEXT VSL

	;Here to perform Deadlock Avoidance Check

ALOC.8:	PUSHJ	P,DEADLK		;CALL BLISS INTERFACE ROUTINE
	JUMPT	ALOC.A			;WIN,,CONTINUE ON !!!

	;Here if Deadlock check fails, delete all current VSL's

ALOC.9:	POP	T4,S1			;GET A VSL ADDRESS
	PUSHJ	P,SHUFFL		;SHUFFEL THIS GUYS ALLOCATION AROUND
	JUMPT	ALOC.A			;WIN,,IT SURE IS HARD BEING NICE !!!
	MOVE	S1,BMATRX		;GET THE 'B' MATRIX ID
	MOVE	S2,BM			;GET THE USERS CURRENT MATRIX ENTRY
	PUSHJ	P,L%APOS		;POSITION TO IT
	PUSHJ	P,L%DENT		;DELETE IT
	MOVE	S1,BMATRX		;GET THE 'B' MATRIX ID
	PUSHJ	P,L%PREM		;POSITION TO THE OLD ENTRY
	ZERO	.SMFLG(S2),SM.IGN	;CLEAR THE 'IGNORE' BIT
	$TEXT(<-1,,G$MSG>,<Volume set allocation failed - insufficient resources available^M^J^0>)
	SETOM	ERRACK			;THIS IS AN ERROR ACK
	PUSHJ	P,USRNOT		;TELL THE USER
	SETZM	S1			;RETURN ALLOCATION FAILED ERROR CODE
	$RETF				;RETURN NO GOOD !!!

	;Here if the Deadlock Check Wins

ALOC.A:	MOVE	S1,BMATRX		;GET THE 'B' MATRIX ID
	PUSHJ	P,L%PREM		;GET THE OLD USER ENTRY
	PUSHJ	P,L%DENT		;DELETE IT

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

	;Here to clear 'Waiting for Allocation' bits in the VSL's

ALOC.B:	POP	T4,S1			;GET THE VSL ADDRESS OFF THE QUEUE
	CAMN	S1,[-1]			;END OF THE QUEUE ???
	JRST	ALO.B0			;YES,,FINISH UP !!!
	ZERO	.VSFLG(S1),VS.WAL	;NO,,CLEAR THIS VSL'S WAITING BIT
	JRST	ALOC.B 			;AND GO GET ANOTHER

ALO.B0:	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE USERS JOB NUMBER
	TXNN	S1,BA%JOB		;IS IT AN INTERNAL REQUEST ???
	PJRST	USRACK			;NO,,RETURN ACKING THE USER

	INCR	.MRCNT(AP),MR.LNK	;YES,,GEN A NEW LINK CODE
	LOAD	P2,.MRCNT(AP),MR.LNK	;AND LOAD IT
	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE REQUEST NUMBER
	MOVNS	P1			;NEGATE IT
	MOVSS	P1			;MOVE RIGHT TO LEFT
	HRRI	P1,.MRVSL(AP)		;CREATE VSL SEARCH AOBJN AC

ALO.B1:	MOVE	S1,0(P1)		;GET A VSL ADDRESS
	LOAD	S2,.VSFLG(S1),VS.ALC	;JUST ALLOCATING ???
	SKIPN	S2			;YES,,SKIP THIS
	STORE	P2,.VSRID(S1),VS.LNK	;NO,,LINK THIS VSL TO ALL OTHER MOUNTS
	AOBJN	P1,ALO.B1		;LOOK AT ALL VSL'S
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	D$BMTX - ROUTINE TO FIND A USERS ENTRY IN THE 'B' MATRIX
	;	D$CMTX -    ""   ""  ""  "   ""    ""  ""  "" 'C'   ""

	;CALL:	AP/ The Users MDR Address
	;
	;RET:	BM/ The 'B' Matrix Entry Address if using D$BMTX entry point
	;	CM/ The 'C' Matrix Entry Address if using D$CMTX entry point

TOPS10<
D$BMTX:	SKIPA	S1,BMATRX		;SKIP AND LOAD THE 'B' MATRIX ID
D$CMTX:	MOVE	S1,CMATRX		;LOAD THE 'C' MATRIX ID
	PUSHJ	P,.SAVE2		;SAVE P1 & P2 FOR A SECOND
	LOAD	P1,.MRJOB(AP),MD.PJB	;GET THE USERS JOB NUMBER
	MOVX	P2,SM.IGN		;GET 'IGNORE ENTRY' FLAG BIT
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	SKIPA				;SKIP THE FIRST TIME THROUGH
BMTX.1:	PUSHJ	P,L%NEXT		;GET THE NEXT ENTRY
	JUMPF	.RETF			;NOT THERE,,RETURN NOT FOUND
	CAMN	P1,.SMJOB(S2)		;IS THIS THE ONE WE WANT ???
	TDNE	P2,.SMFLG(S2)		;YES, 'IGNORE THIS ONE' ???
	JRST	BMTX.1			;NOT OURS OR IGNORED,,TRY NEXT
	CAMN	S1,BMATRX		;WAS THIS A 'B' MATRIX SEARCH ???
	MOVE	BM,S2			;YES,,GET THE ENTRY ADDRESS IN BM
	CAMN	S1,CMATRX		;WAS THIS A 'C' MATRIX SEARCH ???
	MOVE	CM,S2			;YES,,GET THE ENTRY ADDRESS IN CM
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	DEADLK - BLISS INTERFACE ROUTINE FOR DEADLOCK AVOIDANCE ROUTINE

	;CALL:	AMATRX/ The 'A' Matrix Address
	;	BMATRX/ The 'B' Matrix Link List ID
	;	CMATRX/ The 'C' Matrix Link List ID
	;
	;RET:	True Or False depending on the Deadlock Avoidance check

TOPS10<
D$DLOK::				;MAKE IT GLOBAL
DEADLK:	SKIPN	G$DEAD##		;DEADLOCK AVOIDANCE CHECKING ENABLED ??
	$RETT				;NO,,ALWAYS WIN !!!
	$COUNT	(DEAD)			;COUNT NUMBER OF DEADLOCK CHECKS
	PUSH	P,AMATRX		;PARM #1 AMATRX
	PUSH	P,BMATRX		;PARM #2 BMATRX
	PUSH	P,CMATRX		;PARM #3 CMATRX
	MOVE	S1,AMATRX		;GET THE AMATRX ADDRESS
	LOAD	S1,.AMHDR(S1),AM.CNT	;GET THE TOTAL RESOURCE COUNT
	PUSH	P,S1			;PARM #4 RESOURCE COUNT
	PUSH	P,PROCNT		;PARM #5 MATRIX PROCESS COUNT
	PUSHJ	P,D$DEAD##		;PERFORM DEADLOCK AVOIDANCE
	SUB	P,[5,,5]		;DELETE THE PARM LIST
	$RETIT				;return if ok
	$COUNT	(DFAL)			;count up the deadlock failures
	$RET				;PASS FAILURE ON BACK
> ;END TOPS10 CONDITIONAL
	SUBTTL	D$DLCK - ROUTINE TO SET UP THE DEADLOCK AVOIDANCE CHECK

	;CALL:	S1/ The VSL Address
	;	AP/ The MDR Address
	;
	;RET:	True if Allocation Wins, False Otherwise

TOPS10<
D$DLCK:	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	PUSHJ	P,.SAVET		;SAVE T1 - T4
	MOVEM	S1,SAVVSL		;SAVE THE VSL FOR RETRIES

DLCK.A:	LOAD	P1,.VSRID(S1),VS.LNK	;GET THE REQUEST LINK CODE
	LOAD	P2,.MRCNT(AP),MR.CNT	;GET THE VSL REQUEST COUNT
	MOVNS	P2			;NEGATE THE COUNT
	MOVSS	P2			;MOVE RIGHT TO LEFT
	HRRI	P2,.MRVSL(AP)		;CREATE VSL SEARCH AOBJN AC
	SETZM	P4			;CLEAR THE DEADLOCK CHECK FLAG
	$SAVE	<M>			;PRESERVE WHATEVER IS IN M
	PUSHJ	P,SETSTK		;SETUP THE VSL, RSN STACK
	MOVE	T4,[IOWD MSGLN##,G$MSG]	;GET A QUEUE FOR VSL ADDRESSES
	PUSH	T4,[-1]			;INDICATE 'END OF QUEUE'

DLCK.1:	MOVE	P3,0(P2)		;GET A VSL ADDRESS
	LOAD	S1,.VSRID(P3),VS.LNK	;GET ITS LINK CODE
	MOVX	S2,VS.CLM		;GET THE 'RESOURCES CLAIMED' STATUS BIT
	CAMN	P1,S1			;DO WE WANT THIS VSL ???
	TDNE	S2,.VSFLG(P3)		;  AND IS HAS IT BEEN CLAIMED YET ???
	JRST	DLCK.3			;WRONG VSL OR CLAIMED,,SKIP IT
	MOVE	S1,P3			;COPY THE VSL ADRS
	PUSHJ	P,VSLRSN		;EXTRACT ALL RSNS FOR THIS VSL
	SETOM	P4			;SET THE DEADLOCK CHECK FLAG
	PUSH	T4,P3			;QUEUE UP THE VSL ADDRESS

DLCK.3:	AOBJN	P2,DLCK.1		;CHECK ALL VSL'S
	JUMPE	P4,.RETT		;NOTHING TO DO, SO RETURN NOW!

	;Here to find the users 'C' matrix entry

	PUSHJ	P,D$CMTX		;LOCATE THE USERS 'C' MATRIX ENTRY
	SKIPT				;IT MUST BE THERE !!!
	$STOP(CME,'C' Matrix Entry is Missing)

	;Here to perform 'A' & 'C' Matrix Updates

	;First, Create a duplicate 'A' matrix 

	MOVE	P4,AMATRX		;GET THE OLD 'A' MATRIX ADDRESS
	LOAD	S1,.AMHDR(P4),AM.LEN	;GET THE MATRIX LENGTH
	PUSHJ	P,M%GMEM		;GET A NEW' 'A' MATRIX 
	MOVEM	S2,AMATRX		;SAVE THE ADDRESS OF THE NEW MATRIX
	ADDI	S1,0(S2)		;CALC THE MATRIX END ADDRESS
	HRL	S2,P4			;GET SOURCE,,DEST FOR BLT
	BLT	S2,-1(S1)		;COPY OLD 'A' MATRIX TO NEW 'A' MATRIX

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

	;Then, Create a duplicate 'C' matrix entry

	MOVE	S1,CMATRX		;GET THE 'C' MATRIX ID
	PUSHJ	P,L%RENT		;REMEMBER THE ORIGIONAL ENTRY
	PUSHJ	P,L%SIZE		;GET ITS LENGTH
	MOVE	P3,S2			;SAVE IT FOR A SECOND
	PUSHJ	P,L%CENT		;CREATE A NEW ENTRY
	MOVE	P2,S2			;SAVE ITS ADDRESS FOR A SECOND
	ADDI	P3,0(S2)		;CALC ENTRY END ADDRESS
	HRL	S2,CM			;GET SOURCE,,DESTINATION FOR BLT
	BLT	S2,-1(P3)		;COPY OLD ENTRY TO NEW ENTRY
	MOVX	S1,SM.IGN		;GET THE 'IGNORE' BIT
	IORM	S1,.SMFLG(CM)		;LITE IT FOR THE OLD ENTRY
	MOVE	CM,P2			;POINT TO NEW ENTRY

	;Here to Update the 'A' and 'C' matricies

DLCK.4:	POP	M,P1			;GET A RSN OFF THE QUEUE
	POP	M,P3			;GET THE VSL ADDRESS OFF THE QUEUE
	CAMN	P1,[-1]			;END OF THE QUEUE ???
	JRST	DLCK.5			;YES,,LETERRIP !!!
	LOAD	S1,P1,RF.RSN		;GET JUST THE RESOURCE NUMBER
	MOVE	S2,P3			;AIM AT THE VSL
	PUSHJ	P,ADDCMA		;UPDATE THE 'C' MATRIX
	LOAD	S1,P1,RF.RSN		;GET JUST THE RESOURCE NUMBER
	MOVE	S2,P3			;AIM AT THE VSL
	TXNN	P1,RF.OTU		;IF OTHER USERS, DON'T TAKE OUT DRIVES
	PUSHJ	P,ADDAMA		;UPDATE THE 'A' MATRIX
	JUMPT	DLCK.4			;WIN,,CONTINUE
	JRST	DLCK.7			;NO GOOD,,RETURN AN ERROR

	;Here to invoke the Deadlock Avoidance Routine

DLCK.5:	PUSHJ	P,DEADLK		;LETERRIP !!!
	JUMPF	DLCK.7			;NO GOOD,,FINISH UP !!!

	;Deadlock Check Wins,,delete the old 'A' Matrix and 'C' Matrix
	;Also Update the VS.CLM status bit for the VSL'S involved

	LOAD	S1,.AMHDR(P4),AM.LEN	;GET THE OLD 'A' MATRIX LENGTH
	MOVE	S2,P4			;GET THE OLD 'A' MATRIX ADDRESS
	PUSHJ	P,M%RMEM		;RETURN IT TO THE MEMORY MANAGER
	MOVE	S1,CMATRX		;GET THE 'C' MATRIX ID
	PUSHJ	P,L%PREM		;POSITION TO THE OLD ENTRY
	PUSHJ	P,L%DENT		;AND DELETE IT
	MOVX	S2,VS.CLM		;GET THE 'RESOURCES CLAIMED' STATUS BIT

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

DLC.5B:	POP	T4,S1			;GET A VSL ADDRESS OFF THE QUEUE
	CAMN	S1,[-1]			;END OF QUEUE ???
	$RETT				;YES,,RETURN OK...
	IORM	S2,.VSFLG(S1)		;LITE THE RESOURCES CLAIMED STATUS BIT
	JRST	DLC.5B			;AND GO TRY AGAIN

	;Here if an error occurs,,delete the new 'A' and 'C' Matricies

DLCK.7:	MOVE	S2,AMATRX		;GET THE NEW 'A' AMATRX ADDRESS
	MOVEM	P4,AMATRX		;RESTORE THE OLD 'A' MATRIX ADDRESS
	LOAD	S1,.AMHDR(S2),AM.LEN	;GET THE OLD 'A' MATRIX LENGTH
	PUSHJ	P,M%RMEM		;RETURN IT TO THE MEMORY MANAGER
	MOVE	S1,CMATRX		;GET THE 'C' MATRIX ID
	MOVE	S2,CM			;GET THE 'C' MATRIX ENTRY
	PUSHJ	P,L%APOS		;POSITION TO THE ENTRY
	PUSHJ	P,L%DENT		;AND DELETE IT
	MOVE	S1,CMATRX		;GET THE 'C' MATRIX ENTRY
	PUSHJ	P,L%PREM		;POSITION TO THE OLD 'C' ENTRY
	ZERO	.SMFLG(S2),SM.IGN	;CLEAR THE IGNORE BIT
	MOVE	S1,SAVVSL		;GET THE VSL ADDRESS
	PUSHJ	P,SHUFFL		;SHUFFLE THE RESOURCES AROUND
	JUMPF	.RETF			;NO GOOD SHUFFLING
	JRST	DLCK.A			;TRY AGAIN WITH NEW RESOURCES

SAVVSL:	BLOCK	1			;PLACE TO SAVE A VSL

> ;END TOPS10 CONDITIONAL
	SUBTTL	RETA%C - ROUTINE TO RETURN RESOURCES TO THE 'A' & 'C' MATRICIES

	;CALL:	S1/ The VSL Being Returned
	;
	;RET:	True Always

TOPS10<
RETA%C:	LOAD	TF,.VSFLG(S1),VS.CLM	;HAS THIS VSL CLAIMED ITS RESOURCES ???
	JUMPE	TF,.RETT		;NO,,NOTHING TO RETURN
	PUSHJ	P,.SAVE4		;SAVE P1 - P4 FOR A SECOND
	MOVE	P2,S1			;SAVE THE VSL ADDRESS
	PUSHJ	P,D$CMTX		;GET THE USERS 'C' MATRIX ADDRESS
	SKIPT				;IT ALSO MUST BE THERE !!!
	PUSHJ	P,S..CME		;NO,,UH OH !!!
	$SAVE	<M>			;PRESERVE WHATEVER IS IN M
	PUSHJ	P,SETSTK		;SETUP THE VSL, RSN STACK
	MOVE	S1,P2			;GET BACK VSL ADRS
	PUSHJ	P,VSLRSN		;GO GET THIS VSL'S RESOURCE NUMBERS
	ZERO	.VSFLG(P2),VS.CLM	;CLEAR RESOURCE CLAIMED STATUS BIT

RETA.1:	POP	M,P1			;GET BACK RSN
	POP	M,0(M)			;THROW OUT VSL (COPY OF P2)
	CAMN	P1,[-1]			;TOP OF STACK?
	$RETT				;YES, ALL DONE
	LOAD	S1,P1,RF.RSN		;GET THE RSN IN S1
	MOVE	S2,P2			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,SUBCMA		;RETURN THE 'C' MATRIX RESOURCE
	TXNN	P1,RF.OTU		;ARE THERE OTHER USERS?
	PUSHJ	P,SUBAMA		;NO, RETURN THE 'A' MATRIX RESOURCE
	SKIPT				;'A' MATRIX NEGATIVE,,THATS ALL FOLKS !!
	$STOP	(NAM,Negative 'A' Matrix Entry Computed) ;CNT CAN'T BE NEGATIVE
	JRST	RETA.1			;PROCESS THE NEXT VSL
> ;END TOPS10 CONDITIONAL
	SUBTTL	RETBMA - ROUTINE TO RETURN RESOURCES TO THE 'B' MATRIX

	;CALL:	S1/ The VSL Being Returned
	;
	;RET:	True Always

TOPS10<
RETBMA:	PUSHJ	P,.SAVE4		;SAVE P1 - P4 FOR A SECOND
	MOVE	P2,S1			;SAVE THE VSL ADDRESS
	PUSHJ	P,D$BMTX		;GET THE USERS 'B' MATRIX ADDRESS
	SKIPT				;IT ALSO MUST BE THERE !!!
	$STOP	(BME,'B' Matrix Entry is Missing)
	$SAVE	<M>			;PRESERVE WHATEVER IS IN M
	PUSHJ	P,SETSTK		;SETUP THE VSL, RSN STACK
	MOVE	S1,P2			;RESTORE THE VSL ADDRESS
	PUSHJ	P,VSLRSX		;GO GET THIS VSL'S RESOURCE NUMBERS

RETB.1:	POP	M,P1			;GET BACK RSN AND FLAGS
	POP	M,0(M)			;THROW OUT VSL ADRS (HAVE IN P2)
	CAMN	P1,[-1]			;TOP OF STACK?
	$RETT				;YES, ALL DONE!
	LOAD	S1,P1,RF.RSN		;GET RESOURCE NUMBER IN S1
	MOVE	S2,P2			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,SUBBMA		;RETURN THE 'B' MATRIX RSN
	JRST	RETB.1			;TRY THE NEXT ONE
> ;END TOPS10 CONDITIONAL
	SUBTTL	ADDBMA - ROUTINE  TO UPDATE A RESOURCE NUMBER FOR A USER
	;	ADDCMA -   ""     ""   ""   "   ""       ""    "" "  ""

	;CALL:	S1/ The Resource Number
	;	S2/ The VSL Address
	;	BM or CM/ The Matrix entry address

TOPS10<
ADDBMA:	PUSHJ	P,.SAVE3		;SAVE P1 - P3
	MOVE	P2,BM			;GET THE ENTRY ADDRESS
	MOVE	P3,BMATRX		;GET THE 'B' MATRIX ID
	JRST	UPDR.1			;MEET AT THE PASS !!!

ADDCMA:	PUSHJ	P,.SAVE3		;SAVE P1 - P3
	MOVE	P2,CM			;GET THE ENTRY ADDRESS
	MOVE	P3,CMATRX		;GET THE 'C' MATRIX ID

UPDR.1:	PUSHJ	P,GETADD		;GET ADDITIVE (S1 = RSN, S2 = VSL)

UPDR.3:	$SAVE	<S1,S2>			;SAVE THE RSN AND COUNT
	LOAD	P1,.SMFLG(P2),SM.CNT	;GET HIS RSN COUNT
	CAIG	S1,0(P1)		;DOES HE HAVE THIS RESOURCE YET ???
	JRST	UPDR.4			;YES,,JUST BUMP THE COUNT

	;Here to add space to the users 'B' matrix entry for the new RSN

	PUSH	P,S1			;SAVE THE RSN 
	PUSH	P,S2			;SAVE THE COUNT
	STORE	S1,.SMFLG(P2),SM.CNT	;SAVE THE NEW MAX RSN OFFSET
	SUB	S1,P1			;CALC NEEDED SPACE FOR NEW RSN
	MOVE	P1,S1			;SAVE IT HERE
	MOVE	S1,P3			;GET THE MATRIX ID
	MOVE	S2,P2			;GET THE ENTRY ADDRESS
	PUSHJ	P,L%APOS		;POSITION TO IT
	PUSHJ	P,L%SIZE		;GET THE ENTRY LENGTH
	PUSH	P,S2			;SAVE THE CURRENT LENGTH
	ADD	S2,P1			;EXTEND IT BY CORRECT AMOUNT
	PUSHJ	P,L%CENT		;CREATE A NEW ENTRY FOR THE USER
	POP	P,S1			;RESTORE THE OLD LENGTH
	ADD	S1,S2			;CALC BLT END ADDRESS
	MOVE	P1,S2			;GET 0,,DESTINATION
	HRL	P1,P2			;GET SOURCE,,DESTINATION FOR BLT
	BLT	P1,-1(S1)		;COPY OLD TO NEW
	EXCH	P2,S2			;GET NEW ENTRY ADDR IN P2, OLD IN S2
	MOVE	S1,P3			;GET THE MATRIX ID
	PUSHJ	P,L%APOS		;POSITION TO THE OLD ENTRY
	PUSHJ	P,L%DENT		;DELETE IT
	CAMN	P3,BMATRX		;IS THIS THE 'B' MATRIX ???
	MOVE	BM,P2			;YES,,SAVE THE NEW ENTRY ADDRESS
	CAMN	P3,CMATRX		;IS THIS THE 'C' MATRIX ???
	MOVE	CM,P2			;YES,,SAVE THE NEW ENTRY ADDRESS
	POP	P,S2			;RESTORE THE COUNT
	POP	P,S1			;RESTORE THE RSN OFFSET

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

	;Here to just update the RSN claim count for a user

UPDR.4:	ADDI	S1,.SMRES(P2)		;CALC RSN ENTRY ADDRESS
	ADDM	S2,0(S1)		;UPDATE THE MATRIX
	CAME	P2,BM			;ARE WE UPDATING THE 'B' MATRIX ???
	$RETT				;NO,,RETURN
	SUBI	S1,.SMRES(P2)		;YES,,GET THE RSN BACK
	IMULI	S1,AMALEN		;GET THE 'A' MATRIX ENTRY OFFSET
	ADD	S1,AMATRX		;GET THE ENTRY ADDRESS
	INCR	.AMCNT(S1),AM.ALO	;BUMP THE RSN ALLOCATION COUNT
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	SUBCMA - ROUTINE TO RETURN RESOURCES TO THE 'C' MATRIX

	;CALL:	S1/ The RSN
	;	S2/ The VSL Address
	;
	;RET:	True  Always or not at all

TOPS10<
SUBCMA:	$SAVE	<S1,S2>			;SAVE S1 & S2 ACROSS THE CALL
	PUSH	P,S2			;SAVE THE VSL ADDRESS FOR A SECOND
	LOAD	S2,.SMFLG(CM),SM.CNT	;GET THE RSN COUNT
	CAIGE	S2,0(S1)		;RESOURCE NUMBER MUST BE IN RANGE
	$STOP	(RMC,Resource Number Missing in 'C' Matrix)
	POP	P,S2			;RESTORE THE VSL ADDRESS
	PUSHJ	P,GETSUB		;CALC SUBTRACT QUANTITY
	ADDI	S1,.SMRES(CM)		;POINT TO THE RSN ENTRY
	ADDM	S2,0(S1)		;UPDATE THE MATRIX
	SKIPGE	0(S1)			;IF STILL VALID,,SKIP
	$STOP	(NCM,Negative 'C' Matrix Entry Computed) ;CNT CAN'T BE NEGATIVE
	$RETT				;RETURN



	SUBTTL	SUBBMA - ROUTINE TO RETURN 'B' MATRIX RESOURCES


	;CALL:	S1/ The RSN
	;	S2/ The VSL Address
	;
	;RET:	True Always or not at all

SUBBMA:	$SAVE	<S1,S2>			;SAVE S1 & S2 ACROSS THE CALL
	PUSH	P,S2			;SAVE THE VSL ADDRESS FOR A SECOND
	LOAD	S2,.SMFLG(BM),SM.CNT	;GET THE RSN COUNT
	CAIGE	S2,0(S1)		;RESOURCE NUMBER MUST BE IN RANGE
	$STOP	(RMB,Resource Number Missing in 'B' Matrix)
	POP	P,S2			;RESTORE THE VSL ADDRESS
	PUSHJ	P,GETSUB		;GET THE SUBTRACT QUANTITY
	ADDI	S1,.SMRES(BM)		;POINT TO THE RSN ENTRY
	ADDM	S2,0(S1)		;UPDATE THE MATRIX
	SKIPGE	0(S1)			;SKIP IF STILL VALID
	$STOP	(NBM,Negative 'B' Matrix Entry Computed) ;CNT CAN'T BE NEGATIVE
	SUBI	S1,.SMRES(BM)		;YES,,GET THE RSN BACK
	IMULI	S1,AMALEN		;GET THE 'A' MATRIX ENTRY OFFSET
	ADD	S1,AMATRX		;GET THE ENTRY ADDRESS
	DECR	.AMCNT(S1),AM.ALO	;REDUCE THE RSN ALLOCATION COUNT
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	ADDAMA - ROUTINE TO REMOVE 'A' MATRIX RESOURCES
	;	SUBAMA - ROUTINE TO RETURN 'A' MATRIX RESOURCES
	;	D$INCA - ROUTINE TO ADD 1 TO THE RESOURCE COUNT
	;	D$DECA - ROUTINE TO SUBTRACT 1 FROM THE RESOURCE COUNT

	;CALL:	S1/ The RSN to be Updated (if ADDAMA or SUBAMA)
	;	S2/ The VSL Address
	;
	;	S1/ The UCB Address (if D$INCA or D$DECA)
	;
	;RET:	False iff the Matrix Count goes Negative

TOPS10<
ADDAMA:	TDZA	TF,TF			;FLAG ADD ENTRY POINT
SUBAMA:	MOVEI	TF,1			;FLAG SUBTRACT ENTRY POINT
	$SAVE	<S1,S2,T1>		;SAVE S1 & S2 ACROSS THE CALL
	MOVE	T1,TF			;GET ENTRY POINT TYPE
	XCT	[PUSHJ P,GETADD
		 PUSHJ P,GETSUB](T1)	;GET ADD/SUBTRACT QUANTITY
	SETZM	T1			;INDICATE CLAIM ADJUSTMENT
	PUSHJ	P,ADJAMA		;UPDATE THE MATRIX FOR THIS RSN
	JUMPF	.RETF			;OVER QUOTA,,RETURN NOW
	$RETT				;ELSE RETURN OK

D$INCA:	SKIPA	S2,[-1]			;GET RSN COUNT OF -1 AND SKIP
D$DECA:	MOVEI	S2,1			;GET RSN COUNT OF 1
	$SAVE	<T1>			;SAVE T1
	SETOM	T1			;INDICATE NO CLAIM ADJUSTMENT
	LOAD	S1,.UCBST(S1),UC.RSN	;GET THE CURRENT RSN
	PUSHJ	P,ADJAMA		;UPDATE THE MATRIX FOR THIS RSN
	JUMPF	.RETF			;OVER QUOTA,,RETURN NOW
	$RETT				;ELSE RETURN OK
	SUBTTL	ADJAMA - ROUTINE TO ADJUST THE 'A' MATRIX

	;CALL:	S1/ The RSN
	;	S2/ The count
	;	T1/ 0 if claim adjustment wanted, -1 if not
	;
	;RET:	True if OK, False if over quota

ADJAMA:	IMULI	S1,AMALEN		;GET THE ENTRY OFFSET
	ADD	S1,AMATRX		;POINT TO THE ENTRY
	JUMPN	T1,ADJA.1		;NO CLAIM ADJUSTMENT,,SKIP THIS
	LOAD	TF,.AMCNT(S1),AM.CLM	;GET THE NUMBER CLAIMED
	ADDM	S2,TF			;ADD/SUBTRACT 1
	STORE	TF,.AMCNT(S1),AM.CLM	;AND SAVE THE RESULT
ADJA.1:	LOAD	TF,.AMCNT(S1),AM.AVA	;GET THE AVAILABLE COUNT
	MOVNS	S2			;REVERSE THE PROCESS
	ADDM	S2,TF			;ADD/SUBTRACT 1
	STORE	TF,.AMCNT(S1),AM.AVA	;AND SAVE THE RESULT
	TXNE	TF,SGNBIT		;IF FIELD SIGN BIT IS ON,, THEN
	$RETF				;   COUNT IS NEGATIVE SO RETURN FALSE
	$RETT				;ELSE RETURN OK

> ;END TOPS10 CONDITIONAL
	SUBTTL	VSLRSN - ROUTINE TO FIND A VSL'S RESOURCE NUMBERS

	;CALL:	S1/ The VSL Address
	;	M/  Stack pointer to RSN Queue
	;
	;RET:	FALSE if the disk VSL is not in the system catalog
	;	TRUE with the VSL & RSN pairs queued up

TOPS10<
VSLRSN:	TDZA	TF,TF			;INDICATE NORMAL ENTRY POINT
VSLRSX:	SETOM	TF			;INDICATE EXTENDED ENTRY POINT
	PUSHJ	P,.SAVE4		;SAVE P1 - P4
	MOVE	P1,S1			;SAVE VSL ADRS
	MOVE	P2,TF			;SAVE THE ENTRY POINT INDICATOR
	LOAD	S1,.VSFLG(S1),VS.TYP	;GET TYPE OF VOLUME SET
	CAXE	S1,%DISK		;IS THIS A STRUCTURE REQUEST ???
	JRST	VSLR.2			;NO, SEE WHAT ELSE

	;Here to queue up allocation for a disk VSL

	HRROI	S1,.VSVSN(P1)		;POINT TO THE ASCIZ VOL SET NAME
	PUSHJ	P,S%SIXB		;CONVERT IT TO SIXBIT
	MOVE	S1,S2			;MOVE IT TO S1
	PUSH	P,S1			;SAVE STR NAME A SECOND
	PUSHJ	P,D$SRSN		;GET THE STRUCTURE RESOURCE NUMBER
	POP	P,TF			;GET BACK STR NAME
	PUSH	M,P1			;QUEUE UP THE VSL ADDRESS
	PUSH	M,S1			;QUEUE UP THE RESOURCE NUMBER
	IMULI	S1,AMALEN		;MAKE A MATRIX INDEX
	ADD	S1,AMATRX		;AIM AT CURRENT SLOT
	LOAD	S1,.AMNAM(S1),AM.PRR	;GET THE PERMANENT STR BIT FOR THIS STR
	JUMPN	S1,.RETT		;IF PERMANENT STR, DON'T ADD DEVICES
	MOVE	S1,TF			;GET BACK STR NAME
	PUSHJ	P,D$FCAT		;REQUEST THE CATALOG ENTRY
	JUMPF	.POPJ			;NOT THERE,,IGNORE ALLOCATION FOR NOW
	MOVE	P2,S1			;SAVE CATALOG ADRS
	LOAD	S1,.CTVSN(P2)		;GET VOLUME SET NAME
	PUSHJ	P,D$FNDV		;FIND THE PRIMARY VOL BLOCK
	PUSHJ	P,D$VOWN		;FIND THE OWNER
	SETZ	S1,			;ASSUME NO OTHER USERS
	SKIPF				;ASSUMPTION TRUE?
	MOVX	S1,RF.OTU		;NO, INDICATE OTHER USERS
	EXCH	S1,P2			;SAVE FLAG BIT, GET BACK STR NAME
	LOAD	P3,.CTCNT(S1)		;GET NUMBER OF DRIVES UNDER THIS STR
	MOVEI	P4,.CTVOL(S1)		;AIM AT DEVICE LIST PORTION
VSLR.1:	MOVE	S1,.CTRSN(P4)		;GET THIS RESOURCE NUMBER
	PUSH	M,P1			;QUEUE UP THE VSL ADDRESS
	IOR	S1,P2			;LITE (PERHAPS) THE OTHER USER BIT
	PUSH	M,S1			;QUEUE UP THE CATALOG ENTRY ADDRESS
	ADDI	P4,CATBLN		;STEP TO NEXT DRIVE
	SOJG	P3,VSLR.1		;DO 'EM ALL
	$RETT				;DONE,,RETURN

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

	;Here to queue up allocation for a tape VSL
	;If the Extended entry point was used, we will also queue up
	;the volume RSN's for all the volumes in the volume set.

VSLR.2:	CAXE	S1,%TAPE		;IS IT A TAPE VSL?
	$RETF				;NO, WE DON'T KNOW HOW TO DO ALLOCATION
	LOAD	S1,.VSATR(P1),VS.RSN	;GET THE REQUESTED DEVICE TYPE
	SKIPN	S1			;CAN'T BE ZERO !!!
	$STOP	(ITR,Invalid Tape Resource Number Returned)
	PUSH	M,P1			;QUEUE UP THE VSL
	PUSH	M,S1			;QUEUE UP THE DEVICE REQUIREMENTS
	JUMPN	P2,VSLR.3		;EXTENDED ENTRY,,QUEUE ALL VOL RSN'S

	;Queue the VSL's current volume RSN

	MOVX	S1,VS.ABO+VS.VSW	;GET ABORTED BY OPR + VOL SWITCH BITS
	TDNE	S1,.VSFLG(P1)		;EITHER BIT ON ???
	$RETT				;YES,,DON'T QUEUE UP THE VOL RSN
	LOAD	S1,.VSCVL(P1),VS.OFF	;GET OFFSET TO CURRENT VOLUME
	ADDI	S1,.VSVOL(P1)		;POINT TO THE CURRENT VOL ADDRESS
	MOVE	S1,0(S1)		;GET THE VOL ADDRESS
	SKIPN	.VLNAM(S1)		;ANY VOLID SPECIFIED ???
	$RETT				;NO,,DON'T QUEUE ANYTHING UP !!!
	PUSHJ	P,D$TVRS		;YES,,GET THE VOLUME RSN
	PUSH	M,P1			;QUEUE UP THE VSL
	PUSH	M,S1			;QUEUE UP VOLUME RSN
	$RETT

	;Queue all the volumes in the volume set

VSLR.3:	LOAD	P2,.VSCVL(P1),VS.CNT	;GET THE VOLUME COUNT
	MOVNS	P2			;NEGATE IT
	MOVSS	P2			;MOVE RIGHT TO LEFT
	HRRI	P2,.VSVOL(P1)		;CREATE VOL AOBJN AC

VSLR.4:	MOVE	S1,0(P2)		;GET A VOLUME ADDRESS
	SKIPN	.VLNAM(S1)		;ANY VOLID SPECIFIED ???
	JRST	VSLR.5			;NO,,DON'T QUEUE ANYTHING UP !!!
	PUSHJ	P,D$TVRS		;YES,,CONVERT IT TO A RSN
	PUSH	M,P1			;QUEUE UP THE VSL
	PUSH	M,S1			;QUEUE UP THE VOLUME RSN
VSLR.5:	AOBJN	P2,VSLR.4		;CONTINUE FOR ALL VOLUMES
	$RETT				;AND RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	SETSTK - Setup a queue for VSL, RSN pairs

	;This routine sets up a queue so that all resource numbers for a
	; given VSL or group of VSLs can be stashed in one place.

TOPS10<
SETSTK:	MOVE	M,[IOWD RPDLEN,RSNPDL]	;AIM AT THE QUEUE
	PUSH	M,[-1]			;MARK THE END OF THE QUEUE
	PUSH	M,[-1]			;ONE MORE TIME !!!
	$RETT

RPDLEN==^D100*2				;SPACE FOR 100 VSL, RSN PAIRS
RSNPDL:	BLOCK	RPDLEN			;THE RSN STACK
> ;END TOPS10 CONDITIONAL
	SUBTTL	GETADD - ROUTINE TO CALC THE 'A', 'B', 'C' MATRIX ADD VALUE
	;	GETSUB - ROUTINE TO CALC THE 'A', 'B', 'C' MATRIX SUB VALUE


	;CALL:	S1/ The RSN
	;	S2/ The VSL Address whose resource is being updated or 0 if none
	;
	;RET:	S1/ The RSN
	;	S2/ The Additive or Subtractive Quantity


	;This routine returns a vslue in S2 which is then used in updating
	;The deadlock avoidance matricies. This value is determined as
	;follows: If the Resource Type is %STRC, and the VS.SIN
	;flag bit is lit, then return MAXRES in S2. If both of those
	;conditions are not met, then return 1 in S2. If the GETSUB entry
	;Point is used, Then the negative of those 2 values is returned.

TOPS10<
GETADD:	TDZA	TF,TF			;INDICATE 'GETADD' ENTRY POINT
GETSUB:	SETOM	TF			;INDICATE 'GETSUB' ENTRY POINT
	JUMPE	S2,[MOVEI  S2,1		;NO VSL ADDRESS,,GET A 1
		    SKIPE  TF		;WAS 'GETSUB' ENTRY POINT USED ???
		    MOVNS  S2		;YES,,NEGATE THE VALUE
		    $RETT  ]		;AND RETURN
	$SAVE	<S1,P1>			;SAVE S1 AND P1 FOR A SECOND
	IMULI	S1,AMALEN		;GET THE 'A' MATRIX OFFSET
	ADD	S1,AMATRX		;POINT TO THE 'A' MATRIX ENTRY
	LOAD	S1,.AMSTA(S1),AM.DVT	;GET THE RESOURCE TYPE
	LOAD	P1,.VSFLG(S2),VS.SIN	;GET THE 'SINGLE ACCESS' FLAG BIT
	MOVEI	S2,1			;DEFAULT TO A 1
	CAXN	S1,%STRC		;IS THIS A STRUCTURE RESOURCE ???
	SKIPN	P1			;YES,,AND IS SINGLE ACCESS REQUIRED ??
	SKIPA				;NOT A STR OR NOT SINGLE ACCESS,,SKIP
	MOVX	S2,MAXRES		;ELSE LOAD MAX RESOURCE COUNT
	SKIPE	TF			;WAS ENTRY POINT 'GETSUB' ???
	MOVNS	S2			;YES,,THEN NEGATE THE VALUE
	$RETT				;RETURN
> ;END TOPS10 CONDITIONAL
	SUBTTL	MISC ROUTINES

TOPS10<
D$DEC::	$TEXT	(,<^D4/S1/ ^A>)
	$RETT

D$CR::	OUTSTR	[BYTE(7)15,12,0,0,0]
	POPJ	P,

D$TEXT:: $TEXT	(,<^T/0(S1)/^A>)
	$RETT

DUMP:	$SAVE	<TF,S1,S2>
	PUSH	P,AMATRX
	PUSH	P,BMATRX
	PUSH	P,CMATRX
	LOAD	S1,AMATRX
	LOAD	S1,.AMHDR(S1),AM.CNT
	PUSH	P,S1
	PUSH	P,PROCNT
	PUSHJ	P,D$DUMP##
	SUB	P,[5,,5]
	$RETT
> ;END TOPS10 CONDITIONAL
	SUBTTL	MDA PSEUDO PROCESS ACTION ROUTINES

	;CALL:	S1/ The .QE Address
	;
	;RET:	True Always


	;SUBTTL  D$PPRL - ROUTINE TO DELETE AN MDR FOR A PSEUDO PROCESS

TOPS10<
D$PPRL:	SKIPN	G$MDA##			;ARE WE RUNNING WITH MDA ???
	$RETT				;NO,,RETURN
	$SAVE	<AP,CM,BM>		;SAVE SOME AC'S
	SKIPE	AP,.QEMDR(S1)		;CHECK AND LOAD THE MDR ADDRESS
	PJRST	D$DMDR			;DELETE THE MDR FOR THIS REQUEST
	$RETT				;NONE,,RETURN
> ;END TOPS10 CONDITIONAL

TOPS20<
D$PPRL:	$RETT	>			;A NOOP ON THE -20
	SUBTTL  D$PPRE - ROUTINE TO RESET A REAL PROCESS TO A PSEUDO PROCESS

D$PPRE:
TOPS10<	SKIPN	G$MDA##			;ARE WE RUNNING WITH MDA ???
	$RETT				;NO,,RETURN
	$SAVE	<P1,P2,P3,P4,AP,CM,BM>	;SAVE ALL THESE AC'S
	MOVE	P1,S1			;SAVE THE QE ADDRESS
	SKIPN	AP,.QEMDR(P1)		;CHECK AND LOAD THE MDR ADDRESS
	$RETT				;RETURN IF NONE...
	PUSHJ	P,D$BMTX		;LOCATE THE PROCESS 'B' MATRIX
	PUSHJ	P,D$CMTX		;LOCATE THE PROCESS 'C' MATRIX
	MOVE	S1,.QERID(P1)		;GET THE PROCESS REQUEST ID
	TXO	S1,BA%JOB		;CREATE THE PSEUDO JOB NUMBER
	STORE	S1,.MRJOB(AP),MD.PJB	;CONVERT THE MDR TO A PSEUDO PROCESS MDR
	STORE	S1,.QEJBN(P1),QE.BJN	;SAVE IT HERE ALSO
	MOVEM	S1,.SMJOB(BM)		;CONVERT THE 'B' MATRIX AND
	MOVEM	S1,.SMJOB(CM)		;CONVERT THE 'C' MATRIX
	SETZM	G$ACK##			;WE DON'T WANT AN ACK LATER !!!
	INCR	.MRCNT(AP),MR.LNK	;GEN A NEW LINK CODE
	LOAD	P3,.MRCNT(AP),MR.LNK	;  AND LOAD IT INTO P3
	LOAD	P4,.MRCNT(AP),MR.CNT	;GET THE VSL REQUEST COUNT
	MOVEI	P2,.MRVSL(AP)		;GET VSL LIST ADDRESS
	ADDI	P2,-1(P4)		;WORK FROM LAST VSL TO FIRST

PPRE.1:	MOVE	S1,0(P2)		;GET A VSL ADDRESS
	MOVE	P1,.VSFLG(S1)		;SAVE THE VOL SET FLAG BITS
	PUSHJ	P,D$ALCV		;RETURN THIS VSL'S ALLOCATION
	MOVE	S1,0(P2)		;GET THE VSL ADDRESS BACK
	TXNE	P1,VS.UAL		;DID THE USER ALLOCATE THIS VSL ???
	TXNE	P1,VS.ALC		;YES,,DID HE HAVE IT MOUNTED ???
	JRST	PPRE.2			;NOT USER ALLOC OR NOT MOUNTED,,SKIP
	ZERO	.VSFLG(S1),VS.ALC	;WANT THIS REMOUNTED !!
	STORE	P3,.VSRID(S1),VS.LNK	;RESET TO A COMMON LINK CODE

PPRE.2:	SUBI	P2,1			;GET NEXT VSL ADDRESS
	SOJG	P4,PPRE.1		;CONTINUE FOR ALL VSL'S
	MOVE	S1,.MRQEA(AP)		;GET THE QE ADDRESS
	MOVX	S2,QE.WAM+QE.ALR	;GET 'ALLOCATION PRE-SCAN' BITS
	ANDCAM	S2,.QESEQ(S1)		;CLEAR THEM
	MOVX	S2,QE.WAL		;FORCE ANOTHER PRE-SCAN BY
	IORM	S2,.QESEQ(S1)		;  LIGHTING THIS BIT
> ;END TOPS10 CONDITIONAL
	$RETT				;AND RETURN
	SUBTTL	D$PMDR - ROUTINE TO LOOK AT THE MDR LOOKING FOR PSEUDO PROCESSES


	;CALL:	No Args
	;
	;RET:	True Always

TOPS10<
D$PMDR:	SKIPN	G$MDA##			;ARE WE RUNNING WITH MDA ???
	$RETT				;NO,,RETURN
	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%FIRST		;GET THE FIRST ENTRY
	JRST	PMDR.2			;JUMP THE FIRST TIME

PMDR.1:	MOVE	S1,MDRQUE		;GET THE MDR QUEUE ID
	PUSHJ	P,L%NEXT		;GET THE NEXT ENTRY
PMDR.2:	JUMPF	.RETT			;DONE,,RETURN
	MOVE	AP,S2			;SAVE THE ENTRY ADDRESS
	LOAD	S1,.MRJOB(AP),MD.PJB	;GET THE JOB NUMBER
	TXNN	S1,BA%JOB		;IS IT A PSEUDO PROCESS
	JRST	PMDR.1			;NO,,SKIP IT
	MOVE	S1,.MRQEA(AP)		;GET THE QE ADDRESS
	ZERO	.QESEQ(S1),QE.ALR	;ZAP THE REQUEST FOR ALLOCATION BIT
	MOVE	S1,.MRVSL(AP)		;GET THE VSL ADDRESS
	PUSHJ	P,D$MNTV		;TRY TO MOUNT IT
	JRST	PMDR.1			;AND GO GET THE NEXT
> ;END TOPS10 CONDITIONAL

TOPS20<
D$PMDR:	$RETT	>			;A NOOP ON THE -20
	SUBTTL	D$MODR - ROUTINE TO MODIFY A USERS ALLOCATION ON THE 'FLY'

	;CALL:	S1/ The VSL to be modified
	;	S2/ The UCB of the device to be added
	;
	;RET:	True if user can have the volume, false otherwise

TOPS10<
D$MODR:	PUSHJ	P,.SAVE3		;SAVE P1 - P3
	DMOVE	P1,S1			;SAVE THE VSL AND UCB ADDRESSES
	SKIPN	P3,.UCBVL(P2)		;CHK AND LOAD THE MOUNTED VOL ADDRESS
	 $ERJMP	MD$NVM,P1		;NONE THERE,,SOMETHING FISHY HERE !!!

	;Check/Validate the Density Status

	MOVX	S1,VL.SRD		;GET SET REQUESTED DENSITY FOR USER BIT
	ANDCAM	S1,.VLFLG(P3)		;CLEAR IT INCASE SECOND TIME THROUGH
	LOAD	S1,.VSATR(P1),VS.DDN	;DID WE DEFAULT THE DENSITY ???
	JUMPN	S1,MODR.1		;YES,,CONTINUE ONWARD
	LOAD	S1,.VSATR(P1),VS.DEN	;NO,,GET THE REQUESTED DENSITY CODE
	LOAD	S2,.VLFLG(P3),VL.DEN	;GET THE VOLUME DENSITY
	CAMN	S1,S2			;IT WOULD BE NICE IF THEY MATCHED
	JRST	MODR.1			;THEY DO
	LOAD	S1,.VLFLG(P3),VL.LBT	;GET THE VOLUME LABEL TYPE
	PUSHJ	P,GETLBT		;CONVERT IT
	MOVX	S2,UC.WLK		;GET THE WRITE LOCKED BIT
	CAIN	S1,%UNLBL		;UNLABELED?
	TDNE	S2,.UCBST(P2)		;CANT SCREW AROUND UNLESS WRITE-ENABLED
	 $ERJMP	MD$RDD,P1		;UNLABELED OR WRITE-LOCKED
	LOAD	S1,.VSATR(P1),VS.DEN	;GET THE REQUESTED DENSITY
	MOVE	S1,D$DEN(S1)		;CONVERT CODE TO A BIT MAP
	TDNN	S1,.UCBST(P2)		;DRIVE SUPPORT THE REQUESTED DENSITY?
	 $ERJMP	MD$IDD,P1		;OPERATOR IS A JOKER
	MOVX	S1,VL.SRD		;GET SET REQUESTED DENSITY FOR USER BIT
	IORM	S1,.VLFLG(P3)		;REMEMBER FOR LATER

	;Check/Validate the Track Status

MODR.1:	LOAD	S1,.VSATR(P1),VS.DTK	;DID WE DEFAULT THE TRACK STATUS ???
	JUMPN	S1,MODR.2		;YES,,CONTINUE ONWARD
	LOAD	S1,.VSATR(P1),VS.TRK	;GET THE REQUESTED TRACK STATUS
	LOAD	S2,.UCBST(P2),UC.TRK	;GET THE DEVICE TRACK STATUS
	CAME	S1,S2			;THEY MUST MATCH !!!
	 $ERJMP	MD$TDM,P1		;NO,,TOO BAD

	;Check to see if requested resource matches assigned resource

MODR.2:	LOAD	S1,.VSATR(P1),VS.RSN	;GET THE REQUESTED DEVICE TYPE
	SKIPN	S1			;CAN'T BE ZERO !!!
	PUSHJ	P,S..ITR		;YES,,DEEEEEP TROUBLE !!!
	LOAD	P2,.UCBST(P2),UC.RSN	;GET THE DEVICE RESOURCE NUMBER
	CAMN	S1,P2			;DO WE MATCH ???
	JRST	MODR.3			;YES,,HE WINS BIG !!!

	;See if we can change his allocation to include this device

	PUSHJ	P,D$BMTX		;LOCATE THE USERS 'B'
	PUSHJ	P,D$CMTX		;     AND 'C' MATRIX ENTRIES
	DMOVE	S1,P1			;GET VSL (P1) AND RSN (P2)
	PUSHJ	P,MODALC		;MODIFY THE USERS ALLOCATION
	SKIPT				;WIN,,CONTINUE
	 $ERJMP	MD$DDD,P1		;RETURN THE ERROR (DEADLOCK DETECTED) !!
MODR.3:	LOAD	S1,.VLFLG(P3),VL.DEN	;GET THE MOUNTED VOLUME DENSITY
	MOVX	S2,VL.SRD		;GET SET REQUESTED DENSITY FOR USER BIT
	TDNN	S2,.VLFLG(P3)		;GONNA DO THIS LATER?
	STORE	S1,.VSATR(P1),VS.DEN	;NO - RESET IT FOR THIS VSL
	$RETT				;RETURN
	SUBTTL	SHUFFL - Routine to shuffle resources around for a requestor

	;CALL:	S1/ A 'current' VSL address
	;
	;RET:	True if resources shuffled OK, false otherwise

	;This routine attempts to resolve deadlocks for a user by allocating
	;different resources to a users request. The current (new) requests
	;are shuffled first, then old requests are looked at. If, after all 
	;of this there is still a deadlock, tough noogies !!!

SHUFFL:	$SAVE	<P1,P2,P3,P4,T1>	;SAVE SOME AC'S
	STKVAR	<<VQUEUE,40>>		;ALLOCATE SOME QUEUE SPACE
	LOAD	P2,.VSRID(S1),VS.LNK	;GET THE LINK CODE (NEW REQUESTS)
	MOVEI	P3,VQUEUE		;GET THE QUEUE ADDRESS
	ADD	P3,[-40,,-1]		;CREATE QUEUE PDL POINTER
	PUSH	P3,[-1]			;SIGNAL END OF 'NEW' REQUEST QUEUE
	MOVE	P4,P			;SAVE THE CURRENT STACK POINTER
	PUSH	P,[-2]			;SIGNAL END OF 'OLD' REQUEST QUEUE
	LOAD	P1,.MRCNT(AP),MR.CNT	;GET THE REQUEST COUNT
	MOVNS	P1			;NEGATE IT
	MOVSS	P1			;MOVE RIGHT TO LEFT
	HRRI	P1,.MRVSL(AP)		;CREATE AOBJN AC

SHUF.1:	MOVE	S1,0(P1)		;GET A VSL ADDRESS
	LOAD	S2,.VSFLG(S1),VS.TYP	;GET THE REQUEST TYPE
	CAXE	S2,%TAPE		;A TAPE ???
	JRST	SHUF.2			;NO,,GET NEXT
	PUSHJ	P,D$FOWN		;DOES HE HAVE IT MOUNTED ???
	JUMPT	SHUF.2			;YES,,SKIP THIS
	MOVE	S1,0(P1)		;GET THE VSL ADDRESS BACK
	LOAD	S2,.VSRID(S1),VS.LNK	;GET ITS LINK CODE
	CAMN	P2,S2			;A 'NEW' REQUEST ???
	PUSH	P3,S1			;YES,,QUEUE IT UP
	CAME	P2,S2			;AN 'OLD' REQUEST ???
	PUSH	P,S1			;YES,,QUEUE IT UP
SHUF.2:	AOBJN	P1,SHUF.1		;CHECK ALL REQUESTS
	PUSHJ	P,D$BMTX		;LOCATE THIS GUYS 'B' MATRIX ENTRY
	PUSHJ	P,D$CMTX		;LOCATE THIS GUYS 'C' MATRIX ENTRY

SHUF.3:	POP	P3,P1			;DE-QUEUE A VSL ADDRESS
	CAMN	P1,[-1]			;DONE WITH THE 'NEW' QUEUE ???
	JRST	[MOVE P3,P		;YES,,GET POINTER TO 'OLD' QUEUE
		 JRST SHUF.3 ]		;AND KEEP ON TRUCK'N !!!
	CAMN	P1,[-2]			;DONE WITH THE 'OLD' QUEUE ???
	JRST	[MOVE P,P4		;RESTORE THE STACK POINTER
		 $RETF   ]		;JUST NO WAY TO CONTINUE !!!!!

	LOAD	S1,.VSATR(P1),VS.DEN	;GET HIS DENSITY CODE
	MOVE	S1,D$DEN(S1)		;CONVERT TO A BIT MASK
	LOAD	S2,.VSATR(P1),VS.TRK	;GET THE TRACK TYPE
	LOAD	T1,.VSATR(P1),VS.RSN	;GET THE CURRENT RESOURCE
	PUSHJ	P,ANYTAP		;GET THE NEXT RESOURCE WHICH FITS
	JUMPF	SHUF.3			;NO MORE RESOURCES,,TRY NEXT REQUEST
	MOVE	S2,S1			;GET THE NEW RESOURCE IN S2
	MOVE	S1,P1			;GET THE VSL ADDRESS IN S1
	PUSHJ	P,MODALC		;MODIFY HIS ALLOCATION
	JUMPF	SHUF.3			;LOSE,,TRY NEXT REQUEST
	MOVE	P,P4			;RESTORE THE STACK POINTER
	$RETT				;WIN,,RETURN
	SUBTTL	MODALC - Routine to modify a users resource number for a request

	;CALL:	S1/ The VSL Address
	;	S2/ The New Resource Number (RSN)
	;
	;RET:	True -  users matrix entries updated
	;	False - Deadlock detected (no matrix modifications)


MODALC:	PUSHJ	P,.SAVE3		;SAVE P1 AND P3
	DMOVE	P1,S1			;SAVE THE VSL ADDRESS AND NEW RSN
	LOAD	P3,.VSFLG(P1),VS.CLM	;GET THE RESOURCE CLAIMED STATUS IN P2
	LOAD	S1,.VSATR(P1),VS.RSN	;GET THE REQUESTED DEVICE TYPE
	MOVE	S2,P1			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,SUBBMA		;DELETE HIS 'B' MATRIX ENTRY
	JUMPE	P3,.+3			;NOT CLAIMED,,DON'T MODIFY 'A' & 'C'
	PUSHJ	P,SUBAMA		;DELETE HIS 'A' MATRIX ENTRY
	PUSHJ	P,SUBCMA		;DELETE HIS 'C' MATRIX ENTRY
	MOVE	S1,P2			;GET THE NEW RESOURCE NUMBER IN S1
	MOVE	S2,P1			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,ADDBMA		;ADD A NEW 'B' MATRIX ENTRY
	JUMPE	P3,.+3			;NOT CLAIMED,,DON'T MODIFY 'A' & 'C'
	PUSHJ	P,ADDAMA		;ADD A NEW 'A' MATRIX ENTRY
	PUSHJ	P,ADDCMA		;ADD A NEW 'C' MATRIX ENTRY
	PUSHJ	P,DEADLK		;CHECK FOR DEADLOCKS
	JUMPF	MODA.2			;FOUND SOME,,OH WELL WE TRIED !!!!
MODA.1:	STORE	P2,.VSATR(P1),VS.RSN	;WIN,,MODIFY HIS ALLOCATION
	$RETT				;RETURN

	;Here if user caused a deadlock - put matrix back in order

MODA.2:	MOVE	S1,P2			;GET THE NEW RESOURCE NUMBER IN S1
	MOVE	S2,P1			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,SUBBMA		;DELETE HIS 'B' MATRIX ENTRY
	JUMPE	P3,.+3			;NOT CLAIMED,,DON'T MODIFY 'A' & 'C'
	PUSHJ	P,SUBAMA		;DELETE HIS 'A' MATRIX ENTRY
	PUSHJ	P,SUBCMA		;DELETE HIS 'C' MATRIX ENTRY
	LOAD	S1,.VSATR(P1),VS.RSN	;GET THE REQUESTED DEVICE TYPE
	MOVE	S2,P1			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,ADDBMA		;RESTORE HIS 'B' MATRIX ENTRY
	JUMPE	P3,.+3			;NOT CLAIMED,,DON'T MODIFY 'A' & 'C'
	PUSHJ	P,ADDAMA		;RESTORE HIS 'A' MATRIX ENTRY
	PUSHJ	P,ADDCMA		;RESTORE HIS 'C' MATRIX ENTRY
	$RETF				;RETURN NO GOOD
> ;END TOPS10 CONDITIONAL
	SUBTTL	D$ALCT - ROUTINE TO ALLOCATE TAPE VOLUMES FOR 'IDENTIFY' COMMAND

	;CALL:	S1/ The VSL Address
	;
	;RET:	True if no deadlock, False otherwise

TOPS10<
	INTERN	D$ALCT

D$ALCT:	PUSHJ	P,.SAVE2		;SAVE P1 - P2
	MOVE	P1,S1			;SAVE THE VSL ADDRESS
	PUSHJ	P,D$CMTX		;LOCATE THIS GUYS 'C' MATRIX ENTRY
	LOAD	S1,.VSCVL(P1),VS.OFF	;GET THE OFFSET TO THE CURRENT VOLUME
	ADDI	S1,.VSVOL(P1)		;POINT TO ITS ADDRESS
	MOVE	S1,0(S1)		;GET THE CURRENT VOLUME ADDRESS
	PUSHJ	P,D$TVRS		;GET THE VOLUME RESOURCE NUMBER
	MOVE	P2,S1			;SAVE THE RSN IN P2
	MOVE	S2,P1			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,ADDAMA		;ADD THIS RESOURCE TO THE 'A' MATRIX
	PUSHJ	P,ADDCMA		;ADD THIS RESOURCE TO THE 'C' MATRIX
	LOAD	S1,.VSFLG(P1),VS.CLM	;HAS THIS DEVICE BEEN CLAIMED ???
	JUMPN	S1,ALCT.1		;YES,,DON'T DO IT AGAIN
	LOAD	S1,.VSATR(P1),VS.RSN	;GET THE REQUESTED DEVICE RSN
	MOVE	S2,P1			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,ADDAMA		;ADD THIS RESOURCE TO THE 'A' MATRIX
	PUSHJ	P,ADDCMA		;ADD THIS RESOURCE TO THE 'C' MATRIX
ALCT.1:	PUSHJ	P,DEADLK		;PERFORM THE DEADLOCK CHECK
	JUMPT	[MOVX  S1,VS.CLM	;WIN,,GET VSL CLAIMED STATUS
		 IORM  S1,.VSFLG(P1)	;SET IT
		 $RETT ]		;AND RETURN
	MOVE	S1,P2			;GET THE VOLUME RSN IN S1
	MOVE	S2,P1			;GET THE VSL ADDRESS IN S2
	PUSHJ	P,SUBAMA		;REMOVE THIS RSN FROM THE 'A' MATRIX
	PUSHJ	P,SUBCMA		;REMOVE THIS RSN FROM THE 'C' MATRIX
	LOAD	S1,.VSFLG(P1),VS.CLM	;GET THE DEVICE CLAIMED STATUS BIT
	JUMPN	S1,ALCT.2		;IF SET,,DON'T RETURN DEVICE ALLOCATION
	LOAD	S1,.VSATR(P1),VS.RSN	;GET THE DEVICE RESOURCE NUMBER
	MOVE	S2,P1			;GET THE VSL ADDRESS
	PUSHJ	P,SUBAMA		;REMOVE THIS RSN FROM THE 'A' MATRIX
	PUSHJ	P,SUBCMA		;REMOVE THIS RSN FROM THE 'C' MATRIX
ALCT.2:	 $ERJMP	MD$DDD,P1		;RETURN AN ERROR
> ;END TOPS10 CONDITIONAL
	END