	.TITLE	VPVDV - Virtual printer VIRTUAL DEVICE FRONT END
	.IDENT	/AP001/
;
; COPYRIGHT (C) 1979,1980 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
; MODULE DESCRIPTION
;
;	Printer VIRTUAL DEVICE FRONT END
;
; Derived from DECnet ivrtual device front end. Network parts
; removed to create a virtual printer that just creates disk files
; that are print images.
;
; Initial version will just put print lines on debug terminal.
;
; DISTRIBUTED SYSTEMS SOFTWARE ENGINEERING
;
; IDENT HISTORY:
;
; ap002 26-jan-86 hjj	blanks lines are being stripped, check for lines
;			with just lf,cr and pass them.
; ap001 24-jan-86 hjj	started.
;

	.SBTTL	MACRO CALLS AND LOCAL DEFINITIONS
;
; MACRO LIBRARY CALLS
;
	.MCALL	EXIT$S,DIR$,ASTX$S,ALUN$S,CLEF$,GTSK$S
	.MCALL	SETF$,QIOW$,CALLR,USTP$S,WSIG$S,SREA$
	.MCALL	OPNW$,CONW$,CONB$$,DSCW$,CLSW$,REC$,SND$,XMIW$
	.MCALL	SNDW$,RECW$,GNDW$,REJW$,CON$,SPAW$,NETDF$
	.MCALL	HDRDF$

	NETDF$				; DEFINE NETWORK SYMBOLS
	HDRDF$				; DEFINE TASK HEADER OFFSETS
;
; LOCAL MACROS
;
	.MACRO	CODE$			; GENERATE CODE PSECT
	.PSECT	CODE$	I,RO
	.ENDM	CODE$

	.MACRO	DATA$	P1		; GENERATE DATA PSECTS
	.IF IDN	<P1><PURE>
	.PSECT	DATA$P	D,RO
	.IFF
	.PSECT	DATA$I	D,RW
	.ENDC
	.ENDM	DATA$

	.MACRO	FUNC$	FUNCTN,ROUTIN	; GENERATE I/O FUNCTION DISPATCH ENTRY
	.WORD	FUNCTN/256.
	.WORD	ROUTIN
	.ENDM	FUNC$
;
; LUN AND EVENT FLAG DEFINITIONS
;
	.TTLUN=1			; TERMINAL LUN
	.MBXLU=2			; MAILBOX LUN
	.LLLUN=3			; LOGICAL LINK LUN

	.EXEFN=1			; TASK EXIT EVENT FLAG
	.TTEFN=2			; TERMINAL EVENT FLAG
	.NTEFN=3			; NETWORK I/O EVENT FLAG
	.SDEFN=4			; SNDW$ EVENT FLAG
	.RCEFN=5			; RECW$ EVENT FLAG

	.SBTTL	IMPURE STORAGE
;
; BUFFERS
;
	DATA$	IMPURE			; INPURE DATA

	RCVSIZ=20.			; SIZE OF RECEIVE BUFFER
RCVBUF:	.BLKB	RCVSIZ			; RECEIVE BUFFER
	GNDSIZ=98.			; SIZE OF GND BUFFER (ENOUGH FOR PEM)
GNDBUF:	.BLKB	GNDSIZ			; GND BUFFER
;
; STATUS BLOCKS
;
TTSTAT:	.BLKW	2			; TERMINAL I/O STATUS
NSSTAT:	.BLKW	2			; NETWORK I/O STATUS
SNDSTT:	.BLKW	2			; SEND STATUS
RCVSTT:	.BLKW	2			; RECEIVE STATUS
GNDSTT:	.BLKW	2			; GET NETWORK DATA STATUS

;
; MISC. STORAGE
;
CURIOP:	.WORD	0			; CURRENT I/O PACKET ADDRESS
KILFLG:	.WORD	0			; CURRENT REQUEST IS BEING KILLED
CURAPR:	.BLKW	1			; APR BIAS OF USER BUFFER
CURLEN:	.BLKW	1			; LENGTH OF REMAINING DATA TO BE XFERRED
TEXT:	.WORD	0			; TEXT STRING POINTER
USER:	.WORD	0			; USER'S TI: UCB ADDRESS
OWNER:	.BLKW	1			; OWNER OF VIRTUAL DEVICE
LOGNAM:	.BLKW	2			; LOGICAL NAME TO BE ASSIGNED
VDUCB:	.WORD	0			; UCB ADDRESS OF OUR VD:
DEVTYP:	.WORD	0			; REMOTE DEVICE TYPE


	.SBTTL	NETWORK DIRECTIVE DPB'S
;
; NETWORK DPB'S
;
	DATA$	IMPURE
OPN:	OPNW$	.MBXLU,.NTEFN,NSSTAT,,<1>
CON:	CONW$	.LLLUN,.NTEFN,NSSTAT,,<CONB,N.RQL>
REC:	REC$	.LLLUN,,RCVSTT
DSC:	DSCW$	.LLLUN,.NTEFN
CLS:	CLSW$	.MBXLU,.NTEFN
GND:	GNDW$	.MBXLU,.NTEFN,GNDSTT,,<GNDBUF,GNDSIZ>
REJ:	REJW$	.MBXLU,.NTEFN,,,<GNDBUF,GNDSIZ>
SPA:	SPAW$	.MBXLU,.NTEFN,,,<SPAAST>
SND:	SND$	.LLLUN,,SNDSTT
SNDW:	SNDW$	.LLLUN,.SDEFN,SNDSTT
RECW:	RECW$	.LLLUN,.RCEFN,RCVSTT
RECMSG:	RECW$	.LLLUN,.RCEFN,RCVSTT,,<RCVBUF,RCVSIZ>

;
; CONNECT BLOCK
;
CONB:	CONB$$	RPRINT,0,1,<RPRINT>


	.SBTTL	RSX DIRECTIVE DPB'S
;
; RSX DPB'S
;
	DATA$	IMPURE
CLEF:	CLEF$	.EXEFN			; CLEAR EXIT FLAG
SETF:	SETF$	.EXEFN			; SET EXIT FLAG
TIQIO:	QIOW$	IO.WBT,.TTLUN,.TTEFN,,,,<,,40> ; TI  MESSAGE OUTPUT
SREA:	SREA$	ABOAST			; TASK ABORT REQUEST AST
;
TTQIO:	QIOW$	IO.WLB,.TTLUN,.TTEFN,,TTSTAT,,<,,40> ; TI  MESSAGE OUTPUT

	.SBTTL	MESSAGES STRINGS
;
; TEXT STRINGS
;
	.ENABL	LC
	.NLIST	BEX
	DATA$	PURE
stamsg:	.asciz	<15>/VDV -- starting /
giomsg:	.asciz	<15>/VDV -- vducb not set /
aiomsg:	.asciz	<15>/VDV -- vp attached /
diomsg:	.asciz	<15>/VDV -- vp detached /
NSERR:	.ASCIZ	<15>/VDV -- Network not loaded/
OPNERR:	.ASCIZ	<15>/VDV -- Unable to open network/
CONER1:	.ASCIZ	<15>/VDV -- Unable to connect to remote server pem err/
CONER2:	.ASCIZ	<15>/VDV -- Unable to connect to remote server xcon err/
PROERR:	.ASCIZ	<15>/VDV -- Server synchronization error/
ABOERR:	.ASCIZ	<15>/VDV -- Task aborted by directive or MCR request/
	.EVEN
	DATA$	IMPURE
ABTERR:	.ASCII	<15>/VDV -- Link to server aborted /
abter1:	.ascii	/000000 /
abter2:	.asciz	/000000/
ATTMSG:	.ASCII	<15>/VDV -- Connected through /
ATTBUF:	.BLKB	7
DETMSG:	.ASCII	<15>/VDV -- Disconnected from /
DETBUF:	.BLKB	7
CONER3:	.ASCII	<15>/VDV -- Unable to connect to remote server nstat err/
erval1:	.blkb	6
	.byte	40
erval2:	.blkb	6
	.byte	0
NVDERR:	.ASCII	<15>/VDV -- Unable to allocate a virtual device of type "/
NVDBUF:	.ASCIZ	/??:"/
DEVERR:	.ASCII	<15>/VDV -- Unable to access remote device or file (/
DEVBUF:	.BLKB	6
	.EVEN
	.LIST	BEX

	.SBTTL	VDV MAIN LINE CODE
;+
; **-VDV-VIRTUAL DEVICE MAIN LINE CODE
;
; VDV IS INITIATED BY A USER REQUEST PEM. THE REQUEST BLOCK CONTAINS
; A TARGET NODE NAME AND DEVICE/FILE SPECIFICATION. THE REMOTE DEVICE/FILE
; IS ACCESSED, AND THE USER IS ALLOCATED A PSEUDO DEVICE OF THE PROPER
; TYPE AS A CHANNEL TO DIRECT I/O TO THE REMOTE DEVICE. ALL I/O PACKETS
; ARE PROCESSED UNTIL THE EXIT FLAG IS SET, THEN THE DEVICE IS DEALLOCATED,
; MARKED AS OFFLINE, AND THE TASK EXITS.
;
;-

	CODE$

VDV::
;
; INITIALIZE AND CONNECT
;
	CALL	OPEN			; OPEN THE NETWORK, AND PERFORM PREAMBLE
	BCS	EXIT			; IF CS, FATAL ERROR - EXIT
;
	DIR$	#SREA			; SPECIFY EXIT REQUEST AST
;
	mov	#STAMSG, r0
	call	print
;
	CALL	GETVD			; ALLOCATE A VD: UNIT
	BCS	EXIT			; IF CS, COULDN'T - TELL USER AND EXIT
	DIR$	#CLEF			; CLEAR THE EXIT INDICATOR
;
; PROCESS AN I/O PACKET
;
;
	tst	vducb
	bne	10$
	mov	#GIOMSG, r0
	call	print
	br	exit
;

10$:	CALL	GETIOP			; TRY TO GET AN I/O PACKET
	BCS	EXIT			; IF CS, EXIT TASK
	CALL	PRIOP			; PROCESS THE I/O
	BCS	EXIT			; IF CS, FATAL ERROR
	BR	10$			; ELSE, TRY TO GET MORE WORK

	.SBTTL	ABOAST - ABORT REQUESTED AST
;+
; **-ABOAST-ABORT REQUESTED AST
;
; THIS ROUTINE SETS THE EXIT FLAG, AND UNSTOPS THE TASK.
;
;-

ABOAST:
	mov	r0, -(sp)
	MOV	#ABOERR,r0		; SET ERROR MESSAGE TEXT
	call	print
	call	abort
	mov	(sp)+, r0
	ASTX$S


	.SBTTL	EXIT - CLEAN UP AND EXIT
;+
; **-EXIT-EXIT VDV PROCESSING
;-

EXIT:
	DIR$	#DSC			; DISCONNECT THE LINK (IF THERE IS ONE)
	DIR$	#CLS			; CLOSE OUR MAILBOX (IF OPEN)

	MOV	TEXT,R0			; GET TEXT STRING TO PRINT
	BEQ	20$			; IF EQ, NOTHING TO PRINT
	CALL	PRINT			; ELSE, PRINT IT

20$:	TST	VDUCB			; DID WE ALLOCATE A VD: ?
	BEQ	40$			; IF EQ, NO - NO NEED TO PRINT MESSAGE
	MOV	#ATTBUF,R0		; ELSE, POINT TO START OF FORMATTED NAME
	MOV	#DETBUF,R1		; POINT TO BUFFER IN DETACH MESSAGE
30$:	MOVB	(R0)+,(R1)+		; COPY DEVICE NAME
	BNE	30$			; ...
	MOV	#DETMSG,R0		; POINT TO MESSAGE
	CALL	PRINT			; TELL USER ABOUT IT
	CLR	VDUCB			; INDICATE NO UNIT ALLOCATED

40$:	CLR	USER			; CLEAR USER'S TI: UCB ADDRESS
	EXIT$S				; BYE-BYE !

	.SBTTL	PRINT - PRINT AN ASCIZ STRING
;+
; **-PRINT-PRINT AN ASCIZ STRING ON TI:
;
; INPUTS:
;	R0 = ADDRESS OF ASCIZ STRING
;
; OUTPUTS:
;	STRING PRINTED
;	R0 IS MODIFIED
;-

PRINT:
	MOV	R0,TIQIO+Q.IOPL		; SET STRING ADDRESS
10$:	TSTB	(R0)+			; LOOK FOR END OF STRING
	BNE	10$			; ...
	SUB	TIQIO+Q.IOPL,R0		; CALC STRING LENGTH
	MOV	R0,TIQIO+Q.IOPL+2	; SET STRING LENGTH
	DIR$	#TIQIO			; PRINT IT OUT
	RETURN

	.SBTTL	OPEN - ACCESS remote process
;+
; **-OPEN-Open network and connect to remote process
;-

OPEN:
;
; ASSIGN LUNS AND OPEN MAILBOX
;
	MOV	#NSERR,TEXT		; ASSUME NETWORK NOT LOADED
	ALUN$S	#.MBXLU,#"NS		; ASSIGN MAILBOX LUN
	BCS	90$			; IF CS, COULDN'T - EXIT
	ALUN$S	#.LLLUN,#"NS		; ASSIGN LOGICAL LINK LUN
	BCS	90$			; IF CS, COULDN'T - EXIT
	MOV	#OPNERR,TEXT		; ASSUME OPEN ERROR
	DIR$	#OPN			; OPEN THE NET
	BCS	90$			; IF CS, EXIT
	TSTB	NSSTAT			; SUCCESS ?
	BMI	90$			; IF MI, NO
	DIR$	#SPA			; SET UP OUR NETWORK DATA AST
	BCC	100$			; IF CC, OK

90$:	SEC				; INDICATE ERROR
100$:	RETURN				; AND OUT

	.SBTTL	SPAAST - NETWORK DATA AST ROUTINE
;+
; **-SPAAST-NETWORK DATA AST SERVICE ROUTINE
;
; THIS ROUTINE IS CALLED TO PROCESS NETWORK DATA.
;
;-

SPAAST:
10$:	DIR$	#GND			; GET NETWORK DATA
	CMPB	#IE.NDA,GNDSTT		; WAS THERE ANY DATA?
	BEQ	100$			; IF EQ, NO - ALL DONE
	MOVB	GNDSTT+1,R5		; ELSE, GET DATA TYPE
	ASL	R5			; CONVERT TO WORD OFFSET
	CALL	@GNDTAB-2(R5)		; DISPATCH TO CORRECT ROUTINE
	BR	10$			; LOOK FOR MORE DATA
100$:	ASTX$S				; EXIT THE AST
	RETURN				; OR RETURN IF CALLED

;
; NETWORK DATA DISPATCH TABLE
;
GNDTAB:	.WORD	GNDCON			; CONNECT REQUEST
	.WORD	GNDINT			; INTERRUPT MESSAGE
	.WORD	GNDDSC			; DISCONNECTS
	.WORD	GNDDSC			;  3 FLAVORS
	.WORD	GNDDSC			;   ..

	.SBTTL	GNDCON - PROCESS CONNECT REQUEST
	.SBTTL	GNDINT - PROCESS INTERRUPT MESSAGE
	.SBTTL	GNDDSC - PROCESS DISCONNECT
;+
; **-GNDCON-PROCESS CONNECT REQUEST
;
; ALL INCOMING CONNECTS ARE REJECTED
;
;-

GNDCON:
	DIR$	#REJ			; REJECT THE CONNECT
	RETURN

;+
; **-GNDINT-PROCESS INTERRUPT MESSAGE
;
; ALL INCOMING INTERRUPT MESSAGES ARE IGNORED
;
;-

GNDINT:
	RETURN				; TOSS IT


;+
; **-GNDDSC-PROCESS DISCONNECT
;
; THE TASK IS UNSTOPPED, AND THE EXIT FLAG IS SET FOR DISCONNECTS
;
;-

GNDDSC:
	mov	r2, -(sp)
	mov	r1, -(sp)
	mov	r0, -(sp)

	mov	#abter1, r0
	mov	GNDSTT, r1		; get iosb 0
	mov	#1, r2			; dont suppress zero's
	call	$cbomg			; convert
	mov	#abter2, r0
	mov	GNDSTT+2, r1		; get iosb 1
	call	$cbomg			; convert

	mov	(sp)+, r0
	mov	(sp)+, r1
	mov	(sp)+, r2

	MOV	#ABTERR,TEXT		; SET LINK ABORTED ERROR MESSAGE
ABORT:	GTSK$S	#GNDBUF			; GET TASK PARAMETERS (NAME)
	USTP$S  #GNDBUF			; UNSTOP OURSELF
	DIR$	#SETF			; SET THE EXIT FLAG
	RETURN

;
;	.SBTTL	GETVD - GET A VIRTUAL DEVICE OF THE CORRECT TYPE
;;+
;; **-GETVD-GET A VIRTUAL DEVICE OF THE CORRECT TYPE
;;
;; THIS ROUTINE IS CALLED AFTER A DEVICE CHARACTERISTICS MESSAGE IS RECEIVED
;; TO ALLOCATE AND INITIALIZE THE DATA STRUCTURES FOR A VIRTUAL DEVICE.
;;
;;-
;
GETVD:
	MOV	#NVDERR,TEXT		; ASSUME ERROR = "NO DEVICE"

20$:	MOVb	#'V,NVDBUF		; SAVE DEVICE TYPE FOR POSSIBLE ERROR
	MOVb	#'P,NVDBUF+1		; SAVE DEVICE TYPE FOR POSSIBLE ERROR

	SWSTK$	90$			;; ENTER SYSTEM STATE
	MOV	$DEVHD,R1		;; POINT TO FIRST DEVICE DCB
30$:	CMP	D.NAM(R1),#"VP		;; IS THIS THE CORRECT DCB ?
	BEQ	40$			;; IF EQ, YES - TRY TO FIND A UNIT
35$:	MOV	(R1),R1			;; ELSE, KEEP LOOKING
	BNE	30$			;; IF NE, MORE DCB'S
	MOV	@$HEADR,R0		;; ELSE, GET SAVED SP
	INC	6(R0)			;; SET USER C-BIT
	BR	80$			;; AND RETURN

40$:	MOVB	D.UNIT+1(R1),R2		;; GET HIGH UNIT NUMBER
	MOVB	D.UNIT(R1),R3		;; AND LOW UNIT NUMBER
	SUB	R3,R2			;; CALC NUMBER OF UCB'S ON THIS DCB
	MOV	D.UCB(R1),R3		;; POINT TO FIRST UCB
45$:	TST	U.VDV(R3)		;; IS THIS UNIT ALLOCATED ?
	BEQ	60$			;; IF EQ, NO - USE IT
	ADD	D.UCBL(R1),R3		;; ELSE, POINT TO NEXT UCB
	DEC	R2			;; IS THERE ANOTHER UNIT TO CHECK ?
	BGE	45$			;; IF GE, YES
	BR	35$			;; ELSE, LOOK FOR ANOTHER DCB
60$:	CLR	TEXT			;; CLEAR OUT ERROR TEXT POINTER
	MOV	$TKTCB,U.VDV(R3)	;; ALLOCATE THE DEVICE
	MOV	OWNER,U.USR(R3)		;; SET THE OWNER
;==	MOV	OWNER,U.OWN(R3)		;; ALLOCATE DEVICE (IF NOT GLOBAL)
	clr	U.OWN(R3)		;; GLOBAL device
	MOV	#KILAST,U.AST(R3)	;; SET THE I/O KILL AST ADDRESS
	BICB	#US.OFL,U.ST2(R3)	;; MARK UNIT AS ONLINE
	MOV	#0, U.CW2(R3)		;; SET NUMBER OF BLOCKS
	MOV	#0, U.CW3(R3)		;; ...
	MOV	#80., U.CW4(R3)		;; AND BUFFER SIZE
	MOV	R3,VDUCB		;; SAVE THE UCB ADDRESS
	MOV	#ATTBUF,R0		;; POINT TO BUFFER FOR FORMATTED NAME
	MOVB	D.NAM(R1),(R0)+		;; SET IN DEVICE NAME
	MOVB	D.NAM+1(R1),(R0)+	;; ...
	MOVB	D.UNIT+1(R1),R1		;; GET THE HI UNIT FOR THIS DCB
	SUB	R2,R1			;; CALC THIS UNIT'S RELATIVE NUMBER
	BIC	#177400,R1		;; DON'T SIGN-EXTEND
	CLR	R2			;; ZERO SUPPRESS
	CALL	$CBOMG			;; CONVERT TO ASCII
	MOVB	#':,(R0)+		;; PUT IN TERMINATOR
	CLRB	(R0)			;; MAKE ASCIZ
80$:	RETURN				;; BACK TO USER STATE

90$:
	BCS	100$			; IF CS, RETURN WITH ERROR
	MOV	#ATTMSG,R0		; ELSE, SET UP "DEVICE ATTACHED" MESSAGE
	CALL	PRINT			; TELL THE USER ABOUT IT
100$:	RETURN


	.SBTTL	GETIOP - GET AN I/O PACKET
;+
; **-GETIOP-GET AN I/O PACKET
;
; THIS ROUTINE GETS THE NEXT I/O PACKET FOR ALLOCATE VIRTUAL DEVICE OR STOPS.
;
;-

GETIOP:
	SWSTK$	50$			;; ENTER SYSTEM STATE
;
; CHECK IF TASK IS EXITING
;
10$:	MOV	$TKTCB,R0		;; GET OUR TCB ADDRESS
	BIT	#1,T.EFLG(R0)		;; IS THE EXIT FLAG SET ?
	BEQ	30$			;; IF EQ, NO - LOOK FOR A PACKET
;
; TASK IS EXITING - FINISH ALL I/O WITH IE.OFL STATUS, AND MARK UNIT AS OFFLINE.
;
	MOV	@$HEADR,R1		;; ELSE, GET SAVED SP
	INC	6(R1)			;; SET USER C-BIT
20$:	MOV	VDUCB,R5		;; GET VD UCB ADDRESS
	BISB	#US.OFL,U.ST2(R5)	;; SET UNIT AS OFFLINE
	CLR	U.VDV(R5)		;; INDICATE NO OWNING TASK
	CLR	U.USR(R5)		;; OR USER
	CLR	U.OWN(R5)		;; AND DEVICE NOT ALLOCATED
	CALL	60$			;; TRY TO GET A PACKET
	BCS	40$			;; IF CS, COULDN'T - RETURN
	MOV	#IE.OFL&377,R0		;; ELSE, SET OFFLINE STATUS
	CLR	R1			;; ...
	CALL	$IOFIN			;; AND COMPLETE I/O
	BR	20$			;; DO TILL NO MORE PACKETS
;
; TASK IS NOT EXITING, TRY TO GET A PACKET. IF NO PACKET, STOP THE TASK.
;
30$:	CALL	60$			;; TRY TO GET A REQUEST
	BCC	40$			;; IF CC, GOT ONE - RETURN
	CALLR	$STPCT			;; ELSE, STOP OURSELF

40$:	RETURN				;; BACK TO USER STATE

50$:	BCS	40$			; IF CS, RETURN TO CALLER
	TST	CURIOP			; ELSE, DO WE HAVE WORK YET ?
	BNE	40$			; IF NE, YES - DO IT
	BR	GETIOP			; ELSE, NO - LOOK AGAIN

;
; LOCAL SUBROUTINE TO FIND A PACKET
;

60$:	MOV	$TKTCB,R0		;; POINT TO OUT TCB ADDRESS
	ADD	#T.RCVL,R0		;; POINT TO THE RECEIVE LISTHEAD
	MOV	(R0),R3			;; GET THE NEXT PACKET ADDRESS
	SEC				;; ASSUME NO PACKET
	BEQ	80$			;; IF EQ, NO WORK
	MOV	(R3),(R0)		;; UNLINK PACKET FROM LIST
	BNE	70$			;; IF NE, MORE IN LIST
	MOV	R0,2(R0)		;; ELSE, CLOSE UP LIST

70$:
	CLR	KILFLG			;; INDICATE KILL NOT ACTIVE
					;; ... AND CLEAR C-BIT
80$:	MOV	R3,CURIOP		;; SAVE PACKET ADDRESS
	RETURN				;; RETURN TO CALLER


	.SBTTL	KILAST - I/O KILL AST ROUTINE
;+
; **-KILAST-I/O KILL AST ROUTINE
;
; THIS ROUTINE IS CALLED WHEN THE DRIVER IS CALLED AT IT'S
; CANCEL I/O ENTRY POINT, AND QUEUES AN AST.
;
; INPUTS:
;	(SP) = ADDRESS OF TCB OF TASK WHOSE I/O IS TO BE KILLED
;
;
;-
 
KILAST:
	MOV	R5,-(SP)		; SAVE R5
	MOV	2(SP),R5		; GET TCB ADDRESS
 
	SWSTK$	50$			;; ENTER SYSTEM STATE
10$:	MOV	$TKTCB,R4		;; GET OUR TCB ADDRESS
	ADD	#T.RCVL,R4		;; POINT TO OUR RECEIVE QUEUE
20$:	MOV	(R4),R3			;; POINT TO THE NEXT I/O PACKET
	BEQ	40$			;; IF EQ, ALL THROUGH
	CMP	R5,I.TCB(R3)		;; IS THIS PACKET FROM THAT TASK ?
	BEQ	30$			;; IF EQ, YES - KILL THE I/O
	MOV	R3,R4			;; ELSE, SET UP TO LOOK AT NEXT
	BR	20$			;; AND CONTINUE
 
30$:	MOV	(R3),(R4)		;; UNLINK THE PACKET FROM THE QUEUE
	BNE	35$			;; IF NE, NOT LAST PACKET
	MOV	$TKTCB,R2		;; ELSE, POINT TO OUR TCB
	MOV	R4,T.RCVL+2(R2)		;; AND CLOSE LIST
35$:	MOV	#IE.ABO&377,R0		;; SET ABORT ERROR CODE
	CLR	R1			;; INDICATE 0 BYTES TRANSFERRED
	CALL	$IOFIN			;; COMPLETE THE I/O
	BR	10$			;; AND LOOK FOR MORE
 
40$:	RETURN				;; BACK TO USER STATE
50$: 
100$:	MOV	(SP)+,R5		; RESTORE R5
	TST	(SP)+			; CLEAN TCB ADDRESS OFF STACK
	ASTX$S				; AND EXIT THE AST

	.SBTTL	PRIOP - PROCESS AN I/O PACKET
;+
; **-PRIOP-PROCESS AN I/O PACKET
;
; THIS ROUTINE DISPATCHES TO THE APPROPIATE I/O ROUTINE, AND
; POSTS COMPLETION ON THE PACKET.
;
;-

PRIOP:
	MOV	CURIOP,R3		; GET THE PACKET ADDRESS
	MOVB	I.FCN+1(R3),R0		; GET THE FUNCTION CODE
	MOV	#FCNTBL,R1		; POINT TO THE DISPATCH TABLE
10$:	CMP	R0,(R1)+		; IS THIS THE CORRECT ROUTINE ?
	BEQ	20$			; IF EQ, YES - CALL IT
	TST	-2(R1)			; AT END OF TABLE ?
	BEQ	20$			; IF EQ, YES - CALL IT ILLEGAL FUNCTION
	TST	(R1)+			; ELSE, SKIP OVER ROUTINE ADDRESS
	BR	10$			; AND KEEP LOOKING

20$:	CALL	@(R1)			; DISPATCH TO CORRECT ROUTINE

	SWSTK$	30$			;; ENTER SYSTEM STATE
	CALLR	$IOFIN			;; FINISH OFF THE I/O
30$:	RETURN				; AND RETURN

;
; I/O FUNCTION DISPATCH TABLE
;
FCNTBL:
	FUNC$	IO.ATT,ATTACH		; attach
	FUNC$	IO.DET,DETACH		; DETACH
	FUNC$	IO.WLB,WRITE		; WRITE LOGICAL BLOCK
	FUNC$	0,ILEGAL		; END OF TABLE

	.SBTTL	ILEGAL - PROCESS AN ILLEGAL FUNCTION CODE
;+
; **-ILEGAL-PROCESS AN ILLEGAL FUNCTION CODE
;
; THIS ROUTINE RETURNS I/O STATUS OF IE.IFC
;
; INPUTS:
;	R3 = I/O PACKET ADDRESS
;
; OUTPUTS:
;	R0 = 1ST I/O STATUS WORD
;	R1 = 2ND I/O STATUS WORD
;	R3 = I/O PACKET ADDRESS
;-

ILEGAL:
	MOV	#IE.IFC&377,R0		; SET STATUS RETURN
	CLR	R1			; ...
	RETURN

	.SBTTL	ATTACH/DETACH - PROCESS attach, detach
;+
; **-ATTACH/DETACH - PROCESS attach, detach
;
; THIS ROUTINE RETURNS I/O STATUS OF IS.SUC
;
; INPUTS:
;	R3 = I/O PACKET ADDRESS
;
; OUTPUTS:
;	R0 = 1ST I/O STATUS WORD
;	R1 = 2ND I/O STATUS WORD
;	R3 = I/O PACKET ADDRESS
;-


ATTACH:
	mov	#aiomsg, r0
	call	print

	mov	r2, -(sp)
	mov	r3, -(sp)
	mov	r4, -(sp)
	mov	r5, -(sp)
	call	connect
	mov	(sp)+, r5
	mov	(sp)+, r4
	mov	(sp)+, r3
	mov	(sp)+, r2

	MOV	#IS.SUC&377,R0		; assume success
	bcc	10$			; C set means failed
	mov	#IE.OFL&377, r0
10$:
	CLR	R1			; ...
	RETURN


detach:
	DIR$	#DSC			; DISCONNECT from SERVER

	mov	#diomsg, r0
	call	print
	
	MOV	#IS.SUC&377,R0		; SET STATUS RETURN
	CLR	R1			; ...
	RETURN

;+
; **-Connect - connect to remote
;
; 
;-

connect:
	MOV	#CONER2,TEXT		; ASSUME CONNECT ERROR
	DIR$	#CON			; ATTEMPT CONNECT TO SERVER
	BCS	20$			; IF CS, COULDN'T
	MOV	#CONER3,TEXT		; ASSUME CONNECT ERROR
	TSTB	NSSTAT			; SUCCESS ?
	BPL	30$			; IF PL, yes

	mov	#erval1, r0
	mov	nsstat, r1
	mov	#1, r2
	call	$cbomg
	mov	#erval2, r0
	mov	nsstat+2, r1
	mov	#1, r2
	call	$cbomg
20$:
	mov	text, r0
	call	print
	sec			; say error

30$:	return	



	.SBTTL	WRITE - PROCESS WRITE REQUESTS
;+
; **-WRITE-PROCESS WRITE REQUEST
;
; THIS ROUTINE TRANSMITS A REQUEST MESSAGE, FOLLOWED BY AS
; MANY DATA MESSAGES AS REQUIRED TO COMPLETE THE DATA
;
; INPUTS:
;	R3 = I/O PACKET ADDRESS
;
; OUTPUTS:
;	R0 = 1ST I/O STATUS WORD
;	R1 = 2ND I/O STATUS WORD
;	R3 = I/O PACKET ADDRESS
;-

WRITE:
	MOV	I.PRM(R3),CURAPR	; SAVE USER BUFFER APR BIAS
	MOV	I.PRM+4(R3),CURLEN	; SET LENGTH OF WRITE

	MOV	I.PRM+2(R3),SNDW+Q.IOPL		; SET VIRTUAL BUFFER ADDRESS
	MOV	I.PRM+4(R3), SNDW+Q.IOPL+2	; SET XMIT LENGTH
;	mov	I.PRM+6(R3), SNDW+Q.IOPL+4	; set vfc
;
	MTPS	#PR7			;;; LOCK OUT INTERRUPTS
	MOV	CURAPR,UISAR6		;;; MAP TO USER'S BUFFER
	MOV	#77406,UISDR6		;;; SET 4K R/W ACCESS
;
; fix veritical formatting. If record begins with <lf> and ends
; with <cr>, strip both, unless lf/cr is only data in record.
;
	mov	I.PRM+2(r3), r0		;;; point to buffer
	cmpb	#12, (r0)		;;; start with lf ??
	bne	40$			;;; no, don't change
	add	I.PRM+4(r3), r0		;;; point to past end of line
	cmpb	#15, -1(r0)		;;; end with cr ??
	bne	40$			;;; no, ok
	cmp	#2, I.PRM+4(r3)		;;; only lf/cr in line ?
	beq	40$			;;; yes, pass

	inc	SNDW+Q.IOPL		;;; bump past lf
	sub	#2, SNDW+Q.IOPL+2	;;; cut length by 2
40$:
	DIR$	#SNDW			;;; send to partner
	BCC	90$			; IF CC, OKAY
	CMPB	$DSW,#IE.UPN		; WAS ERROR "NO RESOURCES" ?
	SEC				; ASSUME NO, INDICATE ERROR
	BNE	100$			; IF NE, NO - RETURN WITH ERROR
	WSIG$S				; ELSE, WAIT A WHILE
	BR	40$			; AND TRY AGAIN

90$:
	MOV	#IS.SUC&377,R0		; say successful
	MOV	I.PRM+4(R3),R1		; say whole buffer sent
	
100$:	RETURN

	.END	VDV

