.TITLE	VSDRV -- VARIABLE SEND-DATA DRIVER
	.IDENT	/060582/
;
;	VSDRV VERSION 2
;
;	DRIVER CODE VERSION 2.05
;
;	YES, THIS IS THE EVER-POPULAR AND WORLD-ACCLAIMED VS: DRIVER VERSION 2!
;	(ACCEPT NO SUBSTITUTES!)
;
;	WITH THANKS TO:
;		DAN CURTIS, FOR LENDING HIS EXPERTISE AND CODE 
;			(IS THERE  A N Y T H I N G  YOU CAN'T DO???)
;		PHIL CANNON, FOR SUGGESTING THIS IN THE FIRST PLACE
;		THE LWBR-POB PROJECT, FOR PAYING FOR THE TIME IT TOOK
;
;	VERSION 2 WRITTEN BY JOHN OSUDAR 31-JUL-81
;
;	MODIFICATION HISTORY FOR VERSION 2:
;	2.01 03-AUG-81	ADDED PCBDF$ MACRO CALL TO DEFINE P.BLKS; CHANGED "BEQ" TO
;			"BNE" IN VSCRQ AFTER TEST FOR SF.FLU SUBFUNCTION
;	2.02 03-AUG-81	ADDED LINE "MOV QUHDAD,R0" AFTER $QASTT CALL
;	2.03 26-AUG-81	FIXED BUG IN DETECTING MESSAGE LONGER THAN USER BUFFER--
;			EXISTING CODE LOST MESSAGE & POOL SPACE!!!
;	2.04 30-OCT-81	ADDED FUNCTIONS IO.EXM AND IO.DLM
;	2.05 05-JUN-82	IMPROVED SPEED BY REPLACING $GTWRD/$PTWRD WITH INTERNAL
;			CODE
;
;	FUNCTIONS SUPPORTED:
;
;	IO.KIL		(0012)	CANCEL ALL WAITING READ REQUESTS FOR THIS TASK
;	IO.WLB		(0400)	PUT A MESSAGE INTO ANY EXISTING QUEUE
;	IO.RLB		(1000)	GET A MESSAGE FROM A QUEUE
;	IO.RLB!SF.WAI	(1200)	WAIT FOR A MESSAGE TO BE PUT INTO A QUEUE,
;				AND GET IT
;	IO.ATT		(1400)	(NO-OP -- CANNOT ATTACH DEVICE)
;	IO.DET		(2000)	(NO-OP)
;	IO.CRQ		(2400)	CREATE A MESSAGE QUEUE
;	IO.CRQ!SF.FLU	(2500)	CREATE A MESSAGE QUEUE; IF IT ALREADY EXISTS,
;				FLUSH IT (DELETE ALL MESSAGES)
;	IO.DLQ		(3000)	DELETE A MESSAGE QUEUE AND ALL QUEUED MESSAGES
;	IO.CLN		(3400)	CLOSE LUN (USED BY EXEC); CLEAN UP AST'S
;	IO.DMP		(4000)	DUMP A SNAPSHOT OF THE DRIVER'S PRIVATE POOL
;	IO.AST		(4400)	SET/CLEAR AST FOR A QUEUE
;	IO.EXM		(5000)	EXAMINE SELECTED MESSAGE
;	IO.DLM		(5400)	DELETE SELECTED MESSAGE
;
;	EACH MESSAGE QUEUE HAS A NAME, WHICH IS A SIX-CHARACTER RAD50 STRING,
;	WHICH MUST BEGIN WITH SOMETHING OTHER THAN A SPACE.  WHEN NO QUEUE
;	NAME IS GIVEN IN A FUNCTION, THE TASK'S NAME IS USED AS A DEFAULT.
;	IF PRIVILEGE CHECKING IS ENABLED IN THIS ASSEMBLY, THEN NON-PRIVILEGED
;	TASKS ARE NOT ALLOWED TO CREATE, DELETE, OR READ QUEUES OTHER
;	THAN THEIR DEFAULT QUEUE.  ALL TASKS MAY SEND MESSAGES TO ANY QUEUE.
;	(IF PRIVILEGE CHECKING IS DISABLED, ANY TASK CAN DO ANYTHING.)
;
;	WHENEVER A "MESSAGE ID" IS MENTIONED, IT MEANS THE VIRTUAL ADDRESS OF
;	THE MESSAGE (IN VSDRV ADDRESS SPACE).  A MESSAGE ID OF 0 MEANS THE FIRST
;	MESSAGE IN THE QUEUE.
;
;	TO DISABLE PRIVILEGE CHECKING, COMMENT OUT THE FOLLOWING LINE:
;
;VS$PRV	=	0		;CHECK PRIVILEGES
;
;	THE SIX-WORD PARAMETER LIST SUPPLIED TO QIO IS USED AS FOLLOWS:
;
;	WORD 1 -- BUFFER ADDRESS (WITH IO.WLB, IO.RLB, IO.DMP, IO.EXM)
;	WORD 2 -- BUFFER LENGTH IN BYTES (WITH IO.WLB, IO.RLB, IO.DMP, IO.EXM)
;	WORD 3 -- FIRST WORD OF RAD50 QUEUE NAME (WITH IO.WLB; FOR PRIVILEGED
;			TASKS, ALSO WITH IO.RLB, IO.CRQ, IO.DLQ, IO.EXM, IO.DLM)
;	WORD 4 -- SECOND WORD OF RAD50 QUEUE NAME (SAME FUNCTIONS AS WORD 3)
;	WORD 5 -- REQUESTED MESSAGE ID (WITH IO.EXM, IO.DLM)
;	WORD 6 -- ADDRESS OF AST ROUTINE, OR 0 TO CLEAR (WITH IO.AST)
;
;	IT IS RECOMMENDED THAT WORDS 3 AND 4 BE SET TO ZERO IF THE DEFAULT
;	QUEUE NAME IS DESIRED.
;	NOTE:  IO.RLB RETURNS THE SENDER TASK NAME IN THE FIRST TWO WORDS OF
;	THE BUFFER, SO FOUR EXTRA BYTES SHOULD BE SUPPLIED IN THE USER BUFFER.
;	IO.EXM RETURNS THE ENTIRE MESSAGE, INCLUDING THE FOUR OVERHEAD WORDS
;	(NEXT-MESSAGE ID, TEXT LENGTH OF CURRENT MESSAGE, SENDER TASK NAME)
;	BUT DOES ALLOW A PARTIAL TRANSFER, UNLIKE IO.RLB.
;
	.MCALL	HWDDF$,PKTDF$,DCBDF$,UCBDF$,SCBDF$,TCBDF$,PCBDF$	;V2.01
	HWDDF$
	PKTDF$
	DCBDF$
	UCBDF$
	SCBDF$
	TCBDF$
	PCBDF$								;V2.01
;
LD$VS	==	1			;WE CAN GET LOADED (AND USUALLY DO!)
FREESZ	==	2048.			;PRIVATE POOL SIZE IN BYTES
NUMPRM	=	3			;NUMBER OF AST PARAMETERS ON STACK
;
;	MESSAGE QUEUE HEADER OFFSETS
;
QH.LNK	= 0
QH.FMS	= 2
QH.LMS	= 4
QH.QNM	= 6
QH.RWP	= 12
QH.TCB	= 14
QH.AST	= 16
QHDSIZ	= 20
;
;	MESSAGE OFFSETS
;
MS.LNK	= 0
MS.LEN	= 2
MS.STN	= 4
MS.TXT	= 10
;
VSTOP:					;LABEL AT START OF DRIVER CODE
$VSTBL::
	.WORD	VSINI			;I/O INITIATOR
	.WORD	VSCAN			;CANCEL I/O
	.WORD	VSOUT			;TIMEOUT
	.WORD	VSPWF			;POWERFAIL
;
;	VSINI -- I/O INITIATOR ENTRY:  GET A PACKET TO PROCESS
;
;	INITIAL CONDITIONS:
;		R5 = UCB ADDRESS
;
;	RESULTS:
;		IF CY SET, NO PACKET OR CONTROLLER BUSY
;		IF CY CLEAR:
;		R1 = PACKET ADDRESS
;		R4 = SCB ADDRESS
;		R5 = UCB ADDRESS
;
VSINI:
	CALL	$GTPKT			;GET A PACKET
	BCS	VSOUT			;IF NONE, RETURN
;
;	VSPROC -- PROCESS I/O PACKET
;
;	INITIAL CONDITIONS:
;		R1 = PACKET ADDRESS
;		R4 = SCB ADDRESS
;		R5 = UCB ADDRESS
;
;	THIS ROUTINE WILL DISPATCH THE REQUEST TO THE FUNCTION ROUTINE.
;	
VSPROC:
	MOV	R1,IOPKAD		;SAVE PACKET ADDRESS
	MOV	I.FCN(R1),IOFUNC	;SAVE FUNCTION
	MOVB	I.FCN+1(R1),R2		;GET FUNCTION CODE
	ASL	R2			;MAKE IT A WORD OFFSET
	MOV	I.TCB(R1),R0		;GET REQUESTOR TCB ADDRESS
	MOV	T.NAM(R0),QUENAM	;GET TASK NAME FOR DEFAULT QUEUE NAME
	MOV	T.NAM+2(R0),QUENAM+2	;
	JMP	@INITBL(R2)		;PERFORM THE OPERATION
;
VSOUT:	RETURN				;TIMEOUT JUST RETURNS
VSPWF:	MOV	U.DCB(R5),R0		;GET DCB ADDRESS
	MOV	D.PCB(R0),R0		;GET DRIVER'S PCB ADDRESS
	MOV	P.BLKS(R0),R0		;GET NUMBER OF 64-BYTE BLOCKS IN
					;PARTITION (MAXIMUM 1777 WILL WORK.)
	ASH	#6,R0			;MAKE IT A BYTE COUNT
	MOV	#VSBOT,R1		;GET CURRENT END OF DRIVER
	SUB	#VSTOP,R1		;COMPUTE FIXED SIZE OF DRIVER
	CMP	R1,R0			;HOW DOES IT COMPARE?
	BHIS	9$			;IF FIXED SIZE >= PARTITION, DONE
	CMP	R0,#20000		;PARTITION > 8K BYTES?
	BLOS	1$			;NO
	MOV	#20000,R0		;IF IT IS, JUST MAKE IT 8K BYTES
1$:	SUB	R1,R0			;SEE HOW MANY EXTRA POOL BYTES WE HAVE
	ADD	#FREESZ,R0		;COMPUTE TOTAL POOL SIZE
	BIC	#3,R0			;ASSURE IT'S IN DOUBLE-WORDS
	CLR	VSPOOL			;INITIALIZE POOL BLOCK LINK
	MOV	R0,VSPOOL+2		;SET ITS SIZE
	MOV	R0,SIZE			;STORE POOL SIZE
	MOV	R5,U.VCB(R5)		;SET UP BOGUS VOLUME CONTROL BLOCK,
	ADD	#U.VCB+2,U.VCB(R5)	; WHICH IS WORD AFTER U.VCB IN THE UCB
9$:	RETURN				;RETURN WHEN DONE
;
;	ENTER FUNCTION ROUTINES WITH THE FOLLOWING CONDITIONS:
;
;	R0 = REQUESTOR'S TCB ADDRESS
;	R1 = I/O PACKET ADDRESS
;	R2 = FUNCTION CODE TIMES 2
;	R3 = <FREE>
;	R4 = SCB ADDRESS
;	R5 = UCB ADDRESS
;	IOPKAD, IOFUNC, QUENAM, QUENAM+2 ARE SET UP
;
INITBL:	.WORD	VSDONZ			;IO.KIL IS NOT PASSED THROUGH
	.WORD	VSWLB			;IO.WLB
	.WORD	VSRLB			;IO.RLB
	.WORD	VSDONZ			;IO.ATT IS NO-OP'ED
	.WORD	VSDONZ			;IO.DET IS NO-OP'ED
	.WORD	VSCRQ			;IO.CRQ
	.WORD	VSDLQ			;IO.DLQ
	.WORD	VSCLN			;IO.CLN
	.WORD	VSDMP			;IO.DMP
	.WORD	VSAST			;IO.AST
	.WORD	VSEXM			;IO.EXM				;V2.04
	.WORD	VSDLM			;IO.DLM				;V2.04
;
;	VSDONZ -- DONE WITH A PACKET, ZERO BYTES TRANSFERRED
;	VSDON  -- DONE WITH A PACKET, TRANSFER COUNT IN R1
;	VSERR  -- ERROR WITH PACKET, STATUS AND COUNT SUPPLIED
;	VSERRZ -- ERROR WITH PACKET, STATUS SUPPLIED, ZERO COUNT
;
;	INITIAL CONDITIONS:
;		R5 = UCB ADDRESS
;
VSDONZ:	MOV	#IS.SUC,R0		;SHOW SUCCESSFUL COMPLETION
VSERRZ:	CALL	VSFINZ			;FINISH UP, ZERO BYTES TRANSFERRED
	BR	VSINI			;LOOP BACK TO GET NEXT PACKET
VSDON:	MOV	#IS.SUC,R0		;SHOW SUCCESSFUL COMPLETION
VSERR:	CALL	VSFIN			;FINISH IT UP
	BR	VSINI			;LOOP BACK TO INITIATOR ENTRY
;
;	VSFIN  -- FINISH PROCESSING AN I/O PACKET
;	VSFINZ -- FINISH PROCESSING AN I/O PACKET, ZERO BYTES TRANSFERRED
;
;	INITIAL CONDITIONS:
;		R0 = STATUS CODE
;		R1 = NUMBER OF BYTES TRANSFERRED
;		R5 = UCB ADDRESS
;
;	RESULTS:
;		R4 IS DESTROYED *AND* THE STACK IS NOT PRESERVED!
;
VSFIN:	CALLR	$IODON
VSFINZ:	CALLR	$IOALT
;
;	THE FOLLOWING ARE POSSIBLE STATUS RETURNS FROM THE DRIVER:
;
IS.SUC	= 1		;SUCCESSFUL COMPLETION
IE.ABO	= -15.		;OPERATION ABORTED
IE.PRI	= -16.		;PRIVILEGE VIOLATION
IE.QNF	= -101.		;QUEUE NOT FOUND
IE.QEX	= -102.		;QUEUE ALREADY EXISTS
IE.NMS	= -103.		;NO MORE SPACE IN VS: PRIVATE POOL
IE.RAW	= -104.		;READ ALREADY WAITING IN QUEUE
IE.NOM	= -105.		;NO MESSAGE AVAILABLE
IE.UBS	= -106.		;USER BUFFER IS TOO SMALL FOR DATA TRANSFER
IE.ATS	= -107.		;AST PREVIOUSLY SET FOR QUEUE
IE.ATC	= -108.		;NO AST PRESENTLY SET FOR QUEUE
	.PAGE
;
;	HERE IS THE STRUCTURE OF THE MESSAGE QUEUES:
;
;	FIRST, THERE IS A QUEUE-HEADER HEADER, WHICH LOOKS LIKE THIS:
;
;		----------------------------------
;		|  POINTER TO FIRST QUEUE HEADER |
;		----------------------------------
;		|  POINTER TO LAST QUEUE HEADER  |
;		----------------------------------
;
;	THIS HEADS A QUEUE OF QUEUE HEADERS, EACH OF WHICH LOOKS LIKE THIS:
;
;		----------------------------------
;		|  POINTER TO NEXT QUEUE HEADER  |
;		----------------------------------
;		|    POINTER TO FIRST MESSAGE    |
;		----------------------------------
;		|    POINTER TO LAST MESSAGE     |
;		----------------------------------
;		|				 |
;		-      RAD50 NAME OF QUEUE       -
;		|				 |
;		----------------------------------
;		|  ADDRESS OF READ WAIT PACKET   |
;		----------------------------------
;		|    TCB ADDRESS OF AST TASK     |
;		----------------------------------
;		|          AST ADDRESS           |
;		----------------------------------
;
;
;	A MESSAGE IN A QUEUE LOOKS LIKE THIS:
;
;		----------------------------------
;		|     POINTER TO NEXT MESSAGE    |
;		----------------------------------
;		|     MESSAGE LENGTH IN BYTES    |
;		----------------------------------
;		|                                |
;		-     RAD50 SENDER TASK NAME     -
;		|                                |
;		----------------------------------
;		|               .                |
;		-               .                -
;		|               .                |
;		-          MESSAGE TEXT          -
;		|               .                |
;		-               .                -
;		|               .                |
;		----------------------------------
;
;		MESSAGE TEXT MAY BE PADDED WITH 0 TO 3 BYTES OF EXTRA SPACE,
;		TO BRING THE ENTIRE MESSAGE TO A MULTIPLE OF 4 BYTES IN LENGTH
;
	.PAGE
;
;	FQHBQN -- FIND QUEUE HEADER BY QUEUE NAME
;
;	INITIAL CONDITIONS:
;		QUENAM, QUENAM+2 = RAD50 QUEUE NAME
;
;	RESULTS:
;		R0 = ADDRESS OF QUEUE HEADER (IF FOUND)
;		   = 0 (IF NOT FOUND)
;		Z STATUS CLEAR IF FOUND, SET IF NOT FOUND
;
FQHBQN:
	MOV	#QHDHD,R0		;GET QUEUE-HEADER HEADER ADDRESS
1$:	MOV	R0,PREVQH		;SAVE PREDECESSOR ADDRESS FOR UNLINK
	MOV	(R0),R0			;FOLLOW LINK TO NEXT HEADER
	BEQ	9$			;IF NULL, QUEUE NOT FOUND
	CMP	QUENAM,QH.QNM(R0)	;SEE IF FIRST WORDS MATCH
	BNE	1$			;IF NOT, FOLLOW LINK
	CMP	QUENAM+2,QH.QNM+2(R0)	;SEE IF SECOND WORDS MATCH
	BNE	1$			;IF NOT, FOLLOW LINK
9$:	TST	R0			;SET Z STATUS ACCORDING TO RESULT
	RETURN				;RETURN WHEN EQUAL, OR AT END OF QUEUE
;
;	ALOCAT -- ALLOCATE A PRIVATE POOL BLOCK
;
;	INITIAL CONDITIONS:
;		R1 = SIZE OF BLOCK TO ALLOCATE
;
;	RESULTS:
;		IF CY SET, ALLOCATION FAILED
;		IF CY CLEAR, R0 = ADDRESS, R1 = LENGTH OF BLOCK ALLOCATED
;
ALOCAT:
	MOV	#VSPHDR,R0		;GET PRIVATE POOL HEADER ADDRESS
	CALL	$ALOC1			;ALLOCATE
	RETURN				;RETURN
;
;	DEALOC -- DEALLOCATE A PRIVATE POOL BLOCK
;
;	INITIAL CONDITIONS:
;		R0 = ADDRESS OF BLOCK TO DEALLOCATE
;		R1 = LENGTH OF BLOCK TO DEALLOCATE
;
DEALOC:	MOV	#VSPHDR,R3		;GET PRIVATE POOL HEADER ADDRESS
	CALL	$DEAC1			;DEALLOCATE
	RETURN				;RETURN
;
;	GETMSG -- GET NEXT MESSAGE IN QUEUE
;
;	INITIAL CONDITIONS:
;		QUHDAD = ADDRESS OF QUEUE FROM WHICH TO GET MESSAGE
;
;	RESULTS:
;		R1 = ADDRESS OF MESSAGE IF ONE IS DEQUEUED
;		CY STATUS CLEAR IF MESSAGE DEQUEUED, SET IF NO MESSAGE FOUND
GETMSG:
	MOV	QUHDAD,R0		;GET ADDRESS OF QUEUE HEADER
	ASSUME	QH.FMS,2		;REQUIRED IF NEXT INSTRUCTION IS TO WORK!
	TST	(R0)+			;POINT TO MESSAGE QUEUE HEADER
	CALLR	$QRMVF			;REMOVE FROM QUEUE AND RETURN
;
;	FLUSHQ -- FLUSH QUEUE
;
;	INITIAL CONDITIONS:
;		QUHDAD = ADDRESS OF QUEUE TO FLUSH
;
;	RESULTS:
;		R0 AND R1 ARE DESTROYED
;		THE QUEUE IS FLUSHED OF ALL MESSAGES, AND A WAITING READ
;			PACKET IS ABORTED IF PRESENT.
;
FLUSHQ:
	CALL	GETMSG			;GET NEXT MESSAGE IN QUEUE
	BCS	9$			;IF CY, NO MORE MESSAGES
	MOV	R1,R0			;COPY MESSAGE ADDRESS
	MOV	MS.LEN(R0),R1		;GET LENGTH
	ADD	#MS.TXT,R1		;ADD OVERHEAD
	CALL	DEALOC			;DEALLOCATE THE BLOCK
	BR	FLUSHQ			;TRY IT AGAIN
9$:	MOV	QUHDAD,R0		;GET QUEUE HEADER ADDRESS
	TST	QH.RWP(R0)		;WAITING PACKET PRESENT?
	BEQ	8$			;NO, SKIP IT
	MOV	QH.RWP(R0),S.PKT(R4)	;SET PACKET ADDRESS INTO SCB
	MOV	#IE.ABO,R0		;SET ABORT STATUS
	CALL	VSFINZ			;KILL THE PACKET
8$:	RETURN				;AND RETURN
;
; *** THE ENTIRE FOLLOWING SECTION WAS INSERTED FOR V2.05
;
;	PUTWRD -- INTERNAL PUT WORD ROUTINE (REPLACES $PTWRD LOOP)
;
;	INITIAL CONDITIONS:
;		R0 = NUMBER OF WORDS TO TRANSFER
;		R1 = DRIVER VIRTUAL ADDRESS OF DATA TO BE TRANSFERRED
;		U.BUF,U.BUF+2 IN UCB CONTAIN BUFFER POINTER FROM $RELOC
;	RESULTS:
;		R0, R1, R2 DESTROYED
;		DATA HAS BEEN TRANSFERRED TO USER BUFFER
;		U.BUF,U.BUF+2 IN UCB HAVE BEEN UPDATED
;
PUTWRD:
	MOV	@#KISAR6,-(SP)		;SAVE CURRENT APR6 MAPPING
	MOV	U.BUF(R5),@#KISAR6	;MAP USER BUFFER
	MOV	U.BUF+2(R5),R2		;GET BUFFER VIRTUAL ADDRESS
1$:	MOV	(R1)+,(R2)+		;MOVE A WORD
	SOB	R0,1$			;LOOP FOR ENTIRE USER BUFFER
; (THIS WORKS BECAUSE U.BUF+2 IS INITIALLY BETWEEN 140000 AND 140076 OCTAL;
; WE WILL NEVER GET A REQUEST WITH >17700 (OCTAL) BYTES OF DATA -- WE CAN'T
; EVEN COME CLOSE, AS THERE IS NOT THAT MUCH POOL SPACE IN THE DRIVER!!!)
	MOV	(SP)+,@#KISAR6		;RESTORE ORIGINAL MAPPING
	MOV	R2,U.BUF+2(R5)		;UPDATE POINTER
	RETURN				;RETURN WHEN DONE
;
; *** THE ENTIRE PRECEDING SECTION WAS INSERTED FOR V2.05
;
;
;	VSCRQ -- CREATE A QUEUE
;
VSCRQ:
	CMP	#^RA  ,I.PRM+4(R1)	;WAS A QUEUE NAME SPECIFIED?
	BHI	11$			;NO, USE DEFAULT
	.IF	DF VS$PRV
	BIT	#T3.PRV,T.ST3(R0)	;IS REQUESTOR A PRIVILEGED TASK?
	BNE	10$			;IF SO, OK
	MOV	#IE.PRI,R0		;ELSE IT'S A PRIVILEGE VIOLATION
	JMP	VSERRZ			;SO EXIT
	.ENDC	;DF VS$PRV
10$:	MOV	I.PRM+4(R1),QUENAM	;COPY REQUESTED QUEUE NAME
	MOV	I.PRM+6(R1),QUENAM+2	;
11$:	CALL	FQHBQN			;FIND QUEUE HEADER BY QUEUE NAME
	BEQ	1$			;NOT FOUND--OK
	CMPB	#100,IOFUNC		;SF.FLU SET?
	BNE	3$			;IF NOT, ERROR			;V2.01
	TST	QH.AST(R0)		;AST SET?
	BEQ	31$			;IF NOT, PROCEED WITH FLUSH
	MOV	#IE.ATS,R0		;ELSE ERROR "AST IS SET"
	JMP	VSERRZ			;ERROR EXIT
31$:	MOV	R0,QUHDAD		;SAVE QUEUE HEADER ADDRESS
	CALL	FLUSHQ			;FLUSH IT
	JMP	VSDONZ			;DONE
3$:	MOV	#IE.QEX,R0		;SET ERROR CODE
	JMP	VSERRZ			;ERROR EXIT
1$:	MOV	#QHDSIZ,R1		;REQUEST A HEADER
	CALL	ALOCAT			;ALLOCATE IT
	BCC	2$			;GOT IT--OK
	MOV	#IE.NMS,R0		;NO MORE SPACE
	JMP	VSERRZ			;ERROR EXIT
2$:	MOV	R0,QUHDAD		;SAVE QUEUE HEADER ADDRESS
	CLR	(R0)+			;LINK IS NULL
	MOV	R0,R1			;SAVE LOCATION OF MESSAGE QUEUE HEADER
	CLR	(R0)+			;POINTER TO FIRST MESSAGE IS NULL
	MOV	R1,(R0)+		;END POINTER SHOWS EMPTY QUEUE
	MOV	QUENAM,(R0)+		;PUT IN THE QUEUE NAME
	MOV	QUENAM+2,(R0)+		;
	CLR	(R0)+			;NO READ WAIT PACKET
	CLR	(R0)+			;CLEAR AST TASK TCB ADDRESS
	CLR	(R0)+			;CLEAR AST ADDRESS
	MOV	#QHDHD,R0		;GET ADDRESS OF QUEUE-HEADER LISTHEAD
	MOV	QUHDAD,R1		;GET ADDRESS OF NEW HEADER
	CALL	$QINSF			;INSERT INTO QUEUE
	JMP	VSDONZ			;DONE
;
;	VSDLQ -- DELETE A QUEUE AND ANY QUEUED MESSAGES
;
VSDLQ:
	CMP	#^RA  ,I.PRM+4(R1)	;WAS A QUEUE NAME SPECIFIED?
	BHI	11$			;NO, USE DEFAULT
	.IF	DF VS$PRV
	BIT	#T3.PRV,T.ST3(R0)	;IS REQUESTOR A PRIVILEGED TASK?
	BNE	10$			;IF SO, OK
	MOV	#IE.PRI,R0		;ELSE IT'S A PRIVILEGE VIOLATION
	JMP	VSERRZ			;SO EXIT
	.ENDC	;DF VS$PRV
10$:	MOV	I.PRM+4(R1),QUENAM	;COPY REQUESTED QUEUE NAME
	MOV	I.PRM+6(R1),QUENAM+2	;
11$:	CALL	FQHBQN			;FIND QUEUE HEADER BY QUEUE NAME
	BNE	1$			;FOUND--OK
	MOV	#IE.QNF,R0		;QUEUE NOT FOUND
	JMP	VSERRZ			;ERROR EXIT
1$:	MOV	R0,QUHDAD		;SAVE QUEUE ADDRESS
	TST	QH.AST(R0)		;IS AST SET IN THIS QUEUE?
	BEQ	3$			;IF NOT, OK
	MOV	#IE.ATS,R0		;ELSE ERROR "AST IS SET"
	JMP	VSERRZ			;ERROR EXIT
3$:	MOV	(R0),@PREVQH		;COPY OUR LINK TO PREDECESSOR'S
	BNE	2$			;IF NON-NULL, UNLINK IS COMPLETE
	MOV	PREVQH,QHDHD+2		;ELSE PREDECESSOR IS NEW LAST ENTRY
2$:	CALL	FLUSHQ			;FLUSH THAT QUEUE!
	MOV	#QHDSIZ,R1		;PREPARE TO DEALLOCATE QUEUE HEADER
	MOV	QUHDAD,R0		;GET ITS ADDRESS
	CALL	DEALOC			;DEALLOCATE IT
	JMP	VSDONZ			;DONE
;
;	VSRLB -- READ (RECEIVE A MESSAGE)
;
VSRLB:
	CMP	#^RA  ,I.PRM+6(R1)	;WAS A QUEUE NAME SPECIFIED?
	BHI	11$			;NO, USE DEFAULT
	.IF	DF VS$PRV
	BIT	#T3.PRV,T.ST3(R0)	;IS REQUESTOR A PRIVILEGED TASK?
	BNE	10$			;IF SO, OK
	MOV	#IE.PRI,R0		;ELSE IT'S A PRIVILEGE VIOLATION
	JMP	VSERRZ			;SO EXIT
	.ENDC	;DF VS$PRV
10$:	MOV	I.PRM+6(R1),QUENAM	;COPY REQUESTED QUEUE NAME
	MOV	I.PRM+10(R1),QUENAM+2	;
11$:	CALL	FQHBQN			;FIND QUEUE HEADER BY QUEUE NAME
	BNE	1$			;GOT IT--OK
	MOV	#IE.QNF,R0		;QUEUE NOT FOUND
	JMP	VSERRZ			;ERROR EXIT
1$:	MOV	R0,QUHDAD		;SAVE QUEUE HEADER ADDRESS
	TSTB	IOFUNC			;WAIT SPECIFIED IN FUNCTION?
	BPL	4$			;NO, OK
	TST	QH.RWP(R0)		;ALREADY WAITING?
	BEQ	3$			;NO, OK
	CMP	IOPKAD,QH.RWP(R0)	;IS THIS THE PACKET THAT WAS WAITING?
	BNE	22$			;NO, IT'S ANOTHER ONE
	CLR	QH.RWP(R0)		;CLEAR WAITING PACKET ADDRESS
	BR	4$			;AND ALLOW THE READ TO PROCEED
22$:	MOV	#IE.RAW,R0		;SHOW QUEUE HAS READ ALREADY WAITING
	JMP	VSERRZ			;ERROR EXIT
3$:	TST	QH.AST(R0)		;IS AN AST SET FOR THIS QUEUE?
	BEQ	32$			;NO, IT'S OK
	MOV	#IE.ATS,R0		;ELSE ERROR "AST IS SET"
	JMP	VSERRZ			;ERROR EXIT
32$:	TST	QH.FMS(R0)		;IS A MESSAGE QUEUED ALREADY?
	BNE	4$			;IF IT IS, DON'T WAIT
	MOV	IOPKAD,QH.RWP(R0)	;ELSE SET READ WAIT PACKET ADDRESS
	BICB	#US.BSY,U.STS(R5)	;CLEAR UNIT BUSY
	CLRB	S.STS(R4)		;CLEAR CONTROLLER BUSY
	JMP	VSINI			;GET NEXT PACKET
4$:	MOV	QH.FMS(R0),R1		;GET ADDRESS OF FIRST MESSAGE	;V2.03
	BNE	5$			;Z CLEAR IF GOT ONE		;V2.03
	MOV	#IE.NOM,R0		;ELSE INDICATE NO MESSAGE AVAILABLE
	JMP	VSERRZ			;AND ERROR EXIT
5$:	MOV	R1,MSGADR		;SAVE MESSAGE ADDRESS
	MOV	MS.LEN(R1),MSGLEN	;GET LENGTH OF MESSAGE RECEIVED
	MOV	MSGLEN,R0		;GET LENGTH OF MESSAGE
	ADD	#4,R0			;ADD FOUR FOR SENDER TASK NAME
	CMP	R0,U.CNT(R5)		;COMPARE TO USER BUFFER SIZE
	BLOS	6$			;IF LE, USER BUFFER IS BIG ENOUGH
	MOV	#IE.UBS,R0		;ELSE USER BUFFER IS TOO SMALL
	JMP	VSERRZ			;SO ERROR EXIT
6$:	MOV	R0,TEMP			;SAVE TRANSFER COUNT
	CALL	GETMSG			;ACTUALLY GET IT NOW		;V2.03
	ADD	#MS.STN,R1		;POINT TO NAME OF SENDER TASK	;V2.03
	MOV	TEMP,R0			;GET TRANSFER COUNT AGAIN	;V2.03
	INC	R0			;INCREMENT TO ROUND UP
	ASR	R0			;GET WORD COUNT (>0 DUE TO TASK NAME)
	CALL	PUTWRD			;CALL INTERNAL PUT WORD ROUTINE	;V2.05
	MOV	MSGADR,R0		;GET MESSAGE ADDRESS AGAIN
	MOV	MSGLEN,R1		;GET LENGTH
	ADD	#MS.TXT,R1		;ADD OVERHEAD SIZE
	CALL	DEALOC			;DEALLOCATE THE MESSAGE BLOCK
	MOV	TEMP,R1			;GET TRANSFER COUNT
	JMP	VSDON			;DONE WITH THIS ONE
;
;	VSWLB -- WRITE (SEND MESSAGE)
;
VSWLB:
	CMP	#^RA  ,I.PRM+6(R1)	;WAS A QUEUE NAME SPECIFIED?
	BHI	11$			;NO, USE DEFAULT
	MOV	I.PRM+6(R1),QUENAM	;COPY REQUESTED QUEUE NAME
	MOV	I.PRM+10(R1),QUENAM+2	;
11$:	CALL	FQHBQN			;FIND QUEUE HEADER BY QUEUE NAME
	BNE	3$			;IF FOUND, OK
	MOV	#IE.QNF,R0		;QUEUE NOT FOUND
	JMP	VSERRZ			;ERROR EXIT
3$:	MOV	R0,QUHDAD		;SAVE QUEUE HEADER ADDRESS
	MOV	U.CNT(R5),R1		;GET MESSAGE LENGTH
	MOV	R1,MSGLEN		;SAVE IT
	ADD	#MS.TXT,R1		;DETERMINE REQUIRED STORAGE
	CALL	ALOCAT			;ALLOCATE IT
	BCC	5$			;IF IT SUCCEEDED, OK
	MOV	#IE.NMS,R0		;NO MORE SPACE
	JMP	VSERRZ			;ERROR EXIT
5$:	MOV	R0,MSGADR		;SAVE MESSAGE ADDRESS
	CLR	(R0)+			;CLEAR LINK TO NEXT MESSAGE
	MOV	MSGLEN,(R0)+		;SET MESSAGE LENGTH
	MOV	IOPKAD,R1		;GET PACKET ADDRESS
	MOV	I.TCB(R1),R1		;NOW GET REQUESTOR'S TCB ADDRESS
	MOV	T.NAM(R1),(R0)+		;MOVE SENDER TASK NAME INTO BLOCK
	MOV	T.NAM+2(R1),(R0)+	;
	MOV	MSGLEN,R1		;GET MESSAGE LENGTH
	INC	R1			;INCREMENT TO ROUND UP
	ASR	R1			;GET WORD COUNT
	BEQ	7$			;IF ZERO, SKIP TRANSFER
;
; *** THE ENTIRE FOLLOWING SECTION WAS INSERTED FOR V2.05
;     REPLACING A $GTWRD LOOP
;
	MOV	@#KISAR6,-(SP)		;SAVE CURRENT APR6 MAPPING
	MOV	U.BUF(R5),@#KISAR6	;MAP USER BUFFER
	MOV	U.BUF+2(R5),R2		;GET BUFFER VIRTUAL ADDRESS
6$:	MOV	(R2)+,(R0)+		;MOVE A WORD
	SOB	R1,6$			;LOOP FOR ENTIRE USER BUFFER
; (THIS WORKS BECAUSE U.BUF+2 IS INITIALLY BETWEEN 140000 AND 140076 OCTAL;
; WE WILL NEVER GET A REQUEST WITH >17700 (OCTAL) BYTES OF DATA -- WE CAN'T
; EVEN COME CLOSE, AS THERE IS NOT THAT MUCH POOL SPACE IN THE DRIVER!!!)
	MOV	(SP)+,@#KISAR6		;RESTORE ORIGINAL MAPPING
	MOV	R2,U.BUF+2(R5)		;UPDATE POINTER
;
; *** THE ENTIRE PRECEDING SECTION WAS INSERTED FOR V2.05
;
7$:	MOV	QUHDAD,R0		;GET RECEIVER QUEUE HEADER ADDRESS
	TST	(R0)+			;POINT TO MESSAGE QUEUE HEADER
	MOV	MSGADR,R1		;GET MESSAGE ADDRESS
	CALL	$QINSF			;STICK IT IN THE QUEUE
	TST	-(R0)			;GET BACK RECEIVER QUEUE HEADER ADDR
	TST	QH.AST(R0)		;AST SPECIFIED FOR THIS QUEUE?
	BEQ	77$			;IF NOT, SKIP AST CODE
	MOV	#<5+NUMPRM>*2,R1	;ALLOCATE AST BLOCK OF PROPER LENGTH
	CALL	$ALOCB			;(ALLOCATION FROM EXEC POOL)
	BCC	71$			;IF SUCCESSFUL, CONTINUE
	IOT				;CRASH THE SYSTEM (OUT OF POOL ANYWAY!)
71$:	MOV	QUHDAD,R2		;GET QUEUE HEADER ADDRESS
	MOV	R0,ASTADR		;SAVE AST BLOCK ADDRESS
	CLR	(R0)+			;CLEAR LINK
	MOV	R1,(R0)+		;STORE LENGTH OF AST BLOCK
	MOV	#<7+NUMPRM>*2,(R0)+	;STORE BYTES TO ALLOCATE ON STACK
	MOV	QH.AST(R2),(R0)+	;SET AST ADDRESS
	MOV	#NUMPRM,(R0)+		;SET NUMBER OF PARAMETERS
	MOV	QH.QNM(R2),(R0)+	;STORE FIRST WORD OF QUEUE NAME
	MOV	QH.QNM+2(R2),(R0)+	;STORE SECOND WORD OF QUEUE NAME
	MOV	MSGLEN,(R0)		;STORE MESSAGE LENGTH
	ADD	#4,(R0)			;ADD FOUR FOR SENDER TASK NAME SPACE
	MOV	QH.TCB(R2),R0		;GET TASK'S TCB ADDRESS
	MOV	ASTADR,R1		;GET AST BLOCK ADDRESS
	CALL	$QASTT			;QUEUE THE AST
	MOV	QUHDAD,R0		;GET THE QUEUE HEADER ADDRESS	;V2.02
77$:	TST	QH.RWP(R0)		;WAS THERE A PACKET WAITING ON READ?
	BNE	8$			;YES, HAVE TO PROCESS READ AS WELL
	MOV	MSGLEN,R1		;ELSE FINISH UP
	JMP	VSDON			;BY JUMPING OUT
8$:	MOV	QH.RWP(R0),IOPKAD	;GET READ-WAIT'S I/O PACKET ADDRESS
	MOV	#IS.SUC,R0		;INDICATE SUCCESS
	MOV	MSGLEN,R1		;GET LENGTH
	CALL	VSFIN			;FINISH OUR PACKET
	BISB	#US.BSY,U.STS(R5)	;SET UNIT BUSY
	MOV	U.SCB(R5),R4		;GET SCB ADDRESS
	INCB	S.STS(R4)		;SET CONTROLLER BUSY
	MOV	IOPKAD,R1		;GET PACKET ADDRESS
	MOV	R1,S.PKT(R4)		;SET NEW PACKET ADDRESS
	MOV	I.PRM(R1),U.BUF(R5)	;SET UP UCB FOR TRANSFERS
	MOV	I.PRM+2(R1),U.BUF+2(R5)	;
	MOV	I.PRM+4(R1),U.CNT(R5)	;
	JMP	VSPROC			;PROCESS THE OLD PACKET
;
;	VSCLN -- CLOSE LUN (CLEAN UP AST'S)
;
;	CLOSE LUN (CLEAN UP AST'S) IS INITIATED BY THE EXEC WHEN A TASK IS
;	EXITING, AND ONE OF THE TASK'S LUNS HAS A NONZERO SECOND LUN WORD.
;	VSDRV SETS THE SECOND LUN WORD NONZERO WHEN A TASK SETS AN AST, JUST
;	SO THAT THE EXEC WILL DO THIS.  THIS FUNCTION WILL THEN CLEAR *ALL*
;	AST'S SET BY THE TASK.  PRESUMABLY, IF A TASK WANTED TO CLEAR ALL
;	THE AST'S THAT IT SET, IT COULD DO THIS CALL ITSELF.  THAT DOESN'T
;	SAVE ANYTHING, THOUGH, SINCE ALL THE SECOND LUN WORDS THAT NEED TO
;	BE CLEARED WILL NOT BE AFFECTED.  (IF ONE LUN IS USED TO SET ALL AST'S,
;	AND THE SAME LUN IS USED TO CLEAR THEM ALL WITH THIS FUNCTION, THEN
;	THE EXEC WILL NOT BE FORCED TO DO THIS.)
;
VSCLN:
	CLR	@I.LN2(R1)		;CLEAR SECOND LUN WORD FOR THIS LUN
	MOV	#QHDHD,R3		;GET QUEUE HEADER HEADER ADDRESS
1$:	MOV	(R3),R3			;GET NEXT QUEUE HEADER ADDRESS
	BEQ	9$			;IF NO MORE, DONE
	CMP	QH.TCB(R3),R0		;AST SET BY THIS TASK IN THIS QUEUE?
	BNE	1$			;IF NOT, LOOP
	CLR	QH.TCB(R3)		;ELSE CLEAR THE AST TASK TCB ADDRESS
	CLR	QH.AST(R3)		;CLEAR THE AST ADDRESS TOO
	BR	1$			;AND LOOP
9$:	JMP	VSDONZ			;WHEN DONE, DONE
;
;	VSAST -- SET/CLEAR AST
;
;	THIS FUNCTION IS USED TO SET OR CLEAR AN AST FOR A PARTICULAR QUEUE.
;	ONLY THE TASK THAT SETS THE AST CAN CLEAR IT.  (THE EXEC DOES THIS
;	FOR THE TASK AT EXIT, IF NECESSARY, WITH IO.CLN; SEE ABOVE.)
;
VSAST:
	CMP	#^RA  ,I.PRM+4(R1)	;WAS A QUEUE NAME SPECIFIED?
	BHI	11$			;NO, USE DEFAULT
	.IF	DF VS$PRV
	BIT	#T3.PRV,T.ST3(R0)	;IS REQUESTOR A PRIVILEGED TASK?
	BNE	10$			;IF SO, OK
	MOV	#IE.PRI,R0		;ELSE IT'S A PRIVILEGE VIOLATION
	JMP	VSERRZ			;SO EXIT
	.ENDC	;DF VS$PRV
10$:	MOV	I.PRM+4(R1),QUENAM	;COPY REQUESTED QUEUE NAME
	MOV	I.PRM+6(R1),QUENAM+2	;
11$:	CALL	FQHBQN			;FIND QUEUE HEADER BY QUEUE NAME
	BNE	1$			;FOUND--OK
	MOV	#IE.QNF,R0		;QUEUE NOT FOUND
	JMP	VSERRZ			;ERROR EXIT
1$:	MOV	R0,QUHDAD		;SAVE QUEUE ADDRESS
	TST	QH.RWP(R0)		;IS THERE A READ WAITING IN THIS QUEUE?
	BEQ	2$			;IF NOT, OK
	MOV	#IE.RAW,R0		;ELSE ERROR "READ WAITING"
	JMP	VSERRZ			;ERROR EXIT
2$:	MOV	I.PRM+12(R1),R3		;GET AST ADDRESS; ARE WE CLEARING AST?
	BEQ	3$			;YES, CLEARING
	TST	QH.AST(R0)		;IF SETTING AST, SEE IF ONE ALREADY SET
	BEQ	22$			;NOT ALREADY SET; IT'S OK TO SET ONE
	MOV	#IE.ATS,R0		;ELSE ERROR "AST ALREADY SET"
	JMP	VSERRZ			;ERROR EXIT
22$:	MOV	I.TCB(R1),QH.TCB(R0)	;SET TCB ADDRESS OF AST TASK
	MOV	R3,QH.AST(R0)		;SET AST ADDRESS
	MOV	#2,@I.LN2(R1)		;SET SECOND LUN WORD NONZERO
	JMP	VSDONZ			;DONE
3$:	TST	QH.AST(R0)		;IF CLEARING AST, SEE IF ONE IS SET
	BNE	33$			;IF ONE SET, OK
	MOV	#IE.ATC,R0		;ELSE ERROR "NO AST SET"
	JMP	VSERRZ			;ERROR EXIT
33$:	CMP	I.TCB(R1),QH.TCB(R0)	;SAME TASK CLEARING AS SET IT?
	BEQ	35$			;YES, IT'S OK TO CLEAR
	MOV	#IE.ATS,R0		;ELSE ERROR "AST SET BY OTHER TASK"
	JMP	VSERRZ			;ERROR EXIT
35$:	CLR	QH.TCB(R0)		;CLEAR AST TASK TCB ADDRESS
	CLR	QH.AST(R0)		;CLEAR AST ADDRESS TOO
	JMP	VSDONZ			;DONE
;
;	VSCAN -- CANCEL I/O
;
;	CANCEL I/O DOES ONLY ONE THING:  IT KILLS ANY READ-WAIT PACKETS
;	THAT BELONG TO THE TASK DOING THE CANCEL.  NO QUEUES OR MESSAGES
;	ARE DELETED.
;
VSCAN:
	MOV	R1,TEMP			;SAVE TCB ADDRESS
	MOV	#QHDHD,R0		;GET ADDRESS OF QUEUE-HEADER LISTHEAD
1$:	MOV	(R0),R0			;FOLLOW LINK TO NEXT QUEUE HEADER
	BEQ	9$			;IF NULL, WE'RE DONE
	TST	QH.RWP(R0)		;ELSE SEE IF THIS QUEUE HAS A WAIT
	BEQ	1$			;IF NOT, SKIP THIS HEADER
	MOV	QH.RWP(R0),R1		;ELSE GET PACKET ADDRESS
	CMP	TEMP,I.TCB(R1)		;DOES IT BELONG TO THIS TASK?
	BNE	1$			;IF NOT, SKIP THIS HEADER
	CLR	QH.RWP(R0)		;ELSE WE WANT TO CLEAR THIS ONE
	MOV	R1,S.PKT(R4)		;SET PACKET ADDRESS INTO SCB
	MOV	R0,QUHDAD		;SAVE HEADER ADDRESS
	MOV	#IE.ABO,R0		;SET ABORT STATUS
	CALL	VSFINZ			;KILL THE PACKET
	MOV	QUHDAD,R0		;RESTORE QUEUE HEADER ADDRESS
	BR	1$			;LOOP FOR ALL THE REST
9$:	RETURN				;RETURN WHEN DONE
;
;	VSDMP -- DUMP DRIVER POOL SNAPSHOT
;
VSDMP:
	.IF	DF VS$PRV
	BIT	#T3.PRV,T.ST3(R0)	;IS REQUESTOR A PRIVILEGED TASK?
	BNE	10$			;IF SO, OK
	MOV	#IE.PRI,R0		;ELSE IT'S A PRIVILEGE VIOLATION
	JMP	VSERRZ			;SO EXIT
	.ENDC	;DF VS$PRV
10$:	MOV	#VSPOOL-HERE,R0		;GET SIZE OF SNAPSHOT
	ADD	SIZE,R0			;
	CMP	R0,U.CNT(R5)		;TASK BUFFER BIG ENOUGH?
	BLOS	1$			;YES, DUMP IT
	MOV	#IE.UBS,R0		;ELSE USER BUFFER TOO SMALL
	JMP	VSERRZ			;ERROR EXIT
1$:	MOV	R0,-(SP)		;SAVE COUNT FOR I/O STATUS BLK	;V2.05
	ASR	R0			;GET WORD COUNT
	MOV	#HERE,R1		;GET STARTING ADDRESS
	CALL	PUTWRD			;CALL INTERNAL PUT WORD ROUTINE	;V2.05
	MOV	(SP)+,R1		;RESTORE COUNT			;V2.05
	JMP	VSDON			;WHEN DONE, WE'RE REALLY DONE!
;
; *** THE ENTIRE FOLLOWING SECTION WAS INSERTED FOR V2.04
;
;	VSEXM -- EXAMINE SELECTED MESSAGE
;
VSEXM:
	CMP	#^RA  ,I.PRM+6(R1)	;WAS A QUEUE NAME SPECIFIED?
	BHI	11$			;NO, USE DEFAULT
	.IF	DF VS$PRV
	BIT	#T3.PRV,T.ST3(R0)	;IS REQUESTOR A PRIVILEGED TASK?
	BNE	10$			;IF SO, OK
	MOV	#IE.PRI,R0		;ELSE IT'S A PRIVILEGE VIOLATION
	JMP	VSERRZ			;SO EXIT
	.ENDC	;DF VS$PRV
10$:	MOV	I.PRM+6(R1),QUENAM	;COPY REQUESTED QUEUE NAME
	MOV	I.PRM+10(R1),QUENAM+2	;
11$:	CALL	FQHBQN			;FIND QUEUE HEADER BY QUEUE NAME
	BNE	1$			;GOT IT--OK
	MOV	#IE.QNF,R0		;QUEUE NOT FOUND
	JMP	VSERRZ			;ERROR EXIT
1$:	MOV	R0,QUHDAD		;SAVE QUEUE HEADER ADDRESS
	MOV	I.PRM+12(R1),R3		;GET REQUESTED MESSAGE ID
	BNE	12$			;IF NONZERO, NOT FIRST MESSAGE DEFAULT
	MOV	QH.FMS(R0),R3		;IF DEFAULT, SET TO FIRST MESSAGE
	ASSUME	QH.FMS,2		;MAKE SURE NEXT INSTRUCTION WORKS!
12$:	TST	(R0)+			;POINT TO FIRST MESSAGE ADDRESS
2$:	MOV	(R0),R0			;GET NEXT MESSAGE ADDRESS
	BEQ	3$			;IF ZERO, REACHED END -- NOT FOUND
	CMP	R0,R3			;COMPARE TO REQUESTED MESSAGE ID
	BNE	2$			;NOT THE ONE WE WANT -- KEEP LOOKING
	MOV	MS.LEN(R0),R3		;FOUND IT!  NOW GET MESSAGE LENGTH
	ADD	#MS.TXT+1,R3		;COMPUTE TOTAL SIZE AND ROUND UP ...
	BIC	#1,R3			;TO AN EVEN NUMBER
	CMP	R3,U.CNT(R5)		;COMPARE TO USER BUFFER SIZE
	BLOS	22$			;IF NOT > USER BUFFER, OK
	MOV	U.CNT(R5),R3		;ELSE USE USER BUFFER SIZE
22$:	MOV	R0,R1			;COPY POINTER			;V2.05
	MOV	R3,R0			;COPY COUNT			;V2.05
	ASR	R0			;AND TURN IT INTO WORD COUNT	;V2.05
	CALL	PUTWRD			;CALL INTERNAL PUT WORD ROUTINE	;V2.05
	MOV	R3,R1			;GET THE COUNT AGAIN		;V2.05
	JMP	VSDON			;AND FINISH UP
3$:	MOV	#IE.NOM,R0		;IF NOT FOUND, RETURN "NO MESSAGE" ERROR
	JMP	VSERRZ			;ERROR EXIT
;
;	VSDLM -- DELETE SELECTED MESSAGE
;
VSDLM:
	MOV	R0,TEMP			;SAVE TASK TCB ADDRESS
	CMP	#^RA  ,I.PRM+4(R1)	;WAS A QUEUE NAME SPECIFIED?
	BHI	11$			;NO, USE DEFAULT
	.IF	DF VS$PRV
	BIT	#T3.PRV,T.ST3(R0)	;IS REQUESTOR A PRIVILEGED TASK?
	BNE	10$			;IF SO, OK
	MOV	#IE.PRI,R0		;ELSE IT'S A PRIVILEGE VIOLATION
	JMP	VSERRZ			;SO EXIT
	.ENDC	;DF VS$PRV
10$:	MOV	I.PRM+4(R1),QUENAM	;COPY REQUESTED QUEUE NAME
	MOV	I.PRM+6(R1),QUENAM+2	;
11$:	CALL	FQHBQN			;FIND QUEUE HEADER BY QUEUE NAME
	BNE	1$			;FOUND--OK
	MOV	#IE.QNF,R0		;QUEUE NOT FOUND
	JMP	VSERRZ			;ERROR EXIT
1$:	MOV	R0,QUHDAD		;SAVE QUEUE ADDRESS
	MOV	I.PRM+10(R1),R3		;GET REQUESTED MESSAGE ID
	BNE	12$			;IF NOT ZERO, ISN'T DEFAULT TO FIRST
	MOV	QH.FMS(R0),R3		;ELSE GET FIRST MESSAGE ADDRESS
12$:	TST	QH.TCB(R0)		;DOES QUEUE HAVE AN AST?
	BEQ	14$			;IF NOT, OK
	CMP	TEMP,QH.TCB(R0)		;ELSE SEE IF SAME TASK AS THIS ONE
	BEQ	14$			;IF SO, OK
	MOV	#IE.ATS,R0		;INDICATE AST SET
	JMP	VSERRZ			;AND ERROR EXIT
	ASSUME	QH.FMS,2		;MAKE SURE NEXT INSTRUCTION WORKS!
14$:	TST	(R0)+			;POINT TO FIRST MESSAGE ADDRESS
2$:	MOV	R0,R2			;SAVE PREVIOUS ADDRESS
	MOV	(R0),R0			;GET NEXT ADDRESS
	BEQ	3$			;IF ZERO, NOT FOUND
	CMP	R0,R3			;ELSE SEE IF WE WANT THIS ONE
	BNE	2$			;NO, LOOKING FOR ANOTHER ONE
	MOV	(R0),(R2)		;GOT IT, NOW DELETE IT: CLOSE UP LIST
	BNE	22$			;IF NOT ZERO LINK, NO NEW END
	MOV	QUHDAD,R3		;NEW END:  GET QUEUE HEADER ADDRESS
	MOV	R2,QH.LMS(R3)		;STORE NEW END
22$:	MOV	MS.LEN(R0),R1		;GET MESSAGE TEXT LENGTH
	ADD	#MS.TXT,R1		;ADD LENGTH OF OVERHEAD STUFF
	CALL	DEALOC			;DEALLOCATE IT
	JMP	VSDONZ			;DONE!
3$:	MOV	#IE.NOM,R0		;NOT FOUND -- "NO SUCH MESSAGE"
	JMP	VSERRZ			;ERROR EXIT
;
; *** THE ENTIRE PRECEDING SECTION WAS INSERTED FOR V2.04
;
;
IOPKAD:	.BLKW	1			;CURRENT I/O PACKET ADDRESS
IOFUNC:	.BLKW	1			;CURRENT FUNCTION CODE
QUHDAD:	.BLKW	1			;CURRENT QUEUE HEADER ADDR
QUENAM:	.BLKW	2			;CURRENT QUEUE NAME (RAD50)
MSGADR:	.BLKW	1			;CURRENT MESSAGE BLOCK ADDRESS
MSGLEN:	.BLKW	1			;LENGTH OF CURRENT MESSAGE IN BYTES
ASTADR:	.BLKW	1			;AST BLOCK ADDRESS/ROUTINE ADDRESS
TEMP:	.BLKW	1			;TRANSFER COUNT AND OTHER TEMPORARIES
PREVQH:	.BLKW	1			;PREVIOUS QUEUE HEADER ADDRESS
SIZE:	.WORD	FREESZ			;TOTAL SIZE OF POOL
;
HERE:	.WORD	HERE			;A POINT OF REFERENCE FOR IO.DMP
QHDHD:	.WORD	0,QHDHD			;QUEUE-HEADER LISTHEAD
VSPHDR:	.WORD	3,VSPOOL,0		;PRIVATE POOL HEADER
VSPOOL:	.WORD	0,FREESZ		;SINGLE POOL BLOCK
	.BLKB	FREESZ-4		;REST OF POOL
VSBOT:					;LABEL JUST AFTER FIXED POOL SPACE
;
	.END