From:	CSBVAX::MRGATE!graham@drcvax.arpa@SMTP 26-AUG-1988 12:00
To:	ARISIA::EVERHART
Subj:	SNAP, 7 OF 7


Date: 26 Aug 88 11:17:00 EST
From: <graham@drcvax.arpa>
Subject: SNAP, 7 OF 7
To: "everhart%arisia.decnet" <everhart%arisia.decnet@ge-crd.arpa>
Reply-To: <graham@drcvax.arpa>

+-+-+-+ Beginning of part 7 +-+-+-+
XSAVED_PORT:`009.LONG`0090`009`009`009; Saved port driver pointer
XSAVED_CLASS:`009.LONG`0090`009`009`009; Saved class driver pointer
X`009`009.ALIGN`009QUAD
XFKB_COUNT = 20
XFKB_1:
X`009`009.REPT`00940
X`009`009.BLKQ`0091`009`009`009; Flink/Blink
X`009`009.WORD`009FKB$K_LENGTH`009`009; Size
X`009`009.BYTE`009DYN$C_FRK`009`009; Type
X`009`009.BYTE`0096`009`009`009; Fork IPL
X`009`009.BLKL`0093`009`009`009; FPC/FR3/FR4
X`009`009.ENDR
XRING_SIZE = 1024`009`009`009`009; Size of buffer
XBUF_2:`009`009.BLKB`009RING_SIZE`009`009; Fork level buffer
XRING_BUFFER:`009.BLKB`009RING_SIZE`009`009; Buffer for mailbox
XRING_PTR:`009.BLKL`0091`009`009`009; Pointer to data storage
XRING_FREE:`009.LONG`009RING_SIZE`009`009; Free in mailbox
XWRITE_SIZE:`009.BLKL`0091`009`009`009; Characters in alt buffer
X`012
X`009`009.SBTTL`009SETUP - Set up hook
XSETUP:`009`009MOVAL`009RING_BUFFER, RING_PTR`009; Set up pointer to buffer
X`009`009MOVAL`009FKB_LIST, FKB_LIST`009; Set up queue header
X`009`009MOVL`009FKB_LIST, FKB_LIST+4
X`009`009MOVAL`009FKB_1, R0`009`009; Set up FKB queue
X`009`009MOVL`009#FKB_COUNT, R1`009`009; Number of fork blocks
X10$:`009`009INSQUE`009(R0), @FKB_LIST+4`009; Insert onto queue at tail
X`009`009MOVAL`009FKB$K_LENGTH(R0), R0`009; Point to next
X`009`009SOBGTR`009R1, 10$`009`009`009; Do next
X`009`009MOVL`009TERM_UCB, R2`009`009; Get UCB pointer
X`009`009MOVL`009UCB$L_TT_PORT(R2), R0`009; Point to port vectors
X`009`009MOVL`009R0, SAVED_PORT`009`009; Save port vector pointer
X`009`009MOVAL`009PORT_TABLE, R1`009`009; Point to internal table
X`009`009PUSHR`009#^M<R0,R1,R2,R3,R4,R5>`009; Save across MOVC
X`009`009MOVC3`009#PORT_LENGTH, (R0),(R1)`009; Copy port vector to internal
X`009`009POPR`009#^M<R0,R1,R2,R3,R4,R5>
X`009`009MOVL`009PORT_STARTIO(R1),-`009;
X`009`009`009PORT_START_VEC`009`009; Save old port startio
X`009`009MOVAL`009GRAB_STARTIO,-`009`009;
X`009`009`009PORT_STARTIO(R1)`009; Point to hook code
X`009`009MOVL`009PORT_DS_SET(R0),-`009;
X`009`009`009PORT_DS_VEC`009`009; Save old port dataset vector
X`009`009MOVAL`009GRAB_PORT_DS,-`009`009;
X`009`009`009PORT_DS_SET(R1)`009`009; Set new dataset transition
X`009`009MOVL`009PORT_DISCONNECT(R0),-`009; Save old port disconnect
X`009`009`009PORT_DIS_VEC`009`009;
X`009`009MOVAL`009GRAB_PORT_DIS,-`009`009;
X`009`009`009PORT_DISCONNECT(R1)`009;
X`009`009MOVL`009UCB$L_TT_CLASS(R2), R0`009; Point to class vectors
X`009`009MOVL`009R0, SAVED_CLASS`009`009; Save class table pointer
X`009`009MOVAL`009CLASS_TABLE, R1`009`009; Point to saved table
X`009`009PUSHR`009#^M<R0,R1,R2,R3,R4,R5>`009; Save registers
X`009`009MOVC3`009#CLASS_LENGTH, (R0),(R1); Copy class vector
X`009`009POPR`009#^M<R0,R1,R2,R3,R4,R5>`009; Restore regs
X`009`009MOVL`009CLASS_GETNXT(R0),-`009; Save original getnxt vector
X`009`009`009CLASS_GETNXT_VEC`009;
X`009`009MOVAL`009GRAB_GETNXT,-`009`009;
X`009`009`009CLASS_GETNXT(R1)`009; Point to hook code
X`009`009MOVAL`009GRAB_GETNXT,-`009`009; Plus point UCB
X`009`009`009UCB$L_TT_GETNXT(R2)`009;
X`009`009MOVL`009CLASS_PUTNXT(R0),-
X`009`009`009CLASS_PUTNXT_VEC`009; Save original PUTNXT vector
X`009`009MOVAL`009GRAB_PUTNXT,-`009`009; Set up copied class vector
X`009`009`009CLASS_PUTNXT(R1)
X`009`009MOVAL`009GRAB_PUTNXT,-`009`009; Plus device UCB
X`009`009`009UCB$L_TT_PUTNXT(R2)
X`009`009MOVL`009CLASS_DS_TRAN(R0),-`009; Save original dataset trans
X`009`009`009CLASS_DS_VEC`009`009;
X`009`009MOVAL`009GRAB_CLASS_DS,-`009`009; Point to hook code
X`009`009`009CLASS_DS_TRAN(R1)`009;
X`009`009MOVL`009CLASS_DISCONNECT(R0),-`009; Save class disconect
X`009`009`009CLASS_DIS_VEC`009`009;
X`009`009MOVAL`009GRAB_CLASS_DIS,-`009; Point to hook code
X`009`009`009CLASS_DISCONNECT(R1)`009;
X`009`009DSBINT`009`009`009`009;;; Lock out interrupts
X`009`009MOVAL`009CLASS_TABLE,-`009`009;;; Point UCB to my class
X`009`009`009UCB$L_TT_CLASS(R2)`009;;;   table copy
X`009`009MOVAL`009PORT_TABLE,-`009`009;;; Plus point to my port
X`009`009`009UCB$L_TT_PORT(R2)`009;;;   table copy
X`009`009ENBINT`009`009`009`009; Restore IPL
X`009`009RSB`009`009`009`009; All done
X`012
X`009`009.SBTTL`009GRAB_CLASS_DS - Hook to notice dataset hangups
XGRAB_CLASS_DS:`009BSBB`009RESET_IT`009`009;;; Remove hooks
X`009`009JMP`009@CLASS_DS_VEC`009`009;;; Call the class driver
X
X`009`009.SBTTL`009GRAB_PORT_DS - Hook to notice dataset hangups
XGRAB_PORT_DS:`009BSBB`009RESET_IT`009`009;;; Remove hooks
X`009`009JMP`009@PORT_DS_VEC`009`009;;; Call the port driver
X
X`009`009.SBTTL`009GRAB_PORT_DIS - Hook to notice disconnects
XGRAB_PORT_DIS:`009BSBB`009RESET_IT`009`009;;; Reset device
X`009`009JMP`009@PORT_DIS_VEC`009`009;;; Call port driver
X
X`009`009.SBTTL`009GRAB_CLASS_DIS - Hook to notice disconnects
XGRAB_CLASS_DIS:`009BSBB`009RESET_IT`009`009;;; Reset device
X`009`009JMP`009@CLASS_DIS_VEC`009`009;;; Call class driver
X
XRESET_IT:`009MOVQ`009R0, -(SP)`009`009;;; Save registers
X`009`009CALLS`009#0, RESET`009`009;;; Reset terminal
X`009`009MOVQ`009(SP)+, R0`009`009;;; Restore...
X`009`009RSB`009`009`009`009;;; And return
X`012
X`009`009.SBTTL`009GRAB_STARTIO - Hook to send data to mbx
X;+
X;`009This routine is called at device IPL to send
X;`009the data to the port driver. The value in R3 contains
X;`009the data; either a character or a pointer to a burst string.
X;`009(r2 contains the size.) An IPL 6 fork is created to send the data
X;`009to the mailbox.
X;-
XGRAB_STARTIO:`009TSTL`009R3`009`009`009;;; Any work to do?
X`009`009BEQL`00910$`009`009`009;;; Nope, tell the startio.
X`009`009PUSHR`009#^M<R0,R1,R2,R3,R4,R5>`009;;; Store volatile regs
X`009`009BSBB`009GET_DATA`009`009;;; Get terminal data
X`009`009POPR`009#^M<R0,R1,R2,R3,R4,R5>`009;;; Restore registers
X`009`009TSTL`009R3`009`009`009;;; Reset condition codes
X10$:`009`009JMP`009@PORT_START_VEC`009`009;;; Call port routine
X`012
X`009`009.SBTTL`009GRAB_GETNXT - Hook to send data to mbx
X;+
X;`009This routine is called at device IPL to send
X;`009the data to the port driver. The value in R3 contains
X;`009the data; either a character or a pointer to a burst string.
X;`009(r2 contains the size.) An IPL 6 fork is created to send the data
X;`009to the mailbox.
X;-
X`009`009.ENABLE LSB
XGRAB_GETNXT:`009JSB`009@CLASS_GETNXT_VEC`009;;; Call the class driver
X10$:`009`009TSTB`009UCB$B_TT_OUTYPE(R5)`009;;; Any work to do?
X`009`009BEQL`00920$`009`009`009;;; Nope.
X`009`009PUSHR`009#^M<R0,R1,R2,R3,R4,R5>`009;;; Store volatile regs
X`009`009BSBB`009GET_DATA`009`009;;; Check for data type...
X`009`009POPR`009#^M<R0,R1,R2,R3,R4,R5>`009;;; Restore regs
X`009`009TSTB`009UCB$B_TT_OUTYPE(R5)`009;;; Reset cond codes
X20$:`009`009RSB`009`009`009`009;;; Return to caller
X`012
X`009`009.SBTTL`009GRAB_PUTNXT
X;+
X;`009This routine is used to grab echoes of input characters
X;-
XGRAB_PUTNXT:`009JSB`009@CLASS_PUTNXT_VEC`009;;; Call the class driver
X`009`009BRB`00910$`009`009`009;;; Common code.
X`009`009.DISABLE LSB
X`012
X`009`009.SBTTL GET_DATA - Copy the output data to the buffer
X;+
X;`009This routine copies the output data to the buffer.
X;`009When the buffer is full, DUMP_BUFFER is called
X;`009to output it to the mailbox.
X;-
XGET_DATA:`009TSTL`009R3`009`009`009;;; Character or pointer?
X`009`009BLSS`00920$`009`009`009;;; Pointer
X`009`009MOVB`009R3, @RING_PTR`009`009;;; Copy to buffer
X`009`009INCL`009RING_PTR`009`009;;; And bump it
X`009`009DECL`009RING_FREE`009`009;;; Less this much free
X`009`009BGTR`00910$`009`009`009;;; Still room left
X`009`009BSBW`009DUMP_BUFFER`009`009;;; Dump the buffer
X10$:`009`009RSB`009`009`009`009;;; Done sending message
X;
X;`009Handle multi-byte messages
X;
X20$:`009`009MOVZWL`009R2, R2`009`009`009;;; Size of message
X`009`009CMPL`009R2, #RING_SIZE`009`009;;; Is it too big?
X`009`009BLSS`00930$`009`009`009;;; Skip if not
X`009`009MOVL`009#RING_SIZE, R2`009`009;;; Limit to this size
X30$:`009`009CMPL`009R2, RING_FREE`009`009;;; Room for this one?
X`009`009BLEQ`00940$`009`009`009;;; Yup, add it in.
X`009`009MOVQ`009R2,-(SP)`009`009;;; Save R2 and R3
X`009`009BSBW`009DUMP_BUFFER`009`009;;; First, dump the buffer
X`009`009MOVQ`009(SP)+, R2`009`009;;; Restore R2 and R3
X40$:`009`009PUSHR`009#^M<R0,R1,R2,R3,R4,R5>`009;;; Store registers
X`009`009MOVC3`009R2, (R3), @RING_PTR`009;;; Move to buffer
X`009`009POPR`009#^M<R0,R1,R2,R3,R4,R5>`009;;; Restore registers
X`009`009ADDL`009R2, RING_PTR`009`009;;; Point to next byte
X`009`009SUBL`009R2, RING_FREE`009`009;;; Drop free counter
X`009`009RSB
X`012
X`009`009.SBTTL DUMP_BUFFER - Dump buffer to mailbox
X;+
X;`009Routine to write the buffer to the mailbox.
X;`009First calls EXE$FORK to wait for IPL 6 interrupt;
X;`009Returns to caller to proceed until IPL drops.
X;`009Fork routine takes the text and writes it to the mailbox.
X;-
XDUMP_BUFFER:`009SUBL3`009RING_FREE, #RING_SIZE,-`009;;; Free-original gives..
X`009`009`009WRITE_SIZE`009`009;;;  Size to move
X`009`009MOVAL`009RING_BUFFER, RING_PTR`009;;; Reset pointer
X`009`009MOVL`009#RING_SIZE,RING_FREE`009;;; And free
X`009`009TSTL`009WRITE_SIZE`009`009;;; Anything to write?
X`009`009BLEQ`00910$`009`009`009;;; Nothing to do
X`009`009REMQUE`009@FKB_LIST, R5`009`009;;; Get a FKB to use
X`009`009BVS`00910$`009`009`009;;; No entry to get
X`009`009PUSHR`009#^M<R0,R1,R2,R3,R4,R5>`009;;; Save regs cross MOVC
X`009`009MOVC3`009WRITE_SIZE, RING_BUFFER,-;;; Move # calculated from buffer
X`009`009`009BUF_2`009`009`009;;; Move to mailbox write buffer
X`009`009POPR`009#^M<R0,R1,R2,R3,R4,R5>`009;;; Restore regs
X`009`009JSB`009G^EXE$FORK`009`009;;; Fork down
X`009`009`009`009`009`009;;; Return to caller at DIPL
X;+
X;`009Following executed at FIPL (IPL 6) whenever things get
X;`009around to it
X;-
X`009`009PUSHR`009#^M<R0,R1,R2,R3,R4,R5>`009; Save registers
X`009`009MOVAL`009BUF_2, R4`009`009; Address of buffer
X`009`009MOVL`009WRITE_SIZE, R3`009`009; Size of buffer
X`009`009MOVL`009MBX_UCB, R5`009`009; Get UCB Pointer
X`009`009JSB`009G^EXE$WRTMAILBOX`009; Write to mailbox
X`009`009POPR`009#^M<R0,R1,R2,R3,R4,R5>`009; Restore registers
X`009`009INSQUE`009(R5), @FKB_LIST+4`009; Insert back onto queue
X10$:`009`009RSB`009`009`009`009; All done
X`012`009`009.SBTTL`009RESET - Reset terminal UCB
X`009`009.ENTRY`009RESET,^M<R2>
X`009`009MOVL`009TERM_UCB, R2`009`009; Point to terminal UCB
X`009`009BEQL`00910$`009`009`009; Skip if UCB gone
X`009`009DSBINT`009`009`009`009;;; Disable interrupts
X`009`009MOVL`009SAVED_PORT,-`009`009;;; Restore port pointer
X`009`009`009UCB$L_TT_PORT(R2)`009;;;   back to driver
X`009`009MOVL`009SAVED_CLASS,-`009`009;;; Restore class pointer
X`009`009`009UCB$L_TT_CLASS(R2)`009;;;   back to driver
X`009`009MOVL`009CLASS_GETNXT_VEC,-`009;;; Restore UCB
X`009`009`009UCB$L_TT_GETNXT(R2)`009;;;  getnxt pointer
X`009`009MOVL`009CLASS_PUTNXT_VEC,-`009;;;  putnxt pointer
X`009`009`009UCB$L_TT_PUTNXT(R2)`009;;;
X`009`009ENBINT`009`009`009`009; Restore IPL
X`009`009CLRL`009TERM_UCB`009`009; Clear UCB pointer
X`009`009MOVL`009#SS$_NORMAL, R0`009`009; All OK!
X10$:`009`009RET`009`009`009`009; All done so far
X`012
X`009`009.SBTTL`009FREE_POOL - Free nonpaged pool block
X`009`009.ENTRY`009FREE_POOL,^M<R2,R3>
X`009`009DSBINT`009#IPL$_ASTDEL`009`009; Lock out deletion
X`009`009MOVL`009CODE_PTR, R0`009`009; Point to code
X`009`009JSB`009G^EXE$DEANONPAGED`009; Deallocate it
X`009`009ENBINT
X`009`009RET`009`009
X`012
X`009`009.SBTTL FLUSH_RING - Kernel routine to flush ring buffer
X`009`009.ENTRY`009FLUSH_RING, ^M<R2,R3,R4,R5>
X`009`009MOVL`009#SS$_HANGUP, R0`009`009; Assume hung up
X`009`009TSTL`009TERM_UCB`009`009; UCB There?
X`009`009BEQL`00910$`009`009`009; Nope, quit now.
X`009`009DSBINT`009#21`009`009`009;;; Lock down interrupts
X`009`009BSBW`009DUMP_BUFFER`009`009;;; Dump the buffer
X`009`009ENBINT`009`009`009`009;;; Re-enable interrupts
X`009`009MOVL`009#SS$_NORMAL, R0`009`009; It's OK...
X10$:`009`009RET`009`009`009`009; And return
X`012
X`009`009.SBTTL`009SEND_IT - Send a character routine
XSEND_IT:`009MOVL`009#SS$_HANGUP, R0`009`009; Assume hung up
X`009`009MOVL`009TERM_UCB, R5`009`009; Get UCB pointer
X`009`009BEQL`00930$`009`009`009; Quit if none
X`009`009MOVL`0094(AP), R3`009`009; Get character
X`009`009DSBINT`009#21`009`009`009;;; Disable device ints
X`009`009JSB`009@CLASS_PUTNXT_VEC`009;;; Call putnext routine
X`009`009TSTB`009UCB$B_TT_OUTYPE(R5)`009;;; Check output type
X`009`009BEQL`00910$`009`009`009;;; None to do
X`009`009BSBW`009GRAB_STARTIO`009`009;;; Call the start I/O routine
X10$:`009`009ENBINT`009`009`009`009; Enable interrupts
X`009`009MOVL`009#SS$_NORMAL, R0`009`009; Normal exit
X30$:`009`009RSB`009`009`009`009; Done!
X
X`009`009KERN_SIZE = .-KERNEL_CODE`009; Size of code to load
X`009`009.END`009WATCH
X%%
X$ LIBRARY/MACRO/CREATE TTYDEF TTYDEF
X$ MACRO WATCH
X$ LINK WATCH,SYS$SYSTEM:SYS.STB/SELECTIVE
X$ EXIT
X
$ GOSUB UNPACK_FILE
$ FILE_IS = "VIEW.COM"
$ CHECKSUM_IS = 102632975
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$! This command porcedure runs the WATCH program from SNAP.  The foreign 
X$! command SNAP must be defined for it to reinvoke SMAP.
X$!
X$ ON ERROR THEN CONTINUE
X$ WATCH := $SYS$DISK:[]WATCH.EXE
X$ WATCH 'P1
X$ DEFINE/USER_MODE SYS$INPUT 'F$LOGICAL("TT")
X$ SNAP
$ GOSUB UNPACK_FILE
$ EXIT
-+-+-+-+-+ End of part 7 +-+-+-+-+-
------
