MODULE VT200_KIND ( MAIN = VT200_KIND, %TITLE'Is terminal VT200 or VT240' IDENT = '1-0.0' ) = BEGIN !++ ! FACILITY: User utilities ! ! ABSTRACT: ! ! This program solicits the terminal for detailed information about ! itself. If the VAX says it is a VT200 series terminal, the secondary ! Device Attributes (DA) request is made, and a determination made ! based upon the report. The result is set into the DCL symbol ! VT_KIND, and will be the string "VT220", "VT240", or "UNKNOWN". ! ! Note that the typeahead buffer is purged by this program. ! ! ENVIRONMENT: User mode, attached to terminal ! ! AUTHOR: Ken A L Coar ! ! MODIFIED BY: ! ! KLC0259 Ken Coar 20-JAN-1987 08:52 ! Original. Developed because of DECUS DCS need. !-- %SBTTL'Declarations' ! ! SWITCHES: ! SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); ! ! LINKAGES: ! ! NONE. ! ! ! INCLUDE FILES: ! LIBRARY 'SYS$LIBRARY:LIB'; ! LIB plus STARLET LIBRARY 'KEN_LIBRARY:KENLIB'; ! Local declarations ! ! FORWARD ROUTINES: ! FORWARD ROUTINE VT200_KIND : EXTERNAL_CALL; ! ! EXTERNAL REFERENCES: ! EXTERNAL ROUTINE LIB$FREE_EF, LIB$GET_EF, LIB$SET_SYMBOL, STR$COPY_DX; ! ! MACROS: ! ! NONE. ! ! ! EQUATED SYMBOLS: ! LITERAL K_CSI = %X'9B', K_ESC = %X'1B', K_TTBUF_SIZE = 128; ! ! FIELDS: ! ! NONE. ! ! ! PSECTS: ! RTL_PSECTS (FACILITY=DCS); ! ! OWN STORAGE: ! OWN DSYMBOL : DESCR (CLASS=DYNAMIC), DC : LONG, DVILST : _ITMLST( DVI$_, (4, DEVCLASS, DC, 0) ), TTBUF : VECTOR [K_TTBUF_SIZE, BYTE], TTCHAN : WORD, REQEF : LONG, REQSTAT : _IOSB, ! ! Note that the following must be done at run-time to be pretty because ! it needs bit %C'c' (63 hex) set, and it is very ugly to do that in ! a BIND statement. ! ! Also, since all the other bits need to be clear, we have to fill the ! structure with zero bytes. BLISS-32 no longer lets you have both ! an INITIAL and a PRESET on the same structure, which is a shame. ! R_TRM_BYTES : BBLOCK [16] INITIAL (REP 16 OF BYTE (0)); BIND KD_SYMNAME = %ASCID'VT_KIND', KD_VT220 = %ASCID'VT220', KD_VT240 = %ASCID'VT240', KD_UNKNOWN = %ASCID'UNKNOWN', KD_INPUT_SOURCE = UPLIT LONG( %ASCID'SYS$INPUT', %ASCID'SYS$OUTPUT', %ASCID'SYS$COMMAND', %ASCID'TT', 0 ) : VECTOR [, LONG], ! ! Notice that we use an escape in the report request string. This is ! because even the terminals in 8-bit mode recognise that sequence, ! whereas those in 7-bit mode might not understand the CSI prefix. ! KD_PROMPT = %ASCID %STRING (%CHAR (K_ESC), '[>0c') : BBLOCK, KR_TERMINATORS = UPLIT( WORD (16), WORD (0), LONG (R_TRM_BYTES) ); %SBTTL'FIND_SOURCE - Locate the terminal LNM' ROUTINE FIND_SOURCE : INTERNAL_CALL = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine steps through the list of input sources defined by ! KD_INPUT_SOURCE until it reaches a zero, or finds one that $GETDVIW ! reports is defined by the VAX as a terminal. It assigns a channel ! to the terminal, if found; otherwise, it returns an error. ! ! CALLING SEQUENCE: ! ! ret-status.wlc.v = FIND_SOURCE (); ! ! FORMAL PARAMETERS: ! ! NONE. ! ! IMPLICIT INPUTS: ! ! KD_INPUT_SOURCE list of descriptor addresses, terminated by ! a longword of zero. The descriptors contain ! device or logical names to be checked for ! terminal-ness. ! ! REQSTAT IOSB for $GETDVIW. ! ! REQEF longword containing EF for $GETDVIW. ! ! IMPLICIT OUTPUTS: ! ! TTCHAN word to receive the channel number assigned ! to the terminal, if found. ! ! COMPLETION STATUS: ! ! SS$_NORMAL successful completion, channel assigned ! SHR$_NOTTERM warning; none of the specified sources was ! known as a terminal by the VAX. ! SS$_xxx status returned by $GETDVIW or $ASSIGN. ! ! SIDE EFFECTS: ! ! Channel assigned if terminal is found. ! !-- BEGIN LOCAL IDX : LONG INITIAL (0), SOURCE : LONG, STATUS : LONG; WHILE (SOURCE = .KD_INPUT_SOURCE [.IDX]) NEQ 0 DO BEGIN STATUS = $GETDVIW( DEVNAM=.SOURCE, EFN=.REQEF, IOSB=REQSTAT, ITMLST=DVILST ); IF .STATUS THEN STATUS = .REQSTAT [IOSB_W_STATUS]; %CHECK (.STATUS); IF .DC EQL DC$_TERM THEN EXITLOOP; IDX = .IDX + 1; END; IF .SOURCE EQL 0 THEN RETURN SHR$_NOTTERM; %CHECK ($ASSIGN (CHAN=TTCHAN, DEVNAM=.SOURCE)); RETURN SS$_NORMAL; END; %SBTTL'VT200_KIND - Main program' GLOBAL ROUTINE VT200_KIND : EXTERNAL_CALL = !++ ! FUNCTIONAL DESCRIPTION: ! ! This is the main program. It calls FIND_SOURCE to locate the terminal ! (if there is one), and then sends a secondary DA request to it. The ! response, if there is one, is parsed, and the KD_SYMNAME symbol set ! accordingly. ! ! Note that the typeahead buffer is purged by this program. ! ! CALLING SEQUENCE: ! ! Called by DCL as main entry point. ! ! FORMAL PARAMETERS: ! ! NONE. ! ! IMPLICIT INPUTS: ! ! NONE. ! ! IMPLICIT OUTPUTS: ! ! [KD_SYMNAME] Local DCL symbol whose name is specified by ! this identifier is defined as "VT220", "VT240", ! or "UNKNOWN", if a terminal can be found.. ! ! COMPLETION STATUS: ! ! SS$_NORMAL successful completion ! SHR$_NOTTERM warning; no terminal found with this process ! other error from LIB$GET_EF, LIB$FREE_EF, or ! FIND_SOURCE (q.v.). ! ! SIDE EFFECTS: ! ! If no errors are encountered, a local DCL symbol will be defined. ! !-- BEGIN LABEL PARSE_LOAD; LOCAL TYPE_OFFSET : BYTE, SYMVAL : LONG, STATUS : LONG; %CHECK (LIB$GET_EF (REQEF)); %CHECK (FIND_SOURCE ()); ! ! Now set up the terminator mask by setting the %C'c' bit (63 hex). ! This needs to be done at run-time because of megagrossity in ! readability if done at compile-time. ! R_TRM_BYTES [%C'c' / 8, %C'c' MOD 8, 1, 0] = 1; ! ! If we've gotten this far, we can interrogate the terminal. Note that ! anything the user has typed up to this point will be discarded from the ! typeahead buffer. ! STATUS = $QIOW( EFN=.REQEF, CHAN=.TTCHAN, IOSB=REQSTAT, FUNC=( IO$_TTYREADPALL OR IO$M_PURGE OR IO$M_NOECHO OR IO$M_TIMED ), P1=TTBUF, P2=K_TTBUF_SIZE, P3=3, P4=KR_TERMINATORS, P5=.KD_PROMPT [DSC$A_POINTER], P6=.KD_PROMPT [DSC$W_LENGTH] ); ! ! The response to the above will be one of ! ! A timeout (terminal too slow, or didn't understand query) ! CSI > n ; ... c 8-bit terminal response ! ESC [ > n ; ... c 7-bit terminal response ! ! In the last two above, the spaces between characters are for clarity; ! they are not actually part of the response. The `n' is either `1,' ! indicating a VT220, or `2,' indicating a VT240. ! ! If the response does not comply to either of the above formats, we ! don't know what it is. ! IF .STATUS THEN STATUS = .REQSTAT [IOSB_W_STATUS]; SYMVAL = KD_UNKNOWN; PARSE_LOAD: BEGIN IF .STATUS EQL SS$_TIMEOUT THEN LEAVE PARSE_LOAD; SELECTONE .TTBUF [0] OF SET ! ! If first character is a CSI, set the offset to the position ! of the identifying character. ! [K_CSI] : TYPE_OFFSET = 2; ! ! If it's an escape, increase the offset because the prefix ! is two characters (ESC [) rather than just one (CSI). ! [K_ESC] : TYPE_OFFSET = 3; ! ! If the prefix isn't one of these, the user probably responded ! with text on a non-VT200 series terminal. ! [OTHERWISE] : LEAVE PARSE_LOAD; TES; SELECTONE .TTBUF [.TYPE_OFFSET] OF SET [%C'1'] : SYMVAL = KD_VT220; [%C'2'] : SYMVAL = KD_VT240; ! ! If it wasn't one of the above, we don't know what the response ! is, so ignore it. ! [OTHERWISE] : LEAVE PARSE_LOAD; TES; END; %( BLOCK PARSE_LOAD )% ! ! Set the symbol according to the above analysis. ! %CHECK (LIB$SET_SYMBOL (KD_SYMNAME, .SYMVAL)); ! ! We don't need the channel or event flag anymore, so let's get rid of ! them. Note that we do this AFTER the symbol definition, so an error ! won't prevent the symbol from being available. ! %CHECK (LIB$FREE_EF (REQEF)); %CHECK ($DASSGN (CHAN=.TTCHAN)); RETURN SS$_NORMAL; END; END ELUDOM