| .TITLE FORCE
.IDENT "X01-020"
;
; ****************************************************************************
; * *
; * COPYRIGHT (c) 1987 *
; * BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. *
; * *
; * THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED *
; * ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE *
; * INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER *
; * COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY *
; * OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY *
; * TRANSFERRED. *
; * *
; * THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE *
; * AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT *
; * CORPORATION. *
; * *
; * DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS *
; * SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. *
; * *
; ****************************************************************************
;
; Facility: Force input passed characters into a terminals typeahead
; buffer and from there into any outstanding read I/O requests.
;
; Abstract: The particular terminals UCB is located from VMS's device
; tables. From there the typeahead buffer is located and
; the passed characters and inserted if there is room.
; The terminal class driver routine TTY$PUTNEXTCHAR is used,
; this routine can be located from the UCB$L_TT_PUTNXT
; longword located in the UCB of the particular terminal device.
; Since the class driver routine is used, much device
; independence exists and all character codes are interpreted
; including control sequences.
;
; Author: G. Davies 20-Jan-1984
; Concept stolen from a program "SPY" written by A. R. Fleig
;
; Modifications:
; 18-Feb-1987 norm lastovica csc/cs
; Use IOC$SEARCHDEV to simplify finding the UCB. Clean up
; code further to make things simpler. change little functionality.
;
; Notes:
;
; CMKRNL and WORLD privileges are required.
;
; Calling standard:
; Two parameters are needed, the first is the device name
; passed by descriptor. This needs to be the device name
; or logical. This will be passed to $GETDVI to return the
; 'real' terminal name. This 'real' name string is passed to
; IOC$SEARCHDEV which will return the UCB and DDB addresses
; (though we only care about the UCB address here).
;
; The second parameter is the string to be forced passed by
; descriptor, it must be longer that zero characters but less than
; or equal to 80 characters. If this is not true the status
; SS$_BADPARAM will be returned.
;
; The status of this routine is passed back in register zero.
; Attempting to pass less or more than two parameters will
; return the status SS$_BADPARAM.
;
; Restrictions:
; It was found that if echo is set on the terminal
; that is being forced to, the current read I/O if any
; completes with the status SS$_TIMEOUT. This appears to
; happen as soon as the first character forced to the terminal.
; The following characters are forced without error.
; Fow example suposing the target terminal is at DCL
; and the string "SH USERS" was forced. The target terminal
; would display the error "RMS-W-TMO, timeout" and then
; display "H USERS" which would execute the HELP USERS command.
; This only happened if there was an outstanding read I/O to
; the terminal. For example if the target terminal was
; executing a DCL WAIT command when the string above was
; forced, on completion of the WAIT command the entire forced
; string would echo and execute correctly.
; The application of this subprogram did not require
; echo so before the force begin's the terminal is set to
; noecho, and this is reversed afterwards. Note that the mode
; or characteristics of the terminal are not changed but only
; the current status of the current I/O request if any is
; modified. So even with using the SET_ECHO and SET_NOECHO
; routines, if there is no outstanding read I/O active on the
; target terminal all characters echo correctly.
;
; 17-Feb-1987
; The current restriction seems to be that the first
; character is tossed when echo is not disabled. However,
; the timeout message is not seen. Initial investigation
; shows that the TTCHARI and TTCHARO routines do some strange
; things when doing echo and this could explain the missing characters.
; The echo does not seem to happen real time anyhow, so there
; may be more going on here than meets the eye. There are
; other entry points in the terminal driver code that may be
; usefull here...
;
;
; Include files:
;
.LIBRARY "SYS$LIBRARY:LIB.MLB" ;Use 'special' macro library
.LINK "sys$system:sys.stb"/se
$DCDEF ;Device Characteristics
$DDBDEF ;Device Data Block Offsets
$IODEF ;I/O Function Codes
$JPIDEF ;GETJPI definitions
$TTDEF ;Terminal codes
$TTYDEFS ;Terminal driver UCB extension offsets
$UCBDEF ;Unit Control Block offsets
$TTYMACS ;Terminal driver routines
$DCDEF
$DVIDEF
; Local storage.
.PSECT RWDATA, NOEXE, WRT, LONG
;
; Remote terminal specification
;
RT_TERMINAL:
.ASCII /RT/
LOCK_DATA_START: ; page(s) from here to lock_data_end are ;-------+
; locked into memory to prevent paging at ;
; elevated IPL ;
; These
FORCE_LENGTH: .WORD 0 ; Length of string to force ; bytes
FORCE_STRING: .BLKB 80 ; Buffer for string to force ; are
FORCE_CHAR: .BYTE 0 ; Individual character to force for ; required
; for each call to FORCE_INTO_TYPEAHEAD ; to
; be
UCBADR: .BLKL 1 ;UCB address of target terminal ; locked
;
FORK_IPL: .LONG 11 ;IPL for terminal data access synchronisation ;
CURRENT_ECHO: .BYTE 0 ;Original state of echo/noecho indicator ;
; for terminal line ;
DEVICE_NAME: .BLKL 1 ; points to the device name string desc ;
;
LOCK_DATA_END: ;-------+
;
; Control blocks to lock necessary pages in physical memory
;
LOCK_DATA: .ADDRESS LOCK_DATA_START
.ADDRESS LOCK_DATA_END
LOCK_CODE: .ADDRESS LOCK_CODE_START
.ADDRESS LOCK_CODE_END
;
; build a string descriptor for the physical device name. $GETDVI will
; fill in the name length and the string. We'll save room for 32 bytes
; of device name here. Probably overkill, but not something that we'd
; want to risk!
;
real_name_desc: ; our descriptor
real_name_len: .long ; resultant string length
.address real_name_str ; pointer to the string
real_name_str: .blkb 32 ; save room for 32 bytes of string
;
; Item list for getdvi system service
;
GETDVI_LIST:
.WORD 4
.WORD DVI$_DEVCLASS
.ADDRESS DEVICE_CLASS ; check to be sure a terminal
.LONG 0
.word 32 ; max string of 32 bytes back
.word dvi$_tt_phydevnam ; get the device name
.address real_name_str ; point to the string space
.address real_name_len ; put the returned length here
.LONG 0 ; end GETDVI item list
DEVICE_CLASS: ; save device class here
.LONG 0
.PSECT CODE, EXE, NOWRT, LONG
.DEFAULT DISPLACEMENT, WORD
.ENTRY FORCE, ^M<R2, R3, R4, R5, R8, R9, R10, R11>
;
; Try and lock required data and code pages in memory
;
$LKWSET_S INADR=LOCK_DATA ; lock the data
BLBS R0,5$ ; success??
BRW CRASH ; nope, error
5$: $LKWSET_S INADR=LOCK_CODE ; lock the code
BLBS R0,7$
BRW CRASH
;
; check the arguments to make sure there are 2 (ought to check for
; valid string descriptors to avoid damage later)
;
7$: MOVL (AP)+,R0 ; Check number arguments
CMPL R0, #2 ; must be 2
BEQL 10$ ; it is
MOVL #SS$_BADPARAM,R0 ; it is not!
BRW CRASH ; complain
;
; save the device name address and get the device type and the physical
; device name from GETDVIW. this allows logicals to be passed as well
; as virtual terminal names.
;
10$: MOVL (AP)+,R10 ; Address of descriptor of terminal
movl r10,device_name ; save for later
15$: $GETDVIW_S EFN=#1,-
DEVNAM=(R10),-
ITMLST=GETDVI_LIST
BLBS R0,17$ ; did the GETDVI go OK?
BRW CRASH ; not this time
;
; make sure the device requested is a terminal
;
17$: CMPL #DC$_TERM,DEVICE_CLASS ; is it a terminal??
BEQL CHECK_NOT_REMOTE ; yes
MOVL #SS$_DEVCMDERR,R0 ; no, must be a mistake!!
BRW CRASH
;
; We cannot force to a remote terminal (but why??)
;
CHECK_NOT_REMOTE:
MOVL 4(R10),R0 ; Address of string
MATCHC #2,RT_TERMINAL,#4,(R0) ; Check for RT
BNEQ 20$
MOVL #SS$_DEVCMDERR,R0 ; was RT, no way!
BRW CRASH
20$:
;
; verify that the string passed is in bounds
;
MOVL (AP)+,R10 ; Address of descriptor of force string
TSTW (R10) ; Check zero length
BEQL 30$ ; zero not allowed
CMPW (R10),#80 ; Check too long
BLEQ 40$ ; it is OK
30$: MOVL #SS$_BADPARAM,R0 ; can not do it
BRW CRASH ; get out with error
;
; move the string to our locked buffer
;
40$: MOVW (R10),FORCE_LENGTH ; Length of string
MOVL 4(R10),R0 ; Address of string
MOVC3 FORCE_LENGTH,(R0),FORCE_STRING ; move passed string to buffer
;
; get the UCB address for the target terminal
;
50$:
test::
$cmkrnl_s routin=search_unit ; determine the UCB address
blbs r0,90$ ; did it work
brw crash ; nope.
90$: MOVAL FORCE_STRING,R10 ; Address of string to force
MOVZWL FORCE_LENGTH,R9 ; number of characters to force
;
; Set the terminal we are forcing at to noecho mode
;
$CMKRNL_S ROUTIN=SET_NO_ECHO
BLBS R0,COPY_LOOP
BRW CRASH
;
; Copy force string character by character into the terminal I/O
; subsystem. Since many instructions may be executed to perform this
; action, and most processing is done at high IPL, one character is
; forced at a time so no latency problems are introduced when forcing
; long strings.
;
COPY_LOOP:
MOVB (R10)+,FORCE_CHAR ; move the next character
$CMKRNL_S ROUTIN=FORCE_INTO_TYPEAHEAD ; and send it
BLBS R0,100$
BRW CRASH
100$: DECW R9 ; subtract one and go back
BNEQ copy_loop ; if they are not all moved
ALL_FORCED:
;
; Set terminal back to echo
;
$CMKRNL_S ROUTIN=SET_ECHO
BLBS R0,10$
BRW CRASH
;
; Try and unlock pages previously tacked down
;
10$: $ULWSET_S INADR=LOCK_DATA
BLBS R0,20$
BRW CRASH
20$: $ULWSET_S INADR=LOCK_CODE
BLBS R0,30$
BRW CRASH
30$: MOVL #SS$_NORMAL,R0
CRASH: RET
;
; Kernel mode routines.
;
LOCK_CODE_START: ; pages to be locked in memory start here,
; end at lock_code_end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Get UCB data. Call IOC$SEARCHDEV passing the device name. We will
; get back a UCB and DDB address in R1 and R2. However, all we want is
; R1 (the UCB). Save it in UCBADR for our caller. See IOSUBPAGD.LIS
; for more information.
;
.ENTRY SEARCH_UNIT, ^M<R2, R3, R4, R5, R6, R7, R10, R11>
moval real_name_desc, r1 ; get the device name descriptor
DSBINT FORK_IPL ; Raise IPL to lock the I/O database
jsb g^ioc$searchdev ; find the device
ENBINT ; Reset IPL
movl r1,ucbadr ; save the UCB address
ret ; status in R0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Set terminal driver status for this line to no echo by simply setting
; the bit in the state flag in the UCB.
;
.ENTRY SET_NO_ECHO, ^M<R2, R3, R4, R5, R6, R7, R10, R11>
DSBINT FORK_IPL ;Raise IPL
MOVL UCBADR,R5 ;Unit control block address
MOVAB UCB$Q_TT_STATE(R5),R2 ;Quadword of state bits
CLRB CURRENT_ECHO ;Initialize our flag
IF_STATE NOECHO,10$ ;Is noecho currently set - BR if so
SET_STATE NOECHO ;Set to noecho
INCB CURRENT_ECHO ; and set our flag
10$: ENBINT ;Reset IPL
MOVZWL S^#SS$_NORMAL, R0 ;Return with success
RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Set terminal driver status for this line to original state of echo.
;
.ENTRY SET_ECHO, ^M<R2, R3, R4, R5, R6, R7, R10, R11>
DSBINT FORK_IPL ;Raise IPL
MOVL UCBADR,R5 ;Unit control block address
MOVAB UCB$Q_TT_STATE(R5),R2 ;Quadword of state bits
TSTB CURRENT_ECHO ;Test whether echo was originally set
BEQL 10$ ;NO - so leave state as noecho
CLR_STATE NOECHO ;Set state to echo
10$: ENBINT ;Reset IPL
MOVZWL S^#SS$_NORMAL, R0 ;Return with success
RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Force one character by using terminal class driver routine. This will
; put the character into the typeahead buffer if there is one. See
; TTCHARI.LIS in [TTDRVR] for more information.
;
.ENTRY FORCE_INTO_TYPEAHEAD, ^M<R2, R3, R4, R5, R6, R7, R10, R11>
DSBINT FORK_IPL ;Raise IPL.
MOVL UCBADR,R5 ; Unit control block address
MOVZBL FORCE_CHAR,R3 ; Character to force
JSB @UCB$L_TT_PUTNXT(R5) ; Prod terminal class driver for this
; UCB
ENBINT ;Reset IPL
MOVZWL S^#SS$_NORMAL, R0 ;Return with success
RET
LOCK_CODE_END: ; end of pages locked
.END
|
| $! I've got one that does both sides; it can capture both input and
$! output. Extract this note and "@" it to compile and link.
$! Usage: Run it. tell it what terminal.
$! it will then slave your terminal to the other's output stream.
$! if you type ^\ "input" mode is enabled; anything you type is
$! forced to the other terminal's input stream. Another ^\ disables
$! input mode. ^Z with input mode disabled will clean up and exit.
$! **** WARNING: Don't point this to a RTxx device *****
$! [unless you LIKE crashing systems].
$ CREATE TTYDEF.MAR
$ DECK/DOLLAR="%%"
.MACRO $TTYDEF,$GBL ;
$DEFINI TTY,$GBL
$DEF TTY$L_WB_FLINK .BLKL
$DEF TTY$L_WB_BLINK .BLKL
$DEF TTY$W_WB_SIZE .BLKW
$DEF TTY$B_WB_TYPE .BLKB
$DEF TTY$B_WB_FIPL .BLKB
$DEF TTY$L_WB_FPC .BLKL
$DEF TTY$L_WB_FR3 .BLKL
$DEF TTY$L_WB_FR4 .BLKL
$DEF TTY$L_WB_MAP .BLKL
$DEF TTY$L_WB_NEXT .BLKL
$DEF TTY$L_WB_END .BLKL
$DEF TTY$L_WB_IRP .BLKL
$DEF TTY$W_WB_STATUS .BLKW
$DEF TTY$W_WB_BCNT .BLKW
$DEF TTY$L_WB_RETADDR .BLKL
$DEF TTY$C_WB_HDRLEN
$DEF TTY$K_WB_HDRLEN
$DEF TTY$L_WB_DATA .BLKL
$DEFEND TTY,$GBL,DEF
.ENDM $TTYDEF
.MACRO $TTYDEFS $GBL
$UCBDEF
$DEFINI TTYDEFS,$GBL
.BLKB UCB$C_LENGTH
$DEF UCB$Q_TT_STATE
.BLKQ 1
$DEF UCB$L_TT_MULTI
.BLKL 1
$DEF UCB$L_TT_RDUE
.BLKL 1
$DEF UCB$L_TT_RTIMOU
.BLKL 1
$DEF UCB$L_TT_CTRLY
.BLKL 1
$DEF UCB$L_TT_CTRLC
.BLKL 1
$DEF UCB$L_TT_OUTBAND
.BLKL 1
$DEF UCB$L_TT_BANDQUE
.BLKL 1
$DEF UCB$L_TT_TYPAHD
.BLKL 1
$DEF UCB$W_TT_INAHD
.BLKW 1
$DEF UCB$W_TT_HOLD
.BLKW 1
$VIELD TTY,0,<-
<TANK_CHAR,8,M>-
<TANK_XOFF,1,M>-
<TANK_XON,1,M>-
<TANK_STOP,1,M>-
<TANK_STOP2,1,M>-
<TANK_HOLD,1,M>-
<TANK_BURST,1,M>-
>
$DEF UCB$W_TT_CURSOR
.BLKW 1
$DEF UCB$B_TT_LINE
.BLKB 1
$DEF UCB$B_TT_LASTC
.BLKB 1
$DEF UCB$L_TT_DECHAR
.BLKL 1
$DEF UCB$L_TT_DECHA1
.BLKL 1
$DEF UCB$L_TT_WFLINK
.BLKL 1
$DEF UCB$L_TT_WBLINK
.BLKL 1
$DEF UCB$L_TT_WRTBUF
.BLKL 1
$DEF UCB$L_TT_GETNXT
.BLKL 1
$DEF UCB$L_TT_PUTNXT
.BLKL 1
$DEF UCB$L_TT_CLASS
.BLKL 1
$DEF UCB$L_TT_PORT
.BLKL 1
$DEF UCB$L_TT_OUTADR
.BLKL 1
$DEF UCB$W_TT_OUTLEN
.BLKW 1
$DEF UCB$B_TT_DS_RCV
.BLKB 1
$DEF UCB$B_TT_DS_TX
.BLKB 1
$DEF UCB$W_TT_DS_ST
.BLKW 1
$DEF UCB$W_TT_DS_TIM
.BLKW 1
$DEF UCB$W_TT_SPEED
.BLKW 1
$VIELD UCB,0,<-
<TT_TSPEED,8,M>-
<TT_RSPEED,8,M>-
>
$DEF UCB$B_TT_CRFILL
.BLKB 1
$DEF UCB$B_TT_LFFILL
.BLKB 1
$DEF UCB$B_TT_PARITY
.BLKB 1
$VIELD UCB,3,<-
<TT_LEN,2,M>-
<TT_STOP,1,M>-
<TT_PARTY,1,M>-
<TT_ODD,1,M>-
>
$DEF UCB$B_TT_FILL
.BLKB 1
$DEF UCB$W_TT_DESPEE
.BLKW 1
$DEF UCB$B_TT_DECRF
.BLKB 1
$DEF UCB$B_TT_DELFF
.BLKB 1
$DEF UCB$B_TT_DEPARI
.BLKB 1
$DEF UCB$B_TT_DETYPE
.BLKB 1
$DEF UCB$W_TT_DESIZE
.BLKW 1
.BLKB
$DEF UCB$B_TT_MAINT
.BLKB 1
$VIELD UCB,0,<-
<,7,>,-
<TT_DSBL,1,M>-
>
$DEF UCB$L_TT_ALTDRV
.BLKL 1
$DEF UCB$L_TT_MAP
.BLKL 1
$DEF UCB$W_TT_ALTLEN
.BLKW 1
$DEF UCB$B_TT_ESC
.BLKB 1
$DEF UCB$B_TT_ESC_O
.BLKB 1
$DEF UCB$C_TT_LENGTH
$DEF UCB$K_TT_LENGTH
. = 0
$DEF CLASS_GETNXT
.BLKL 1
$DEF CLASS_PUTNXT
.BLKL 1
$DEF CLASS_SETUP_UCB
.BLKL 1
$DEF CLASS_DS_TRAN
.BLKL 1
$DEF CLASS_DDT
.BLKL 1
$DEF CLASS_READERROR
.BLKL 1
. = 0
$DEF PORT_STARTIO
.BLKL 1
$DEF PORT_DISCONNECT
.BLKL 1
$DEF PORT_SET_LINE
.BLKL 1
$DEF PORT_DS_SET
.BLKL 1
$DEF PORT_XON
.BLKL 1
$DEF PORT_XOFF
.BLKL 1
$DEF PORT_STOP
.BLKL 1
$DEF PORT_STOP2
.BLKL 1
$DEF PORT_ABORT
.BLKL 1
$DEF PORT_RESUME
.BLKL 1
$DEF PORT_SET_MODEM
.BLKL 1
$DEF PORT_START_DMA
.BLKL 1
$DEF PORT_MAINT
.BLKL 1
. = 0
$DEF TTY$L_RB_NXT
.BLKL 1
$DEF TTY$L_RB_UVA
.BLKL 1
$DEF TTY$W_RB_SIZE
.BLKW 1
.BLKB 1
.BLKB 1
$DEF TTY$W_RB_ORGHOR
.BLKW 1
$DEF TTY$W_RB_TIMOS
.BLKW 1
$DEF TTY$L_RB_EXTEND
.BLKL 1
$DEF TTY$L_RB_DATA
.BLKL 1
. = 0
$DEF TTY$L_TA_PUT
.BLKL 1
$DEF TTY$L_TA_GET
.BLKL 1
$DEF TTY$W_TA_SIZE
.BLKW 1
$DEF TTY$B_TA_TYPE
.BLKB 1
.BLKB 1
$DEF TTY$L_TA_END
.BLKL 1
$DEF TTY$L_TA_DATA
.BLKL 1
$VIELD TTY,0,<-
<ST_CTRLS,,M>-
<ST_FILL,,M>-
<ST_CURSOR,,M>-
<ST_SENDLF,,M>-
<ST_MULTI,,M>-
<ST_DMA,,M>-
<ST_WRITE,,M>-
<ST_BRDCST,,M>-
<ST_EOL,,M>-
<ST_CTRLR,,M>-
<ST_READ,,M>-
>
$VIELD TTY,0,<-
<ST_CTRLO,,M>-
<ST_DEL,,M>-
<ST_PASALL,,M>-
<ST_NOECHO,,M>-
<ST_WRTALL,,M>-
<ST_PROMPT,,M>-
<ST_NOFLTR,,M>-
<ST_ESC,,M>-
<ST_BADESC,,M>-
<ST_NL,,M>-
<ST_REFRSH,,M>-
<ST_ESCAPE,,M>-
<ST_TYPFUL,,M>-
<ST_SKIPLF,,M>-
<ST_GETAHD,,M>-
<ST_UNSOL,,M>-
<ST_ESC_O,,M>-
<ST_CTRLSP,,M>-
<ST_WRAP,,M>-
<ST_BRDP,,M>-
<ST_DMAABO,,M>-
<ST_OVRFLO,,M>-
<ST_AUTOP,,M>-
>
$VIELD TTY,0,<-
<SX_CTRLS>-
<SX_FILL>-
<SX_CURSOR>-
<SX_SENDLF>-
<SX_MULTI>-
<SX_DMA>-
<SX_WRITE>-
<SX_BRDCST>-
<SX_EOL>-
<SX_CTRLR>-
<SX_READ>-
>
$VIELD TTY,0,<-
<A,32>-
<SX_CTRLO>-
<SX_DEL>-
<SX_PASALL>-
<SX_NOECHO>-
<SX_WRTALL>-
<SX_PROMPT>-
<SX_NOFLTR>-
<SX_ESC>-
<SX_BADESC>-
<SX_NL>-
<SX_REFRSH>-
<SX_ESCAPE>-
<SX_TYPFUL>-
<SX_SKIPLF>-
<SX_GETAHD>-
<SX_UNSOL>-
<SX_ESC_O>-
<SX_CTRLSP>-
<SX_WRAP>-
<SX_BRDP>-
<SX_DMAABO>-
<SX_OVRFLO>-
<SX_AUTOP>-
>
$EQULST TTY$C_,,0,1,<-
<CTRLC,3>-
<BELL,7>-
<BS,8>-
<TAB,9>-
<LF,10>-
<VT,11>-
<FF,12>-
<CR,13>-
<CTRLO,15>-
<CTRLQ,17>-
>
$EQULST TTY$C_,,,1,<-
<XON,17>-
<CTRLR,18>-
<CTRLS,19>-
<XOFF,19>-
<CTRLU,21>-
<CTRLX,24>-
<CTRLY,25>-
<CTRLZ,26>-
<ESCAPE,27>-
<BLANK,32>-
<DOLLAR,36>-
>
$EQULST TTY$C_,,,1,<-
<PLUS,43>-
<ZERO,48>-
<ONE,49>-
<SCRIPT,96>-
<LOWA,97>-
<LOWZ,123>-
<DELETE,127>-
<NL,128>-
>
$EQULST TTY$C_,,0,1,<-
<MAXPAGLEN,255>-
<MAXPAGWID,511>-
<HIGHIPL,22>-
>
$EQULST TTY$C_,,0,1,<-
<FC_READ>-
<FC_WRITE>-
<FC_SETM>-
<FC_SETC>-
<FC_N_SET>-
>
$VIELD TTY,0,<-
<,3,M>-
<CH_LOWER,,M>-
<CH_SPEC,,M>-
<CH_CTRL,,M>-
<CH_CTRL3,,M>-
<CH_CTRL2,,M>-
>
$DEFEND UCB
$CRBDEF
crb$l_tt_modem = crb$l_timelink
crb$l_dz_modem = crb$l_duetime
crb$b_tt_timmask = crb$l_toutrout+3
crb$b_tt_ring = crb$l_toutrout
crb$b_tt_carrier = crb$l_toutrout+1
crb$b_tt_dtr = crb$l_toutrout+2
crb$b_tt_type = crb$b_type+1
IDB$B_TT_ENABLE = ^X0E
.ENDM $TTYDEFS
.MACRO $TTYMACS
.MACRO GTSBITS BITS,MODE,TARGET,BRANCH,?L1
F=0
Z0=3
X0=0
W0=0
Z1=3
X1=0
W1=0
.IRP Y,<BITS>
T=TTY$V_SX_'Y
.IF LE 32-T
X1=T-32@-3
.IF LT X1-Z1
Z1=X1
.ENDC
W1=<TTY$M_ST_'Y>!W1
.ENDC
.IF GT 32-T
X0=T@-3
.IF LT X0-Z0
Z0=X0
.ENDC
W0=<TTY$M_ST_'Y>!W0
.ENDC
.ENDR
.IF NE W0
GTSBITS1 Z0,W0,MODE,0
.IF NB TARGET
.IF IDN BRANCH,BEQL
.IF NE W1
F=1
BNEQ L1
.IFF
BEQL TARGET
.ENDC
.ENDC
.IF DIF BRANCH,BEQL
BNEQ TARGET
.ENDC
.ENDC
.ENDC
.IF NE W1
GTSBITS1 Z1,W1,MODE,4
.IF NB TARGET
BRANCH TARGET
.ENDC
.ENDC
.IF NE F
L1:
.ENDC
.ENDM GTSBITS
.MACRO GTSBITS1 Z,WX,MODE,BIAS
WX=WX@-<Z*8>
X=WX@-8
.IF EQ X
BI'MODE'B #WX,BIAS+Z(R2)
.IFF
X=WX@-16
.IF EQ X
BI'MODE'W #WX,BIAS+Z(R2)
.IFF
BI'MODE'L #WX,BIAS+Z(R2)
.ENDC
.ENDC
.ENDM GTSBITS1
.MACRO SET_STATE NAME
GTSBITS <NAME>,S
.ENDM SET_STATE
.MACRO CLR_STATE NAME
GTSBITS <NAME>,C
.ENDM CLR_STATE
.MACRO IF_STATE NAME,TARGET
CNT = 0
.IRP Y,<NAME>
CNT = CNT + 1
.ENDR
.IF EQUAL CNT - 1
ONE_BIT <NAME>,S,TARGET
.IFF
GTSBITS <NAME>,T,TARGET,BNEQ
.ENDC
.ENDM IF_STATE
.MACRO IF_NOT_STATE NAME,TARGET
CNT = 0
.IRP Y,<NAME>
CNT = CNT + 1
.ENDR
.IF EQUAL CNT - 1
ONE_BIT <NAME>,C,TARGET
.IFF
GTSBITS <NAME>,T,TARGET,BEQL
.ENDC
.ENDM IF_NOT_STATE
.MACRO ONE_BIT BIT,BRANCH,TARGET
BB'BRANCH' #TTY$V_SX_'BIT',(R2),'TARGET'
.ENDM ONE_BIT
.MACRO NOSET BIT,?L1
BBC #TT2$V_'BIT',R1,L1
BICL #TT2$M_'BIT',R0
L1:
.ENDM NOSET
.MACRO NOCLEAR BIT,?L1
BBC #TT2$V_'BIT',R1,L1
BISL #TT2$M_'BIT',R0
L1:
.ENDM NOCLEAR
.MACRO NOMOD BIT,?L1
BBC #TT2$V_'BIT',R1,L1
XORL2 #TT2$M_'BIT',R0
L1:
.ENDM NOMOD
.MACRO PRIV_TO_MOD BIT,ERROR = NOPRIV_EXIT,?L1
BBC #TT2$V_'BIT',R1,L1
BITL #<<1@PRV$V_LOG_IO>!-
<1@PRV$V_PHY_IO>>,-
@IRP$L_ARB(R3)
BNEQ L1
BRW 'ERROR'
L1:
.ENDM PRIV_TO_MOD
.MACRO $TTYMACS
.ENDM $TTYMACS
.ENDM $TTYMACS
.MACRO $TTYMODEM
.MACRO STO_TQE OFFSET,SIZE,VALUE,BASE
$$$$$$ = .
. = OFFSET+BASE
.'SIZE VALUE
. = $$$$$$
.ENDM STO_TQE
modem$b_st_onmask = 0
modem$b_st_offmask = 1
modem$w_st_timer = 2
modem$w_st_routine = 4
modem$c_st_length = 6
modem$b_tran_type = 0
modem$w_tran_nstate = 2
modem$b_tran_offmask = 4
modem$b_tran_onmask = 5
modem$c_tran_length = 6
modem$c_tran_time = 1
modem$c_tran_dataset = 0
modem$c_tran_end = 2
modem$c_tran_dialtype = 3
modem$c_tran_dz11 = 4
modem$c_tran_nomodem = 5
modem$c_timer = 4
modem$c_dataset = 3
modem$c_init = 0
modem$c_shutdwn = 1
modem$c_null = 2
modem$m_enable =^x8000
$VIELD TIMCTRL,0,<-
<CANCEL,,M>,-
<ACTIVE,,M>,-
>
.ENDM $TTYMODEM
%%
$ CREATE WATCH.MAR
$ DECK/DOLLAR=%%
.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 #2, G^LIB$GET_COMMAND ; Get the terminal name
STATUS
MOVAL NAME_BUF, R0 ; Check for trailing colon
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<R2,R3,R4,R5>
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<R2,R3,R4,R5>
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<R2,R3>
$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<R2, R3, R4, R5>
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<R0,R1,R2,R3,R4,R5> ; Save across MOVC
MOVC3 #PORT_LENGTH, (R0),(R1) ; Copy port vector to internal
POPR #^M<R0,R1,R2,R3,R4,R5>
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<R0,R1,R2,R3,R4,R5> ; Save registers
MOVC3 #CLASS_LENGTH, (R0),(R1); Copy class vector
POPR #^M<R0,R1,R2,R3,R4,R5> ; 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<R0,R1,R2,R3,R4,R5> ;;; Store volatile regs
BSBB GET_DATA ;;; Get terminal data
POPR #^M<R0,R1,R2,R3,R4,R5> ;;; 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<R0,R1,R2,R3,R4,R5> ;;; Store volatile regs
BSBB GET_DATA ;;; Check for data type...
POPR #^M<R0,R1,R2,R3,R4,R5> ;;; 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<R0,R1,R2,R3,R4,R5> ;;; Store registers
MOVC3 R2, (R3), @RING_PTR ;;; Move to buffer
POPR #^M<R0,R1,R2,R3,R4,R5> ;;; 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<R0,R1,R2,R3,R4,R5> ;;; Save regs cross MOVC
MOVC3 WRITE_SIZE, RING_BUFFER,-;;; Move # calculated from buffer
BUF_2 ;;; Move to mailbox write buffer
POPR #^M<R0,R1,R2,R3,R4,R5> ;;; 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<R0,R1,R2,R3,R4,R5> ; 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<R0,R1,R2,R3,R4,R5> ; Restore registers
INSQUE (R5), @FKB_LIST+4 ; Insert back onto queue
10$: RSB ; All done
.SBTTL RESET - Reset terminal UCB
.ENTRY RESET,^M<R2>
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<R2,R3>
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<R2,R3,R4,R5>
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
%%
$ LIBRARY/MACRO/CREATE TTYDEF TTYDEF
$ MACRO WATCH
$ LINK WATCH,SYS$SYSTEM:SYS.STB/SELECTIVE
$ EXIT
|