.TITLE WATCH - Watch terminal output stream .LIBRARY /TTYDEF/ .LIBRARY /SYS$LIBRARY:LIB/ .LINK 'SYS$SYSTEM:SYS.STB' /SELECTIVE_SEARCH $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 $DCdef ; Device Class Chars $DEVdef ; For Device Chars 2 $UCBdef ; UCB bit settings .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/ Count: .BlkL 1 ; Count Chars in Dev Str Char2: .BlkL 1 ; Char 2 Stats Class: .BlkL 1 ; Class Characteristics Stats: .BlkL 1 ; Device Stats SLIST: .ADDRESS ERR1 .ADDRESS ERR2 .ADDRESS ERR3 ERR1: .ASCID /%WATCH-F-DEVNOTTRM, Device specified is not a Terminal./ ERR2: .ASCID /%WATCH-F-DEVRTT, Device specified is a Remote Terminal./ ERR3: .ASCID /%WATCH-F-DEVNOTONL, Device specified is not online./ ; Item Descriptor Block used in getting Device Characteristics. ; We want to find out if this is a device we can monitor. Item: .Word 4 ; Device Char 2 .Word DVI$_DevChar2 .Address Char2 .Long 0 .Word 4 ; Device Class .Word DVI$_DevClass .Address Class .Long 0 .Word 4 ; Device Status .Word DVI$_Sts .Address Stats .Long 0 .Word 64 ; Physical TT .Word DVI$_TT_PhyDevNam .Address Name_Buf .Long 0,0 ; End of List .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 PUSHL #0 ; Prompt PUSHAL T_NAME ; Return buffer CALLS #3, G^LIB$GET_FOREIGN ; Get the terminal name STATUS TSTW T_NAME ; Test for Foriegn input BNEQ NOSHOW ; We got some. CALLS #0,SYS_INT ; Do a Show Interactive Users MOVL #64,T_NAME PUSHAL T_NAME ; Return length PUSHAL WHICH ; Prompt PUSHAL T_NAME ; Return buffer CALLS #3, G^LIB$GET_INPUT ; Get the terminal name STATUS NOSHOW: PUSHAL T_NAME PUSHAL T_NAME CALLS #2, G^STR$UPCASE ; Upcase it $GETDVI_S devnam=T_Name,itmlst=Item ; Get Device Chars CLRL R8 ; 0-Not Term Ret Sts CMPL #DC$_Term,Class ; Is it a Terminal? BNEQ EOP ; Nope. INCL R8 ; 1-Remote Term Ret Sts BBS #DEV$V_RTT,Char2,EOP ; Bit set means Remote INCL R8 ; 2-Not UCB Ret Sts BBC #UCB$V_Online,Stats,EOP ; Bit clear/Not Online MOVAL Name_Buf,R7 ; Get ready to count 10$: CMPB #0,(R7)+ ; bytes in device BEQL DONE ; string. AOBLEQ #64,Count,10$ ; Automatic Counter DONE: MOVL Count,T_Name ; Move in bytes of str BRB Cont ; All is a Go. EOP: PUSHL SLIST[R8] ; Address of Errmsg CALLS #1,G^LIB$PUT_OUTPUT ; Print it. RET ; Exit Program ;+ ; Uppercase the string and find the UCB ;- Cont: 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^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 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) ; LOCK LOCKNAME=SCHED, - LOCKIPL=#IPL$_SCHED, - SAVIPL=-(SP) 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 UNLOCK LOCKNAME=SCHED, - NEWIPL=(SP)+ 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 LOCK LOCKNAME=SCHED,- LOCKIPL=#IPL$_SCHED,- SAVIPL=-(SP) 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) ;;; UNLOCK LOCKNAME=SCHED,- NEWIPL=(SP)+ 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. LOCK LOCKNAME=HWCLK,- LOCKIPL=#IPL$_HWCLK,- SAVIPL=-(SP) BSBW DUMP_BUFFER ;;; Dump the buffer UNLOCK LOCKNAME=HWCLK,- NEWIPL=(SP)+ 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 LOCK LOCKNAME=HWCLK,- LOCKIPL=#IPL$_HWCLK,- SAVIPL=-(SP) 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$: UNLOCK LOCKNAME=HWCLK,- NEWIPL=(SP)+ MOVL #SS$_NORMAL, R0 ; Normal exit 30$: RSB ; Done! KERN_SIZE = .-KERNEL_CODE ; Size of code to load ; ; Subroutine that effectively does a SHOW SYSTEM/INTERACTIVE ; .Psect Data,NoExe,Wrt $FSCNdef Priv: .Quad 65536 CPid: .Long -1 RPid: .Long 0 Uic: .Long 0 State: .Long 0 Prior: .Long 0 Sts: .BLKL 1 CPU_Tim:.BlkL 2 User: .Byte 12,0[12] Proc: .Byte 12,0[12] Term: .Byte 8,0[7],32 States: .Ascii / COLPGMWAITCEF PFW LEF LEFO HIB / - /HIBO SUSP SUSPOFPG COM COMO CUR / St_Hld: .BYTE 5,0[5] ImgDsc: .Long 49 .Address Imag+1 Imag: .Byte 49,0[49] FilBuf: .Word 49,FSCN$_Name .BlkL 3 FilItm: .BlkO 1 Item1: .Word 12,JPI$_Username ; Username .Address User+1 .Long 0 .Word 4,JPI$_Pid ; PID .Address RPid .Long 0 .Word 4,JPI$_Uic ; UIC .Address UIC .Long 0 .Word 49,JPI$_Imagname ; Imagename .Address Imag+1 .Long 0 .Word 7,JPI$_Terminal ; Terminal .Address Term+1 .Long 0 .Word 4,JPI$_CPUtim ; CPU Time .Address CPU_Tim .Long 0 .Word 4,JPI$_State ; State .Address State .Long 0 .Word 4,JPI$_Pri ; Priority .Address Prior .Long 0 .Word 12,JPI$_Prcnam ; Priority .Address Proc+1 .Long 0,+4 ; Stats .Address Sts .Long 0,0 ; End of List Device: .Ascid /TT:/ Chanel: .BlkW 1 Head: .Ascii / PID Username Term UIC Imagename/- / State Pr CPU time/<13><10> Headln= .-Head Use1: .Ascid '!8XL !12AC !8AC !9%U !15AS !5AC !2UL '- '!2UL !2ZL:!2ZL:!2ZL.!2ZL !/' Out1: .Long 80 .Address .+4 .Blkb 80 Len1: .BLKW 1 Lis1: .Blkl 20 .Psect Code,Exe,NoWrt ; Define Code .Entry Sys_Int,^M<> ; Entry of Sub Sys_Int $SetPrv_S enbflg=#1,prvadr=Priv ; Turn on Privs $Assign_S devnam=Device,chan=Chanel ; Assign our TT: $Qiow_S chan=Chanel,- ; Write the Sys func=#IO$_WriteVBlk,- ; Header p1=Head,p2=#Headln SI_Strt:CLRL RPid ; Clear PID for next $GetJpiW_S pidadr=CPid,itmlst=Item1 ; Get Job Process Info CMPW R0 ,#SS$_NoMoreProc ; Are we at the end? BNEQ 10$ ; Nope $Dassgn_S chan=Chanel ; Yep. Deassign TT: RET ; Exit Program 10$: BBC #25,Sts,SI_Strt ; Check Interactive Bit More: MOVAL User,R10 ; Get Username CMPB #0,1(R10) ; Check to see non zero len BNEQ 10$ ; Yup. MOVAL Proc,R10 ; If not load Procname 10$: MOVAL States ,R6 ; Get State String Address MULL3 #5,State,R7 ; Compute index into it. ADDL2 R6 ,R7 ; Get address within string MOVC3 #5,(R7),St_Hld+1 ; Move it into storage MOVO FilBuf,FilItm ; Get Image name $FileScan_S srcstr=ImgDsc,- ; Parsge out image name valuelst=FilItm MOVZWL FilItm,FilItm ; Save it EDIV #100,CPU_tim,CPU_tim,R9 ; Start computing CPUtim str EDIV #60,CPU_tim,CPU_tim,R8 EDIV #60,CPU_tim,CPU_tim,R7 EDIV #24,CPU_tim,R11,R6 $Fao_S ctrstr=Use1,outlen=Len1,- ; Format our entire output outbuf=Out1,p1=RPid,- ; string for a pretty p2=R10,p3=#Term,p4=Uic,- ; picture for the user. p5=#Filitm,p6=#St_Hld,- ; p7=Prior,p8=R11,p9=R6,- ; p10=R7,p11=R8,p12=R9 MOVAL Out1+8,R6 ; Get address of Output Str MOVZWL Out1,R7 ; Get Length of Output Str Loop1: CMPB (R6)+,#0 ; Compare Byte to Null Char BNEQ Next ; Not a Null MOVB #32,-1(R6) ; Null! Change it to a space Next: SOBGTR R7,Loop1 ; Do this to end of string. $Qiow_S chan=Chanel,- ; Print it out func=#IO$_WriteVBlk,- ; p1=Out1+8,p2=Len1 Brw SI_Strt ; Go for more. .END WATCH