Columbia Kermit/kermit.zip/pub/vmskermit32/vmsmit.bli

Text File | 2020-01-01 | 118KB | 5,179 lines

MODULE KERMIT (IDENT = '3.3.128', MAIN = MAIN_ROUTINE,
    ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL)
        ) =

BEGIN

BIND
    IDENT_STRING = %ASCID'VMS Kermit-32 version 3.3.128';    ! Ident message

!++
! FACILITY:
!   KERMIT-32
!
! ABSTRACT:
!   KERMIT-32 is an implementation of the KERMIT protocal to allow the
!   transfer of files from micro computers to the DECsystem-10, DECSYSTEM-20
!   and now the VAX/VMS systems.
!
! ENVIRONMENT:
!   User mode
!
! AUTHOR: Robert C. McQueen, CREATION DATE: 24-January-1983
!
! MODIFIED BY:
!
!--

%SBTTL 'Table of Contents'
%SBTTL 'Revision History'

!++
! Start of version 1.
!
! 1.0.000    By: Robert C. McQueen        On: 4-Jan-1983
!        Create this program.
!
! 1.0.001    By: Robert C. McQueen        On: 4-May-1983
!        Allow RECEIVE without a file specification to mean
!        use what ever the remote says.
!
! 1.1.002    By: W. Hom            On: 6-July-1983
!        Implement CONNECT command.
!
! 1.2.003    By: Robert C. McQueen        On: 15-Aug-1983
!        Add SET PARITY command and SHOW PARITY to support
!        eight bit quoting.
!
! 1.2.004    By: Robert C. McQueen        On: 23-August-1983
!        Add dummy routine SY_TIME.
!
! 1.2.005    By: Robert C. McQueen        On: 23-August-1983
!        Add SET [SEND | RECEIVE] EIGHT-BIT-QUOTE <octal>
!        command.  Add message for SHOW RECEIVE and SHOW SEND parameters
!
! 1.2.006    By: Robert C. McQueen        On: 26-August-1983
!        Add BYE, FINISH and LOGOUT commands.  These commands call
!        DO_GENERIC to send generic functions to remote servers.
!
! 1.2.007    By: Robert C. McQueen        On: 16-September-1983
!        Implement SY_TIME, and XFR_STATUS routines.
!        Add more stat type out.
!
! 1.2.008    By: Robert C. McQueen        On: 19-September-1983
!        Add the SET RETRY command and the SHOW RETRY command.
!
! 1.2.009    By: Robert C. McQueen        On: 20-September-1983
!        Add CRCCLC routine for calculating CRC-CCITT.
!        Set SET BLOCK_CHECK_TYPE and SHOW BLOCK_CHECK_TYPE commands.
!
! 1.2.010    By: Nick Bush            On: 3-October-1983
!        SERVER (in KERMSG) actually returns a value.  If it
!        is "ABORTED", then we should prompt again.  This allows
!        a ^Y typed to the server to put it back into command
!        level.  (If you want to type out statistics or whatever).
!
! 2.0.011    Release VAX/VMS Kermit-32 version 2.0
!
! 2.0.012    By: Nick Bush            On: 10-Nov-1983
!        Add type out of version number.  Also fix some
!        problems with IBM mode and local echo.
!
! 2.0.013    By: Nick Bush            On: 11-Nov-1983
!        Change how debugging output is done so that it
!        can be redirected to the logical device KER$DEBUG.
!        If the logical name is defined to be something other
!        that SYS$OUTPUT, KERMIT will send any debugging output
!        there.
!
! 2.0.014    By: Robert C. McQueen        On: 16-Nov-1983
!        Make sure all message number checks are mod 64.  There
!        were four that weren't.
!
! 2.0.015    By: Nick Bush            On: 17-Nov-1983
!        Always clear purge typeahead when posting receive QIO.
!        Also, clear any typeahead just before sending a packet.
!
! 2.0.016    By: Nick Bush            On: 4-Dec-1983
!        Change how binary files are written to (hopefully) improve
!        the performance.  We will now use 510 records and only
!        write out the record when it is filled (instead of writing
!        one record per packet).  This should cut down on the overhead
!        substantially.
!
! 2.0.017    By: Nick Bush            On: 9-Dec-1983
!        Fix processing for VFC format files.  Also fix GET_ASCII
!        for PRN and FTN record types.  Change GET_ASCII so that
!        'normal' CR records get sent with trailing CRLF's instead
!        of <LF>record<CR>.  That was confusing too many people.
!
! 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.022    By: Nick Bush            On: 15-Dec-1983
!        Add Fixed record size (512 byte) format for writing files.
!        This can be used for .EXE files.  Also clean up writing
!        ASCII files so that we don't lose any characters.
!
! 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.025    By: Robert C. McQueen        On: 22-Dec-1983
!        Use RMSG_COUNT and SMSG_COUNT now.
!
! 2.0.026    By: Nick Bush            On: 3-Jan-1984
!        Add options for format of file specification to be
!        sent in file header packets.  Also type out full file
!        specification being sent/received instead of just
!        the name we are telling the other end to use.
!
! 2.0.027    By: Nick Bush            On: 20-Jan-1984
!        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.030    By: Nick Bush            On: 3-Feb-1984
!        Add the capability of receiving a file with a different
!        name than given by KERMSG.  The RECEIVE and GET commands
!        now really are different.
!
! 2.0.031    By: Nick Bush            On: 4-Feb-1984
!        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.032    By: Nick Bush            On: 25-Feb-1984
!        Add code for LOCAL and REMOTE commands.  These depend
!        upon support in KERMSG and KERSYS.
!
! 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: Nick Bush                On: 15-March-1984
!        Fix PUT_FILE to correctly handle carriage returns which are
!        not followed by line feeds.  Count was being decremented
!        Instead of incremented.
!
! 2.0.037    By: Robert C. McQueen            On: 20-March-1984
!        Fix call to LOG_OPEN for debug log file.
!        Module: KERTRM.
!
! 2.0.040    By: Nick Bush                On: 22-March-1984
!        Fix processing of FORTRAN carriage control to handle lines
!        which do not contain the carriage control character (i.e., zero
!        length records).  Previously, this type of record was sending
!        infinite nulls.
!
! 2.0.041    By: Nick Bush                On: 26-March-1984
!        Add SET PROMPT command.
!
! 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.
!
! 2.0.044    By: Nick Bush                On: 28-March-1984
!        Fix SET SEND START_OF_PACKET to store in SND_SOH instead
!        of RCV_SOH.  Also, set TY_FIL false before calling FILE_OPEN
!        to check for existence of send files.
!
! 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.0.047    By: Nick Bush                On: 30-March-1984
!        Fix SEND command processing to save and restore the file
!        specification over the call to FILE_OPEN, since FILE_OPEN
!        rewrites it with the resulting file name, losing any
!        wild-cards.
!
! 3.0.050    By: Nick Bush                On: 2-April-1984
!        Add SET SERVER_TIMER to determine period between idle naks.
!        Also allow for a routine to process file specs before
!        FILE_OPEN uses them.  This allows individual sites to
!        restrict the format of file specifications used by Kermit.
!
! 3.0.051    By: Nick Bush                On: 2-April-1984
!        Fix command scanning to correctly exit after performing
!        a single command when entered with a command present.
!
! 3.1.052    By: Nick Bush                On: 3-July-1984
!        Fix KERCOM's definition of MAX_MSG to allow for all characters
!        of packet to fit into buffers, not just the counted ones.
!
! 3.1.053    By: Robert C. McQueen            On: 9-July-1984
!        Fix FORTRAN carriage control processing to pass along
!        any character from the carriage control column that is
!        not really carriage control.
!
! 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.055    By: Nick Bush                On: 27-August-1984
!        Clear out FILE_SIZE before processing a RECEIVE command to
!        ensure that KERMSG doesn't perform a GET.
!
! 3.1.056    By: Nick Bush                On: 28-August-1984
!        Add a TAKE (or @) command.  Also perform an initialization
!        file on startup.  This file is either VMSKERMIT.INI or
!        whatever file is pointed to by the logical name VMSKERMIT.
!
! 3.1.057    By: Nick Bush                On: 21-Feb-1985
!        Determine VMS version on startup and remember for later
!        use.  Use it in KERSYS to determine whether we will need
!        to force an end-of-file on the mailbox when the subprocess
!        on the other end goes away.
!
! 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.062    By: Nick Bush                On: 16-March-1985
!        Previous edit broke remote commands - must post QIO's
!        when opening terminals for these.
!
! 3.1.063    By: Nick Bush                On: 16-March-1985
!        Fix status command to output right headers over data.
!
! 3.1.064    By: Nick Bush                On: 30-March-1985
!        Fix LIB$SPAWN call to set SYS$INPUT for the subprocess
!        to be NLA0: so that it doesn't try to input from the
!        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.
!
! 3.1.066    By: Nick Bush                On: 22-April-1985
!        Don't use NLA0: as SYS$INPUT when spawning things under VMS 3.
!
!
! Start version 3.2 on 8-May-1985
!
! 3.2.067    By: Robert McQueen            On: 8-May-1985
!        Use $GETJPIW and $GETDVIW instead of $GETJPI and $GETDVI.
!        Module: KERTRM, KERFIL
!
! 3.2.070    By: Robert McQueen            On: 17-Dec-1985
!        Fix a problem with CRC calculations when 8 bit data and not
!        8 bit quoting.
!
! 3.2.071    By: Robert McQueen            On: 11-March-1986
!        Fix a problem were KERMSG didn't allow for a line termination
!        character in the buffer.
!
! 3.2.072    By: Robert McQueen            On: 11-March-1986
!        Allow 0 as a valid value for SET SEND PADDING command.
!
! 3.2.073    By: Robert McQueen            On: 11-March-1986
!        Fix a problem restoring the terminal characteristics under
!        VMS 4.x
!
! 3.2.074    By: Robert McQueen            On: 11-March-1986
!        Put MAX_MSG back the way it was and fix the problem correctly
!        in KERMSG.
!
! 3.2.075    By: Robert McQueen            On: 8-April-1986
!        Change how the FINISH command works.  Cause it to go back to
!        the Kermit-32 prompt, not exit.
!
! 3.2.076    By: Robert McQueen            On: 17-April-1986
!        Set PASSTHRU in addition to everything else we change in VMSTRM.
!
! 3.2.077    By: Robert McQueen            On: 8-May-1986
!        FIX FORTRAN CC!! (Once and for all I hope)
!
! 3.2.100    By: Gregory P. Welsh            On: 1-June-1986
!        Add TRANSMIT command along with set SET/SHOW TRANSMIT ECHO
!               and DELAY commands.
!
! Start of version 3.3
!
! 3.3.101    By: Robert C. McQueen            On: 2-July-1986
!        Change $TRNLOG system service calls to LIB$SYS_TRNLOG library
!        routine.  Handle no translation properly in VMSTRM.BLI.
!
! 3.3.102    By: Robert McQueen            On: 5-July-1986
!        Add changes/fixes suggested by Art Guion and David Deley for
!        VMSTRM.BLI
!        - Turn off FALLBACK terminal characteristics for eightbit
!          operations.
!        - Decrease IBM timeouts when waiting for a handshake.
!
! 3.3.103    By: Robert McQueen            On: 5-July-1986
!        Add changes/fixes suggested by David Deley for VMSMIT.BLI
!        - Problem with an infinite loop getting a command.
!
! 3.3.104    By: Robert McQueen            On: 5-July-1986
!        Add changes/fixes suggested by Art Guion and David Deley for
!        KERMSG.BLI.
!        - Always attempt a handshake in IBM mode.  Failing to handshake
!          may cause 3704/5 style controller to hang a VM system.
!        - Don't lose the last character in a buffer.   BFR_FILL logic
!          forgets to send the last cahracters of a file when it doesn't
!          fit into the current packet.
!
! 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.106    By: Robert McQueen            On: 8-July-1986
!        Fix problem of closing a fixed file and losing data.
!
! 3.3.107    By: Antonino N. Mione            On: 8-Sep-1986
!        Do not abort on ERROR packet while in SERVER mode. Instead,
!        return to SERVER IDLE mode.
!
! 3.3.110    By: Antonino N. Mione            On: 8-Sep-1986
!        Make KERMIT-32 close the terminal (so the terminal
!        parameters are appropriately reset) upon reciept of
!        a GENERIC LOGOUT packet.
!
! 3.3.111    By: Robert McQueen            On: 2-Oct-1986
!        Make Kermit-32 not eat the parity from a CR if a LF doesn't
!        follow it when writing an ASCII file.
!
! 3.3.112    JHW0001        Jonathan H. Welch,     28-Apr-1988 12:11
!        Fix the message generated in NEXT_FILE so that the
!        filenames displayed (i.e. Sending: foo.bar;1 as foo.bar)
!        are always terminated by a null (ASCIZ).
!
! 3.3.113    JHW0002        Jonathan H. Welch,    5-May-1988 11:48
!        Modified SY_TIME to use $GETTIM as opposed to the LIB$timer
!        routines (which broke when their method of calculating
!        time differences changed in V4.4?).
!
!        Removed the call to LIB$INIT_TIMER in SY_INIT.
!
! 3.3.114    JHW003        Jonathan H. Welch,    6-May-1988 9:41
!        Modified MAIN_ROUTINE to return the status code from
!        COMND when exiting.
!
!        Note: The error message codes returned are internal
!        Kermit-32 error codes.
!
! 3.3.115    JHW004        Jonathan H. Welch,    9-May-1988
!        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    JHW005        Jonathan H. Welch,    12-May-1988 8:35
!        Modified COMND_HELP to look for the kermit help
!        file called KERMIT_HELP or pointed to by the logical
!        name KERMIT_HELP.  Thus if a user wants to have the
!        kermit help file in a directory other than SYS$HELP
!        it is not necessary to define the logical name KERMIT
!        (which causes problems: i.e. RUN KERMIT will fail).
!
! 3.3.117    JHW006        Jonathan H. Welch,    12-May-1988
!        Calls to LIB$SIGNAL with multiple arguments were
!        not coded correctly.  For calls with multiple arguments
!        an argument count was added.
!        Minor changes to KERM_HANDLER to make use of the changed
!        argument passing method.
!
! 3.3.118    By: Burt Johnson            On: 1-Feb-1990
!        Added support for Extended Length packets;
!
! 3.3.119    JHW007        Jonathan H. Welch,    4-Apr-1990 7:47
!        Modified Final_Status to have an initial value of SS$_NORMAL.
!        Previously, if all kermit operations were successful a
!        return status of 0 was generated.
!
!        Added a compile-time test for BLISS32 systems in the three
!        generic bliss files (GLB, MSG, TT) which didn't have this
!        declaration so that references to data use longword offsets.
!        Burt Johnson's solution (PSECT PLIT = $CODE$) was generating
!        many link-time errors.
!
! 3.3.120    JHW008        Jonathan H. Welch,    5-Apr-1990 10:57
!        Modified the call to NORMALIZE_FILE in routine REC_FILE
!        to adjust file name and type lengths downwards to 39
!        characters each as opposed to the pre-VMS 4 format of
!        9 for the name and 3 for the type.
!
! 3.3.121    JHW009        Jonathan H. Welch,    12-Apr-1990 12:20
!        Added and modified routines in vmstrm.bli to notify the
!        user if SS$_HANGUP occurs on the outgoing terminal line.
!        If the outgoing line is serviced by a decserver (LTA type
!        terminal) the user must issue a CONNECT LTAnnn command
!        to reestablish a LAT link to the decserver.
!
! 3.3.122    JHW010        Jonathan H. Welch,    23-Apr-1990 09:42
!        Added SET FILE BLOCKSIZE nnn (where nnn is the record size
!        in bytes) command for incoming BINARY and FIXED file transfers.
!        If no blocksize has been specified the old behavior (510 byte
!        records plus 2 bytes (for CR/LF) for BINARY files and 512
!        byte records for FIXED files will be used.
!        Also modified SHOW FILE to display record size when appropriate.
!
! 3.3.123    JHW011        Jonathan H. Welch,     17-May-1990 9:06
!        Modified a miscoded call to send_packet in routine
!        send_gencmd to correctly specify the length of the
!        response packet to transmit.  This miscoding only
!        affected long packet support, in particular, when
!        GETting files standard length packets were being used
!        when long packet support was available in both kermit
!        programs.
!
! 3.3.124    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.125    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.126    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.127    JHW015        Jonathan H. Welch,    16-Jul-1990 15:30
!        Fixed the logic in GET_ASCII which was causing an infinite
!        loop for files with print file carriage control.
!
! 3.3.128    JHW016        Jonathan H. Welch,    17-Oct-1990 9:42
!        Modified asn_wth_mbx to work properly in non-interactive mode.
!--

%SBTTL 'Routine definitions -- Forwards'
!<BLF/NOFORMAT>
!
! Forward definitions
!

! Command processing routines

FORWARD ROUTINE
    COMND,            ! Process a command
    COMND_ERROR : NOVALUE,    ! Give error for command
    COMND_FILE,            ! Process command file
    DO_COMND,            ! Parse and dispatch one command
    COMND_HELP    : NOVALUE,    ! Process the HELP command
    COMND_SHOW    : NOVALUE,    ! Process the SHOW command
    COMND_STATUS : NOVALUE,    ! Process the STATUS command
    COMND_REMOTE : NOVALUE,    ! Process the REMOTE command
    COMND_LOCAL : NOVALUE,    ! Process the LOCAL commands
    GET_REM_ARGS,        ! Get arguments for REMOTE/LOCAL commands
    STORE_TEXT,            ! Routine to store a file name
    COPY_TERM_NAME,        ! Copy device name (TERM_xxxx)
    COPY_DESC,            ! Copy file name (FILE_xxx)
    COPY_ALT_FILE,        ! Copy to alternate file name (ALT_FILE_xxx)
    COPY_GEN_1DATA,        ! Copy to GEN_1DATA (generic command argument)
    STORE_BLOCKSIZE,         ! Store the blocksize value
    STORE_DEBUG,        ! Store the debuging flag
    STORE_TR_ECHO,        ! Store the transmit echo flag  [078]
    STORE_TR_DELAY,        ! Store the transmit delay  [078]
    STORE_FTP,            ! Store the file type
    STORE_FNM,            ! Store the file name form
    STORE_ECHO,            ! Store the local echo flag
    STORE_PARITY,        ! Store the parity type
    STORE_CHK,            ! This routine will store the checksum type.
    STORE_ABT,            ! This routine will store the aborted file disposition
    STORE_IBM,            ! Store IBM flag
    STORE_MSG_FIL,        ! Store TY_FIL
    STORE_MSG_PKT,        ! Store TY_PKT
    CHECK_PACKET_LEN,        ! Validate PACKET length given
    CHECK_NPAD,            ! Validate the number of pad characters
    CHECK_PAD_CHAR,        ! Validate the padding character being set
    CHECK_EOL,            ! Validate EOL character given.
    CHECK_QUOTE,        ! Validate quoting character
    CHECK_SOH,            ! Validate the start of packet character given
    KEY_ERROR;            ! Return correct keyword error value

!
! Error handling routines
!

FORWARD ROUTINE
    KERM_HANDLER;            ! Condition handler
    %SBTTL    'Include files'

!
! INCLUDE FILES:
!

LIBRARY 'SYS$LIBRARY:STARLET';

LIBRARY 'SYS$LIBRARY:TPAMAC';

REQUIRE 'KERCOM';                ! Common definitions

REQUIRE 'KERERR';                ! Error message symbol definitions

%SBTTL 'Macro definitions'

!
! MACROS:
!

MACRO
    TPARSE_ARGS =
        BUILTIN AP;
        MAP AP : REF BLOCK [,BYTE];
    %;

!
! Macro to initialize a string descriptor
!
MACRO
    INIT_STR_DESC (DESC, BUFFER, SIZE) =
    BEGIN
!    MAP
!    DESC : BLOCK [8, BYTE];
    DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    DESC [DSC$W_LENGTH] = SIZE;
    DESC [DSC$A_POINTER] = BUFFER;
    END
    %;
    %SBTTL    'Equated symbols -- Command types'

!
! EQUATED SYMBOLS:
!
! Command offsets

LITERAL
    CMD_MIN = 1,                ! Minimum value
    CMD_CONN = 1,                ! Connect command
    CMD_EXIT = 2,                ! Exit command
    CMD_HELP = 3,                ! Help command
    CMD_RECEIVE = 4,                ! Receive command
    CMD_SET = 5,                ! Set command
    CMD_SEND = 6,                ! Send command
    CMD_SHOW = 7,                ! Show command
    CMD_SERVER = 8,                ! SERVER command
    CMD_STATUS = 9,                ! STATUS command
    CMD_LOGOUT = 10,                ! Generic LOGOUT command
    CMD_BYE = 11,                ! Generic LOGOUT command and EXIT
    CMD_FINISH = 12,                ! Generic EXIT command
    CMD_GET = 13,                ! Get command
    CMD_REMOTE = 14,                ! Remote command
    CMD_LOCAL = 15,                ! Local command
    CMD_PUSH = 16,                ! PUSH command (spawn new DCL)
    CMD_NULL = 17,                ! Any command which is done
                            ! totally by the LIB$TPARSE call
    CMD_TAKE = 18,                ! Take command
    CMD_TRANSMIT = 19,                          ! Transmit command [078]
    CMD_MAX = 19;                               ! Maximum command value [078]

! Items to show

LITERAL
    SHOW_ALL = 1,                ! Show everything
    SHOW_DEB = 2,                ! Show debugging flag
    SHOW_DEL = 3,                ! Show delay
    SHOW_ESC = 4,                ! Show ESCAPE character
    SHOW_TIM = 5,                ! Show random timing
    SHOW_LIN = 6,                ! Show the line we are using
    SHOW_ECH = 7,                ! Show the echo flag
    SHOW_SEN = 8,                ! Show send parameters
    SHOW_REC = 9,                ! Show the receive parameters
    SHOW_PAR = 10,                ! Show the parity setting
    SHOW_RTY = 11,                ! Show retry counters
    SHOW_CHK = 12,                ! Show block-check-type
    SHOW_ABT = 13,                ! Show aborted file disposition
    SHOW_FIL = 14,                ! Show file parameters
    SHOW_PAC = 15,                ! Show packet parameters
    SHOW_COM = 16,                ! Show communications parameters
    SHOW_VER = 17,                ! Show version
    SHOW_TRN = 18;                              ! Show transmit delay and echo
    %SBTTL    'Equated symbols -- Constants'

! Constants

LITERAL
    CMD_BFR_LENGTH = 132,            ! Command buffer length
    OUT_BFR_LENGTH = 80,            ! Output buffer length (SHOW cmd)
    HELP_LENGTH = 132,                ! Length of the help buffer
    TEMP_LENGTH = 132;                ! Length of the temporary area
!
! The default prompt
!
BIND
    DEFAULT_PROMPT = %ASCID'Kermit-32>';

MAP
    DEFAULT_PROMPT : BLOCK [8, BYTE];    ! This is a descriptor
    %SBTTL    'Storage -- Global'

!<BLF/NOFORMAT>
!
! GLOBAL STORAGE:
!

    GLOBAL
    TRANSACTION_DESC : BLOCK [8, BYTE],    ! Descriptor for transaction log file
    TRANSACTION_OPEN,            ! File open flag
    TRANSACTION_FAB : $FAB_DECL,        ! Transaction file FAB
    TRANSACTION_RAB : $RAB_DECL,        ! Transaction file RAB
    ESCAPE_CHR,                ! Escape character for CONNECT
    ALT_FILE_SIZE,                ! Number of characters in FILE_NAME
    ALT_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)]; ! Storage
    %SBTTL    'Storage -- Local'

!
! OWN STORAGE:
!

    OWN

! Command scanning information

    TPARSE_BLOCK    : BLOCK [TPA$K_LENGTH0, BYTE]
        INITIAL (TPA$K_COUNT0,        ! Longword count
            TPA$M_ABBREV),        ! Allow abbreviations
    BAD_CMD_DESC : BLOCK [8, BYTE],        ! Descriptor for bad command field
    COMMAND,                ! Type of command we are doing
    SHOW_TYPE,                ! Type of show command
    REM_TYPE,                ! Type of REMOTE command
    TAKE_DISPLAY,                ! Display commands being TAKEn
!
! Output data area
!
    OUTPUT_LINE : VECTOR [OUT_BFR_LENGTH, BYTE, UNSIGNED],
    OUTPUT_DESC : BLOCK [8, BYTE],
    OUTPUT_SIZE : WORD UNSIGNED,

! Misc constants.

    Final_Status : LONG UNSIGNED INITIAL(SS$_NORMAL), ! Status from within condition handler routine.
    TRANSACTION_NAME : VECTOR [CH$ALLOCATION(MAX_FILE_NAME)],
    PROMPT_DESC : BLOCK [8, BYTE],        ! Descriptor for prompt
    PROMPT_TEXT : VECTOR [CH$ALLOCATION(TEMP_LENGTH)], ! Storage for prompt
    CRC_TABLE : BLOCK [16, LONG],        ! CRC-CCITT table
    TAK_FIL_DESC    : BLOCK [8, BYTE],    ! Take file descriptor
    TAK_FIL_NAME    : BLOCK [CH$ALLOCATION(MAX_FILE_NAME)],
    TEMP_DESC    : BLOCK [8, BYTE],    ! Temporary descriptor
    TEMP_NAME    : VECTOR [CH$ALLOCATION(TEMP_LENGTH)];


!<BLF/FORMAT>
%SBTTL 'External routines'
!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
!
! Library routines
!
    LIB$GET_INPUT : ADDRESSING_MODE (GENERAL),
    LIB$PUT_OUTPUT : ADDRESSING_MODE (GENERAL),
    LIB$TPARSE : ADDRESSING_MODE (GENERAL),
    LIB$CRC_TABLE : ADDRESSING_MODE (GENERAL),
    LIB$CRC : ADDRESSING_MODE (GENERAL),
    LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE,
    LIB$ESTABLISH : ADDRESSING_MODE (GENERAL),
    LIB$ATTACH : ADDRESSING_MODE (GENERAL),
    LIB$SPAWN : ADDRESSING_MODE (GENERAL),
!
! KERMSG - KERMIT Message processing routines
!
    SEND_SWITCH,                ! Send a file
    REC_SWITCH,                    ! Receive a file
    DO_GENERIC,                    ! Send generic functions
    SERVER,                    ! Server mode processing
    SND_ERROR : NOVALUE,            ! Send E packet to remote
    MSG_INIT : NOVALUE,                ! Initialization routine
!
! KERFIL - File processing.
!
    FILE_INIT : NOVALUE,            ! Initialization routine
!
! KERSYS - System subroutines for KERMSG
!
    SY_INIT : NOVALUE,                ! Initialization routine
!
! KERTRM - Terminal processing.
!
    TERM_INIT : NOVALUE,            ! Initialize the terminal processing
    TERM_OPEN,                    ! Open the terminal line
    TERM_CLOSE,                    ! Close the terminal line
    TERM_CONNECT,                ! Impliments CONNECT command
    SET_TRANS_TERM,                ! Set new transfer terminal
    COMND_TRANSMIT,                             ! Transmit command code   in module KERTRM
!
! KERTT - Text processing
!
    TT_INIT : NOVALUE,                ! Initialization routine
    TT_TEXT : NOVALUE,                ! Output a text string
    TT_NUMBER : NOVALUE,            ! Output a number
    TT_CHAR : NOVALUE,                ! Output a single character
    TT_OUTPUT : NOVALUE,            ! Routine to dump the current
                            !  text line.
    TT_CRLF : NOVALUE;                ! Output the line

%SBTTL 'External storage'
!
! EXTERNAL Storage:
!

EXTERNAL
!
! KERMSG storage
!
! Receive parameters
    RCV_PKT_SIZE,                ! Receive packet size
    RCV_NPAD,                    ! Padding length
    RCV_PADCHAR,                ! Padding character
    RCV_TIMEOUT,                ! Time out
    RCV_EOL,                    ! EOL character
    RCV_QUOTE_CHR,                ! Quote character
    RCV_8QUOTE_CHR,                ! 8-bit quoting character
    RCV_SOH,                    ! Start of packet header
!
! Send parameters
!
    SND_PKT_SIZE,                ! Send packet size
    SND_NPAD,                    ! Padding length
    SND_PADCHAR,                ! Padding character
    SND_TIMEOUT,                ! Time out
    SND_EOL,                    ! EOL character
    SND_QUOTE_CHR,                ! Quote character
    SND_SOH,                    ! Packet start of header
!
! Server parameters
!
    SRV_TIMEOUT,                ! Time between idle naks in server
!
! Misc. packet parameters
!
    SET_REPT_CHR,                ! Desired repeat character
!
! Statistics
!
    SND_TOTAL_CHARS,                ! Total characters sent
    RCV_TOTAL_CHARS,                ! Total characters received
    SND_DATA_CHARS,                ! Total number of data characters sent
    RCV_DATA_CHARS,                ! Total number of data characters received
    SMSG_TOTAL_CHARS,                ! Total chars sent this file xfer
    RMSG_TOTAL_CHARS,                ! Total chars rcvd this file xfer
    SMSG_DATA_CHARS,                ! Total data chars this file xfer
    RMSG_DATA_CHARS,                ! Total data chars this file xfer
    RCV_NAKS,                    ! Total number of NAKs received
    SND_NAKS,                    ! Total number of NAKs sent
    RMSG_NAKS,                    ! Number of NAKs received
    SMSG_NAKS,                    ! Number of NAKs sent
    RCV_COUNT,                    ! Total number of packets received
    SND_COUNT,                    ! Total number of packets sent
    RMSG_COUNT,                    ! Number of packets received
    SMSG_COUNT,                    ! Number of packets sent
    XFR_TIME,                    ! Amount of time the last transfer took
    TOTAL_TIME,                    ! Total time the transfers have taken
    LAST_ERROR : VECTOR [CH$ALLOCATION (MAX_MSG + 1)],    ! Last error message
    TY_PKT,                    ! Flag that packet numbers should be typed
    TY_FIL,                    ! Flag that file names should be typed
    GEN_1DATA : VECTOR [CH$ALLOCATION (MAX_MSG)],    ! Data for generic command
    GEN_1SIZE,                    ! Size of data in GEN_1DATA
    GEN_2DATA : VECTOR [CH$ALLOCATION (MAX_MSG)],    ! Second argument for generic command
    GEN_2SIZE,                    ! Size of data in GEN_2DATA
    GEN_3DATA : VECTOR [CH$ALLOCATION (MAX_MSG)],    ! Third arg for generic command
    GEN_3SIZE,                    ! Size of data in GEN_3DATA
!
! Misc constants.
!
    FILE_SIZE,                    ! Number of characters in FILE_NAME
    FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],
    SI_RETRIES,                    ! Initial connection max retries
    PKT_RETRIES,                ! Packet max retries
    DELAY,                    ! Amount of time to delay
    DEBUG_FLAG,                    ! Debugging mode on/off
    CHKTYPE,                    ! Type of block-check-type wanted
    ABT_FLAG,                    ! Aborted file disposition
!    IBM_FLAG,                    ! IBM mode flag
    IBM_CHAR,                    ! Handshaking character
    WARN_FLAG,                    ! File warning flag
    FIL_NORMAL_FORM,                ! File name type to send
    PARITY_TYPE,                ! Type of parity we are using
    ECHO_FLAG,                    ! Local echo flag
    CONNECT_FLAG;                ! True if SYS$OUTPUT and line

                        ! xfering over are the same.
!
! KERFIL storage
!

EXTERNAL

    file_blocksize,                             ! Blocksize for FIXED files
    file_blocksize_set,                ! Flag indicating a blocksize has been specified by the user.
    FILE_TYPE,                    ! Type of file being processed
    FILE_DESC : BLOCK [8, BYTE];        ! Descriptor for the file name

!
! KERTRM storage
!

EXTERNAL
    SESSION_DESC : BLOCK [8, BYTE],        ! Session log file name
    DEBUG_DESC : BLOCK [8, BYTE],        ! Debugging log file name
    TERM_DESC : BLOCK [8, BYTE],        ! Terminal name descriptor
    TRANS_ECHO_FLAG,                            ! Transmit echo on/off
    TRANS_DELAY,                                ! Transmit delay
    TERM_FLAG;                    ! Terminal open flag

%SBTTL 'Command parsing tables'
!<BLF/NOFORMAT>
!++
!
!The following are the command state tables for the KERMIT-32
!command processing.
!
!--

$INIT_STATE    (KERMIT_STATE,    KERMIT_KEY);

$STATE    (START,
    ('BYE',        DONE_STATE,    ,    CMD_BYE,    COMMAND),
    ('CONNECT',    CONN_STATE,    ,    CMD_CONN,    COMMAND),
    ('EXIT',    DONE_STATE,    ,    CMD_EXIT,    COMMAND),
    ('FINISH',    DONE_STATE,    ,    CMD_FINISH,    COMMAND),
    ('GET',        GET_STATE,    ,    CMD_GET,    COMMAND),
    ('HELP',    HELP_STATE,    ,    CMD_HELP,    COMMAND),
    ('LOCAL',    REM_STATE,    ,    CMD_LOCAL,    COMMAND),
    ('LOG',        LOG_STATE,    ,    CMD_NULL,    COMMAND),
    ('LOGOUT',    DONE_STATE,    ,    CMD_LOGOUT,    COMMAND),
    ('PUSH',    DONE_STATE,    ,    CMD_PUSH,    COMMAND),
    ('QUIT',    DONE_STATE,    ,    CMD_EXIT,    COMMAND),
    ('RECEIVE',    REC_STATE,    ,    CMD_RECEIVE,    COMMAND),
    ('REMOTE',    REM_STATE,    ,    CMD_REMOTE,    COMMAND),
    ('SET',        SET_STATE,    ,    CMD_SET,    COMMAND),
    ('SEND',    SEND_STATE,    ,    CMD_SEND,    COMMAND),
    ('SERVER',    DONE_STATE,    ,    CMD_SERVER,    COMMAND),
    ('SHOW',    SHOW_STATE,    ,    CMD_SHOW,    COMMAND),
    ('STATUS',    DONE_STATE,    ,    CMD_STATUS,    COMMAND),
    ('TAKE',    TAKE_STATE,    ,    CMD_TAKE,    COMMAND),
    ('@',        TAKE_STATE,    ,    CMD_TAKE,    COMMAND),
        ('TRANSMIT',    TRANSMIT_STATE, ,       CMD_TRANSMIT,   COMMAND),  !
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

!++
! CONNECT command.  Format is:
!
!    Kermit-32>CONNECT device
!
! Where:
!    Device - Terminal line to connect to
!
!--

$STATE    (CONN_STATE,
    (TPA$_EOS, DONE_STATE),
    (TPA$_LAMBDA, SET_LIN_STATE)
    )

!++
! EXIT command.  Format is:
!
!    Kermit-32>EXIT
!
! Just exit back to VMS.
!
!--

!++
! HELP command.  Format is:
!
!    Kermit-32>HELP
!
! Do HELP processing for KERMIT-32.
!
!--

$STATE    (HELP_STATE,
    (TPA$_ANY,    HELP_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE)
)

    %SBTTL    'QUIT command table'

!++
! QUIT command.  Format is:
!
!    Kermit-32>QUIT
!
! This command will just exit back to VMS.
!
!--
    %SBTTL    'GET command table'

!++
! GET command.  Format is:
!
!    Kermit-32>GET file-specification
!
! This command will cause KERMIT to get a file from the micro.
! It will assume that it is to used what ever line it currently is
! associated with (CONNECT or SET LINE).
!
!--

$STATE    (GET_STATE,
    (TPA$_ANY,    GET_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,FILE_DESC)
    )
    %SBTTL    'RECEIVE command table'

!++
! RECEIVE command.  Format is:
!
!    Kermit-32>RECEIVE file-specification
!
! This command will cause KERMIT to receive a file from the micro.
! It will assume that it is to used what ever line it currently is
! associated with (CONNECT or SET LINE).
!
!--

$STATE    (REC_STATE,
    (TPA$_ANY,    REC1_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE)
    )


$STATE    (REC1_STATE,
    (TPA$_ANY,    REC1_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE,    COPY_ALT_FILE)
    )
    %SBTTL    'REMOTE command tables'

!++
! REMOTE command.  This command will allow the local Kermit user to
! request the server Kermit to perform some action.
!
!    Kermit-32>REMOTE keyword arguments
!
! Where:
!
!    Keyword is one of:
!        DELETE
!        DIRECTORY
!        DISK_USAGE
!        HELP
!        SPACE
!        TYPE
!--
$STATE    (REM_STATE,
    ('COPY',    REM2_STATE,    ,GC_COPY,    REM_TYPE),
    ('CWD',        REM1_STATE,    ,GC_CONNECT,    REM_TYPE),
    ('DELETE',    REM2_STATE,    ,GC_DELETE,    REM_TYPE),
    ('DIRECTORY',    REM1_STATE,    ,GC_DIRECTORY,    REM_TYPE),
    ('DISK_USAGE',    REM1_STATE,    ,GC_DISK_USAGE,    REM_TYPE),
    ('EXIT',    DONE_STATE,    ,GC_EXIT,    REM_TYPE),
    ('HELP',    REM1_STATE,    ,GC_HELP,    REM_TYPE),
    ('HOST',    REM2_STATE,    ,GC_COMMAND,    REM_TYPE),
    ('LOGIN',    REM2_STATE,    ,GC_LGN,    REM_TYPE),
    ('LOGOUT',    DONE_STATE,    ,GC_LOGOUT,    REM_TYPE),
    ('RENAME',    REM2_STATE,    ,GC_RENAME,    REM_TYPE),
    ('SEND_MESSAGE',REM2_STATE,    ,GC_SEND_MSG,    REM_TYPE),
    ('SPACE',    REM1_STATE,    ,GC_DISK_USAGE,    REM_TYPE),
    ('STATUS',    DONE_STATE,    ,GC_STATUS,    REM_TYPE),
    ('TYPE',    REM2_STATE,    ,GC_TYPE,    REM_TYPE),
    ('WHO',        REM1_STATE,    ,GC_WHO,    REM_TYPE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

! State to allow for either no arguments or a text string

$STATE    (REM1_STATE,
    (TPA$_ANY,    REM2_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE)
    )

! State to require a text string argument

$STATE    (REM2_STATE,
    (TPA$_ANY,    REM2_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE,    COPY_GEN_1DATA)
    )
    %SBTTL    'SET command tables'

!++
! SET command.  Format is:
!
!    Kermit-32>SET parameter
!
! Where:
!    Parameter - One of many keywords
!
!--

$STATE    (SET_STATE,
    ('BLOCK_CHECK_TYPE', SET_CHK_STATE),
    ('DEBUGGING',    SET_DEB_STATE),
    ('DELAY',    SET_DEL_STATE),
    ('ESCAPE',    SET_ESC_STATE),
    ('FILE',    SET_FIL_STATE),
    ('HANDSHAKE',    SET_HAN_STATE),
    ('IBM_MODE',    SET_IBM_STATE),
    ('INCOMPLETE_FILE_DISPOSITION', SET_ABT_STATE),
    ('LINE',    SET_LIN_STATE),
    ('LOCAL_ECHO',    SET_ECH_STATE),
    ('MESSAGE',    SET_MSG_STATE),
    ('PARITY',    SET_PAR_STATE),
    ('PROMPT',    SET_PMT_STATE),
    ('RECEIVE',    SET_REC_STATE),
    ('REPEAT_QUOTE',SET_RPT_STATE),
    ('RETRY',    SET_RTY_STATE),
    ('SEND',    SET_SND_STATE),
    ('SERVER_TIMER',SET_SRV_STATE),
    ('TRANSMIT',    SET_TRN_STATE),  !
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

!++
!
! SET INCOMPLETE_FILE [disposition] command.  The possible arguments are
!    KEEP or DISCARD.
!
!--

$STATE    (SET_ABT_STATE,
    ('DISCARD', DONE_STATE,    STORE_ABT,,    ,TRUE),
    ('KEEP',    DONE_STATE,    STORE_ABT,,    ,FALSE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

!++
!
! SET BLOCK_CHECK_TYPE [type] command.  The format is:
!
!    Kermit-32>SET BLOCK_CHECK_TYPE [1_CHARACTER_CHECKSUM | ....]
!
!--

$STATE    (SET_CHK_STATE,
    ('1_CHARACTER_CHECKSUM', DONE_STATE,    STORE_CHK,,    ,CHK_1CHAR),
    ('2_CHARACTER_CHECKSUM', DONE_STATE,    STORE_CHK,,    ,CHK_2CHAR),
    ('3_CHARACTER_CRC_CCITT', DONE_STATE,    STORE_CHK,,    ,CHK_CRC),
    ('ONE_CHARACTER_CHECKSUM', DONE_STATE,    STORE_CHK,,    ,CHK_1CHAR),
    ('THREE_CHARACTER_CRC_CCITT', DONE_STATE, STORE_CHK,,    ,CHK_CRC),
    ('TWO_CHARACTER_CHECKSUM', DONE_STATE,    STORE_CHK,,    ,CHK_2CHAR),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

!++
!
! SET DEBUGGING command.  The format is:
!
!    Kermit-32>SET DEBUGGING (on/off)
!
! Where:
!    on/off is either the ON or OFF keyword.
!
!--

$STATE    (SET_DEB_STATE,
    ('OFF',        DONE_STATE,    STORE_DEBUG,    ,    ,FALSE),
    ('ON',        DONE_STATE,    STORE_DEBUG,    ,    ,TRUE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

!++
!
! SET IBM_MODE command.  The format is:
!
!    Kermit-32>SET IBM_MODE (on/off)
!
! Where:
!    on/off is either the ON or OFF keyword.
!
!--

$STATE    (SET_IBM_STATE,
    ('OFF',        DONE_STATE,    STORE_IBM,    ,    ,FALSE),
    ('ON',        DONE_STATE,    STORE_IBM,    ,    ,TRUE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )
!++
!
! SET HANDSHAKE command.  The format is:
!
!    Kermit-32>SET HANDSHAKE <octal>
!
! Where:
!    <octal> is the octal number representing the handshake character
!    for file transfers.
!
! Negative values indicate no handshaking.
!--

$STATE    (SET_HAN_STATE,
    ('NONE',    DONE_STATE,    ,   -1    ,IBM_CHAR),
    (TPA$_OCTAL,    DONE_STATE,    ,    ,IBM_CHAR)
    )

!++
!
! SET DELAY command.  The format is:
!
!    Kermit-32>SET DELAY <dec>
!
! Where:
!    <dec> is the number of seconds to delay before sending the
!    SEND-INIT packet.
!--

$STATE    (SET_DEL_STATE,
    (TPA$_DECIMAL,    DONE_STATE,    ,    ,DELAY)
    )

!++
!
! SET FILE BLOCKSIZE command.  The format is:
!
!    Kermit-32>SET FILE BLOCKSIZE <size>
!
! Where:
!    <size> is the number of bytes per fixed-length record for BINARY
!    and FIXED files.
!--

$STATE    (SET_BLK_STATE,
    (TPA$_DECIMAL, DONE_STATE, store_blocksize, , file_blocksize)
        )

!++
!
! SET ESCAPE command.  The format is:
!
!    Kermit-32>SET ESCAPE <octal>
!
! Where:
!    <octal> is the octal number representing the escape character
!    for the CONNECT command processing.  The default escape character
!    is Control-].
!--

$STATE    (SET_ESC_STATE,
    (TPA$_OCTAL,    DONE_STATE,    ,    ,ESCAPE_CHR)
    )
!++
!
! SET FILE xxx command.  The format is:
!
!    Kermit-32>SET FILE <item> <args>
!
! Where:
!    <item> is one of:
!        NAMING - Type of file name to send
!        TYPE - Type of file to create on receive (or send in certain cases)
!               BLOCKSIZE - Size of blocks (in bytes) for (FIXED and BINARY
!                           type) output files.
!
!--
$STATE    (SET_FIL_STATE,
    ('NAMING',    SET_FNM_STATE),
    ('TYPE',    SET_FTP_STATE),
    ('BLOCKSIZE',    SET_BLK_STATE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )
!++
!
! SET FILE NAMING command.  The format is:
!
!    Kermit-32>SET FILE NAMING <type>
!
! Where:
!    <type> is one of:
!        FULL   - Send complete file specification, including device and
!            directory
!        NORMAL_FORM - Send only name.type
!        UNTRANSLATED - Send name.type, but don't do any fixups on it
!--

$STATE (SET_FNM_STATE,
    ('FULL',    DONE_STATE,    STORE_FNM,    ,    ,FNM_FULL),
    ('NORMAL_FORM',    DONE_STATE,    STORE_FNM,    ,    ,FNM_NORMAL),
    ('UNTRANSLATED',DONE_STATE,    STORE_FNM,    ,    ,FNM_UNTRAN),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )
!++
!
! SET FILE TYPE command.  The format is:
!
!    Kermit-32>SET FILE TYPE <type>
!
! Where:
!    <Type> is one of the following:
!        ASCII - Normal ASCII file (stream ascii)
!        BINARY - Micro binary file.
!--

$STATE    (SET_FTP_STATE,
    ('ASCII',    DONE_STATE,    STORE_FTP,    ,    ,FILE_ASC),
    ('BINARY',    DONE_STATE,    STORE_FTP,    ,    ,FILE_BIN),
    ('BLOCK',    DONE_STATE,    STORE_FTP,    ,    ,FILE_BLK),
    ('FIXED',    DONE_STATE,    STORE_FTP,    ,    ,FILE_FIX),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

!++
! SET LINE command.  Format is:
!
!    Kermit-32>SET LINE terminal-device:
!
! Where:
!    Terminal-device: is the terminal line to use to the transfer of
!    the data and to use in the CONNECT command.
!
!--

$STATE    (SET_LIN_STATE,
    (TPA$_ANY,    SET_LIN_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE,    COPY_TERM_NAME)
    )

!++
! SET LOCAL-ECHO command.  Format is:
!
!    Kermit-32>SET LOCAL-ECHO state
!
! Where:
!    STATE is either the keyword ON or OFF.
!
!-

$STATE    (SET_ECH_STATE,
    ('OFF',        DONE_STATE,    STORE_ECHO,    ,    ,FALSE),
    ('ON',        DONE_STATE,    STORE_ECHO,    ,    ,TRUE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )


!++
! SET MESSAGE command. Format is:
!
!    Kermit-32>SET MESSAGE <keyword>
!
! Where the keyword is:
!
!    FILE_NAMES - Type out file names being transferred
!    PACKET_NUMBERS - Type out packet counts
!--

$STATE    (SET_MSG_STATE,
    ('FILE_NAMES',        SET_MSG_FIL_STATE),
    ('PACKET_NUMBERS',    SET_MSG_PKT_STATE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

$STATE    (SET_MSG_FIL_STATE,
    ('OFF',        DONE_STATE,    STORE_MSG_FIL,    ,    ,FALSE),
    ('ON',        DONE_STATE,    STORE_MSG_FIL,    ,    ,TRUE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

$STATE    (SET_MSG_PKT_STATE,
    ('OFF',        DONE_STATE,    STORE_MSG_PKT,    ,    ,FALSE),
    ('ON',        DONE_STATE,    STORE_MSG_PKT,    ,    ,TRUE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

!++
! SET PROMPT command.
!
!    Kermit-32>SET PROMPT new-prompt-text
!
!--

$STATE    (SET_PMT_STATE,
    (TPA$_ANY,    SET_PMT_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,PROMPT_DESC)
    )

!++
! SET REPEAT_QUOTE command.  Format is:
!
!    Kermit-32>SET REPEAT_QUOTE <character value>
!
!--

$STATE    (SET_RPT_STATE,
    (TPA$_OCTAL,    DONE_STATE,    CHECK_QUOTE,    ,SET_REPT_CHR)
    )

!++
! SET RETRY command.  Format is:
!
!    Kermit-32>SET RETRY <keyword>
!
! Where the keyword is:
!
!    INITIAL_CONNECTION - set number of initial connection retries.
!    PACKET - set the number of packet retries.
!--

$STATE    (SET_RTY_STATE,
    ('INITIAL_CONNECTION',    SET_RTY_INI_STATE),
    ('PACKET',        SET_RTY_PKT_STATE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )


$STATE    (SET_RTY_INI_STATE,
    (TPA$_DECIMAL,    DONE_STATE,    ,    ,SI_RETRIES)
    )

$STATE    (SET_RTY_PKT_STATE,
    (TPA$_DECIMAL,    DONE_STATE,    ,    ,PKT_RETRIES)
    )
    %SBTTL    'SET PARITY type'

!++
! SET PARITY command.  Format is:
!
!    Kermit-32>SET PARITY type
!
! The type can be:
!
!    NONE - No parity processing
!    MARK - Mark parity
!    SPACE - Space parity
!    EVEN - Even parity
!    ODD - Odd parity
!
!--

$STATE    (SET_PAR_STATE,
    ('EVEN',    DONE_STATE,    STORE_PARITY,    ,    ,PR_EVEN),
    ('MARK',    DONE_STATE,    STORE_PARITY,    ,    ,PR_MARK),
    ('NONE',    DONE_STATE,    STORE_PARITY,    ,    ,PR_NONE),
    ('ODD',        DONE_STATE,    STORE_PARITY,    ,    ,PR_ODD),
    ('SPACE',    DONE_STATE,    STORE_PARITY,    ,    ,PR_SPACE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )
    %SBTTL    'SET RECEIVE table'

!++
! SET RECEIVE command.  Format is:
!
!    Kermit-32>SET RECEIVE item
!
! Where:
!    Item - One of the following:
!        PACKET-LENGTH <dec>
!        PADDING <dec>
!        PADCHAR <chr>
!        TIMEOUT <dec>
!        END-OF-LINE <oct>
!        QUOTE <chr>
!
!--

$STATE    (SET_REC_STATE,
    ('EIGHT-BIT-QUOTE',    SR_8QU_STATE),
    ('END_OF_LINE',        SR_EOL_STATE),
    ('PACKET_LENGTH',    SR_PKT_STATE),
    ('PADCHAR',        SR_PDC_STATE),
    ('PADDING',        SR_PAD_STATE),
    ('QUOTE',        SR_QUO_STATE),
    ('START_OF_PACKET',    SR_SOH_STATE),
    ('TIMEOUT',        SR_TIM_STATE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

!++
!
! SET RECEIVE PACKET-LENGTH command.  Format is:
!
!    Kermit-32>SET RECEIVE PACKET-LENGTH <dec>
!
! Where:
!    <Dec> is a decimal number that specifies the length of a
!    receive packet.
!
!--

$STATE    (SR_PKT_STATE,
    (TPA$_DECIMAL,    DONE_STATE,    CHECK_PACKET_LEN,    ,RCV_PKT_SIZE)
    )


!++
!
! SET RECEIVE PADDING command.  The format of this command is:
!
!    Kermit-32>SET RECEIVE PADDING <dec>
!
! Where:
!    <dec> is the decimal number of padding characters to output.
!
!--

$STATE    (SR_PAD_STATE,
    (TPA$_DECIMAL,    DONE_STATE,    CHECK_NPAD,    ,RCV_NPAD)
    )

!++
!
! SET RECEIVE PADCHAR command.  Format is:
!
!    Kermit-32>SET RECEIVE PADCHAR <oct>
!
! Where:
!    <oct> is the octal representation of the padding character
!    that is to be used.
!
!--

$STATE    (SR_PDC_STATE,
    (TPA$_OCTAL,    DONE_STATE,    CHECK_PAD_CHAR,    ,RCV_PADCHAR)
    )
!++
!
! SET RECEIVE START_OF_PACKET command.  Format is:
!
!    Kermit-32>SET RECEIVE START_OF_PACKET <oct>
!
! Where:
!    <oct> is the octal representation of the padding character
!    that is to be used.
!
!--

$STATE    (SR_SOH_STATE,
    (TPA$_OCTAL,    DONE_STATE,    CHECK_SOH,    ,RCV_SOH)
    )

!++
!
! SET RECEIVE TIMEOUT command.  The format is:
!
!    Kermit-32>SET RECEIVE TIMEOUT <dec>
!
! Where:
!    <dec> is the number of seconds before KERMIT-32 should time out
!    attempting to receive a correct message.
!
!--

$STATE    (SR_TIM_STATE,
    (TPA$_DECIMAL,    DONE_STATE,    ,    ,RCV_TIMEOUT)
    )

!++
! SET END-OF-LINE command.  Format is:
!
!    Kermit-32>SET RECEIVE END-OF-LINE <octal>
!
! Where:
!    <octal> is the octal number representation of the character
!    that is the end of line character.
!
!--

$STATE    (SR_EOL_STATE,
    (TPA$_OCTAL,    DONE_STATE,    CHECK_EOL,    ,RCV_EOL)
    )

!++
! SET RECEIVE QUOTE command.  The format is:
!
!    Kermit-32>SET RECEIVE QUOTE <octal>
!
! Where:
!    <octal> is the octal number representing the quoting character.
!
!--

$STATE    (SR_QUO_STATE,
    (TPA$_OCTAL,    DONE_STATE,    CHECK_QUOTE,    ,RCV_QUOTE_CHR)
    )
    %SBTTL    'SET RECEIVE EIGHT-BIT-QUOTE'

!++
! This routine will handle the setting of the eight bit quoting character.
!
!    Kermit-32>SET RECEIVE EIGHT-BIT-QUOTE <octal>
!
! Where:
!    <octal> is the octal number representing the quoting character.
!
!--

$STATE    (SR_8QU_STATE,
    (TPA$_OCTAL,    DONE_STATE,    CHECK_QUOTE,    ,RCV_8QUOTE_CHR)
    )
    %SBTTL    'SET SEND tables'

!++
! SET SEND command.  Format is:
!
!    Kermit-32>SET SEND item
!
! Where:
!    Item - One of the following:
!        PACKET-LENGTH <dec>
!        PADDING <dec>
!        PADCHAR <chr>
!        TIMEOUT <dec>
!        END-OF-LINE <oct>
!        QUOTE <chr>
!
!--

$STATE    (SET_SND_STATE,
    ('END_OF_LINE',        SS_EOL_STATE),
    ('PACKET_LENGTH',    SS_PKT_STATE),
    ('PADCHAR',        SS_PDC_STATE),
    ('PADDING',        SS_PAD_STATE),
    ('QUOTE',        SS_QUO_STATE),
    ('START_OF_PACKET',    SS_SOH_STATE),
    ('TIMEOUT',        SS_TIM_STATE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )



!++
!
! SET SEND PACKET-LENGTH command.  Format is:
!
!    Kermit-32>SET SEND PACKET-LENGTH <dec>
!
! Where:
!    <Dec> is a decimal number that specifies the length of a
!    receive packet.
!
!--

$STATE    (SS_PKT_STATE,
    (TPA$_DECIMAL,    DONE_STATE,    CHECK_PACKET_LEN,    ,SND_PKT_SIZE)
    )


!++
!
! SET SEND PADDING command.  The format of this command is:
!
!    Kermit-32>SET SEND PADDING <dec>
!
! Where:
!    <dec> is the decimal number of padding characters to output.
!
!--

$STATE    (SS_PAD_STATE,
    (TPA$_DECIMAL,    DONE_STATE,    CHECK_NPAD,    ,SND_NPAD)
    )

!++
!
! SET SEND PADCHAR command.  Format is:
!
!    Kermit-32>SET SEND PADCHAR <oct>
!
! Where:
!    <oct> is the octal representation of the padding character
!    that is to be used.
!
!--

$STATE    (SS_PDC_STATE,
    (TPA$_OCTAL,    DONE_STATE,    CHECK_PAD_CHAR,    ,SND_PADCHAR)
    )
!++
!
! SET RECEIVE START_OF_PACKET command.  Format is:
!
!    Kermit-32>SET RECEIVE START_OF_PACKET <oct>
!
! Where:
!    <oct> is the octal representation of the padding character
!    that is to be used.
!
!--

$STATE    (SS_SOH_STATE,
    (TPA$_OCTAL,    DONE_STATE,    CHECK_SOH,    ,SND_SOH)
    )

!++
!
! SET SEND TIMEOUT command.  The format is:
!
!    Kermit-32>SET SEND TIMEOUT <dec>
!
! Where:
!    <dec> is the number of seconds before KERMIT-32 should time out
!    attempting to receive a correct message.
!
!--

$STATE    (SS_TIM_STATE,
    (TPA$_DECIMAL,    DONE_STATE,    ,    ,SND_TIMEOUT)
    )

!++
! SET SEND END-OF-LINE command.  Format is:
!
!    Kermit-32>SET SEND END-OF-LINE <octal>
!
! Where:
!    <octal> is the octal number representation of the character
!    that is the end of line character.
!
!--

$STATE    (SS_EOL_STATE,
    (TPA$_OCTAL,    DONE_STATE,    CHECK_EOL,    ,SND_EOL)
    )

!++
! SET SEND QUOTA command.  The format is:
!
!    Kermit-32>SET SEND QUOTA <octal>
!
! Where:
!    <octal> is the octal number representing the quoting character.
!
!--

$STATE    (SS_QUO_STATE,
    (TPA$_OCTAL,    DONE_STATE,    CHECK_QUOTE,    ,SND_QUOTE_CHR)
    )

!++
! SET SERVER_TIMER command.
!
! This sets the time between naks send when server is idle.
!--

$STATE    (SET_SRV_STATE,
    (TPA$_DECIMAL,    DONE_STATE,    ,    ,SRV_TIMEOUT)
    )

!++
!
! SET TRANSMIT xxx command.  The format is:     !  and below
!
!    Kermit-32>SET TRANSMIT <item> <args>
!
! Where:
!    <item> is one of:
!        DELAY - Time to delay after each carriage return
!            ECHO - Echo from terminal line or just print line numbers
!
!--
$STATE    (SET_TRN_STATE,                                                !
    ('DELAY',    SET_TRD_STATE),                                !
    ('ECHO',    SET_TRE_STATE),                                !
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)                     !
    )                                                              !

!++
!
! SET TRANSMIT DELAY command.  Format is:          ! and below
!
!    Kermit-32>SET TRANSMIT DELAY <digit>
!
! Where:
!    <digit> is a decimal digit that specifies the length of time in
!    tenths of a second to delay after transmitting a carriage return.
!
!--

$STATE    (SET_TRD_STATE,                                                       !
    (TPA$_DIGIT,    DONE_STATE,    STORE_TR_DELAY,     ,TRANS_DELAY) !
    )                                                                     !

!++
!
! SET TRANSMIT ECHO command.  The format is:         !  and below
!
!    Kermit-32>SET TRANSMIT ECHO (on/off)
!
! Where:
!    on/off is either the ON or OFF keyword.
!
!--

$STATE    (SET_TRE_STATE,                                                 !
    ('ON',        DONE_STATE,    STORE_TR_ECHO,    ,    ,TRUE), !
    ('OFF',        DONE_STATE,    STORE_TR_ECHO,    ,    ,FALSE),!
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)                      !
    )                                                               !
    %SBTTL    'SEND command'

!++
! SEND command.  The format is:
!
!    Kermit-32>SEND file-specification
!
! Where:
!    FILE-SPECIFICATION is any valid VAX/VMS file specification.
!
!--

$STATE    (SEND_STATE,
    (TPA$_ANY,    SEND_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,FILE_DESC)
    )
    %SBTTL    'SHOW command'

!++
! SHOW command.  The format is:
!
!    Kermit-32>SHOW <parameter>
!
! Where:
!    <Parameter> is one of the following:
!        SEND - Send parameters
!        RECEIVE - Receive parameters
!        DEBUGGING - State of the debugging flag
!        FILE-TYPE - Type of the file
!        LOCAL-ECHO - Local echo flag
!        LINE - Current line associated
!        ESCAPE - Current escape character
!        DELAY  - Delay parameter.
!
!--

$STATE    (SHOW_STATE,
    ('ALL',            DONE_STATE,    ,SHOW_ALL,    SHOW_TYPE),
    ('BLOCK_CHECK_TYPE',    DONE_STATE,    ,SHOW_CHK,    SHOW_TYPE),
    ('COMMUNICATIONS',    DONE_STATE,    ,SHOW_COM,    SHOW_TYPE),
    ('DEBUGGING',        DONE_STATE,    ,SHOW_DEB,    SHOW_TYPE),
    ('DELAY',        DONE_STATE,    ,SHOW_DEL,    SHOW_TYPE),
    ('ESCAPE',        DONE_STATE,    ,SHOW_ESC,    SHOW_TYPE),
    ('FILE_PARAMETERS',    DONE_STATE,    ,SHOW_FIL,    SHOW_TYPE),
    ('INCOMPLETE_FILE_DISPOSITION',DONE_STATE,    ,SHOW_ABT,    SHOW_TYPE),
    ('LINE',        DONE_STATE,    ,SHOW_LIN,    SHOW_TYPE),
    ('LOCAL_ECHO',        DONE_STATE,    ,SHOW_ECH,    SHOW_TYPE),
    ('PACKET',        DONE_STATE,    ,SHOW_PAC,    SHOW_TYPE),
    ('PARITY',        DONE_STATE,    ,SHOW_PAR,    SHOW_TYPE),
    ('SEND',        DONE_STATE,    ,SHOW_SEN,    SHOW_TYPE),
    ('TIMING',        DONE_STATE,    ,SHOW_TIM,    SHOW_TYPE),
    ('RECEIVE',        DONE_STATE,    ,SHOW_REC,    SHOW_TYPE),
    ('RETRY',        DONE_STATE,    ,SHOW_RTY,    SHOW_TYPE),
    ('VERSION',        DONE_STATE,    ,SHOW_VER,    SHOW_TYPE),
    ('TRANSMIT',        DONE_STATE,    ,SHOW_TRN,    SHOW_TYPE),   !
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )
    %SBTTL    'LOG command'

!++
! The LOG command allows the specification of a session or transaction
!log file.
!--

$STATE    (LOG_STATE,
    ('DEBUGGING',    DBG_STATE),
    ('SESSION',    SES_STATE),
    ('TRANSACTIONS',TRN_STATE),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

$STATE    (DBG_STATE,
    (TPA$_ANY,    DBG_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,DEBUG_DESC)
    )

$STATE    (SES_STATE,
    (TPA$_ANY,    SES_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,SESSION_DESC)
    )

$STATE    (TRN_STATE,
    (TPA$_ANY,    TRN_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,TRANSACTION_DESC)
    )


    %SBTTL    'Take command tables'

!++
! The following describes the TAKE (or @) command.
!--

$STATE    (TAKE_STATE,
    ('/',        TAK_SWT_STATE,    COPY_DESC,    ,    ,TAK_FIL_DESC),
    (TPA$_ANY,    TAKE_STATE,    STORE_TEXT),
    (TPA$_LAMBDA,    DONE_STATE,    COPY_DESC,    ,    ,TAK_FIL_DESC)
    )

$STATE    (TAK_SWT_STATE,
    ('DISPLAY',        DONE_STATE,    ,TRUE,        TAKE_DISPLAY),
    (TPA$_SYMBOL,    TPA$_FAIL,    KEY_ERROR)
    )

      %SBTTL  'TRANSMIT command'                                         !
                                                                         !
!++                                                                      !
! TRANSMIT command.  The format is:                                      !
!                                                                        !
!     Kermit-32>TRANSMIT file-specification                              !
!                                                                        !
! Where:                                                                 !
!     FILE-SPECIFICATION is any valid VAX/VMS file specification.        !
!                                                                        !
!--                                                                      !
                                                                         !
$STATE  (TRANSMIT_STATE,                                                 !
      (TPA$_ANY,  TRANSMIT_STATE,          STORE_TEXT),                  !
      (TPA$_LAMBDA, DONE_STATE,        COPY_DESC,                       , ,FILE_DESC)  !
      )                                                                  !

    %SBTTL    'Done state'

!++
! This is the single state that is the required CONFIRM for the end
! of the commands.
!--

$STATE    (DONE_STATE,
    (TPA$_EOS,    TPA$_EXIT)
    )

!++
!
! End of the KERMIT-32 command definitions
!
!--

PSECT    OWN = $OWN$;
PSECT    GLOBAL = $GLOBAL$;

!<BLF/FORMAT>
ROUTINE MAIN_ROUTINE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This is the main routine for KERMIT-32.  This routine will
!    initialize the various parameters and then call the command
!    scanner to process commands.
!
! FORMAL PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!    Return status from last command.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS,                    ! Returned status
    CRC_BIT_MASK,                ! Bit mask for CRC initialization
    LOOP_FLAG;

!
! Initialize some variables
!
    STATUS = LIB$PUT_OUTPUT (IDENT_STRING);    ! Say who we are
    MSG_INIT ();                ! Initialize message processing
    TERM_INIT ();                ! Init terminal processing
    TT_INIT ();                    ! Init text processing
    FILE_INIT ();                ! Init file processing
    SY_INIT ();                    ! Init system routines
    ESCAPE_CHR = CHR_ESCAPE;
!
! Initialize some VAX/VMS interface items
!
    CRC_BIT_MASK = %O'102010';            ! CRC bit mask
    LIB$CRC_TABLE (CRC_BIT_MASK, CRC_TABLE);
    LIB$ESTABLISH (KERM_HANDLER);
!
! Initialize transaction log file descriptor
!
    INIT_STR_DESC (TRANSACTION_DESC, TRANSACTION_NAME, 0);
!
! Initialize take file descriptor
!
    INIT_STR_DESC (TAK_FIL_DESC, TAK_FIL_NAME, 0);
!
! Initialize prompt descriptor
!
    INIT_STR_DESC (PROMPT_DESC, PROMPT_TEXT, 0);
!
! Take initialization file
!
    COMND_FILE (%ASCID'VMSKERMIT', %ASCID'.INI;0', TRUE, FALSE);
!
! Main command loop
!
    Status = COMND ();
    RETURN .Final_Status OR STS$M_INHIB_MSG;
    END;                    ! end of routine MAIN_ROUTINE
%SBTTL 'COMND'
ROUTINE COMND =

!++
! FUNCTIONAL DESCRIPTION:
!    This routine will do the command scanning for KERMIT-32.  It
!    will call the correct routines to process the commands.
!
! CALLING SEQUENCE:
!
!    COMND();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    Return status from last command.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    EXTERNAL ROUTINE
    GET_COMMAND,                ! Get line from SYS$COMMAND
    LIB$GET_FOREIGN : ADDRESSING_MODE (GENERAL);    ! Get command which started program

    LOCAL
    DESC : BLOCK [8, BYTE],
    CMD_BUF : VECTOR [80, BYTE, UNSIGNED],
    CMD_SIZE : UNSIGNED WORD,
    ONE_COMMAND,                ! Only do one command
    STATUS : UNSIGNED LONG;

    ONE_COMMAND = FALSE;            ! And many commands
!
! Initialize the command string descriptor
!
    INIT_STR_DESC (DESC, CMD_BUF, 80);
!
! Get the first command string.  If we get something, then we will only
! want to perform one command, then exit.  Otherwise, we will do commands
! until something one tells us to exit.
!
    STATUS = LIB$GET_FOREIGN (DESC, 0, CMD_SIZE, 0);

    IF .STATUS EQL RMS$_EOF THEN RETURN SS$_NORMAL;

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

    IF .CMD_SIZE GTR 0 THEN ONE_COMMAND = TRUE;

    WHILE TRUE DO
    BEGIN

    IF .CMD_SIZE GTR 0
    THEN
        BEGIN
        DESC [DSC$W_LENGTH] = .CMD_SIZE;

        IF .STATUS THEN STATUS = DO_COMND (DESC);

        IF .STATUS EQL KER_EXIT THEN RETURN SS$_NORMAL;

        IF NOT .STATUS AND .STATUS NEQ KER_TAKE_ERROR THEN COMND_ERROR (.STATUS);

        END;

!
! If we were given command when run, just exit after doing it
!

    IF .ONE_COMMAND THEN RETURN SS$_NORMAL;

!
! Initialize prompt if null
!

    IF .PROMPT_DESC [DSC$W_LENGTH] LEQ 0
    THEN
        BEGIN
        CH$COPY (.DEFAULT_PROMPT [DSC$W_LENGTH], CH$PTR (.DEFAULT_PROMPT [DSC$A_POINTER]), 0,
        TEMP_LENGTH, CH$PTR (PROMPT_TEXT));
        PROMPT_DESC = .DEFAULT_PROMPT [DSC$W_LENGTH];
        END;

    DESC [DSC$W_LENGTH] = 80;        ! Reset length
    STATUS = GET_COMMAND (DESC, PROMPT_DESC, CMD_SIZE, TRUE);

    IF .STATUS EQL RMS$_EOF THEN RETURN SS$_NORMAL;
!
! If there was an error then return the error code to the upper level
!
    IF NOT .STATUS                ! Failing status?
    THEN
        RETURN .STATUS;            ! Yes, return it

    END;                    ! End of WHILE TRUE DO BEGIN

    RETURN SS$_NORMAL;
    END;                    ! End of COMND
%SBTTL 'COMND_FILE - Perform take (indirect) file'
ROUTINE COMND_FILE (TAKE_DESC, DEFAULT_DESC, OK_NONE, DISPLAY_FLAG) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will read a file of commands and perform them.  If any
! error occurs, it will abort the command processing.
!
! CALLING SEQUENCE:
!
!    STATUS = COMND_FILE (TAKE_DESC, DEFAULT_DESC, OK_NONE, DISPLAY_FLAG)
!
! INPUT PARAMETERS:
!
!    TAKE_DESC - String descriptor of file specification
!    DEFAULT_DESC - Default file specification
!    OK_NONE - If true, return EOF if file does not exist, otherwise
!        return error if file does not exist.
!    DISPLAY_FLAG - If true display commands being executed
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    Standard status values
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    EXTERNAL ROUTINE
    STR$UPCASE : ADDRESSING_MODE (GENERAL),    ! Upcase a string
    LIB$GET_VM : ADDRESSING_MODE (GENERAL) NOVALUE,
    LIB$FREE_VM : ADDRESSING_MODE (GENERAL) NOVALUE;

    MAP
    TAKE_DESC : REF BLOCK [8, BYTE],
    DEFAULT_DESC : REF BLOCK [8, BYTE];    ! The args are descriptors

    LOCAL
    TAKE_FILE_DESC : BLOCK [8, BYTE],    ! Descriptor for take file
    TAKE_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],    ! Name of take file
    TAKE_FILE_FAB : $FAB_DECL,        ! FAB for take file
    TAKE_FILE_RAB : $RAB_DECL,        ! RAB for take file
    TAKE_FILE_XABFHC : $XABFHC_DECL,    ! XAB for file header items
    TAKE_FILE_BADR,                ! Address of take file buffer
    TAKE_FILE_BSIZ,                ! Size of take file buffer
    TAKE_FILE_FADR,                ! Address of fixed header buffer
    TAKE_FILE_FSIZ,                ! size of fixed header buffer
    STATUS,                    ! Random status values
    CMD_DESC : BLOCK [8, BYTE];        ! Descriptor for command

    CH$COPY (.TAKE_DESC [DSC$W_LENGTH], CH$PTR (.TAKE_DESC [DSC$A_POINTER]), 0, MAX_FILE_NAME,
    CH$PTR (TAKE_FILE_NAME));
    INIT_STR_DESC (TAKE_FILE_DESC, TAKE_FILE_NAME, .TAKE_DESC [DSC$W_LENGTH]);
    $FAB_INIT (FAB = TAKE_FILE_FAB, FNA = TAKE_FILE_NAME, FNS = .TAKE_FILE_DESC [DSC$W_LENGTH], FAC = GET,
    XAB = TAKE_FILE_XABFHC, DNA = .DEFAULT_DESC [DSC$A_POINTER], DNS = .DEFAULT_DESC [DSC$W_LENGTH]);
    $XABFHC_INIT (XAB = TAKE_FILE_XABFHC);
    STATUS = $OPEN (FAB = TAKE_FILE_FAB);

    IF NOT .STATUS
    THEN
    BEGIN

    IF .STATUS EQL RMS$_FNF AND .OK_NONE THEN RETURN KER_TAKE_EOF;

    LIB$SIGNAL (.STATUS);
    RETURN KER_TAKE_ERROR;
    END;

!
! Allocate a buffer
!
    TAKE_FILE_BSIZ = .TAKE_FILE_XABFHC [XAB$W_LRL];

    IF .TAKE_FILE_BSIZ EQL 0 THEN TAKE_FILE_BSIZ = MAX_REC_LENGTH;

    LIB$GET_VM (TAKE_FILE_BSIZ, TAKE_FILE_BADR);
    INIT_STR_DESC (CMD_DESC, .TAKE_FILE_BADR, .TAKE_FILE_BSIZ);
!
! Determine if we need a buffer for the fixed control area
!
    TAKE_FILE_FSIZ = .TAKE_FILE_FAB [FAB$B_FSZ];

    IF .TAKE_FILE_FSIZ NEQ 0 THEN LIB$GET_VM (TAKE_FILE_FSIZ, TAKE_FILE_FADR);

!
! Initialize the RAB for the $CONNECT RMS call
!
    $RAB_INIT (RAB = TAKE_FILE_RAB, FAB = TAKE_FILE_FAB, RAC = SEQ, ROP = NLK, UBF = .TAKE_FILE_BADR,
    USZ = .TAKE_FILE_BSIZ);

    IF .TAKE_FILE_FSIZ NEQ 0 THEN TAKE_FILE_RAB [RAB$L_RHB] = .TAKE_FILE_FADR;

    STATUS = $CONNECT (RAB = TAKE_FILE_RAB);

    IF NOT .STATUS
    THEN
    BEGIN
    LIB$SIGNAL (.STATUS);
    LIB$FREE_VM (TAKE_FILE_BSIZ, TAKE_FILE_BADR);

    IF .TAKE_FILE_FSIZ NEQ 0 THEN LIB$FREE_VM (TAKE_FILE_FSIZ, TAKE_FILE_FADR);

    RETURN KER_TAKE_ERROR;
    END;

    WHILE (STATUS = $GET (RAB = TAKE_FILE_RAB)) DO
    BEGIN

    IF .TAKE_FILE_RAB [RAB$W_RSZ] GTR 0
    THEN
        BEGIN
        CMD_DESC [DSC$W_LENGTH] = .TAKE_FILE_RAB [RAB$W_RSZ];
        STATUS = STR$UPCASE (CMD_DESC, CMD_DESC);

        IF .DISPLAY_FLAG THEN LIB$PUT_OUTPUT (CMD_DESC);

        STATUS = DO_COMND (CMD_DESC);

        IF NOT .STATUS
        THEN
        BEGIN

        IF .STATUS NEQ KER_TAKE_ERROR
        THEN
            BEGIN
            COMND_ERROR (.STATUS);
            LIB$PUT_OUTPUT (CMD_DESC);
            STATUS = KER_TAKE_ERROR;    ! Indicate we should abort back
            END;

        EXITLOOP;
        END;

        END;

    END;                    ! End of WHILE TRUE DO BEGIN

!
! When the loop exits, we got some kind of error.  Complain unless end of file.
!

    IF .STATUS EQL RMS$_EOF THEN STATUS = KER_TAKE_EOF;

    IF .STATUS NEQ KER_EXIT AND .STATUS NEQ KER_TAKE_EOF AND .STATUS NEQ KER_TAKE_ERROR
    THEN
    LIB$SIGNAL (.STATUS);

!
! Close the file
!
    $DISCONNECT (RAB = TAKE_FILE_RAB);
    $CLOSE (FAB = TAKE_FILE_FAB);
!
! Return any buffers
!
    LIB$FREE_VM (TAKE_FILE_BSIZ, TAKE_FILE_BADR);

    IF .TAKE_FILE_FSIZ NEQ 0 THEN LIB$FREE_VM (TAKE_FILE_FSIZ, TAKE_FILE_FADR);

    RETURN .STATUS;
    END;                    ! End of COMND_FILE
%SBTTL 'COMND_ERROR - Give error message for command'
ROUTINE COMND_ERROR (STATUS) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will issue an error message for a command parsing error.
!
! CALLING SEQUENCE:
!
!    COMND_ERROR (.STATUS);
!
! INPUT PARAMETERS:
!
!    STATUS - The status value returned from DO_COMND
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    IF .STATUS EQL KER_AMBIGKEY OR .STATUS EQL KER_UNKNOWKEY
    THEN
    LIB$SIGNAL (.STATUS, 1,
        TPARSE_BLOCK [TPA$L_TOKENCNT])
    ELSE
    BEGIN

    EXTERNAL LITERAL
        LIB$_SYNTAXERR;

    IF .STATUS EQL LIB$_SYNTAXERR
    THEN
        LIB$SIGNAL (KER_CMDERR, 1, TPARSE_BLOCK [TPA$L_STRINGCNT])
    ELSE
        LIB$SIGNAL (.STATUS);

    END;

    END;                    ! End of COMND_ERROR
%SBTTL 'DO_COMND'
ROUTINE DO_COMND (CMD_DESC) =

!++
! FUNCTIONAL DESCRIPTION:
! This routine will parse and process one Kermit command.
!
! CALLING SEQUENCE:
!
!    STATUS = DO_COMND(CMD_DESC);
!
! INPUT PARAMETERS:
!
!    CMD_DESC - Descriptor of command string
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    BIND
    SERVER_TEXT = %ASCID'Kermit Server running on VAX/VMS host.  Please type your escape sequence to',
    SERVER_TEXT_1 = %ASCID' return to your local machine.  Shut down the server by typing the Kermit BYE',
    SERVER_TEXT_2 = %ASCID' command on your local machine.',
    PUSH_TEXT = %ASCID' Type LOGOUT to return to VMS Kermit';

    MAP
    CMD_DESC : REF BLOCK [8, BYTE];        ! Descriptor for command

    LOCAL
    STATUS : UNSIGNED LONG;

! Initialize some per-command data areas.
    INIT_STR_DESC (TEMP_DESC, TEMP_NAME, 0);
    COMMAND = 0;
    SHOW_TYPE = 0;
    REM_TYPE = 0;
    FILE_SIZE = 0;
    ALT_FILE_SIZE = 0;
    GEN_1SIZE = 0;
    GEN_2SIZE = 0;
    GEN_3SIZE = 0;
    CONNECT_FLAG = FALSE;            ! Assume not connected
    TAKE_DISPLAY = 0;
    TPARSE_BLOCK [TPA$L_STRINGCNT] = .CMD_DESC [DSC$W_LENGTH];
    TPARSE_BLOCK [TPA$L_STRINGPTR] = .CMD_DESC [DSC$A_POINTER];
    TPARSE_BLOCK [TPA$V_BLANKS] = 0;        ! Ignore blanks
    STATUS = LIB$TPARSE (TPARSE_BLOCK, KERMIT_STATE, KERMIT_KEY);

    IF .STATUS
    THEN
    BEGIN
    FILE_SIZE = .FILE_DESC [DSC$W_LENGTH];    ! Copy length in case needed

    CASE .COMMAND FROM CMD_MIN TO CMD_MAX OF
        SET

        [CMD_BYE] :
        BEGIN

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

            IF NOT .CONNECT_FLAG THEN DO_GENERIC (GC_LOGOUT) ELSE STATUS = KER_LOCONLY;

            TERM_CLOSE ()
            END;

        IF NOT .STATUS THEN RETURN .STATUS ELSE RETURN KER_EXIT;

        END;

        [CMD_CONN] :
        TERM_CONNECT ();

        [CMD_EXIT] :
        RETURN KER_EXIT;

        [CMD_FINISH] :

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

            IF NOT .CONNECT_FLAG THEN DO_GENERIC (GC_EXIT) ELSE STATUS = KER_LOCONLY;

            TERM_CLOSE ()
            END;

        [CMD_GET] :

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

            IF NOT .CONNECT_FLAG THEN REC_SWITCH () ELSE STATUS = KER_LOCONLY;

            TERM_CLOSE ();
            END;

        [CMD_HELP] :
        COMND_HELP ();

        [CMD_LOGOUT] :

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

            IF NOT .CONNECT_FLAG THEN DO_GENERIC (GC_LOGOUT) ELSE STATUS = KER_LOCONLY;

            TERM_CLOSE ()
            END;

        [CMD_RECEIVE] :

        IF (STATUS = TERM_OPEN (TRUE))    ! Open the terminal
        THEN
            BEGIN
            FILE_SIZE = 0;        ! No file to request
            REC_SWITCH ();
            TERM_CLOSE ();
            END;

        [CMD_REMOTE] :
        COMND_REMOTE ();

        [CMD_LOCAL] :
        COMND_LOCAL ();

        [CMD_PUSH] :
        BEGIN

        OWN
            PID : INITIAL (0);

        LIB$PUT_OUTPUT (PUSH_TEXT);

        IF .PID NEQ 0
        THEN
            BEGIN
            STATUS = LIB$ATTACH (PID);

            IF NOT .STATUS THEN PID = 0;

            END;

        IF .PID EQL 0
                THEN STATUS = LIB$SPAWN (0, 0, 0, 0, 0, PID);    ! Just spawn a DCL

        END;

        [CMD_SEND] :
        BEGIN

        EXTERNAL ROUTINE
            FILE_OPEN,            ! Open file routine
            FILE_CLOSE;            ! Close file routine

        LOCAL
            SAVE_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],
            SAVE_FILE_SIZE,
            SAVE_TY_FIL;

        SAVE_TY_FIL = .TY_FIL;        ! Save current type out flag
        TY_FIL = FALSE;            ! Suppress type out of names
        SAVE_FILE_SIZE = .FILE_SIZE;    ! Save the file name size

        CH$MOVE((.FILE_SIZE),CH$PTR(FILE_NAME),
            CH$PTR(SAVE_FILE_NAME));

        IF FILE_OPEN (FNC_READ)
        THEN
            BEGIN
            FILE_SIZE = .SAVE_FILE_SIZE;    ! Reset the file name size
            CH$MOVE(.FILE_SIZE,CH$PTR(SAVE_FILE_NAME),
            CH$PTR(FILE_NAME));

            FILE_CLOSE (FALSE);
            TY_FIL = .SAVE_TY_FIL;    ! Reset type out flag

            IF (STATUS = TERM_OPEN (TRUE))    ! Open the terminal
            THEN
            BEGIN
            SEND_SWITCH ();
            TERM_CLOSE ();
            END;

            END
        ELSE
            TY_FIL = .SAVE_TY_FIL;    ! Reset type out flag

        END;

        [CMD_SERVER] :
        BEGIN
        LIB$PUT_OUTPUT (SERVER_TEXT);
        LIB$PUT_OUTPUT (SERVER_TEXT_1);
        LIB$PUT_OUTPUT (SERVER_TEXT_2);

        IF (STATUS = TERM_OPEN (TRUE))    ! Open the terminal
        THEN
            BEGIN
            STATUS = SERVER ();
            TERM_CLOSE ();
            RETURN KER_NORMAL;

            END;

        END;

        [CMD_SHOW] :
        COMND_SHOW ();

        [CMD_STATUS] :
        COMND_STATUS ();

        [CMD_TAKE] :
        STATUS = COMND_FILE (TAK_FIL_DESC, %ASCID'.COM;0', FALSE, .TAKE_DISPLAY);

            [CMD_TRANSMIT]:                                               !
                COMND_TRANSMIT ();                                        !

        [INRANGE] :
        TES;

    END;

    RETURN .STATUS;
    END;                    ! End of DO_COMND
%SBTTL 'Command execution -- COMND_HELP'
ROUTINE COMND_HELP : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will do the HELP command processing for KERMIT.  It
!    will call the library routines.
!
! CALLING SEQUENCE:
!
!    COMND_HELP();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
        Help_File : VECTOR [2],
    STATUS : UNSIGNED LONG;

    EXTERNAL ROUTINE
    LBR$OUTPUT_HELP : ADDRESSING_MODE (GENERAL);

!
! Do the help processing.
!
    Status = $TRNLNM(TABNAM = %ASCID 'LNM$FILE_DEV',
                     LOGNAM = %ASCID 'KERMIT_HELP');
    IF .Status
    THEN
        BEGIN
        Help_File [0] = %CHARCOUNT(%ASCII 'KERMIT_HELP');
        Help_File [1] = UPLIT BYTE(%ASCII 'KERMIT_HELP');
        STATUS = LBR$OUTPUT_HELP (LIB$PUT_OUTPUT,
                                  0,
                                  TEMP_DESC,
                                  %ASCID'KERMIT_HELP',
                              UPLIT (HLP$M_PROMPT +
                                         HLP$M_PROCESS +
                                         HLP$M_GROUP +
                                         HLP$M_SYSTEM),
                                  LIB$GET_INPUT);
        END
    ELSE
        BEGIN
        Help_File [0] = %CHARCOUNT(%ASCII 'KERMIT_HELP');
        Help_File [1] = UPLIT BYTE(%ASCII 'KERMIT_HELP');
        STATUS = LBR$OUTPUT_HELP (LIB$PUT_OUTPUT,
                                  0,
                                  TEMP_DESC,
                                  %ASCID'KERMIT',
                                  UPLIT (HLP$M_PROMPT +
                                         HLP$M_PROCESS +
                                         HLP$M_GROUP +
                                         HLP$M_SYSTEM),
                                  LIB$GET_INPUT);
        END;

    IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);

    END;
%SBTTL 'Command execution -- Support routines -- OUTPUT_LONG_WORD'
ROUTINE OUTPUT_LONG_WORD (MSG_ADDR, LONG_VALUE) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!    This routine is used to output the various long word parameters
!    that are shown by the SHOW command.  All text is defined in the level
!    0 of this program.
!
! CALLING SEQUENCE:
!
!    OUTPUT_LONG_WORD( MSG_ASCID, LONG_WORD_VALUE_TO_OUTPUT);
!
! INPUT PARAMETERS:
!
!    MSG_ASCID - %ASCID of the text to use for the $FAO call.
!
!    LONG_WORD_VALUE_TO_OUTPUT - Value of the long word to pass to the $FAO.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    MAP
    LONG_VALUE : LONG UNSIGNED,
    MSG_ADDR : LONG UNSIGNED;

    LOCAL
    STATUS : UNSIGNED;            ! Status return by LIB$xxx

    INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
    $FAO (.MSG_ADDR, OUTPUT_SIZE, OUTPUT_DESC, .LONG_VALUE);
    OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
    STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
    END;
%SBTTL 'Command Execution -- COMND_REMOTE'
ROUTINE COMND_REMOTE : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will handle the REMOTE commands.  It will call KERMSG
!to perform the command.
!
! CALLING SEQUENCE:
!
!    COMND_REMOTE ();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    REM_TYPE - type of command to be executed
!    GEN_xDATA/GEN_xSIZE - arguments for the commands
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    IF GET_REM_ARGS (FALSE)
    THEN

    IF TERM_OPEN (TRUE)            ! Open the terminal to determine if local
    THEN
        BEGIN

        IF NOT .CONNECT_FLAG
            THEN DO_GENERIC (.REM_TYPE)
            ELSE LIB$SIGNAL (KER_LOCONLY);

        TERM_CLOSE ();
        END;

    END;                    ! End of COMND_REMOTE
%SBTTL 'Command Execution -- COMND_LOCAL'
ROUTINE COMND_LOCAL : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will handle the LOCAL commands.  It will call the generic
!command processor to perform the command, and type the result.
!
! CALLING SEQUENCE:
!
!    COMND_LOCAL ();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    REM_TYPE - type of command to be executed
!    GEN_xDATA/GEN_xSIZE - arguments for the commands
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    SAVED_TY_FIL,                ! Saved value from TY_FIL
    STATUS,                    ! Status values
    FILE_FLAG,                ! Flag whether file is open
    CHARACTER,                ! Character from get-a-char routine
    STR_LENGTH,                ! Length of string
    STR_ADDRESS,                ! Address of string
    GET_CHR_RTN;                ! Address of routine to get a character

    EXTERNAL ROUTINE
    SY_GENERIC,                ! Do a generic command
    GET_FILE,                ! Get a character from a file
    FILE_OPEN,                ! Open a file
    FILE_CLOSE;                ! Close a file

!
! First get any extra arguments needed
!
    STATUS = GET_REM_ARGS (TRUE);

    IF NOT .STATUS THEN RETURN;

!
! Initialize arguments for SY_GENERIC
!
    GET_CHR_RTN = 0;                ! No routine
    STR_LENGTH = 0;                ! No length
    STR_ADDRESS = 0;                ! No address
!
! Have generic routine do the command
!
    STATUS = SY_GENERIC (.REM_TYPE, STR_ADDRESS, STR_LENGTH, GET_CHR_RTN);

    IF NOT .STATUS
    THEN
    LIB$SIGNAL (.STATUS)
    ELSE
    BEGIN
!
! If we got a string, type it out
!

    IF .STR_LENGTH NEQ 0
    THEN
        BEGIN

        LOCAL
        POINTER;

        POINTER = CH$PTR (.STR_ADDRESS);

        DECR I FROM .STR_LENGTH TO 1 DO
        TT_CHAR (CH$RCHAR_A (POINTER));

        TT_CRLF ();                ! Make sure it gets dumped
        END
    ELSE
!
! Here if we didn't get a string.  Either we need to call the supplied routine
! or open a file and call GET_FILE for each character.
!
        BEGIN

        IF .GET_CHR_RTN NEQ 0
        THEN
        FILE_FLAG = FALSE        ! No file open
        ELSE
        BEGIN
        FILE_FLAG = TRUE;        ! Have a file
        GET_CHR_RTN = GET_FILE;        ! This is our get-a-char routine
        SAVED_TY_FIL = .TY_FIL;        ! Save current type out flag
        TY_FIL = FALSE;            ! Make sure we don't have name typed
        STATUS = FILE_OPEN (FNC_READ);    ! Open the file
        TY_FIL = .SAVED_TY_FIL;        ! Restore type out value

        IF NOT .STATUS            ! If we couldn't open the file
        THEN
            RETURN;            ! Just return, (FILE_OPEN reported it)

        END;

        DO
        BEGIN
        STATUS = (.GET_CHR_RTN) (CHARACTER);    ! Get a character

        IF .STATUS AND NOT .STATUS EQL KER_EOF    ! Did we get one?
        THEN
            TT_CHAR (.CHARACTER)    ! Yes, type it
        ELSE
!
! If no character returned, check for EOF and close file if we opened it
!

            IF .STATUS EQL KER_EOF AND .FILE_FLAG THEN FILE_CLOSE ();

        END
        UNTIL NOT .STATUS OR .STATUS EQL KER_EOF;    ! Loop until we are done

        TT_OUTPUT ();            ! Force out last buffer
        END;

    END;

    END;                    ! End of COMND_LOCAL
%SBTTL 'Command execution -- COMND_SHOW'
ROUTINE COMND_SHOW : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will process the SHOW command.  This routine
!    expects that the command has already been processed and that
!    the type of SHOW command is stored in SHOW_TYPE.
!
! CALLING SEQUENCE:
!
!    COMND_SHOW();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS : WORD;                ! Status returned

! Bind some addresses to text

    BIND
    OFF_TEXT = %ASCID'OFF',            ! Item is off
    ON_TEXT = %ASCID'ON',            ! Item is on
    SHOW_ABT_MSG = %ASCID' Incomplete file disposition    !AS',
    ABT_DISCARD = %ASCID'Discard',
    ABT_KEEP = %ASCID'Keep',
    SHOW_CHK_MSG = %ASCID' Block check type        !AS',
    CHK_1CHAR_MSG = %ASCID'One character checksum',
    CHK_2CHAR_MSG = %ASCID'Two character checksum',
    CHK_CRC_MSG = %ASCID'Three character CRC-CCITT',
    SHOW_DEB_MSG = %ASCID' Debugging            !AS',
    SHOW_DEL_MSG = %ASCID' Delay                !ZL (sec)',
    SHOW_SRV_MSG = %ASCID' Server sends NAKs every !ZL seconds while waiting for a command',
    SHOW_ESC_MSG = %ASCID' Escape character        !3OL (octal)',
    SHOW_FTP_MSG = %ASCID' File type            !AS',
    SHOW_BLK_MSG = %ASCID' BINARY and FIXED record size   !UL (bytes)',
    FTP_ASCII =    %ASCID'ASCII',
    FTP_BINARY = %ASCID'BINARY',
    FTP_BLOCK = %ASCID'BLOCK',
    FTP_FIXED = %ASCID'FIXED',
    SHOW_FNM_MSG = %ASCID' File naming            !AS',
    FNM_MSG_FULL = %ASCID'Full file specifcation',
    FNM_MSG_NORMAL = %ASCID'Normal form',
    FNM_MSG_UNTRAN = %ASCID'Untranslated',
!    SHOW_IBM_MSG = %ASCID' IBM mode            !AS',
    SHOW_HAN_MSG = %ASCID' Handshaking character        !3OL (octal)',
    SHOW_HAN_MSG_NONE = %ASCID' Handshaking character        None',
    SHOW_LIN_MSG = %ASCID' Line used            !AS',
    SHOW_ECH_MSG = %ASCID' Local echo            !AS',
    SHOW_PAR_MSG = %ASCID' Parity type            !AS',
    PAR_EVEN = %ASCID'Even',
    PAR_ODD = %ASCID'Odd',
    PAR_MARK = %ASCID'Mark',
    PAR_SPACE = %ASCID'Space',
    PAR_NONE = %ASCID'None',
    SHOW_RTY_HDR = %ASCID' Retry maximums',
    SHOW_RTY_INI_MSG = %ASCID'  Initial connection        !ZL (dec)',
    SHOW_RTY_PKT_MSG = %ASCID'  Sending a packet        !ZL (dec)',
    SHOW_REC_HDR = %ASCID' Receive parameters',
    SHOW_SND_HDR = %ASCID' Send parameters',
    SHOW_PKT_MSG = %ASCID'  Packet length            !ZL (dec)',
    SHOW_PAD_MSG = %ASCID'  Padding length        !ZL (dec)',
    SHOW_PDC_MSG = %ASCID'  Padding character        !3OL (octal)',
    SHOW_TIM_MSG = %ASCID'  Time out            !ZL (sec)',
    SHOW_EOL_MSG = %ASCID'  End of line character        !3OL (octal)',
    SHOW_QUO_MSG = %ASCID'  Quoting character        !3OL (octal)',
    SHOW_SOH_MSG = %ASCID'  Start of packet        !3OL (octal)',
    SHOW_8QU_MSG = %ASCID'  8-bit quoting character    !3OL (octal)',
    SHOW_TRN_HDR = %ASCID' Transmit parameters',                            !
    SHOW_TRD_MSG = %ASCID'  Delay                         0.!AD (sec)',     !
    SHOW_TRE_MSG = %ASCID'  Echo                    !AS',           !
    SHOW_RPT_MSG = %ASCID' Repeat quoting character    !3OL (octal)';

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine is used to output the keywords TRUE or FALSE.
!    All text that this routine uses is defined in the level 0 BEGIN/END
!    of the program.
!
! CALLING SEQUENCE:
!
!    OUTPUT_TRUE_FALSE( MSG_ASCID, FLAG_WORD);
!
! INPUT PARAMETERS:
!
!    MSG_ASCID - %ASCID of the text to use for the $FAO call.
!
!    FLAG_WORD - Long word containing the value of either TRUE or FALSE.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    ROUTINE OUTPUT_TRUE_FALSE (MSG_ADDR, FLAG_ADDR) : NOVALUE =
    BEGIN

    MAP
        FLAG_ADDR : LONG UNSIGNED,
        MSG_ADDR : LONG UNSIGNED;

    LOCAL
        STATUS : UNSIGNED;            ! Status return by LIB$xxx

    INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
    $FAO (.MSG_ADDR, OUTPUT_SIZE, OUTPUT_DESC,
        (SELECTONE ..FLAG_ADDR OF
        SET
        [TRUE] : ON_TEXT;
        [FALSE] : OFF_TEXT;
        TES));
    OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
    STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
    END;

    SELECT .SHOW_TYPE OF
    SET
!
! Show version
!

    [SHOW_ALL, SHOW_VER] :
        STATUS = LIB$PUT_OUTPUT (IDENT_STRING);    ! Type our name and version

    [SHOW_ALL, SHOW_CHK, SHOW_PAC] :
        BEGIN
        INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
        $FAO (SHOW_CHK_MSG, OUTPUT_SIZE, OUTPUT_DESC,
        (SELECTONE .CHKTYPE OF
            SET
            [CHK_1CHAR] : CHK_1CHAR_MSG;
            [CHK_2CHAR] : CHK_2CHAR_MSG;
            [CHK_CRC] : CHK_CRC_MSG;
            TES));
        OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
        STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
        END;

    [SHOW_ALL, SHOW_DEB] :
        OUTPUT_TRUE_FALSE (SHOW_DEB_MSG, DEBUG_FLAG);

    [SHOW_ALL, SHOW_DEL, SHOW_COM, SHOW_TIM] :
        OUTPUT_LONG_WORD (SHOW_DEL_MSG, .DELAY);

    [SHOW_ALL, SHOW_TIM] :
        OUTPUT_LONG_WORD (SHOW_SRV_MSG, .SRV_TIMEOUT);

    [SHOW_ALL, SHOW_ESC, SHOW_COM] :
        OUTPUT_LONG_WORD (SHOW_ESC_MSG, .ESCAPE_CHR);

    [SHOW_ALL, SHOW_FIL] :             !
        BEGIN
        INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
        $FAO (SHOW_FTP_MSG,
                  OUTPUT_SIZE,
                  OUTPUT_DESC,
                 (SELECTONE .FILE_TYPE OF
                    SET
                    [FILE_ASC] : FTP_ASCII;
                    [FILE_BIN] : FTP_BINARY;
                    [FILE_FIX] : FTP_FIXED;
                    [FILE_BLK] : FTP_BLOCK;
                    TES));
        OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
        STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
!
! Display the file name format
!
        INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
        $FAO (SHOW_FNM_MSG, OUTPUT_SIZE, OUTPUT_DESC,
        (SELECTONE .FIL_NORMAL_FORM OF
            SET
            [FNM_FULL] : FNM_MSG_FULL;
            [FNM_NORMAL] : FNM_MSG_NORMAL;
            [FNM_UNTRAN] : FNM_MSG_UNTRAN;
            TES));
        OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
        STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);

! Display file block size
            INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
            $FAO(SHOW_BLK_MSG, OUTPUT_SIZE, OUTPUT_DESC, .file_blocksize);
        OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
        STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);

        END;

    [SHOW_ALL, SHOW_COM] :
        IF .IBM_CHAR GEQ 0
        THEN
        OUTPUT_LONG_WORD (SHOW_HAN_MSG, .IBM_CHAR)
        ELSE
        STATUS = LIB$PUT_OUTPUT (SHOW_HAN_MSG_NONE);

    [SHOW_ALL, SHOW_ABT, SHOW_FIL] :
        BEGIN
        INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
        $FAO (SHOW_ABT_MSG, OUTPUT_SIZE, OUTPUT_DESC, (IF .ABT_FLAG THEN ABT_DISCARD ELSE ABT_KEEP));
        OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
        STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
        END;

    [SHOW_ALL, SHOW_LIN, SHOW_COM] :
        BEGIN
        INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);

        IF .TERM_DESC [DSC$W_LENGTH] GTR 0
        THEN
        $FAO (SHOW_LIN_MSG, OUTPUT_SIZE, OUTPUT_DESC, TERM_DESC)
        ELSE
        $FAO (SHOW_LIN_MSG, OUTPUT_SIZE, OUTPUT_DESC, %ASCID'none');

        OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
        STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
        END;

    [SHOW_ALL, SHOW_ECH, SHOW_COM] :
        OUTPUT_TRUE_FALSE (SHOW_ECH_MSG, ECHO_FLAG);

    [SHOW_ALL, SHOW_PAR, SHOW_COM] :
        BEGIN
        INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
        $FAO (SHOW_PAR_MSG, OUTPUT_SIZE, OUTPUT_DESC,
        (SELECTONE .PARITY_TYPE OF
            SET
            [PR_EVEN] : PAR_EVEN;
            [PR_ODD] : PAR_ODD;
            [PR_NONE] : PAR_NONE;
            [PR_MARK] : PAR_MARK;
            [PR_SPACE] : PAR_SPACE;
            TES));
        OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
        STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);
        END;

    [SHOW_ALL, SHOW_RTY, SHOW_PAC] :
        BEGIN
        STATUS = LIB$PUT_OUTPUT (SHOW_RTY_HDR);
        OUTPUT_LONG_WORD (SHOW_RTY_INI_MSG, .SI_RETRIES);
        OUTPUT_LONG_WORD (SHOW_RTY_PKT_MSG, .PKT_RETRIES);
        END;

    [SHOW_ALL, SHOW_SEN, SHOW_PAC] :
        BEGIN
        STATUS = LIB$PUT_OUTPUT (SHOW_SND_HDR);
        OUTPUT_LONG_WORD (SHOW_PKT_MSG, ABS (.SND_PKT_SIZE));
        OUTPUT_LONG_WORD (SHOW_PAD_MSG, ABS (.SND_NPAD));
        OUTPUT_LONG_WORD (SHOW_PDC_MSG, ABS (.SND_PADCHAR));
        OUTPUT_LONG_WORD (SHOW_TIM_MSG, ABS (.SND_TIMEOUT));
        OUTPUT_LONG_WORD (SHOW_EOL_MSG, ABS (.SND_EOL));
        OUTPUT_LONG_WORD (SHOW_QUO_MSG, ABS (.SND_QUOTE_CHR));
        OUTPUT_LONG_WORD (SHOW_SOH_MSG, ABS (.SND_SOH));
        END;

    [SHOW_ALL, SHOW_REC, SHOW_PAC] :
        BEGIN
        STATUS = LIB$PUT_OUTPUT (SHOW_REC_HDR);
        OUTPUT_LONG_WORD (SHOW_PKT_MSG, .RCV_PKT_SIZE);
        OUTPUT_LONG_WORD (SHOW_PAD_MSG, .RCV_NPAD);
        OUTPUT_LONG_WORD (SHOW_PDC_MSG, .RCV_PADCHAR);
        OUTPUT_LONG_WORD (SHOW_TIM_MSG, .RCV_TIMEOUT);
        OUTPUT_LONG_WORD (SHOW_EOL_MSG, .RCV_EOL);
        OUTPUT_LONG_WORD (SHOW_QUO_MSG, .RCV_QUOTE_CHR);
        OUTPUT_LONG_WORD (SHOW_8QU_MSG, .RCV_8QUOTE_CHR);
        OUTPUT_LONG_WORD (SHOW_SOH_MSG, .RCV_SOH);
        END;

    [SHOW_ALL, SHOW_TRN] :                                              !
        BEGIN                                                           !
        STATUS = LIB$PUT_OUTPUT (SHOW_TRN_HDR);                         !
            INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);       !
            $FAO (SHOW_TRD_MSG, OUTPUT_SIZE, OUTPUT_DESC, 1, TRANS_DELAY);  !
            OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;                      !
            STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);                          !
        OUTPUT_TRUE_FALSE (SHOW_TRE_MSG, TRANS_ECHO_FLAG);              !
        END;                                                            !

    [SHOW_ALL, SHOW_PAC] :
        BEGIN
        OUTPUT_LONG_WORD (SHOW_RPT_MSG, .SET_REPT_CHR);
        END;

    TES;

    END;                    ! End of COMND_SHOW
%SBTTL 'Command execution -- COMND_STATUS'
ROUTINE COMND_STATUS : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will display the status of Kermit-32.
!
! CALLING SEQUENCE:
!
!    COMND_STATUS ();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS,                    ! Status returned by system call
    POINTER,                ! Pointer to the LAST_ERROR text
    CHAR_COUNT;                ! Character count

    BIND
    TEXT_CR = %ASCID'',
    TEXT_BAUD = %ASCID' Effective data rate    !ZL baud',
    TEXT_NAKS_SENT = %ASCID' NAKs received        !ZL',
    TEXT_NAKS_RCV = %ASCID' NAKs sent        !ZL',
    TEXT_PKTS_SENT = %ASCID' Packets sent        !ZL',
    TEXT_PKTS_RCV = %ASCID' Packets received    !ZL',
    TEXT_CHR_SENT = %ASCID' Characters sent    !ZL',
    TEXT_DATA_CHAR_SENT = %ASCID' Data characters sent    !ZL',
    TEXT_DATA_CHAR_RCV = %ASCID' Data characters received !ZL',
    TEXT_CHR_RCV = %ASCID' Characters received    !ZL',
    TEXT_TOTAL_HDR = %ASCID'Totals since Kermit was started',
    TEXT_XFR_HDR = %ASCID'Totals for the last transfer';

    STATUS = LIB$PUT_OUTPUT (TEXT_CR);
    STATUS = LIB$PUT_OUTPUT (TEXT_XFR_HDR);
    OUTPUT_LONG_WORD (TEXT_CHR_SENT, .SMSG_TOTAL_CHARS);
    OUTPUT_LONG_WORD (TEXT_DATA_CHAR_SENT, .SMSG_DATA_CHARS);
    OUTPUT_LONG_WORD (TEXT_NAKS_SENT, .SMSG_NAKS);
    OUTPUT_LONG_WORD (TEXT_PKTS_SENT, .SMSG_COUNT);
    OUTPUT_LONG_WORD (TEXT_CHR_RCV, .RMSG_TOTAL_CHARS);
    OUTPUT_LONG_WORD (TEXT_DATA_CHAR_RCV, .RMSG_DATA_CHARS);
    OUTPUT_LONG_WORD (TEXT_NAKS_RCV, .RMSG_NAKS);
    OUTPUT_LONG_WORD (TEXT_PKTS_RCV, .RMSG_COUNT);

    IF .XFR_TIME NEQ 0
    THEN
        BEGIN
            LOCAL
                Data_Chars,
                Baud_Rate;

        IF .RMSG_DATA_CHARS LEQ .SMSG_DATA_CHARS
            THEN Data_Chars = .SMSG_DATA_CHARS
            ELSE Data_Chars = .RMSG_DATA_CHARS;

            Baud_Rate = .Data_Chars * 10 / ((.Xfr_Time + 500) / 1000);
        OUTPUT_LONG_WORD (TEXT_BAUD, .Baud_Rate);
            END;
!    OUTPUT_LONG_WORD (TEXT_BAUD, .Baud_Rate);
!        (((IF .RMSG_DATA_CHARS LEQ .SMSG_DATA_CHARS THEN .SMSG_DATA_CHARS ELSE .RMSG_DATA_CHARS)*10)/((
!        .XFR_TIME + 500)/1000)));

    STATUS = LIB$PUT_OUTPUT (TEXT_CR);
    STATUS = LIB$PUT_OUTPUT (TEXT_TOTAL_HDR);
    OUTPUT_LONG_WORD (TEXT_CHR_SENT, .SND_TOTAL_CHARS);
    OUTPUT_LONG_WORD (TEXT_DATA_CHAR_SENT, .SND_DATA_CHARS);
    OUTPUT_LONG_WORD (TEXT_NAKS_SENT, .SND_NAKS);
    OUTPUT_LONG_WORD (TEXT_PKTS_SENT, .SND_COUNT);
    OUTPUT_LONG_WORD (TEXT_CHR_RCV, .RCV_TOTAL_CHARS);
    OUTPUT_LONG_WORD (TEXT_DATA_CHAR_RCV, .RCV_DATA_CHARS);
    OUTPUT_LONG_WORD (TEXT_NAKS_RCV, .RCV_NAKS);
    OUTPUT_LONG_WORD (TEXT_PKTS_RCV, .RCV_COUNT);

    IF .TOTAL_TIME NEQ 0
    THEN
    OUTPUT_LONG_WORD (TEXT_BAUD,
        (((.RCV_DATA_CHARS + .SND_DATA_CHARS)*10)/((.TOTAL_TIME + 500)/1000)));

!
! Output the error text if there is any
!
    POINTER = CH$PTR (LAST_ERROR);
    CHAR_COUNT = 0;

    WHILE CH$RCHAR_A (POINTER) NEQ CHR_NUL DO
    CHAR_COUNT = .CHAR_COUNT + 1;

    IF .CHAR_COUNT NEQ 0
    THEN
    BEGIN
    INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH);
    STATUS = $FAO (%ASCID'Last error: !AD', OUTPUT_SIZE, OUTPUT_DESC, .CHAR_COUNT, LAST_ERROR);

    IF NOT .STATUS
    THEN
        LIB$SIGNAL (.STATUS)
    ELSE
        BEGIN
        OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE;
        STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC);

        IF NOT .STATUS THEN LIB$SIGNAL (.STATUS);

        END;

    END;

    END;                    ! End of SHOW_STATUS
%SBTTL 'GET_REM_ARGS - Get extra arguments for remote commands'
ROUTINE GET_REM_ARGS (LOCAL_FLAG) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will get any extra arguments required for remote commands.
!It will prompt the user and get the input from SYS$COMMAND:.
!
! CALLING SEQUENCE:
!
!    STATUS = GET_REM_ARGS (LOCAL_FLAG);
!
! INPUT PARAMETERS:
!
!    LOCAL_FLAG - If true, this is for a LOCAL xxx command.  Only get the
!            arguments we know we need for local commands. Otherwise
!            get all possible arguments.
!
! IMPLICIT INPUTS:
!
!    REM_TYPE - Type of remote command to get arguments for.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    GEN_xDATA, GEN_xSIZE - Text and sizes of arguments
!
! COMPLETION CODES:
!
!    Status values from subroutines called if in error.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    EXTERNAL ROUTINE
    GET_COMMAND;                ! Get line from SYS$COMMAND:

    LOCAL
    GEN_2DESC : BLOCK [8, BYTE],        ! Descriptor for second argument
    GEN_3DESC : BLOCK [8, BYTE],        ! Descriptor for third argument
    STATUS;                    ! Random status values

!
! Set up descriptors for second and third arguments
!
    INIT_STR_DESC (GEN_2DESC, GEN_2DATA, MAX_MSG);
    INIT_STR_DESC (GEN_3DESC, GEN_3DATA, MAX_MSG);

    SELECTONE .REM_TYPE OF
    SET

    [GC_CONNECT] :

        IF NOT .LOCAL_FLAG AND .GEN_1SIZE GTR 0
        THEN
        RETURN GET_COMMAND (GEN_2DESC, %ASCID'Password: ',
            GEN_2SIZE, FALSE);

    [GC_COPY, GC_RENAME] :

        WHILE TRUE DO
        BEGIN
        STATUS = GET_COMMAND (GEN_2DESC, %ASCID'New file: ', GEN_2SIZE, TRUE);

        IF NOT .STATUS OR .GEN_2SIZE NEQ 0 THEN RETURN .STATUS;

        END;

    [GC_LGN] :
        BEGIN
        STATUS = GET_COMMAND (GEN_3DESC, %ASCID'Account: ', GEN_3SIZE, TRUE);

        IF NOT .STATUS THEN RETURN .STATUS;

        RETURN GET_COMMAND (GEN_2DESC, %ASCID'Password: ', GEN_2SIZE, FALSE);
        END;

    [GC_SEND_MSG] :
        RETURN GET_COMMAND (GEN_2DESC, %ASCID'Message: ', GEN_2SIZE, TRUE);

    [GC_WHO] :

        IF NOT .LOCAL_FLAG THEN RETURN GET_COMMAND (GEN_2DESC, %ASCID'Options: ', GEN_2SIZE, TRUE);

    TES;

!
! If we fall out of the SELECT, we don't need any arguments
!
    RETURN TRUE;
    END;                    ! End of GET_REM_ARGS
%SBTTL 'TPARSE support -- STORE_BLOCKSIZE'
ROUTINE STORE_BLOCKSIZE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the blocksize to be used when creating
!    BINARY and FIXED files.
!
! CALLING SEQUENCE:
!
!    Standard LIB$TPARSE routine call.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;
!    file_blocksize = .AP [TPA$L_PARAM];
    file_blocksize_set = 1;
    RETURN SS$_NORMAL;
    END;                    ! End of STORE_BLOCKSIZE
%SBTTL 'TPARSE support -- STORE_DEBUG'
ROUTINE STORE_DEBUG =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the debug flag into the DEBUG_FLAG
!    location.
!
! CALLING SEQUENCE:
!
!    Standard LIB$TPARSE routine call.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;
    DEBUG_FLAG = .AP [TPA$L_PARAM];
    RETURN SS$_NORMAL;
    END;                    ! End of STORE_DEBUG
%SBTTL 'TPARSE support -- STORE_TR_DELAY'
ROUTINE STORE_TR_DELAY =                         !  and below

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the transmit delay into the
!    TRANS_DELAY location.
!
! CALLING SEQUENCE:
!
!    Standard LIB$TPARSE routine call.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN                                       !
    TPARSE_ARGS;                                !
    TRANS_DELAY = .AP [TPA$L_PARAM];            !
    RETURN SS$_NORMAL;                          !
    END;                    ! End of STORE_TR_DELAY
%SBTTL 'TPARSE support -- STORE_TR_ECHO'
ROUTINE STORE_TR_ECHO =                         !  and below

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the transmit echo flag into the
!    TRANS_ECHO_FLAG location.
!
! CALLING SEQUENCE:
!
!    Standard LIB$TPARSE routine call.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN                                       !
    TPARSE_ARGS;                                !
    TRANS_ECHO_FLAG = .AP [TPA$L_PARAM];        !
    RETURN SS$_NORMAL;                          !
    END;                    ! End of STORE_TR_ECHO

%SBTTL 'TPARSE support -- STORE_IBM'
ROUTINE STORE_IBM =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the IBM flag into the IBM_FLAG
!    location.
!
! CALLING SEQUENCE:
!
!    Standard LIB$TPARSE routine call.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    EXTERNAL LITERAL
    IBM_MODE_ECHO : WEAK,            ! IBM mode echo value
    IBM_MODE_PARITY : WEAK,            ! Default parity
    IBM_MODE_CHARACTER : WEAK;        ! And handshake character for

                            ! IBM mode
    TPARSE_ARGS;

    IF .AP [TPA$L_PARAM]
    THEN
    BEGIN
    IBM_CHAR = (IF IBM_MODE_CHARACTER NEQ 0 THEN IBM_MODE_CHARACTER ELSE CHR_DC1);
    PARITY_TYPE = (IF IBM_MODE_PARITY NEQ 0 THEN IBM_MODE_PARITY ELSE PR_MARK);
    ECHO_FLAG = (IF IBM_MODE_ECHO NEQ 0 THEN IBM_MODE_ECHO ELSE TRUE);
    END
    ELSE
    BEGIN
    IBM_CHAR = -1;                ! Turn IBM mode off
    ECHO_FLAG = FALSE;            ! No local echo
    PARITY_TYPE = PR_NONE;            ! and no parity
    END;

    RETURN SS$_NORMAL;
    END;                    ! End of STORE_IBM
%SBTTL 'TPARSE support -- STORE_ABT'
ROUTINE STORE_ABT =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the aborted file disposition into ABT_FLAG
!
! CALLING SEQUENCE:
!
!    Standard LIB$TPARSE routine call.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;
    ABT_FLAG = .AP [TPA$L_PARAM];
    RETURN SS$_NORMAL;
    END;                    ! End of STORE_ABT
%SBTTL 'TPARSE support -- STORE_CHK'
ROUTINE STORE_CHK =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the block check type into XXXX
!    location.
!
! CALLING SEQUENCE:
!
!    Standard LIB$TPARSE routine call.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;
    CHKTYPE = .AP [TPA$L_PARAM];
    RETURN SS$_NORMAL;
    END;                    ! End of STORE_CHK
%SBTTL 'TPARSE support -- STORE_FTP - Store file type'
ROUTINE STORE_FTP =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the file type that was specified by the
!    user for the KERFIL processing.
!
! CALLING SEQUENCE:
!
!    Standard call from LIB$TPARSE.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;
    FILE_TYPE = .AP [TPA$L_PARAM];

    IF (.FILE_TYPE EQL FILE_FIX) OR
       (.FILE_TYPE EQL FILE_BIN)
    THEN
        BEGIN
        TT_TEXT(UPLIT('Current block size for file transfer is ', 0));
        TT_NUMBER(.file_blocksize);
        TT_CRLF();
        END;

    RETURN SS$_NORMAL;
    END;                    ! End of STORE_FTP
%SBTTL 'TPARSE support -- STORE_FNM - Store file type'
ROUTINE STORE_FNM =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the file type that was specified by the
!    user for the KERFIL processing.
!
! CALLING SEQUENCE:
!
!    Standard call from LIB$TPARSE.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;
    FIL_NORMAL_FORM = .AP [TPA$L_PARAM];
    RETURN SS$_NORMAL;
    END;                    ! End of STORE_FNM
%SBTTL 'TPARSE support -- STORE_PARITY - Store file type'
ROUTINE STORE_PARITY =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the type of parity to use for the transfer.
!    If a parity type of other than NONE is specified then we will use
!    eight-bit quoting to support the transfer.
!
! CALLING SEQUENCE:
!
!    Standard call from LIB$TPARSE.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;
    PARITY_TYPE = .AP [TPA$L_PARAM];
    RETURN SS$_NORMAL;
    END;                    ! End of STORE_PARITY
%SBTTL 'TPARSE support -- STORE_ECHO - Store local echo flag'
ROUTINE STORE_ECHO =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the state of the local echo flag as the
!    user set it.
!
! CALLING SEQUENCE:
!
!    Standard TPARSE argument call.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;
    ECHO_FLAG = .AP [TPA$L_PARAM];
    RETURN SS$_NORMAL;
    END;                    ! End of STORE_ECHO
%SBTTL 'TPARSE support -- STORE_MSG_FIL - Store file name typeout flag'
ROUTINE STORE_MSG_FIL =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the state of the file name typeout flag as the
!    user set it.
!
! CALLING SEQUENCE:
!
!    Standard TPARSE argument call.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;
    TY_FIL = .AP [TPA$L_PARAM];
    RETURN SS$_NORMAL;
    END;                    ! End of STORE_MSG_FIL
%SBTTL 'TPARSE support -- STORE_MSG_PKT - Store packet number typeout flag'
ROUTINE STORE_MSG_PKT =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store the state of the packet number flag as the
!    user set it.
!
! CALLING SEQUENCE:
!
!    Standard TPARSE argument call.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;
    TY_PKT = .AP [TPA$L_PARAM];
    RETURN SS$_NORMAL;
    END;                    ! End of STORE_MSG_PKT
%SBTTL 'TPARSE support -- CHECK_EOL'
ROUTINE CHECK_EOL =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will valid the SEND and RECEIVE eol character that
!    is being set by the user.
!
! CALLING SEQUENCE:
!
!    Standard TPARSE routine calling sequence.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;

    IF (.AP [TPA$L_NUMBER] LSS %C' ') AND (.AP [TPA$L_NUMBER] GTR 0)
    THEN
    RETURN SS$_NORMAL
    ELSE
    RETURN KER_ILLEOL;

    END;                    ! End of CHECK_EOL
%SBTTL 'TPARSE support -- CHECK_QUOTE'
ROUTINE CHECK_QUOTE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will validate the SEND and RECEIVE quoting character that
!    is being set by the user.
!
! CALLING SEQUENCE:
!
!    Standard TPARSE routine calling sequence.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    Error code or true value
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;

    IF (.AP [TPA$L_NUMBER] GEQ %C' ' AND .AP [TPA$L_NUMBER] LSS %C'?') OR (.AP [TPA$L_NUMBER] GEQ %C'`' AND
    .AP [TPA$L_NUMBER] LSS CHR_DEL)
    THEN
    RETURN SS$_NORMAL
    ELSE
    RETURN KER_ILLQUO;

    END;                    ! End of CHECK_QUO
%SBTTL 'TPARSE support -- CHECK_SOH'
ROUTINE CHECK_SOH =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will valid the SEND and RECEIVE START_OF_PACKET
!    character that is being set by the user.
!
! CALLING SEQUENCE:
!
!    Standard TPARSE routine calling sequence.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;

    IF (.AP [TPA$L_NUMBER] LSS %C' ') AND (.AP [TPA$L_NUMBER] GTR 0)
    THEN
    RETURN SS$_NORMAL
    ELSE
    RETURN KER_ILLSOH;

    END;                    ! End of CHECK_SOH
%SBTTL 'TPARSE support -- CHECK_PAD_CHAR'
ROUTINE CHECK_PAD_CHAR =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will valid the SEND and RECEIVE eol character that
!    is being set by the user.
!
! CALLING SEQUENCE:
!
!    Standard TPARSE routine calling sequence.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;

    IF .AP [TPA$L_NUMBER] LSS %C' ' OR .AP [TPA$L_NUMBER] EQL CHR_DEL
    THEN
    RETURN SS$_NORMAL
    ELSE
    RETURN KER_ILLPADCHR;

    END;                    ! End of CHECK_PAD_CHAR
%SBTTL 'TPARSE support -- CHECK_NPAD'
ROUTINE CHECK_NPAD =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will determine if the padding character specified by the
!    user is valid.
!
! CALLING SEQUENCE:
!
!    Standard TPARSE calling sequence.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;

    IF .AP [TPA$L_NUMBER] LSS 0 THEN RETURN KER_ILLNPAD ELSE RETURN SS$_NORMAL;

    END;                    ! End of CHECK_NPAD
%SBTTL 'TPARSE support -- CHECK_PACKET_LEN'
ROUTINE CHECK_PACKET_LEN =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will determine if the packet length specified by the
!    user is valid.
!
! CALLING SEQUENCE:
!
!    Standard TPARSE calling sequence.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;

    IF .AP [TPA$L_NUMBER] LSS 10 OR .AP [TPA$L_NUMBER] GTR (MAX_MSG - 2)
    THEN
    RETURN KER_ILLPKTLEN
    ELSE
    RETURN SS$_NORMAL;

    END;                    ! End of CHECK_PACKET_LEN
%SBTTL 'STORE_TEXT'
ROUTINE STORE_TEXT =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store a single character of the file specification
!    that the user gives to the SEND and RECEIVE commands.
!
! FORMAL PARAMETERS:
!
!    Character that was parsed.
!
! IMPLICIT INPUTS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    Character stored into the file specification vector.
!
! ROUTINE VALUE and
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;

    IF (TEMP_DESC [DSC$W_LENGTH] = .TEMP_DESC [DSC$W_LENGTH] + 1) LSS TEMP_LENGTH
    THEN
    BEGIN
    CH$WCHAR (.AP [TPA$B_CHAR], CH$PTR (TEMP_NAME, .TEMP_DESC [DSC$W_LENGTH] - 1));
    AP [TPA$V_BLANKS] = 1;            ! Blanks are significant
    RETURN SS$_NORMAL;
    END
    ELSE
    RETURN KER_LINTOOLNG;

    END;                    ! End of STORE_TEXT
%SBTTL 'TPARSE support -- COPY_DESC - Copy string to a descriptor'
ROUTINE COPY_DESC =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will copy a string to the descriptor passed in the TPARSE
! argument.
!
! CALLING SEQUENCE:
!
!    COPY_FILE();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    TEMP_DESC and TEMP_NAME set up with the device name and length
!    in the descriptor.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    Descriptor fields set up.
!    TEMP_DESC.
!
! COMPLETION CODES:
!
!    0 - Failure.
!    1 - Success.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;

    LOCAL
    DESC_ADDR;

    DESC_ADDR = .AP [TPA$L_PARAM];
    BEGIN

    MAP
    DESC_ADDR : REF BLOCK [8, BYTE];

    DESC_ADDR [DSC$W_LENGTH] = .TEMP_DESC [DSC$W_LENGTH];
    CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1,
    CH$PTR (.DESC_ADDR [DSC$A_POINTER]));
    END;
    RETURN SS$_NORMAL;
    END;                    ! End of COPY_FILE
%SBTTL 'TPARSE support -- COPY_ALT_FILE - Copy file specification'
ROUTINE COPY_ALT_FILE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will copy the file name from the temporary
!    descriptor to the descriptor that is used for the file name.
!    (ALT_FILE_NAME).
!    This is for use by the RECEIVE command so that the user may
!    specify an alternate file name for the received file.
!
! CALLING SEQUENCE:
!
!    COPY_ALT_FILE();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    TEMP_DESC and TEMP_NAME set up with the device name and length
!    in the descriptor.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    ALT_FILE_NAME set up with what was in TEMP_NAME and
!    TEMP_DESC.
!
! COMPLETION CODES:
!
!    0 - Failure.
!    1 - Success.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    ALT_FILE_SIZE = .TEMP_DESC [DSC$W_LENGTH];
    CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1,
    CH$PTR (ALT_FILE_NAME));
    RETURN SS$_NORMAL;
    END;                    ! End of COPY_ALT_FILE
%SBTTL 'TPARSE support -- COPY_GEN_1DATA - Copy generic command argument'
ROUTINE COPY_GEN_1DATA =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will copy the generic command argument from the
!    temporary descriptor to the global storage for the argument
!    (GEN_1DATA).
!
! CALLING SEQUENCE:
!
!    COPY_GEN_1DATA();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    TEMP_DESC and TEMP_NAME set up with the device name and length
!    in the descriptor.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    GEN_1DATA and GEN_1SIZE set up with what was in TEMP_NAME and
!    TEMP_DESC.
!
! COMPLETION CODES:
!
!    0 - Failure.
!    1 - Success.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    GEN_1SIZE = .TEMP_DESC [DSC$W_LENGTH];
    CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1,
    CH$PTR (GEN_1DATA));
    RETURN SS$_NORMAL;
    END;                    ! End of COPY_GEN_1DATA
%SBTTL 'TPARSE support -- COPY_GEN_2DATA - Copy generic command argument'
ROUTINE COPY_GEN_2DATA =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will copy the generic command argument from the
!    temporary descriptor to the global storage for the argument
!    (GEN_2DATA).
!
! CALLING SEQUENCE:
!
!    COPY_GEN_2DATA();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    TEMP_DESC and TEMP_NAME set up with the device name and length
!    in the descriptor.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    GEN_2DATA and GEN_2SIZE set up with what was in TEMP_NAME and
!    TEMP_DESC.
!
! COMPLETION CODES:
!
!    0 - Failure.
!    1 - Success.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    GEN_2SIZE = .TEMP_DESC [DSC$W_LENGTH];
    CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1,
    CH$PTR (GEN_2DATA));
    RETURN SS$_NORMAL;
    END;                    ! End of COPY_GEN_2DATA
%SBTTL 'TPARSE support -- COPY_GEN_3DATA - Copy generic command argument'
ROUTINE COPY_GEN_3DATA =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will copy the generic command argument from the
!    temporary descriptor to the global storage for the argument
!    (GEN_3DATA).
!
! CALLING SEQUENCE:
!
!    COPY_GEN_3DATA();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    TEMP_DESC and TEMP_NAME set up with the device name and length
!    in the descriptor.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    GEN_3DATA and GEN_3SIZE set up with what was in TEMP_NAME and
!    TEMP_DESC.
!
! COMPLETION CODES:
!
!    0 - Failure.
!    1 - Success.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    GEN_3SIZE = .TEMP_DESC [DSC$W_LENGTH];
    CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1,
    CH$PTR (GEN_3DATA));
    RETURN SS$_NORMAL;
    END;                    ! End of COPY_GEN_3DATA
%SBTTL 'COPY_TERM_NAME'
ROUTINE COPY_TERM_NAME =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will copy the device name from the temporary
!    descriptor to the descriptor that is used for the terminal name.
!    (TERM_NAME and TERM_DESC).
!    It will call KERTRM to validate the name as a usuable terminal.
!
! CALLING SEQUENCE:
!
!    COPY_TERM_NAME();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    TEMP_DESC and TEMP_NAME set up with the device name and length
!    in the descriptor.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    TERM_NAME and TERM_DESC set up with what was in TEMP_NAME and
!    TEMP_DESC.
!
! COMPLETION CODES:
!
!    0 - Failure.
!    1 - Success.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    EXTERNAL
    JOB_TERM_DESC : BLOCK [8, BYTE];    ! Descriptor for jobs contolling terminal

    IF NOT CH$FAIL (CH$FIND_NOT_CH (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (.TEMP_DESC [DSC$A_POINTER]), %C' '))
    THEN
    RETURN SET_TRANS_TERM (TEMP_DESC)
    ELSE

    IF NOT SET_TRANS_TERM (%ASCID'KER$COMM')
    THEN

        IF NOT SET_TRANS_TERM (%ASCID'SYS$INPUT')
        THEN

        IF NOT SET_TRANS_TERM (%ASCID'SYS$OUTPUT')
        THEN

            IF NOT SET_TRANS_TERM (%ASCID'SYS$COMMAND') THEN RETURN SET_TRANS_TERM (JOB_TERM_DESC);

    RETURN SS$_NORMAL;
    END;                    ! End of COPY_TERM_NAME
%SBTTL 'KEY_ERROR - Handle keyword errors'
ROUTINE KEY_ERROR =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called from the command parser (LIB$TPARSE) when a keyword
! does not match.  It will just return the correct error code.
!
! CALLING SEQUENCE:
!
!    STATUS = KEY_ERROR ();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TPARSE_ARGS;

    IF .AP [TPA$V_AMBIG] THEN RETURN KER_AMBIGKEY ELSE RETURN KER_UNKNOWKEY;

    END;                    ! End of KEY_ERROR
%SBTTL 'XFR_STATUS - Return the transfer status'

GLOBAL ROUTINE XFR_STATUS (TYPE, SUB_TYPE) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine is called after either a packet has been received
!    correctly at the receive level, a packet has been sent, or
!    either a NAK has been sent or received.
!
! CALLING SEQUENCE:
!
!    XFR_STATUS (Type);
!
! INPUT PARAMETERS:
!
!    Type - ASCII Characters describing the type of transfer
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    EXTERNAL ROUTINE
    LOG_FAOL;

!
! If we have a journal file (transaction log), then say what we are doing.
!

    IF .TRANSACTION_OPEN AND .TYPE EQL %C'F'
    THEN
    BEGIN
    FILE_DESC [DSC$W_LENGTH] = .FILE_SIZE;    ! Make sure size is right

    SELECTONE .SUB_TYPE OF
        SET

        [%C'S'] :
        LOG_FAOL (%ASCID'!%T!_Sending file !AS!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB);

        [%C'R'] :
        LOG_FAOL (%ASCID'!%T!_Receiving file !AS!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB);

        [%C'C'] :
        LOG_FAOL (%ASCID'!%T!_Closing file !AS!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB);

        [%C'X'] :
        LOG_FAOL (%ASCID'!%T!_Aborting file !AS by user request!/', UPLIT (0, FILE_DESC),
            TRANSACTION_RAB);

        [%C'Z'] :
        LOG_FAOL (%ASCID'!%T!_Aborting file group !AS by user request!/', UPLIT (0, FILE_DESC),
            TRANSACTION_RAB);

        [%C'D'] :
        LOG_FAOL (%ASCID'!%T!_Aborting file !AS, partial file saved!/', UPLIT (0, FILE_DESC),
            TRANSACTION_RAB);

        [%C'A'] :
        LOG_FAOL (%ASCID'!%T!_Aborting file !AS due to protocol error!/', UPLIT (0, FILE_DESC),
            TRANSACTION_RAB);
        TES;

    END;

    IF .TY_PKT
    THEN
    BEGIN

    SELECTONE .TYPE OF
        SET

        [%ASCII'R'] :
        BEGIN

        IF .SUB_TYPE EQL %C'P'
        THEN
            BEGIN
            TT_TEXT (UPLIT (%ASCIZ' R'));
            TT_NUMBER (.RMSG_COUNT);
            END;

        IF .SUB_TYPE EQL %C'N'
        THEN
            BEGIN
            TT_TEXT (UPLIT (%ASCIZ' R%'));
            TT_NUMBER (.RMSG_NAKS);
            END;

        END;

        [%ASCII'S'] :
        BEGIN

        IF .SUB_TYPE EQL %C'P'
        THEN
            BEGIN
            TT_TEXT (UPLIT (%ASCIZ' S'));
            TT_NUMBER (.SMSG_COUNT);
            END;

        IF .SUB_TYPE EQL %C'N'
        THEN
            BEGIN
            TT_TEXT (UPLIT (%ASCIZ' S%'));
            TT_NUMBER (.SMSG_NAKS);
            END;

        END;
        TES;

    TT_OUTPUT ();
    END;

    END;                    ! End of XFR_STATUS

%SBTTL 'CRCCLC - Calculate the CRC-CCITT for a message'

GLOBAL ROUTINE CRCCLC (POINTER, SIZE) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will calculate the CRC for a message.  It will use
!    the VAX LIB$ routine to do all the work.
!
! CALLING SEQUENCE:
!
!    CRC = CRCCLC(Pointer, Size)
!
! INPUT PARAMETERS:
!
!    Pointer - Character pointer to the message.
!    Size - Length of the message.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    CRC for the message.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    TEMP_DESC : BLOCK [8, BYTE],        ! Temporary descriptor
    CRC_INITIAL;                ! Initial CRC value

    CRC_INITIAL = 0;                ! Set the initial value
    INIT_STR_DESC (TEMP_DESC, .POINTER, .SIZE);
    RETURN LIB$CRC (CRC_TABLE, CRC_INITIAL, TEMP_DESC);
    END;                    ! End of CRCCLC

%SBTTL 'KRM_ERROR - Issue an error message given error code'

GLOBAL ROUTINE KRM_ERROR (ERROR_CODE) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will cause an error message to be issued to the
!    user's terminal and/or a message to be sent to the remote KERMIT.
!
! CALLING SEQUENCE:
!
!    KRM_ERROR(KER_xxxxxx);
!
! INPUT PARAMETERS:
!
!    KER_xxxxxx - Error code from KERERR.REQ
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    LIB$SIGNAL (.ERROR_CODE);
    END;                    ! End of KRM_ERROR

%SBTTL 'KERM_HANDLER - Condition handler'
ROUTINE KERM_HANDLER =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This is the condition handler for KERMIT-32.
!
! CALLING SEQUENCE:
!
!    Called via LIB$SIGNAL.
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    BIND
    FACILITY_DESC = %ASCID'KERMIT32';

    BUILTIN
    AP;

    LOCAL
    PUTMSG_VECTOR : VECTOR [10, LONG],
    SIGARGLST;                ! Address of the signal argument list

    MAP
    AP : REF BLOCK [, BYTE],
    SIGARGLST : REF BLOCK [, BYTE];

!++
!
! Routine to do the actual output of the error message
!
!--

    ROUTINE HANDLE_MSG =
    BEGIN

    EXTERNAL ROUTINE
        LOG_FAOL;

    BUILTIN
        AP;

    LOCAL
        ERR_DESC,                ! Address of the error descriptor
        POINTER;                ! Pointer to get characters

    MAP
        ERR_DESC : REF BLOCK [8, BYTE],
        AP : REF BLOCK [, BYTE];

    ERR_DESC = .AP [4, 0, 32, 0];

    IF .TERM_FLAG THEN SND_ERROR (.ERR_DESC [DSC$W_LENGTH], .ERR_DESC [DSC$A_POINTER]);

    IF .TRANSACTION_OPEN
    THEN
        BEGIN

        OWN
        TMP_DESC : BLOCK [8, BYTE];

        INIT_STR_DESC (TMP_DESC, .ERR_DESC [DSC$A_POINTER], .ERR_DESC [DSC$W_LENGTH]);
        LOG_FAOL (%ASCID'!%T!_!AS!/', UPLIT (0, TMP_DESC), TRANSACTION_RAB);
        END;

    IF NOT .CONNECT_FLAG
    THEN
        BEGIN
        TT_CRLF ();
        POINTER = CH$PTR (.ERR_DESC [DSC$A_POINTER]);

        INCR I FROM 1 TO .ERR_DESC [DSC$W_LENGTH] DO
        TT_CHAR (CH$RCHAR_A (POINTER));

        TT_CRLF ();
        END;

    RETURN 0;
    END;
    SIGARGLST = .AP [CHF$L_SIGARGLST];

    IF .SIGARGLST [CHF$L_SIG_NAME] GEQ %X'400' AND .SIGARGLST [CHF$L_SIG_NAME] LEQ %X'5FF'
    THEN
    RETURN SS$_RESIGNAL;

    PUTMSG_VECTOR [0] = .SIGARGLST [CHF$L_SIG_ARGS] - 2;    ! No PC and PSL
    PUTMSG_VECTOR [1] = .SIGARGLST [CHF$L_SIG_NAME];
!    PUTMSG_VECTOR [2] = .SIGARGLST [CHF$L_SIG_ARGS] - 3;

!    INCR I FROM 0 TO .SIGARGLST [CHF$L_SIG_ARGS] - 4 DO
    INCR I FROM 0 TO .SIGARGLST [CHF$L_SIG_ARGS] - 2 DO
    PUTMSG_VECTOR [.I + 2] = .(SIGARGLST [CHF$L_SIG_ARG1] + (.I*4));

    Final_Status = .Putmsg_Vector [1];
    $PUTMSG (MSGVEC = PUTMSG_VECTOR, ACTRTN = HANDLE_MSG, FACNAM = FACILITY_DESC);
    RETURN SS$_CONTINUE;
    END;                    ! End of KERM_HANDLER
%SBTTL 'End of KERMIT.B32'
END                        ! End of module

ELUDOM