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


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

+-+-+-+ Beginning of part 6 +-+-+-+
X`009`009$TT2DEF`009`009`009`009; Define terminal chars
X`009`009$SSDEF`009`009`009`009; Define system service returns
X`009`009$DVIDEF`009`009`009`009; GETDVI definitions
X`009`009$DYNDEF`009`009`009`009; Dynamic memory struct types
X`009`009$FKBDEF`009`009`009`009; Define fork block
X
X`009`009.PSECT`009$DATA`009RD, WRT, NOEXE, NOSHR, LONG
X
XWAIT:`009`009.BLKQ`009`0091`009`009; Flush timer quadword
XTERM_IOSB:`009.BLKQ`009`0091`009`009; Terminal output IOSB
XINPUT_IOSB:`009.BLKQ`009`0091`009`009; Terminal input IOSB
XMBX_IOSB:`009.BLKQ`009`0091`009`009; Mailbox IOSB
XUSER_IOSB:`009.BLKQ`009`0091`009`009; User IOSB
X
XTERM_CHARS:`009.BLKL`009`0093`009`009; Terminal characteristics
XORIG_CHARS:`009.BLKL`009`0093`009`009; Original characteristics
X
XNAME_ARGS:`009.LONG`009`0093`009`009; Arg list for find UCB routine
XDESCR:`009`009.BLKL`009`0091`009`009; Device name descr address
XUCB:`009`009.BLKL`009`0091`009`009; Returned UCB address
XPUCB:`009`009.BLKL`009`0091`009`009; Returned phys UCB address
X
XSEND_ARGS:`009.LONG`009`0091`009`009; Arg list for send char routine
XSEND_CHAR:`009.BLKL`009`0091`009`009; Character to send
X
XTERM_EF:`009.BLKL`009`0091`009`009; Terminal output EF
XINPUT_EF:`009.BLKL`009`0091`009`009; Terminal input EF
XMBX_EF:`009`009.BLKL`009`0091`009`009; Mailbox event flag
XMBX_SIZE:`009.LONG`009`009512`009`009; Size of terminal mailbox
XMBX_QUO:`009.LONG`009`0092048`009`009; Quota for terminal mailbox
X
XT_NAME:`009`009.LONG`009`00964`009`009; Descriptor for terminal name
X`009`009.ADDRESS`009NAME_BUF
X
XDVI_LIST:`009.WORD`009`00964`009`009; GETDVI item list for
X`009`009.WORD`009`009DVI$_DEVNAM`009; Getting mailbox device name
X`009`009.ADDRESS`009MBX_NAME
X`009`009.ADDRESS`009MBX_DESC
X`009`009.LONG`009`0090
X`009`009.LONG`009`0090
X
XMBX_DESC:`009.BLKL`009`0091`009`009; Descriptor for data mailbox
X`009`009.ADDRESS`009MBX_NAME`009; Device name
XMBX_NAME:`009.BLKB`009`00964
X
XEXIT_BLOCK:`009.BLKL`009`0091`009`009; Link
X`009`009.ADDRESS`009EXIT_HANDLER`009; Handler
X`009`009.LONG`009`0091
X`009`009.ADDRESS`009EXIT_CODE`009; Exit reason
XEXIT_CODE:`009.BLKL`009`0091
X
XFLAGS:`009`009.LONG`009`0090`009`009; Status flags
XMBX_CHAN:`009.BLKW`009`0091`009`009; Terminal Mailbox Channel
XINPUT_CHAN:`009.BLKW`009`0091`009`009; user input channel
XUSER_MBX:`009.BLKW`009`0091`009`009; User input mailbox chan
X`009`009.ALIGN`009LONG
X
XNAME_BUF:`009.BLKB`009`00964`009`009; Terminal name input buffer
XMBX_BUF:`009.BLKB`009`0092048`009`009; Mailbox buffer
XINPUT_MBX_BUF:`009.BLKB`009`009512`009`009; Buffer for term mailbox
XINPUT_BUF:`009.BLKB`009`00980`009`009; Input buffer
XWHICH:`009`009.ASCID`009`009/What terminal:/
XUSER_TERM:`009.ASCID`009`009/SYS$COMMAND/`009; User's terminal for output
XTIMER:`009`009.ASCID`009`009/0 00:00:00.10/`009; Wait for one tenth second
XENABLED:`009.ASCID`009`009/Input mode enabled - ^\ to disable/
XDISABLED:`009.ASCID`009`009/Input mode disabled/
X`012
X`009`009.MACRO`009STATUS ?L1
X`009`009BLBS`009R0, L1
X`009`009$EXIT_S`009R0
XL1:
X`009`009.ENDM`009STATUS
X`012
X`009`009.SBTTL`009WATCH - Setup entry point
X
X`009`009.PSECT`009$CODE`009RD, NOWRT, SHR, EXE, LONG
X`009`009.ENTRY`009WATCH, ^M<>
X
X`009`009$BINTIM_S`009TIMBUF=TIMER,-`009`009; Convert delay to
X`009`009`009`009TIMADR=WAIT`009`009;  binary
X`009`009STATUS
X;+
X;`009Assign a channel to the user's terminal with an
X;`009associated mailbox.
X;-
X`009`009PUSHAL`009`009USER_MBX`009`009; Channel for user mailbox
X`009`009PUSHAL`009`009INPUT_CHAN`009`009; Channel for user term
X`009`009PUSHAL`009`009MBX_SIZE`009`009; And message size
X`009`009PUSHAL`009`009MBX_QUO`009`009`009; Quota
X`009`009PUSHAL`009`009USER_TERM`009`009; Device name
X`009`009CALLS`009`009#5,G^LIB$ASN_WTH_MBX`009; Assign the channel
X`009`009STATUS
X;+
X;`009Get the user terminal characteristics
X;-
X`009`009$QIOW_S`009`009CHAN=INPUT_CHAN,-
X`009`009`009`009FUNC=#IO$_SENSEMODE,-
X`009`009`009`009P1=ORIG_CHARS, P2=#12
X`009`009STATUS
X`009`009MOVQ`009`009ORIG_CHARS, TERM_CHARS`009; Copy for mods
X`009`009MOVL`009`009ORIG_CHARS+8, TERM_CHARS+8
X;+
X;`009Allocate event flags
X;-
X`009`009PUSHAL`009`009MBX_EF`009`009`009; Get the mailbox EF
X`009`009CALLS`009`009#1,G^LIB$GET_EF
X`009`009STATUS
X`009`009PUSHAL`009`009TERM_EF
X`009`009CALLS`009`009#1,G^LIB$GET_EF
X`009`009STATUS
X`009`009PUSHAL`009`009INPUT_EF
X`009`009CALLS`009`009#1,G^LIB$GET_EF
X`009`009STATUS
X;+
X;`009Create the data mailbox, and get it's UCB address
X;-
X`009`009$CREMBX_S`009CHAN=MBX_CHAN,-`009`009; Create the mailbox
X`009`009`009`009MAXMSG=#2048
X`009`009STATUS
X`009`009$GETDVI_S`009CHAN=MBX_CHAN,-`009`009; Get the mailbox name
X`009`009`009`009ITMLST=DVI_LIST,-
X`009`009`009`009EFN=#1
X`009`009STATUS
X`009`009$WAITFR_S`009EFN=#1
X`009`009STATUS
X`009`009MOVAL`009MBX_DESC, DESCR`009`009; Point to mailbox descriptor
X`009`009$CMKRNL_S`009ROUTIN=FIND_UCB,-
X`009`009`009`009ARGLST=NAME_ARGS
X`009`009STATUS
X`009`009MOVL`009UCB, MBX_UCB`009`009; Point to mailbox UCB
X;+
X;`009Get the name of the terminal to slave
X;+
XSTART:`009`009PUSHAL`009T_NAME`009`009`009; Return length
X`009`009PUSHAL`009WHICH`009`009`009; Prompt
X`009`009PUSHAL`009T_NAME`009`009`009; Return buffer
X`009`009CALLS`009#2, G^LIB$GET_COMMAND`009; Get the terminal name
X`009`009STATUS
X`009`009MOVAL`009NAME_BUF, R0`009`009; Check for trailing colon
X10$:`009`009CMPB`009(R0), #^A/:/`009`009; Is it a colon?
X`009`009BEQL`00930$`009`009`009; Yup, all done
X`009`009CMPB`009(R0), #^A/ /`009`009; A space?
X`009`009BNEQ`00920$`009`009`009; Nope.
X`009`009MOVB`009#^A/:/,(R0)`009`009; Yes.. add colon.
X`009`009BRB`00930$`009`009`009; All done
X20$:`009`009INCL`009R0`009`009`009; Point to next
X`009`009BRB`00910$`009`009`009; Loop back
X;+
X;`009Uppercase the string and find the UCB
X;-
X30$:`009`009PUSHAL`009T_NAME
X`009`009PUSHAL`009T_NAME
X`009`009CALLS`009#2, G^STR$UPCASE`009; Upcase it
X`009`009MOVAL`009T_NAME, DESCR`009`009; Point kernel routine to arglist
X`009`009$CMKRNL_S`009ROUTIN=FIND_UCB,-; Find the device UCB
X`009`009`009`009ARGLST=NAME_ARGS
X`009`009STATUS
X`009`009MOVL`009UCB, TERM_UCB`009`009; Store UCB for it
X`009`009TSTL`009PUCB`009`009`009; Is it virtual?
X`009`009BEQL`00940$`009`009`009; Nope.
X`009`009MOVL`009PUCB, TERM_UCB`009`009; Yes, use physical
X
X40$:`009`009CALLS`009#0, G^SET_EXIT`009`009; Declare the exit handler
X;+
X;`009Set it to PASTHRU mode
X;-
X`009`009BISL2`009`009#TT2$M_PASTHRU, TERM_CHARS+8
X`009`009$QIOW_S`009`009CHAN=INPUT_CHAN,-
X`009`009`009`009FUNC=#IO$_SETMODE,-
X`009`009`009`009P1=TERM_CHARS, P2=#12
X`009`009STATUS
X`012
X;+
X;`009Load the magic code into nonpaged pool
X;-
X`009`009$CMKRNL_S`009ROUTIN=LOAD_CODE; Load the code and set hook
X`009`009STATUS
X`009`009BSBW`009SETUP_TERM_AST`009`009; Set up AST for terminal
X`009`009$SETIMR_S`009DAYTIM=WAIT,-`009; Set up the flush timer
X`009`009`009`009ASTADR=FLUSH
X`009`009STATUS
X`009`009CLRQ`009-(SP)`009`009`009; At top of screen..
X`009`009CALLS`009#2, G^SCR$ERASE_PAGE`009; Erase it
X`009`009STATUS
X;+
X;`009Fall thru to begin reading the mailbox.
X;-
X`012
X`009`009.SBTTL`009MBX_READ - Read messages and echo
X;+
X;`009Read and echo the mailbox message
X;-
XMBX_READ:`009$QIOW_S`009`009EFN=MBX_EF,-`009`009; Read the mailbox
X`009`009`009`009CHAN=MBX_CHAN,-
X`009`009`009`009FUNC=#IO$_READVBLK,-
X`009`009`009`009IOSB=MBX_IOSB,-
X`009`009`009`009P1=MBX_BUF,P2=#2048
X`009`009STATUS`009`009`009`009`009; Check QIO Status
X`009`009MOVZWL`009MBX_IOSB, R0`009`009`009; Check I/O status
X`009`009STATUS
X`009`009MOVZWL`009MBX_IOSB+2, R1
X`009`009$QIOW_S`009`009EFN=TERM_EF,-`009`009; Write the text
X`009`009`009`009IOSB=TERM_IOSB,-
X`009`009`009`009CHAN=INPUT_CHAN,-
X`009`009`009`009FUNC=#IO$_WRITEVBLK,-
X`009`009`009`009P1=MBX_BUF, P2=R1
X`009`009STATUS
X`009`009MOVZWL`009TERM_IOSB, R0
X`009`009STATUS
X`009`009BRW`009MBX_READ`009`009`009; Read another
X`012
X;+
X;`009Exit handler setup
X;-
X`009`009.ENTRY`009SET_EXIT,^M<>
X`009`009$DCLEXH_S`009DESBLK=EXIT_BLOCK ; Declare exit handler
X`009`009RET`009`009
X`012
X`009`009.SBTTL`009EXIT_HANDLER, Exit reset handler
X`009`009.ENTRY`009EXIT_HANDLER,^M<>
X`009`009$QIOW_S`009`009CHAN=INPUT_CHAN,-`009; Reset the term
X`009`009`009`009FUNC=#IO$_SETMODE,-
X`009`009`009`009P1=ORIG_CHARS,-
X`009`009`009`009P2=#12
X`009`009$QIOW_S`009`009EFN=TERM_EF,-`009`009; Write the text
X`009`009`009`009CHAN=INPUT_CHAN,-
X`009`009`009`009FUNC=#IO$_WRITEVBLK,-
X`009`009`009`009P1=EXIT_MESSAGE, P2=#EXIT_SIZE
X`009`009MOVL`009CODE_PTR, R0
X`009`009BEQL`00910$
X`009`009MOVAL`009RESET-KERNEL_CODE(R0), R0
X`009`009$CMKRNL_S`009ROUTIN=(R0)`009`009; Call fixup
X`009`009BLBC`009R0, 20$
X`009`009$CMKRNL_S`009ROUTIN=FREE_POOL`009; Free pool
X`009`009BLBC`009R0, 20$
X10$:`009`009MOVL`009#SS$_NORMAL, R0
X20$:`009`009RET
XEXIT_MESSAGE:`009.ASCII`009/Exiting.../
XEXIT_SIZE = .-EXIT_MESSAGE
X`012
X`009`009.SBTTL`009FLUSH - Flush the ring
X`009`009.ENTRY`009FLUSH, ^M<>
X`009`009$SETIMR_S`009DAYTIM=WAIT,-
X`009`009`009`009ASTADR=FLUSH
X`009`009STATUS
X`009`009MOVL`009CODE_PTR, R0
X`009`009MOVAL`009FLUSH_RING-KERNEL_CODE(R0), R0
X`009`009$CMKRNL_S`009ROUTIN=(R0)`009`009; Call the flusher
X`009`009STATUS
X`009`009RET
X`012
X`009`009.SBTTL`009FIND_UCB - Locate the device UCB
X;
X;`009This routine finds the address of the UCB for a specified
X;`009device.
X;
X;`009Arguments:
X;`009DESCR`009Address of device name descriptor
X;`009UCB`009Return pointer to [virtual] UCB
X;`009PUCB`009Return pointer to [physical] UCB, zero if none.
X;
X;`009This routine executes in Kernel mode at elevated IPL
X;
X`009`009.ENTRY`009FIND_UCB,^M<R2,R3,R4,R5>
X`009`009CLRQ`0098(AP)`009`009`009; Clear UCB pointers
X`009`009MOVL`009G^SCH$GL_CURPCB, R4`009; Get current PCB pointer
X`009`009JSB`009G^SCH$IOLOCKR`009`009; Lock I/O database for read
X`009`009MOVL`0094(AP), R1`009`009; Point to device descr
X`009`009JSB`009G^IOC$SEARCHDEV`009`009; Search for device
X`009`009BLBC`009R0, 10$`009`009`009; Exit on failure
X`009`009MOVL`009UCB$L_TL_PHYUCB(R1),12(AP) ; Return physical UCB
X`009`009MOVL`009R1, 8(AP)`009`009; Return UCB
X`009`009BBC`009#DEV$V_DET, UCB$L_DEVCHAR2(R1),-
X`009`009`00910$`009`009`009; Skip if not detached
X`009`009MOVL`009#SS$_DEVOFFLINE, R0`009; Say it's offline
X10$:`009`009PUSHL`009R0`009`009`009; Save status
X`009`009JSB`009G^SCH$IOUNLOCK`009`009; Unlock the I/O database
X`009`009POPL`009R0
X`009`009RET`009`009`009`009; And return
X`012
X`009`009.SBTTL`009LOAD_CODE - Load hook code into pool
X
X`009`009.ENTRY`009LOAD_CODE,^M<R2,R3,R4,R5>
X`009`009DSBINT`009#IPL$_ASTDEL`009`009; Stop process deletion
X`009`009MOVL`009#KERN_SIZE, R1`009`009; Size of pool to get
X`009`009JSB`009G^EXE$ALONONPAGED`009; Get the pool
X`009`009BLBS`009R0, 10$`009`009`009; Skip if OK
X`009`009ENBINT
X`009`009RET`009`009`009`009; Can't get it!
X10$:`009`009MOVW`009R1, CODE_SIZE`009`009; Store size
X`009`009MOVL`009R2, CODE_PTR`009`009; Store pointer
X`009`009MOVC3`009#KERN_SIZE,-
X`009`009`009KERNEL_CODE,-
X`009`009`009(R2)`009`009`009; Store the code in the block
X`009`009MOVL`009CODE_PTR, R0`009`009; Point to code block
X`009`009MOVAL`009SETUP-KERNEL_CODE(R0), R0 ; Get SETUP address
X`009`009JSB`009(R0)`009`009`009; Go to it
X`009`009ENBINT
X`009`009MOVL`009#SS$_NORMAL, R0`009`009; OK So far
X`009`009RET
X`012
X`009`009.SBTTL SETUP_TERM_AST - Setup the terminal mailbox AST
VSETUP_TERM_AST:`009$QIOW_S`009CHAN=USER_MBX,-`009`009; Using user's terminal ma
Xilbox
X`009`009`009FUNC=#IO$_SETMODE!IO$M_WRTATTN,- ; Write attention AST
X`009`009`009P1=TERM_AST`009`009; AST routine
X`009`009STATUS
X`009`009RSB
X
X`009`009.ENTRY`009TERM_AST, ^M<R2,R3>
X`009`009$QIOW_S`009`009CHAN=USER_MBX,-
X`009`009`009`009IOSB=USER_IOSB,-
X`009`009`009`009FUNC=#IO$_READVBLK,-
X`009`009`009`009P1=INPUT_MBX_BUF,P2=#512
X`009`009STATUS
XLOOP:`009`009$QIOW_S`009CHAN=INPUT_CHAN,-
X`009`009`009EFN=INPUT_EF,-
X`009`009`009FUNC=#IO$_READVBLK!IO$M_TIMED!IO$M_NOECHO,-
X`009`009`009IOSB=INPUT_IOSB,-
X`009`009`009P1=INPUT_BUF,-
X`009`009`009P2=#80,-
X`009`009`009P3=#0`009`009`009; Zero second timeout
X`009`009STATUS
X`009`009MOVZWL`009INPUT_IOSB, R0`009`009; Check status
X`009`009CMPW`009R0, #SS$_TIMEOUT`009; Timed out?
X`009`009BEQL`00910$`009`009`009; Yup, that's OK.
X`009`009STATUS
X10$:`009`009MOVW`009INPUT_IOSB+2, R2`009; Get offset to terminator
X`009`009ADDW`009INPUT_IOSB+6, R2`009; Plus terminator size
X`009`009BNEQ`00920$`009`009`009; Something there
X`009`009BSBW`009SETUP_TERM_AST`009`009; Reset the AST
X`009`009RET`009`009`009`009; Nothing there
X20$:`009`009MOVZWL`009R2, R2`009`009`009; Extend to word
X`009`009MOVAL`009INPUT_BUF, R3`009`009; And buffer pointer
X30$:`009`009MOVZBL`009(R3)+, SEND_CHAR`009; Get character
X`009`009CMPB`009SEND_CHAR,#^A/\/-^A/@/`009; ^\?
X`009`009BNEQ`00950$`009`009`009; Not the flag char
X`009`009BLBS`009FLAGS, 40$`009`009; If was set, clear it
X`009`009BISB`009#1, FLAGS`009`009; Set the flag
X`009`009PUSHAL`009ENABLED`009`009`009; Say input is enabled
X`009`009CALLS`009#1,G^LIB$PUT_OUTPUT
X`009`009BRB`00960$`009`009`009; Try next char
X40$:`009`009BICB`009#1, FLAGS`009`009; Clear the input flag
X`009`009PUSHAL`009DISABLED
X`009`009CALLS`009#1,G^LIB$PUT_OUTPUT`009; Say input disabled
X50$:`009`009BLBC`009FLAGS, 60$`009`009; Input mode disabled
X`009`009$CMKRNL_S`009ROUTIN=SEND_ONE,ARGLST=SEND_ARGS
X`009`009STATUS
X`009`009BRB`00970$`009`009`009; Done character
X60$:`009`009CMPB`009SEND_CHAR,#^A/Z/-^A/@/`009; Control-Z?
X`009`009BNEQ`00970$`009`009`009; Nope, ignore it.
X`009`009$EXIT_S`009#SS$_NORMAL`009`009; Exit now.
X70$:`009`009SOBGTR`009R2, 30$`009`009`009; Loop back
X`009`009BRW`009LOOP`009`009`009; Any more input?
X80$:`009`009RET
X`012
X`009`009.SBTTL`009SEND_ONE - Send a character to user terminal
X`009`009.ENTRY`009SEND_ONE, ^M<R2, R3, R4, R5>
X`009`009MOVL`009CODE_PTR, R0`009`009; Point to code block
X`009`009MOVAL`009SEND_IT-KERNEL_CODE(R0), R0 ; Get SEND CHARACTER address
X`009`009JSB`009(R0)`009`009`009; Call it
X`009`009RET
X`012
X`009`009.SBTTL`009KERNEL_CODE
X`009`009.PSECT`009LOADED`009RD, WRT, PIC, NOSHR, EXE, PAGE
XKERNEL_CODE:
XFKB_LIST:`009.BLKQ`0091`009`009`009; Fork block list
XCODE_SIZE:`009.BLKW`0091`009`009`009; Size
X`009`009.WORD`009DYN$C_FRK`009`009; Type
XCODE_PTR:`009.LONG`0090`009`009`009; Pointer to loaded code
XTERM_UCB:`009.LONG`0090`009`009`009; Terminal UCB
XMBX_UCB:`009.LONG`0090`009`009`009; Mailbox UCB
XPORT_TABLE:`009.BLKB`009PORT_LENGTH`009`009; Copied/munged port vector
XCLASS_LENGTH = CLASSS_CLASS_DEF`009`009`009; Hack since it's not there..
XCLASS_TABLE:`009.BLKB`009CLASS_LENGTH`009`009; Copied/munged class vector
XPORT_START_VEC:`009.LONG`0090`009`009`009; Gets original UCB PORT STARTIO
XPORT_DS_VEC:`009.LONG`0090`009`009`009; Gets original UCB PORT modem 
XCLASS_GETNXT_VEC:.LONG`0090`009`009`009; Gets original UCB Class GETNXT
XCLASS_PUTNXT_VEC:.LONG`0090`009`009`009; ... class driver put char
XCLASS_DS_VEC:`009.LONG`0090`009`009`009; ... class driver dataset trans
XPORT_DIS_VEC:`009.LONG`0090`009`009`009; ... port driver disconnect
XCLASS_DIS_VEC:`009.LONG`0090`009`009`009; ... class driver disconnect
-+-+-+-+-+ End of part 6 +-+-+-+-+-
------
