From:	ADVAX::"mcnc!CUNYVM.CUNY.EDU!VMSSERV%WKUVX1.BITNET" 26-FEB-1991 06:47:29.31
To:	arisia::everhart
CC:	
Subj:	DISK$WKUPUB2:[VMSSERV.FILES.WATCH]WATCH.01_OF_01;1

Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Tue, 26 Feb 91 06:46:13 EST
Received:  from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP
	id AA25596 for ; Tue, 26 Feb 91 06:23:47 -0500
Received: from CUNYVM.CUNY.EDU by mcnc.mcnc.org (5.59/MCNC/6-11-90)
	id AA17685; Tue, 26 Feb 91 06:16:59 -0500
	for arisia.dnet.ge.com!everhart
Message-Id: <9102261116.AA17685@mcnc.mcnc.org>
Received: from WKUVX1.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.2.2MX) with BSMTP id 7843; Tue, 26 Feb 91 06:16:49 EST
Date: Mon, 25 Feb 91 15:49 CST
From: mcnc!CUNYVM.CUNY.EDU!VMSSERV%WKUVX1.BITNET
Subject: DISK$WKUPUB2:[VMSSERV.FILES.WATCH]WATCH.01_OF_01;1
To: arisia::everhart
X-Vms-To: IN%"everhart@arisia.dnet.ge.com"
 
$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 22-FEB-1991 07:44:00.51   By user GOATHUNTER
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. BUILD_WATCH.COM;1
$!       2. WATCH.MAR;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X$ macro watch
X$ link/notrace watch
X$ exit
$ CALL UNPACK BUILD_WATCH.COM;1 593575544
$ create 'f'
X;Last Modified:   6-SEP-1988 14:19:55.00, By: RLB`20
X
X`09`09.TITLE`09WATCH - Watch terminal output stream
X`09`09.LIBRARY`09/SYS$LIBRARY:LIB/
X`09`09.LINK`09`09'SYS$SYSTEM:SYS.STB'/SELECTIVE_SEARCH
X`09`09$CCBDEF`09`09`09`09; Channel control block offsets
X`09`09$IPLDEF`09`09`09`09; Define IPL levels
X`09`09$TTYDEF`09`09`09`09; Define term driver structures
X`09`09$TTYDEFS`09`09`09;  ditto
X`09`09$TTYMDMDEF`09`09`09; Define modem control signals
X`09`09$TTYVECDEF`09`09`09; Define port/class vectors
X`09`09$TT2DEF`09`09`09`09; Define terminal chars
X`09`09$SSDEF`09`09`09`09; Define system service returns
X`09`09$DVIDEF`09`09`09`09; GETDVI definitions
X`09`09$DYNDEF`09`09`09`09; Dynamic memory struct types
X`09`09$FKBDEF`09`09`09`09; Define fork block
X
X`09`09.PSECT`09$DATA`09RD, WRT, NOEXE, NOSHR, LONG
X
XWAIT:`09`09.BLKQ`09`091`09`09; Flush timer quadword
XTERM_IOSB:`09.BLKQ`09`091`09`09; Terminal output IOSB
XINPUT_IOSB:`09.BLKQ`09`091`09`09; Terminal input IOSB
XMBX_IOSB:`09.BLKQ`09`091`09`09; Mailbox IOSB
XUSER_IOSB:`09.BLKQ`09`091`09`09; User IOSB
XUSER_UCB:`09.BLKL`09`091`09`09; User's terminal UCB
X
XTERM_CHARS:`09.BLKL`09`093`09`09; Terminal characteristics
XORIG_CHARS:`09.BLKL`09`093`09`09; Original characteristics
X
XNAME_ARGS:`09.LONG`09`093`09`09; Arg list for find UCB routine
XDESCR:`09`09.BLKL`09`091`09`09; Device name descr address
XUCB:`09`09.BLKL`09`091`09`09; Returned UCB address
XPUCB:`09`09.BLKL`09`091`09`09; Returned phys UCB address
X
XSEND_ARGS:`09.LONG`09`091`09`09; Arg list for send char routine
XSEND_CHAR:`09.BLKL`09`091`09`09; Character to send
X
XTERM_EF:`09.BLKL`09`091`09`09; Terminal output EF
XINPUT_EF:`09.BLKL`09`091`09`09; Terminal input EF
XMBX_EF:`09`09.BLKL`09`091`09`09; Mailbox event flag
XMBX_SIZE:`09.LONG`09`09512`09`09; Size of terminal mailbox
XMBX_QUO:`09.LONG`09`092048`09`09; Quota for terminal mailbox
X
XT_NAME:`09`09.LONG`09`0964`09`09; Descriptor for terminal name
X`09`09.ADDRESS`09NAME_BUF
X
XDVI_LIST:`09.WORD`09`0964`09`09; GETDVI item list for
X`09`09.WORD`09`09DVI$_DEVNAM`09; Getting mailbox device name
X`09`09.ADDRESS`09MBX_NAME
X`09`09.ADDRESS`09MBX_DESC
X`09`09.LONG`09`090
X`09`09.LONG`09`090
X
XMBX_DESC:`09.BLKL`09`091`09`09; Descriptor for data mailbox
X`09`09.ADDRESS`09MBX_NAME`09; Device name
XMBX_NAME:`09.BLKB`09`0964
X
XEXIT_BLOCK:`09.BLKL`09`091`09`09; Link
X`09`09.ADDRESS`09EXIT_HANDLER`09; Handler
X`09`09.LONG`09`091
X`09`09.ADDRESS`09EXIT_CODE`09; Exit reason
XEXIT_CODE:`09.BLKL`09`091
X
XFLAGS:`09`09.LONG`09`090`09`09; Status flags
XMBX_CHAN:`09.BLKW`09`091`09`09; Terminal Mailbox Channel
XINPUT_CHAN:`09.BLKW`09`091`09`09; user input channel
XUSER_MBX:`09.BLKW`09`091`09`09; User input mailbox chan
X`09`09.ALIGN`09LONG
X
XNAME_BUF:`09.BLKB`09`0964`09`09; Terminal name input buffer
XMBX_BUF:`09.BLKB`09`092048`09`09; Mailbox buffer
XINPUT_MBX_BUF:`09.BLKB`09`09512`09`09; Buffer for term mailbox
XINPUT_BUF:`09.BLKB`09`0980`09`09; Input buffer
XWHICH:`09`09.ASCID`09`09/What terminal:/
XUSER_TERM:`09.ASCID`09`09/SYS$COMMAND/`09; User's terminal for output
XTIMER:`09`09.ASCID`09`09/0 00:00:00.10/`09; Wait for one tenth second
XENABLED:`09.ASCID`09`09/Input mode enabled - `5E\ to disable/
XDISABLED:`09.ASCID`09`09/Input mode disabled/
XNOT_SUPPORTED:`09.ASCID`09`09/You can't WATCH that terminal/<13><10>
XNOT_YOUR_OWN:`09.ASCID`09`09/You can't WATCH your own terminal/<13><10>
X`0C
X`09`09.MACRO`09STATUS ?L1
X`09`09BLBS`09R0, L1
X`09`09$EXIT_S`09R0
XL1:
X`09`09.ENDM`09STATUS
X`0C
X`09`09.SBTTL`09WATCH - Setup entry point
X
X`09`09.PSECT`09$CODE`09RD, NOWRT, SHR, EXE, LONG
X`09`09.ENTRY`09WATCH, `5EM<>
X
X`09`09$BINTIM_S`09TIMBUF=TIMER,-`09`09; Convert delay to
X`09`09`09`09TIMADR=WAIT`09`09;  binary
X`09`09STATUS
X;+
X;`09Assign a channel to the user's terminal with an
X;`09associated mailbox.
X;-
X`09`09PUSHAL`09`09USER_MBX`09`09; Channel for user mailbox
X`09`09PUSHAL`09`09INPUT_CHAN`09`09; Channel for user term
X`09`09PUSHAL`09`09MBX_SIZE`09`09; And message size
X`09`09PUSHAL`09`09MBX_QUO`09`09`09; Quota
X`09`09PUSHAL`09`09USER_TERM`09`09; Device name
X`09`09CALLS`09`09#5,G`5ELIB$ASN_WTH_MBX`09; Assign the channel
X`09`09STATUS
X;+
X;`09Get the UCB address of the user's terminal for later checks
X;-
X`09`09$CMKRNL_S ROUTIN=GET_USER_UCB
X`09`09STATUS
X;+
X;`09Get the user terminal characteristics
X;-
X`09`09$QIOW_S`09`09CHAN=INPUT_CHAN,-
X`09`09`09`09FUNC=#IO$_SENSEMODE,-
X`09`09`09`09P1=ORIG_CHARS, P2=#12
X`09`09STATUS
X`09`09MOVQ`09`09ORIG_CHARS, TERM_CHARS`09; Copy for mods
X`09`09MOVL`09`09ORIG_CHARS+8, TERM_CHARS+8
X;+
X;`09Allocate event flags
X;-
X`09`09PUSHAL`09`09MBX_EF`09`09`09; Get the mailbox EF
X`09`09CALLS`09`09#1,G`5ELIB$GET_EF
X`09`09STATUS
X`09`09PUSHAL`09`09TERM_EF
X`09`09CALLS`09`09#1,G`5ELIB$GET_EF
X`09`09STATUS
X`09`09PUSHAL`09`09INPUT_EF
X`09`09CALLS`09`09#1,G`5ELIB$GET_EF
X`09`09STATUS
X;+
X;`09Create the data mailbox, and get it's UCB address
X;-
X`09`09$CREMBX_S`09CHAN=MBX_CHAN,-`09`09; Create the mailbox
X`09`09`09`09MAXMSG=#2048
X`09`09STATUS
X`09`09$GETDVI_S`09CHAN=MBX_CHAN,-`09`09; Get the mailbox name
X`09`09`09`09ITMLST=DVI_LIST,-
X`09`09`09`09EFN=#1
X`09`09STATUS
X`09`09$WAITFR_S`09EFN=#1
X`09`09STATUS
X`09`09MOVAL`09MBX_DESC, DESCR`09`09; Point to mailbox descriptor
X`09`09$CMKRNL_S`09ROUTIN=FIND_UCB,-
X`09`09`09`09ARGLST=NAME_ARGS
X`09`09STATUS
X`09`09MOVL`09UCB, MBX_UCB`09`09; Point to mailbox UCB
X;+
X;`09Get the name of the terminal to slave
X;+
XSTART:`09`09PUSHAL`09T_NAME`09`09`09; Return length
X`09`09PUSHAL`09WHICH`09`09`09; Prompt
X`09`09PUSHAL`09T_NAME`09`09`09; Return buffer
X`09`09CALLS`09#3, G`5ELIB$GET_FOREIGN`09; Get the terminal name
X`09`09STATUS
X`09`09MOVAL`09NAME_BUF, R0`09`09; Check for trailing colon
X10$:`09`09CMPB`09(R0), #`5EA/:/`09`09; Is it a colon?
X`09`09BEQL`0930$`09`09`09; Yup, all done
X`09`09CMPB`09(R0), #`5EA/ /`09`09; A space?
X`09`09BNEQ`0920$`09`09`09; Nope.
X`09`09MOVB`09#`5EA/:/,(R0)`09`09; Yes.. add colon.
X`09`09BRB`0930$`09`09`09; All done
X20$:`09`09INCL`09R0`09`09`09; Point to next
X`09`09BRB`0910$`09`09`09; Loop back
X;+
X;`09Uppercase the string and find the UCB
X;-
X30$:`09`09PUSHAL`09T_NAME
X`09`09PUSHAL`09T_NAME
X`09`09CALLS`09#2, G`5ESTR$UPCASE`09; Upcase it
X; Put getdvi here...
X`09`09MOVAL`09T_NAME, DESCR`09`09; Point kernel routine to arglist
X`09`09$CMKRNL_S`09ROUTIN=FIND_UCB,-; Find the device UCB
X`09`09`09`09ARGLST=NAME_ARGS
X`09`09STATUS
X`09`09MOVL`09UCB, TERM_UCB`09`09; Store UCB for it
X`09`09TSTL`09PUCB`09`09`09; Is it virtual?
X`09`09BEQL`0940$`09`09`09; Nope.
X`09`09MOVL`09PUCB, TERM_UCB`09`09; Yes, use physical
X
X40$:`09`09CALLS`09#0, G`5ESET_EXIT`09`09; Declare the exit handler
X
X`09`09CMPL`09TERM_UCB, USER_UCB`09; Same UCB address as user's?
X`09`09BNEQ`0950$`09`09`09; Branch if not
X`09`09PUSHAL`09NOT_YOUR_OWN`09`09; Push message address
X`09`09CALLS`09#1, G`5ELIB$PUT_OUTPUT`09; Display the message
X`09`09$EXIT_S`09`09`09`09; And exit
X;+
X;`09Set it to PASTHRU mode
X;-
X50$:`09`09BISL2`09`09#TT2$M_PASTHRU, TERM_CHARS+8
X`09`09$QIOW_S`09`09CHAN=INPUT_CHAN,-
X`09`09`09`09FUNC=#IO$_SETMODE,-
X`09`09`09`09P1=TERM_CHARS, P2=#12
X`09`09STATUS
X`0C
X;+
X;`09Load the magic code into nonpaged pool
X;-
X`09`09$CMKRNL_S`09ROUTIN=LOAD_CODE; Load the code and set hook
X`09`09CMPL`09R0, #SS$_IVDEVNAM`09; Legal device to watch ?
X`09`09BNEQ`0960$`09`09`09; Branch it okay so far
X`09`09PUSHAL`09NOT_SUPPORTED`09`09; Push message dsc pointer
X`09`09CALLS`09#1, G`5ELIB$PUT_OUTPUT`09; Display "non-supported" msg
X`09`09$EXIT_S`09`09`09`09; And just exit
X
X60$:`09`09STATUS
X`09`09BSBW`09SETUP_TERM_AST`09`09; Set up AST for terminal
X`09`09$SETIMR_S`09DAYTIM=WAIT,-`09; Set up the flush timer
X`09`09`09`09ASTADR=FLUSH
X`09`09STATUS
X`09`09CLRQ`09-(SP)`09`09`09; At top of screen..
X`09`09CALLS`09#2, G`5ESCR$ERASE_PAGE`09; Erase it
X`09`09STATUS
X;+
X;`09Fall thru to begin reading the mailbox.
X;-
X`0C
X`09`09.SBTTL`09MBX_READ - Read messages and echo
X;+
X;`09Read and echo the mailbox message
X;-
XMBX_READ:`09$QIOW_S`09`09EFN=MBX_EF,-`09`09; Read the mailbox
X`09`09`09`09CHAN=MBX_CHAN,-
X`09`09`09`09FUNC=#IO$_READVBLK,-
X`09`09`09`09IOSB=MBX_IOSB,-
X`09`09`09`09P1=MBX_BUF,P2=#2048
X`09`09STATUS`09`09`09`09`09; Check QIO Status
X`09`09MOVZWL`09MBX_IOSB, R0`09`09`09; Check I/O status
X`09`09STATUS
X`09`09MOVZWL`09MBX_IOSB+2, R1
X`09`09$QIOW_S`09`09EFN=TERM_EF,-`09`09; Write the text
X`09`09`09`09IOSB=TERM_IOSB,-
X`09`09`09`09CHAN=INPUT_CHAN,-
X`09`09`09`09FUNC=#IO$_WRITEVBLK,-
X`09`09`09`09P1=MBX_BUF, P2=R1
X`09`09STATUS
X`09`09MOVZWL`09TERM_IOSB, R0
X`09`09STATUS
X`09`09BRW`09MBX_READ`09`09`09; Read another
X`0C
X;+
X; Get the user's UCB address
X;-
X`09`09.ENTRY GET_USER_UCB`5EM<R2>
X`09`09MOVL`09INPUT_CHAN, R0`09`09; Get channel number
X`09`09JSB`09G`5EIOC$VERIFYCHAN`09; Get UCB address
X`09`09BLBC`09R0, 10$`09`09`09; Branch on error
X`09`09MOVL`09CCB$L_UCB(R1), R2`09; Get the UCB address
X`09`09MOVL`09UCB$L_TL_PHYUCB(R2),USER_UCB ; Get the physical ucb
X10$:`09`09RET
X
X`0C
X;+
X;`09Exit handler setup
X;-
X`09`09.ENTRY`09SET_EXIT,`5EM<>
X`09`09$DCLEXH_S`09DESBLK=EXIT_BLOCK ; Declare exit handler
X`09`09RET`09`09
X`0C
X`09`09.SBTTL`09EXIT_HANDLER, Exit reset handler
X`09`09.ENTRY`09EXIT_HANDLER,`5EM<>
X`09`09$QIOW_S`09`09CHAN=INPUT_CHAN,-`09; Reset the term
X`09`09`09`09FUNC=#IO$_SETMODE,-
X`09`09`09`09P1=ORIG_CHARS,-
X`09`09`09`09P2=#12
X`09`09$QIOW_S`09`09EFN=TERM_EF,-`09`09; Write the text
X`09`09`09`09CHAN=INPUT_CHAN,-
X`09`09`09`09FUNC=#IO$_WRITEVBLK,-
X`09`09`09`09P1=EXIT_MESSAGE, P2=#EXIT_SIZE
X`09`09MOVL`09CODE_PTR, R0
X`09`09BEQL`0910$
X`09`09MOVAL`09RESET-KERNEL_CODE(R0), R0
X`09`09$CMKRNL_S`09ROUTIN=(R0)`09`09; Call fixup
X`09`09BLBC`09R0, 20$
X`09`09$CMKRNL_S`09ROUTIN=FREE_POOL`09; Free pool
X`09`09BLBC`09R0, 20$
X10$:`09`09MOVL`09#SS$_NORMAL, R0
X20$:`09`09RET
XEXIT_MESSAGE:`09.ASCII`09/Exiting.../
XEXIT_SIZE = .-EXIT_MESSAGE
X`0C
X`09`09.SBTTL`09FLUSH - Flush the ring
X`09`09.ENTRY`09FLUSH, `5EM<>
X`09`09$SETIMR_S`09DAYTIM=WAIT,-
X`09`09`09`09ASTADR=FLUSH
X`09`09STATUS
X`09`09MOVL`09CODE_PTR, R0
X`09`09MOVAL`09FLUSH_RING-KERNEL_CODE(R0), R0
X`09`09$CMKRNL_S`09ROUTIN=(R0)`09`09; Call the flusher
X`09`09STATUS
X`09`09RET
X`0C
X`09`09.SBTTL`09FIND_UCB - Locate the device UCB
X;
X;`09This routine finds the address of the UCB for a specified
X;`09device.
X;
X;`09Arguments:
X;`09DESCR`09Address of device name descriptor
X;`09UCB`09Return pointer to `5Bvirtual`5D UCB
X;`09PUCB`09Return pointer to `5Bphysical`5D UCB, zero if none.
X;
X;`09This routine executes in Kernel mode at elevated IPL
X;
X`09`09.ENTRY`09FIND_UCB,`5EM<R2,R3,R4,R5>
X`09`09CLRQ`098(AP)`09`09`09; Clear UCB pointers
X`09`09MOVL`09G`5Ectl$GL_PCB, R4`09; Get current PCB pointer
X`09`09JSB`09G`5ESCH$IOLOCKR`09`09; Lock I/O database for read
X`09`09MOVL`094(AP), R1`09`09; Point to device descr
X`09`09JSB`09G`5EIOC$SEARCHDEV`09`09; Search for device
X`09`09BLBC`09R0, 10$`09`09`09; Exit on failure
X`09`09MOVL`09UCB$L_TL_PHYUCB(R1),12(AP) ; Return physical UCB
X`09`09MOVL`09R1, 8(AP)`09`09; Return UCB
X`09`09BBC`09#DEV$V_DET, UCB$L_DEVCHAR2(R1),-
X`09`09`0910$`09`09`09; Skip if not detached
X`09`09MOVL`09#SS$_DEVOFFLINE, R0`09; Say it's offline
X10$:`09`09PUSHL`09R0`09`09`09; Save status
X`09`09JSB`09G`5ESCH$IOUNLOCK`09`09; Unlock the I/O database
X`09`09POPL`09R0
X`09`09RET`09`09`09`09; And return
X`0C
X`09`09.SBTTL`09LOAD_CODE - Load hook code into pool
X
X`09`09.ENTRY`09LOAD_CODE,`5EM<R2,R3,R4,R5>
X`09`09DSBINT`09#IPL$_ASTDEL`09`09; Stop ast delivery
X`09`09MOVL`09#KERN_SIZE, R1`09`09; Size of pool to get
X`09`09JSB`09G`5EEXE$ALONONPAGED`09; Get the pool
X`09`09BLBS`09R0, 10$`09`09`09; Skip if OK
X`09`09ENBINT
X`09`09RET`09`09`09`09; Can't get it!
X10$:`09`09MOVW`09R1, CODE_SIZE`09`09; Store size
X`09`09MOVL`09R2, CODE_PTR`09`09; Store pointer
X`09`09MOVC3`09#KERN_SIZE,-
X`09`09`09KERNEL_CODE,-
X`09`09`09(R2)`09`09`09; Store the code in the block
X`09`09MOVL`09CODE_PTR, R0`09`09; Point to code block
X`09`09MOVAL`09SETUP-KERNEL_CODE(R0), R0 ; Get SETUP address
X`09`09JSB`09(R0)`09`09`09; Go to it
X`09`09ENBINT
X`09`09RET
X`0C
X`09`09.SBTTL SETUP_TERM_AST - Setup the terminal mailbox AST
XSETUP_TERM_AST:`09$QIOW_S`09CHAN=USER_MBX,-`09`09; Using user's terminal mai
Vlbox
X`09`09`09FUNC=#IO$_SETMODE!IO$M_WRTATTN,- ; Write attention AST
X`09`09`09P1=TERM_AST`09`09; AST routine
X`09`09STATUS
X`09`09RSB
X
X`09`09.ENTRY`09TERM_AST, `5EM<R2,R3>
X`09`09$QIOW_S`09`09CHAN=USER_MBX,-
X`09`09`09`09IOSB=USER_IOSB,-
X`09`09`09`09FUNC=#IO$_READVBLK,-
X`09`09`09`09P1=INPUT_MBX_BUF,P2=#512
X`09`09STATUS
XLOOP:`09`09$QIOW_S`09CHAN=INPUT_CHAN,-
X`09`09`09EFN=INPUT_EF,-
X`09`09`09FUNC=#IO$_READVBLK!IO$M_TIMED!IO$M_NOECHO,-
X`09`09`09IOSB=INPUT_IOSB,-
X`09`09`09P1=INPUT_BUF,-
X`09`09`09P2=#80,-
X`09`09`09P3=#0`09`09`09; Zero second timeout
X`09`09STATUS
X`09`09MOVZWL`09INPUT_IOSB, R0`09`09; Check status
X`09`09CMPW`09R0, #SS$_TIMEOUT`09; Timed out?
X`09`09BEQL`0910$`09`09`09; Yup, that's OK.
X`09`09STATUS
X10$:`09`09MOVW`09INPUT_IOSB+2, R2`09; Get offset to terminator
X`09`09ADDW`09INPUT_IOSB+6, R2`09; Plus terminator size
X`09`09BNEQ`0920$`09`09`09; Something there
X`09`09BSBW`09SETUP_TERM_AST`09`09; Reset the AST
X`09`09RET`09`09`09`09; Nothing there
X20$:`09`09MOVZWL`09R2, R2`09`09`09; Extend to word
X`09`09MOVAL`09INPUT_BUF, R3`09`09; And buffer pointer
X30$:`09`09MOVZBL`09(R3)+, SEND_CHAR`09; Get character
X;`09`09BRB`0960$
X`09`09CMPB`09SEND_CHAR,#`5EA/\/-`5EA/@/`09; `5E\?
X`09`09BNEQ`0950$`09`09`09; Not the flag char
X`09`09BLBS`09FLAGS, 40$`09`09; If was set, clear it
X`09`09BISB`09#1, FLAGS`09`09; Set the flag
X`09`09PUSHAL`09ENABLED`09`09`09; Say input is enabled
X`09`09CALLS`09#1,G`5ELIB$PUT_OUTPUT
X`09`09BRB`0960$`09`09`09; Try next char
X40$:`09`09BICB`09#1, FLAGS`09`09; Clear the input flag
X`09`09PUSHAL`09DISABLED
X`09`09CALLS`09#1,G`5ELIB$PUT_OUTPUT`09; Say input disabled
X50$:`09`09BLBC`09FLAGS, 60$`09`09; Input mode disabled
X`09`09$CMKRNL_S`09ROUTIN=SEND_ONE,ARGLST=SEND_ARGS
X`09`09STATUS
X`09`09BRB`0970$`09`09`09; Done character
X60$:`09`09CMPB`09SEND_CHAR,#`5EA/Z/-`5EA/@/`09; Control-Z?
X`09`09BNEQ`0970$`09`09`09; Nope, ignore it.
X`09`09$EXIT_S`09#SS$_NORMAL`09`09; Exit now.
X70$:`09`09SOBGTR`09R2, 30$`09`09`09; Loop back
X`09`09BRW`09LOOP`09`09`09; Any more input?
X80$:`09`09RET
X`0C
X`09`09.SBTTL`09SEND_ONE - Send a character to user terminal
X`09`09.ENTRY`09SEND_ONE, `5EM<R2, R3, R4, R5>
X`09`09MOVL`09CODE_PTR, R0`09`09; Point to code block
X`09`09MOVAL`09SEND_IT-KERNEL_CODE(R0), R0 ; Get SEND CHARACTER address
X`09`09JSB`09(R0)`09`09`09; Call it
X`09`09RET
X`0C
X`09`09.SBTTL`09KERNEL_CODE
X`09`09.PSECT`09LOADED`09RD, WRT, PIC, NOSHR, EXE, PAGE
XKERNEL_CODE:
XFKB_LIST:`09.BLKQ`091`09`09`09; Fork block list
XCODE_SIZE:`09.BLKW`091`09`09`09; Size
X`09`09.WORD`09DYN$C_FRK`09`09; Type
XCODE_PTR:`09.LONG`090`09`09`09; Pointer to loaded code
XTERM_UCB:`09.LONG`090`09`09`09; Terminal UCB
XMBX_UCB:`09.LONG`090`09`09`09; Mailbox UCB
XPORT_TABLE:`09.BLKB`09PORT_LENGTH`09`09; Copied/munged port vector
XCLASS_LENGTH = CLASSS_CLASS_DEF`09`09`09; Hack since it's not there..
XCLASS_TABLE:`09.BLKB`09CLASS_LENGTH`09`09; Copied/munged class vector
XPORT_START_VEC:`09.LONG`090`09`09`09; Gets original UCB PORT STARTIO
XPORT_DS_VEC:`09.LONG`090`09`09`09; Gets original UCB PORT modem`20
XCLASS_GETNXT_VEC:.LONG`090`09`09`09; Gets original UCB Class GETNXT
XCLASS_PUTNXT_VEC:.LONG`090`09`09`09; ... class driver put char
XCLASS_DS_VEC:`09.LONG`090`09`09`09; ... class driver dataset trans
XPORT_DIS_VEC:`09.LONG`090`09`09`09; ... port driver disconnect
XCLASS_DIS_VEC:`09.LONG`090`09`09`09; ... class driver disconnect
XSAVED_PORT:`09.LONG`090`09`09`09; Saved port driver pointer
XSAVED_CLASS:`09.LONG`090`09`09`09; Saved class driver pointer
X`09`09.ALIGN`09QUAD
XFKB_COUNT = 20
XFKB_1:
X`09`09.REPT`0940
X`09`09.BLKQ`091`09`09`09; Flink/Blink
X`09`09.WORD`09FKB$K_LENGTH`09`09; Size
X`09`09.BYTE`09DYN$C_FRK`09`09; Type
X`09`09.BYTE`096`09`09`09; Fork IPL
X`09`09.BLKL`093`09`09`09; FPC/FR3/FR4
X`09`09.ENDR
XRING_SIZE = 1024`09`09`09`09; Size of buffer
XBUF_2:`09`09.BLKB`09RING_SIZE`09`09; Fork level buffer
XRING_BUFFER:`09.BLKB`09RING_SIZE`09`09; Buffer for mailbox
XRING_PTR:`09.BLKL`091`09`09`09; Pointer to data storage
XRING_FREE:`09.LONG`09RING_SIZE`09`09; Free in mailbox
XWRITE_SIZE:`09.BLKL`091`09`09`09; Characters in alt buffer
X`0C
X`09`09.SBTTL`09SETUP - Set up hook
XSETUP:`09`09MOVAL`09RING_BUFFER, RING_PTR`09; Set up pointer to buffer
X`09`09MOVAL`09FKB_LIST, FKB_LIST`09; Set up queue header
X`09`09MOVL`09FKB_LIST, FKB_LIST+4
X`09`09MOVAL`09FKB_1, R0`09`09; Set up FKB queue
X`09`09MOVL`09#FKB_COUNT, R1`09`09; Number of fork blocks
X10$:`09`09INSQUE`09(R0), @FKB_LIST+4`09; Insert onto queue at tail
X`09`09MOVAL`09FKB$K_LENGTH(R0), R0`09; Point to next
X`09`09SOBGTR`09R1, 10$`09`09`09; Do next
X
X`09`09MOVL`09TERM_UCB, R2`09`09; Get UCB pointer
X`09`09MOVL`09UCB$L_TT_PORT(R2), R0`09; Point to port vectors
X`09`09MOVL`09R0, SAVED_PORT`09`09; Save port vector pointer
X`09`09BLSS`0920$`09`09`09; Branch if legal system VA
X`09`09MOVL`09#SS$_IVDEVNAM, R0`09; Indicate an invalid device
X`09`09RSB`09`09`09`09; And return
X
X20$:`09`09MOVAL`09PORT_TABLE, R1`09`09; Point to internal table
X`09`09PUSHR`09#`5EM<R0,R1,R2,R3,R4,R5>`09; Save across MOVC
X`09`09MOVC3`09#PORT_LENGTH, (R0),(R1)`09; Copy port vector to internal
X`09`09POPR`09#`5EM<R0,R1,R2,R3,R4,R5>
X`09`09MOVL`09PORT_STARTIO(R1),-`09;
X`09`09`09PORT_START_VEC`09`09; Save old port startio
X`09`09MOVAL`09GRAB_STARTIO,-`09`09;
X`09`09`09PORT_STARTIO(R1)`09; Point to hook code
X`09`09MOVL`09PORT_DS_SET(R0),-`09;
X`09`09`09PORT_DS_VEC`09`09; Save old port dataset vector
X`09`09MOVAL`09GRAB_PORT_DS,-`09`09;
X`09`09`09PORT_DS_SET(R1)`09`09; Set new dataset transition
X`09`09MOVL`09PORT_DISCONNECT(R0),-`09; Save old port disconnect
X`09`09`09PORT_DIS_VEC`09`09;
X`09`09MOVAL`09GRAB_PORT_DIS,-`09`09;
X`09`09`09PORT_DISCONNECT(R1)`09;
X`09`09MOVL`09UCB$L_TT_CLASS(R2), R0`09; Point to class vectors
X`09`09MOVL`09R0, SAVED_CLASS`09`09; Save class table pointer
X`09`09BLSS`0930$`09`09`09; Branch if legal system VA
X`09`09MOVL`09#SS$_IVDEVNAM, R0`09; Indicate an invalid device
X`09`09RSB`09`09`09`09; And return
X
X30$:`09`09MOVAL`09CLASS_TABLE, R1`09`09; Point to saved table
X`09`09PUSHR`09#`5EM<R0,R1,R2,R3,R4,R5>`09; Save registers
X`09`09MOVC3`09#CLASS_LENGTH, (R0),(R1); Copy class vector
X`09`09POPR`09#`5EM<R0,R1,R2,R3,R4,R5>`09; Restore regs
X`09`09MOVL`09CLASS_GETNXT(R0),-`09; Save original getnxt vector
X`09`09`09CLASS_GETNXT_VEC`09;
X`09`09MOVAL`09GRAB_GETNXT,-`09`09;
X`09`09`09CLASS_GETNXT(R1)`09; Point to hook code
X`09DEVICELOCK -`09`09`09`09; lock the device
X`09`09LOCKADDR=UCB$L_DLCK(R2),-
X`09`09SAVIPL=-(SP)
X
X`09`09MOVAL`09GRAB_GETNXT,-`09`09; Plus point UCB
X`09`09`09UCB$L_TT_GETNXT(R2)`09;
X`09`09MOVL`09CLASS_PUTNXT(R0),-
X`09`09`09CLASS_PUTNXT_VEC`09; Save original PUTNXT vector
X`09`09MOVAL`09GRAB_PUTNXT,-`09`09; Set up copied class vector
X`09`09`09CLASS_PUTNXT(R1)
X`09`09MOVAL`09GRAB_PUTNXT,-`09`09; Plus device UCB
X`09`09`09UCB$L_TT_PUTNXT(R2)
X`09DEVICEUNLOCK -
X`09`09LOCKADDR=UCB$L_DLCK(R2),-
X`09`09NEWIPL=(SP)+,-
X`09`09CONDITION=RESTORE,-
X`09`09PRESERVE=YES
X`09`09MOVL`09CLASS_DS_TRAN(R0),-`09; Save original dataset trans
X`09`09`09CLASS_DS_VEC`09`09;
X`09`09MOVAL`09GRAB_CLASS_DS,-`09`09; Point to hook code
X`09`09`09CLASS_DS_TRAN(R1)`09;
X`09`09MOVL`09CLASS_DISCONNECT(R0),-`09; Save class disconect
X`09`09`09CLASS_DIS_VEC`09`09;
X`09`09MOVAL`09GRAB_CLASS_DIS,-`09; Point to hook code
X`09`09`09CLASS_DISCONNECT(R1)`09;
X`09DEVICELOCK -
X`09`09LOCKADDR=UCB$L_DLCK(R2),-
X`09`09SAVIPL=-(SP)
X`09`09MOVAL`09CLASS_TABLE,-`09`09;;; Point UCB to my class
X`09`09`09UCB$L_TT_CLASS(R2)`09;;;   table copy
X`09`09MOVAL`09PORT_TABLE,-`09`09;;; Plus point to my port
X`09`09`09UCB$L_TT_PORT(R2)`09;;;   table copy
X`09DEVICEUNLOCK -
X`09`09LOCKADDR=UCB$L_DLCK(R2),-
X`09`09NEWIPL=(SP)+,-
X`09`09CONDITION=RESTORE,-
X`09`09PRESERVE=YES
X`09`09MOVZBL`09#SS$_NORMAL, R0`09`09; Set normal status
X`09`09RSB`09`09`09`09; All done
X`0C
X`09`09.SBTTL`09GRAB_CLASS_DS - Hook to notice dataset hangups
XGRAB_CLASS_DS:`09BSBB`09RESET_IT`09`09;;; Remove hooks
X`09`09JMP`09@CLASS_DS_VEC`09`09;;; Call the class driver
X
X`09`09.SBTTL`09GRAB_PORT_DS - Hook to notice dataset hangups
XGRAB_PORT_DS:`09BSBB`09RESET_IT`09`09;;; Remove hooks
X`09`09JMP`09@PORT_DS_VEC`09`09;;; Call the port driver
X
X`09`09.SBTTL`09GRAB_PORT_DIS - Hook to notice disconnects
XGRAB_PORT_DIS:`09BSBB`09RESET_IT`09`09;;; Reset device
X`09`09JMP`09@PORT_DIS_VEC`09`09;;; Call port driver
X
X`09`09.SBTTL`09GRAB_CLASS_DIS - Hook to notice disconnects
XGRAB_CLASS_DIS:`09BSBB`09RESET_IT`09`09;;; Reset device
X`09`09JMP`09@CLASS_DIS_VEC`09`09;;; Call class driver
X
XRESET_IT:`09MOVQ`09R0, -(SP)`09`09;;; Save registers
X`09`09CALLS`09#0, RESET`09`09;;; Reset terminal
X`09`09MOVQ`09(SP)+, R0`09`09;;; Restore...
X`09`09RSB`09`09`09`09;;; And return
X`0C
X`09`09.SBTTL`09GRAB_STARTIO - Hook to send data to mbx
X;+
X;`09This routine is called at device IPL to send
X;`09the data to the port driver. The value in R3 contains
X;`09the data; either a character or a pointer to a burst string.
X;`09(r2 contains the size.) An IPL 6 fork is created to send the data
X;`09to the mailbox.
X;-
XGRAB_STARTIO:`09TSTL`09R3`09`09`09;;; Any work to do?
X`09`09BEQL`0910$`09`09`09;;; Nope, tell the startio.
X`09`09PUSHR`09#`5EM<R0,R1,R2,R3,R4,R5>`09;;; Store volatile regs
X`09`09BSBB`09GET_DATA`09`09;;; Get terminal data
X`09`09POPR`09#`5EM<R0,R1,R2,R3,R4,R5>`09;;; Restore registers
X`09`09TSTL`09R3`09`09`09;;; Reset condition codes
X10$:`09`09JMP`09@PORT_START_VEC`09`09;;; Call port routine
X`0C
X`09`09.SBTTL`09GRAB_GETNXT - Hook to send data to mbx
X;+
X;`09This routine is called at device IPL to send
X;`09the data to the port driver. The value in R3 contains
X;`09the data; either a character or a pointer to a burst string.
X;`09(r2 contains the size.) An IPL 6 fork is created to send the data
X;`09to the mailbox.
X;-
X`09`09.ENABLE LSB
XGRAB_GETNXT:`09JSB`09@CLASS_GETNXT_VEC`09;;; Call the class driver
X10$:`09`09TSTB`09UCB$B_TT_OUTYPE(R5)`09;;; Any work to do?
X`09`09BEQL`0920$`09`09`09;;; Nope.
X`09`09PUSHR`09#`5EM<R0,R1,R2,R3,R4,R5>`09;;; Store volatile regs
X`09`09BSBB`09GET_DATA`09`09;;; Check for data type...
X`09`09POPR`09#`5EM<R0,R1,R2,R3,R4,R5>`09;;; Restore regs
X`09`09TSTB`09UCB$B_TT_OUTYPE(R5)`09;;; Reset cond codes
X20$:`09`09RSB`09`09`09`09;;; Return to caller
X`0C
X`09`09.SBTTL`09GRAB_PUTNXT
X;+
X;`09This routine is used to grab echoes of input characters
X;-
XGRAB_PUTNXT:`09JSB`09@CLASS_PUTNXT_VEC`09;;; Call the class driver
X`09`09BRB`0910$`09`09`09;;; Common code.
X`09`09.DISABLE LSB
X`0C
X`09`09.SBTTL GET_DATA - Copy the output data to the buffer
X;+
X;`09This routine copies the output data to the buffer.
X;`09When the buffer is full, DUMP_BUFFER is called
X;`09to output it to the mailbox.
X;-
XGET_DATA:`09TSTL`09R3`09`09`09;;; Character or pointer?
X`09`09BLSS`0920$`09`09`09;;; Pointer
X`09`09MOVB`09R3, @RING_PTR`09`09;;; Copy to buffer
X`09`09INCL`09RING_PTR`09`09;;; And bump it
X`09`09DECL`09RING_FREE`09`09;;; Less this much free
X`09`09BGTR`0910$`09`09`09;;; Still room left
X`09`09BSBW`09DUMP_BUFFER`09`09;;; Dump the buffer
X10$:`09`09RSB`09`09`09`09;;; Done sending message
X;
X;`09Handle multi-byte messages
X;
X20$:`09`09MOVZWL`09R2, R2`09`09`09;;; Size of message
X`09`09CMPL`09R2, #RING_SIZE`09`09;;; Is it too big?
X`09`09BLSS`0930$`09`09`09;;; Skip if not
X`09`09MOVL`09#RING_SIZE, R2`09`09;;; Limit to this size
X30$:`09`09CMPL`09R2, RING_FREE`09`09;;; Room for this one?
X`09`09BLEQ`0940$`09`09`09;;; Yup, add it in.
X`09`09MOVQ`09R2,-(SP)`09`09;;; Save R2 and R3
X`09`09BSBW`09DUMP_BUFFER`09`09;;; First, dump the buffer
X`09`09MOVQ`09(SP)+, R2`09`09;;; Restore R2 and R3
X40$:`09`09PUSHR`09#`5EM<R0,R1,R2,R3,R4,R5>`09;;; Store registers
X`09`09MOVC3`09R2, (R3), @RING_PTR`09;;; Move to buffer
X`09`09POPR`09#`5EM<R0,R1,R2,R3,R4,R5>`09;;; Restore registers
X`09`09ADDL`09R2, RING_PTR`09`09;;; Point to next byte
X`09`09SUBL`09R2, RING_FREE`09`09;;; Drop free counter
X`09`09RSB
X`0C
X`09`09.SBTTL DUMP_BUFFER - Dump buffer to mailbox
X;+
X;`09Routine to write the buffer to the mailbox.
X;`09First calls EXE$FORK to wait for IPL 6 interrupt;
X;`09Returns to caller to proceed until IPL drops.
X;`09Fork routine takes the text and writes it to the mailbox.
X;-
XDUMP_BUFFER:`09SUBL3`09RING_FREE, #RING_SIZE,-`09;;; Free-original gives..
X`09`09`09WRITE_SIZE`09`09;;;  Size to move
X`09`09MOVAL`09RING_BUFFER, RING_PTR`09;;; Reset pointer
X`09`09MOVL`09#RING_SIZE,RING_FREE`09;;; And free
X`09`09TSTL`09WRITE_SIZE`09`09;;; Anything to write?
X`09`09BLEQ`0910$`09`09`09;;; Nothing to do
X`09`09REMQUE`09@FKB_LIST, R5`09`09;;; Get a FKB to use
X`09`09BVS`0910$`09`09`09;;; No entry to get
X`09`09PUSHR`09#`5EM<R0,R1,R2,R3,R4,R5>`09;;; Save regs cross MOVC
X`09`09MOVC3`09WRITE_SIZE, RING_BUFFER,-;;; Move # calculated from buffer
X`09`09`09BUF_2`09`09`09;;; Move to mailbox write buffer
X`09`09POPR`09#`5EM<R0,R1,R2,R3,R4,R5>`09;;; Restore regs
X`09`09JSB`09G`5EEXE$FORK`09`09;;; Fork down
X`09`09`09`09`09`09;;; Return to caller at DIPL
X;+
X;`09Following executed at FIPL (IPL 6) whenever things get
X;`09around to it
X;-
X`09`09PUSHR`09#`5EM<R0,R1,R2,R3,R4,R5>`09; Save registers
X`09`09MOVAL`09BUF_2, R4`09`09; Address of buffer
X`09`09MOVL`09WRITE_SIZE, R3`09`09; Size of buffer
X`09`09MOVL`09MBX_UCB, R5`09`09; Get UCB Pointer
X`09`09JSB`09G`5EEXE$WRTMAILBOX`09; Write to mailbox
X`09`09POPR`09#`5EM<R0,R1,R2,R3,R4,R5>`09; Restore registers
X`09`09INSQUE`09(R5), @FKB_LIST+4`09; Insert back onto queue
X10$:`09`09RSB`09`09`09`09; All done
X`0C`09`09.SBTTL`09RESET - Reset terminal UCB
X`09`09.ENTRY`09RESET,`5EM<R2>
X`09`09MOVL`09TERM_UCB, R2`09`09; Point to terminal UCB
X`09`09BEQL`0910$`09`09`09; Skip if UCB gone
X`09DEVICELOCK -
X`09`09LOCKADDR=UCB$L_DLCK(R2),-
X`09`09SAVIPL=-(SP)
X`09`09TSTL`09SAVED_PORT`09`09;;; Is there a saved port vector
X`09`09BEQL`091$`09`09`09;;; Skip if not there
X`09`09MOVL`09SAVED_PORT,-`09`09;;; Restore port pointer
X`09`09`09UCB$L_TT_PORT(R2)`09;;;   back to driver
X1$:`09`09TSTL`09SAVED_CLASS`09`09;;; Test saved class address
X`09`09BEQL`092$`09`09`09;;; Skip null restores
X`09`09MOVL`09SAVED_CLASS,-`09`09;;; Restore class pointer
X`09`09`09UCB$L_TT_CLASS(R2)`09;;;   back to driver
X2$:`09`09TSTL`09CLASS_GETNXT_VEC`09;;; Test for null
X`09`09BEQL`093$`09`09`09;;; Skip nulls
X`09`09MOVL`09CLASS_GETNXT_VEC,-`09;;; Restore UCB
X`09`09`09UCB$L_TT_GETNXT(R2)`09;;;  getnxt pointer
X3$:`09`09TSTL`09CLASS_PUTNXT_VEC`09;;; Test for null
X`09`09BEQL`094$`09`09`09;;; Skip if null
X`09`09MOVL`09CLASS_PUTNXT_VEC,-`09;;;  putnxt pointer
X`09`09`09UCB$L_TT_PUTNXT(R2)`09;;;
X4$:`09`09
X`09DEVICEUNLOCK -
X`09`09LOCKADDR=UCB$L_DLCK(R2),-
X`09`09NEWIPL=(SP)+,-
X`09`09CONDITION=RESTORE,-
X`09`09PRESERVE=YES
X
X`09`09CLRL`09TERM_UCB`09`09; Clear UCB pointer
X`09`09MOVL`09#SS$_NORMAL, R0`09`09; All OK!
X10$:`09`09RET`09`09`09`09; All done so far
X`0C
X`09`09.SBTTL`09FREE_POOL - Free nonpaged pool block
X`09`09.ENTRY`09FREE_POOL,`5EM<R2,R3>
X`09`09DSBINT`09#IPL$_ASTDEL`09`09; Lock out delivery of asts
X`09`09MOVL`09CODE_PTR, R0`09`09; Point to code
X`09`09JSB`09G`5EEXE$DEANONPAGED`09; Deallocate it
X`09`09ENBINT
X`09`09RET`09`09
X`0C
X`09`09.SBTTL FLUSH_RING - Kernel routine to flush ring buffer
X`09`09.ENTRY`09FLUSH_RING, `5EM<R2,R3,R4,R5>
X`09`09MOVL`09#SS$_HANGUP, R0`09`09; Assume hung up
X`09`09TSTL`09TERM_UCB`09`09; UCB There?
X`09`09BEQL`0910$`09`09`09; Nope, quit now.
X`09`09DSBINT`09#21`09`09`09;; Lock down interrupts
X`09`09BSBW`09DUMP_BUFFER`09`09;;; Dump the buffer
X`09`09ENBINT`09`09`09`09;;; Re-enable interrupts
X`09`09MOVL`09#SS$_NORMAL, R0`09`09; It's OK...
X10$:`09`09RET`09`09`09`09; And return
X`0C
X`09`09.SBTTL`09SEND_IT - Send a character routine
XSEND_IT:`09MOVL`09#SS$_HANGUP, R0`09`09; Assume hung up
X`09`09MOVL`09TERM_UCB, R5`09`09; Get UCB pointer
X`09`09BEQL`0930$`09`09`09; Quit if none
X`09`09MOVL`094(AP), R3`09`09; Get character
X`09DEVICELOCK -
X`09`09LOCKADDR=UCB$L_DLCK(R5),-
X`09`09SAVIPL=-(SP)
X`09`09JSB`09@CLASS_PUTNXT_VEC`09;;; Call putnext routine
X`09`09TSTB`09UCB$B_TT_OUTYPE(R5)`09;;; Check output type
X`09`09BEQL`0910$`09`09`09;;; None to do
X`09`09BSBW`09GRAB_STARTIO`09`09;;; Call the start I/O routine
X10$:`09`09
X`09DEVICEUNLOCK -
X`09`09LOCKADDR=UCB$L_DLCK(R5),-
X`09`09NEWIPL=(SP)+,-
X`09`09CONDITION=RESTORE,-
X`09`09PRESERVE=YES
X
X`09`09MOVL`09#SS$_NORMAL, R0`09`09; Normal exit
X30$:`09`09RSB`09`09`09`09; Done!
X
X`09`09KERN_SIZE = .-KERNEL_CODE`09; Size of code to load
X`09`09.END`09WATCH
$ CALL UNPACK WATCH.MAR;1 239612267
$ v=f$verify(v)
$ EXIT
