Google
 

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

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

	SEARCH	QSRMAC,GLXMAC,ORNMAC	;GET QUASAR SYMBOLS
	PROLOGUE(QSRMDA)		;GENERATE NECESSARY SYMBOLS

	.DIRECT	FLBLST			;SQUASH LITERAL EXPANSION
	SUBTTL	Table of Contents


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

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

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

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

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

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

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

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

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

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

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

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

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

	INTERN	D$INIT			;MDA INITIALIZATION
	INTERN	D$MOUNT			;PROCESS A TAPE/DISK MOUNT REQUEST
TOPS10<	INTERN	D$DEASSIGN >		;DEASSIGN/RELEASE A VOLUME SET
TOPS10<	INTERN	D$IDENTIFY >		;IDENTIFY MESSAGE PROCESSOR
TOPS10<	INTERN	D$ENABLE >		;ENABLE AVR FOR A TAPE DRIVE
TOPS10<	INTERN	D$DISABLE >		;DISABLE AVR FOR A TAPE DRIVE
	INTERN	D$DMDR			;DELETE AN MDR
TOPS10<	INTERN	D$RECOGNIZE >		;PROCESS THE RECOGNIZE OPERATOR CMD
TOPS10<	INTERN	D$AVR >			;TAPE AUTOMATIC VOLUME RECOGNIZER
TOPS10<	INTERN	D$DEVSTA >		;PROCESS TAPE/DISK STATUS MESSAGES
TOPS10<	INTERN	D$UNLOAD >		;UNLOAD A TAPE DRIVE
TOPS10<	INTERN	D$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

> ;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
	JUMPF	D$DMDR			;NO GOOD,,DELETE THE MDR AND RETURN
TOPS20<	PUSHJ	P,USRACK		;ACK THE USER
	$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.1:	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
	$TEXT	(MDADBP,<[^T/@TYPE(P3)/ request ^T/.VSVSN(P2)/ queued, request #^D/.VSRID(P2),VS.RID/]>)

USRA.2:	AOBJN	P1,USRA.1		;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	[NPRTBL]		;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-1		;CALC THE VSL LENGTH
	MOVE	S1,VSLQUE		;GET THE VSL QUEUE ID
	PUSHJ	P,L%CENT		;CREATE SPACE FOR THE VSL ENTRY
	MOVE	P2,S2			;SAVE THE NEW VSL ADDRESS
	HRLI	S1,TMPVSL		;GET THE SOURCE VSL ADDRESS
	HRRI	S1,0(P2)		;GET THE DEST VSL ADDRESS
	BLT	S1,VSLLEN-1(P2)		;COPY THE PROTOTYPE VSL OVER
	MOVE	T1,VOLNBR		;GET THE VOLUME COUNT
	MOVEI	T2,.VSVOL(P2)		;POINT T2 AT THE VSL VOL ADDRESSES
	MOVEI	T3,ARG.DA(P1)		;POINT T3 AT THE VOLUME LIST

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

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