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 ; BRB 60$ 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 BLSS 20$ ; Branch if legal system VA MOVL #SS$_IVDEVNAM, R0 ; Indicate an invalid device RSB ; And return 20$: 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 BLSS 30$ ; Branch if legal system VA MOVL #SS$_IVDEVNAM, R0 ; Indicate an invalid device RSB ; And return 30$: 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 DEVICELOCK - ; lock the device LOCKADDR=UCB$L_DLCK(R2),- SAVIPL=-(SP) 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) DEVICEUNLOCK - LOCKADDR=UCB$L_DLCK(R2),- NEWIPL=(SP)+,- CONDITION=RESTORE,- PRESERVE=YES 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) ; DEVICELOCK - LOCKADDR=UCB$L_DLCK(R2),- 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 DEVICEUNLOCK - LOCKADDR=UCB$L_DLCK(R2),- NEWIPL=(SP)+,- CONDITION=RESTORE,- PRESERVE=YES MOVZBL #SS$_NORMAL, R0 ; Set normal status 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 DEVICELOCK - LOCKADDR=UCB$L_DLCK(R2),- SAVIPL=-(SP) TSTL SAVED_PORT ;;; Is there a saved port vector BEQL 1$ ;;; Skip if not there MOVL SAVED_PORT,- ;;; Restore port pointer UCB$L_TT_PORT(R2) ;;; back to driver 1$: TSTL SAVED_CLASS ;;; Test saved class address BEQL 2$ ;;; Skip null restores MOVL SAVED_CLASS,- ;;; Restore class pointer UCB$L_TT_CLASS(R2) ;;; back to driver 2$: TSTL CLASS_GETNXT_VEC ;;; Test for null BEQL 3$ ;;; Skip nulls MOVL CLASS_GETNXT_VEC,- ;;; Restore UCB UCB$L_TT_GETNXT(R2) ;;; getnxt pointer 3$: TSTL CLASS_PUTNXT_VEC ;;; Test for null BEQL 4$ ;;; Skip if null MOVL CLASS_PUTNXT_VEC,- ;;; putnxt pointer UCB$L_TT_PUTNXT(R2) ;;; 4$: DEVICEUNLOCK - LOCKADDR=UCB$L_DLCK(R2),- NEWIPL=(SP)+,- CONDITION=RESTORE,- PRESERVE=YES 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 delivery of asts 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 DEVICELOCK - LOCKADDR=UCB$L_DLCK(R5),- 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$: DEVICEUNLOCK - LOCKADDR=UCB$L_DLCK(R5),- NEWIPL=(SP)+,- CONDITION=RESTORE,- PRESERVE=YES MOVL #SS$_NORMAL, R0 ; Normal exit 30$: RSB ; Done! KERN_SIZE = .-KERNEL_CODE ; Size of code to load .END WATCH