From: CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 1-AUG-1989 10:57 To: MRGATE::"ARISIA::EVERHART" Subj: VMS V4 Watch Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Tue, 1 AUG 89 07:18:57 PDT Received: from RELAY.CS.NET by KL.SRI.COM with TCP; Tue, 1 Aug 89 07:08:30 PDT Received: from crdgw1.ge.com by RELAY.CS.NET id aa16910; 1 Aug 89 10:06 EDT Received: by crdgw1.ge.com (5.57/Ultrix 3.0 (1.49)) id AA27871; Tue, 1 Aug 89 10:06:34 EDT Message-Id: <8908011406.AA27871@crdgw1.ge.com> Date: 1 Aug 89 10:02 EST From: FTH05%ESDSDF.DECNET@crdgw1 Subject: VMS V4 Watch To: INFO-VAX%KL.SRI.COM@RELAY.CS.NET ;In response to the request for a version of WATCH for VMS V4.x, ; here it is... .TITLE WATCH - Watch terminal output stream .LIBRARY /TTYDEF/ .LIBRARY /SYS$LIBRARY:LIB/ $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 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/ .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 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 CALLS #3, G^LIB$GET_FOREIGN ; Get the terminal name STATUS MOVAL NAME_BUF, R0 ; Check for trailing colon ; Disallow terminal name beginning with R (rtan:) ; Watching rt units crashes VMS CMPB (R0),#^A/R/ ; Terminal name start with R? BNEQ 10$ ; If first char not R then ok RET ; 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 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 ;+ ; Set it to PASTHRU mode ;- 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 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 ;+ ; 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 CLRQ 8(AP) ; Clear UCB pointers MOVL G^SCH$GL_CURPCB, 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 DSBINT #IPL$_ASTDEL ; Stop process deletion 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 MOVL #SS$_NORMAL, R0 ; OK So far 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 $QIOW_S CHAN=USER_MBX,- IOSB=USER_IOSB,- FUNC=#IO$_READVBLK,- P1=INPUT_MBX_BUF,P2=#512 STATUS LOOP: $QIOW_S CHAN=INPUT_CHAN,- EFN=INPUT_EF,- FUNC=#IO$_READVBLK!IO$M_TIMED!IO$M_NOECHO,- IOSB=INPUT_IOSB,- P1=INPUT_BUF,- P2=#80,- P3=#0 ; Zero second timeout STATUS MOVZWL INPUT_IOSB, R0 ; Check status CMPW R0, #SS$_TIMEOUT ; Timed out? BEQL 10$ ; Yup, that's OK. STATUS 10$: MOVW INPUT_IOSB+2, R2 ; Get offset to terminator ADDW INPUT_IOSB+6, R2 ; Plus terminator size BNEQ 20$ ; Something there BSBW SETUP_TERM_AST ; Reset the AST RET ; Nothing there 20$: MOVZWL R2, R2 ; Extend to word MOVAL INPUT_BUF, R3 ; And buffer pointer 30$: MOVZBL (R3)+, SEND_CHAR ; Get character CMPB SEND_CHAR,#^A/\/-^A/@/ ; ^\? BNEQ 50$ ; Not the flag char BLBS FLAGS, 40$ ; If was set, clear it BISB #1, FLAGS ; Set the flag PUSHAL ENABLED ; Say input is enabled CALLS #1,G^LIB$PUT_OUTPUT BRB 60$ ; Try next char 40$: BICB #1, FLAGS ; Clear the input flag PUSHAL DISABLED CALLS #1,G^LIB$PUT_OUTPUT ; Say input disabled 50$: BLBC FLAGS, 60$ ; Input mode disabled $CMKRNL_S ROUTIN=SEND_ONE,ARGLST=SEND_ARGS STATUS BRB 70$ ; Done character 60$: CMPB SEND_CHAR,#^A/Z/-^A/@/ ; Control-Z? BNEQ 70$ ; Nope, ignore it. $EXIT_S #SS$_NORMAL ; Exit now. 70$: SOBGTR R2, 30$ ; Loop back BRW LOOP ; Any more input? 80$: RET .SBTTL SEND_ONE - Send a character to user terminal .ENTRY SEND_ONE, ^M MOVL CODE_PTR, R0 ; Point to code block MOVAL SEND_IT-KERNEL_CODE(R0), R0 ; Get SEND CHARACTER address JSB (R0) ; Call it RET .SBTTL KERNEL_CODE .PSECT LOADED RD, WRT, PIC, NOSHR, EXE, PAGE KERNEL_CODE: FKB_LIST: .BLKQ 1 ; Fork block list CODE_SIZE: .BLKW 1 ; Size .WORD DYN$C_FRK ; Type CODE_PTR: .LONG 0 ; Pointer to loaded code TERM_UCB: .LONG 0 ; Terminal UCB MBX_UCB: .LONG 0 ; Mailbox UCB PORT_TABLE: .BLKB PORT_LENGTH ; Copied/munged port vector CLASS_LENGTH = CLASSS_CLASS_DEF ; Hack since it's not there.. CLASS_TABLE: .BLKB CLASS_LENGTH ; Copied/munged class vector PORT_START_VEC: .LONG 0 ; Gets original UCB PORT STARTIO PORT_DS_VEC: .LONG 0 ; Gets original UCB PORT modem CLASS_GETNXT_VEC:.LONG 0 ; Gets original UCB Class GETNXT CLASS_PUTNXT_VEC:.LONG 0 ; ... class driver put char CLASS_DS_VEC: .LONG 0 ; ... class driver dataset trans PORT_DIS_VEC: .LONG 0 ; ... port driver disconnect CLASS_DIS_VEC: .LONG 0 ; ... class driver disconnect SAVED_PORT: .LONG 0 ; Saved port driver pointer SAVED_CLASS: .LONG 0 ; Saved class driver pointer .ALIGN QUAD FKB_COUNT = 20 FKB_1: .REPT 40 .BLKQ 1 ; Flink/Blink .WORD FKB$K_LENGTH ; Size .BYTE DYN$C_FRK ; Type .BYTE 6 ; Fork IPL .BLKL 3 ; FPC/FR3/FR4 .ENDR RING_SIZE = 1024 ; Size of buffer BUF_2: .BLKB RING_SIZE ; Fork level buffer RING_BUFFER: .BLKB RING_SIZE ; Buffer for mailbox RING_PTR: .BLKL 1 ; Pointer to data storage RING_FREE: .LONG RING_SIZE ; Free in mailbox WRITE_SIZE: .BLKL 1 ; Characters in alt buffer .SBTTL SETUP - Set up hook SETUP: MOVAL RING_BUFFER, RING_PTR ; Set up pointer to buffer MOVAL FKB_LIST, FKB_LIST ; Set up queue header MOVL FKB_LIST, FKB_LIST+4 MOVAL FKB_1, R0 ; Set up FKB queue MOVL #FKB_COUNT, R1 ; Number of fork blocks 10$: INSQUE (R0), @FKB_LIST+4 ; Insert onto queue at tail MOVAL FKB$K_LENGTH(R0), R0 ; Point to next SOBGTR R1, 10$ ; Do next MOVL TERM_UCB, R2 ; Get UCB pointer MOVL UCB$L_TT_PORT(R2), R0 ; Point to port vectors MOVL R0, SAVED_PORT ; Save port vector pointer MOVAL PORT_TABLE, R1 ; Point to internal table PUSHR #^M ; Save across MOVC MOVC3 #PORT_LENGTH, (R0),(R1) ; Copy port vector to internal POPR #^M MOVL PORT_STARTIO(R1),- ; PORT_START_VEC ; Save old port startio MOVAL GRAB_STARTIO,- ; PORT_STARTIO(R1) ; Point to hook code MOVL PORT_DS_SET(R0),- ; PORT_DS_VEC ; Save old port dataset vector MOVAL GRAB_PORT_DS,- ; PORT_DS_SET(R1) ; Set new dataset transition MOVL PORT_DISCONNECT(R0),- ; Save old port disconnect PORT_DIS_VEC ; MOVAL GRAB_PORT_DIS,- ; PORT_DISCONNECT(R1) ; MOVL UCB$L_TT_CLASS(R2), R0 ; Point to class vectors MOVL R0, SAVED_CLASS ; Save class table pointer MOVAL CLASS_TABLE, R1 ; Point to saved table PUSHR #^M ; Save registers MOVC3 #CLASS_LENGTH, (R0),(R1); Copy class vector POPR #^M ; Restore regs MOVL CLASS_GETNXT(R0),- ; Save original getnxt vector CLASS_GETNXT_VEC ; MOVAL GRAB_GETNXT,- ; CLASS_GETNXT(R1) ; Point to hook code MOVAL GRAB_GETNXT,- ; Plus point UCB UCB$L_TT_GETNXT(R2) ; MOVL CLASS_PUTNXT(R0),- CLASS_PUTNXT_VEC ; Save original PUTNXT vector MOVAL GRAB_PUTNXT,- ; Set up copied class vector CLASS_PUTNXT(R1) MOVAL GRAB_PUTNXT,- ; Plus device UCB UCB$L_TT_PUTNXT(R2) MOVL CLASS_DS_TRAN(R0),- ; Save original dataset trans CLASS_DS_VEC ; MOVAL GRAB_CLASS_DS,- ; Point to hook code CLASS_DS_TRAN(R1) ; MOVL CLASS_DISCONNECT(R0),- ; Save class disconect CLASS_DIS_VEC ; MOVAL GRAB_CLASS_DIS,- ; Point to hook code CLASS_DISCONNECT(R1) ; DSBINT ;;; Lock out interrupts MOVAL CLASS_TABLE,- ;;; Point UCB to my class UCB$L_TT_CLASS(R2) ;;; table copy MOVAL PORT_TABLE,- ;;; Plus point to my port UCB$L_TT_PORT(R2) ;;; table copy ENBINT ; Restore IPL RSB ; All done .SBTTL GRAB_CLASS_DS - Hook to notice dataset hangups GRAB_CLASS_DS: BSBB RESET_IT ;;; Remove hooks JMP @CLASS_DS_VEC ;;; Call the class driver .SBTTL GRAB_PORT_DS - Hook to notice dataset hangups GRAB_PORT_DS: BSBB RESET_IT ;;; Remove hooks JMP @PORT_DS_VEC ;;; Call the port driver .SBTTL GRAB_PORT_DIS - Hook to notice disconnects GRAB_PORT_DIS: BSBB RESET_IT ;;; Reset device JMP @PORT_DIS_VEC ;;; Call port driver .SBTTL GRAB_CLASS_DIS - Hook to notice disconnects GRAB_CLASS_DIS: BSBB RESET_IT ;;; Reset device JMP @CLASS_DIS_VEC ;;; Call class driver RESET_IT: MOVQ R0, -(SP) ;;; Save registers CALLS #0, RESET ;;; Reset terminal MOVQ (SP)+, R0 ;;; Restore... RSB ;;; And return .SBTTL GRAB_STARTIO - Hook to send data to mbx ;+ ; This routine is called at device IPL to send ; the data to the port driver. The value in R3 contains ; the data; either a character or a pointer to a burst string. ; (r2 contains the size.) An IPL 6 fork is created to send the data ; to the mailbox. ;- GRAB_STARTIO: TSTL R3 ;;; Any work to do? BEQL 10$ ;;; Nope, tell the startio. PUSHR #^M ;;; Store volatile regs BSBB GET_DATA ;;; Get terminal data POPR #^M ;;; Restore registers TSTL R3 ;;; Reset condition codes 10$: JMP @PORT_START_VEC ;;; Call port routine .SBTTL GRAB_GETNXT - Hook to send data to mbx ;+ ; This routine is called at device IPL to send ; the data to the port driver. The value in R3 contains ; the data; either a character or a pointer to a burst string. ; (r2 contains the size.) An IPL 6 fork is created to send the data ; to the mailbox. ;- .ENABLE LSB GRAB_GETNXT: JSB @CLASS_GETNXT_VEC ;;; Call the class driver 10$: TSTB UCB$B_TT_OUTYPE(R5) ;;; Any work to do? BEQL 20$ ;;; Nope. PUSHR #^M ;;; Store volatile regs BSBB GET_DATA ;;; Check for data type... POPR #^M ;;; Restore regs TSTB UCB$B_TT_OUTYPE(R5) ;;; Reset cond codes 20$: RSB ;;; Return to caller .SBTTL GRAB_PUTNXT ;+ ; This routine is used to grab echoes of input characters ;- GRAB_PUTNXT: JSB @CLASS_PUTNXT_VEC ;;; Call the class driver BRB 10$ ;;; Common code. .DISABLE LSB .SBTTL GET_DATA - Copy the output data to the buffer ;+ ; This routine copies the output data to the buffer. ; When the buffer is full, DUMP_BUFFER is called ; to output it to the mailbox. ;- GET_DATA: TSTL R3 ;;; Character or pointer? BLSS 20$ ;;; Pointer MOVB R3, @RING_PTR ;;; Copy to buffer INCL RING_PTR ;;; And bump it DECL RING_FREE ;;; Less this much free BGTR 10$ ;;; Still room left BSBW DUMP_BUFFER ;;; Dump the buffer 10$: RSB ;;; Done sending message ; ; Handle multi-byte messages ; 20$: MOVZWL R2, R2 ;;; Size of message CMPL R2, #RING_SIZE ;;; Is it too big? BLSS 30$ ;;; Skip if not MOVL #RING_SIZE, R2 ;;; Limit to this size 30$: CMPL R2, RING_FREE ;;; Room for this one? BLEQ 40$ ;;; Yup, add it in. MOVQ R2,-(SP) ;;; Save R2 and R3 BSBW DUMP_BUFFER ;;; First, dump the buffer MOVQ (SP)+, R2 ;;; Restore R2 and R3 40$: PUSHR #^M ;;; Store registers MOVC3 R2, (R3), @RING_PTR ;;; Move to buffer POPR #^M ;;; Restore registers ADDL R2, RING_PTR ;;; Point to next byte SUBL R2, RING_FREE ;;; Drop free counter RSB .SBTTL DUMP_BUFFER - Dump buffer to mailbox ;+ ; Routine to write the buffer to the mailbox. ; First calls EXE$FORK to wait for IPL 6 interrupt; ; Returns to caller to proceed until IPL drops. ; Fork routine takes the text and writes it to the mailbox. ;- DUMP_BUFFER: SUBL3 RING_FREE, #RING_SIZE,- ;;; Free-original gives.. WRITE_SIZE ;;; Size to move MOVAL RING_BUFFER, RING_PTR ;;; Reset pointer MOVL #RING_SIZE,RING_FREE ;;; And free TSTL WRITE_SIZE ;;; Anything to write? BLEQ 10$ ;;; Nothing to do REMQUE @FKB_LIST, R5 ;;; Get a FKB to use BVS 10$ ;;; No entry to get PUSHR #^M ;;; Save regs cross MOVC MOVC3 WRITE_SIZE, RING_BUFFER,-;;; Move # calculated from buffer BUF_2 ;;; Move to mailbox write buffer POPR #^M ;;; Restore regs JSB G^EXE$FORK ;;; Fork down ;;; Return to caller at DIPL ;+ ; Following executed at FIPL (IPL 6) whenever things get ; around to it ;- PUSHR #^M ; Save registers MOVAL BUF_2, R4 ; Address of buffer MOVL WRITE_SIZE, R3 ; Size of buffer MOVL MBX_UCB, R5 ; Get UCB Pointer JSB G^EXE$WRTMAILBOX ; Write to mailbox POPR #^M ; Restore registers INSQUE (R5), @FKB_LIST+4 ; Insert back onto queue 10$: RSB ; All done .SBTTL RESET - Reset terminal UCB .ENTRY RESET,^M MOVL TERM_UCB, R2 ; Point to terminal UCB BEQL 10$ ; Skip if UCB gone DSBINT ;;; Disable interrupts MOVL SAVED_PORT,- ;;; Restore port pointer UCB$L_TT_PORT(R2) ;;; back to driver MOVL SAVED_CLASS,- ;;; Restore class pointer UCB$L_TT_CLASS(R2) ;;; back to driver MOVL CLASS_GETNXT_VEC,- ;;; Restore UCB UCB$L_TT_GETNXT(R2) ;;; getnxt pointer MOVL CLASS_PUTNXT_VEC,- ;;; putnxt pointer UCB$L_TT_PUTNXT(R2) ;;; ENBINT ; Restore IPL CLRL TERM_UCB ; Clear UCB pointer MOVL #SS$_NORMAL, R0 ; All OK! 10$: RET ; All done so far .SBTTL FREE_POOL - Free nonpaged pool block .ENTRY FREE_POOL,^M DSBINT #IPL$_ASTDEL ; Lock out deletion MOVL CODE_PTR, R0 ; Point to code JSB G^EXE$DEANONPAGED ; Deallocate it ENBINT RET .SBTTL FLUSH_RING - Kernel routine to flush ring buffer .ENTRY FLUSH_RING, ^M MOVL #SS$_HANGUP, R0 ; Assume hung up TSTL TERM_UCB ; UCB There? BEQL 10$ ; Nope, quit now. DSBINT #21 ;;; Lock down interrupts BSBW DUMP_BUFFER ;;; Dump the buffer ENBINT ;;; Re-enable interrupts MOVL #SS$_NORMAL, R0 ; It's OK... 10$: RET ; And return .SBTTL SEND_IT - Send a character routine SEND_IT: MOVL #SS$_HANGUP, R0 ; Assume hung up MOVL TERM_UCB, R5 ; Get UCB pointer BEQL 30$ ; Quit if none MOVL 4(AP), R3 ; Get character DSBINT #21 ;;; Disable device ints JSB @CLASS_PUTNXT_VEC ;;; Call putnext routine TSTB UCB$B_TT_OUTYPE(R5) ;;; Check output type BEQL 10$ ;;; None to do BSBW GRAB_STARTIO ;;; Call the start I/O routine 10$: ENBINT ; Enable interrupts MOVL #SS$_NORMAL, R0 ; Normal exit 30$: RSB ; Done! KERN_SIZE = .-KERNEL_CODE ; Size of code to load .END WATCH