;Last Modified:   6-SEP-1988 14:19:55.00, By: RLB 

		.TITLE	WATCH - Watch terminal output stream
		.LIBRARY	/SYS$LIBRARY:LIB/
		.LINK		'SYS$SYSTEM:SYS.STB'/SELECTIVE_SEARCH
		$CCBDEF				; Channel control block offsets
		$IPLDEF				; Define IPL levels
		$TTYDEF				; Define term driver structures
		$TTYDEFS			;  ditto
		$TTYMDMDEF			; Define modem control signals
		$TTYVECDEF			; Define port/class vectors
		$TT2DEF				; Define terminal chars
		$SSDEF				; Define system service returns
		$DVIDEF				; GETDVI definitions
		$DYNDEF				; Dynamic memory struct types
		$FKBDEF				; Define fork block

		.PSECT	$DATA	RD, WRT, NOEXE, NOSHR, LONG

WAIT:		.BLKQ		1		; Flush timer quadword
TERM_IOSB:	.BLKQ		1		; Terminal output IOSB
INPUT_IOSB:	.BLKQ		1		; Terminal input IOSB
MBX_IOSB:	.BLKQ		1		; Mailbox IOSB
USER_IOSB:	.BLKQ		1		; User IOSB
USER_UCB:	.BLKL		1		; User's terminal UCB

TERM_CHARS:	.BLKL		3		; Terminal characteristics
ORIG_CHARS:	.BLKL		3		; Original characteristics

NAME_ARGS:	.LONG		3		; Arg list for find UCB routine
DESCR:		.BLKL		1		; Device name descr address
UCB:		.BLKL		1		; Returned UCB address
PUCB:		.BLKL		1		; Returned phys UCB address

SEND_ARGS:	.LONG		1		; Arg list for send char routine
SEND_CHAR:	.BLKL		1		; Character to send

TERM_EF:	.BLKL		1		; Terminal output EF
INPUT_EF:	.BLKL		1		; Terminal input EF
MBX_EF:		.BLKL		1		; Mailbox event flag
MBX_SIZE:	.LONG		512		; Size of terminal mailbox
MBX_QUO:	.LONG		2048		; Quota for terminal mailbox

T_NAME:		.LONG		64		; Descriptor for terminal name
		.ADDRESS	NAME_BUF

DVI_LIST:	.WORD		64		; GETDVI item list for
		.WORD		DVI$_DEVNAM	; Getting mailbox device name
		.ADDRESS	MBX_NAME
		.ADDRESS	MBX_DESC
		.LONG		0
		.LONG		0

MBX_DESC:	.BLKL		1		; Descriptor for data mailbox
		.ADDRESS	MBX_NAME	; Device name
MBX_NAME:	.BLKB		64

EXIT_BLOCK:	.BLKL		1		; Link
		.ADDRESS	EXIT_HANDLER	; Handler
		.LONG		1
		.ADDRESS	EXIT_CODE	; Exit reason
EXIT_CODE:	.BLKL		1

FLAGS:		.LONG		0		; Status flags
MBX_CHAN:	.BLKW		1		; Terminal Mailbox Channel
INPUT_CHAN:	.BLKW		1		; user input channel
USER_MBX:	.BLKW		1		; User input mailbox chan
		.ALIGN	LONG

NAME_BUF:	.BLKB		64		; Terminal name input buffer
MBX_BUF:	.BLKB		2048		; Mailbox buffer
INPUT_MBX_BUF:	.BLKB		512		; Buffer for term mailbox
INPUT_BUF:	.BLKB		80		; Input buffer
WHICH:		.ASCID		/What terminal:/
USER_TERM:	.ASCID		/SYS$COMMAND/	; User's terminal for output
TIMER:		.ASCID		/0 00:00:00.10/	; Wait for one tenth second
ENABLED:	.ASCID		/Input mode enabled - ^\ to disable/
DISABLED:	.ASCID		/Input mode disabled/
NOT_SUPPORTED:	.ASCID		/You can't WATCH that terminal/<13><10>
NOT_YOUR_OWN:	.ASCID		/You can't WATCH your own terminal/<13><10>

		.MACRO	STATUS ?L1
		BLBS	R0, L1
		$EXIT_S	R0
L1:
		.ENDM	STATUS

		.SBTTL	WATCH - Setup entry point

		.PSECT	$CODE	RD, NOWRT, SHR, EXE, LONG
		.ENTRY	WATCH, ^M<>

		$BINTIM_S	TIMBUF=TIMER,-		; Convert delay to
				TIMADR=WAIT		;  binary
		STATUS
;+
;	Assign a channel to the user's terminal with an
;	associated mailbox.
;-
		PUSHAL		USER_MBX		; Channel for user mailbox
		PUSHAL		INPUT_CHAN		; Channel for user term
		PUSHAL		MBX_SIZE		; And message size
		PUSHAL		MBX_QUO			; Quota
		PUSHAL		USER_TERM		; Device name
		CALLS		#5,G^LIB$ASN_WTH_MBX	; Assign the channel
		STATUS
;+
;	Get the UCB address of the user's terminal for later checks
;-
		$CMKRNL_S ROUTIN=GET_USER_UCB
		STATUS
;+
;	Get the user terminal characteristics
;-
		$QIOW_S		CHAN=INPUT_CHAN,-
				FUNC=#IO$_SENSEMODE,-
				P1=ORIG_CHARS, P2=#12
		STATUS
		MOVQ		ORIG_CHARS, TERM_CHARS	; Copy for mods
		MOVL		ORIG_CHARS+8, TERM_CHARS+8
;+
;	Allocate event flags
;-
		PUSHAL		MBX_EF			; Get the mailbox EF
		CALLS		#1,G^LIB$GET_EF
		STATUS
		PUSHAL		TERM_EF
		CALLS		#1,G^LIB$GET_EF
		STATUS
		PUSHAL		INPUT_EF
		CALLS		#1,G^LIB$GET_EF
		STATUS
;+
;	Create the data mailbox, and get it's UCB address
;-
		$CREMBX_S	CHAN=MBX_CHAN,-		; Create the mailbox
				MAXMSG=#2048
		STATUS
		$GETDVI_S	CHAN=MBX_CHAN,-		; Get the mailbox name
				ITMLST=DVI_LIST,-
				EFN=#1
		STATUS
		$WAITFR_S	EFN=#1
		STATUS
		MOVAL	MBX_DESC, DESCR		; Point to mailbox descriptor
		$CMKRNL_S	ROUTIN=FIND_UCB,-
				ARGLST=NAME_ARGS
		STATUS
		MOVL	UCB, MBX_UCB		; Point to mailbox UCB
;+
;	Get the name of the terminal to slave
;+
START:		PUSHAL	T_NAME			; Return length
		PUSHAL	WHICH			; Prompt
		PUSHAL	T_NAME			; Return buffer
; It has been claimed the #3 below should be #2 for correct operation
; on VMS V5. This is NOT clear, but be informed...
		CALLS	#3, G^LIB$GET_FOREIGN	; Get the terminal name
		STATUS
		MOVAL	NAME_BUF, R0		; Check for trailing colon
; Ensure terminal name does NOT start with "R". If you run this program
; on a terminal RTAn: (DECnet set host connect), VMS crashes!
		CMPB	(R0), #^A/R/		; is it an R?
		BNEQ	10$			; IF not, all's well
		RET				; If trying to look at RT,
				; GET OUTTA HERE FAST!
10$:		CMPB	(R0), #^A/:/		; Is it a colon?
		BEQL	30$			; Yup, all done
		CMPB	(R0), #^A/ /		; A space?
		BNEQ	20$			; Nope.
		MOVB	#^A/:/,(R0)		; Yes.. add colon.
		BRB	30$			; All done
20$:		INCL	R0			; Point to next
		BRB	10$			; Loop back
;+
;	Uppercase the string and find the UCB
;-
30$:		PUSHAL	T_NAME
		PUSHAL	T_NAME
		CALLS	#2, G^STR$UPCASE	; Upcase it
; Put getdvi here...
		MOVAL	T_NAME, DESCR		; Point kernel routine to arglist
		$CMKRNL_S	ROUTIN=FIND_UCB,-; Find the device UCB
				ARGLST=NAME_ARGS
		STATUS
		MOVL	UCB, TERM_UCB		; Store UCB for it
		TSTL	PUCB			; Is it virtual?
		BEQL	40$			; Nope.
		MOVL	PUCB, TERM_UCB		; Yes, use physical

40$:		CALLS	#0, G^SET_EXIT		; Declare the exit handler

		CMPL	TERM_UCB, USER_UCB	; Same UCB address as user's?
		BNEQ	50$			; Branch if not
		PUSHAL	NOT_YOUR_OWN		; Push message address
		CALLS	#1, G^LIB$PUT_OUTPUT	; Display the message
		$EXIT_S				; And exit
;+
;	Set it to PASTHRU mode
;-
50$:		BISL2		#TT2$M_PASTHRU, TERM_CHARS+8
		$QIOW_S		CHAN=INPUT_CHAN,-
				FUNC=#IO$_SETMODE,-
				P1=TERM_CHARS, P2=#12
		STATUS

;+
;	Load the magic code into nonpaged pool
;-
		$CMKRNL_S	ROUTIN=LOAD_CODE; Load the code and set hook
		CMPL	R0, #SS$_IVDEVNAM	; Legal device to watch ?
		BNEQ	60$			; Branch it okay so far
		PUSHAL	NOT_SUPPORTED		; Push message dsc pointer
		CALLS	#1, G^LIB$PUT_OUTPUT	; Display "non-supported" msg
		$EXIT_S				; And just exit

60$:		STATUS
		BSBW	SETUP_TERM_AST		; Set up AST for terminal
		$SETIMR_S	DAYTIM=WAIT,-	; Set up the flush timer
				ASTADR=FLUSH
		STATUS
		CLRQ	-(SP)			; At top of screen..
		CALLS	#2, G^SCR$ERASE_PAGE	; Erase it
		STATUS
;+
;	Fall thru to begin reading the mailbox.
;-

		.SBTTL	MBX_READ - Read messages and echo
;+
;	Read and echo the mailbox message
;-
MBX_READ:	$QIOW_S		EFN=MBX_EF,-		; Read the mailbox
				CHAN=MBX_CHAN,-
				FUNC=#IO$_READVBLK,-
				IOSB=MBX_IOSB,-
				P1=MBX_BUF,P2=#2048
		STATUS					; Check QIO Status
		MOVZWL	MBX_IOSB, R0			; Check I/O status
		STATUS
		MOVZWL	MBX_IOSB+2, R1
		$QIOW_S		EFN=TERM_EF,-		; Write the text
				IOSB=TERM_IOSB,-
				CHAN=INPUT_CHAN,-
				FUNC=#IO$_WRITEVBLK,-
				P1=MBX_BUF, P2=R1
		STATUS
		MOVZWL	TERM_IOSB, R0
		STATUS
		BRW	MBX_READ			; Read another

;+
; Get the user's UCB address
;-
		.ENTRY GET_USER_UCB^M<R2>
		MOVL	INPUT_CHAN, R0		; Get channel number
		JSB	G^IOC$VERIFYCHAN	; Get UCB address
		BLBC	R0, 10$			; Branch on error
		MOVL	CCB$L_UCB(R1), R2	; Get the UCB address
		MOVL	UCB$L_TL_PHYUCB(R2),USER_UCB ; Get the physical ucb
10$:		RET


;+
;	Exit handler setup
;-
		.ENTRY	SET_EXIT,^M<>
		$DCLEXH_S	DESBLK=EXIT_BLOCK ; Declare exit handler
		RET		

		.SBTTL	EXIT_HANDLER, Exit reset handler
		.ENTRY	EXIT_HANDLER,^M<>
		$QIOW_S		CHAN=INPUT_CHAN,-	; Reset the term
				FUNC=#IO$_SETMODE,-
				P1=ORIG_CHARS,-
				P2=#12
		$QIOW_S		EFN=TERM_EF,-		; Write the text
				CHAN=INPUT_CHAN,-
				FUNC=#IO$_WRITEVBLK,-
				P1=EXIT_MESSAGE, P2=#EXIT_SIZE
		MOVL	CODE_PTR, R0
		BEQL	10$
		MOVAL	RESET-KERNEL_CODE(R0), R0
		$CMKRNL_S	ROUTIN=(R0)		; Call fixup
		BLBC	R0, 20$
		$CMKRNL_S	ROUTIN=FREE_POOL	; Free pool
		BLBC	R0, 20$
10$:		MOVL	#SS$_NORMAL, R0
20$:		RET
EXIT_MESSAGE:	.ASCII	/Exiting.../
EXIT_SIZE = .-EXIT_MESSAGE

		.SBTTL	FLUSH - Flush the ring
		.ENTRY	FLUSH, ^M<>
		$SETIMR_S	DAYTIM=WAIT,-
				ASTADR=FLUSH
		STATUS
		MOVL	CODE_PTR, R0
		MOVAL	FLUSH_RING-KERNEL_CODE(R0), R0
		$CMKRNL_S	ROUTIN=(R0)		; Call the flusher
		STATUS
		RET

		.SBTTL	FIND_UCB - Locate the device UCB
;
;	This routine finds the address of the UCB for a specified
;	device.
;
;	Arguments:
;	DESCR	Address of device name descriptor
;	UCB	Return pointer to [virtual] UCB
;	PUCB	Return pointer to [physical] UCB, zero if none.
;
;	This routine executes in Kernel mode at elevated IPL
;
		.ENTRY	FIND_UCB,^M<R2,R3,R4,R5>
		CLRQ	8(AP)			; Clear UCB pointers
		MOVL	G^ctl$GL_PCB, R4	; Get current PCB pointer
		JSB	G^SCH$IOLOCKR		; Lock I/O database for read
		MOVL	4(AP), R1		; Point to device descr
		JSB	G^IOC$SEARCHDEV		; Search for device
		BLBC	R0, 10$			; Exit on failure
		MOVL	UCB$L_TL_PHYUCB(R1),12(AP) ; Return physical UCB
		MOVL	R1, 8(AP)		; Return UCB
		BBC	#DEV$V_DET, UCB$L_DEVCHAR2(R1),-
			10$			; Skip if not detached
		MOVL	#SS$_DEVOFFLINE, R0	; Say it's offline
10$:		PUSHL	R0			; Save status
		JSB	G^SCH$IOUNLOCK		; Unlock the I/O database
		POPL	R0
		RET				; And return

		.SBTTL	LOAD_CODE - Load hook code into pool

		.ENTRY	LOAD_CODE,^M<R2,R3,R4,R5>
		DSBINT	#IPL$_ASTDEL		; Stop ast delivery
		MOVL	#KERN_SIZE, R1		; Size of pool to get
		JSB	G^EXE$ALONONPAGED	; Get the pool
		BLBS	R0, 10$			; Skip if OK
		ENBINT
		RET				; Can't get it!
10$:		MOVW	R1, CODE_SIZE		; Store size
		MOVL	R2, CODE_PTR		; Store pointer
		MOVC3	#KERN_SIZE,-
			KERNEL_CODE,-
			(R2)			; Store the code in the block
		MOVL	CODE_PTR, R0		; Point to code block
		MOVAL	SETUP-KERNEL_CODE(R0), R0 ; Get SETUP address
		JSB	(R0)			; Go to it
		ENBINT
		RET

		.SBTTL SETUP_TERM_AST - Setup the terminal mailbox AST
SETUP_TERM_AST:	$QIOW_S	CHAN=USER_MBX,-		; Using user's terminal mailbox
			FUNC=#IO$_SETMODE!IO$M_WRTATTN,- ; Write attention AST
			P1=TERM_AST		; AST routine
		STATUS
		RSB

		.ENTRY	TERM_AST, ^M<R2,R3>
		$QIOW_S		CHAN=USER_MBX,-
				IOSB=USER_IOSB,-
				FUNC=#IO$_READVBLK,-
				P1=INPUT_MBX_BUF,P2=#512
		STATUS