MODULE KERTRM (IDENT = '2.0.005' ) = BEGIN ! !++ ! FACILITY: ! ! KERMIT-32 terminal processing. ! ! ABSTRACT: ! ! This module will do all of the terminal processing for KERMIT-32. ! It contains the output routines for the terminal to send and ! receive messages as well as the routines to output text for debugging. ! ! ENVIRONMENT: ! ! VAX/VMS user mode. ! ! AUTHOR: Robert C. McQueen, CREATION DATE: 25-March-1983 !-- %SBTTL 'Table of Contents' ! ! TABLE OF CONTENTS: ! %SBTTL 'Revision History' !++ ! ! Start of version 1. 25-March-1983 ! ! 1.0.000 By: Robert C. McQueen On: 25-March-1983 ! Create this module. ! ! 1.1.001 By: W. Hom On: 6-July-83 ! Implement CONNECT command. ! ! 1.1.002 By: Nick Bush On: 7-July-83 ! Fix RECEIVE QIO to time out correctly. ! ! 1.2.003 By: Robert C. McQueen On: 16-Aug-83 ! Get the status correctly for the SS$_TIMEOUT checks. ! ! 1.2.004 By: Robert C. McQueen On: 9-Sept-1983 ! Flag if we just opened the terminal, so that we can ! clear the input that is coming into the terminal. This ! will clear up some of the junk that we get on start up. ! ! 2.0.005 Release VAX/VMS Kermit-32 version 2.0 ! !-- %SBTTL 'Library files' ! ! INCLUDE FILES: ! ! ! System definitions ! LIBRARY 'SYS$LIBRARY:STARLET'; ! ! KERMIT common definitions ! REQUIRE 'KERCOM'; REQUIRE 'KERERR'; %SBTTL 'Structure definitions -- $GETDVI arguments' ! ! $GETDVI interface fields and structure definition ! LITERAL DVI_SIZE = 3; ! Length of a DVI item list entry ! ! Fields for accessing the items in a DVI item list ! FIELD DVI_FIELDS = SET DVI_BFR_LENGTH = [0, 0, 16, 0], DVI_ITEM_CODE = [0, 16, 16, 0], DVI_BFR_ADDRESS = [1, 0, 32, 0], DVI_RTN_LENGTH = [2, 0, 32, 0] TES; ! ! Structure definition for item list STRUCTURE DVI_ITEM_LIST [I, O, P, S, E; N] = [(N + 1)*DVI_SIZE*4] (DVI_ITEM_LIST + ((I*DVI_SIZE) + O)*4); %SBTTL 'Structures definitions -- Terminal characteristics' ! ! Terminal characteristics words ! LITERAL TC$_CHAR_LENGTH = 12; ! ! Fields for accessing the items in a characteristic block ! FIELD TC$_FIELDS = SET TC$_CLASS = [0, 0, 8, 0], TC$_TYPE = [0, 8, 8, 0], TC$_BFR_SIZE = [0, 16, 16, 0], TC$_PAGE_LEN = [1, 24, 8, 0], TC$_CHAR = [1, 0, 24, 0], TC$_CHAR_2 = [2, 0, 32, 0] TES; ! ! Structure definition for item list ! STRUCTURE TC$_CHAR_STR [O, P, S, E; N] = [TC$_CHAR_LENGTH] (TC$_CHAR_STR + O*4); %SBTTL 'Literals' ! ! Literal definitions ! LITERAL RECV_BUFF_SIZE = MAX_MSG + 20, ! Size of receive buffer TIME_EFN = 3, ! Event flag number for receive timer TERM_EFN = 2; ! Event flag number to use for Terminal input %SBTTL 'Storage' ! ! OWN STORAGE: ! OWN TEXT_DESC : BLOCK [8, BYTE]; ! ! Communications routines storage ! OWN TERM_FIRST_TIME, ! First time QIO to read done TERM_CHAN, ! Channel the terminal is opened on CONS_CHAN, ! Channel the console terminal is opened on IO_STATUS : VECTOR [4, WORD], ! IOSB for receive QIO RECV_BUFFER : VECTOR [CH$ALLOCATION (RECV_BUFF_SIZE, CHR_SIZE)], ! Input buffer OLD_PARITY : BLOCK [8, BYTE], ! Old IOSB information OLD_TERM_CHAR : TC$_CHAR_STR FIELD (TC$_FIELDS), ! Old terminal chars NEW_TERM_CHAR : TC$_CHAR_STR FIELD (TC$_FIELDS); ! New terminal chars GLOBAL TERM_FLAG; ! Terminal open flag %SBTTL 'External routines' ! ! EXTERNAL REFERENCES: ! ! ! System library routines ! EXTERNAL ROUTINE LIB$PUT_SCREEN : ADDRESSING_MODE (GENERAL), LIB$PUT_OUTPUT : ADDRESSING_MODE (GENERAL), LIB$EMUL : ADDRESSING_MODE (GENERAL), LIB$ADDX : ADDRESSING_MODE (GENERAL), LIB$SIGNAL : ADDRESSING_MODE (GENERAL); ! ! Forward routines: ! FORWARD ROUTINE DO_RECEIVE_QIO, DO_CONS_QIO; %SBTTL 'External storage' !++ ! The following is the various external storage locations that are ! referenced from this module. !-- ! ! KERMSG storage ! EXTERNAL PARITY_TYPE, ! Type of parity being used IBM_FLAG, ! True if IBM mode IBM_CHAR, ! IBM mode turn-around character RCV_EOL, ! Receive EOL character RCV_TIMEOUT, ! Receive time out counter CONNECT_FLAG; ! Flag if communications line is TT: ! ! KERMIT storage ! EXTERNAL ESCAPE_CHR, ! Escape char. for CONNECT. TERM_NAME, ! Terminal name TERM_DESC : BLOCK [8, BYTE]; ! Descriptor for terminal name %SBTTL 'Terminal routines -- TERM_INIT - Initialize this module' GLOBAL ROUTINE TERM_INIT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the terminal processing module. It will ! initialize the various data locations in this module. ! ! CALLING SEQUENCE: ! ! TERM_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! Initialize the text descriptor ! TEXT_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TEXT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TEXT_DESC [DSC$W_LENGTH] = 0; ! ! Set up the terminal name descriptor ! TERM_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TERM_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TERM_DESC [DSC$A_POINTER] = TERM_NAME; TERM_DESC [DSC$W_LENGTH] = 12; CH$COPY (10, CH$PTR (UPLIT ('SYS$INPUT:')), 0, 11, CH$PTR (TERM_NAME)); ! ! Initialize the flags ! TERM_FLAG = FALSE; END; ! End of TERM_INIT %SBTTL 'TERM_DUMP - This routine will dump text on the terminal' GLOBAL ROUTINE TERM_DUMP (BUFFER_ADDRESS, BUFFER_COUNT) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will dump the text specified on the user's terminal. ! It will then return to the caller. ! ! CALLING SEQUENCE: ! ! TERM_DUMP( TEXT-BUFFER-ADDRESS, COUNT) ! ! INPUT PARAMETERS: ! ! TEXT-BUFFER-ADDRESS - Address of the buffer containing the characters. ! ! COUNT - Count of the characters in the buffer. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL TEXT_DESC : BLOCK [8, BYTE]; IF NOT .CONNECT_FLAG THEN BEGIN IF .TERM_FLAG THEN $QIOW (CHAN = .CONS_CHAN, FUNC = IO$_WRITEVBLK OR IO$M_NOFORMAT, P1 = .BUFFER_ADDRESS, P2 = .BUFFER_COUNT) ELSE BEGIN TEXT_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TEXT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TEXT_DESC [DSC$W_LENGTH] = .BUFFER_COUNT; TEXT_DESC [DSC$A_POINTER] = .BUFFER_ADDRESS; LIB$PUT_OUTPUT(TEXT_DESC); END; END; END; ! End of TERM_DUMP %SBTTL 'DBG_DUMP - This routine will dump text on the terminal' GLOBAL ROUTINE DBG_DUMP (BUFFER_ADDRESS, BUFFER_COUNT) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will dump the text specified on the user's terminal. ! It will then return to the caller. ! ! CALLING SEQUENCE: ! ! DBG_DUMP( TEXT-BUFFER-ADDRESS, COUNT) ! ! INPUT PARAMETERS: ! ! TEXT-BUFFER-ADDRESS - Address of the buffer containing the characters. ! ! COUNT - Count of the characters in the buffer. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL TEXT_DESC : BLOCK [8, BYTE]; IF NOT .CONNECT_FLAG THEN BEGIN IF .TERM_FLAG THEN $QIOW (CHAN = .CONS_CHAN, FUNC = IO$_WRITEVBLK OR IO$M_NOFORMAT, P1 = .BUFFER_ADDRESS, P2 = .BUFFER_COUNT) ELSE BEGIN TEXT_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TEXT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TEXT_DESC [DSC$W_LENGTH] = .BUFFER_COUNT; TEXT_DESC [DSC$A_POINTER] = .BUFFER_ADDRESS; LIB$PUT_OUTPUT(TEXT_DESC); END; END; END; ! End of DBG_DUMP %SBTTL 'Communcations line -- TERM_OPEN' GLOBAL ROUTINE TERM_OPEN = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will assign a channel that is used in the CONNECT ! processing and to send/receive a file from. ! ! CALLING SEQUENCE: ! ! TERM_OPEN(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_DESC - Descriptor of a vector of ASCII characters that represent ! the name of the terminal to use. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! TERM_CHAN - Channel number of the terminal line we are using. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN BIND SYS_OUTPUT = %ASCID'TT:'; LOCAL STATUS, OUTPUT_ITM : DVI_ITEM_LIST [2] FIELD (DVI_FIELDS), OUTPUT_NAME : VECTOR [65, BYTE], OUTPUT_LENGTH, OUTPUT_CLASS, OUTPUT_STATUS, TERM_ITM : DVI_ITEM_LIST [2] FIELD (DVI_FIELDS), TERM_NAME : VECTOR [65, BYTE], TERM_LENGTH, TERM_CLASS, TERM_STATUS; ! ! Initialize the first character to be an underscore, incase we have a ! concealed device name ! OUTPUT_NAME [0] = %C'_'; TERM_NAME [0] = %C'_'; ! ! Initialize the GETDVI call for the TT: ! OUTPUT_ITM [0, DVI_ITEM_CODE] = DVI$_DEVCLASS; OUTPUT_ITM [0, DVI_BFR_LENGTH] = 4; OUTPUT_ITM [0, DVI_BFR_ADDRESS] = OUTPUT_CLASS; OUTPUT_ITM [0, DVI_RTN_LENGTH] = 0; ! OUTPUT_ITM [1, DVI_ITEM_CODE] = DVI$_DEVNAM; OUTPUT_ITM [1, DVI_BFR_LENGTH] = 64; OUTPUT_ITM [1, DVI_BFR_ADDRESS] = OUTPUT_NAME [1]; OUTPUT_ITM [1, DVI_RTN_LENGTH] = OUTPUT_LENGTH; ! OUTPUT_ITM [2, DVI_ITEM_CODE] = 0; OUTPUT_ITM [2, DVI_BFR_LENGTH] = 0; ! ! Initialize the GETDVI call for the terminal name given ! TERM_ITM [0, DVI_ITEM_CODE] = DVI$_DEVCLASS; TERM_ITM [0, DVI_BFR_LENGTH] = 4; TERM_ITM [0, DVI_BFR_ADDRESS] = TERM_CLASS; TERM_ITM [0, DVI_RTN_LENGTH] = 0; ! TERM_ITM [1, DVI_ITEM_CODE] = DVI$_DEVNAM; TERM_ITM [1, DVI_BFR_LENGTH] = 64; TERM_ITM [1, DVI_BFR_ADDRESS] = TERM_NAME [1]; TERM_ITM [1, DVI_RTN_LENGTH] = TERM_LENGTH; ! TERM_ITM [2, DVI_ITEM_CODE] = 0; TERM_ITM [2, DVI_BFR_LENGTH] = 0; ! ! Get the device information ! OUTPUT_STATUS = $GETDVI (EFN = TERM_EFN, DEVNAM = SYS_OUTPUT, ITMLST = OUTPUT_ITM); IF NOT .OUTPUT_STATUS THEN BEGIN LIB$SIGNAL (.OUTPUT_STATUS); RETURN .OUTPUT_STATUS; END; STATUS = $WAITFR (EFN = TERM_EFN); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; ! ! For both of the device names ! TERM_STATUS = $GETDVI (EFN = TERM_EFN, DEVNAM = TERM_DESC, ITMLST = TERM_ITM); IF NOT .TERM_STATUS THEN BEGIN LIB$SIGNAL (.TERM_STATUS); RETURN .TERM_STATUS; END; STATUS = $WAITFR (EFN = TERM_EFN); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; ! ! Make sure that they are terminals ! IF .TERM_CLASS EQL DC$_TERM AND .OUTPUT_CLASS EQL DC$_TERM THEN BEGIN IF CH$NEQ (.OUTPUT_LENGTH, CH$PTR (.OUTPUT_ITM [1, DVI_BFR_ADDRESS]), .TERM_LENGTH, CH$PTR (.TERM_ITM [1, DVI_BFR_ADDRESS]), CHR_NUL) THEN CONNECT_FLAG = FALSE ELSE CONNECT_FLAG = TRUE; END ELSE BEGIN RETURN KER_LINTERM; END; STATUS = $ASSIGN (DEVNAM = TERM_DESC, CHAN = TERM_CHAN); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; ! ! If we are not sending data on the console terminal, open it up as well, ! since we will want to be able to capture command characters from it. ! IF NOT .CONNECT_FLAG THEN BEGIN STATUS = $ASSIGN (DEVNAM = SYS_OUTPUT, CHAN = CONS_CHAN); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; END; STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SENSEMODE, P1 = OLD_TERM_CHAR, P2 = TC$_CHAR_LENGTH, IOSB = OLD_PARITY); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; NEW_TERM_CHAR [TC$_BFR_SIZE] = .OLD_TERM_CHAR [TC$_BFR_SIZE]; NEW_TERM_CHAR [TC$_TYPE] = .OLD_TERM_CHAR [TC$_TYPE]; NEW_TERM_CHAR [TC$_CLASS] = .OLD_TERM_CHAR [TC$_CLASS]; NEW_TERM_CHAR [TC$_PAGE_LEN] = .OLD_TERM_CHAR [TC$_PAGE_LEN]; NEW_TERM_CHAR [TC$_CHAR] = (.OLD_TERM_CHAR [TC$_CHAR] OR TT$M_EIGHTBIT OR TT$M_NOBRDCST) AND NOT (TT$M_CRFILL OR TT$M_LFFILL OR TT$M_WRAP); NEW_TERM_CHAR [TC$_CHAR_2] = .OLD_TERM_CHAR [TC$_CHAR_2] OR TT2$M_XON; STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SETMODE, P1 = NEW_TERM_CHAR, P2 = TC$_CHAR_LENGTH, P5 = TT$M_ALTRPAR); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; TERM_FLAG = TRUE; ! Terminal now open TERM_FIRST_TIME = TRUE; ! Flag first time QIO should clear input ! ! Now post the initial receive QIO ! STATUS = DO_RECEIVE_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR; END; ! ! Also post the QIO for the console ! IF NOT .CONNECT_FLAG THEN BEGIN STATUS = DO_CONS_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); $CANCEL (CHAN = .TERM_CHAN); $DASSGN (CHAN = .TERM_CHAN); RETURN KER_RECERR; END; END; RETURN KER_NORMAL; END; ! End of TERM_OPEN %SBTTL 'Communications line -- TERM_CLOSE' GLOBAL ROUTINE TERM_CLOSE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will deassign the channel that was assigned by ! TERM_OPEN. ! ! CALLING SEQUENCE: ! ! TERM_CLOSE(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_CHAN - Channel number to deassign. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL PAR, ! Parity being set STATUS; ! Status returned by system service STATUS = $CANCEL (CHAN = .TERM_CHAN); ! Kill pending QIO IF NOT .CONNECT_FLAG THEN BEGIN $CANCEL (CHAN = .CONS_CHAN); $DASSGN (CHAN = .CONS_CHAN); END; CONNECT_FLAG = FALSE; PAR = .OLD_PARITY [1, 8, 8, 0] OR TT$M_ALTRPAR; STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SETMODE, P1 = OLD_TERM_CHAR, P2 = TC$_CHAR_LENGTH, P5 = .PAR); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; STATUS = $DASSGN (CHAN = .TERM_CHAN); IF .STATUS THEN BEGIN TERM_FLAG = FALSE; RETURN KER_NORMAL END ELSE BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; END; ! End of TERM_CLOSE %SBTTL 'Communications line -- SEND' GLOBAL ROUTINE SEND (ADDRESS, LENGTH) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send a stream of 8-bit bytes over the terminal ! line to the remote KERMIT. This routine is called from KERMSG. ! ! CALLING SEQUENCE: ! ! SEND(Address-of-msg, Length-of-msg); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_CHAN - Channel number to deassign. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS; ! Status returned by $QIOW STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_WRITEVBLK + IO$M_NOFORMAT, P1 = .ADDRESS, P2 = .LENGTH); IF .STATUS EQL SS$_NORMAL THEN RETURN KER_NORMAL ELSE BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; END; ! End of SEND %SBTTL 'Communications line -- RECEIVE' GLOBAL ROUTINE RECEIVE (ADDRESS, LENGTH) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will receive a stream of 8-bit bytes over the terminal ! line to the remote KERMIT. This routine is called from KERMSG. ! The text that is stored will always contain the control-A as the ! first character. ! ! CALLING SEQUENCE: ! ! RECEIVE(Address-of-msg); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_CHAN - Channel number to deassign. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL QWORD_TIMEOUT : VECTOR [2, LONG], ! Quad word TIMEOUT value TIMER_VALUE : VECTOR [2, LONG], ! Quad word TIME value OLD_POINTER, ! Pointer into the message NEW_POINTER, ! Other pointer for finding SOH CUR_LENGTH, ! Running length while finding SOH CUR_EFN, ! Current EFN value STATUS; ! Status returned by $QIO ! ! Set up the timer if we have a time out parameter ! STATUS = $CLREF (EFN = TIME_EFN); IF .RCV_TIMEOUT GTR 0 THEN BEGIN STATUS = $CANTIM (REQIDT = TIME_EFN); STATUS = $GETTIM (TIMADR = TIMER_VALUE); STATUS = LIB$EMUL (RCV_TIMEOUT, UPLIT (10000000), UPLIT (0), QWORD_TIMEOUT); STATUS = LIB$ADDX (TIMER_VALUE, QWORD_TIMEOUT, QWORD_TIMEOUT); STATUS = $SETIMR (DAYTIM = QWORD_TIMEOUT, EFN = TIME_EFN, REQIDT = TIME_EFN); END; ! ! Loop until we get something that is acceptable ! WHILE TRUE DO BEGIN ! ! Wait for something to happen. Either the terminal EFN will come up ! indicating we have some data, or the timer EFN will indicate that ! the time has run out. ! STATUS = $WFLOR (EFN = TERM_EFN, MASK = (1^TERM_EFN OR 1^TIME_EFN)); STATUS = $READEF (EFN = TERM_EFN, STATE = CUR_EFN); ! ! If the terminal EFN is not set, the time must have expired. Therefore, ! we have timed out, and need to return that fact. ! IF (.CUR_EFN AND 1^TERM_EFN) EQL 0 THEN RETURN KER_TIMEOUT; ! ! Check if the QIO completed successfully. If not, we will return ! an error. ! IF NOT .IO_STATUS [0] THEN BEGIN LIB$SIGNAL (.IO_STATUS [0]); RETURN KER_RECERR; END; ! ! First check for a control-Y as the terminator. If it was, then ! just abort now, since the user probably typed it. ! IF .CONNECT_FLAG THEN IF (.IO_STATUS [2] EQL CHR_CTL_Y) AND (.RCV_EOL NEQ CHR_CTL_Y) THEN BEGIN STATUS = $CANTIM (REQIDT = TIME_EFN); RETURN KER_ABORTED END; ! ! Now find the final start of header character in the buffer. We ! will only return the text from that point on. If there is no SOH, ! then just get another buffer. It was probably noise on the line. ! OLD_POINTER = CH$PTR (RECV_BUFFER, 0, CHR_SIZE); CUR_LENGTH = .IO_STATUS [1]; ! Length without terminating character NEW_POINTER = CH$FIND_CH (.CUR_LENGTH, .OLD_POINTER, CHR_CTL_A); ! ! If we found a start of header character, then we probably have something ! to return. However, first we must find the last start of header, in case ! something is garbled. ! IF NOT CH$FAIL (.NEW_POINTER) THEN BEGIN ! ! Search until we can't find any more start of headers, or until we run ! out of string to search (last character before EOL is an SOH). ! WHILE (.CUR_LENGTH GTR 0) AND ( NOT CH$FAIL (.NEW_POINTER)) DO BEGIN CUR_LENGTH = .CUR_LENGTH - CH$DIFF (.NEW_POINTER, .OLD_POINTER); ! Adjust the length for the characters we are skipping OLD_POINTER = .NEW_POINTER; ! Remember where we start NEW_POINTER = CH$FIND_CH (.CUR_LENGTH - 1, CH$PLUS (.OLD_POINTER, 1), CHR_CTL_A); ! Find the next SOH (if any) END; ! ! If we have something left of the buffer, move from the SOH until the end ! into the callers buffer. ! IF (.CUR_LENGTH GTR 0) THEN BEGIN .LENGTH = .CUR_LENGTH + 1; IF .PARITY_TYPE EQL PR_NONE THEN CH$MOVE (.CUR_LENGTH + 1, .OLD_POINTER, CH$PTR (.ADDRESS, 0, CHR_SIZE)) ELSE BEGIN NEW_POINTER = CH$PTR(.ADDRESS, 0, CHR_SIZE); DECR CUR_LENGTH FROM .CUR_LENGTH TO 0 DO CH$WCHAR_A((CH$RCHAR_A(OLD_POINTER) AND %O'177'),NEW_POINTER); END; EXITLOOP END END; ! End of IF NOT CH$FAIL(.POINTER) ! ! If we have gotten here, we have input a buffer without a valid message. ! Make sure we post the QIO again ! STATUS = DO_RECEIVE_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR END; END; ! End of WHILE TRUE DO ! ! If we have gotten here, we have a valid message to return. ! Post the QIO so the buffer is available for the next message. ! STATUS = DO_RECEIVE_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR END; RETURN KER_NORMAL; ! Return happy END; ! End of RECEIVE %SBTTL 'Communications line -- IBM_WAIT' GLOBAL ROUTINE IBM_WAIT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will wait until the IBM turnaround character ! is seen on the communications line, or until the timeout ! parameter is exceeded. ! ! CALLING SEQUENCE: ! ! STATUS = IBM_WAIT (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_CHAN - Channel number for terminal ! ! OUTPUT PARAMETERS: ! ! Status value is returned as routine value. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL QWORD_TIMEOUT : VECTOR [2, LONG], ! Quad word TIMEOUT value TIMER_VALUE : VECTOR [2, LONG], ! Quad word TIME value CUR_EFN, ! Current EFN value STATUS; ! Status returned by $QIO ! ! Set up the timer if we have a time out parameter ! STATUS = $CLREF (EFN = TIME_EFN); IF .RCV_TIMEOUT GTR 0 THEN BEGIN STATUS = $CANTIM (REQIDT = TIME_EFN); STATUS = $GETTIM (TIMADR = TIMER_VALUE); STATUS = LIB$EMUL (RCV_TIMEOUT, UPLIT (10000000), UPLIT (0), QWORD_TIMEOUT); STATUS = LIB$ADDX (TIMER_VALUE, QWORD_TIMEOUT, QWORD_TIMEOUT); STATUS = $SETIMR (DAYTIM = QWORD_TIMEOUT, EFN = TIME_EFN, REQIDT = TIME_EFN); END; ! ! Loop until we get something that is acceptable ! WHILE TRUE DO BEGIN ! ! Wait for something to happen. Either the terminal EFN will come up ! indicating we have some data, or the timer EFN will indicate that ! the time has run out. ! STATUS = $WFLOR (EFN = TERM_EFN, MASK = (1^TERM_EFN OR 1^TIME_EFN)); STATUS = $READEF (EFN = TERM_EFN, STATE = CUR_EFN); ! ! If the terminal EFN is not set, the time must have expired. Therefore, ! pretend we got the character. ! IF (.CUR_EFN AND 1^TERM_EFN) EQL 0 THEN RETURN KER_NORMAL; ! ! Check if the QIO completed successfully. If not, we will return ! an error. ! IF NOT .IO_STATUS [0] THEN BEGIN LIB$SIGNAL (.IO_STATUS [0]); RETURN KER_RECERR; END; ! ! First check for a control-Y as the terminator. If it was, then ! just abort now, since the user probably typed it. ! IF .CONNECT_FLAG THEN IF (.IO_STATUS [2] EQL CHR_CTL_Y) AND (.RCV_EOL NEQ CHR_CTL_Y) THEN BEGIN STATUS = $CANTIM (REQIDT = TIME_EFN); RETURN KER_ABORTED END; ! Check if terminator was the turnaround character IF (.IO_STATUS [2] EQL .IBM_CHAR) THEN EXITLOOP; ! ! Make sure we post the QIO again ! STATUS = DO_RECEIVE_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR END; END; ! End of WHILE TRUE DO ! ! If we have gotten here, we have a valid message to return. ! Post the QIO so the buffer is available for the next message. ! STATUS = DO_RECEIVE_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR END; RETURN KER_NORMAL; ! Return happy END; ! End of RECEIVE %SBTTL 'DO_RECEIVE_QIO' ROUTINE DO_RECEIVE_QIO = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to perform a QIO input from the terminal. This ! ensures that there is usually a receive buffer pending. ! ! CALLING SEQUENCE: ! ! STATUS = DO_RECEIVE_QIO (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! RCV_EOL - Receive end-of-line character ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! IO_STATUS - IOSB for the QIO ! RCV_BUFFER - Data input from terminal ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! TERM_EFN is set when I/O completes ! !-- BEGIN LOCAL QIO_FUNC, TERMINATOR : VECTOR [2, LONG], STATUS; ! For status of QIO call ! ! Initialize the terminating characters for the QIO. Only terminate ! on the end-of-line character and a control-Y ! TERMINATOR [0] = 0; TERMINATOR [1] = 1^.RCV_EOL OR 1^CHR_CTL_Y; IF .IBM_FLAG THEN TERMINATOR [1] = TERMINATOR [1] OR 1^.IBM_CHAR; ! ! Initialize the QIO function ! QIO_FUNC = IO$_TTYREADALL OR IO$M_NOECHO; ! ! If this is the first time then purge any information that we have ! received on the line, before attempting to read information. ! IF .TERM_FIRST_TIME THEN BEGIN QIO_FUNC = .QIO_FUNC OR IO$M_PURGE; TERM_FIRST_TIME = FALSE ! Not first time anymore END; RETURN $QIO (CHAN = .TERM_CHAN, EFN = TERM_EFN, FUNC = .QIO_FUNC, IOSB = IO_STATUS, P1 = RECV_BUFFER, P2 = RECV_BUFF_SIZE, P4 = TERMINATOR); END; ! End of DO_RECEIVE_QIO %SBTTL 'DO_CONS_QIO' ROUTINE DO_CONS_QIO = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to perform a QIO input from the terminal. This ! ensures that there is usually a receive buffer pending. ! ! CALLING SEQUENCE: ! ! STATUS = DO_CONS_QIO (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! RCV_EOL - Receive end-of-line character ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! IO_STATUS - IOSB for the QIO ! RCV_BUFFER - Data input from terminal ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! TERM_EFN is set when I/O completes ! !-- BEGIN EXTERNAL ABT_CUR_FILE, ABT_ALL_FILE; LOCAL STATUS; ! For status of QIO call LITERAL CONS_BUFF_SIZE = 1; OWN CONS_STATUS : VECTOR [4, WORD], CONS_BUFFER : VECTOR [CONS_BUFF_SIZE, BYTE]; ! ! AST routine for console ! ROUTINE CONS_AST (DUMMY) = BEGIN IF .CONS_STATUS [0] THEN IF .CONS_STATUS [2] EQL CHR_CTL_Z THEN ABT_ALL_FILE = TRUE ELSE IF .CONS_STATUS [2] EQL CHR_CTL_X THEN ABT_CUR_FILE = TRUE ELSE IF .CONS_STATUS [2] EQL CHR_CTL_Y OR .CONS_STATUS EQL CHR_CTL_C THEN RETURN SS$_NORMAL; IF .CONS_STATUS [0] NEQ SS$_CANCEL AND .CONS_STATUS [0] NEQ SS$_ABORT THEN RETURN DO_CONS_QIO () ELSE RETURN SS$_NORMAL; END; RETURN $QIO (CHAN = .CONS_CHAN, FUNC = IO$_TTYREADALL, IOSB = CONS_STATUS, ASTADR = CONS_AST, P1 = CONS_BUFFER, P2 = CONS_BUFF_SIZE); END; ! End of DO_CONS_QIO %SBTTL 'TERM_CONNECT' GLOBAL ROUTINE TERM_CONNECT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine TERM_CONNECT will enable two terminal-like devices, ! MY_TERM and TERM_NAME, to communicate with each other. Anything ! that the user types on his terminal, MYTERM, will be sent to the ! other device, TERM_NAME, over the terminal line TERM_CHAN. ! Anything that TERM_NAME cares to output will be sent to MYTERM. ! The main routine TERM_CONNECT performs the initialization. It ! opens the input and output files and connects streams. ! ! CALLING SEQUENCE: ! ! TERM_CONNECT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_DESC - Descriptor of a vector of ASCII characters that represent ! the name of the terminal to use. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! TERM_CHAN - Channel number used by the terminal line to TERM_DESC. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LITERAL OUT_BUFLEN = 80, ! Max # of char. in output buffer INP_BUFSIZ = 25, ! Max # of char. in input buffer NUM_OUT_BUF = 2, ! # of output buffers per device NUM_IN_BUF = 2, ! # of input buffers per device MYT = 0, ! Device MY_TERM TRM = 1, ! Device TERM_NAME OFFSET = 1, ! IOSB : offset to terminator TIMEUP = 1, ! Time limit for READ QIO EOFSIZ = 3, ! IOSB : terminator size T_EFN_DISP = NUM_OUT_BUF, XITEFN = 2*NUM_OUT_BUF + 1, ! Exit event flag number EFN_MASK = (1^XITEFN - 1) AND ( NOT 1); ! Mask of flags set by CONNECT STRUCTURE IOSB_VECTOR [D, BUFNUM, INFO; NUMBUF] = [NUMBUF*16] (IOSB_VECTOR + (D*NUMBUF + BUFNUM)*8 + 2*INFO)<0, 16, 0>, BUFFER_VECTOR [D, BUFNUM; NUMBUF, BUFSIZ] = [NUMBUF*BUFSIZ*2 + NUMBUF] (BUFFER_VECTOR + (D*NUMBUF + BUFNUM)*BUFSIZ + D); OWN BTIMUP : VECTOR [4, WORD], ! Time limit in binary format CHANNEL : VECTOR [2, LONG], ! Contains channel #s CHR_COUNT : VECTOR [2, WORD] INITIAL (0), ! # of char. in out buffer ESC_FLG : INITIAL (FALSE), ! Was last char. the ESCAPE_CHR ESC_CHR_MSG : VECTOR [30, BYTE], ! Escape character message IN_IOSB : IOSB_VECTOR [NUM_IN_BUF], ! IOSB status block INP_BUF : BUFFER_VECTOR [NUM_IN_BUF, INP_BUFSIZ], ! Input buffers MSG : VECTOR [80, BYTE], ! Combined escape message MSG_DES : BLOCK [8, BYTE], ! Descriptor for message OUT_BUF : BUFFER_VECTOR [NUM_OUT_BUF, OUT_BUFLEN], ! Output buffers OUT_BUFNUM : VECTOR [2, BYTE], ! Present output buffer OUT_EFN : VECTOR [2, BYTE], ! Present event flag # OUT_PTR : VECTOR [2, LONG], ! CS-pointer for output buffer STATE; ! Used by $READEF to store state of EFs BIND ATIMUP = %ASCID'0 00:00:00.100', MYT_CHAN = CHANNEL [1], MY_TERM = %ASCID'SYS$INPUT:'; LABEL CONN_STREAMS; LOCAL CON_MSG : VECTOR [80, BYTE], CON_MSG_DESC : BLOCK [8, BYTE], STATUS; %SBTTL 'TERM_CONNECT -- TYPE_OUT_BUF' ROUTINE TYPE_OUT_BUF (DEV) = !++ ! This routine send the contents of the output buffer to the other ! device. It also resets the OUT_PTR and the CHR_COUNT and it ! increments OUT_EFN and OUT_BUFNUM. !-- BEGIN LOCAL STATUS; ! Check to make sure exit flag not set before $QIO IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN BEGIN $SETEF (EFN = .OUT_EFN [.DEV]); RETURN .STATUS; END; $WAITFR (EFN = .OUT_EFN [.DEV]); $CLREF (EFN = .OUT_EFN [.DEV]); IF $READEF (EFN = XITEFN, STATE = STATE) EQL SS$_WASCLR THEN STATUS = $QIO (CHAN = .CHANNEL [.DEV], EFN = .OUT_EFN [.DEV], FUNC = IO$_WRITEVBLK OR IO$M_NOFORMAT, P1 = OUT_BUF [.DEV, .OUT_BUFNUM [.DEV]], P2 = .CHR_COUNT [.DEV]) ELSE BEGIN $SETEF (EFN = .OUT_EFN [.DEV]); RETURN .STATUS; END; CHR_COUNT [.DEV] = 0; OUT_EFN [.DEV] = .OUT_EFN [.DEV] + 1; IF (OUT_BUFNUM [.DEV] = .OUT_BUFNUM [.DEV] + 1) GEQ NUM_OUT_BUF THEN BEGIN OUT_BUFNUM [.DEV] = 0; OUT_EFN [.DEV] = .DEV*T_EFN_DISP + 1; END; OUT_PTR [.DEV] = CH$PTR (OUT_BUF [.DEV, .OUT_BUFNUM [.DEV]]); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); $SETEF (EFN = XITEFN); END; RETURN .STATUS; END; %SBTTL 'TERM_CONNECT -- TIME_UP' ROUTINE TIME_UP (OUTEFN) : NOVALUE = !++ ! AST routine called 0.1 second after first character is input. It calls ! TYPE_OUT_BUF to transmit output buffer. !-- BEGIN LOCAL DEV; IF (.OUTEFN - T_EFN_DISP) LEQ 0 THEN DEV = 0 ! Device was MY_TERM ELSE DEV = 1; ! Device was TERM_NAME TYPE_OUT_BUF (.DEV); END; ! End of TIME_UP %SBTTL 'TERM_CONNECT -- STORE_INPUT' ROUTINE STORE_INPUT (DEV, INP_BUFNUM, NUM_CHR_IN) : NOVALUE = !++ ! This routine stores the input buffer in the output buffer and keeps ! track of the number of characters in the output buffer. It also ! calls TYPE_OUT_BUF when the output buffer is full and it sets up ! the timer routine TIME_UP. !-- BEGIN LOCAL STATUS; IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN RETURN .STATUS; IF .NUM_CHR_IN EQL 0 THEN RETURN .STATUS; IF .CHR_COUNT [.DEV] EQL 0 THEN BEGIN STATUS = $SETIMR (DAYTIM = BTIMUP, ASTADR = TIME_UP, REQIDT = .OUT_EFN [.DEV]); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); $SETEF (EFN = XITEFN); RETURN .STATUS; END; END; OUT_PTR [.DEV] = CH$MOVE (.NUM_CHR_IN, CH$PTR (INP_BUF [.DEV, .INP_BUFNUM]), .OUT_PTR [.DEV]); IF (CHR_COUNT [.DEV] = .CHR_COUNT [.DEV] + .NUM_CHR_IN) GEQ OUT_BUFLEN - INP_BUFSIZ THEN BEGIN $CANTIM (REQIDT = .OUT_EFN [.DEV]); TYPE_OUT_BUF (.DEV); END; RETURN .STATUS; END; ! End of STORE_INPUT %SBTTL 'TERM_CONNECT -- MYTINP' ROUTINE MYTINP (INP_BUFNUM) = !++ ! This AST routine gets characters from the channel MYT_CHAN and outputs ! them on the channel TERM_CHAN. It also checks to see if the exit ! characters have been typed. If they have been typed, MYTINP sets the ! event flag XITEFN. INP_BUFNUM contains the # of the input buffer. !-- BEGIN OWN STATUS, NUM_CHR_IN; %SBTTL 'TERM_CONNECT -- MYTINP -- CHK_FOR_EXIT' ROUTINE CHK_FOR_EXIT (INP_BUFNUM) = !++ ! This routine checks to see if the exit characters have been typed. It ! returns TRUE if found and FALSE if not. If only 1 ESCAPE_CHR found ! then ESC_FLG is set to TRUE. !-- BEGIN LOCAL ESC_PTR, INDEX : INITIAL (0), ! Displacement of ESC from beginning of buffer PTR0; ! Points to beginning of input buffer PTR0 = CH$PTR (INP_BUF [MYT, .INP_BUFNUM]); IF .ESC_FLG EQL TRUE ! ESCAPE_CHR was previously typed. THEN BEGIN INDEX = 0; ESC_PTR = .PTR0; ESC_FLG = FALSE; END ELSE IF (ESC_PTR = CH$FIND_CH (.NUM_CHR_IN, .PTR0, .ESCAPE_CHR)) EQL 0 THEN RETURN FALSE ELSE BEGIN INDEX = CH$DIFF (.PTR0, .ESC_PTR); IF .INDEX NEQ (NUM_CHR_IN = .NUM_CHR_IN - 1) THEN BEGIN CH$COPY (.NUM_CHR_IN - .INDEX, CH$PLUS (.ESC_PTR, 1), 0, .NUM_CHR_IN - .INDEX, .ESC_PTR); END ELSE ! ESCAPE_CHR was last character. BEGIN ESC_FLG = TRUE; RETURN FALSE; END; END; SELECTONE CH$RCHAR (.ESC_PTR) OF SET ['C', 'c'] : BEGIN NUM_CHR_IN = .INDEX; RETURN TRUE; END; [.ESCAPE_CHR] : CH$WCHAR (.ESCAPE_CHR, .ESC_PTR); [OTHERWISE] : BEGIN ! Send a bell char. to MY_TERM INP_BUF [TRM, NUM_IN_BUF] = CHR_BEL; STORE_INPUT (TRM, NUM_IN_BUF, 1); IF (NUM_CHR_IN = .NUM_CHR_IN - 1) EQL .INDEX THEN RETURN FALSE; CH$COPY (.NUM_CHR_IN - .INDEX, CH$PLUS (.ESC_PTR, 1), 0, .NUM_CHR_IN - .INDEX, .ESC_PTR); END; TES; RETURN FALSE; END; ! End of CHK_FOR_EXIT %SBTTL 'TERM_CONNECT -- MYTINP' ! Main portion of MYTINP IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN RETURN .STATUS; NUM_CHR_IN = .IN_IOSB [MYT, .INP_BUFNUM, OFFSET] + .IN_IOSB [MYT, .INP_BUFNUM, EOFSIZ]; IF .NUM_CHR_IN NEQ 0 THEN IF CHK_FOR_EXIT (.INP_BUFNUM) THEN BEGIN $CANTIM (); $SETEF (EFN = XITEFN); ! Exit characters typed. Set flag. RETURN 1; END ELSE STORE_INPUT (MYT, .INP_BUFNUM, .NUM_CHR_IN); ! Store char. IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) EQL SS$_WASCLR THEN STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = IO$M_NOECHO OR IO$M_TIMED OR IO$_TTYREADALL, ASTADR = MYTINP, P1 = INP_BUF [MYT, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = TIMEUP, ASTPRM = .INP_BUFNUM, IOSB = IN_IOSB [MYT, .INP_BUFNUM, 0]); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); $SETEF (EFN = XITEFN); END; RETURN .STATUS; END; ! End of MYTINP %SBTTL 'TERM_CONNECT -- TRMINP' ROUTINE TRMINP (INP_BUFNUM) = !++ ! This AST routine receives characters from the channel TERM_CHAN and ! outputs the characters to the channel MYT_CHAN. INP_BUFNUM contains ! the number of the input buffer. !-- BEGIN LOCAL NUM_CHR_IN, STATUS; IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN RETURN .STATUS; NUM_CHR_IN = .IN_IOSB [TRM, .INP_BUFNUM, OFFSET] + .IN_IOSB [TRM, .INP_BUFNUM, EOFSIZ]; IF .NUM_CHR_IN NEQ 0 THEN STORE_INPUT (TRM, .INP_BUFNUM, .NUM_CHR_IN); IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) EQL SS$_WASCLR THEN STATUS = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO OR IO$M_TIMED, ASTADR = TRMINP, P1 = INP_BUF [TRM, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = TIMEUP, IOSB = IN_IOSB [TRM, .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); $SETEF (EFN = XITEFN); END; RETURN .STATUS; END; ! End of TRMINP %SBTTL 'TERM_CONNECT -- ESC_MSG' ROUTINE ESC_MSG : NOVALUE = BEGIN LOCAL ESC_LEN; ESC_LEN = 0; SELECTONE .ESCAPE_CHR OF SET [CHR_NUL, 0] : BEGIN ESC_LEN = 28; CH$MOVE (.ESC_LEN, CH$PTR (PLIT ('ctrl-@ or on VT-100 ctrl-spc')), CH$PTR (ESC_CHR_MSG)); END; [CHR_RS, %O'36'] : BEGIN ESC_LEN = 26; CH$MOVE (.ESC_LEN, CH$PTR (PLIT ('ctrl-^ or on VT-100 ctrl-~')), CH$PTR (ESC_CHR_MSG)); END; [CHR_US, %O'37'] : BEGIN ESC_LEN = 26; CH$MOVE (.ESC_LEN, CH$PTR (PLIT ('ctrl-- or on VT-100 ctrl-?')), CH$PTR (ESC_CHR_MSG)); END; [1 TO %O'37'] : BEGIN ESC_LEN = 6; CH$MOVE (.ESC_LEN, CH$PTR (PLIT ('ctrl-')), CH$PTR (ESC_CHR_MSG)); ESC_CHR_MSG [5] = .ESCAPE_CHR + %O'100'; END; [%O'40' TO %O'176'] : BEGIN ESC_LEN = 3; ESC_CHR_MSG = '"'; ESC_CHR_MSG [1] = .ESCAPE_CHR; ESC_CHR_MSG [2] = '"'; END; [CHR_DEL, %O'177'] : BEGIN ESC_LEN = 3; ESC_CHR_MSG = 'DEL'; END; TES; MSG_DES [DSC$B_CLASS] = DSC$K_CLASS_S; MSG_DES [DSC$B_DTYPE] = DSC$K_DTYPE_T; MSG_DES [DSC$A_POINTER] = MSG; MSG_DES [DSC$W_LENGTH] = .ESC_LEN + 34; CH$COPY (14, CH$PTR (UPLIT (' Type ')), .ESC_LEN, CH$PTR (ESC_CHR_MSG), 20, CH$PTR (UPLIT (' and "C" to exit. ]')), 0, .MSG_DES [DSC$W_LENGTH], CH$PTR (MSG)); LIB$PUT_OUTPUT (MSG_DES); END; ! End of ESC_MSG %SBTTL 'TERM_CONNECT -- INITIALIZATION' ! Initialize variables CHR_COUNT [0] = 0; CHR_COUNT [1] = 0; ESC_FLG = FALSE; OUT_BUFNUM [0] = 0; OUT_BUFNUM [1] = 0; OUT_EFN [0] = 1; OUT_EFN [1] = T_EFN_DISP + 1; OUT_PTR [0] = CH$PTR (OUT_BUF [0, .OUT_BUFNUM [0]]); OUT_PTR [1] = CH$PTR (OUT_BUF [1, .OUT_BUFNUM [1]]); $BINTIM (TIMBUF = ATIMUP, TIMADR = BTIMUP); ! Initialize Connect message CON_MSG_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; CON_MSG_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; CON_MSG_DESC [DSC$A_POINTER] = CON_MSG; CON_MSG_DESC [DSC$W_LENGTH] = .TERM_DESC [DSC$W_LENGTH] + 48; CH$COPY (46, CH$PTR (UPLIT ('[ CONNECT running on VAX host. Connecting to ')), .TERM_DESC [DSC$W_LENGTH], CH$PTR (TERM_NAME), 0, .CON_MSG_DESC [DSC$W_LENGTH], CH$PTR (CON_MSG)); ! Assign channels to devices TERM_NAME and MY_TERM. STATUS = TERM_OPEN (); IF .CONNECT_FLAG ! Check if TERM_NAME is TT: THEN BEGIN TERM_CLOSE (); LIB$SIGNAL (KER_CON_SAME); RETURN KER_CON_SAME; END; IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; STATUS = $CANCEL (CHAN = .TERM_CHAN); ! Kill all pending QIOs for terminal CHANNEL [0] = .TERM_CHAN; CHANNEL [1] = .CONS_CHAN; STATUS = $CANCEL (CHAN = .CONS_CHAN); ! Kill pending QIOs for console as well ! STATUS = $ASSIGN (DEVNAM = MY_TERM, CHAN = MYT_CHAN); IF NOT .STATUS THEN BEGIN TERM_CLOSE (); LIB$SIGNAL (.STATUS); RETURN .STATUS; END; ! Prepare event flags $CLREF (EFN = XITEFN); INCR FLAG FROM 1 TO XITEFN - 1 DO $SETEF (EFN = .FLAG); ! Connect streams CONN_STREAMS : BEGIN ! Send connect message LIB$PUT_OUTPUT (%ASCID''); LIB$PUT_OUTPUT (CON_MSG_DESC); ESC_MSG (); ! Type escape character message LIB$PUT_OUTPUT (%ASCID''); $SETAST (ENBFLG = 0); ! Disable AST until after all QIOs INCR INP_BUFNUM FROM 0 TO NUM_IN_BUF - 1 DO BEGIN STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO OR IO$M_TIMED, ASTADR = MYTINP, P1 = INP_BUF [MYT, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = TIMEUP, IOSB = IN_IOSB [MYT, .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM); IF NOT .STATUS THEN LEAVE CONN_STREAMS; STATUS = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO OR IO$M_TIMED, ASTADR = TRMINP, P1 = INP_BUF [TRM, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = TIMEUP, IOSB = IN_IOSB [TRM, .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM); IF NOT .STATUS THEN LEAVE CONN_STREAMS; END; $SETAST (ENBFLG = 1); ! Enable AST $WAITFR (EFN = XITEFN); ! Wait for exit flag $WFLAND (EFN = 0, MASK = EFN_MASK); ! Go when outputs completed LIB$PUT_OUTPUT (%ASCID'[ Exiting from CONNECT. Returning to host. ]'); LIB$PUT_OUTPUT (%ASCID''); END; ! ! Program end -- Close both channels and return with STATUS ! $CANTIM (); $CANCEL (CHAN = .TERM_CHAN); $CANCEL (CHAN = .MYT_CHAN); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); STATUS = $DASSGN (CHAN = .TERM_CHAN); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); TERM_FLAG = FALSE; STATUS = $DASSGN (CHAN = .MYT_CHAN); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); $SETAST (ENBFLG = 1); RETURN .STATUS; END; ! End of TERM_CONNECT %SBTTL 'End of KERTRM' END ! End of module ELUDOM