Columbia Kermit/kermit.zip/b/vmstrm.bli

Text File | 2020-01-01 | 98KB | 3,794 lines

MODULE KERTRM (IDENT = '3.3.120',
    ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL)
    ) =
BEGIN
!<BLF/WIDTH:100>

!++
! 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
!
! 2.0.006    By: Nick Bush            On: 10-Nov-1983
!        Fix local echo and IBM mode.
!
! 2.0.013    By: Nick Bush            On: 11-Nov-1983
!        Make it possible to redirect debugging output to DBG$OUTPUT.
!
! 2.0.015    By: Nick Bush            On: 17-Nov-1983
!        Always purge typeahead when posting the receive QIO.
!        Also eat any received data just before sending a packet.
!
! 2.0.020    By: Nick Bush            On: 9-Dec-1983
!        Only abort (when remote) if we seen two control-Y's in
!        succession.  This way a single glitch does not kill us.
!
! 2.0.021    By: Nick Bush            On: 12-Dec-1983
!        Add status type-out character (^A), debug toggle
!        character (^D), and force timeout character (^M)
!        to those accepted during a transfer when we are remote.
!
! 2.0.023    By: Nick Bush            On: 16-Dec-1983
!        Add a default terminal name for the communications line.
!        If KER$COMM is defined, that will be the default.
!
! 2.0.027    By: Nick Bush            On: 20-Jan-1983
!        Fix reset of parity to use the correct field in the
!        IO status block from the IO$_SENSEMODE.  It was using
!        the LF fill count instead.
!
! 2.0.031    By: Nick Bush            On: 4-Feb-1983
!        Change connect code to improve response (hopefully
!        without worsening throughput or runtime requirements).
!        When either terminal is idle we will be waiting for
!        a single character with a larger buffered read queued
!        up immediately after it.
!
! 2.0.033    By: Nick Bush            On: 6-March-1984
!        Change command input and terminal processing so that
!        we will always have SYS$OUTPUT and SYS$COMMAND open
!        when they are terminals, and will also always have
!        the transfer terminal line open.  This makes it
!        unnecessary for the user to allocate a dialup line
!        in order to go between CONNECT and a transfer command,
!        and keep anyone else from grabbing the line between
!        commands.
!        Also add the command parsing for the rest of the LOCAL/REMOTE
!        commands.  This makes use of the fact that we have
!        SYS$COMMAND open to allow us to read passwords without echo.
!        Commands which should only be done when Kermit is local
!        (GET, BYE, etc.) will now give an error if the transfer
!        line is the same as the controlling terminal.
!        SEND will now check for the files existance before calling
!        KERMSG to send it.
!
! 2.0.034    By: Nick Bush                On: 7-March-1984
!        Default the parity type to be that of the default transfer
!        line.  This should make things simpler for systems which use
!        parity by default.
!
! 2.0.035    By: Nick Bush                On: 8-March-1984
!        Add LOG SESSION command to set a log file for CONNECT.
!        While we are doing so, clean up the command parsing a little
!        so that we don't have as many COPY_xxx routines.
!
! 2.0.036    By: Robert C. McQueen            On: 20-March-1984
!        Fix call to LOG_OPEN to make the debug log file work.
!        Module: KERTRM
!
! 2.0.037    By: Robert C. McQueen            On: 20-March-1984
!        Fix call to LOG_OPEN for debug log file.
!        Module: KERTRM.
!
! 2.0.042    By: Nick Bush                On: 26-March-1984
!        Fix connect processing to make it easy to type messages
!        on the user's terminal while connected.  Use this
!        to type messages when log file stopped and started.
!        Include the node name in the messages to keep
!        users who are running through multiple Kermit's from
!        getting confused.
!
! 2.0.043    By: Nick Bush                On: 28-March-1984
!        Fix SET PARITY ODD to work.  Somehow, the table entry
!        had PR_NONE instead of PR_ODD.  Also add status type
!        out and help message to connect command.
!
! 3.0.045    Start of version 3.
!
! 3.0.046    By: Nick Bush                On: 29-March-1984
!        Fix debugging log file to correctly set/clear file open
!        flag.  Also make log files default to .LOG.
!
! 3.1.054    By: Nick Bush                On: 13-July-1984
!        Change TERM_OPEN to take an argument which determines
!        whether it should post any QIO's.  This makes it unnecessary
!        for TERM_CONNECT to cancel the QIO's, and avoids problems
!        with DECnet remote terminals.
!
! 3.1.060    By: Nick Bush                On: 16-March-1985
!        Increase size of terminal name buffers to account for large
!        unit numbers (most likely seen with VTA's).
!
! 3.1.061    By: Nick Bush                On: 16-March-1985
!        Only attempt to set parity back when closing terminal.
!
! 3.1.065    By: Nick Bush                On: 10-April-1985
!        Split IBM handshaking from parity and local echo.  Allow
!        link time setting of IBM_MODE defaults by defining symbols:
!
!        IBM_MODE_CHARACTER = character value of handshake character
!        IBM_MODE_ECHO = 1 for local echo, 2 for no local echo
!        IBM_MODE_PARITY = (0 = none), (1 = mark), (2 = even),
!            (3 = odd), (4 = space).
!
!        If not specified, Kermit will continue to use DC1, local echo
!        and odd parity for IBM_MODE.
!
!
! Start of version 3.2 on 8-May-1985
!
! 3.2.073    By: Robert McQueen            On: 11-March-1985
!        Fix a problem restoring the terminal characteristics under
!        VMS 4.x
!
! 3.2.100    By: Gregory P. Welsh            On: 1-June-1986
!        Added code for Transmit function (COMND_TRANSMIT).
!
! Start of version 3.3
!
! 3.3.101    By: Robert McQueen            On: 2-July-1986
!        Change $TRNLOG system service to be LIB$SYS_TRNLOG and
!        handle the errors better.  (LIB$ shouldn't change even if the
!        system service does).
!
! 3.3.102    By: Robert McQueen            On: 5-July-1986
!        Add changes/fixes suggested by Art Guion and David Deley.
!        - Turn off FALLBACK terminal characteristics for eightbit
!          operations.
!        - Decrease IBM timeouts when waiting for a handshake.
!
! 3.3.105    By: Robert McQueen            On: 8-July-1986
!        Attempt to fix the truncation errors that we now get from
!        LINK with BLISS-32 v4.2.  Also do code clean up in VMSTRM and
!        VMSFIL.
!
! 3.3.115    JHW004        Jonathan H. Welch,    9-May-1988 14:35
!        Added the ability to send a break character to
!        the outgoing terminal session using the sequence
!        esc-chr B.  The break will be sent after the next
!        character arrives.  This is because there must be
!        no outstanding I/O on a channel in order to modify
!        terminal characteristics (necessary to send a break).
!
! 3.3.116    JHW008        Jonathan H. Welch,    12-Apr-1990 12:20
!        Added and modified routines in to notify the user if
!        SS$_HANGUP occurs on the outgoing terminal line.
!
! 3.3.117    JHW012        Jonathan H. Welch,     18-May-1990 7:56
!        Modified asn_wth_mbx to obtain the master PID in the
!        process tree before asking for JPI$_TERMINAL.  $GETJPI
!        was returning a null string for this item when called
!        from a subprocess resulting in a "No default terminal
!        line for transfers" message.
!
! 3.3.118    JHW013        Jonathan H. Welch,    18-May-1990 13:00
!        Extended the buffer size for terminal names from 20
!        characters to 255 to make sure any terminal name can
!        be accomodated.
!
! 3.3.119    JHW014        Jonathan H. Welch,    5-Jun-1990 12:38
!        Modified asn_wth_mbx to add a ':' to the end of the
!               terminal name is one is not returned by VMS.
!               This will keep LIB$GETDVI from failing with an
!               "invalid device name" which results in the kermit
!               error "no default terminal line for transfers."
!
! 3.3.120    JHW016        Jonathan H. Welch,    17-Oct-1990 9:42
!        Modified asn_wth_mbx to work properly in non-interactive mode.
!--

%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
    ITEM_SIZE = 3;            ! Length of a DVI item list entry

!
! Fields for accessing the items in a DVI item list
!

FIELD
    ITEM_FIELDS =
    SET
    ITEM_BFR_LENGTH = [0, 0, 16, 0],
    ITEM_ITEM_CODE = [0, 16, 16, 0],
    ITEM_BFR_ADDRESS = [1, 0, 32, 0],
    ITEM_RTN_LENGTH = [2, 0, 32, 0]
    TES;

!
! Structure definition for item list

STRUCTURE
    ITEM_LIST [I, O, P, S, E; N] =
    [(N + 1)*ITEM_SIZE*4]
    (ITEM_LIST + ((I*ITEM_SIZE) + O)*4)<P, S, E>;

%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)<P, S, E>;

%SBTTL 'Literals'
!
! Literal definitions
!

LITERAL
    MAX_NODE_NAME = 255,            ! Size of a node name
    TERM_NAME_SIZE = 255,            ! Size of a terminal name - be generous
    RECV_BUFF_SIZE = MAX_MSG + 20,        ! Size of receive buffer
    GET_DEV_EFN = 7,                ! For GET_DEV_CHAR
    CONS_O_EFN = 6,                ! Event flag for console output
    CONS_EFN = 5,                ! Event flag for console input
    TERM_O_EFN = 4,                ! Event flag for terminal output
    TIME_EFN = 3,                ! Event flag number for receive timer
    TERM_EFN = 2;                ! Event flag number to use for Terminal input

%SBTTL 'Storage'
!
! OWN STORAGE:
!
!
! Communications routines storage
!

OWN
    FORCE_ABORT,                ! Force abort next receive
    FORCE_TIMEOUT,                ! Force time out on next receive
    TERM_FIRST_TIME,                ! First time QIO to read done
    TERM_CHAN,                    ! Channel the terminal is opened on
    mbx_chan : INITIAL(0),            ! Mailbox channel associated with TERM_CHAN device.
    new_mbx_chan : INITIAL(0),            ! Mailbox channel associated with new (temporary) TERM_CHAN device.
    CONS_CHAN,                    ! Channel the console terminal is opened on
    SYS_OUTPUT_CHAN,                ! Channel to SYS$OUTPUT (if it is a terminal)
    SYS_OUTPUT_OPEN,                ! SYS$OUTPUT open
    SYS_OUTPUT_NAME : VECTOR [TERM_NAME_SIZE, BYTE],    ! Text of physical name for SYS$OUTPUT
    SYS_OUTPUT_DESC : BLOCK [8, BYTE],        ! Descriptor for physical name
    SYS_COMMAND_CHAN,                ! Channel to SYS$COMMAND if a terminal
    SYS_COMMAND_OPEN,                ! SYS$COMMAND open
    SYS_COMMAND_NAME : VECTOR [TERM_NAME_SIZE, BYTE],    ! Text of physical name for SYS$COMMAND
    SYS_COMMAND_DESC : BLOCK [8, BYTE],        ! Descriptor for physical name
    TERM_NAME : VECTOR [TERM_NAME_SIZE, BYTE],    ! Text of current transfer terminal name
    JOB_TERM_NAME : VECTOR [TERM_NAME_SIZE, BYTE],    ! Text of jobs controlling terminal name
    TERM_OPEN_FLAG,                ! The transfer terminal is open
    SESSION_FAB : $FAB_DECL,            ! FAB for session logging
    SESSION_RAB : $RAB_DECL,            ! RAB for session logging
    SESSION_NAME : VECTOR [MAX_FILE_NAME, BYTE],    ! Actual name of session log file
    SESSION_OPEN,                ! Session log file open
    SESSION_LOGGING,                ! Session logging enabled
    DEBUG_FAB : $FAB_DECL,            ! FAB for debugging
    DEBUG_RAB : $RAB_DECL,            ! RAB for debugging
    DEBUG_NAME : VECTOR [MAX_FILE_NAME, BYTE],    ! Name of debugging log file
    DEBUG_REDIRECTED,                ! Debugging output redirected
    NODE_NAME : VECTOR [MAX_NODE_NAME, BYTE],    ! Node name text
    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
    NODE_DESC : BLOCK [8, BYTE] PRESET            ! Descriptor for node name
        ([DSC$B_CLASS ] = DSC$K_CLASS_S,        ! String class
         [DSC$B_DTYPE ] = DSC$K_DTYPE_T,        ! Text descriptor
         [DSC$W_LENGTH ] = MAX_NODE_NAME,        ! Maximum length
         [DSC$A_POINTER ] = NODE_NAME),        ! Address of the item
    DEBUG_DESC : BLOCK [8, BYTE] PRESET            ! Debugging log file
         ([DSC$B_CLASS ] = DSC$K_CLASS_S,        !  descriptor
          [DSC$B_DTYPE ] = DSC$K_DTYPE_T,        ! Standard string descriptor
          [DSC$W_LENGTH ] = 0,            !  initialially zero length
          [DSC$A_POINTER ] = DEBUG_NAME),        !  pointing to DEBUG_NAME
    SESSION_DESC : BLOCK [8, BYTE],        ! Descriptor for session log file name
    TERM_DESC : BLOCK [8, BYTE],        ! Descriptor for current transfer terminal
    JOB_TERM_DESC : BLOCK [8, BYTE],        ! Descriptor for controlling terminal (if any)
    TRANS_DELAY,                                ! The transmit delay
    TRANS_ECHO_FLAG,                            ! The transmit echo flag
    TERM_FLAG,                    ! Terminal setup for transfer
    Send_Break_TTY_Flag;            ! Flag to indicate if a break should be sent.

%SBTTL 'External routines'
!
! EXTERNAL REFERENCES:
!
!
! System library routines
!

EXTERNAL ROUTINE
    LIB$ASN_WTH_MBX : ADDRESSING_MODE (GENERAL),
    LIB$GETJPI : ADDRESSING_MODE (GENERAL),
    LIB$GETDVI : ADDRESSING_MODE (GENERAL),
    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),
    LIB$WAIT : ADDRESSING_MODE (GENERAL);

!
! Forward routines:
!

FORWARD ROUTINE
    TERM_DUMP : NOVALUE,            ! Routine to type on terminal
    GET_DEV_CHAR,                ! Get device characteristics
    Term_Hangup : NOVALUE,
    Mbx_Ast_Rtn : NOVALUE,
    asn_wth_mbx,
    Send_Break_TTY,
    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
    ECHO_FLAG,                    ! Local echo
    IBM_CHAR,                    ! IBM mode turn-around character
    RCV_EOL,                    ! Receive EOL character
    SEND_TIMEOUT,                ! Receive time out counter
    CONNECT_FLAG;                ! Flag if communications line is TT:

!
! KERMIT storage
!

EXTERNAL
    ESCAPE_CHR;                    ! Escape char. for CONNECT.

%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

    LOCAL
    COUNTER,                ! Counter for logical name translation
    STATUS,                    ! System call status
    DEV_TYPE,                ! Device type result
    RSL_LENGTH : VOLATILE,            ! Resulting length of translation
    RSL_NAME : BLOCK [TERM_NAME_SIZE, BYTE], ! Translated name
    RSL_DESC : BLOCK [8, BYTE],        ! Descriptor for translated name

    NODE_ITEM_LIST : FIELD(ITEM_FIELDS) ITEM_LIST [2] PRESET ! Node name
          ([0, ITEM_BFR_LENGTH ] = MAX_NODE_NAME,        ! Translation
           [0, ITEM_ITEM_CODE ] = LNM$_STRING,        ! Item list
           [0, ITEM_BFR_ADDRESS ] = NODE_NAME,        ! to xlate
           [0, ITEM_RTN_LENGTH ] = NODE_DESC[DSC$W_LENGTH]), ! SYS$NODE

    ITMLST : ITEM_LIST [1] FIELD (ITEM_FIELDS) PRESET
           ([0, ITEM_ITEM_CODE ] = JPI$_TERMINAL,        ! Get terminal name
        [0, ITEM_BFR_LENGTH ] = TERM_NAME_SIZE - 1, ! Max name size
        [0, ITEM_BFR_ADDRESS ] = JOB_TERM_NAME + 1, ! Place to store it
        [0, ITEM_RTN_LENGTH ] = RSL_LENGTH);        ! Resulting length

!
! Initialize session log file descriptor
!
    SESSION_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    SESSION_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    SESSION_DESC [DSC$W_LENGTH] = 0;
    SESSION_DESC [DSC$A_POINTER] = SESSION_NAME;
!
! Get system node name (if any)
!
    NODE_DESC [DSC$W_LENGTH] = MAX_NODE_NAME;
    STATUS = $TRNLNM(ATTR = %REF(LNM$M_CASE_BLIND),
    TABNAM = %ASCID 'LNM$SYSTEM', LOGNAM = %ASCID 'SYS$NODE',
    ITMLST = NODE_ITEM_LIST);

    COUNTER = 64;                ! Max number of translations

    WHILE .STATUS                ! Translation fails
    AND .COUNTER GTR 0            ! or we do too many translations
    DO
    BEGIN
    STATUS = $TRNLNM(ATTR = %REF(LNM$M_CASE_BLIND),
        TABNAM = %ASCID 'LNM$SYSTEM', LOGNAM = NODE_DESC,
        ITMLST = NODE_ITEM_LIST);
    COUNTER = .COUNTER - 1;
    END;
!
! If call failed, we don't really know the node name
!
    IF (NOT .STATUS) OR (NODE_NAME[0] EQL 0)
    THEN
    NODE_DESC[DSC$W_LENGTH] = 0;
!
! Get controlling terminal
!
    JOB_TERM_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    JOB_TERM_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    JOB_TERM_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE;
    JOB_TERM_DESC [DSC$A_POINTER] = JOB_TERM_NAME;
    JOB_TERM_NAME [0] = %C'_';

    STATUS = $GETJPIW (ITMLST = ITMLST);
    JOB_TERM_DESC [DSC$W_LENGTH] = .RSL_LENGTH + 1;

    IF NOT .STATUS OR .RSL_LENGTH EQL 0 THEN JOB_TERM_DESC [DSC$W_LENGTH] = 0;

!
! Open the output device and command device (if they are terminals)
!
    SYS_OUTPUT_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    SYS_OUTPUT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    SYS_OUTPUT_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE;
    SYS_OUTPUT_DESC [DSC$A_POINTER] = SYS_OUTPUT_NAME;
    STATUS = GET_DEV_CHAR (%ASCID'SYS$OUTPUT', SYS_OUTPUT_DESC, DEV_TYPE);

    IF .STATUS AND .DEV_TYPE EQL DC$_TERM
    THEN
    BEGIN
    STATUS = $ASSIGN (CHAN = SYS_OUTPUT_CHAN, DEVNAM = SYS_OUTPUT_DESC);

    IF .STATUS THEN SYS_OUTPUT_OPEN = TRUE;

    END;

    SYS_COMMAND_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    SYS_COMMAND_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    SYS_COMMAND_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE;
    SYS_COMMAND_DESC [DSC$A_POINTER] = SYS_COMMAND_NAME;
    STATUS = GET_DEV_CHAR (%ASCID'SYS$COMMAND', SYS_COMMAND_DESC, DEV_TYPE);

    IF .STATUS AND .DEV_TYPE EQL DC$_TERM
    THEN
    BEGIN
    STATUS = $ASSIGN (CHAN = SYS_COMMAND_CHAN, DEVNAM = SYS_COMMAND_DESC);

    IF .STATUS THEN SYS_COMMAND_OPEN = TRUE;

    END;
!
! 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] = TERM_NAME_SIZE;
!
! If KER$COMM is a terminal, then use it as the default.
!
    STATUS = GET_DEV_CHAR (%ASCID'KER$COMM', TERM_DESC, DEV_TYPE);

    IF NOT .STATUS OR .DEV_TYPE NEQ DC$_TERM
    THEN
    BEGIN
!
! If KER$COMM is not a terminal (or is not anything), try SYS$INPUT.
!
    TERM_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE;
    STATUS = GET_DEV_CHAR (%ASCID'SYS$INPUT', TERM_DESC, DEV_TYPE);

    IF NOT .STATUS OR .DEV_TYPE NEQ DC$_TERM
    THEN
        BEGIN
!
! If SYS$INPUT is not a terminal, check out SYS$OUTPUT.  We will already have
! it open if it is a terminal.
!

        IF .SYS_OUTPUT_OPEN
        THEN
        BEGIN
        CH$COPY (.SYS_OUTPUT_DESC [DSC$W_LENGTH],
            CH$PTR (.SYS_OUTPUT_DESC [DSC$A_POINTER]), CHR_NUL, TERM_NAME_SIZE,
            CH$PTR (TERM_NAME));
        TERM_DESC [DSC$W_LENGTH] = .SYS_OUTPUT_DESC [DSC$W_LENGTH];
        END
        ELSE
        BEGIN
!
! SYS$OUTPUT is not a terminal.  Next we try SYS$COMMAND.  It should already
! be open if it is a valid terminal.
!

        IF .SYS_COMMAND_OPEN
        THEN
            BEGIN
            CH$COPY (.SYS_COMMAND_DESC [DSC$W_LENGTH],
            CH$PTR (.SYS_COMMAND_DESC [DSC$A_POINTER]), CHR_NUL, TERM_NAME_SIZE,
            CH$PTR (TERM_NAME));
            TERM_DESC [DSC$W_LENGTH] = .SYS_OUTPUT_DESC [DSC$W_LENGTH];
            END
        ELSE
            BEGIN
!
! Here we start to get desparate.  Nothing we have tried so far was a terminal.
! Try the terminal which is controlling the job which owns this process.
!
            TERM_DESC [DSC$W_LENGTH] = .JOB_TERM_DESC [DSC$W_LENGTH];
            CH$COPY (.JOB_TERM_DESC [DSC$W_LENGTH],
            CH$PTR (.JOB_TERM_DESC [DSC$A_POINTER]), CHR_NUL, TERM_NAME_SIZE,
            CH$PTR (TERM_NAME));
            END;

        END;

        END;

    END;

!
! At this point TERM_DESC should be set up with something resembling
! the phyiscal name of a terminal (unless this is a detached process).
! We can now assign a channel to the terminal and tell the user what the
! default device is.
!
    CH$WCHAR (CHR_NUL, CH$PTR (TERM_NAME, .TERM_DESC [DSC$W_LENGTH]));
    status = asn_wth_mbx(term_desc, %REF(100), %REF(100), term_chan, mbx_chan);
    TERM_DUMP (UPLIT BYTE(CHR_CRT, CHR_LFD), 2);

    IF .STATUS
    THEN
    BEGIN

    BIND
        DEFTRM_TEXT = %ASCID'Default terminal for transfers is: ';

    MAP
        DEFTRM_TEXT : BLOCK [8, BYTE];

    TERM_OPEN_FLAG = TRUE;
    TERM_DUMP (.DEFTRM_TEXT [DSC$A_POINTER], .DEFTRM_TEXT [DSC$W_LENGTH]);
    TERM_DUMP (TERM_NAME, .TERM_DESC [DSC$W_LENGTH]);
        IF .mbx_chan NEQ 0 THEN Term_Hangup();
    END
    ELSE
    BEGIN

    BIND
        NODEFTRM_TEXT = %ASCID'No default terminal line for transfers';

    MAP
        NODEFTRM_TEXT : BLOCK [8, BYTE];

    TERM_OPEN_FLAG = FALSE;
    TERM_DESC [DSC$W_LENGTH] = 0;
    TERM_DUMP (.NODEFTRM_TEXT [DSC$A_POINTER], .NODEFTRM_TEXT [DSC$W_LENGTH])
    END;

    TERM_DUMP (UPLIT BYTE(CHR_CRT, CHR_LFD), 2);
!
! Initialize the flags
!
    TERM_FLAG = FALSE;
    TRANS_DELAY = '0';   ! init transmit delay to .0 seconds
!
! If we really did get the terminal open, then determine what type of
! parity it uses, and default to using that parity.
!

    IF .TERM_OPEN_FLAG
    THEN
    BEGIN
    STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SENSEMODE, P1 = OLD_TERM_CHAR,
        P2 = TC$_CHAR_LENGTH, IOSB = OLD_PARITY);

    IF .STATUS
    THEN

        IF (.OLD_PARITY [6, 0, 8, 0] AND TT$M_PARITY) NEQ 0
        THEN

        IF (.OLD_PARITY [6, 0, 8, 0] AND TT$M_ODD) NEQ 0
        THEN
            PARITY_TYPE = PR_ODD
        ELSE
            PARITY_TYPE = PR_EVEN

        ELSE
        PARITY_TYPE = PR_NONE;

    END;

    END;                    ! End of TERM_INIT


%SBTTL 'ASN_WTH_MBX - Assign channel to device and mailbox.'

global ROUTINE ASN_WTH_MBX(p_device_name, p_message_size, p_buffer_quota,
                           p_device_channel, p_mailbox_channel) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will assign a channel to TERM_DESC and if TERM_DESC is not
! the users' terminal create and assign a mailbox to receive messages
! about the outgoing session's state (in particular we're watching for
! SS$_HANGUP).
!
! CALLING SEQUENCE:
!
!    STATUS = ASN_WTH_MBX();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    TERM_DESC
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    TERM_CHAN, MBX_CHAN
!
! COMPLETION CODES:
!
!    Status of LIB$GETJPI, $ASN_WTH_MBX, and/or $ASSIGN
!
! SIDE EFFECTS:
!
!    A channel is assigned to TERM_CHAN and conditionally a mailbox
!       is created and a channel assigned to it.
!


BEGIN

    BIND
        buffer_quota = .p_buffer_quota,
        device_channel = .p_device_channel,
        device_name = .p_device_name,
        message_size = .p_message_size,
        mailbox_channel = .p_mailbox_channel;

    LOCAL
        master_pid,
        mode,
        sts,
        terminal_name : BLOCK [term_name_size, BYTE],
        terminal_desc : BLOCK [8, BYTE] PRESET
                                      ([DSC$B_CLASS] = DSC$K_CLASS_S,
                                       [DSC$B_DTYPE] = DSC$K_DTYPE_T,
                                       [DSC$W_LENGTH] = term_name_size,
                                       [DSC$A_POINTER] = terminal_name),
        temp_name : BLOCK [term_name_size, BYTE],
        temp_desc : BLOCK [8, BYTE] PRESET
                                  ([DSC$B_CLASS] = DSC$K_CLASS_S,
                                   [DSC$B_DTYPE] = DSC$K_DTYPE_T,
                                   [DSC$W_LENGTH] = term_name_size,
                                   [DSC$A_POINTER] = temp_name);
    MAP
        device_name : BLOCK [term_name_size, BYTE];

    sts = LIB$GETJPI(%REF(JPI$_MODE),0,0,mode);
    if .mode NEQ JPI$K_INTERACTIVE
    THEN
        $ASSIGN(CHAN = device_channel, DEVNAM = device_name)
    ELSE
        BEGIN

        sts = LIB$GETJPI(%REF(JPI$_MASTER_PID),0,0,master_pid,0,0);
        IF NOT .sts THEN RETURN .sts;

        sts = LIB$GETJPI(%REF(JPI$_TERMINAL),
                         master_pid,
                         0,
                         0,
                         temp_desc,
                         temp_desc);
        IF NOT .sts THEN RETURN .sts;
        IF .(.temp_desc[dsc$a_pointer] - 1 +
             .temp_desc[dsc$w_length])<0,8> NEQ %C ':'
        THEN
            BEGIN
            (.temp_desc[dsc$a_pointer] + .temp_desc[dsc$w_length])<0,8> = %C ':';
            temp_desc[dsc$w_length] = .temp_desc[dsc$w_length] + 1;
            END;

        sts = LIB$GETDVI(%REF(DVI$_DEVNAM),
                         0,
                         temp_desc,
                         0,
                         terminal_desc,
                         terminal_desc);
        IF NOT .sts THEN RETURN .sts;

        IF CH$EQL(.terminal_desc[DSC$W_LENGTH], .terminal_desc[DSC$A_POINTER],
                  .device_name[DSC$W_LENGTH], .device_name[DSC$A_POINTER],
                  %C' ')
        THEN
            BEGIN
            IF .mailbox_channel NEQ 0 THEN $DASSGN(CHAN = .mailbox_channel);
            mailbox_channel = 0;
            $ASSIGN(CHAN = device_channel, DEVNAM = device_name)
            END
        ELSE
            LIB$ASN_WTH_MBX(device_name, message_size, buffer_quota,
                            device_channel, mailbox_channel)
        END
END;

%SBTTL 'SET_TRANS_TERM - Set new transfer terminal line'

GLOBAL ROUTINE SET_TRANS_TERM (NEW_NAME) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will validate the terminal name that a user wishes to set
! as the transfer line.  If the name is valid, it will store the physical
! name in TERM_DESC, and open the new terminal line.
!
! CALLING SEQUENCE:
!
!    STATUS = SET_TRANS_TERM (NEW_NAME);
!
! INPUT PARAMETERS:
!
!    NEW_NAME - Descriptor for new terminal name.
!
! IMPLICIT INPUTS:
!
!    TERM_OPEN_FLAG, TERM_CHAN
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    True/false status value - error code
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    MAP
    NEW_NAME : REF BLOCK [8, BYTE];        ! Descriptor for new name

    LOCAL
    NEW_CHAN,                ! Temp for channel to new terminal
    RSL_DESC : BLOCK [8, BYTE],        ! Descriptor for physical name
    RSL_NAME : VECTOR [TERM_NAME_SIZE, BYTE],    ! String of resulting name
    DEV_TYPE,                ! Device type
    STATUS;                    ! Random status values

!
! Set up descriptor
!
    RSL_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    RSL_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    RSL_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE;    ! Maximum length
    RSL_DESC [DSC$A_POINTER] = RSL_NAME;    ! Where to store name
    STATUS = GET_DEV_CHAR (.NEW_NAME, RSL_DESC, DEV_TYPE);

    IF NOT .STATUS THEN RETURN .STATUS;

    IF .DEV_TYPE NEQ DC$_TERM THEN RETURN KER_LINTERM;

!
! The device is a terminal, now make sure we can get it.
!
! If we are CONNECTing to the same device and this device is a LAT
! device then we must deassign our channel to it (in order for things
! to reset properly).  There is a chance the reassignment will fail.
! If this happens then we are in a bad state - no valid output device.
!
! Otherwise keep a channel to either the old or new device at all times.
!
    IF CH$EQL(.rsl_desc[DSC$W_LENGTH], .rsl_desc[DSC$A_POINTER],
              .term_desc[DSC$W_LENGTH], .term_desc[DSC$A_POINTER],
              %C' ') AND
       CH$EQL(4, .rsl_desc[DSC$A_POINTER], 4, UPLIT('_LTA'))
!       (..rsl_desc[DSC$A_POINTER] EQL '_LTA')
    THEN
        BEGIN
        IF .mbx_chan NEQ 0
        THEN
            BEGIN
            $DASSGN (CHAN = .mbx_chan);
            mbx_chan = 0;
            END;
        $DASSGN (CHAN = .TERM_CHAN);
        status = asn_wth_mbx(rsl_desc, %REF(100), %REF(100),
                             new_chan, new_mbx_chan);
        IF NOT .STATUS THEN RETURN .STATUS;
        END
    ELSE
        BEGIN
        status = asn_wth_mbx(rsl_desc, %REF(100), %REF(100),
                             new_chan, new_mbx_chan);
        IF NOT .STATUS THEN RETURN .STATUS;
!
! We have the new terminal.  Deassign the old one and copy the new data
!
        $DASSGN (CHAN = .TERM_CHAN);
        IF .mbx_chan NEQ 0
        THEN
            BEGIN
            $DASSGN (CHAN = .mbx_chan);
            mbx_chan = 0;
            END;
        CH$COPY (.RSL_DESC [DSC$W_LENGTH], CH$PTR (RSL_NAME), CHR_NUL,
                 TERM_NAME_SIZE, CH$PTR (TERM_NAME));
        TERM_DESC [DSC$W_LENGTH] = .RSL_DESC [DSC$W_LENGTH];
        END;

    TERM_CHAN = .NEW_CHAN;
    IF .new_mbx_chan NEQ 0 THEN mbx_chan = .new_mbx_chan;
    IF .mbx_chan NEQ 0 THEN Term_Hangup();


    RETURN KER_NORMAL;
    END;                    ! End of SET_TRANS_TERM

%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 .SYS_OUTPUT_OPEN
    THEN
        $QIOW (CHAN = .SYS_OUTPUT_CHAN, EFN = CONS_O_EFN,
        FUNC = IO$_WRITEVBLK, P1 = .BUFFER_ADDRESS, P2 = .BUFFER_COUNT, P4 = 0)
    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
    STATUS,                    ! Status from $PUT
    TEXT_DESC : BLOCK [8, BYTE];

    IF NOT .CONNECT_FLAG AND NOT .DEBUG_REDIRECTED    ! Check where debugging should go
    THEN
    BEGIN

    IF .SYS_OUTPUT_OPEN
    THEN
        $QIOW (CHAN = .SYS_OUTPUT_CHAN, EFN = CONS_O_EFN,
        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
    ELSE

    IF .DEBUG_REDIRECTED
    THEN
        BEGIN

        EXTERNAL ROUTINE
        LOG_CHAR,            ! Routine to write a character to log file
        LOG_CLOSE;            ! Routine to close log file

        LOCAL
        POINTER;

        POINTER = CH$PTR (.BUFFER_ADDRESS);

        DECR I FROM .BUFFER_COUNT TO 1 DO

        IF NOT LOG_CHAR (CH$RCHAR_A (POINTER), DEBUG_RAB)
        THEN
            BEGIN
            LOG_CLOSE (DEBUG_FAB, DEBUG_RAB);
            DEBUG_REDIRECTED = FALSE;
            END;

        END;

    END;                    ! End of DBG_DUMP

%SBTTL 'GET_COMMAND - Get a command line'

GLOBAL ROUTINE GET_COMMAND (CMD_DESC, PROMPT_DESC, CMD_LENGTH, ECHO_FLAG) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will get a command line from SYS$COMMAND:.  If
! SYS$COMMAND is a terminal, it will do input using a QIO, which will
! allow input without echo if desired.  If SYS$COMMAND is not a terminal,
! it will use LIB$GET_COMMAND.
!
! CALLING SEQUENCE:
!
!    STATUS = GET_COMMAND (CMD_DESC, PROMPT_DESC, CMD_LENGTH, ECHO_FLAG);
!
! INPUT PARAMETERS:
!
!    CMD_DESC - String descriptor for command being input
!    PROMPT_DESC - String descriptor for prompt
!    ECHO_FLAG - True if input should be echoed, false if not
!
! IMPLICIT INPUTS:
!
!    SYS_COMMAND_OPEN - Flag whether SYS$COMMAND is open
!    SYS_COMMAND_CHAN - Channel SYS$COMMAND is open on, if open
!
! OUPTUT PARAMETERS:
!
!    CMD_LENGTH - Actual length of command input
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    Returns status value, true unless error has occured.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    MAP
    CMD_DESC : REF BLOCK [8, BYTE],        ! Where to put input
    PROMPT_DESC : REF BLOCK [8, BYTE];    ! Prompt string

    EXTERNAL ROUTINE
    TT_CRLF : NOVALUE, ! Type a CRLF
    STR$UPCASE : ADDRESSING_MODE (GENERAL),    ! Upcase a string
    LIB$GET_COMMAND : ADDRESSING_MODE (GENERAL);    ! Get string from SYS$COMMAND

    LOCAL
    QIO_FUNC,                ! Function for QIO
    IOSB : VECTOR [4, WORD],        ! IOSB for QIO
    STATUS;                    ! Random status values

    IF .SYS_COMMAND_OPEN
    THEN
    BEGIN
    QIO_FUNC = IO$_READPROMPT;        ! Assume just read with prompt

    IF NOT .ECHO_FLAG THEN QIO_FUNC = IO$_READPROMPT OR IO$M_NOECHO;    ! Don't echo input

    STATUS = $QIOW (CHAN = .SYS_COMMAND_CHAN, FUNC = .QIO_FUNC, IOSB = IOSB,
        P1 = .CMD_DESC [DSC$A_POINTER], P2 = .CMD_DESC [DSC$W_LENGTH],
        P5 = .PROMPT_DESC [DSC$A_POINTER], P6 = .PROMPT_DESC [DSC$W_LENGTH]);

    IF NOT .STATUS THEN RETURN .STATUS;

!
! If we didn't echo, then dump a CRLF so we look nice
!

    IF NOT .ECHO_FLAG THEN TT_CRLF ();

    IF .IOSB [0]
    THEN
        BEGIN
        .CMD_LENGTH = .IOSB [1];        ! Get actual length input

        IF .IOSB [3] EQL 1 AND .IOSB [2] EQL CHR_CTL_Z THEN RETURN RMS$_EOF;

        END;

!
! Upcase the resulting string
!
    STATUS = STR$UPCASE (.CMD_DESC, .CMD_DESC);

    IF NOT .STATUS THEN RETURN .STATUS;

    RETURN .IOSB [0];            ! Return resulting status
    END;

!
! Here if SYS$COMMAND is not open.  Get the command via LIB$GET_COMMAND.
!
    RETURN LIB$GET_COMMAND (.CMD_DESC, .PROMPT_DESC, .CMD_LENGTH);
    END;                    ! End of GET_COMMAND

%SBTTL 'Communcations line -- TERM_OPEN'

GLOBAL ROUTINE TERM_OPEN (POST_QIOS) =

!++
! 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(POST_QIOS);
!
! INPUT PARAMETERS:
!
!    POST_QIOS - True if initial read QIO's should be posted.
!
! IMPLICIT INPUTS:
!
!    TERM_DESC - Descriptor of a vector of ASCII characters that represent
!    the name of the terminal to use.
!
!    TERM_CHAN - Channel open to terminal if TERM_OPEN_FLAG is true.
!
! 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

    EXTERNAL ROUTINE
    LOG_FAOL,                ! Write FAOL style text
    LOG_OPEN;                ! Open a log file

    EXTERNAL
    TRANSACTION_OPEN,
    TRANSACTION_DESC : BLOCK [8, BYTE],
    TRANSACTION_FAB : $FAB_DECL,
    TRANSACTION_RAB : $RAB_DECL;

    LOCAL
    STATUS;

!
! If the terminal is not open, we must open it first.
!

    IF NOT .TERM_OPEN_FLAG
    THEN

    IF .TERM_DESC [DSC$W_LENGTH] GTR 0
    THEN
        BEGIN
        STATUS = SET_TRANS_TERM (TERM_DESC);

        IF NOT .STATUS THEN RETURN .STATUS;

        END
    ELSE
        RETURN KER_LINTERM;

!
! Set up connect flag properly
!

    IF CH$NEQ (.SYS_OUTPUT_DESC [DSC$W_LENGTH], CH$PTR (.SYS_OUTPUT_DESC [DSC$A_POINTER]),
        .TERM_DESC [DSC$W_LENGTH], CH$PTR (TERM_NAME), CHR_NUL) OR NOT .SYS_OUTPUT_OPEN
    THEN
    CONNECT_FLAG = FALSE
    ELSE
    CONNECT_FLAG = TRUE;

!
! If we aren't connected, remember the channel to use for the console I/O
!

    IF NOT .CONNECT_FLAG AND .SYS_OUTPUT_OPEN THEN CONS_CHAN = .SYS_OUTPUT_CHAN;

!
! Get current settings for transfer terminal
!
    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_NOBRDCST) AND NOT (TT$M_CRFILL OR
    TT$M_LFFILL OR TT$M_WRAP OR TT$M_NOTYPEAHD);
! We do not want to use eightbit if using parity

    IF .PARITY_TYPE EQL PR_NONE
    THEN
    NEW_TERM_CHAR [TC$_CHAR] = .NEW_TERM_CHAR [TC$_CHAR] OR TT$M_EIGHTBIT
    ELSE
    NEW_TERM_CHAR [TC$_CHAR] = .NEW_TERM_CHAR [TC$_CHAR] AND NOT TT$M_EIGHTBIT;

    NEW_TERM_CHAR [TC$_CHAR_2] = TT2$M_XON OR TT2$M_PASTHRU OR
    (.OLD_TERM_CHAR [TC$_CHAR_2] AND NOT TT2$M_FALLBACK);

    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
    FORCE_TIMEOUT = FALSE;            ! Don't timeout for no reason
    FORCE_ABORT = FALSE;            ! Don't abort yet
!
! Now post the initial receive QIO
!

    IF .POST_QIOS                ! Need the QIO's?
    THEN
    BEGIN
    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 AND .SYS_OUTPUT_OPEN
    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;

    END;

!
! Open any debugging log file
!

    IF .DEBUG_DESC [DSC$W_LENGTH] GTR 0
    THEN

    IF LOG_OPEN (DEBUG_DESC, DEBUG_FAB, DEBUG_RAB)
    THEN
        DEBUG_REDIRECTED = TRUE
    ELSE
        DEBUG_REDIRECTED = FALSE

    ELSE
    DEBUG_REDIRECTED = FALSE;

    IF .TRANSACTION_DESC [DSC$W_LENGTH] GTR 0
    THEN

    IF LOG_OPEN (TRANSACTION_DESC, TRANSACTION_FAB, TRANSACTION_RAB)
    THEN
        BEGIN
        TRANSACTION_OPEN = TRUE;
        LOG_FAOL (%ASCID'!-!-!11%D!/!-!%T!_Starting transaction log in file !AS!/',
        UPLIT (0, TRANSACTION_DESC), TRANSACTION_RAB);
        END
    ELSE
        TRANSACTION_OPEN = FALSE

    ELSE
    TRANSACTION_OPEN = FALSE;

    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

    EXTERNAL ROUTINE
    LOG_FAOL,                ! Routine to dump FAOL string
    LOG_CLOSE;                ! Routine to close log file

    EXTERNAL
    TRANSACTION_OPEN,
    TRANSACTION_DESC : BLOCK [8, BYTE],
    TRANSACTION_FAB,
    TRANSACTION_RAB;

    LOCAL
    PAR,                    ! Parity being set
    STATUS;                    ! Status returned by system service

    STATUS = $CANCEL (CHAN = .TERM_CHAN);    ! Kill pending QIO

    IF .SYS_OUTPUT_OPEN THEN $CANCEL (CHAN = .CONS_CHAN);

    CONNECT_FLAG = FALSE;
    PAR = (.OLD_PARITY [6, 0, 8, 0] AND (TT$M_ODD OR TT$M_PARITY)) OR TT$M_ALTRPAR;
                        ! Only set parity
    STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SETMODE, P1 = OLD_TERM_CHAR,
    P2 = TC$_CHAR_LENGTH, P4 = .OLD_PARITY [4, 0, 16, 0], P5 = .PAR);

    IF NOT .STATUS
    THEN
    BEGIN
    LIB$SIGNAL (.STATUS);
    RETURN .STATUS;
    END;

!
! Flag terminal parameters are reset
!
    TERM_FLAG = FALSE;
!
! Close the debugging log file
!

    IF .DEBUG_REDIRECTED
    THEN
    BEGIN
    LOG_CLOSE (DEBUG_FAB, DEBUG_RAB);
    DEBUG_REDIRECTED = FALSE;
    END;

!
! Close the transaction log
!

    IF .TRANSACTION_OPEN
    THEN
    BEGIN
    LOG_FAOL (%ASCID'!-!-!11%D!/!-!%T!_Closing transaction log file !AS!/',
        UPLIT (0, TRANSACTION_DESC), TRANSACTION_RAB);
    LOG_CLOSE (TRANSACTION_FAB, TRANSACTION_RAB);
    TRANSACTION_OPEN = FALSE;
    END;

!
! If all worked, say so
!
    RETURN KER_NORMAL
    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
    CUR_EFN,                ! Current EFN settings
    STATUS;                    ! Status returned by $QIOW

!
! If we already got a complete buffer of input we should ignore it.
! This is because we are probably retransmitting something and the
! incoming data is the response to the previous copy of this message.
! If we don't ignore it, we could get into a situation where every message
! gets transmitted twice.
!
    STATUS = $READEF (EFN = TERM_EFN, STATE = CUR_EFN);

    IF (.CUR_EFN AND 1^TERM_EFN) EQL 1 THEN DO_RECEIVE_QIO ();

    STATUS = $QIOW (CHAN = .TERM_CHAN, EFN = TERM_O_EFN, 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

    EXTERNAL
    RCV_SOH;                ! Character to use for start of packet

    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

    OWN
    INT_CHR_SEEN;                ! Interrupt character seen last

!
! Flag we haven't seen a ^Y yet.  We must get two control-Y's in fairly
! quick succession (no timeouts in between) in order to give up.
!
    INT_CHR_SEEN = FALSE;
!
! Set up the timer if we have a time out parameter
!

    IF NOT .FORCE_TIMEOUT THEN STATUS = $CLREF (EFN = TIME_EFN);

    IF .SEND_TIMEOUT GTR 0
    THEN
    BEGIN
    STATUS = $CANTIM (REQIDT = TIME_EFN);
    STATUS = $GETTIM (TIMADR = TIMER_VALUE);
    STATUS = LIB$EMUL (SEND_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);
    FORCE_TIMEOUT = FALSE;            ! Timeout had it chance to happen
!
! 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;

!
! If we have a request to abort, start it up the chain.
!

    IF .FORCE_ABORT
    THEN
        BEGIN
        STATUS = $CANTIM (REQIDT = TIME_EFN);
        RETURN KER_ABORTED;
        END;

!
! 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

        IF .INT_CHR_SEEN AND .IO_STATUS [1] EQL 0
        THEN
            BEGIN
            STATUS = $CANTIM (REQIDT = TIME_EFN);
            RETURN KER_ABORTED
            END
        ELSE
            BEGIN
            INT_CHR_SEEN = TRUE;
            IO_STATUS [1] = 0;        ! Force no input seen
            END

        END
        ELSE
        INT_CHR_SEEN = FALSE;        ! Last character not ^Y

!
! 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, .RCV_SOH);
!
! 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), .RCV_SOH);
        ! 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    ! Have eight-bit?
        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 .SEND_TIMEOUT GTR 0
    THEN
    BEGIN
    STATUS = $CANTIM (REQIDT = TIME_EFN);
    STATUS = $GETTIM (TIMADR = TIMER_VALUE);
    STATUS = LIB$EMUL (SEND_TIMEOUT, UPLIT (1000000), 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 'GET_DEV_CHAR - Determine device characteristics'
    ROUTINE GET_DEV_CHAR (LOG_NAME_DESC, PHYS_NAME_DESC, DEV_CLASS) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will get the device characteristics from VMS.  It returns
! both the physical name of the device and the device class.
!
! CALLING SEQUENCE:
!
!    STATUS = GET_DEV_CHAR (LOG_NAME_DESC, PHYS_NAME_DESC, DEV_CLASS);
!
! INPUT PARAMETERS:
!
!    LOG_NAME_DESC - Descriptor for logical device for which the device
!            class is desired.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    PHYS_NAME_DESC - Descriptor for physical device name
!    DEV_CLASS - Device class for device
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES/RETURN VALUE:
!
!    Status value returned from $GETDVI if it fails,
!        KER_NORMAL otherwise.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    MAP
    PHYS_NAME_DESC : REF BLOCK [8, BYTE];    ! Physical name descriptor

    LOCAL
    ITMLST : ITEM_LIST [2] FIELD (ITEM_FIELDS),
    PHYS_NAME_LENGTH : VOLATILE,
    STATUS;

!
! Set up item list for device class
!
    ITMLST [0, ITEM_ITEM_CODE] = DVI$_DEVCLASS;
    ITMLST [0, ITEM_BFR_LENGTH] = 4;        ! 4 byte result
    ITMLST [0, ITEM_BFR_ADDRESS] = .DEV_CLASS;    ! Where to return result
    ITMLST [0, ITEM_RTN_LENGTH] = 0;        ! We know how long it is
!
! Item list entry for device name
!
    ITMLST [1, ITEM_ITEM_CODE] = DVI$_DEVNAM;    ! Want the name of the device
    ITMLST [1, ITEM_BFR_LENGTH] = .PHYS_NAME_DESC [DSC$W_LENGTH];    ! Max length to return
    ITMLST [1, ITEM_BFR_ADDRESS] = .PHYS_NAME_DESC [DSC$A_POINTER];    ! Where to return name
    ITMLST [1, ITEM_RTN_LENGTH] = PHYS_NAME_LENGTH;    ! Where to return length
!
! End the list of items
!
    ITMLST [2, ITEM_ITEM_CODE] = 0;
    ITMLST [2, ITEM_BFR_LENGTH] = 0;
!
! Request the information
!
    STATUS = $GETDVIW (EFN = GET_DEV_EFN, DEVNAM = .LOG_NAME_DESC, ITMLST = ITMLST);

    IF NOT .STATUS THEN RETURN .STATUS;
!
! Assign the length and return happy
!
    PHYS_NAME_DESC [DSC$W_LENGTH] = .PHYS_NAME_LENGTH;
    RETURN KER_NORMAL;
    END;                    ! End of GET_DEV_CHAR
%SBTTL 'Term_Hangup'
global ROUTINE Term_Hangup : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine puts a read-attention AST on the mailbox associated with
! TERM_DESC - the port being used for external communications.  The
! mailbox will receive 3 types of messages: Unsolicited data, Terminal
! hangup, and Broadcast messages.  Only Terminal hangup messages are of
! interest here.
!
!
! CALLING SEQUENCE:
!
!    TERM_HANGUP();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    MBX_CHAN - The channel to the mailbox associated with TERM_DESC.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    Return status from $QIOW
!
! SIDE EFFECTS:
!
!    A write-attention AST is queued to the mailbox.  The ast routine
!    MBX_AST_RTN will be called if a message is written to the mailbox.
!
!--

    BEGIN

    LOCAL
        Function,
        Iosb : VECTOR [4, WORD],    ! I/O status block.
    Sts;

    Function = IO$_SETMODE + IO$M_WRTATTN;
    Sts = $QIOW(CHAN = .Mbx_Chan,
                FUNC = .Function,
                IOSB = Iosb,
                P1 = Mbx_Ast_Rtn);

    IF .sts THEN sts = .Iosb[0];
    IF NOT .sts THEN LIB$SIGNAL(.Sts);

    END;
%SBTTL 'Mbx_Ast_Rtn'
ROUTINE Mbx_Ast_Rtn : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine is called at AST level whenever a mailbox message
!    arrives in the mailbox associated with TERM_DESC.  If the message
!    is a hangup notification the user will be 1) notified his outgoing
!    connection is no longer present (technically there is no longer
!    a channel to the device represented in TERM_DESC) and 2)
!
! CALLING SEQUENCE:
!
!    MBX_AST_RTN();
!
! INPUT PARAMETERS:
!
!       None.
!
! IMPLICIT INPUTS:
!
!    TERM_DESC
!    MBX_CHAN - The channel to the mailbox associated with TERM_DESC.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    MBX_CHAN
!
! COMPLETION CODES:
!
!    SS$_NORMAL or error condition.
!
! SIDE EFFECTS:
!
!    A message may be output to the user if his outgoing session is
!    no longer valid.
!
!--

    BEGIN

    LOCAL
        Function,
        Iosb : VECTOR [4, WORD],
        Mbx_Msg : VECTOR [124, BYTE],
        Sts;


    Function = IO$_READVBLK;

    Sts = $QIOW(CHAN = .Mbx_Chan,
                FUNC = .Function,
                IOSB = Iosb,
                P1 = Mbx_Msg,
                P2 = 100);

    IF .Sts THEN Sts = .Iosb[0];
    IF NOT .sts THEN LIB$SIGNAL(.Sts);

    IF .Mbx_Msg<0,16> EQL MSG$_TRMHANGUP
    THEN
        BEGIN
!        asn_wth_mbx(term_desc, %REF(100), %REF(100), term_chan, mbx_chan);
        $DASSGN(CHAN = .mbx_chan);
        mbx_chan = 0;
        LIB$SIGNAL(SS$_HANGUP)
        END
    ELSE
        Term_Hangup();

    END;

%SBTTL 'Send_Break_TTY'
GLOBAL ROUTINE Send_Break_TTY =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine sends a break to the user's current terminal line.
!
!
! CALLING SEQUENCE:
!
!    STATUS = Send_Break_TTY ();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    Term_Desc - The current outgoing terminal line.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    Return status from $QIOW
!
! SIDE EFFECTS:
!
!    A break is sent to the user's outgoing terminal line.
!
!--

    BEGIN

    LOCAL
        Char : VECTOR [2],        ! Terminal characteristics.
        Iosb : VECTOR [4, WORD],    ! I/O status block.
        Parity_Flags,
        Sts;

    Sts = $QIOW(CHAN = .Term_Chan,
                FUNC = IO$_SENSEMODE,
                IOSB = Iosb,
                P1 = Char);
    IF .Sts THEN Sts = .Iosb [0];
    IF NOT .Sts THEN RETURN .Sts;

    Parity_Flags<4,16> = .Iosb [3];

    Sts = $QIOW(CHAN = .Term_Chan,
                FUNC = IO$_SETMODE,
                IOSB = Iosb,
                P1 = Char,
                P5 = (.Parity_Flags OR TT$M_BREAK));
    IF .Sts THEN Sts = .Iosb [0];
    IF NOT .Sts THEN RETURN .Sts;

    LIB$WAIT(%REF(%E'0.25'));

    Sts = $QIOW(CHAN = .Term_Chan,
                FUNC = IO$_SETMODE,
                IOSB = Iosb,
                P1 = Char,
                P5 = .Parity_Flags);
    IF (.Sts) THEN Sts = .Iosb [0];

    Send_Break_TTY_Flag = 0;

    RETURN .Sts;
    END;
%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_CHAR GEQ 0 THEN TERMINATOR [1] = .TERMINATOR [1] OR 1^.IBM_CHAR;

                        ! Need IBM turnaround?
!
! Initialize the QIO function
! Always purge typeahead
!
    QIO_FUNC = IO$_TTYREADALL OR IO$M_NOECHO OR IO$M_PURGE;
    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,
    DEBUG_FLAG,
    TYP_STS_FLAG;

    LOCAL
    I,                    ! Random index variable
    TERMINATOR : VECTOR [2, LONG],        ! Pointer at terminator mask
    TERM_MASK : VECTOR [8, LONG],        ! Terminator mask
    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

        SELECT .CONS_STATUS [2] OF
        SET

        [CHR_CTL_Z] :
            ABT_ALL_FILE = TRUE;

        [CHR_CTL_X] :
            ABT_CUR_FILE = TRUE;

        [CHR_CTL_Y] :
            RETURN SS$_NORMAL;

        [CHR_CTL_C] :
            BEGIN
            FORCE_TIMEOUT = TRUE;
            FORCE_ABORT = TRUE;
            END;

        [CHR_CTL_D] :
            DEBUG_FLAG = NOT .DEBUG_FLAG;

        [CHR_CTL_A] :
            TYP_STS_FLAG = TRUE;

        [CHR_CTL_M] :
            FORCE_TIMEOUT = TRUE;

        [CHR_CTL_Z, CHR_CTL_X, CHR_CTL_A, CHR_CTL_M, CHR_CTL_C] :
! Make sure what we did gets noticed, even if we are currently waiting
! forever for input.

            IF .FORCE_TIMEOUT OR .SEND_TIMEOUT EQL 0 THEN $SETEF (EFN = TIME_EFN);

        TES;

    IF .CONS_STATUS [0] NEQ SS$_CANCEL AND .CONS_STATUS [0] NEQ SS$_ABORT
    THEN
        RETURN DO_CONS_QIO ()
    ELSE
        RETURN SS$_NORMAL;

    END;
!
! Start of main portion of DO_CONS_QIO
!
    TERMINATOR [0] = 32;            ! Length of terminator mask in bytes
    TERMINATOR [1] = TERM_MASK;            ! Address of mask

    INCR I FROM 0 TO 7 DO
    TERM_MASK [.I] = -1;            ! All characters are terminators

    RETURN $QIO (CHAN = .CONS_CHAN, EFN = CONS_EFN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO,
        IOSB = CONS_STATUS, ASTADR = CONS_AST, P1 = CONS_BUFFER, P2 = CONS_BUFF_SIZE,
        P4 = TERMINATOR);
    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

    EXTERNAL ROUTINE
    LOG_OPEN,                ! Open log file
    LOG_CLOSE;                ! Close log file

    LITERAL
    OUT_BUFLEN = 80,            ! Max # of char. in output buffer
    INP_BUFSIZ = 80,            ! 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
    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
    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
    MYT_QIO_FUNC,                ! Function for QIO input for my terminal
    ESC_CHR_LEN,                ! Length of escape character message
    ESC_CHR_MSG : VECTOR [30, BYTE],    ! Escape character message
    STATE;                    ! Used by $READEF to store state of EFs

    BIND
    CON_MSG_1 = %ASCID'Connecting to ',
    CON_MSG_2 = %ASCID'.  Type ',
    CON_MSG_3 = %ASCID'C to return to VAX/VMS Kermit-32]',
    CON_MSG_4 = %ASCID'Returning to VAX/VMS Kermit-32]';

    MAP
    CON_MSG_1 : BLOCK [8, BYTE],
    CON_MSG_2 : BLOCK [8, BYTE],
    CON_MSG_3 : BLOCK [8, BYTE],
    CON_MSG_4 : BLOCK [8, BYTE];

    BIND
    ATIMUP = %ASCID'0 00:00:00.050',    ! Time to wait for more output
    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_POINTER, 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

    EXTERNAL ROUTINE
        LOG_CHAR,                ! Routine to log characters
        GEN_PARITY;                ! Routine to generate parity

    LOCAL
        STATUS;

    IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN RETURN;

    IF .NUM_CHR_IN EQL 0 THEN RETURN .STATUS;

    IF .NUM_CHR_IN + .CHR_COUNT [.DEV] GTR OUT_BUFLEN
    THEN
        BEGIN
!
! If we don't have enough room in the buffer for all of the characters, call
! ourself to dump what will fit, then proceed with what remains.
!

        LOCAL
        SAVED_CHR_CNT;            ! Saved character count

        SAVED_CHR_CNT = OUT_BUFLEN - .CHR_COUNT [.DEV];
        NUM_CHR_IN = .NUM_CHR_IN - .SAVED_CHR_CNT;
        STORE_INPUT (.DEV, .INP_POINTER, .SAVED_CHR_CNT);
        INP_POINTER = CH$PLUS (.INP_POINTER, .SAVED_CHR_CNT);
        END;

    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;

! We must generate parity for the communications terminal

    IF .DEV EQL 0
    THEN
        BEGIN

        LOCAL
        POINTER;

        POINTER = .INP_POINTER;

        DECR I FROM .NUM_CHR_IN TO 1 DO
        CH$WCHAR_A (GEN_PARITY (CH$RCHAR_A (POINTER)), OUT_PTR [.DEV]);

        END
    ELSE
        OUT_PTR [.DEV] = CH$MOVE (.NUM_CHR_IN, .INP_POINTER, .OUT_PTR [.DEV]);

!
! If we want logging, do it now
!

    IF (.DEV EQL 1 OR .ECHO_FLAG) AND .SESSION_OPEN AND .SESSION_LOGGING
    THEN
        BEGIN

        LOCAL
        STATUS,
        POINTER;

        POINTER = .INP_POINTER;

        DECR I FROM .NUM_CHR_IN TO 1 DO

        IF NOT LOG_CHAR (CH$RCHAR_A (POINTER), SESSION_RAB)
        THEN
            BEGIN
            SESSION_LOGGING = FALSE;
            EXITLOOP;
            END;

        END;

    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
        ROUTINE TYPE_MSG (MSG_DESC, OPEN_FLAG, CLOSE_FLAG, CRLF_FLAG) : NOVALUE =
        BEGIN

        MAP
            MSG_DESC : REF BLOCK [8, BYTE];

        IF .OPEN_FLAG
        THEN
            BEGIN
            STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(%C'[')), 1);

            IF .NODE_DESC [DSC$W_LENGTH] GTR 0
            THEN
            STORE_INPUT (TRM,
                CH$PTR (.NODE_DESC [DSC$A_POINTER]), .NODE_DESC [DSC$W_LENGTH]);

            END;

        STORE_INPUT (TRM, CH$PTR (.MSG_DESC [DSC$A_POINTER]), .MSG_DESC [DSC$W_LENGTH]);

        IF .CLOSE_FLAG THEN STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(%C']')), 1);

        IF .CRLF_FLAG THEN STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(CHR_CRT, CHR_LFD)), 2);

        END;

        LOCAL
        EAT_CHR,            ! Number of input characters to eat
        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;

        EAT_CHR = 0;            ! No characters to eat

        SELECTONE CH$RCHAR (.ESC_PTR) OF
        SET

        ['?'] :
            BEGIN
            TYPE_MSG (%ASCID'Escape commands are:', TRUE, FALSE, TRUE);
                    Type_Msg (%ASCID'    B - Sends a break', FALSE, FALSE, TRUE);
            TYPE_MSG (%ASCID'    C - Return to VAX/VMS Kermit-32', FALSE, FALSE, TRUE);
            TYPE_MSG (%ASCID'    Q - Suspend logging to session log file (if any)', FALSE,
            FALSE, TRUE);
            TYPE_MSG (%ASCID'    R - Resume logging to session log file (if any)', FALSE,
            FALSE, TRUE);
            TYPE_MSG (%ASCID'    S - Show status', FALSE, FALSE, TRUE);
            TYPE_MSG (%ASCID'    0 - Send a null', FALSE, FALSE, TRUE);
            TYPE_MSG (%ASCID'    ? - Type this text', FALSE, FALSE, TRUE);
            TYPE_MSG (%ASCID'    ', FALSE, FALSE, FALSE);
            STORE_INPUT (TRM, ESC_CHR_MSG, .ESC_CHR_LEN);
            TYPE_MSG (%ASCID' - Send escape character', FALSE, TRUE, TRUE);
            EAT_CHR = 1;
            END;

        ['B', 'b'] :
                    BEGIN
                    Send_Break_TTY_Flag = 1;
            EAT_CHR = 1;
                    END;

        ['C', 'c'] :
            BEGIN
            NUM_CHR_IN = .INDEX;
            RETURN TRUE;
            END;

        ['Q', 'q'] :
            BEGIN

            BIND
            NO_LOG_TEXT = %ASCID'logging already disabled',
            STOP_LOG_TEXT = %ASCID'logging disabled';

            IF .SESSION_LOGGING
            THEN
            TYPE_MSG (STOP_LOG_TEXT, TRUE, TRUE, TRUE)
            ELSE
            TYPE_MSG (NO_LOG_TEXT, TRUE, TRUE, TRUE);

            SESSION_LOGGING = FALSE;
            EAT_CHR = 1;
            END;

        ['R', 'r'] :
            BEGIN            ! Resume logging

            BIND
            NO_LOG_TEXT = %ASCID'no log file to enable',
            START_LOG_TEXT = %ASCID'logging enabled';

            SESSION_LOGGING = .SESSION_OPEN;

            IF .SESSION_LOGGING
            THEN
            TYPE_MSG (START_LOG_TEXT, TRUE, TRUE, TRUE)
            ELSE
            TYPE_MSG (NO_LOG_TEXT, TRUE, TRUE, TRUE);

            EAT_CHR = 1;
            END;

        ['S', 's'] :
            BEGIN
            TYPE_MSG (%ASCID'Connected to ', TRUE, FALSE, FALSE);
            TYPE_MSG (TERM_DESC, FALSE, FALSE, TRUE);
            TYPE_MSG (%ASCID'    Escape character: "', FALSE, FALSE, FALSE);
            STORE_INPUT (TRM, ESC_CHR_MSG, .ESC_CHR_LEN);
            TYPE_MSG (%ASCID'"', FALSE, FALSE, TRUE);
            TYPE_MSG (%ASCID'    Local echo: ', FALSE, FALSE, FALSE);

            IF .ECHO_FLAG
            THEN
            TYPE_MSG (%ASCID'On', FALSE, FALSE, TRUE)
            ELSE
            TYPE_MSG (%ASCID'Off', FALSE, FALSE, TRUE);

            TYPE_MSG (%ASCID'    Parity: ', FALSE, FALSE, FALSE);

            CASE .PARITY_TYPE FROM PR_MIN TO PR_MAX OF
            SET

            [PR_NONE] :
                TYPE_MSG (%ASCID'None', FALSE, FALSE, TRUE);

            [PR_ODD] :
                TYPE_MSG (%ASCID'Odd', FALSE, FALSE, TRUE);

            [PR_EVEN] :
                TYPE_MSG (%ASCID'Even', FALSE, FALSE, TRUE);

            [PR_MARK] :
                TYPE_MSG (%ASCID'Mark', FALSE, FALSE, TRUE);

            [PR_SPACE] :
                TYPE_MSG (%ASCID'Space', FALSE, FALSE, TRUE);
            TES;

            TYPE_MSG (%ASCID'    Logging: ', FALSE, FALSE, FALSE);

            IF .SESSION_OPEN GTR 0
            THEN
            BEGIN
            TYPE_MSG (SESSION_DESC, FALSE, FALSE, FALSE);

            IF .SESSION_LOGGING
            THEN
                TYPE_MSG (%ASCID' Enabled', FALSE, TRUE, TRUE)
            ELSE
                TYPE_MSG (%ASCID' Disabled', FALSE, TRUE, TRUE);

            END
            ELSE
            TYPE_MSG (%ASCID' None specifed', FALSE, TRUE, TRUE);

            EAT_CHR = 1;        ! Eat the "S"
            END;

        [.ESCAPE_CHR] :
            CH$WCHAR (.ESCAPE_CHR, .ESC_PTR);    ! Write the escape character

        ['0'] :
            CH$WCHAR (CHR_NUL, .ESC_PTR);    ! Write a null

        [OTHERWISE] :
            BEGIN            ! Send a bell char. to MY_TERM
            STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(CHR_BEL)), 1);
            EAT_CHR = 1;        ! Eat the character
            END;
        TES;

        IF .EAT_CHR GTR 0
        THEN

        IF (NUM_CHR_IN = .NUM_CHR_IN - .EAT_CHR) NEQ .INDEX
        THEN
            CH$COPY (.NUM_CHR_IN - .INDEX, CH$PLUS (.ESC_PTR, .EAT_CHR), CHR_NUL,
            .NUM_CHR_IN - .INDEX, .ESC_PTR);

        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, CH$PTR (INP_BUF [MYT, .INP_BUFNUM]), .NUM_CHR_IN);

                        ! Store char.

    IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) EQL SS$_WASCLR
    THEN
! If we got some characters, then queue up the next read for lots of
! characters with a 0 timeout (get what we can).  Otherwise queue up
! a read for one character waiting forever.

        IF .NUM_CHR_IN GTR 0 OR .INP_BUFNUM NEQ 0
        THEN
! Queue up a read for the console terminal
        STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC OR IO$M_TIMED,
            ASTADR = MYTINP, P1 = INP_BUF [MYT, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = 0,
            ASTPRM = .INP_BUFNUM, IOSB = IN_IOSB [MYT, .INP_BUFNUM, 0])
        ELSE
        STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC, ASTADR = MYTINP,
            P1 = INP_BUF [MYT, .INP_BUFNUM], P2 = 1, 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, CH$PTR (INP_BUF [TRM, .INP_BUFNUM]),
        .NUM_CHR_IN);

    IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) EQL SS$_WASCLR
    THEN
            BEGIN

! Now that there are no pending I/Os we can call the routine to send
! a break signal to the outgoing terminal line if necessary.
! Pending I/Os would block the QIO SETMODE instruction from taking
! place, effectively hanging kermit until the current I/O read
! completes (if ever).

            IF .Send_Break_TTY_Flag EQL 1
            THEN Send_Break_TTY ();

!
! If we actually got something input, then queue up a read with a 0
! timeout for the whole buffer.  Otherwise, queue up a single character
! read, if this is the first buffer.
!

        IF .NUM_CHR_IN GTR 0 OR .INP_BUFNUM NEQ 0
        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 = 0,
            IOSB = IN_IOSB [TRM,
            .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM)
        ELSE
        STATUS = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO,
            ASTADR = TRMINP, P1 = INP_BUF [TRM, .INP_BUFNUM], P2 = 1,
            IOSB = IN_IOSB [TRM,
            .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM);

            END;

    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 (ESC_TEXT) =
    BEGIN

    MAP
        ESC_TEXT : REF VECTOR [, BYTE];

    SELECTONE .ESCAPE_CHR OF
        SET

        [CHR_NUL, 0] :
        BEGIN

        BIND
            NUL_TXT = %ASCID'^@ or control-space on VT-100';

        MAP
            NUL_TXT : BLOCK [8, BYTE];

        CH$MOVE (.NUL_TXT [DSC$W_LENGTH], CH$PTR (.NUL_TXT [DSC$A_POINTER]),
            CH$PTR (.ESC_TEXT));
        RETURN .NUL_TXT [DSC$W_LENGTH];
        END;

        [CHR_RS, %O'36'] :
        BEGIN

        BIND
            RS_TXT = %ASCID'^^ or ^~ on VT-100';

        MAP
            RS_TXT : BLOCK [8, BYTE];

        CH$MOVE (.RS_TXT [DSC$W_LENGTH], CH$PTR (.RS_TXT [DSC$A_POINTER]),
            CH$PTR (.ESC_TEXT));
        RETURN .RS_TXT [DSC$W_LENGTH];
        END;

        [CHR_US, %O'37'] :
        BEGIN

        BIND
            US_TXT = %ASCID'^_ or ^? on VT-100';

        MAP
            US_TXT : BLOCK [8, BYTE];

        CH$MOVE (.US_TXT [DSC$W_LENGTH], CH$PTR (.US_TXT [DSC$A_POINTER]),
            CH$PTR (.ESC_TEXT));
        RETURN .US_TXT [DSC$W_LENGTH];
        END;

        [1 TO %O'37'] :
        BEGIN
        ESC_TEXT [0] = %C'^';
        ESC_TEXT [1] = .ESCAPE_CHR + %O'100';
        RETURN 2;
        END;

        [CHR_DEL, %O'177'] :
        BEGIN
        ESC_TEXT = 'DEL';
        RETURN 3;
        END;
        TES;

    RETURN 0;                ! No escape character?
    END;                    ! End of ESC_MSG
%SBTTL 'TERM_CONNECT -- COMND_TRANSMIT'

GLOBAL ROUTINE COMND_TRANSMIT : NOVALUE =       ! and below

!++
! FUNCTIONAL DESCRIPTION:
!
!   This routine transmits a file (or files) to the remote side one character
!   at a time.  It can display the numbers of the lines as they are transfered,
!   or echo back to the controling terminal from the remote so that progress of
!   the transmit can be monitored.  It can also delay between 0 and .9 secs
!   after each carriage return for machines that cannot keep up with the
!   transfer.  The file is transmitted blindly (except line feeds are removed)
!   with no error correction or packets.  This is useful for sending files to
!   systems where KERMIT is unavailable.
!
! CALLING SEQUENCE:
!
!   COMND_TRANSMIT ();
!
! IMPLICIT INPUTS:
!
!   TRANS_DELAY - time (0.0 - 0.9 seconds) to delay after carriage return is transmitted.
!   TRANS_ECHO_FLAG - flags whether data from remote side is echoed to the console terminal (ON);
!                     or line numbers are printed during transmit.
!
! IMPLICIT OUTPUTS:
!
!   None
!
! COMPLETION_CODES:
!
!   Standard status values.
!
! SIDE EFFECTS:
!
!   Line feed characters are not transmitted.
!--

    BEGIN

    EXTERNAL
    FILE_SIZE,
    FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],
    TY_FIL;

    EXTERNAL ROUTINE
    FILE_OPEN;

    LOCAL
    STATUS,                                             ! KERMIT status values
    TRANSMIT_DELAY : VECTOR [CH$ALLOCATION(8)],    ! String for transmit delay
    TR_DESC :     BLOCK [8,BYTE];              ! Descriptor for transmit delay

    OWN
    SAVE_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],       ! File name
    SAVE_FILE_SIZE,                                                ! File size
    SAVE_TY_FIL,                                          ! File type out flag
    DELAY : VECTOR [2,LONG,SIGNED];  ! Time after transmitting carriage return

    BIND
    D_TIME = PLIT('0 ::00.');    ! First part of delta time used to find delay

%SBTTL 'TERM_CONNECT -- TRANSMIT_FILE'

    ROUTINE TRANSMIT_FILE =       ! and below

    !++
    ! FUNCTIONAL DESCRIPTION:
    !
    ! This routine transmits the current file (that has already been opened) and
    ! then opens the next file (if there is one).
    !
    !--
        BEGIN        ! TRANSMIT_FILE

        EXTERNAL
          ABT_ALL_FILE,
          ABT_CUR_FILE,
          SMG$_PASALREXI,                          ! Pasteboard exits for device msg
          FLAG_FILE_OPEN;

        EXTERNAL ROUTINE
          NEXT_FILE,
          FILE_OPEN,
          FILE_CLOSE,
          TT_TEXT,
          TT_CRLF : NOVALUE,
          SY_DISMISS : NOVALUE,
          SMG$CREATE_PASTEBOARD : ADDRESSING_MODE (GENERAL),
          SMG$DELETE_PASTEBOARD : ADDRESSING_MODE (GENERAL);

        LOCAL
          STATUS,                                             ! KERMIT status values
          ISTAT,                                                ! qiow status values
          PASTE_STAT,                                            ! SMG status values
          NEW_ID : VECTOR [1, LONG, UNSIGNED];             ! Dummy new pasteboard id

        OWN
          LINE_NUM;                                            ! Line number counter

%SBTTL 'TERM_CONNECT -- TRANSMIT_CHARACTERS'

          ROUTINE TRANSMIT_CHARACTERS : NOVALUE =       ! and below

      !++
      ! FUNCTIONAL DESCRIPTION:
      !
          ! This routine is a loop that transmits all of the characters in a file,
          ! one character per pass.
          !
          !--
          BEGIN        ! TRANSMIT_CHARACTERS

          LITERAL
            WAIT_EFN = 22,
            CHARACTER_LEN = 1;

          EXTERNAL ROUTINE
            GET_FILE,
            TT_NUMBER,
            TT_OUTPUT : NOVALUE;

          LOCAL
            STATUS,                                             ! KERMIT status values
            TSTAT,                                               ! timer status values
            ISTAT,                                                ! qiow status values
            CHARACTER,                             ! Character from get-a-char routine
            TERM_IOSB : VECTOR [4, WORD, UNSIGNED];    ! IO status block for term chan
!
! Begin TRANSMIT_CHARACTERS:
!
          DO

            BEGIN        ! Transmit a character
! Get next character
            STATUS = GET_FILE (CHARACTER);

            IF .STATUS AND NOT .STATUS EQL KER_EOF AND NOT .CHARACTER EQL CHR_LFD         ! Did we get one?
            THEN

              BEGIN        ! Have a character
! Write character out transfer terminal:
                ISTAT = $QIOW (CHAN = .TERM_CHAN, EFN = TERM_O_EFN,
                  FUNC = IO$_WRITEVBLK + IO$M_NOFORMAT,
                  IOSB = TERM_IOSB,
                  P1 = CHARACTER, P2 = CHARACTER_LEN);
                IF NOT .ISTAT THEN LIB$SIGNAL (.ISTAT);
                IF NOT .TERM_IOSB THEN LIB$SIGNAL (.TERM_IOSB);
                IF .CHARACTER EQL CHR_CRT
                THEN
                  BEGIN        ! Just transmitted a carriage return

                    IF NOT .DELAY EQL 0
                    THEN
! Delay desired time:
                      BEGIN
                        TSTAT = $SETIMR (EFN = WAIT_EFN, DAYTIM = DELAY);
                        IF NOT .STATUS THEN LIB$SIGNAL (.TSTAT);
                        TSTAT = $WAITFR (EFN = WAIT_EFN);
                        IF NOT .STATUS THEN LIB$SIGNAL (.TSTAT);
                      END;

                    IF NOT .TRANS_ECHO_FLAG
                    THEN
! Purge term_chan typeahead buffer to get rid of the echoed data and type packet number to console:
                      BEGIN
                        TSTAT = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_READVBLK OR IO$M_PURGE,
                          P1 = INP_BUF [TRM, 0], P2 = 0, IOSB = IN_IOSB [TRM, 0, 0]);
                        IF NOT .TSTAT THEN LIB$SIGNAL (.TSTAT);
                        TT_NUMBER (.LINE_NUM);
                        TT_TEXT (UPLIT (%ASCIZ' '));
                        TT_OUTPUT ();
                        LINE_NUM = .LINE_NUM + 1;
                      END;

                  END;        ! Just transmitted a cariage return

              END;        ! Have a character

            END            ! Transmit a character
              UNTIL NOT .STATUS OR .STATUS EQL KER_EOF OR NOT .ISTAT OR NOT .TERM_IOSB
                    OR .FORCE_ABORT OR .ABT_CUR_FILE OR .ABT_ALL_FILE;

      END;        ! End TRANSMIT_CHARACTERS
!
! Begin TRANSMIT_FILE:
!
        FLAG_FILE_OPEN = TRUE;
        TT_TEXT (UPLIT (%ASCIZ'    File: '));
        TT_TEXT (FILE_NAME);                                ! Type out file name
        TT_CRLF ();
        FILE_SIZE = .SAVE_FILE_SIZE;                  ! Reset the file name size
        INCR I FROM 0 TO .FILE_SIZE - 1 DO
            FILE_NAME [.I] = .SAVE_FILE_NAME [.I];
        TY_FIL = .SAVE_TY_FIL;                             ! Reset type out flag
        LINE_NUM = 1;                           ! Initialize line number counter

        IF (STATUS = TERM_OPEN (TRUE))                       ! Open the terminal
        THEN

          BEGIN        ! Term open
! Cancel qio's to term_chan to start from scratch:
          STATUS = $CANCEL (CHAN = .TERM_CHAN);
          IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);

! Test to see if we are supposed to echo from the term_chan to the cons_chan:
          IF .TRANS_ECHO_FLAG
          THEN

            BEGIN    ! Echo data
! Clear screen (by creating a default pasteboard using SMG utility):
              SY_DISMISS (3);             ! Wait a bit so user can see file name
              PASTE_STAT = SMG$CREATE_PASTEBOARD (NEW_ID);
              IF NOT .PASTE_STAT THEN LIB$SIGNAL (.PASTE_STAT);

! Prepare event flags
              $CLREF (EFN = XITEFN);
              INCR FLAG FROM 1 TO XITEFN - 1 DO
                $SETEF (EFN = .FLAG);
              $SETAST (ENBFLG = 0);               ! Disable AST until after all QIOs

! Set up read qio's to echo characters to controling terminal
              ISTAT = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO,
                ASTADR = TRMINP, P1 = INP_BUF [TRM, 0], P2 = INP_BUFSIZ, P3 = 0,
                IOSB = IN_IOSB [TRM, 0, 0], ASTPRM = 0);
              IF NOT .ISTAT THEN LIB$SIGNAL (.ISTAT);
              INCR INP_BUFNUM FROM 1 TO NUM_IN_BUF - 1 DO
                BEGIN
                  ISTAT = $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=0,
                    IOSB = IN_IOSB [TRM, .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM);
                  IF NOT .ISTAT THEN LIB$SIGNAL (.ISTAT);
                END;
              $SETAST (ENBFLG = 1);                                     ! Enable AST
            END      ! End echo data

          ELSE         ! No echo; output line number title to console:

              TT_TEXT (UPLIT (%ASCIZ'    Transmitting line number... '));

! Start a loop that handles one character per pass:
          TRANSMIT_CHARACTERS ();

! Finished transmitting file - close it:
          FILE_CLOSE ();
          ABT_CUR_FILE = FALSE;
          IF .TRANS_ECHO_FLAG THEN SY_DISMISS (1);      ! Wait a bit so user can see the end of the file

! Cancel read qio's:
          $SETAST (ENBFLG = 0);                                  ! Disable AST's
          STATUS = $CANCEL (CHAN = .TERM_CHAN);
          IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);
          STATUS = $CANCEL (CHAN = .CONS_CHAN);
          IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);

! Clear screen again if we did it before - ie delete pasteboard if we created one:
          IF .TRANS_ECHO_FLAG AND NOT .PASTE_STAT EQL SMG$_PASALREXI
          THEN
            BEGIN
            PASTE_STAT = SMG$DELETE_PASTEBOARD (NEW_ID);
            IF NOT .PASTE_STAT THEN LIB$SIGNAL (.PASTE_STAT);
            END
          ELSE
            BEGIN
            TT_CRLF ();
            TT_CRLF ();
            END;

! Post normal qio's that were canceled:
          STATUS = DO_CONS_QIO();
          IF NOT .STATUS
          THEN
            BEGIN
            LIB$SIGNAL (.STATUS);
            RETURN KER_RECERR
            END;

          STATUS = DO_RECEIVE_QIO();
          IF NOT .STATUS
          THEN
            BEGIN
            LIB$SIGNAL (.STATUS);
            RETURN KER_RECERR
            END;

! Close the console terminal to clean up:
          STATUS = TERM_CLOSE ();
          IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);
          $SETAST (ENBFLG = 1);                                   ! Enable AST's
          END;        ! Term open

! Determine if there is another file to send.
        SAVE_TY_FIL = .TY_FIL;                        ! Save current type out flag
        TY_FIL = FALSE;                            ! Supress the type out of names
        IF NOT .ABT_ALL_FILE AND NOT .FORCE_ABORT THEN STATUS=NEXT_FILE () ELSE STATUS=KER_NOMORFILES;
        TY_FIL = .SAVE_TY_FIL;                           ! Reset the type out flag
        ABT_ALL_FILE = FALSE;
        FORCE_ABORT = FALSE;
        FORCE_TIMEOUT = FALSE;
    RETURN .STATUS;

        END;          ! End TRANSMIT_FILE

!
! Begin COMND_TRANSMIT:
!
! Initialize variables
    CHR_COUNT [0] = 0;
    CHR_COUNT [1] = 0;
    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]]);

! Assign channels to devices TERM_NAME and MY_TERM.
    STATUS = TERM_OPEN (FALSE);            ! Open terminal, no QIO's

    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;

    IF NOT .SYS_OUTPUT_OPEN            ! Make sure we have terminals
    THEN
    BEGIN
    TERM_CLOSE ();
    LIB$SIGNAL (KER_LINTERM);        ! Must both be terminals
    RETURN KER_LINTERM;            ! So give up if not
    END;

    CHANNEL [0] = .TERM_CHAN;
    CHANNEL [1] = .CONS_CHAN;

    IF NOT .STATUS
    THEN
    BEGIN
    TERM_CLOSE ();
    LIB$SIGNAL (.STATUS);
    RETURN .STATUS;
    END;

! Have two terminals - Set up delay:
    CH$COPY (7,CH$PTR(D_TIME),  1,CH$PTR(TRANS_DELAY), %C ' ', 8,CH$PTR(TRANSMIT_DELAY));
    TR_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    TR_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    TR_DESC [DSC$W_LENGTH] = 8;
    TR_DESC [DSC$A_POINTER] = TRANSMIT_DELAY;
    STATUS = $BINTIM (TIMBUF=TR_DESC, TIMADR=DELAY);  ! Calculate delta time
    IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);

! Get the first file and try to open it:
    SAVE_TY_FIL = .TY_FIL;                          ! Save current type out flag
    TY_FIL = FALSE;                              ! Supress the type out of names
    SAVE_FILE_SIZE = .FILE_SIZE;                       ! Save the file name size
    INCR I FROM 0 TO .FILE_SIZE - 1 DO
        SAVE_FILE_NAME [.I] = .FILE_NAME [.I];

! If we can open the file, then transmit it:
    IF FILE_OPEN (FNC_READ)
    THEN        ! Loop to handle one file at a time:
      DO
        STATUS = TRANSMIT_FILE ()
      UNTIL ( NOT .STATUS) OR (.STATUS EQL KER_NOMORFILES)
    ELSE
        TY_FIL = .SAVE_TY_FIL;                             ! Reset type out flag

  END;                  ! End COMND_TRANSMIT routine
%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
!
    ESC_CHR_LEN = ESC_MSG (ESC_CHR_MSG);
    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] = 1 + .NODE_DESC [DSC$W_LENGTH] + .CON_MSG_1 [DSC$W_LENGTH] +
    .TERM_DESC [DSC$W_LENGTH] + .CON_MSG_2 [DSC$W_LENGTH] + .ESC_CHR_LEN + .CON_MSG_3 [DSC$W_LENGTH]
    ;
    CH$COPY (1, CH$PTR (UPLIT BYTE(%C'[')), .NODE_DESC [DSC$W_LENGTH],
    CH$PTR (.NODE_DESC [DSC$A_POINTER]), .CON_MSG_1 [DSC$W_LENGTH],
    CH$PTR (.CON_MSG_1 [DSC$A_POINTER]), .TERM_DESC [DSC$W_LENGTH],
    CH$PTR (.TERM_DESC [DSC$A_POINTER]), .CON_MSG_2 [DSC$W_LENGTH],
    CH$PTR (.CON_MSG_2 [DSC$A_POINTER]), .ESC_CHR_LEN, CH$PTR (ESC_CHR_MSG),
    .CON_MSG_3 [DSC$W_LENGTH], CH$PTR (.CON_MSG_3 [DSC$A_POINTER]), CHR_NUL,
    .CON_MSG_DESC [DSC$W_LENGTH], CH$PTR (CON_MSG));
!
! Assign channels to devices TERM_NAME and MY_TERM.
!
    STATUS = TERM_OPEN (FALSE);            ![054] Open terminal, no QIO's

    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;

    IF NOT .SYS_OUTPUT_OPEN            ![013] Make sure we have terminals
    THEN
    BEGIN
    TERM_CLOSE ();
    LIB$SIGNAL (KER_LINTERM);        ![013] Must both be terminals
    RETURN KER_LINTERM;            ![013] So give up if not
    END;

![054]    STATUS = $CANCEL (CHAN = .TERM_CHAN);    ! Kill all pending QIOs for terminal
    CHANNEL [0] = .TERM_CHAN;
    CHANNEL [1] = .CONS_CHAN;
![054]    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;

!
! Open any session logging file
!
    SESSION_OPEN = FALSE;            ! Assume not logging
    SESSION_LOGGING = FALSE;            !  .  .  .

    IF .SESSION_DESC [DSC$W_LENGTH] GTR 0
    THEN
    BEGIN
    STATUS = LOG_OPEN (SESSION_DESC, SESSION_FAB, SESSION_RAB);

    IF .STATUS
    THEN
        BEGIN
        SESSION_OPEN = TRUE;
        SESSION_LOGGING = TRUE;
        END;

    END;

! Prepare event flags
    $CLREF (EFN = XITEFN);

    INCR FLAG FROM 1 TO XITEFN - 1 DO
    $SETEF (EFN = .FLAG);

!
! Set up proper function for reading from console terminal.  This is done
! so that the NOECHO flag only gets used if LOCAL_ECHO is OFF.
!
    MYT_QIO_FUNC = IO$_TTYREADALL;

    IF NOT .ECHO_FLAG THEN MYT_QIO_FUNC = IO$M_NOECHO OR IO$_TTYREADALL;

! Connect streams
CONN_STREAMS :
    BEGIN
!                     Send connect message
    LIB$PUT_OUTPUT (%ASCID'');
    LIB$PUT_OUTPUT (CON_MSG_DESC);
    LIB$PUT_OUTPUT (%ASCID'');
    $SETAST (ENBFLG = 0);            ! Disable AST until after all QIOs
!
! The first input for each terminal will be for one character.
! This read will wait forever for a character.  The subsequent
! reads will have a timeout of 0 (immediate return).  This
! gets us good response without using large amounts of run time.
!
    STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC, ASTADR = MYTINP, P1 = INP_BUF [MYT, 0],
    P2 = 1, IOSB = IN_IOSB [MYT, 0, 0], ASTPRM = 0);

    IF NOT .STATUS THEN LEAVE CONN_STREAMS;

    STATUS = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO, ASTADR = TRMINP,
    P1 = INP_BUF [TRM, 0], P2 = INP_BUFSIZ, P3 = 0, IOSB = IN_IOSB [TRM, 0, 0], ASTPRM = 0);

    IF NOT .STATUS THEN LEAVE CONN_STREAMS;

    INCR INP_BUFNUM FROM 1 TO NUM_IN_BUF - 1 DO
    BEGIN
! Queue up an input for console terminal
    STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC OR IO$M_TIMED, ASTADR = MYTINP,
        P1 = INP_BUF [MYT, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = 0,
        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 = 0,
        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
    CON_MSG_DESC [DSC$W_LENGTH] = 1 + .NODE_DESC [DSC$W_LENGTH] + .CON_MSG_4 [DSC$W_LENGTH];
    CH$COPY (1, CH$PTR (UPLIT BYTE(%C'[')), .NODE_DESC [DSC$W_LENGTH],
    CH$PTR (.NODE_DESC [DSC$A_POINTER]), .CON_MSG_4 [DSC$W_LENGTH],
    CH$PTR (.CON_MSG_4 [DSC$A_POINTER]), CHR_NUL, .CON_MSG_DESC [DSC$W_LENGTH],
    CH$PTR (.CON_MSG_DESC [DSC$A_POINTER]));
    LIB$PUT_OUTPUT (CON_MSG_DESC);
    LIB$PUT_OUTPUT (%ASCID'');
    END;
!
! Program end -- Close both channels and return with STATUS
!
    $CANTIM ();
!
! Close any log file
!

    IF .SESSION_OPEN THEN LOG_CLOSE (SESSION_FAB, SESSION_RAB);

    SESSION_OPEN = FALSE;
!
! Call TERM_CLOSE to clean up
!
    STATUS = TERM_CLOSE ();

    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