.TITLE	VSDRV -- MESSAGE DRIVER
	.IDENT	/052781/
;
;	RSX-11M V3.2 MESSAGE DRIVER
;
;	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.DLQ		(3000)	DELETE A MESSAGE QUEUE AND ALL QUEUED MESSAGES
;	IO.DMP		(3400)	DUMP A SNAPSHOT OF THE DRIVER'S PRIVATE POOL
;
;	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.
;	NON-PRIVILEGED TASKS ARE NOT ALLOWED TO CREATE, DELETE, OR READ QUEUES
;	OTHER THAN THE DEFAULT QUEUE.  ALL TASKS MAY SEND MESSAGES TO ANY
;	QUEUE.  (IF PRIVILEGE CHECKING IS DISABLED, ANY TASK CAN DO ANYTHING.)
;
;	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)
;	WORD 2 -- BUFFER LENGTH IN BYTES (WITH IO.WLB, IO.RLB, IO.DMP)
;	WORD 3 -- FIRST WORD OF RAD50 QUEUE NAME (WITH IO.WLB; FOR PRIVILEGED
;			TASKS, ALSO WITH IO.RLB, IO.CRQ, IO.DLQ)
;	WORD 4 -- SECOND WORD OF RAD50 QUEUE NAME (SAME FUNCTIONS AS WORD 3)
;	WORD 5 -- UNUSED
;	WORD 6 -- UNUSED
;
;	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.
;
	.MCALL	HWDDF$,PKTDF$,DCBDF$,UCBDF$,SCBDF$,TCBDF$,PCBDF$
	HWDDF$
	PKTDF$
	DCBDF$
	UCBDF$
	SCBDF$
	TCBDF$
	PCBDF$
;
LD$VS	==	1			;WE ARE LOADABLE
FREESZ	==	1980.			;PRIVATE POOL SIZE IN BYTES
;
;  NOTE:  DRIVER WILL EXPAND POOL TO END OF PARTITION WHEN LOADED
;
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
	CLR	VSPOOL			;INITIALIZE POOL BLOCK LINK
	MOV	R0,VSPOOL+2		;SET ITS SIZE
	MOV	R0,SIZE			;STORE POOL SIZE
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	VSDMP			;IO.DMP
;
;	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
;
;	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   |
;		----------------------------------
;		|     FLAGS     ||    (UNUSED)   |
;		----------------------------------
;
;		FLAGS ARE:	200 = WAITING ON READ
;
QH.LNK	= 0
QH.FMS	= 2
QH.LMS	= 4
QH.QNM	= 6
QH.RWP	= 12
QH.FLG	= 15
QHDSIZ	= 16
QF.WOR	= 200
;
;	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
;
MS.LNK	= 0
MS.LEN	= 2
MS.STN	= 4
MS.TXT	= 10
;
;	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
	TST	(R0)+			;POINT TO MESSAGE QUEUE HEADER
	CALLR	$QRMVF			;REMOVE FROM QUEUE AND RETURN
;
;	VSCRQ -- CREATE A QUEUE
;
VSCRQ:
	CMP	#3100,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
	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 UNUSED BYTE AND FLAGS BYTE
	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	#3100,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	(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	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	2$			;TRY IT AGAIN
9$:	MOV	QUHDAD,R0		;GET QUEUE HEADER ADDRESS
	BITB	#QF.WOR,QH.FLG(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$:	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	#3100,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
	BITB	#QF.WOR,QH.FLG(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
	BICB	#QF.WOR,QH.FLG(R0)	;ELSE CLEAR THE WAIT BIT
	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.FMS(R0)		;IS A MESSAGE QUEUED ALREADY?
	BNE	4$			;IF IT IS, DON'T WAIT
	BISB	#QF.WOR,QH.FLG(R0)	;ELSE MARK WAIT ON READ
	MOV	IOPKAD,QH.RWP(R0)	;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$:	CALL	GETMSG			;GET NEXT MESSAGE
	BCC	5$			;CY CLEAR IF GOT ONE
	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
	ADD	#MS.STN,R1		;POINT TO NAME OF SENDER TASK
	MOV	MSGLEN,R0		;GET LENGTH OF MESSAGE
	ADD	#4,R0			;ADD FOUR FOR SENDER TASK NAME
	CMP	R0,U.CNT(R5)		;COMPRE 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
	INC	R0			;INCREMENT TO ROUND UP
	ASR	R0			;GET WORD COUNT (>0 DUE TO TASK NAME)
7$:	MOV	(R1)+,-(SP)		;GET A WORD OF MESSAGE
	CALL	$PTWRD			;PUT INTO TASK'S BUFFER
	SOB	R0,7$			;LOOP FOR ENTIRE MESSAGE
	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	#3100,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
6$:	CALL	$GTWRD			;GET A WORD OF MESSAGE
	MOV	(SP)+,(R0)+		;STORE IT
	SOB	R1,6$			;LOOP FOR THE WHOLE MESSAGE
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
	BITB	#QF.WOR,QH.FLG(R0)	;WAS IT 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
;
;	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
	BITB	#QF.WOR,QH.FLG(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
	BICB	#QF.WOR,QH.FLG(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,R1			;SAVE COUNT FOR I/O STATUS BLOCK
	ASR	R0			;GET WORD COUNT
	MOV	#HERE,R2		;GET STARTING ADDRESS
2$:	MOV	(R2)+,-(SP)		;PUT A WORD ON THE STACK
	CALL	$PTWRD			;AND STICK IT IN THE USER BUFFER
	SOB	R0,2$			;LOOP FOR THE WHOLE THING
	JMP	VSDON			;WHEN DONE, WE'RE REALLY DONE!
;
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
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