Columbia Kermit/kermit.zip/decpro300/promsg.bli

Text File | 2020-01-01 | 142KB | 6,525 lines

%TITLE 'KERMSG - Kermit message processing'
MODULE KERMSG (IDENT = '3.0.041'
        ) =
BEGIN

SWITCHES LANGUAGE (COMMON);

!<BLF/WIDTH:100>

!++
! FACILITY:
!   Kermit-10, VMS Kermit, Pro/Kermit
!
! ABSTRACT:
!    KERMSG is the message processing routines for Kermit-10, VMS Kermit,
!    and PRO/Kermit.
!    This module is written in common BLISS, so that it can be
!    transported for the DECsystem-10 and VAX/VMS systems.
!
! ENVIRONMENT:
!   User mode
!
! AUTHOR: Robert C. McQueen, CREATION DATE: 24-January-1983
!
! MODIFIED BY:
!
!--


%SBTTL 'Table of Contents'
!+
!.pag.lit
!        Table of Contents for KERMSG
!
!
!               Section                  Page
!   1. Revision History . . . . . . . . . . . . . . . . . . .    3
!   2. Interface requirements . . . . . . . . . . . . . . . .    4
!   3. Declarations
!        3.1.   Forward definitions . . . . . . . . . . . . .    5
!   4. Require files. . . . . . . . . . . . . . . . . . . . .   28
!   5. Macro definitions. . . . . . . . . . . . . . . . . . .   29
!   6. KERMIT Protocol Definitions. . . . . . . . . . . . . .   30
!        6.1.   Packet offsets. . . . . . . . . . . . . . . .   31
!        6.2.   Message dependent field . . . . . . . . . . .   32
!        6.3.   SEND initiate packet. . . . . . . . . . . . .   33
!   7. KERMIT Protocol States . . . . . . . . . . . . . . . .   34
!   8. Internal constants . . . . . . . . . . . . . . . . . .   35
!   9. Storage - External . . . . . . . . . . . . . . . . . .   36
!  10. Storage - Local. . . . . . . . . . . . . . . . . . . .   37
!  11. External references. . . . . . . . . . . . . . . . . .   38
!  12. MSG_INIT . . . . . . . . . . . . . . . . . . . . . . .   39
!  13. SND_ERROR. . . . . . . . . . . . . . . . . . . . . . .   40
!  14. SERVER - Server mode . . . . . . . . . . . . . . . . .   41
!  15. SEND_SWITCH. . . . . . . . . . . . . . . . . . . . . .   42
!  16. REC_SWITCH . . . . . . . . . . . . . . . . . . . . . .   43
!  17. Server
!       17.1.   DO_GENERIC - Execute a generic command. . . .   44
!  18. DO_TRANSACTION - Main loop for FSM . . . . . . . . . .   45
!  19. REC_SERVER_IDLE - Idle server state. . . . . . . . . .   46
!  20. SEND_SERVER_INIT . . . . . . . . . . . . . . . . . . .   47
!  21. SEND_DATA. . . . . . . . . . . . . . . . . . . . . . .   48
!  22. SEND_FILE. . . . . . . . . . . . . . . . . . . . . . .   49
!  23. SEND_EOF . . . . . . . . . . . . . . . . . . . . . . .   50
!  24. SEND_INIT. . . . . . . . . . . . . . . . . . . . . . .   51
!  25. SEND_OPEN_FILE - Open file for sending . . . . . . . .   52
!  26. SEND_GENCMD. . . . . . . . . . . . . . . . . . . . . .   53
!  27. SEND_BREAK . . . . . . . . . . . . . . . . . . . . . .   54
!  28. REC_INIT . . . . . . . . . . . . . . . . . . . . . . .   55
!  29. REC_FILE . . . . . . . . . . . . . . . . . . . . . . .   56
!  30. REC_DATA . . . . . . . . . . . . . . . . . . . . . . .   57
!  31. SERVER - Generic commands. . . . . . . . . . . . . . .   58
!  32. HOST_COMMAND - perform a host command. . . . . . . . .   59
!  33. CALL_SY_RTN - handle operating system dependent functions  60
!  34. Message processing
!       34.1.   PRS_SEND_INIT - Parse send init params. . . .   61
!  35. SET_SEND_INIT. . . . . . . . . . . . . . . . . . . . .   62
!  36. SEND_PACKET. . . . . . . . . . . . . . . . . . . . . .   63
!  37. REC_MESSAGE - Receive a message. . . . . . . . . . . .   64
!  38. REC_PACKET . . . . . . . . . . . . . . . . . . . . . .   65
!  39. CALC_BLOCK_CHECK . . . . . . . . . . . . . . . . . . .   66
!  40. NORMALIZE_FILE - Put file name into normal form. . . .   67
!  41. Buffer filling
!       41.1.   Main routine. . . . . . . . . . . . . . . . .   68
!  42. BFR_EMPTY. . . . . . . . . . . . . . . . . . . . . . .   69
!  43. Buffer filling and emptying subroutines. . . . . . . .   70
!  44. Add parity routine . . . . . . . . . . . . . . . . . .   71
!  45. Parity routine . . . . . . . . . . . . . . . . . . . .   72
!  46. Per transfer
!       46.1.   Initialization. . . . . . . . . . . . . . . .   73
!  47. Statistics
!       47.1.   Finish message transfer . . . . . . . . . . .   74
!  48. Status type out
!       48.1.   STS_OUTPUT. . . . . . . . . . . . . . . . . .   75
!  49. TYPE_CHAR - Type out a character . . . . . . . . . . .   76
!  50. Debugging
!       50.1.   DBG_SEND. . . . . . . . . . . . . . . . . . .   77
!       50.2.   DBG_RECEIVE . . . . . . . . . . . . . . . . .   78
!       50.3.   DBG_MESSAGE . . . . . . . . . . . . . . . . .   79
!  51. End of KERMSG. . . . . . . . . . . . . . . . . . . . .   80
!.end lit.pag
!-

%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: 30-Apr-1983
!        Change PAR_xxx to be PR_xxx, so that they can be used for
!        KERMIT-10.
!
! 1.0.002    By: Robert C. McQueen        On: 1-May-1983
!        Add DO_GENERIC routine to cause a generic Kermit command to
!        be executed on the remote Kermit.
!
! 1.0.003    By: Robert C. McQueen        On: 3-May-1983
!        Fix message number incrementing.
!
! 1.0.004    By: Robert C. McQueen        On: 4-May-1983
!        Allow RECEIVE file-specification to work correctly.
!
! 1.0.005    By: Robert C. McQueen        On: 6-May-1983
!        Add more stats support.
!
! 1.0.006    By: Nick Bush            On: 13-June-1983
!        Fix SEND_PACKET to copy correct characters when fixing
!        parity bits.
!
! 1.1.007    By: Nick Bush            On: 15-July-1983
!        Correct SEND-INIT message handling to do the right things
!        with the protocol version 3 items.
!
! 1.1.010    By: Robert C. McQueen        On: 20-July-1983
!        Make PARITY a global routine, so that it can be called by
!        CONNECT processing.  Change the name from PARITY to GEN_PARITY
!        add a new routine to generate the parity, since it is not
!        part of the checksum.
!
! 1.1.011    By: Robert C. McQueen        On: 28-July-1983
!        KER_TIMEOUT errors in the SERVER loop would cause
!        KER_UNISRV error messages to be returned to the remote.
!        Check for receive failures and send NAKs instead.
!
! 1.2.012    By: Robert C. McQueen        On: 23-August-1983
!        Don't abort if we get a message that is just an end of line
!        character.  It could be noise on the line.
!
! 1.2.013    By: Nick Bush            On: 7-September-1983
!        Fix several problems with the SEND_xxx parameters
!
! 1.2.014    By: Robert C. McQueen        On: 15-September-1983
!        Add routine calls to XFR_STATUS to tell the user on the
!        number of packets have changed.
!
! 1.2.015    By: Nick Bush            On: 5-October-1983
!        Add 2 and 3 character checksum (block check) support.
!        Add support for data within acknowledgement packets
!        and withing end-of-file packets to allow for file
!        transmission to be aborted.  Also add support for
!        "I" packet to allow server parameters to be initialized.
!
! 1.2.016    By: Nick Bush            On: 19-October-1983
!        Add repeat character support.
!
! 2.0.017    Release TOPS-10 Kermit-10 version 2.0
!        Release VAX/VMS Kermit-32 version 2.0
!
! 2.0.018    By: Robert C. McQueen        On: 16-November-1983
!        Fix four checks on the message number that were not
!        mod 64.
!
! 2.0.019    By: Robert C. McQueen        On: 16-November-1983
!        Remove the CLEAR routine.  It is not really needed.
!
! 2.0.020    By: Nick Bush            On: 12-Dec-1983
!        Fix SEND_DATA and BFR_FILL to handle empty files and
!        files which happen to end just on a message boundary.
!        This would sometimes produce extra nulls.
!
! 2.0.021    By: Nick Bush            On: 15-Dec-1983
!        Fix some problems with REC_MESSAGE which would cause
!        aborts when a message timed out.
!
! 2.0.022    By: Robert C. McQueen        19-Dec-1983
!        Make STATUS a local for most routines and remove FILE_DUMP
!        as it is nolonger needed.
!
! 2.0.023    By: Nick Bush            On: 3-Jan-1984
!        Change FIL_NORMAL_FORM to contain not just a flag, but
!        a file name type instead.
!
! 2.0.024    By: Nick Bush            On: 11-Jan-1984
!        Fix REC_MESSAGE to send NAK for packet we expect, not
!        previous packet.
!
! 2.0.025    By: Nick Bush            On: 23-Jan-1984
!        Re-enable server-init packet and complete code so that
!        parameters set by it will remain set.
!        Fix file name copying to use BFR_FILL or BFR_EMPTY
!        so that all quoting/compression is done properly.
!
! 2.0.026    By: Nick Bush            On: 15-Feb-1984
!        Add code for generic command support (both directions).
!        There is now only one state dispatch loop, entered
!        in various states for different functions.
!
! 2.0.027    By: Robert C. McQueen        On: 16-Feb-1984
!        At some point SEND_TIMEOUT became global, but it was not moved
!        to KERGLB.  This edit moves it to KERGLB.BLI.
!
! 2.0.030    By: Nick Bush            On: 2-March-1984
!        Fix BFR_FILL to handle case of last repeated character
!        not fitting within a packet.  It was forgetting to
!        send the characters at all.
!
! 2.0.031    By: Nick Bush            On: 6-March-1984
!        Make sure FILE_OPEN_FLAG is set properly when advancing
!        to next file of a wild-card send.  The file was not
!        being set true, leading to problems after a couple files.
!
! 2.0.032    By: Nick Bush            On: 9-March-1984
!        Fix UNPACK_DATA in SERVER_GENERIC to properly store
!        new string pointer.
!
! 2.0.033    By: Robert C. McQueen        On: 12-March-1984
!        If NEXT_FILE fails with anything other than a NOMORFILES
!        it should change state to STATE_A not STATE_SB.  This
!        fixes a problem caused by Pro/Kermit and KERFIL (VMS).
!
! 2.0.034    By: Nick Bush            On: 15-March-1984
!        Put file spec into X packet as well as F packet. This
!        makes wild card TYPE's work nicer.
!
! 2.0.035    By: Nick Bush            On: 20-March-1984
!        Fix send/receive quoting to conform to the way the
!        protocol manual says it should be done, rather
!        than the way we (and Kermit-20) have always done it.
!
! 2.0.036    By: Nick Bush            On: 28-March-1984
!        Make SERVER_GENERIC more defensive against badly
!        constructed packets.  If an argument has negative
!        length, punt the request.  Also put angle brackets
!        around data from "X" packet header, so file names will
!        stick out.
!
! 3.0.037    Start of version 3.
!
! 3.0.040    By: Nick Bush            On: 2-April-1984
!        Add separate server timeout.  This allows stopping the
!        server NAK's without affecting the normal packet timeout.
!
! 3.0.041    By: Nick Bush            On: 12-April-1984
!        Fix block check calculation to account for the fact
!        that the parity bits are put onto the message when
!        it is sent (in place), so that if a retransmission is
!        done without refilling the buffer (as is normal with
!        data messages), the parity bits will be there.  Make
!        sure we strip them out for block check calculation.
!--


%SBTTL 'Interface requirements'

!++
!        Interface requirements
!
! The following routines and data locations are rquired for a correct
! implementation of KERMIT.
!
! File routines:
!
!    FILE_OPEN (Function)
!        This routine will open a file for reading or writting.  It
!        will assume that FILE_SIZE contains the number of bytes
!        and FILE_NAME contains the file name of length FILE_SIZE.
!        The function that is passed is either FNC_READ or FNC_WRITE.
!
!    FILE_CLOSE ()
!        This routine will close the currently open file.  This
!        routine will return the status of the operation.
!
!    GET_FILE (Character)
!        This routine will get a character from the currently open file
!        and store it in the location specified by "Character".  There
!        will be a true/false value returned by the routine to determine
!        if there was an error.
!
!    PUT_FILE (Character)
!        This routine will output a character to the currently open
!        file.  It will return a true/false value to determine if the
!        routine was successful.
!
!    NEXT_FILE ()
!        This routine will advance to the next file.  This routine
!        will return false if there are no more files to process.
!
! Communications line routines:
!
!    RECEIVE (Buffer address, Address of var to store length into)
!        This routine will receive a message from the remote Kermit.
!
!    SEND (Buffer address, Length in characters)
!        This routine will send a message to the remote Kermit.
!
!    GEN_CRC (Buffer address, length in characters)
!        This routine will calculate the CRC-CCITT for the characters
!        in the buffer.
!
! Operating system routines:
!
!    SY_DISMISS (Seconds)
!        This routine will cause Kermit to sleep for the specified
!        number of seconds.  It is used to handle the DELAY parameter.
!
!    SY_LOGOUT ()
!        Log the job off of the system. (Kill the process).
!
!    SY_TIME ()
!        This routine will return the starting time milliseconds.
!        It can be the start of Kermit, the system, etc, so long
!        as it always is incrementing.
!
! Status routines:
!
!    XFR_STATUS (Type, Subtype);
!        This routine is called to indicate the occurance of
!        a significant event that the user interface may wish
!        to inform the user about.  The arguments indicate the
!        type of event.
!        Type: "S" - Send, "R" - Receive
!            Subtype: "P" - Packet
!                 "N" - NAK
!                 "T" - timeout
!        For type = "I" (initiate), "T" (terminate):
!            Subtype: "S" - a file send
!                 "R" - a file receive
!                 "G" - a generic command
!                 "I" - for "T" only, returning to server idle
!        For type = "F" (file operation):
!            Subtype: "S" - open for sending
!                 "R" - open for receiving
!                 "C" - closing file OK
!                 "X" - aborting file by user request
!                 "Z" - aborting group by user request
!                 "D" - aborting file, but saving due to disposition
!                 "A" - aborting file due to protocol error
!
! Error processing:
!
!    KRM_ERROR (Error parameter)
!        This routine will cause an error message to be issued.
!        The error parameter is defined by KERERR.  This may cause
!        SND_ERROR to be called to send an "E" message to the remote.
!
! Terminal I/O routines:
!
!    TERM_DUMP (Buffer, Count)
!    DBG_DUMP (Buffer, Count)
!        This routine will dump the buffer onto the user's terminal.
!        The routine is supplied with the count of the characters
!        and the address of the buffer.
!        These may be the same routine or different.  DBG_DUMP
!        is only called for debugging output.
!
!
!            ENTRY POINTS
!
! KERMSG contains the following entry points for the KERMIT.
!
!    SERVER ()
!        This routine will cause KERMIT go enter server mode.
!
!    SEND_SWITCH ()
!        This routine will send a file.  It expects that the user
!        has stored the text of the file name into FILE_NAME and
!        the length of the text into FILE_SIZE.
!
!    REC_SWITCH ()
!        This routine will receive a file.  It expects that the default
!        file name is set up in FILE_NAME and the length is in
!        FILE_SIZE.
!
!    GEN_PARITY (Character)
!        This routine will return the character with the proper parity
!        on the character.
!
!    SND_ERROR (COUNT, ADDRESS)
!        This routine will send the text of an error to the remote
!        Kermit.
!
!    DO_GENERIC (TYPE)
!        This routine will cause a generic function to be sent to
!        the remote Kermit.  This routine will then do all of the
!        necessary hand shaking to handle the local end of the generic
!        Kermit command.
!
!
!        GLOBAL Storage
!
! The following are the global storage locations that are used to interface
! to KERMSG.  These locations contains the various send and receive parameters.
!
! Receive parameters:
!
!    RCV_PKT_SIZE
!        Receive packet size.
!    RCV_NPAD
!        Padding length
!    RCV_PADCHAR
!        Padding character
!    RCV_TIMEOUT
!        Time out
!    RCV_EOL
!        End of line character
!    RCV_QUOTE_CHR
!        Quote character
!    RCV_8QUOTE_CHR
!        8-bit quoting character
!    RCV_SOH
!        Start of header character
!
! Send parameters (Negative values denote the default, positive user supplied):
!
!    SND_PKT_SIZE
!        Send packet size
!    SND_NPAD
!        Padding length
!    SND_PADCHAR
!        Padding character
!    SND_TIMEOUT
!        Time out
!    SND_EOL
!        End of line character
!    SND_QUOTE_CHR
!        Quote character
!    SND_SOH
!        Start of header character (normally 001)
!
! Statistics:
!
!    SND_TOTAL_CHARS
!        Total characters sent for this Kermit session
!    RCV_TOTAL_CHARS
!        Total characters received for this Kermit session
!    SND_DATA_CHARS
!        Total number of data characters sent for this Kermit session
!    RCV_DATA_CHARS
!        Total number of data characters received for this Kermit session
!    SND_COUNT
!        Total number of packets that have been sent
!    RCV_COUNT
!        Total number of packets that have been received.
!    SMSG_TOTAL_CHARS
!        Total characters sent for this file transfer
!    RMSG_TOTAL_CHARS
!        Total characters received for this file transfer
!    SMSG_DATA_CHARS
!        Total data characters sent for this file transfer
!    RMSG_DATA_CHARS
!        Total data characters received for this file transfer
!    SMSG_NAKS
!        Total number of NAKs sent for this file transfer
!    RMSG_NAKS
!        Total number of NAKs received for this file transfer
!    XFR_TIME
!        Amount of time the last transfer took in milliseconds.
!    TOTAL_TIME
!        Total amount of time spend transfering data.
!
! Misc constants:
!
!    LAST_ERROR
!        ASCIZ of the last error message issued.
!    FILE_NAME
!        Vector containing the ASCII characters of the file name.
!    FILE_SIZE
!        Number of characters in the FILE_NAME vector.
!    DELAY
!        Amount of time to delay
!    DUPLEX
!        DP_HALF or DP_FULL to denote either half duplex or full duplex.
!        [Currently only DP_FULL is supported]
!    PKT_RETRIES
!        Number of retries to attempt to read a message.
!    SI_RETRIES
!        Number of retries to attempt on send inits
!    DEBUG_FLAG
!        Debugging mode on/off
!    WARN_FLAG
!        File warning flag
!    IBM_FLAG
!        True if talking to an IBM system, else false.
!    ECHO_FLAG
!        Local echo flag
!    CONNECT_FLAG
!        Connected flag; True if terminal and SET LINE are the same
!    PARITY_TYPE
!        Type of parity to use on sends.
!    DEV_PARITY_FLAG
!        Device will add parity to message.  True if device adds
!        parity and false if we must do it.
!
!--


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

FORWARD ROUTINE

! Main loop for a complete transaction
    DO_TRANSACTION,        ! Perform a complete transaction

! Send processing routines

    SEND_SERVER_INIT,        ![026] Send a server init packet
    SEND_DATA,            ! Send data to the micro
    SEND_FILE,            ! Send file name
    SEND_OPEN_FILE,            ! Open file for sending
    SEND_GENCMD,        ! Send generic command
    SEND_EOF,            ! Send EOF
    SEND_INIT,            ! Send initialization msg
    SEND_BREAK,            ! Send break end of transmission

! Receive processing routines

    REC_SERVER_IDLE,        ! Wait for message while server is idle
    REC_INIT,            ! Receive initialization
    REC_FILE,            ! Receive file information
    REC_DATA,            ! Receive data
!
! Server processing routines
!
    SERVER_GENERIC,        ! Process generic KERMIT commands
    HOST_COMMAND,        ! Process host command
    KERMIT_COMMAND,        ! Process Kermit command
    CALL_SY_RTN,        ! Handle calling system routine and returning result
!
! Statistic gathering routines
!
    END_STATS    : NOVALUE,    ! End of a message processing stats routine

! Low level send/receive routines

    CALC_BLOCK_CHECK,        ! Routine to calculate the block check value
    SET_SEND_INIT : NOVALUE,    ! Set up the MSG_SND_INIT parameters.
    PRS_SEND_INIT,        ! Parse MSG_SND_INIT parameters.
    DO_PARITY : NOVALUE,    ! Routine to generate parity for a message
    GEN_PARITY,            ! Routine to add parity to a character
    SEND_PACKET,        ! Send a packet to the remote
    REC_MESSAGE,        ! Receive a message with retry processing
    REC_PACKET,            ! Receive a packet from the remote

! Utility routines

    NORMALIZE_FILE : NOVALUE,    ! Force file name into normal form
    BFR_EMPTY,            ! Empty the data buffer
    BFR_FILL,            ! Fill the data buffer from a file
    SET_STRING,            ![025] Routine to set alternate get/put routines
                    ! for use with in memory strings
    TYPE_CHAR,            ! Type a character from a packet
    INIT_XFR    : NOVALUE,    ! Initialize the per transfer processing
    STS_OUTPUT    : NOVALUE,    ! Output current transfer status
!
! Debugging routines
!
    DBG_MESSAGE    : NOVALUE,    ! Type out a formatted message
    DBG_SEND    : NOVALUE,    ! Send message debugging routine
    DBG_RECEIVE    : NOVALUE;    ! Receive message debugging routine




























    %SBTTL    'Require files'

!
!<BLF/FORMAT>
!
! REQUIRE FILES:
!

%IF %BLISS (BLISS32)
%THEN

LIBRARY 'SYS$LIBRARY:STARLET';

%FI

REQUIRE 'KERCOM';

REQUIRE 'KERERR';


%SBTTL 'Macro definitions'
!
! MACROS:
!

MACRO
    CTL (C) =
 ((C) XOR %O'100')%,
    CHAR (C) =
 ((C) + %O'40')%,
    UNCHAR (C) =
 ((C) - %O'40')%;


%SBTTL 'KERMIT Protocol Definitions'

!++
! The following describes the various items that are found in the
! KERMIT messages.  A complete and through desription of the protocol can be
! found in the KERMIT PROTOCOL MANUAL.
!
!
! All KERMIT messages have the following format:
!
! <Mark><CHAR(Count)><CHAR(Seq)><Message-dependent information><Check><EOL>
!
! <MARK>
!    Normally SOH (Control-A, octal 001).
!
! <CHAR(Count)>
!    Count of the number of characters following this position.
!    Character counts of ONLY 0 to 94 are valid.
!
! <CHAR(Seq)>
!    Packet sequence number, modulo 100 (octal).
!
! <MESSAGE-DEPENDENT INFORMATION>
!    This field contains the message dependent information.  There can
!    be multiple fields in this section.  See the KERMIT Protocol document
!    for a complete description of this.
!
! <Check>
!    A block check on the characters in the packet between, but not
!    including, the mark and the checksum itself.  It may be one to three
!    characters, depending upon the type agreed upon.
!
!    1. Single character arithmetic sum equal to:
!        chksum = (s + ((s AND 300)/100)) AND 77
!        Character sent is CHAR(chksum).
!
!    2. Two character arithmetic sum.  CHAR of bits 6-11 are the first
!       character, CHAR of bits 0-5 are the second character.
!
!    3. Three character CRC-CCITT.  First character is CHAR of bits 12-15,
!       second is CHAR of bits 6-11, third is CHAR of bits 0-5.
!
!
! <EOL>
!    End of line.  Any line terminator that may be required by the host.
!--


%SBTTL 'KERMIT Protocol Definitions -- Packet offsets'

!++
! The following define the various offsets of the standard KERMIT
! packets.
!--

LITERAL
    PKT_MARK = 0,                ! <MARK>
    PKT_COUNT = 1,                ! <CHAR(Count)>
    PKT_SEQ = 2,                ! <CHAR(Seq)>
    PKT_TYPE = 3,                ! <Message type>
    PKT_MSG = 4,                ! <MESSAGE-DEPENDENT INFORMATION>
    PKT_MAX_MSG = 94 - 5,            ! Maximum size of the message dependent
                            !  information
    PKT_CHKSUM = 0,                ! <CHAR(Chksum)> offset from end of
                            !    Message dependent information
    PKT_EOL = 1,                ! <Eol> offset from end of data
    PKT_OVR_HEAD_B = 2,                ! Header overhead
    PKT_OVR_HEAD_E = 1,                ! Overhead at the end
    PKT_OVR_HEAD = 3,                ! Overhead added to data length
    PKT_TOT_OVR_HEAD = 6;            ! Total overhead of the message


%SBTTL 'KERMIT Protocol Definitions -- Message dependent field'

!++
! The MESSAGE-DEPENDENT information field of the message contains at
! least one part.  That is the type of message.  The remainder of the message
! MESSAGE-DEPENDENT field is different depending on the message.
!
! <TYPE><TYPE-DEPENDENT-INFORMATION>
!
! <TYPE>
!    The type defines the type of message that is being processed.
!
!--

! Protocol version 1.0 message types

LITERAL
    MSG_DATA = %C'D',                ! Data packet
    MSG_ACK = %C'Y',                ! Acknowledgement
    MSG_NAK = %C'N',                ! Negative acknowledgement
    MSG_SND_INIT = %C'S',            ! Send initiate
    MSG_BREAK = %C'B',                ! Break transmission
    MSG_FILE = %C'F',                ! File header
    MSG_EOF = %C'Z',                ! End of file (EOF)
    MSG_ERROR = %C'E';                ! Error

! Protocol version 2.0 message types

LITERAL
    MSG_RCV_INIT = %C'R',            ! Receive initiate
    MSG_COMMAND = %C'C',            ! Host command
    MSG_GENERIC = %C'G',            ! Generic KERMIT command.
    MSG_KERMIT = %C'K';                ! Perform KERMIT command (text)

! Protocol version 4.0 message types

LITERAL
    MSG_SER_INIT = %C'I',            ! Server initialization
    MSG_TEXT = %C'X';                ! Text header message

!++
! Generic KERMIT commands
!--

LITERAL
    MSG_GEN_LOGIN = %C'I',            ! Login
    MSG_GEN_EXIT = %C'F',            ! Finish (exit to OS)
    MSG_GEN_CONNECT = %C'C',            ! Connect to a directory
    MSG_GEN_LOGOUT = %C'L',            ! Logout
    MSG_GEN_DIRECTORY = %C'D',            ! Directory
    MSG_GEN_DISK_USAGE = %C'U',            ! Disk usage
    MSG_GEN_DELETE = %C'E',            ! Delete a file
    MSG_GEN_TYPE = %C'T',            ! Type a file specification
!    MSG_GEN_SUBMIT = %C'S',            ! Submit
!    MSG_GEN_PRINT = %C'P',            ! Print
    MSG_GEN_WHO = %C'W',            ! Who's logged in
    MSG_GEN_SEND = %C'M',            ! Send a message to a user
    MSG_GEN_HELP = %C'H',            ! Help
    MSG_GEN_QUERY = %C'Q',            ! Query status
    MSG_GEN_RENAME = %C'R',            ! Rename file
    MSG_GEN_COPY = %C'K',            ! Copy file
    MSG_GEN_PROGRAM = %C'P',            ! Run program and pass data
    MSG_GEN_JOURNAL = %C'J',            ! Perform journal functions
    MSG_GEN_VARIABLE = %C'V';            ! Return/set variable state

!
! Acknowledgement modifiers (protocol 4.0)
!

LITERAL
    MSG_ACK_ABT_CUR = %C'X',            ! Abort current file
    MSG_ACK_ABT_ALL = %C'Z';            ! Abort entire stream of files

!
! End of file packet modifier
!

LITERAL
    MSG_EOF_DISCARD = %C'D';            ! Discard data from previous file


%SBTTL 'KERMIT Protocol Definitions -- SEND initiate packet'

!++
!
! The following describes the send initiate packet.  All fields in the message
! data area are optional.
!
! <"S"><CHAR(Bufsiz)><CHAR(Timeout)><CHAR(npad)><CTL(pad)><CHAR(Eol)><Quote>
!    <8-bit-quote><Check-type><Repeat-count-processing><Reserved><Reserved>
!
! BUFSIZ
!    Sending Kermit's maximum buffer size.
!
! Timeout
!    Number of seconds after which the sending Kermit wishes to be timed out
!
! Npad
!    Number of padding caracters the sending Kermit needs preceding each
!    packet.
!
! PAD
!    Padding character.
!
! EOL
!    A line terminator required on all packets set by the receiving
!    Kermit.
!
! Quote
!    The printable ASCII characer the sending Kermit will use when quoting
!    the control cahracters.  Default is "#".
!
! 8-bit-quote
!    Specify quoting mecanism for 8-bit quantities.  A quoting mecanism is
!    mecessary when sending to hosts which prevent the use of the 8th bit
!    for data.  When elected, the quoting mechanism will be used by both
!    hosts, and the quote character must be in the range of 41-76 or 140-176
!    octal, but different from the control-quoting character.  This field is
!    interpreted as follows:
!
!    "Y" - I agree to 8-bit quoting if you request it.
!    "N" - I will not do 8-bit quoting.
!    "&" - (or any other character in the range of 41-76 or 140-176) I want
!          to do 8-bit quoting using this character (it will be done if the
!          other Kermit puts a "Y" in this field.
!    Anything else: Quoting will not be done.
!
! Check-type
!    Type of block check.  The only values presently allowed in this
!    field are "1", "2" or "3".  Future implementations may allow other
!    values.  Interpretation of the values is:
!
!    "1" - Single character checksum.  Default value if none specified.
!    "2" - Double character checksum.
!    "3" - Three character CRC.
!
! Repeat-count-processing
!    The prefix character to be used to indicate a repeated character.
!    This can be any printable cahracter other than blank (which denotes
!    no repeat count).
!
! Fields 10 to 11 reserved.
!--

LITERAL
    P_SI_BUFSIZ = 0,                ! Buffersize
    MY_PKT_SIZE = 80,                ! My packet size
    P_SI_TIMOUT = 1,                ! Time out
    MY_TIME_OUT = 15,                ! My time out
    P_SI_NPAD = 2,                ! Number of padding characters
    MY_NPAD = 0,                ! Amount of padding I require
    P_SI_PAD = 3,                ! Padding character
    MY_PAD_CHAR = 0,                ! My pad character
    P_SI_EOL = 4,                ! End of line character
    MY_EOL_CHAR = %O'015',            ! My EOL cahracter
    P_SI_QUOTE = 5,                ! Quote character
    MY_QUOTE_CHAR = %C'#',            ! My quoting character
    P_SI_8QUOTE = 6,                ! 8-bit quote
    MY_8BIT_QUOTE = %C'&',            ! Don't do it
    P_SI_CHKTYPE = 7,                ! Checktype used
    MY_CHKTYPE = CHK_1CHAR,            ! Use single character checksum
    P_SI_REPEAT = 8,                ! Repeat character
    MY_REPEAT = %C'~',                ! My repeat character
    P_SI_LENGTH = 9;                ! Length of the message


%SBTTL 'KERMIT Protocol States'

!++
! The following are the various states that KERMIT can be in.
! The state transitions are defined in the KERMIT Protocol manual.
!--

LITERAL
    STATE_MIN = 1,                ! Min state number
    STATE_S = 1,                ! Send init state
    STATE_SF = 2,                ! Send file header
    STATE_SD = 3,                ! Send file data packet
    STATE_SZ = 4,                ! Send EOF packet
    STATE_SB = 5,                ! Send break
    STATE_R = 6,                ! Receive state (wait for send-init)
    STATE_RF = 7,                ! Receive file header packet
    STATE_RD = 8,                ! Receive file data packet
    STATE_C = 9,                ! Send complete
    STATE_A = 10,                ! Abort
    STATE_SX = 11,                ! Send text header
    STATE_SG = 12,                ! Send generic command
    STATE_SI = 13,                ! Send server init
    STATE_ID = 14,                ! Server idle loop
    STATE_II = 15,                ! Server idle after server init
    STATE_FI = 16,                ! Server should exit
    STATE_LG = 17,                ! Server should logout
    STATE_OF = 18,                ! Send - open first input file
    STATE_EX = 19,                ! Exit back to command parser
    STATE_ER = 20,                ! Retries exceeded error
    STATE_MAX = 20;                ! Max state number


%SBTTL 'Internal constants'

!++
! The following represent various internal KERMSG constants.
!--

LITERAL
    MAX_PKT_RETRIES = 16,            ! Maximum packet retries
    MAX_SI_RETRIES = 5;                ! Maximum send init retries


%SBTTL 'Storage - External'
!
! OWN STORAGE:
!

EXTERNAL
!
! 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_SOH,                    ! Start of header character
    RCV_8QUOTE_CHR,                ! 8-bit quoting character
!
! Miscellaneous parameters
!
    SET_REPT_CHR,                ! Repeat character
!
! 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,                    ! Start of header character
    SEND_TIMEOUT,                ! Time to wait for receiving message
!
! Server parameters
!
    SRV_TIMEOUT,                ! Time between NAK's when server is idle
!
! 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
    SND_NAKS,                    ! Total NAKs sent
    RCV_NAKS,                    ! Total NAKs received
    SND_COUNT,                    ! Count of total number of packets
    RCV_COUNT,                    ! Count of total number packets received
    SMSG_COUNT,                    ! Total number of packets sent
    RMSG_COUNT,                    ! Total number of packets 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
    SMSG_NAKS,                    ! Total number of NAKs this file xfer
    RMSG_NAKS,                    ! Total number of NAKs received
    XFR_TIME,                    ! Amount of time last xfr took
    TOTAL_TIME,                    ! Total time of all xfrs
                            !  this file xfer
    LAST_ERROR : VECTOR [CH$ALLOCATION (MAX_MSG + 1)],    ! Last error message
!
! Misc constants.
!
    FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],
    FILE_SIZE,
    SI_RETRIES,                    ! Send init retries to attempt
    PKT_RETRIES,                ! Number of retries to try for a message
    DELAY,                    ! Amount of time to delay
    DUPLEX,                    ! Type of connection (half or full)
    PARITY_TYPE,                ! Type of parity to use
    DEV_PARITY_FLAG,                ! True if output device does
                            !  parity, false if we do it
    CHKTYPE,                    ! Type of block check desired
    ABT_FLAG,                    ! True if aborted file should be discarded
    DEBUG_FLAG,                    ! Debugging mode on/off
    WARN_FLAG,                    ! File warning flag
    IBM_FLAG,                    ! Talking to an IBM system
    IBM_CHAR,                    ! Turnaround character for IBM mode
    ECHO_FLAG,                    ! Local echo flag
    CONNECT_FLAG,                ! Connected flag; True if
                            !  terminal and SET LINE are
                            !  the same
    ABT_CUR_FILE,                ! Abort current file
    ABT_ALL_FILE,                ! Abort all files in stream
    TYP_STS_FLAG,                ! Type status next message
    TY_FIL,                    ! Type file specs
    TY_PKT,                    ! Type packet info
    FIL_NORMAL_FORM,                ! If true, file names should be normalized
    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


%SBTTL 'Storage - Local'
!
! LOCAL OWN STORAGE:
!

OWN
!
! Receive parameters
!
    RECV_8QUOTE_CHR,                ! 8th-bit quoting character
    REPT_CHR,                    ! Repeat prefix character
!
! Send parameters
!
    SEND_PKT_SIZE,                ! Send packet size
    SEND_NPAD,                    ! Padding length
    SEND_PADCHAR,                ! Padding character
    SEND_EOL,                    ! EOL character
    SEND_QUOTE_CHR,                ! Quote character
    SEND_8QUOTE_CHR,                ! 8-bit quoting character
!
! Misc parameters
!
    INI_CHK_TYPE,                ! Type of block checking from init message
    BLK_CHK_TYPE,                ! Type of block check to use
    FLAG_8QUOTE,                ! Flag to determine if doing 8bit quoting
    FLAG_REPEAT,                ! True if doing repeated character compression
    STATE,                    ! Current state
    SIZE,                    ! Size of the current message
    OLD_RETRIES,                ! Saved number of retries done.
    NUM_RETRIES,                ! Number of retries
    MSG_NUMBER,                    ! Current message number
    REC_SEQ,                    ! Sequence number of msg in REC_MSG
    REC_LENGTH,                    ! Length of the message recv'd
    REC_TYPE,                    ! Type of the message received.
    REC_MSG : VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)],    ! Message received
    SND_MSG : VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)],    ! Message sent
    FILE_OPEN_FLAG,                ! File is opened.
    FILE_CHARS,                    ! Number of characters sent or received
    TEXT_HEAD_FLAG,                ! Text header received, not file header
    NO_FILE_NEEDED,                ! Don't open a file
    INIT_PKT_SENT,                ! Server-init sent and ACKed
    GEN_TYPE,                    ! Command message type
    GEN_SUBTYPE,                ! Generic command subtype
    GET_CHR_ROUTINE,            ![025] Address of routine to get a character for BFR_FILL
    PUT_CHR_ROUTINE;            ![025] Address of routine to put a character for BFR_EMPTY


%SBTTL 'External references'
!
! EXTERNAL REFERENCES:
!
! Packet I/O routines

EXTERNAL ROUTINE
    SEND,                    ! Send a packet to the remote
    IBM_WAIT,                    ! Wait for IBM turnaround
    RECEIVE;                    ! Receive a packet from the remote

!
! Terminal I/O routines
!

EXTERNAL ROUTINE
    TERM_DUMP : NOVALUE,            ! Normal terminal output
    DBG_DUMP : NOVALUE,                ! Debugging output
    TT_SET_OUTPUT,                ! Set output routine
    TT_CHAR : NOVALUE,                ! Output a single character
    TT_CRLF : NOVALUE,                ! Output a CRLF
    TT_NUMBER : NOVALUE,            ! Output a three digit number to the
                            !  terminal
    TT_TEXT : NOVALUE,                ! Output a string to the user's
    TT_OUTPUT : NOVALUE;            ! Force buffered output to terminal

! Operating system routines and misc routines

EXTERNAL ROUTINE
    CRCCLC,                    ! Calculate a CRC-CCITT
    XFR_STATUS : NOVALUE,            ! Routine to tell the user the
                            !  status of a transfer
    KRM_ERROR : NOVALUE,            ! Issue an error message
    SY_LOGOUT : NOVALUE,            ! Log the job off
    SY_GENERIC,                    ! Perform a generic command
    SY_TIME,                    ! Return elapsed time in milliseconds
    SY_DISMISS : NOVALUE;            ! Routine to dismiss for n seconds.

!
! External file processing routines
!

EXTERNAL ROUTINE
    FILE_OPEN,                    ! Open a file for reading/writing
    FILE_CLOSE,                    ! Close an open file
    NEXT_FILE,                    ! Determine if there is a next file
                            !  and open it for reading.
    GET_FILE,                    ! Get a byte from the file
    PUT_FILE;                    ! Put a byte in the file.


%SBTTL 'MSG_INIT'

GLOBAL ROUTINE MSG_INIT : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will initialize the message processing for
!    KERMIT-32/36.
!
! CALLING SEQUENCE:
!
!    MSG_INIT();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Initialize some variables
!
! Receive parameters first
!
    RCV_PKT_SIZE = MY_PKT_SIZE;
    RCV_NPAD = MY_NPAD;
    RCV_PADCHAR = MY_PAD_CHAR;
    RCV_TIMEOUT = MY_TIME_OUT;
    RCV_EOL = MY_EOL_CHAR;
    RCV_QUOTE_CHR = MY_QUOTE_CHAR;
    RCV_SOH = CHR_SOH;
    RCV_8QUOTE_CHR = MY_8BIT_QUOTE;
    SET_REPT_CHR = MY_REPEAT;
!
! Send parameters.
!
    SND_PKT_SIZE = -MY_PKT_SIZE;
    SND_NPAD = -MY_NPAD;
    SND_PADCHAR = -MY_PAD_CHAR;
    SND_TIMEOUT = -MY_TIME_OUT;
    SND_EOL = -MY_EOL_CHAR;
    SND_QUOTE_CHR = -MY_QUOTE_CHAR;
    SND_SOH = CHR_SOH;
!
! Server parameters
!
    SRV_TIMEOUT = 5*MY_TIME_OUT;
!
! Other random parameters
!
    PKT_RETRIES = MAX_PKT_RETRIES;        ! Number of retries per message
    SI_RETRIES = MAX_SI_RETRIES;        ! Number of retries on send inits
    DELAY = INIT_DELAY;
    DUPLEX = DP_FULL;                ! Use full duplex
    DEBUG_FLAG = FALSE;
    WARN_FLAG = FALSE;
    ECHO_FLAG = FALSE;
    BLK_CHK_TYPE = CHK_1CHAR;            ! Start using single char checksum
    CHKTYPE = MY_CHKTYPE;            ! Desired block check type
    INI_CHK_TYPE = .CHKTYPE;            ! Same as default for now
    DEV_PARITY_FLAG = FALSE;            ! We generate parity
    PARITY_TYPE = PR_NONE;            ! No parity
    ABT_FLAG = TRUE;                ! Discard incomplete files
    FILE_OPEN_FLAG = FALSE;
    IBM_FLAG = FALSE;                ! Not talking to an IBM
    IBM_CHAR = CHR_DC1;                ! XON is IBM turnaround character
    TY_FIL = TRUE;                ! Default to typing files
    TY_PKT = FALSE;                ! But not packet numbers
    FIL_NORMAL_FORM = FNM_NORMAL;        ! Default to normal form names
    GET_CHR_ROUTINE = GET_FILE;            ![025] Initialize the get-a-char routine
    PUT_CHR_ROUTINE = PUT_FILE;            ![025] And the put-a-char
    END;                    ! End of MSG_INIT


%SBTTL 'SND_ERROR'

GLOBAL ROUTINE SND_ERROR (COUNT, ADDRESS) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will send an error packet to the remote KERMIT.  It
!    is called with the count of characters and the address of the text.
!
! CALLING SEQUENCE:
!
!    SND_ERROR(COUNT, %ASCII 'Error text');
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!
!--

    BEGIN
!
! Pack the message into the buffer
!
    SET_STRING (CH$PTR (.ADDRESS), .COUNT, TRUE);
    BFR_FILL (TRUE);
    SET_STRING (0, 0, FALSE);
!
! Save the last error message also
!

    IF .COUNT GTR MAX_MSG THEN COUNT = MAX_MSG;

    CH$COPY (.COUNT, CH$PTR (.ADDRESS), 0, MAX_MSG + 1, CH$PTR (LAST_ERROR));

    IF NOT SEND_PACKET (MSG_ERROR, .SIZE, .MSG_NUMBER) THEN RETURN KER_ABORTED;

    END;                    ! End of SND_ERROR


%SBTTL 'SERVER - Server mode'

GLOBAL ROUTINE SERVER =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will handle the server function in the v2.0 protocol
!    for KERMIT.  This routine by it's nature will call various operating
!    system routines to do things like logging off the system.
!
! CALLING SEQUENCE:
!
!    EXIT_FLAG = SERVER();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS;                    ! Status returned by various routines

    DO
    BEGIN
    INIT_XFR ();
    XFR_STATUS (%C'T', %C'I');        ! Now idle
    STATUS = DO_TRANSACTION (STATE_ID);
    END
    UNTIL .STATUS EQL KER_EXIT OR .STATUS EQL KER_ABORTED;

    RETURN .STATUS;
    END;                    ! End of GLOBAL ROUTINE SERVER


%SBTTL 'SEND_SWITCH'

GLOBAL ROUTINE SEND_SWITCH =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine is the state table switcher for sending files.  It
!    loops until either it is finished or an error is encountered.  The
!    routines called by SEND_SWITCH are responsible for changing the state.
!
! CALLING SEQUENCE:
!
!    SEND_SWITCH();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    Returns:
!        TRUE - File sent correctly.
!        FALSE - Aborted sending the file.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS;                    ! Status result

    IF .CONNECT_FLAG THEN SY_DISMISS (.DELAY);    ! Sleep if the user wanted us to

    INIT_XFR ();                ! Initialize for this transfer
    TEXT_HEAD_FLAG = FALSE;            ! Set text flag correctly
    XFR_STATUS (%C'I', %C'S');            ! Start of file send
    STATUS = DO_TRANSACTION (STATE_S);        ! Call routine to do real work
    XFR_STATUS (%C'T', %C'S');            ! Done with send
    RETURN .STATUS;                ! Return the result
    END;


%SBTTL 'REC_SWITCH'

GLOBAL ROUTINE REC_SWITCH =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will cause file(s) to be received by the remote
!    KERMIT.  This routine contains the main loop for the sending of the
!    data.
!
! CALLING SEQUENCE:
!
!    REC_SWITCH();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    FILE_DESC - Descriptor describing the file to be received by
!        the remote KERMIT.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    True - File received correctly.
!    FALSE - File transfer aborted.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    INIT_STATE,                ! State to start up DO_TRANSACTION in
    STATUS;                    ! Status returned by various routines

    INIT_STATE = STATE_R;            ! Initialize the state
    MSG_NUMBER = 0;
    INIT_XFR ();                ! Initialize the per transfer info
!
! Determine if they said REC <file-spec>
!    Send MSG_RCV_INIT and then receive the file
!

    IF .FILE_SIZE GTR 0
    THEN
    BEGIN
    GEN_TYPE = MSG_RCV_INIT;        ! Use receive-init message
    CH$MOVE (.FILE_SIZE, CH$PTR (FILE_NAME), CH$PTR (GEN_1DATA));
    GEN_1SIZE = .FILE_SIZE;            ! Save the length
    INIT_STATE = STATE_SI;            ! Start out with server init
    END;

!
! Now receive the file normally
!
    XFR_STATUS (%C'I', %C'R');            ! Start of a file receive
    STATUS = DO_TRANSACTION (.INIT_STATE);
    XFR_STATUS (%C'T', %C'R');            ! End of file receive
    RETURN .STATUS;                ! Return the result
    END;                    ! End of REC_SWITCH


%SBTTL 'Server -- DO_GENERIC - Execute a generic command'

GLOBAL ROUTINE DO_GENERIC (TYPE) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will send a generic command to the remote Kermit.
!    it will do all the processing required for the generic command
!    that was executed.  It will return to the caller after the
!    command has be executed.
!
! CALLING SEQUENCE:
!
!    STATUS = DO_GENERIC (Command-type);
!
! INPUT PARAMETERS:
!
!    Command-type -- Command type to be executed.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    INIT_STATE;                ! Initial state for FSM

!
! Set up the per transfer items
!
    INIT_XFR ();
    NUM_RETRIES = 0;
    MSG_NUMBER = 0;
!
! These are all generic commands
!
    GEN_TYPE = MSG_GENERIC;
!
! Assume we will not need server init
!
    INIT_STATE = STATE_SG;

    CASE .TYPE FROM GC_MIN TO GC_MAX OF
    SET

    [GC_EXIT] :
        GEN_SUBTYPE = MSG_GEN_EXIT;

    [GC_LOGOUT] :
        GEN_SUBTYPE = MSG_GEN_LOGOUT;

    [GC_DIRECTORY] :
        BEGIN
        INIT_STATE = STATE_SI;        ! We will need server-init
        GEN_SUBTYPE = MSG_GEN_DIRECTORY;
        END;

    [GC_DISK_USAGE] :
        BEGIN
        INIT_STATE = STATE_SI;        ! We will need server-init
        GEN_SUBTYPE = MSG_GEN_DISK_USAGE;
        END;

    [GC_DELETE] :
        GEN_SUBTYPE = MSG_GEN_DELETE;

    [GC_TYPE] :
        BEGIN
        INIT_STATE = STATE_SI;        ! We will need server-init
        GEN_SUBTYPE = MSG_GEN_TYPE;
        END;

    [GC_HELP] :
        BEGIN
        INIT_STATE = STATE_SI;        ! We will need server-init
        GEN_SUBTYPE = MSG_GEN_HELP;
        END;

    [GC_LGN] :
        GEN_SUBTYPE = MSG_GEN_LOGIN;    ! Login just gets ACK

    [GC_CONNECT] :
        GEN_SUBTYPE = MSG_GEN_CONNECT;    ! CWD just gets ACK

    [GC_RENAME] :
        GEN_SUBTYPE = MSG_GEN_RENAME;    ! Rename file just needs ACK

    [GC_COPY] :
        GEN_SUBTYPE = MSG_GEN_COPY;        ! Copy file just needs ACK

    [GC_WHO] :
        BEGIN
        INIT_STATE = STATE_SI;        ! May get large response
        GEN_SUBTYPE = MSG_GEN_WHO;
        END;

    [GC_SEND_MSG] :
        GEN_SUBTYPE = MSG_GEN_SEND;        ! Just need an ACK

    [GC_STATUS] :
        BEGIN
        INIT_STATE = STATE_SI;        ! May get large response
        GEN_SUBTYPE = MSG_GEN_QUERY;
        END;

    [GC_COMMAND] :
        BEGIN
        INIT_STATE = STATE_SI;        ! Large response likely
        GEN_TYPE = MSG_COMMAND;        ! This is host command
        END;

    [GC_KERMIT] :
        GEN_TYPE = MSG_KERMIT;        ! Perform Kermit command (short response)

    [GC_PROGRAM] :
        BEGIN
        INIT_STATE = STATE_SI;        ! Assume large response
        GEN_SUBTYPE = MSG_GEN_PROGRAM;    ! Generic program command
        END;

    [GC_JOURNAL] :
        GEN_SUBTYPE = MSG_GEN_JOURNAL;    ! Do journal function (short reply)

    [GC_VARIABLE] :
        GEN_SUBTYPE = MSG_GEN_VARIABLE;    ! Set or get a variable value

    [INRANGE, OUTRANGE] :
        BEGIN
        KRM_ERROR (KER_UNIMPLGEN);
        RETURN STATE_A;
        END;
    TES;

    RETURN DO_TRANSACTION (.INIT_STATE);    ! Go do the command
    END;                    ! End of DO_GENERIC


%SBTTL 'DO_TRANSACTION - Main loop for FSM'
ROUTINE DO_TRANSACTION (INIT_STATE) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This is the main routine for performing a Kermit transaction.
!    It is structured as a finite state machine with each state
!    determining the next based upon the packet which is received.
!    It is supplied with the initial state by the caller.
!
! CALLING SEQUENCE:
!
!    Status = DO_TRANSACTION(.INIT_STATE);
!
! INPUT PARAMETERS:
!
!    INIT_STATE - Initial state.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    RETURN_VALUE;

    NUM_RETRIES = 0;                ! Initialize the number of retries
    STATE = .INIT_STATE;            ! Initialize the state

    WHILE TRUE DO

    CASE .STATE FROM STATE_MIN TO STATE_MAX OF
        SET
!
! Send states
!

        [STATE_ID] :
!
! Server while idle.  Set the timeout to twice the normal wait
! and wait for something to show up
!
        BEGIN

        LOCAL
            SAVED_TIMEOUT;

        SAVED_TIMEOUT = .SEND_TIMEOUT;

        IF .SEND_TIMEOUT NEQ 0 THEN SEND_TIMEOUT = .SRV_TIMEOUT;

        STATE = REC_SERVER_IDLE ();
        SEND_TIMEOUT = .SAVED_TIMEOUT;
        END;

        [STATE_II] :
!
! Here while server idle after having received a server-init packet
!
        STATE = REC_SERVER_IDLE ();

        [STATE_FI, STATE_LG] :
!
! Here when we are supposed to exit
!
        RETURN KER_EXIT;

        [STATE_SD] :
        STATE = SEND_DATA ();

        [STATE_SF] :
        STATE = SEND_FILE ();

        [STATE_SZ] :
        STATE = SEND_EOF ();

        [STATE_S] :
        STATE = SEND_INIT ();

        [STATE_OF] :
        STATE = SEND_OPEN_FILE ();

        [STATE_SI] :
        STATE = SEND_SERVER_INIT ();

        [STATE_SG] :
        STATE = SEND_GENCMD ();

        [STATE_SB] :
        STATE = SEND_BREAK ();
!
! Receiving of the data and the end of file message.
!

        [STATE_RD] :
        STATE = REC_DATA ();
!
! Receiving the FILE information of the break to end the transfer of
! one or more files
!

        [STATE_RF] :
        STATE = REC_FILE ();
!
! Initialization for the receiving of a file
!

        [STATE_R] :
        STATE = REC_INIT ();
!
! Here if we have completed the receiving of the file
!

        [STATE_C] :
        BEGIN
        RETURN_VALUE = TRUE;
        EXITLOOP;
        END;
!
! Here if we aborted the transfer or we have gotten into some random
! state (internal KERMSG problem).
!

        [STATE_A, STATE_EX, STATE_ER, INRANGE, OUTRANGE] :
        BEGIN
        RETURN_VALUE = FALSE;

        IF .STATE EQL STATE_EX THEN RETURN_VALUE = KER_ABORTED;

        !
        ! Determine if the file is still open and if so close it
        !

        IF .FILE_OPEN_FLAG
        THEN
            BEGIN
            FILE_OPEN_FLAG = FALSE;

            IF ( NOT .CONNECT_FLAG) AND .TY_FIL
            THEN
            BEGIN
            TT_TEXT (UPLIT (%ASCIZ' [Aborted]'));
            TT_CRLF ();
            END;

            FILE_CLOSE (.ABT_FLAG AND (.STATE EQL STATE_A OR .STATE EQL STATE_EX OR .STATE
            EQL STATE_ER));
            XFR_STATUS (%C'F', %C'A');
            END;

!
! Give error if aborted due to too many retries
!

        IF .STATE EQL STATE_ER THEN KRM_ERROR (KER_RETRIES);

        EXITLOOP;
        END;
        TES;

!
! End the stats and return to the caller
!
    END_STATS ();
!
    RETURN .RETURN_VALUE;
    END;                    ! End of DO_TRANSACTION

%SBTTL 'REC_SERVER_IDLE - Idle server state'
ROUTINE REC_SERVER_IDLE =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called from DO_TRANSACTION when is the server idle
! state.  It will receive a message and properly dispatch to the new
! state.
!
! CALLING SEQUENCE:
!
!    STATE = REC_SERVER_IDLE ();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    Almost everything.
!
! OUPTUT PARAMETERS:
!
!    Routine value is new state for FSM
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS;

    STATUS = REC_PACKET ();
!
! Now determine what to do by the type of message we have receive.
!

    IF .STATUS EQL KER_ABORTED THEN RETURN STATE_EX;

    IF .STATUS
    THEN
    BEGIN

    SELECTONE .REC_TYPE OF
        SET
        !
        ! Server initialization message received. ACK the
        ! message and continue.
        !

        [MSG_SER_INIT] :
        BEGIN

        IF (STATUS = PRS_SEND_INIT ())
        THEN
            BEGIN
            SET_SEND_INIT ();

            IF (STATUS = SEND_PACKET (MSG_ACK, P_SI_LENGTH, .REC_SEQ))
            THEN
            BEGIN
            SND_PKT_SIZE = -.SEND_PKT_SIZE;
            SND_TIMEOUT = -.SEND_TIMEOUT;
            SND_NPAD = -.SEND_NPAD;
            SND_PADCHAR = -.SEND_PADCHAR;
            SND_EOL = -.SEND_EOL;
            SND_QUOTE_CHR = -.SEND_QUOTE_CHR;
            RCV_8QUOTE_CHR = .SEND_8QUOTE_CHR;
            CHKTYPE = .INI_CHK_TYPE;
            SET_REPT_CHR = .REPT_CHR;
            RETURN STATE_II;    ! Now idle after INIT
            END;

            END;

        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;
        !
        ! Send init message received.  We must ACK the message and
        ! then attempt to receive a file from the remote.
        !

        [MSG_SND_INIT] :
        BEGIN
        MSG_NUMBER = (.REC_SEQ + 1) AND %O'77';

        IF (STATUS = PRS_SEND_INIT ())
        THEN
            BEGIN
            SET_SEND_INIT ();
            !
            ! ACK the message then receive everything.
            !

            IF SEND_PACKET (MSG_ACK, P_SI_LENGTH, .REC_SEQ)
            THEN
            BEGIN
            BLK_CHK_TYPE = .INI_CHK_TYPE;    ! Switch to desired form of block check
            XFR_STATUS (%C'I', %C'R');    ! Start of file receive
            RETURN STATE_RF;
            END;

            END;

        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;
        !
        ! Here if we receive a receive init message.
        ! We will be sending a file to the other end.
        !

        [MSG_RCV_INIT] :
        BEGIN
        !
        ! Move the file specification if we received one
        !
        SET_STRING (CH$PTR (FILE_NAME), MAX_FILE_NAME, TRUE);
        BFR_EMPTY ();
        FILE_SIZE = SET_STRING (0, 0, FALSE);
        CH$WCHAR (CHR_NUL, CH$PTR (FILE_NAME, .FILE_SIZE));

        IF .FILE_SIZE GTR 0
        THEN
            BEGIN
            XFR_STATUS (%C'I', %C'S');    ! Start of a file send
            RETURN STATE_S;
            END;

        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;
!
! Generic KERMIT commands
!

        [MSG_GENERIC] :
        RETURN SERVER_GENERIC ();
!
! Host command
!

        [MSG_COMMAND] :
        RETURN HOST_COMMAND ();
!
! Kermit command
!

        [MSG_KERMIT] :
        RETURN KERMIT_COMMAND ();
!
! Unimplimented server routines
!

        [OTHERWISE] :
        BEGIN
        KRM_ERROR (KER_UNISRV);
        RETURN STATE_A;
        END;
        TES;

    END;

!
! If we get here, we must have gotten something random.  Therefore,
! just send a NAK and remain in the current state (unless we have done this
! too many times).
!
    NUM_RETRIES = .NUM_RETRIES + 1;

    IF .NUM_RETRIES GTR .SI_RETRIES THEN RETURN STATE_A;

    IF SEND_PACKET (MSG_NAK, 0, 0) THEN RETURN .STATE ELSE RETURN STATE_EX;

    END;                    ! End of REC_SERVER_IDLE

%SBTTL 'SEND_SERVER_INIT'
ROUTINE SEND_SERVER_INIT =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will send a server initialization message to the
!    remote KERMIT.
!
! CALLING SEQUENCE:
!
!    STATE = SEND_SERVER_INIT();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    RECV_xxx - desired receive parameters
!
! OUTPUT PARAMETERS:
!
!    New state to change the finite state machine to.
!
! IMPLICIT OUTPUTS:
!
!    SEND_xxx - Other Kermit's desired parameters
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    OLD_OUTPUT,                ! Saved terminal output routine
    STATUS;                    ! Status returned by various routines

![026] Local routine to ignore error message output
    ROUTINE IGNORE_ERROR (ADDRESS, LENGTH) =
    BEGIN
    RETURN TRUE;
    END;
    SET_SEND_INIT ();
![026] If too many tries, just give up.  Maybe the other Kermit doesn't
![026] know what to do with this packet.

    IF .NUM_RETRIES GTR .SI_RETRIES THEN RETURN STATE_ER;

![026]
![026] Count the number of times we try this
![026]
    NUM_RETRIES = .NUM_RETRIES + 1;

    IF NOT SEND_PACKET (MSG_SER_INIT, P_SI_LENGTH, .MSG_NUMBER) THEN RETURN STATE_A;

![026]
![026] Determine if we received a packet it good condition.  If we timed out
![026] just try again.  If we get an error packet back, ignore it and
![026] just continue.  The other Kermit must not support this packet.
![026]
    OLD_OUTPUT = TT_SET_OUTPUT (IGNORE_ERROR);
    STATUS = REC_PACKET ();
    TT_OUTPUT ();
    TT_SET_OUTPUT (.OLD_OUTPUT);

    IF .STATUS EQL KER_ERRMSG THEN RETURN STATE_SG;

    IF NOT .STATUS
    THEN

    IF NOT ((.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL
        KER_CHKSUMERR))
    THEN
        RETURN STATE_EX
    ELSE
        RETURN .STATE;

!
! Determine if the packet is good.
!

    IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ EQL .MSG_NUMBER
    THEN
    BEGIN
!
! Here if we have an ACK for the initialization message that was just sent
! to the remote KERMIT.
!

    IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN STATE_A;

    NUM_RETRIES = 0;
    INIT_PKT_SENT = TRUE;            ! We have exchanged init's
    RETURN STATE_SG;
    END;

!
! If we haven't returned yet, we must have gotten an invalid response.
! Just stay in the same state so we try again
!
    RETURN .STATE;
    END;

%SBTTL 'SEND_DATA'
ROUTINE SEND_DATA =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will send a data message to the remote KERMIT.
!
! CALLING SEQUENCE:
!
!    STATE = SEND_DATA();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    New state to change the finite state machine to.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    SUB_TYPE,                ! Subtype for XFR_STATUS call
    STATUS;                    ! Status returned by various routines

!
! If there is nothing in the data packet, we should not bother to send it.
! Instead, we will just call BFR_FILL again to get some more data
!

    IF .SIZE GTR 0
    THEN
    BEGIN
!
! Check to see if the number of retries have been exceeded.
!

    IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;

!
! Not exceeded yet.  Increment the number of retries we have attempted
! on this message.
!
    NUM_RETRIES = .NUM_RETRIES + 1;
!
! Attempt to send the packet and abort if the send fails.
!

    IF NOT SEND_PACKET (MSG_DATA, .SIZE, .MSG_NUMBER) THEN RETURN STATE_EX;

!
! Attempt to receive a message from the remote KERMIT.
!
    STATUS = REC_PACKET ();

    IF NOT .STATUS
    THEN
        BEGIN

        IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL
        KER_CHKSUMERR)
        THEN
        RETURN .STATE
        ELSE
        RETURN STATE_EX;

        END;

!
! Determine if the message is a NAK and the NAK is for the message number
! that we are current working on.  If the NAK is for the next packet then
! treat it like an ACK for this packet
!

    IF .REC_TYPE EQL MSG_NAK AND (.REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77'))
    THEN
        RETURN .STATE;

!
! Make sure we have a NAK or ACK
!

    IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK)
    THEN
!
! Not an ACK or NAK, abort.
!
        BEGIN
        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;

!
! Is this for this message?
!

    IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE;

!
! It was.  Set up for sending the next data message to the remote KERMIT
! and return.
!
!
! Check for data field in ACK indicating abort file or stream
!
!

    IF .REC_TYPE EQL MSG_ACK AND .REC_LENGTH EQL 1
    THEN

        SELECTONE CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE)) OF
        SET

        [MSG_ACK_ABT_CUR] :
            ABT_CUR_FILE = TRUE;

        [MSG_ACK_ABT_ALL] :
            ABT_ALL_FILE = TRUE;
        TES;

    NUM_RETRIES = 0;
    MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
    END;                    ! End of IF .SIZE GTR 0

    IF (BFR_FILL (FALSE) EQL KER_NORMAL) AND NOT (.ABT_CUR_FILE OR .ABT_ALL_FILE)
    THEN
    RETURN STATE_SD
    ELSE
    BEGIN

    IF ( NOT .CONNECT_FLAG) AND .TY_FIL
    THEN
        BEGIN

        IF .ABT_ALL_FILE
        THEN
        TT_TEXT (UPLIT (%ASCIZ' [Group interrupted]'))
        ELSE

        IF .ABT_CUR_FILE
        THEN
            TT_TEXT (UPLIT (%ASCIZ' [Interrupted]'))
        ELSE
            TT_TEXT (UPLIT (%ASCIZ' [OK]'));

        TT_CRLF ();
        END;

    IF .FILE_OPEN_FLAG THEN FILE_CLOSE (FALSE);

    SUB_TYPE = %C'C';            ! Assume ok

    IF .ABT_ALL_FILE
    THEN
        SUB_TYPE = %C'Z'
    ELSE

        IF .ABT_CUR_FILE THEN SUB_TYPE = %C'X';

    XFR_STATUS (%C'F', .SUB_TYPE);
    FILE_OPEN_FLAG = FALSE;
    RETURN STATE_SZ;
    END;

    END;

%SBTTL 'SEND_FILE'
ROUTINE SEND_FILE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will send the file specification that is being
!    transfered, or it will send a text header message.
!
! CALLING SEQUENCE:
!
!    STATE = SEND_FILE();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    TEXT_HEAD_FLAG - If true, send text header instead of file header
!
! OUTPUT PARAMETERS:
!
!    New state to change the finite state machine to.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    M_TYPE,                    ! Message type to send
    STATUS;                    ! Status returned by various routines

!
! Flag we don't want to abort yet
!
    ABT_CUR_FILE = FALSE;
    ABT_ALL_FILE = FALSE;
!
! First determine if we have exceed the number of retries that are
! allowed to attempt to send this message.
!

    IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;

!
! The number of retries are not exceeded.  Increment the number and then
! attempt to send the packet again.
!
    NUM_RETRIES = .NUM_RETRIES + 1;
    SIZE = 0;                    ! Assume no name

    IF .TEXT_HEAD_FLAG THEN M_TYPE = MSG_TEXT ELSE M_TYPE = MSG_FILE;

    IF .FILE_SIZE NEQ 0 AND NOT .NO_FILE_NEEDED
    THEN
    BEGIN
![025]    CH$MOVE (.FILE_SIZE, CH$PTR (FILE_NAME),
![025]        CH$PTR (SND_MSG, PKT_MSG,
![025]        CHR_SIZE));
![025]
![025] Fill packet with file name
![025]
    SET_STRING (CH$PTR (FILE_NAME), .FILE_SIZE, TRUE);
    BFR_FILL (TRUE);
    SET_STRING (0, 0, FALSE);
    END;

    IF NOT SEND_PACKET (.M_TYPE, .SIZE, .MSG_NUMBER) THEN RETURN STATE_EX;

!
! Now get the responce from the remote KERMIT.
!
    STATUS = REC_PACKET ();

    IF NOT .STATUS
    THEN
    BEGIN

    IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR)
    THEN
        RETURN .STATE
    ELSE
        RETURN STATE_EX;

    END;

!
! Determine if the packet is good.
!

    IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK)
    THEN
    BEGIN
    KRM_ERROR (KER_PROTOERR);
    RETURN STATE_A;
    END;

!
! If this is a NAK and the message number is not the one we just send
! treat this like an ACK, otherwise resend the last packet.
!

    IF .REC_TYPE EQL MSG_NAK AND (.REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77')) THEN RETURN .STATE;

    IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE;

!
! If all is ok, bump the message number and fill first buffer
!
    NUM_RETRIES = 0;
    MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';

    IF BFR_FILL (TRUE) THEN RETURN STATE_SD ELSE RETURN STATE_A;

    END;                    ! End of SEND_FILE

%SBTTL 'SEND_EOF'
ROUTINE SEND_EOF =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will send the end of file message to the remote
!    KERMIT.  It will then determine if there are more files to
!    send to the remote.
!
! CALLING SEQUENCE:
!
!    STATE = SEND_EOF();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    New state to change the finite state machine to.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    Sets up for the next file to be processed if there is one.
!
!--

    BEGIN

    LOCAL
    STATUS,                    ! Status returned by various routines
    EOF_MSG_LEN;                ! Length of EOF message to send

!
! First determine if we have exceed the number of retries that are
! allowed to attempt to send this message.
!

    IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;

!
! The number of retries are not exceeded.  Increment the number and then
! attempt to send the packet again.
!
    NUM_RETRIES = .NUM_RETRIES + 1;
!
! Store character in packet to indicate discard of file
! Character will only be sent if file should be discarded
!
    CH$WCHAR (MSG_EOF_DISCARD, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE));

    IF .ABT_CUR_FILE OR .ABT_ALL_FILE THEN EOF_MSG_LEN = 1 ELSE EOF_MSG_LEN = 0;

    IF NOT SEND_PACKET (MSG_EOF, .EOF_MSG_LEN, .MSG_NUMBER) THEN RETURN STATE_EX;

!
! Now get the responce from the remote KERMIT.
!
    STATUS = REC_PACKET ();

    IF NOT .STATUS
    THEN
    BEGIN

    IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR)
    THEN
        RETURN .STATE
    ELSE
        RETURN STATE_EX;

    END;

!
! Determine if the packet is good.
!

    IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK)
    THEN
    BEGIN
    KRM_ERROR (KER_PROTOERR);
    RETURN STATE_A;
    END;

!
! If this is a NAK and the message number is not the one we just send
! treat this like an ACK, otherwise resend the last packet.
!

    IF .REC_TYPE EQL MSG_NAK AND (.REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77')) THEN RETURN .STATE;

    IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE;

!
! Here to determine if there is another file to send.
!
    NUM_RETRIES = 0;
    MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';

    IF NOT .ABT_ALL_FILE THEN STATUS = NEXT_FILE () ELSE STATUS = KER_NOMORFILES;

    IF ( NOT .STATUS) OR (.STATUS EQL KER_NOMORFILES)
    THEN
    BEGIN

    IF (.STATUS NEQ KER_NOMORFILES) THEN RETURN STATE_A ELSE RETURN STATE_SB;

    END
    ELSE
    BEGIN
    FILE_OPEN_FLAG = TRUE;            ! Have a file open again

    IF .FIL_NORMAL_FORM THEN NORMALIZE_FILE (FILE_NAME, FILE_SIZE, -1, -1);

    XFR_STATUS (%C'F', %C'S');        ! Inform display routine

    IF ( NOT .CONNECT_FLAG) AND .TY_FIL
    THEN
        BEGIN
        TT_TEXT (UPLIT (%ASCIZ'Sending: '));
        TT_TEXT (FILE_NAME);
        TT_OUTPUT ();
        END;

    FILE_CHARS = 0;                ! No characters sent yet
    RETURN STATE_SF;
    END;

    END;                    ! End of SEND_EOF

%SBTTL 'SEND_INIT'
ROUTINE SEND_INIT =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will send the initialization packet to the remote
!    KERMIT.  The message type sent is S.
!
! CALLING SEQUENCE:
!
!    STATE = SEND_INIT();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    New state to change the finite state machine to.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS;                    ! Status returned by various routines

    SET_SEND_INIT ();

    IF .NUM_RETRIES GTR .SI_RETRIES THEN RETURN STATE_ER;

!
! Count the number of times we try this
!
    NUM_RETRIES = .NUM_RETRIES + 1;

    IF NOT SEND_PACKET (MSG_SND_INIT, P_SI_LENGTH, .MSG_NUMBER) THEN RETURN STATE_EX;

!
! Determine if we received a packet it good condition.  If we timed out or
! got an illegal message, just try again.
!
    STATUS = REC_PACKET ();

    IF NOT .STATUS
    THEN
    BEGIN

    IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR)
    THEN
        RETURN .STATE
    ELSE
        RETURN STATE_EX;

    END;

!
! Determine if the packet is good.
!

    IF .REC_TYPE NEQ MSG_ACK THEN RETURN .STATE;

    IF .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE;

!
! Here if we have an ACK for the initialization message that was just sent
! to the remote KERMIT.
!

    IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN STATE_A;

    BLK_CHK_TYPE = .INI_CHK_TYPE;        ! We now use agreed upon block check type
    NUM_RETRIES = 0;
    MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
    RETURN STATE_OF;                ! Now need to open the file
    END;

%SBTTL 'SEND_OPEN_FILE - Open file for sending'
ROUTINE SEND_OPEN_FILE =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called from DO_TRANSACTION when the first input file
! needs to be opened.
!
! CALLING SEQUENCE:
!
!    STATE = SEND_OPEN_FILE ();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    FILE_NAME, FILE_SIZE, etc.
!
! OUPTUT PARAMETERS:
!
!    New state for FSM.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    IF ( NOT .CONNECT_FLAG) AND .TY_FIL
    THEN
    BEGIN
    TT_TEXT (UPLIT (%ASCIZ'Sending: '));
    TT_OUTPUT ();
    END;

    FILE_CHARS = 0;                ! No characters sent yet

    IF NOT .NO_FILE_NEEDED
    THEN

    IF NOT FILE_OPEN (FNC_READ) THEN RETURN STATE_A ELSE FILE_OPEN_FLAG = TRUE;

![023]
![023] If we want normalized file names, beat up the name now
![023]

    IF .FIL_NORMAL_FORM THEN NORMALIZE_FILE (FILE_NAME, FILE_SIZE, -1, -1);

    XFR_STATUS (%C'F', %C'S');            ! Inform display routine

    IF ( NOT .CONNECT_FLAG) AND .TY_FIL
    THEN
    BEGIN
    TT_TEXT (FILE_NAME);
    TT_OUTPUT ();
    END;

    RETURN STATE_SF;
    END;                    ! End of FSM_OPEN_FILE

%SBTTL 'SEND_GENCMD'
ROUTINE SEND_GENCMD =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will send a command packet to the server Kermit.
!    The new state will depend upon the response.  If a send-init
!    is received, it will process it and switch to STATE_RF.
!    If a text-header is received it will switch to STATE_RD.
!    If an ACK is received, it will type the data portion and
!    switch to STATE_C.
!
! CALLING SEQUENCE:
!
!    STATE = SEND_GENCMD();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    GEN_TYPE - Message type to send (normally MSG_GENERIC)
!    GEN_SUBTYPE - Message subtype (only if MSG_GENERIC)
!    GEN_1DATA - First argument string
!    GEN_1SIZE - Size of first argument
!    GEN_2DATA - Second argument string
!    GEN_2SIZE - Size of second argument
!    GEN_3DATA - Third argument string
!    GEN_3SIZE - Size of third argument
!
! OUTPUT PARAMETERS:
!
!    New state for the finite state machine.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    POINTER,                ! Pointer at DATA_TEXT
    DATA_TEXT : VECTOR [CH$ALLOCATION (MAX_MSG)],    ! Data buffer
    DATA_SIZE,                ! Length of data buffer used
    STATUS;                    ! Status returned by various routines

    ROUTINE PACK_DATA (POINTER, LENGTH, SRC_ADDR, SRC_LEN) =
!
! Routine to pack an argument into the buffer.
!
    BEGIN

    IF .SRC_LEN GTR MAX_MSG - .LENGTH - 1 THEN SRC_LEN = MAX_MSG - .LENGTH - 1;

    LENGTH = .LENGTH + .SRC_LEN + 1;
    CH$WCHAR_A (CHAR (.SRC_LEN), .POINTER);
    .POINTER = CH$MOVE (.SRC_LEN, CH$PTR (.SRC_ADDR), ..POINTER);
    RETURN .LENGTH;
    END;
!
! First determine if we have exceed the number of retries that are
! allowed to attempt to send this message.
!

    IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;

!
! The number of retries are not exceeded.  Increment the number and then
! attempt to send the packet again.
!
    NUM_RETRIES = .NUM_RETRIES + 1;
!
! Build the packet data field
!
    POINTER = CH$PTR (DATA_TEXT);
    DATA_SIZE = 0;

    IF .GEN_TYPE EQL MSG_GENERIC
    THEN
    BEGIN
    CH$WCHAR_A (.GEN_SUBTYPE, POINTER);
    DATA_SIZE = 1;

    IF .GEN_1SIZE GTR 0 OR .GEN_2SIZE GTR 0 OR .GEN_3SIZE GTR 0
    THEN
        BEGIN
        DATA_SIZE = PACK_DATA (POINTER, .DATA_SIZE, GEN_1DATA, .GEN_1SIZE);

        IF .GEN_2SIZE GTR 0 OR .GEN_3SIZE GTR 0
        THEN
        BEGIN
        DATA_SIZE = PACK_DATA (POINTER, .DATA_SIZE, GEN_2DATA, .GEN_2SIZE);

        IF .GEN_3SIZE GTR 0
        THEN
            BEGIN
            DATA_SIZE = PACK_DATA (POINTER, .DATA_SIZE, GEN_3DATA, .GEN_3SIZE);
            END;

        END;

        END;

    END
    ELSE
    BEGIN

    IF .GEN_1SIZE GTR MAX_MSG THEN GEN_1SIZE = MAX_MSG;

    DATA_SIZE = .GEN_1SIZE;
    CH$MOVE (.GEN_1SIZE, CH$PTR (GEN_1DATA), .POINTER);
    END;

    SET_STRING (CH$PTR (DATA_TEXT), .DATA_SIZE, TRUE);
    BFR_FILL (TRUE);
    SET_STRING (0, 0, FALSE);
!
! Send the packet
!

    IF NOT SEND_PACKET (.GEN_TYPE, .SIZE, .MSG_NUMBER) THEN RETURN STATE_EX;

!
! Now get the responce from the remote KERMIT.
!
    STATUS = REC_PACKET ();

    IF NOT .STATUS
    THEN
    BEGIN

    IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR)
    THEN
        RETURN .STATE
    ELSE
        RETURN STATE_EX;

    END;

! Did we get a send-init?

    SELECTONE .REC_TYPE OF
    SET

    [MSG_SND_INIT] :
        BEGIN
        MSG_NUMBER = .REC_SEQ;        ! Initialize sequence numbers
! Determine if the parameters are ok.  If not, give up

        IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN .STATUS;

        SET_SEND_INIT ();            ! Set up our acknowledgement to the send-init
        SEND_PACKET (MSG_ACK, P_SI_LENGTH, .MSG_NUMBER);    ! Send it
        BLK_CHK_TYPE = .INI_CHK_TYPE;    ! Can now use agreed upon type
        OLD_RETRIES = .NUM_RETRIES;
        NUM_RETRIES = 0;
        MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
        RETURN STATE_RF;            ! Now expect file header
        END;

    [MSG_TEXT] :
!
! If we just got a text header, set up for typing on the terminal and
! shift to receiving data
!
        BEGIN
        TEXT_HEAD_FLAG = TRUE;        ! We want terminal output
        PUT_CHR_ROUTINE = TYPE_CHAR;    ! Set up the put a character routine

        IF .REC_LENGTH GTR 0
        THEN
        BEGIN
        TT_TEXT (UPLIT (%ASCIZ'<<'));    ! Make sure file name sticks out
        BFR_EMPTY ();            ! Dump the packet data to the terminal
        TT_TEXT (UPLIT (%ASCIZ'>>'));    ! So user can tell where name ends
        TT_CRLF ();            ! And a CRLF
        END;

        SEND_PACKET (MSG_ACK, 0, .MSG_NUMBER);    ! Send an ACK
        OLD_RETRIES = .NUM_RETRIES;
        NUM_RETRIES = 0;
        MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
        RETURN STATE_RD;            ! We now want data
        END;

    [MSG_ACK] :
!
! If we get an ACK, just type the data on the terminal and complete the
! transaction.
!
        BEGIN
        PUT_CHR_ROUTINE = TYPE_CHAR;    ! Dump to terminal
        BFR_EMPTY ();            ! Do it

        IF .REC_LENGTH GTR 0 THEN TT_CRLF ();

        RETURN STATE_C;            ! And go idle
        END;

    [MSG_NAK] :
!
! If we get a NAK, stay in the same state.  We will re-transmit the
! packet again.
!
        RETURN .STATE;
    TES;

!
! If we get here, we didn't get anything resembling an acceptable
! packet, so we will abort.
!
    KRM_ERROR (KER_PROTOERR);
    RETURN STATE_A;
    END;

%SBTTL 'SEND_BREAK'
ROUTINE SEND_BREAK =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will send the break (end of transmission) message
!    to the remote KERMIT.  On an ACK the state becomes STATE_C.
!
! CALLING SEQUENCE:
!
!    STATE = SEND_BREAK();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    New state for the finite state machine.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS;                    ! Status returned by various routines

!
! First determine if we have exceed the number of retries that are
! allowed to attempt to send this message.
!

    IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;

!
! The number of retries are not exceeded.  Increment the number and then
! attempt to send the packet again.
!
    NUM_RETRIES = .NUM_RETRIES + 1;

    IF NOT SEND_PACKET (MSG_BREAK, 0, .MSG_NUMBER) THEN RETURN STATE_EX;

!
! Now get the responce from the remote KERMIT.
!
    STATUS = REC_PACKET ();

    IF NOT .STATUS
    THEN
    BEGIN

    IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR)
    THEN
        RETURN .STATE
    ELSE
        RETURN STATE_EX;

    END;

!
! Determine if the packet is good.
!

    IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK)
    THEN
    BEGIN
    KRM_ERROR (KER_PROTOERR);
    RETURN STATE_A;
    END;

!
! If this is a NAK and the message number is not the one we just send
! treat this like an ACK, otherwise resend the last packet.
!

    IF .REC_TYPE EQL MSG_NAK AND .REC_SEQ NEQ 0 THEN RETURN .STATE;

    IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE;

!
! Here to determine if there is another file to send.
!
    NUM_RETRIES = 0;
    MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
    RETURN STATE_C;
    END;

%SBTTL 'REC_INIT'
ROUTINE REC_INIT =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will process an initialization message received from
!    the remote KERMIT.
!
! CALLING SEQUENCE:
!
!    STATE = REC_INIT();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    New machine state.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS;                    ! Status returned by various routines

    ROUTINE CHECK_INIT =
    BEGIN

    IF .REC_TYPE EQL MSG_SND_INIT THEN RETURN TRUE ELSE RETURN FALSE;

    END;

    IF NOT (STATUS = REC_MESSAGE (CHECK_INIT))
    THEN

    IF .STATUS NEQ KER_ABORTED THEN RETURN STATE_A ELSE RETURN STATE_EX;

    MSG_NUMBER = .REC_SEQ;

    IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN STATE_A;

    SET_SEND_INIT ();
    SEND_PACKET (MSG_ACK, P_SI_LENGTH, .MSG_NUMBER);
    BLK_CHK_TYPE = .INI_CHK_TYPE;        ! Can now use agreed upon type
    OLD_RETRIES = .NUM_RETRIES;
    NUM_RETRIES = 0;
    MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
    RETURN STATE_RF;
    END;                    ! End of REC_INIT

%SBTTL 'REC_FILE'
ROUTINE REC_FILE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine expects to receive an MSG_FILE packet from the remote
!    KERMIT.  If the message is correct this routine will change the state
!    to STATE_RD.
!
!    This routine also expects MSG_SND_INIT, MSG_EOF, or MSG_BREAK.
!
! CALLING SEQUENCE:
!
!    STATE = REC_FILE();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    New state.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS;

    ROUTINE CHECK_FILE =
    BEGIN

    IF (.REC_TYPE EQL MSG_SND_INIT) OR (.REC_TYPE EQL MSG_EOF) OR (.REC_TYPE EQL MSG_FILE) OR (
        .REC_TYPE EQL MSG_BREAK) OR (.REC_TYPE EQL MSG_TEXT)
    THEN
        RETURN TRUE
    ELSE
        RETURN FALSE;

    END;
!
! Initialize the abort flags
!
    ABT_CUR_FILE = FALSE;
    ABT_ALL_FILE = FALSE;
!
! Get a message
!

    IF NOT (STATUS = REC_MESSAGE (CHECK_FILE))
    THEN

    IF .STATUS NEQ KER_ABORTED THEN RETURN STATE_A ELSE RETURN STATE_EX;

    SELECTONE .REC_TYPE OF
    SET

    [MSG_SND_INIT] :
        BEGIN

        IF .OLD_RETRIES GTR .SI_RETRIES THEN RETURN STATE_ER;

        OLD_RETRIES = .OLD_RETRIES + 1;

        IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ
        THEN
        BEGIN
        SET_SEND_INIT ();
        BLK_CHK_TYPE = CHK_1CHAR;    ! Must use 1 character CHKSUM
        SEND_PACKET (MSG_ACK, P_SI_LENGTH, .REC_SEQ);
        BLK_CHK_TYPE = .INI_CHK_TYPE;    ! Back to agreed upon type
        NUM_RETRIES = 0;
        RETURN .STATE;
        END
        ELSE
        BEGIN
        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;

        END;

    [MSG_EOF] :
        BEGIN

        IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;

        OLD_RETRIES = .OLD_RETRIES + 1;

        IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ
        THEN
        BEGIN
        SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
        NUM_RETRIES = 0;
        RETURN .STATE;
        END
        ELSE
        BEGIN
        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;

        END;

    [MSG_FILE] :
        BEGIN

        IF .MSG_NUMBER NEQ .REC_SEQ THEN RETURN STATE_ER;

        IF .REC_LENGTH EQL 0
        THEN
        BEGIN
        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;

![025]
![025] Get file name from packet with all quoting undone
![025]
        SET_STRING (CH$PTR (FILE_NAME), MAX_FILE_NAME, TRUE);
        BFR_EMPTY ();
        FILE_SIZE = SET_STRING (0, 0, FALSE);
        CH$WCHAR (CHR_NUL, CH$PTR (FILE_NAME, .FILE_SIZE));
![025]        FILE_SIZE = .REC_LENGTH;
![025]        CH$COPY (.REC_LENGTH, CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE), CHR_NUL, MAX_FILE_NAME,
![025]        CH$PTR (FILE_NAME));

        IF ( NOT .CONNECT_FLAG) AND .TY_FIL
        THEN
        BEGIN
        TT_TEXT (UPLIT (%ASCIZ'Receiving: '));
        TT_TEXT (FILE_NAME);
        TT_OUTPUT ();
        END;

![023]
![023] Force file name into normal form if desired
![023]

        IF .FIL_NORMAL_FORM THEN NORMALIZE_FILE (FILE_NAME, FILE_SIZE, 9, 3);

        FILE_CHARS = 0;            ! No characters received yet

        IF NOT FILE_OPEN (FNC_WRITE) THEN RETURN STATE_A;

        XFR_STATUS (%C'F', %C'R');        ! Tell display routine
        TEXT_HEAD_FLAG = FALSE;        ! Got an F, not an X
        FILE_OPEN_FLAG = TRUE;
        SEND_PACKET (MSG_ACK, 0, .MSG_NUMBER);
        OLD_RETRIES = .NUM_RETRIES;
        NUM_RETRIES = 0;
        MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
        RETURN STATE_RD;
        END;

    [MSG_TEXT] :
!
! If we get a text header, we will want to type the data on
! the terminal.  Set up the put a character routine correctly.
!
        BEGIN

        IF .MSG_NUMBER NEQ .REC_SEQ
        THEN
        BEGIN
        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;

        TEXT_HEAD_FLAG = TRUE;        ! Got an X, not an F
        PUT_CHR_ROUTINE = TYPE_CHAR;    ! Empty buffer on terminal

        IF .REC_LENGTH GTR 0
        THEN
        BEGIN
        TT_TEXT (UPLIT (%ASCIZ'<<'));    ! Make file name stick out
        BFR_EMPTY ();            ! Do the header data
        TT_TEXT (UPLIT (%ASCIZ'>>'));
        TT_CRLF ();            ! And a crlf
        END;

        SEND_PACKET (MSG_ACK, 0, .MSG_NUMBER);
        OLD_RETRIES = .NUM_RETRIES;
        NUM_RETRIES = 0;
        MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
        RETURN STATE_RD;
        END;

    [MSG_BREAK] :
        BEGIN

        IF .MSG_NUMBER NEQ .REC_SEQ
        THEN
        BEGIN
        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;

        SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
        RETURN STATE_C;
        END;

    [OTHERWISE] :
        BEGIN
        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;
    TES;

    END;                    ! End of REC_FILE

%SBTTL 'REC_DATA'
ROUTINE REC_DATA =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will accept data messages and write them to disk.
! It will also accept MSG_FILE, MSG_TEXT and MSG_EOF messages.
!
! CALLING SEQUENCE:
!
!    STATE = REC_DATA();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    New state for the finite state machine.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS;

    ROUTINE CHECK_DATA =
    BEGIN

    IF .REC_TYPE EQL MSG_DATA OR (.REC_TYPE EQL MSG_FILE AND NOT .TEXT_HEAD_FLAG) OR .REC_TYPE
        EQL MSG_EOF OR (.REC_TYPE EQL MSG_TEXT AND .TEXT_HEAD_FLAG)
    THEN
        RETURN TRUE
    ELSE
        RETURN FALSE;

    END;

    LOCAL
    SUB_TYPE,                ! Subtype for XFR_STATUS
    DISCARD_FILE_FLAG,            ! Sender requested discard
    ACK_MSG_LEN;                ! Length of ACK to send

!
! First get a message
!

    IF NOT (STATUS = REC_MESSAGE (CHECK_DATA))
    THEN

    IF .STATUS NEQ KER_ABORTED THEN RETURN STATE_A ELSE RETURN STATE_EX;

    SELECTONE .REC_TYPE OF
    SET

    [MSG_DATA] :
        BEGIN

        IF .MSG_NUMBER NEQ .REC_SEQ
        THEN
        BEGIN

        IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;

        OLD_RETRIES = .OLD_RETRIES + 1;

        IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ
        THEN
            BEGIN
            SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
            NUM_RETRIES = 0;
            RETURN .STATE;
            END
        ELSE
            BEGIN
            KRM_ERROR (KER_PROTOERR);
            RETURN STATE_A;
            END;

        END;

!
! Here if we have a message with a valid message number
!

        IF NOT BFR_EMPTY () THEN RETURN STATE_A;

!
! Check if we wish to abort for some reason
!

        IF .ABT_CUR_FILE
        THEN
        BEGIN
        CH$WCHAR (MSG_ACK_ABT_CUR, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE));
        ACK_MSG_LEN = 1;
        END
        ELSE

        IF .ABT_ALL_FILE
        THEN
            BEGIN
            CH$WCHAR (MSG_ACK_ABT_ALL, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE));
            ACK_MSG_LEN = 1;
            END
        ELSE
            ACK_MSG_LEN = 0;

!
! Now send the ACK
!
        SEND_PACKET (MSG_ACK, .ACK_MSG_LEN, .REC_SEQ);
        OLD_RETRIES = .NUM_RETRIES;
        NUM_RETRIES = 0;
        MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
        RETURN STATE_RD;
        END;

    [MSG_FILE, MSG_TEXT] :
        BEGIN

        IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER;

        OLD_RETRIES = .OLD_RETRIES + 1;

        IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ
        THEN
        BEGIN
        SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
        NUM_RETRIES = 0;
        RETURN .STATE;
        END
        ELSE
        BEGIN
        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;

        END;

    [MSG_EOF] :
        BEGIN

        IF .MSG_NUMBER NEQ .REC_SEQ
        THEN
        BEGIN
        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;

        SEND_PACKET (MSG_ACK, 0, .REC_SEQ);

        IF NOT .TEXT_HEAD_FLAG
        THEN
        BEGIN
        FILE_OPEN_FLAG = FALSE;
        DISCARD_FILE_FLAG = FALSE;    ! Assume we want file

        IF .REC_LENGTH EQL 1
        THEN

            IF CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE)) EQL MSG_EOF_DISCARD
            THEN
            DISCARD_FILE_FLAG = TRUE;

        IF ( NOT .CONNECT_FLAG) AND .TY_FIL
        THEN
            BEGIN

            IF .DISCARD_FILE_FLAG
            THEN

            IF .ABT_FLAG
            THEN
                TT_TEXT (UPLIT (%ASCIZ' [Interrupted]'))
            ELSE
                TT_TEXT (UPLIT (%ASCIZ' [Interrupted, partial file saved]'))

            ELSE
            TT_TEXT (UPLIT (%ASCIZ' [OK]'));

            TT_CRLF ();
            END;

        IF NOT FILE_CLOSE (.DISCARD_FILE_FLAG AND .ABT_FLAG) THEN RETURN STATE_A;

        IF .DISCARD_FILE_FLAG
        THEN

            IF .ABT_FLAG THEN SUB_TYPE = %C'X' ELSE SUB_TYPE = %C'D'

        ELSE
            SUB_TYPE = %C'C';

        END
        ELSE
        BEGIN
        TT_CRLF ();            ! Make sure we have a CRLF
        TT_OUTPUT ();            ! And make sure all output is sent
        END;

        XFR_STATUS (%C'F', .SUB_TYPE);
        MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77';
        RETURN STATE_RF;
        END;

    [OTHERWISE] :
        BEGIN
        KRM_ERROR (KER_PROTOERR);
        RETURN STATE_A;
        END;
    TES;

    END;                    ! End of REC_DATA

%SBTTL 'SERVER - Generic commands'
ROUTINE SERVER_GENERIC =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will handle the generic server messages.
!    The generic server messages include FINISH, LOGOUT.
!
! CALLING SEQUENCE:
!
!    STATE = SERVER_GENERIC();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    Generic message receive in REC_MSG.
!
! OUTPUT PARAMETERS:
!
!    Returns new state for FSM
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS,                    ! Returned status
    G_FUNC,                    ! Generic command function
    POINTER,                ! Character pointer
    DATA_TEXT : VECTOR [CH$ALLOCATION (MAX_MSG)],    ! Unpacked message
    DATA_SIZE;                ! Actual size of data

    ROUTINE UNPACK_DATA (POINTER, SIZE, DST_ADDR, DST_LEN) =
!
! Routine to unpack an argument.
! This will copy the argument data to the desired buffer.
!
    BEGIN

    IF .SIZE GTR 0                ! If we have something to unpack
    THEN
        BEGIN
        .DST_LEN = UNCHAR (CH$RCHAR_A (.POINTER));

        IF ..DST_LEN LSS 0
        THEN
        BEGIN
        KRM_ERROR (KER_PROTOERR);    ! Someone screwed up
        ..DST_LEN = 0;
        RETURN -1;
        END;

        IF ..DST_LEN GTR .SIZE - 1 THEN .DST_LEN = .SIZE - 1;

        CH$COPY (..DST_LEN, ..POINTER, CHR_NUL, MAX_MSG, CH$PTR (.DST_ADDR));
        .POINTER = CH$PLUS (..POINTER, ..DST_LEN);
        RETURN .SIZE - ..DST_LEN - 1;
        END
    ELSE
!
! If nothing left in buffer, return the current size (0)
!
        RETURN .SIZE;

    END;
!
! First unpack the message data into its various pieces
!
    SET_STRING (CH$PTR (DATA_TEXT), MAX_MSG, TRUE);    ! Initialize for unpacking
    BFR_EMPTY ();                ! Unpack the data
    DATA_SIZE = SET_STRING (0, 0, FALSE);    ! All done, get size

    IF .DATA_SIZE LEQ 0
    THEN
    BEGIN
    KRM_ERROR (KER_PROTOERR);        ! Someone screwed up
    RETURN STATE_A;                ! Since no subtype
    END;

!
! Get the arguments from the unpacked data (if any)
!
    GEN_1SIZE = 0;                ! Assume no args
    GEN_2SIZE = 0;                ! none at all
    GEN_3SIZE = 0;
    CH$WCHAR (CHR_NUL, CH$PTR (GEN_1DATA));    ! Ensure all are null terminated
    CH$WCHAR (CHR_NUL, CH$PTR (GEN_2DATA));
    CH$WCHAR (CHR_NUL, CH$PTR (GEN_3DATA));
    POINTER = CH$PTR (DATA_TEXT, 1);        ! Point at second character
    DATA_SIZE = .DATA_SIZE - 1;            ! Account for subtype

    IF .DATA_SIZE GTR 0                ! Room for first arg?
    THEN
    BEGIN
    DATA_SIZE = UNPACK_DATA (POINTER, .DATA_SIZE, GEN_1DATA, GEN_1SIZE);

    IF .DATA_SIZE LSS 0 THEN RETURN STATE_A;    ! Punt if bad arguments

    IF .DATA_SIZE GTR 0            ! Second argument present?
    THEN
        BEGIN
        DATA_SIZE = UNPACK_DATA (POINTER, .DATA_SIZE, GEN_2DATA, GEN_2SIZE);

        IF .DATA_SIZE LSS 0 THEN RETURN STATE_A;    ! Punt if bad arguments

        IF .DATA_SIZE GTR 0            ! Third argument here?
        THEN
        BEGIN
        DATA_SIZE = UNPACK_DATA (POINTER, .DATA_SIZE, GEN_3DATA, GEN_3SIZE);

        IF .DATA_SIZE LSS 0 THEN RETURN STATE_A;    ! Punt if bad arguments

        END;

        END;

    END;

    SELECTONE CH$RCHAR (CH$PTR (DATA_TEXT)) OF
    SET
    !
    ! EXIT command, just return the status to the upper level
    !

    [MSG_GEN_EXIT] :
        BEGIN
        SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
        RETURN STATE_FI;
        END;
    !
    ! LOGOUT command, ACK the message then call the system routine to
    ! kill the process (log the job out, etc.)
    !

    [MSG_GEN_LOGOUT] :
        BEGIN
        SEND_PACKET (MSG_ACK, 0, .REC_SEQ);
        SY_LOGOUT ();
        RETURN STATE_LG;
        END;
!
! For a type command, just set up a transfer flagging we want a text header
! instead of a file header.
!

    [MSG_GEN_TYPE] :
        BEGIN
        CH$COPY (.GEN_1SIZE, CH$PTR (GEN_1DATA), CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME));
        FILE_SIZE = .GEN_1SIZE;
        TEXT_HEAD_FLAG = TRUE;        ! Now want text header
        XFR_STATUS (%C'I', %C'G');        ! Tell display routine we are doing a command

        IF .STATE EQL STATE_II AND .BLK_CHK_TYPE EQL .INI_CHK_TYPE
        THEN
        RETURN STATE_OF            ! Must open the file
        ELSE
        RETURN STATE_S;            ! Start the transaction with a send

        END;

    [MSG_GEN_DIRECTORY] :
        G_FUNC = GC_DIRECTORY;

    [MSG_GEN_DISK_USAGE] :
        G_FUNC = GC_DISK_USAGE;

    [MSG_GEN_DELETE] :
        G_FUNC = GC_DELETE;

    [MSG_GEN_HELP] :
        G_FUNC = GC_HELP;

    [MSG_GEN_LOGIN] :
        G_FUNC = GC_LGN;

    [MSG_GEN_CONNECT] :
        G_FUNC = GC_CONNECT;

    [MSG_GEN_RENAME] :
        G_FUNC = GC_RENAME;

    [MSG_GEN_COPY] :
        G_FUNC = GC_COPY;

    [MSG_GEN_WHO] :
        G_FUNC = GC_WHO;

    [MSG_GEN_SEND] :
        G_FUNC = GC_SEND_MSG;

    [MSG_GEN_QUERY] :
        G_FUNC = GC_STATUS;

    [MSG_GEN_PROGRAM] :
        G_FUNC = GC_PROGRAM;

    [MSG_GEN_JOURNAL] :
        G_FUNC = GC_JOURNAL;

    [MSG_GEN_VARIABLE] :
        G_FUNC = GC_VARIABLE;
!
! Here if we have a function that is not implemented in KERMSG.
!

    [OTHERWISE] :
        BEGIN
        KRM_ERROR (KER_UNIMPLGEN);
        RETURN STATE_A;
        END;
    TES;

!
! If we get here, we have gotten a known type of generic message that
! we need to have our operating system dependent routine handle.
!
    RETURN CALL_SY_RTN (.G_FUNC);
    END;                    ! End of SERVER_GENERIC

%SBTTL 'HOST_COMMAND - perform a host command'
ROUTINE HOST_COMMAND =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will handle the host command packet.
! It will set up the data for the call to the system routine.
!
! CALLING SEQUENCE:
!
!    STATE = HOST_COMMAND();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    Generic message receive in REC_MSG.
!
! OUTPUT PARAMETERS:
!
!    Returns new state for FSM
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    GEN_1SIZE = 0;
    GEN_2SIZE = 0;
    GEN_3SIZE = 0;

    IF .REC_LENGTH LEQ 0
    THEN
    BEGIN
    KRM_ERROR (KER_PROTOERR);        ! Return an error
    RETURN STATE_A;                ! Just abort
    END;

    SET_STRING (CH$PTR (GEN_1DATA), MAX_MSG, TRUE);    ! Start writing to buffer
    BFR_EMPTY ();                ! Dump the text
    GEN_1SIZE = SET_STRING (0, 0, FALSE);    ! Get the result
    RETURN CALL_SY_RTN (GC_COMMAND);
    END;                    ! End of HOST_COMMAND

%SBTTL 'KERMIT_COMMAND - perform a KERMIT command'
ROUTINE KERMIT_COMMAND =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will handle the KERMIT command packet.
! It will set up the data for the call to the system routine.
!
! CALLING SEQUENCE:
!
!    STATE = KERMIT_COMMAND();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    Generic message receive in REC_MSG.
!
! OUTPUT PARAMETERS:
!
!    Returns new state for FSM
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    GEN_1SIZE = 0;
    GEN_2SIZE = 0;
    GEN_3SIZE = 0;

    IF .REC_LENGTH LEQ 0
    THEN
    BEGIN
    KRM_ERROR (KER_PROTOERR);        ! Return an error
    RETURN STATE_A;                ! Just abort
    END;

    SET_STRING (CH$PTR (GEN_1DATA), MAX_MSG, TRUE);    ! Start writing to buffer
    BFR_EMPTY ();                ! Dump the text
    GEN_1SIZE = SET_STRING (0, 0, FALSE);    ! Get the result
    RETURN CALL_SY_RTN (GC_KERMIT);
    END;                    ! End of KERMIT_COMMAND

%SBTTL 'CALL_SY_RTN - handle operating system dependent functions'
ROUTINE CALL_SY_RTN (G_FUNC) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will handle calling the operating system dependent routine
! for a server function and returning the response.
!
! CALLING SEQUENCE:
!
!    STATE = CALL_SY_RTN(.G_FUNC);
!
! INPUT PARAMETERS:
!
!    G_FUNC - Generic function code
!
! IMPLICIT INPUTS:
!
!    Generic message data in GEN_1DATA
!
! OUTPUT PARAMETERS:
!
!    Returns new state for FSM
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STRING_ADDRESS,                ! Address of string result
    STRING_LENGTH,                ! Length of string result
    GET_CHR_SUBROUTINE,            ! Routine to get a response character
    STATUS;                    ! Status value

!
! Call the routine with the desired type of command.
!
    STRING_LENGTH = 0;                ! Initialize for no string
    GET_CHR_SUBROUTINE = 0;            ! And no subroutine

    IF NOT SY_GENERIC (.G_FUNC, STRING_ADDRESS, STRING_LENGTH, GET_CHR_SUBROUTINE)
    THEN
    RETURN STATE_A;                ! And abort

    IF .STRING_LENGTH GTR 0
    THEN
    BEGIN
    SET_STRING (CH$PTR (.STRING_ADDRESS), .STRING_LENGTH, TRUE);

    IF .STRING_LENGTH LSS .SEND_PKT_SIZE - PKT_OVR_HEAD
    THEN
        BEGIN
        BFR_FILL (TRUE);            ! If it should fit, pack it in

        IF SET_STRING (0, 0, FALSE) GEQ .STRING_LENGTH
        THEN                 ! It fit, so just send the ACK

        IF SEND_PACKET (MSG_ACK, .SIZE, .REC_SEQ) THEN RETURN STATE_C ELSE RETURN STATE_EX;

!
! It didn't fit, reset the pointers to the beginning
!
        SET_STRING (CH$PTR (.STRING_ADDRESS), .STRING_LENGTH, TRUE);
        END;

    NO_FILE_NEEDED = TRUE;            ! Don't need a file
    END
    ELSE

    IF .GET_CHR_SUBROUTINE NEQ 0        ! If we got a subroutine back
    THEN
        BEGIN
        GET_CHR_ROUTINE = .GET_CHR_SUBROUTINE;
        NO_FILE_NEEDED = TRUE;
        END;

    TEXT_HEAD_FLAG = TRUE;            ! Send to be typed
    XFR_STATUS (%C'I', %C'G');            ! Doing a generic command

    IF .STATE EQL STATE_II AND .BLK_CHK_TYPE EQL .INI_CHK_TYPE
    THEN
    RETURN STATE_OF
    ELSE
    RETURN STATE_S;                ! Send the response

    END;                    ! End of CALL_SY_RTN

%SBTTL 'Message processing -- PRS_SEND_INIT - Parse send init params'
ROUTINE PRS_SEND_INIT =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will parse the SEND_INIT parameters that were sent by
!    the remote Kermit.  The items will be stored into the low segment.
!
! CALLING SEQUENCE:
!
!    PRS_SEND_INIT ();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    Message stored in REC_MSG.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
! The following section of code will parse the various send parameters
! that are found in the send-init message.  The following code will store
! the following as the value.
!
! If the user specified a value then the user supplied value will be used else
! the value in the message and if none in the message then the default value.
!
! User supplied values are denoted as positive values in SND_xxxxxxx.
!
! Parse the packet size
!
    SEND_PKT_SIZE = (IF .SND_PKT_SIZE GEQ 0 THEN .SND_PKT_SIZE ELSE
    BEGIN

    IF .REC_LENGTH GTR P_SI_BUFSIZ
    THEN
        UNCHAR (CH$RCHAR (CH$PTR (REC_MSG,
            PKT_MSG + P_SI_BUFSIZ, CHR_SIZE)))
    ELSE
        ABS (.SND_PKT_SIZE)

    END
    );
!
! Parse the time out value
!
    SEND_TIMEOUT = (IF .SND_TIMEOUT GEQ 0 THEN .SND_TIMEOUT ELSE
    BEGIN

    IF .REC_LENGTH GTR P_SI_TIMOUT
    THEN
        UNCHAR (CH$RCHAR (CH$PTR (REC_MSG,
            PKT_MSG + P_SI_TIMOUT, CHR_SIZE)))
    ELSE
        ABS (.SND_TIMEOUT)

    END
    );
!
! Parse the number of padding characters supplied
!
    SEND_NPAD = (IF .SND_NPAD GEQ 0 THEN .SND_NPAD ELSE
    BEGIN

    IF .REC_LENGTH GTR P_SI_NPAD
    THEN
        UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_NPAD,
            CHR_SIZE)))
    ELSE
        ABS (.SND_NPAD)

    END
    );
!
! Parse the padding character
!
    SEND_PADCHAR = (IF .SND_PADCHAR GEQ 0 THEN .SND_PADCHAR ELSE
    BEGIN

    IF .REC_LENGTH GTR P_SI_PAD
    THEN
        CTL (CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_PAD,
            CHR_SIZE)))
    ELSE
        ABS (.SND_PADCHAR)

    END
    );
!
! Parse the end of line character
!
    SEND_EOL = (IF .SND_EOL GEQ 0 THEN .SND_EOL ELSE
    BEGIN

    IF .REC_LENGTH GTR P_SI_EOL
    THEN
        UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_EOL,
            CHR_SIZE)))
    ELSE
        ABS (.SND_EOL)

    END
    );
!
! Parse the quoting character
!
    SEND_QUOTE_CHR = (IF .SND_QUOTE_CHR GEQ 0 THEN .SND_QUOTE_CHR ELSE
    BEGIN

    IF .REC_LENGTH GTR P_SI_QUOTE
    THEN
        CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_QUOTE,
            CHR_SIZE))
    ELSE
        ABS (.SND_QUOTE_CHR)

    END
    );
!
! Parse the 8-bit quoting character
!
! If the character was not included in the packet, assume no eight-bit
! quoting allowed (we are probably talking to an old version of Kermit).
!
    SEND_8QUOTE_CHR = (IF .REC_LENGTH GTR P_SI_8QUOTE THEN CH$RCHAR (CH$PTR (REC_MSG,
        PKT_MSG + P_SI_8QUOTE, CHR_SIZE)) ELSE %C'N'    ! Assume no 8-bit quoting allowed
    );
!
! Parse the checksum type
!

    IF .REC_LENGTH GTR P_SI_CHKTYPE
    THEN
    BEGIN

    LOCAL
        REQ_CHK_TYPE;

    REQ_CHK_TYPE = CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_CHKTYPE, CHR_SIZE));

    IF .REC_TYPE NEQ MSG_ACK
    THEN

        IF .REQ_CHK_TYPE GEQ CHK_1CHAR AND .REQ_CHK_TYPE LEQ CHK_CRC
        THEN
        INI_CHK_TYPE = .REQ_CHK_TYPE
        ELSE
        INI_CHK_TYPE = CHK_1CHAR

    ELSE

        IF .REQ_CHK_TYPE NEQ .CHKTYPE
        THEN
        INI_CHK_TYPE = CHK_1CHAR
        ELSE
        INI_CHK_TYPE = .REQ_CHK_TYPE

    END
    ELSE
    INI_CHK_TYPE = CHK_1CHAR;        ! Only single character checksum if not specified

!
! Parse the repeat character
!
    REPT_CHR = (IF .REC_LENGTH GTR P_SI_REPEAT THEN CH$RCHAR (CH$PTR (REC_MSG,
        PKT_MSG + P_SI_REPEAT, CHR_SIZE)) ELSE %C' ');
!
! Check for a valid quoting character.  If it is not valid, then we have
! a protocol error
!

    IF NOT ((.SEND_QUOTE_CHR GEQ %O'41' AND .SEND_QUOTE_CHR LEQ %O'76') OR (.SEND_QUOTE_CHR GEQ %O
    '140' AND .SEND_QUOTE_CHR LEQ %O'176'))
    THEN
    BEGIN
    KRM_ERROR (KER_PROTOERR);
    RETURN KER_PROTOERR;
    END;

!
! Check for a valid 8 bit quoting and set the 8 bit quoting flag as needed
!

    IF ( NOT ((.SEND_8QUOTE_CHR GEQ %O'041' AND .SEND_8QUOTE_CHR LEQ %O'076') OR (.SEND_8QUOTE_CHR
    GEQ %O'140' AND .SEND_8QUOTE_CHR LEQ %O'176') OR (.SEND_8QUOTE_CHR EQL %C'N') OR (
    .SEND_8QUOTE_CHR EQL %C'Y'))) OR .SEND_8QUOTE_CHR EQL .SEND_QUOTE_CHR OR .SEND_8QUOTE_CHR
    EQL .RCV_QUOTE_CHR
    THEN
    BEGIN
    KRM_ERROR (KER_PROTOERR);
    RETURN KER_PROTOERR;
    END;

    IF .SEND_8QUOTE_CHR EQL %C'Y' THEN SEND_8QUOTE_CHR = .RECV_8QUOTE_CHR;

    IF .SEND_8QUOTE_CHR NEQ %C'N' AND .SEND_8QUOTE_CHR NEQ %C'Y'
    THEN
    FLAG_8QUOTE = TRUE
    ELSE
    FLAG_8QUOTE = FALSE;

!
! Check the repeat character and set flags
!

    IF ( NOT ((.REPT_CHR GEQ %O'41' AND .REPT_CHR LEQ %O'76') OR (.REPT_CHR GEQ %O'140' AND
    .REPT_CHR LEQ %O'176')) OR .REPT_CHR EQL .SEND_QUOTE_CHR OR .REPT_CHR EQL .SEND_8QUOTE_CHR
    OR .REPT_CHR EQL .RCV_QUOTE_CHR) AND .REPT_CHR NEQ %C' '
    THEN
    BEGIN
    KRM_ERROR (KER_PROTOERR);
    RETURN KER_PROTOERR;
    END;

    IF .REPT_CHR NEQ %C' ' THEN FLAG_REPEAT = TRUE ELSE FLAG_REPEAT = FALSE;

    RETURN KER_NORMAL;
    END;                    ! End of PRS_SEND_INIT

%SBTTL 'SET_SEND_INIT'
ROUTINE SET_SEND_INIT : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will initialize the various parameters for the
!    MSG_SND_INIT message.
!
! CALLING SEQUENCE:
!
!    SET_SEND_INIT();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    SND_MSG parameters set up.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    CH$WCHAR (CHAR (.RCV_PKT_SIZE), CH$PTR (SND_MSG, PKT_MSG + P_SI_BUFSIZ, CHR_SIZE));
    CH$WCHAR (CHAR (.RCV_TIMEOUT), CH$PTR (SND_MSG, PKT_MSG + P_SI_TIMOUT, CHR_SIZE));
    CH$WCHAR (CHAR (.RCV_NPAD), CH$PTR (SND_MSG, PKT_MSG + P_SI_NPAD, CHR_SIZE));
    CH$WCHAR (CTL (.RCV_PADCHAR), CH$PTR (SND_MSG, PKT_MSG + P_SI_PAD, CHR_SIZE));
    CH$WCHAR (CHAR (.RCV_EOL), CH$PTR (SND_MSG, PKT_MSG + P_SI_EOL, CHR_SIZE));
    CH$WCHAR (.RCV_QUOTE_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_QUOTE, CHR_SIZE));
    CH$WCHAR (.SEND_8QUOTE_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_8QUOTE, CHR_SIZE));
    CH$WCHAR (.INI_CHK_TYPE, CH$PTR (SND_MSG, PKT_MSG + P_SI_CHKTYPE, CHR_SIZE));
    CH$WCHAR (.REPT_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_REPEAT, CHR_SIZE));
    END;                    ! End of SET_SEND_INIT

%SBTTL 'SEND_PACKET'
ROUTINE SEND_PACKET (TYPE, LENGTH, MN) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will cause a packet to be sent over the line
!    that has been opened by OPEN_TERMINAL.
!
! CALLING SEQUENCE:
!
!    SEND_PACKET(Type, Length);
!
! INPUT PARAMETERS:
!
!    TYPE - Type of packet to send.
!
!    LENGTH - Length of the packet being sent.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    FILLER : VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)],
    TOT_MSG_LEN,                ! Length of message including all characters
    CHKSUM,                    ! Checksum for the message we calculate
    POINTER;                ! Pointer to the information in the message

!
! Do any filler processing that the remote KERMIT requires.
!

    IF .SEND_NPAD NEQ 0
    THEN
    BEGIN
    CH$FILL (.SEND_PADCHAR, MAX_MSG, CH$PTR (FILLER, 0, CHR_SIZE));
!
! Update the send stats
!
    SMSG_TOTAL_CHARS = .SMSG_TOTAL_CHARS + .SEND_NPAD;
!
! Send the fill
!
    DO_PARITY (FILLER, .SEND_NPAD + PKT_TOT_OVR_HEAD);
    SEND (FILLER, .SEND_NPAD + PKT_TOT_OVR_HEAD);
    END;

!
! Store the header information into the message.
!
    CH$WCHAR (.TYPE, CH$PTR (SND_MSG, PKT_TYPE, CHR_SIZE));
    CH$WCHAR (.SND_SOH, CH$PTR (SND_MSG, PKT_MARK, CHR_SIZE));
    CH$WCHAR (CHAR (.LENGTH + PKT_OVR_HEAD + (.BLK_CHK_TYPE - CHK_1CHAR)),
    CH$PTR (SND_MSG,
        PKT_COUNT, CHR_SIZE));
    CH$WCHAR (CHAR ((IF .MN LSS 0 THEN 0 ELSE .MN)), CH$PTR (SND_MSG, PKT_SEQ, CHR_SIZE));
!
! Calculate the block check value
!
    POINTER = CH$PTR (SND_MSG, PKT_MARK + 1, CHR_SIZE);
    CHKSUM = CALC_BLOCK_CHECK (.POINTER, .LENGTH + PKT_OVR_HEAD);
    TOT_MSG_LEN = .LENGTH + PKT_TOT_OVR_HEAD;
!
! Store the checksum into the message
!
    POINTER = CH$PTR (SND_MSG, .LENGTH + PKT_OVR_HEAD + 1, CHR_SIZE);

    CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF
    SET

    [CHK_1CHAR] :
        CH$WCHAR_A (CHAR (.CHKSUM), POINTER);

    [CHK_2CHAR] :
        BEGIN
        CH$WCHAR_A (CHAR (.CHKSUM<6, 6>), POINTER);
        CH$WCHAR_A (CHAR (.CHKSUM<0, 6>), POINTER);
        TOT_MSG_LEN = .TOT_MSG_LEN + 1;
        END;

    [CHK_CRC] :
        BEGIN
        CH$WCHAR_A (CHAR (.CHKSUM<12, 4>), POINTER);
        CH$WCHAR_A (CHAR (.CHKSUM<6, 6>), POINTER);
        CH$WCHAR_A (CHAR (.CHKSUM<0, 6>), POINTER);
        TOT_MSG_LEN = .TOT_MSG_LEN + 2;
        END;
    TES;

!
! Store in the end of line character
!
    CH$WCHAR_A (.SEND_EOL, POINTER);
!
! If we are debugging then type out the message we are sending.
!
    DBG_SEND (SND_MSG, (.TOT_MSG_LEN));
!
! Update the stats for total characters and the data characters
!
    SMSG_TOTAL_CHARS = .SMSG_TOTAL_CHARS + .TOT_MSG_LEN;
! Make data characters really be that, not just characters in data field
!    SMSG_DATA_CHARS = .SMSG_DATA_CHARS + .LENGTH;

    IF .TYPE EQL MSG_NAK
    THEN
    BEGIN
    SMSG_NAKS = .SMSG_NAKS + 1;
    XFR_STATUS (%C'S', %C'N');
    END
    ELSE
    BEGIN
    SMSG_COUNT = .SMSG_COUNT + 1;
    XFR_STATUS (%C'S', %C'P');
    END;

!
! Check if we are in IBM mode and need to wait for an XON first
! We will not wait if this is a packet which might be going out
! without previous traffic (generic commands, init packets).

    IF .IBM_FLAG AND NOT (.TYPE EQL MSG_SND_INIT OR .TYPE EQL MSG_SER_INIT OR .TYPE EQL MSG_RCV_INIT
    OR .TYPE EQL MSG_COMMAND OR .TYPE EQL MSG_GENERIC)
    THEN

    IF NOT IBM_WAIT () THEN RETURN KER_ABORTED;

!
! Now call the O/S routine to send the message out to the remote KERMIT
!
    DO_PARITY (SND_MSG, .TOT_MSG_LEN);
    RETURN SEND (SND_MSG, .TOT_MSG_LEN);
    END;                    ! End of SEND_PACKET

%SBTTL 'REC_MESSAGE - Receive a message'
ROUTINE REC_MESSAGE (CHK_ROUTINE) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will handle the retry processing for the various
!    messages that can be received.
!
! CALLING SEQUENCE:
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    KER_NORMAL - Normal return
!    KER_RETRIES - Too many retries
!    (What ever REC_PACKET returns).
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS;                    ! Status returned by various routines

    RETURN

    WHILE TRUE DO
        BEGIN

        IF .NUM_RETRIES GTR .PKT_RETRIES
        THEN
        BEGIN
        KRM_ERROR (KER_RETRIES);    ! Report the error
        RETURN KER_RETRIES;
        END;

        NUM_RETRIES = .NUM_RETRIES + 1;
        STATUS = REC_PACKET ();

        IF NOT .STATUS AND .STATUS NEQ KER_CHKSUMERR AND .STATUS NEQ KER_TIMEOUT
        THEN
        RETURN .STATUS;

        IF NOT .STATUS
        THEN
        SEND_PACKET (MSG_NAK, 0, .MSG_NUMBER)    ![024]
        ELSE
        BEGIN
![021]
![021] If the packet type is not acceptable by our caller, nak it so the
![021] other end tries again, and abort the current operation.  This is so
![021] we will return to server mode (if we are running that way) quickly
![021] when the other Kermit has been aborted and then restarted, and should
![021] also make restarting quick, since we will not need to wait for the
![021] other Kermit to time this message out before retransmitting.
![021]

        IF NOT (.CHK_ROUTINE) ()
        THEN
            BEGIN
            SEND_PACKET (MSG_NAK, 0, .REC_SEQ);
            RETURN FALSE;        ! Just indicate an error
            END
        ELSE
            EXITLOOP KER_NORMAL;

        END;

        END;

    END;                    ! End of REC_PARSE

%SBTTL 'REC_PACKET'
ROUTINE REC_PACKET =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will do the oppoiste of SEND_PACKET.  It will wait
!    for the message to be read from the remote and then it will
!    check the message for validity.
!
! CALLING SEQUENCE:
!
!    Flag = REC_PACKET();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    REC_MSG - Contains the message received.
!
! COMPLETION CODES:
!
!    True - Packet receive ok.
!    False - Problem occured during the receiving of the packet.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    BIND
    ATTEMPT_TEXT = UPLIT (%ASCIZ'Attempting to receive');

    LOCAL
    STATUS,                    ! Status returned by various routines
    MSG_LENGTH,
    ERR_POINTER,                ! Pointer to the error buffer
    POINTER,
    CHKSUM;                    ! Checksum of the message

!
! Attempt to read the message from the remote.
!
!    DO
!    BEGIN

    IF .DEBUG_FLAG
    THEN
    BEGIN

    LOCAL
        OLD_RTN;

    OLD_RTN = TT_SET_OUTPUT (DBG_DUMP);
    TT_TEXT (ATTEMPT_TEXT);
    TT_CRLF ();
    TT_SET_OUTPUT (.OLD_RTN);
    END;

!
! If status type out requested, do it once
!

    IF .TYP_STS_FLAG
    THEN
    BEGIN
    STS_OUTPUT ();
    TYP_STS_FLAG = FALSE;
    END;

!
! Receive the message from the remote Kermit
!
    STATUS = RECEIVE (REC_MSG, MSG_LENGTH);
!
! Check for timeouts
!

    IF .STATUS EQL KER_TIMEOUT THEN XFR_STATUS (%C'R', %C'T');

!
! If it failed return the status to the upper level
!

    IF NOT .STATUS
    THEN
    BEGIN

    IF .STATUS NEQ KER_ABORTED AND .STATUS NEQ KER_TIMEOUT THEN KRM_ERROR (.STATUS);

                        ! Report error
    RETURN .STATUS;
    END;

!
! Determine if we got a good message
!

    IF .MSG_LENGTH LSS PKT_TOT_OVR_HEAD - 1
    THEN
    BEGIN
    RETURN KER_ZEROLENMSG;
    END;

!
! Update the stats on the total number of characters received.
!
    RMSG_TOTAL_CHARS = .RMSG_TOTAL_CHARS + .MSG_LENGTH;
!
! Initialize the checksum and others
!
    REC_TYPE = CH$RCHAR (CH$PTR (REC_MSG, PKT_TYPE, CHR_SIZE));
!
! Now break the message apart byte by byte.
!
    REC_LENGTH = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNT, CHR_SIZE))) - PKT_OVR_HEAD - (
    .BLK_CHK_TYPE - CHK_1CHAR);
    REC_SEQ = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_SEQ, CHR_SIZE)));
!
! Typed the packet if we are debugging
!
    DBG_RECEIVE (REC_MSG);
!
! Now compute the final checksum and make sure that it is identical
! to what we received from the remote KERMIT
!
    POINTER = CH$PTR (REC_MSG, PKT_MARK + 1, CHR_SIZE);
    CHKSUM = CALC_BLOCK_CHECK (.POINTER, .REC_LENGTH + PKT_OVR_HEAD);
    POINTER = CH$PTR (REC_MSG, .REC_LENGTH + PKT_OVR_HEAD + 1, CHR_SIZE);
    STATUS = KER_NORMAL;            ! Assume good checksum

    CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF
    SET

    [CHK_1CHAR] :

        IF .CHKSUM NEQ UNCHAR (CH$RCHAR_A (POINTER)) THEN STATUS = KER_CHKSUMERR;

    [CHK_2CHAR] :

        IF (.CHKSUM<6, 6> NEQ UNCHAR (CH$RCHAR_A (POINTER))) OR (.CHKSUM<0, 6> NEQ UNCHAR (
            CH$RCHAR_A (POINTER)))
        THEN
        STATUS = KER_CHKSUMERR;

    [CHK_CRC] :

        IF (.CHKSUM<12, 4> NEQ UNCHAR (CH$RCHAR_A (POINTER))) OR (.CHKSUM<6, 6> NEQ UNCHAR (
            CH$RCHAR_A (POINTER))) OR (.CHKSUM<0, 6> NEQ UNCHAR (CH$RCHAR_A (POINTER)))
        THEN
        STATUS = KER_CHKSUMERR;

    TES;

!
! If we have a bad checksum, check for the special cases when we might be out
! of sync with the sender.  This can occur if the sender is retransmitting
! a send-init (because our ACK got lost), and we have agreed on multi-char
! checksums, or because the sender is a server who has aborted back to being
! idle without telling us.
! Note that in either case, we return back to using single character checksums
!

    IF .STATUS EQL KER_CHKSUMERR
    THEN
    BEGIN

    IF (.BLK_CHK_TYPE NEQ CHK_1CHAR AND .REC_SEQ EQL 0) AND (.REC_LENGTH LSS 1 - (.BLK_CHK_TYPE
        - CHK_1CHAR) AND .REC_TYPE EQL MSG_NAK) OR (.REC_TYPE EQL MSG_SND_INIT)
    THEN
        BEGIN

        LOCAL
        SAVE_BLK_CHK_TYPE;

        SAVE_BLK_CHK_TYPE = .BLK_CHK_TYPE;    ! Remember what we are using
        BLK_CHK_TYPE = CHK_1CHAR;
        POINTER = CH$PTR (REC_MSG, PKT_MARK + 1, CHR_SIZE);
        CHKSUM = CALC_BLOCK_CHECK (.POINTER, .REC_LENGTH + PKT_OVR_HEAD);
        POINTER = CH$PTR (REC_MSG, .REC_LENGTH + PKT_OVR_HEAD + 1, CHR_SIZE);

        IF .CHKSUM NEQ UNCHAR (CH$RCHAR_A (POINTER))
        THEN
        BEGIN
        BLK_CHK_TYPE = .SAVE_BLK_CHK_TYPE;
        RETURN KER_CHKSUMERR;
        END;

        END
    ELSE
        RETURN KER_CHKSUMERR;

    END;

!
! Update the stats
!
!    RMSG_DATA_CHARS = .RMSG_DATA_CHARS + .REC_LENGTH;

    IF .REC_TYPE EQL MSG_NAK
    THEN
    BEGIN
    RMSG_NAKS = .RMSG_NAKS + 1;
    XFR_STATUS (%C'R', %C'N');
    END
    ELSE
    BEGIN
    RMSG_COUNT = .RMSG_COUNT + 1;
    XFR_STATUS (%C'R', %C'P');
    END;

!
! Now check to see if we have an E type (Error) packet.
!

    IF .REC_TYPE NEQ MSG_ERROR THEN RETURN KER_NORMAL;

!
! Here to process an error packet.  Call the user routine to output the
! error message to the terminal.
!
!
![026] Use decoding routine to fetch the error text
!
    CH$FILL (CHR_NUL, MAX_MSG + 1, CH$PTR (LAST_ERROR));
    SET_STRING (CH$PTR (LAST_ERROR), MAX_MSG, TRUE);
    BFR_EMPTY ();
    SET_STRING (0, 0, FALSE);
![026]    ERR_POINTER = CH$PTR (LAST_ERROR);
![026]    POINTER = CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE);
![026]
![026]    INCR I FROM 1 TO .REC_LENGTH DO
![026]    CH$WCHAR_A (CH$RCHAR_A (POINTER), ERR_POINTER);
![026]
![026]    CH$WCHAR (CHR_NUL, ERR_POINTER);
    TT_TEXT (LAST_ERROR);
    TT_CRLF ();
    RETURN KER_ERRMSG;
    END;                    ! End of REC_PACKET

%SBTTL 'CALC_BLOCK_CHECK'
ROUTINE CALC_BLOCK_CHECK (POINTER, LENGTH) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will calculate the proper value for the block check
!    for a given message.  The value it returns is dependant upon the
!    type of block check requested in BLK_CHK_TYPE.
!
! CALLING SEQUENCE:
!
!    CHKSUM = CALC_BLOCK_CHECK (.POINTER, .LENGTH);
!
! INPUT PARAMETERS:
!
!    POINTER - A character pointer to the first character to be
!        included in the block check.
!
!    LENGTH - The number of characters to be included.
!
! IMPLICIT INPUTS:
!
!    BLK_CHK_TYPE - The type of block check to generate.
!
! OUPTUT PARAMETERS:
!
!    The value is the block check.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    CHAR_MASK,                ! Mask for stripping bits
    BLOCK_CHECK;                ! To build initial block check value

    BLOCK_CHECK = 0;                ! Start out at 0
!
! Set mask for characters so that we calculate the block check correctly
!
    CHAR_MASK = (IF .PARITY_TYPE EQL PR_NONE THEN %O'377' ELSE %O'177');

    CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF
    SET

    [CHK_1CHAR, CHK_2CHAR] :

        INCR I FROM 1 TO .LENGTH DO
        BLOCK_CHECK = .BLOCK_CHECK + (CH$RCHAR_A (POINTER) AND .CHAR_MASK);

    [CHK_CRC] :
        BEGIN
!
! Ensure that the calculation is done with correct type of characters
!

        LOCAL
        TMP_PTR;            ! Temp pointer for copying chars

        TMP_PTR = .POINTER;

        IF .PARITY_TYPE EQL PR_NONE
        THEN

        INCR I FROM 1 TO .LENGTH DO
            CH$WCHAR_A ((CH$RCHAR (.TMP_PTR) AND %O'177'), TMP_PTR);

        BLOCK_CHECK = CRCCLC (.POINTER, .LENGTH);
        END;
    TES;

    IF .BLK_CHK_TYPE EQL CHK_1CHAR
    THEN
    BLOCK_CHECK = (.BLOCK_CHECK + ((.BLOCK_CHECK AND %O'300')/%O'100')) AND %O'77';

    RETURN .BLOCK_CHECK;            ! Return the correct value
    END;                    ! End of CALC_BLOCK_CHK

%SBTTL 'NORMALIZE_FILE - Put file name into normal form'
ROUTINE NORMALIZE_FILE (FILE_ADDRESS, FILE_LENGTH, NAME_LENGTH, TYPE_LENGTH) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will ensure that a file specification is in normal
!    form.  It does this by replacing all non-alphanumeric characters
!    (except the first period) with "X".  It will also ensure that
!    the resulting specification (of form name.type) has only
!    a specified number of characters in the name portion and type portion.
!
! CALLING SEQUENCE:
!
!    NORMALIZE_FILE (FILE_ADDRESS, FILE_LENGTH, NAME_LENGTH, TYPE_LENGTH);
!
! INPUT PARAMETERS:
!
!    FILE_ADDRESS - Address of file specification string to be normalized
!
!    FILE_LENGTH - Length of file specification
!
!    NAME_LENGTH - Maximum length desired for "name" portion.
!
!    TYPE_LENGTH - Maximum length desired for "type" portion.
!
!    With both NAME_LENGTH and TYPE_LENGTH, a negative value indicates
!    unlimited lenght.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    FILE_LENGTH - The length of the resulting file spec
!
!    NAME_LENGTH - The actual length of the resulting file name
!
!    TYPE_LENGTH - The actual length of the resulting file type
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    CH,                    ! Character being processed
    POINTER,                ! Pointer to file spec
    WRT_POINTER,                ! Pointer to write file spec
    WRT_SIZE,
    FIRST_PERIOD,                ! Flag we have seen a period
    IGNORE_BAD,                ! Flag we should ignore bad characters
    BAD_CHAR,                ! Flag this character was bad
    FILE_CTR,                ! Counter for overall length
    NAME_CTR,                ! Counter for name characters
    TYPE_CTR;                ! Counter for type characters

    FILE_CTR = 0;
    NAME_CTR = 0;
    TYPE_CTR = 0;
    WRT_SIZE = 0;
    FIRST_PERIOD = FALSE;            ! No periods yet
    POINTER = CH$PTR (.FILE_ADDRESS);        ! Set up pointer to file name
    WRT_POINTER = .POINTER;

    IF .NAME_LENGTH EQL 0 THEN FIRST_PERIOD = TRUE;    ! Pretend we did name already

    IGNORE_BAD = FALSE;

    IF .NAME_LENGTH GTR 0
    THEN
    BEGIN

    DECR I FROM ..FILE_LENGTH TO 0 DO

        IF CH$RCHAR_A (POINTER) EQL %C'.'
        THEN
        BEGIN
        IGNORE_BAD = TRUE;
        EXITLOOP;
        END;

    END;

    POINTER = .WRT_POINTER;

    WHILE .FILE_CTR LSS ..FILE_LENGTH DO
    BEGIN
    CH = CH$RCHAR_A (POINTER);        ! Get a character
    FILE_CTR = .FILE_CTR + 1;

    IF (.CH LSS %C'0' AND (.CH NEQ %C'.' OR .FIRST_PERIOD)) OR .CH GTR %C'z' OR (.CH GTR %C'9'
        AND .CH LSS %C'A') OR (.CH GTR %C'Z' AND .CH LSS %C'a')
    THEN
        BEGIN
        BAD_CHAR = TRUE;
        CH = %C'X';
        END
    ELSE
        BEGIN
        BAD_CHAR = FALSE;

        IF .CH GEQ %C'a' THEN CH = .CH - (%C'a' - %C'A');

        END;

    IF .CH EQL %C'.'
    THEN
        BEGIN
        FIRST_PERIOD = TRUE;
        CH$WCHAR_A (.CH, WRT_POINTER);
        WRT_SIZE = .WRT_SIZE + 1;
        END
    ELSE

        IF NOT .BAD_CHAR OR NOT .IGNORE_BAD
        THEN

        IF NOT .FIRST_PERIOD
        THEN
            BEGIN

            IF .NAME_LENGTH LSS 0 OR .NAME_CTR LSS .NAME_LENGTH
            THEN
            BEGIN
            NAME_CTR = .NAME_CTR + 1;
            WRT_SIZE = .WRT_SIZE + 1;
            CH$WCHAR_A (.CH, WRT_POINTER);
            END;

            END
        ELSE

            IF .TYPE_LENGTH LSS 0 OR .TYPE_CTR LSS .TYPE_LENGTH
            THEN
            BEGIN
            TYPE_CTR = .TYPE_CTR + 1;
            WRT_SIZE = .WRT_SIZE + 1;
            CH$WCHAR_A (.CH, WRT_POINTER);
            END;

    END;

    .FILE_LENGTH = .WRT_SIZE;
    CH$WCHAR_A (CHR_NUL, WRT_POINTER);
    END;                    ! End of NORMALIZE_FILE

%SBTTL 'Buffer filling -- Main routine'
ROUTINE BFR_FILL (FIRST_FLAG) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will fill the buffer with data from the file.  It
!    will do all the quoting that is required.
!
! CALLING SEQUENCE:
!
!    EOF_FLAG = BFR_FILL(.FIRST_FLAG);
!
! INPUT PARAMETERS:
!
!    FIRST_FLAG - Flag whether first call for this file
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    True - Buffer filled may be at end of file.
!    False - At end of file.
!
! IMPLICIT OUTPUTS:
!
!    Number of characters stored in the buffer.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LITERAL
    NO_CHAR = -1,                ! No character next
    EOF_CHAR = -2;                ! EOF seen

    LOCAL
    I,                    ! Temp loop index
    MAX_SIZE,                ! Maximum size of data
    POINTER;                ! Pointer into the message buffer

    OWN
    NEXT_CHR,                ! Saved character
    STATUS,                    ! Status value
    REPEAT_COUNT,                ! Number of times character repeated
    CHAR_8_BIT,                ! 8 bit character from file
    CHRS : VECTOR [5],            ! String needed to represent character
    CHR_IDX,                ! Index into CHRS
    OLD_CHAR_8_BIT,                ! Previous 8-bit character
    OLD_CHRS : VECTOR [5],            ! String for previous character
    OLD_CHR_IDX;                ! Index for previous character

    ROUTINE GET_QUOTED_CHAR =
!
! This routine gets a character from the file and returns both
! the character and the string needed to represent the character
! if it needs quoting.
!
    BEGIN

    IF .NEXT_CHR GEQ 0
    THEN
        BEGIN
        CHAR_8_BIT = .NEXT_CHR;
        NEXT_CHR = NO_CHAR;
        STATUS = KER_NORMAL;
        END
    ELSE

        IF .NEXT_CHR EQL NO_CHAR
        THEN
        STATUS = (.GET_CHR_ROUTINE) (CHAR_8_BIT)
        ELSE
        STATUS = KER_EOF;

    IF .STATUS EQL KER_NORMAL
    THEN
        BEGIN
!
! Determine if we should just quote the character
!    Either:
!        Character is a delete (177 octal)
!    or    Character is a control character (less than 40 octal)
!    or    Character is a quote character
!    or    Character is the repeat character and doing repeat compression
!    or    Character is an eight bit quote character and doing eight bit
!          quoting.
!

        IF ((.CHAR_8_BIT AND %O'177') LSS %C' ') OR ((.CHAR_8_BIT AND %O'177') EQL CHR_DEL) OR (
        (.CHAR_8_BIT AND %O'177') EQL .RCV_QUOTE_CHR) OR (.FLAG_REPEAT AND ((.CHAR_8_BIT AND
        %O'177') EQL .REPT_CHR)) OR (.FLAG_8QUOTE AND ((.CHAR_8_BIT AND %O'177') EQL
        .SEND_8QUOTE_CHR))
        THEN
        BEGIN
!
! If the character is a control character or delete we must do a CTL(Character)
! so it is something that we can be sure we can send.
!

        IF ((.CHAR_8_BIT AND %O'177') LSS %C' ') OR ((.CHAR_8_BIT AND %O'177') EQL CHR_DEL)
        THEN
            CHRS [0] = CTL (.CHAR_8_BIT)
        ELSE
            CHRS [0] = .CHAR_8_BIT;

        CHR_IDX = 1;
        CHRS [1] = .RCV_QUOTE_CHR;    ![035] Use character we said we would send
        END
        ELSE
        BEGIN
        CHR_IDX = 0;
        CHRS [0] = .CHAR_8_BIT;
        END;

        END
    ELSE

        IF .STATUS NEQ KER_EOF THEN KRM_ERROR (.STATUS);    ! Report error

    RETURN .STATUS;
    END;
    ROUTINE GET_8_QUOTED_CHAR =
!
! This routine will get the quoted representation of a character
! (by calling GET_QUOTED_CHAR), and return the 8th-bit quoted
! representation.
!
    BEGIN

    IF (STATUS = GET_QUOTED_CHAR ()) EQL KER_NORMAL
    THEN
        BEGIN
!
! Determine if we must quote the eighth bit (parity bit on)
!

        IF (((.CHRS [0] AND %O'177') NEQ .CHRS [0]) AND .FLAG_8QUOTE)
        THEN
        BEGIN
        CHRS [0] = .CHRS [0] AND %O'177';
        CHR_IDX = .CHR_IDX + 1;
        CHRS [.CHR_IDX] = .SEND_8QUOTE_CHR;
        END;

        END;

    RETURN .STATUS;
    END;
!
! Start of code for BFR_FILL
!
! Initialize pointer and count
!
    SIZE = 0;
    POINTER = CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE);
    MAX_SIZE = .SEND_PKT_SIZE - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR);
!
! If last call got an error or eof, return it now
!

    IF NOT .FIRST_FLAG AND (.STATUS NEQ KER_NORMAL) THEN RETURN .STATUS;

!
! If first time for a file prime the pump with the first character.
!

    IF .FIRST_FLAG
    THEN
    BEGIN
    FIRST_FLAG = FALSE;
    NEXT_CHR = -1;                ! No backed up character

    IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR ();

    IF .STATUS NEQ KER_NORMAL THEN RETURN .STATUS;

    OLD_CHAR_8_BIT = .CHAR_8_BIT;

    INCR OLD_CHR_IDX FROM 0 TO .CHR_IDX DO
        OLD_CHRS [.OLD_CHR_IDX] = .CHRS [.OLD_CHR_IDX];

    OLD_CHR_IDX = .CHR_IDX;
    REPEAT_COUNT = 0;            ! Character was not repeated yet
                        ! Will always be incremented
    END;

!
! Otherwise, loop until we fill buffer
!

    WHILE .SIZE LSS .MAX_SIZE DO         ! Normal exit is via an EXITLOOP
    BEGIN
!
! Check if we are doing run compression
!

    IF .FLAG_REPEAT
    THEN
        BEGIN
!
! Here with previous character in OLD_xxx.  As long as we
! are getting the same character, just count the run.
!

        WHILE (.CHAR_8_BIT EQL .OLD_CHAR_8_BIT) AND (.REPEAT_COUNT LSS 94) DO
        BEGIN
        REPEAT_COUNT = .REPEAT_COUNT + 1;

        IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR ();

        IF .STATUS NEQ KER_NORMAL
        THEN

            IF .STATUS NEQ KER_EOF
            THEN
            CHAR_8_BIT = NO_CHAR
            ELSE
            BEGIN
            CHAR_8_BIT = EOF_CHAR;
            CHR_IDX = -1;
            END;

        END;

        IF .OLD_CHR_IDX + 1 + 2 LSS ((.OLD_CHR_IDX + 1)*.REPEAT_COUNT)
        THEN
        BEGIN

        IF .SIZE + .OLD_CHR_IDX + 1 + 2 GTR .MAX_SIZE
        THEN
            BEGIN

            IF .CHAR_8_BIT EQL .OLD_CHAR_8_BIT
            THEN
            BEGIN
            NEXT_CHR = .CHAR_8_BIT;
            REPEAT_COUNT = .REPEAT_COUNT - 1;
            END;

            IF .CHAR_8_BIT EQL EOF_CHAR
            THEN
            BEGIN
            NEXT_CHR = EOF_CHAR;    ! Remember EOF for next time
            STATUS = KER_NORMAL;    ! And give good return now
            END;

            EXITLOOP;
            END;

        OLD_CHRS [.OLD_CHR_IDX + 1] = CHAR (.REPEAT_COUNT);
        OLD_CHRS [.OLD_CHR_IDX + 2] = .REPT_CHR;
        OLD_CHR_IDX = .OLD_CHR_IDX + 2;
!
! Count the number of file characters this represents
!
        SMSG_DATA_CHARS = .SMSG_DATA_CHARS + .REPEAT_COUNT - 1;
        FILE_CHARS = .FILE_CHARS + .REPEAT_COUNT - 1;
        REPEAT_COUNT = 1;        ! Only one time for this string
        END;

!
! If we don't have enough room for this character, wait till next
! time.
!

        IF .SIZE + (.OLD_CHR_IDX + 1)*.REPEAT_COUNT GTR .MAX_SIZE
        THEN
        BEGIN
! If the next character is the same, the count will get incremented
! next time we enter, so back it off now.

        IF .CHAR_8_BIT EQL .OLD_CHAR_8_BIT
        THEN
            BEGIN
            NEXT_CHR = .CHAR_8_BIT;
            REPEAT_COUNT = .REPEAT_COUNT - 1;
            END;

        EXITLOOP;
        END;

        SMSG_DATA_CHARS = .SMSG_DATA_CHARS + .REPEAT_COUNT;
        FILE_CHARS = .FILE_CHARS + .REPEAT_COUNT;

        DECR REPEAT_COUNT FROM .REPEAT_COUNT TO 1 DO

        DECR I FROM .OLD_CHR_IDX TO 0 DO
            BEGIN
            CH$WCHAR_A (.OLD_CHRS [.I], POINTER);
            SIZE = .SIZE + 1;
            END;

!
! If we got an error (or EOF) then exit
!

        IF (.STATUS NEQ KER_NORMAL) THEN EXITLOOP;

!
! Otherwise, copy the character which broke the run
!
        OLD_CHAR_8_BIT = .CHAR_8_BIT;

        INCR OLD_CHR_IDX FROM 0 TO .CHR_IDX DO
        OLD_CHRS [.OLD_CHR_IDX] = .CHRS [.OLD_CHR_IDX];

        OLD_CHR_IDX = .CHR_IDX;
        REPEAT_COUNT = 0;
        END
    ELSE
!
! Here if we are not doing run compression.  We can do things much
! easier.
!
        BEGIN

        IF (.SIZE + .CHR_IDX + 1) GTR .MAX_SIZE THEN EXITLOOP;

        SMSG_DATA_CHARS = .SMSG_DATA_CHARS + 1;
        FILE_CHARS = .FILE_CHARS + 1;

        DECR CHR_IDX FROM .CHR_IDX TO 0 DO
        BEGIN
        CH$WCHAR_A (.CHRS [.CHR_IDX], POINTER);
        SIZE = .SIZE + 1;
        END;

        IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR ();

        IF (.STATUS NEQ KER_NORMAL) THEN EXITLOOP;

        END;

    END;

!
! Determine if we really stored anything into the buffer.
!

    IF .SIZE NEQ 0 THEN RETURN KER_NORMAL ELSE RETURN .STATUS;

    END;                    ! End of BFR_FILL

%SBTTL 'BFR_EMPTY'
ROUTINE BFR_EMPTY =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will empty the data from the REC_MSG message buffer
!    to the file.  It will process quoting characters.
!
! CALLING SEQUENCE:
!
!    Flag = BFR_EMPTY();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    True - No problems writing the file.
!    False - I/O error writing the file.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    STATUS,                    ! Status returned by various routines
    REPEAT_COUNT,                ! Count of times to repeat character
    TURN_BIT_8_ON,                ! If eight bit quoting
    COUNTER,                ! Count of the characters left
    CHARACTER,                ! Character we are processing
    POINTER;                ! Pointer to the data

    POINTER = CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE);
    COUNTER = 0;

    WHILE (.COUNTER LSS .REC_LENGTH) DO
    BEGIN
    CHARACTER = CH$RCHAR_A (POINTER);
    COUNTER = .COUNTER + 1;
!
! If the character is the repeat character (and we are doing repeat
! compression), then get the count.
!

    IF ((.CHARACTER EQL .REPT_CHR) AND .FLAG_REPEAT)
    THEN
        BEGIN
        REPEAT_COUNT = UNCHAR (CH$RCHAR_A (POINTER) AND %O'177');
        CHARACTER = CH$RCHAR_A (POINTER);
        COUNTER = .COUNTER + 2;
        END
    ELSE
        REPEAT_COUNT = 1;

!
! If the character is an eight bit quoting character and we are doing eight
! bit quoting then turn on the flag so we turn the eighth bit on when we
! get the real character.
!

    IF ((.CHARACTER EQL .SEND_8QUOTE_CHR) AND .FLAG_8QUOTE)
    THEN
        BEGIN
        TURN_BIT_8_ON = TRUE;
        COUNTER = .COUNTER + 1;
        CHARACTER = CH$RCHAR_A (POINTER);
        END
    ELSE
        TURN_BIT_8_ON = FALSE;

!
! Now determine if we are quoting the character.  If so then we must eat
! the quoting character and get the real character.
!

    IF .CHARACTER EQL .SEND_QUOTE_CHR
                    ![035] Is this character other Kermit sends as quote?
    THEN
        BEGIN
        CHARACTER = CH$RCHAR_A (POINTER);
        COUNTER = .COUNTER + 1;
!
! Determine if we must undo what someone else has done to the character
!

        IF ((.CHARACTER AND %O'177') GEQ CTL (CHR_DEL)) AND ((.CHARACTER AND %O'177') LEQ CTL (
            CHR_DEL) + %O'40')
        THEN
        CHARACTER = CTL (.CHARACTER);

        END;

!
! Turn on the eight bit if needed and then write the character out
!

    IF .TURN_BIT_8_ON THEN CHARACTER = .CHARACTER OR %O'200';

    RMSG_DATA_CHARS = .RMSG_DATA_CHARS + .REPEAT_COUNT;
    FILE_CHARS = .FILE_CHARS + .REPEAT_COUNT;

    DECR REPEAT_COUNT FROM .REPEAT_COUNT TO 1 DO
        BEGIN
        STATUS = (.PUT_CHR_ROUTINE) (.CHARACTER);

        IF NOT .STATUS THEN RETURN .STATUS;

        END;

    END;

    RETURN KER_NORMAL;
    END;                    ! End of BFR_EMPTY

%SBTTL 'Buffer filling and emptying subroutines'
ROUTINE SET_STRING (POINTER, LENGTH, START) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine is used to set up the buffer filling and emptying
!    routines to use a string for input (or output) rather than
!    the file I/O routines.
!
! CALLING SEQUENCE:
!
!    SET_STRING (.POINTER, .LENGTH, .START)
!
! INPUT PARAMETERS:
!
!    POINTER - Character pointer to string
!
!    LENGTH - Number of characters in string
!
!    START - True to start string, false to end it
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    Returns 0 if START = TRUE, actual number of characters used
!    by last string if START = FALSE.
!
! IMPLICIT OUTPUTS:
!
!    GET_CHR_ROUTINE and PUT_CHR_ROUTINE modifed so that string
!    routines are called instead of file I/O.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    OWN
    STR_POINTER,                ! Pointer to string
    STR_LENGTH,                ! Length of string
    STR_ORG_LENGTH,                ! Original length of string
    OLD_GET_CHR,                ! Old get-char routine
    OLD_PUT_CHR;                ! Old put-char routine

!
! Routine to get a character from the string
!
    ROUTINE GET_STRING (CHAR_ADDRESS) =
    BEGIN
!
! If some characters are left, count down the length and get next character
! Otherwise return and end of file indication.
!

    IF .STR_LENGTH GTR 0
    THEN
        BEGIN
        STR_LENGTH = .STR_LENGTH - 1;
        .CHAR_ADDRESS = CH$RCHAR_A (STR_POINTER);
        RETURN KER_NORMAL;
        END
    ELSE
        RETURN KER_EOF;

    END;                    ! End of GET_STRING
    ROUTINE PUT_STRING (CHAR_VALUE) =
    BEGIN
!
! If there is enough room to store another character, store the character
! and count it.  Otherwise return a line too long indication.
!

    IF .STR_LENGTH GTR 0
    THEN
        BEGIN
        STR_LENGTH = .STR_LENGTH - 1;
        CH$WCHAR_A (.CHAR_VALUE, STR_POINTER);
        RETURN KER_NORMAL;
        END
    ELSE
        RETURN KER_LINTOOLNG;

    END;                    ! End of PUT_STRING
!
! If we have a request to start a string (input or output), save the old
! routines and set up ours.  Also save the string pointer and length for
! use by our get/put routines.
! Otherwise this is a request to stop using the string routines, so reset
! the old routines and return the actual number of characters read or
! written
!

    IF .START
    THEN
    BEGIN
    STR_POINTER = .POINTER;
    STR_ORG_LENGTH = .LENGTH;
    STR_LENGTH = .LENGTH;
    OLD_GET_CHR = .GET_CHR_ROUTINE;
    OLD_PUT_CHR = .PUT_CHR_ROUTINE;
    GET_CHR_ROUTINE = GET_STRING;
    PUT_CHR_ROUTINE = PUT_STRING;
    RETURN 0;
    END
    ELSE
    BEGIN
    GET_CHR_ROUTINE = .OLD_GET_CHR;
    PUT_CHR_ROUTINE = .OLD_PUT_CHR;
    RETURN .STR_ORG_LENGTH - .STR_LENGTH;
    END;

    END;                    ! End of SET_STRING

%SBTTL 'Add parity routine'
ROUTINE DO_PARITY (MESSAGE, LENGTH) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will add parity for a complete message that is to be
!    sent to the remote Kermit.
!
! CALLING SEQUENCE:
!
!    DO_PARITY (Message_address, Message_length);
!
! INPUT PARAMETERS:
!
!    Message_address - Address of the message to put parity on.
!    Message_length  - Lengtho of the message.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    MAP
    MESSAGE : REF VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)];

    LOCAL
    POINTER;                ! Point into the message

    IF NOT .DEV_PARITY_FLAG
    THEN
    BEGIN
    POINTER = CH$PTR (.MESSAGE,, CHR_SIZE);

    INCR I FROM 1 TO .LENGTH DO
        CH$WCHAR_A (GEN_PARITY (CH$RCHAR (.POINTER)), POINTER);

    END;

    END;                    ! End of DO_PARITY

%SBTTL 'Parity routine'

GLOBAL ROUTINE GEN_PARITY (CHARACTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will add parity to the character that is supplied.
!
! CALLING SEQUENCE:
!
!    CHARACTER = GEN_PARITY(CHARACTER)
!
! INPUT PARAMETERS:
!
!    CHARACTER - Produce the parity for this character depending on the
!        setting of the SET PARITY switch.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    LOCAL
    TEMP_CHAR;

    IF .IBM_FLAG THEN RETURN .CHARACTER OR %O'200';

    CASE .PARITY_TYPE FROM PR_MIN TO PR_MAX OF
    SET

    [PR_NONE] :
        RETURN .CHARACTER;

    [PR_SPACE] :
        RETURN .CHARACTER AND %O'177';

    [PR_MARK] :
        RETURN .CHARACTER OR %O'200';

    [PR_ODD] :
        TEMP_CHAR = .CHARACTER AND %O'177' OR %O'200';

    [PR_EVEN] :
        TEMP_CHAR = .CHARACTER AND %O'177';
    TES;

    TEMP_CHAR = .TEMP_CHAR XOR (.TEMP_CHAR^-4);
    TEMP_CHAR = .TEMP_CHAR XOR (.TEMP_CHAR^-2);

    IF .TEMP_CHAR<0, 2> EQL %B'01' OR .TEMP_CHAR<0, 2> EQL %B'10'
    THEN
    RETURN .CHARACTER AND %O'177' OR %O'200'
    ELSE
    RETURN .CHARACTER AND %O'177';

    END;                    ! End of GEN_PARITY


%SBTTL 'Per transfer -- Initialization'
ROUTINE INIT_XFR : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will initialize the various locations that the
!    send and receive statistics are kept.
!
! CALLING SEQUENCE:
!
!    INIT_XFR();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Determine if we should do 8 bit quoting
!

    IF .PARITY_TYPE NEQ PR_NONE
    THEN
    BEGIN
    RECV_8QUOTE_CHR = .RCV_8QUOTE_CHR;
    END
    ELSE
    BEGIN
    RECV_8QUOTE_CHR = %C'Y';
    END;

    NUM_RETRIES = 0;
    SEND_8QUOTE_CHR = .RECV_8QUOTE_CHR;
!
! Send parameters that may not get set before we need them for the first
! time.
!
    SEND_PKT_SIZE = ABS (.SND_PKT_SIZE);
    SEND_NPAD = ABS (.SND_NPAD);
    SEND_PADCHAR = ABS (.SND_PADCHAR);
    SEND_TIMEOUT = ABS (.SND_TIMEOUT);
    SEND_EOL = ABS (.SND_EOL);
    SEND_QUOTE_CHR = ABS (.SND_QUOTE_CHR);
!
! For initialization messages, we must use single character checksum
! When the send-init/ack sequence has been done, we will switch to the
! desired form
!
    BLK_CHK_TYPE = CHK_1CHAR;
    INI_CHK_TYPE = .CHKTYPE;            ! Send desired type
!
! Set desired repeat character for use in we are doing send-init
! Will be overwritten by other ends desired character if it sends
! the send-init.
!
    REPT_CHR = .SET_REPT_CHR;
!
! Assume packet assembly/disassembly uses characters from a file
!
    GET_CHR_ROUTINE = GET_FILE;            ! Initialize the get-a-char routine
    PUT_CHR_ROUTINE = PUT_FILE;            ! And the put-a-char
    TEXT_HEAD_FLAG = FALSE;            ! And assume we will get an File header
    NO_FILE_NEEDED = FALSE;            ! Assume will do file ops
    INIT_PKT_SENT = FALSE;            ! And no server-init sent
!
! Always start with packet number 0
!
    MSG_NUMBER = 0;                ! Initial message number
!
! Stats information
!
    SMSG_TOTAL_CHARS = 0;
    RMSG_TOTAL_CHARS = 0;
    SMSG_DATA_CHARS = 0;
    RMSG_DATA_CHARS = 0;
    SMSG_COUNT = 0;
    RMSG_COUNT = 0;
    RMSG_NAKS = 0;
    SMSG_NAKS = 0;
    XFR_TIME = SY_TIME ();
    END;                    ! End of INIT_XFR

%SBTTL 'Statistics -- Finish message transfer'
ROUTINE END_STATS : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will end the collection of the statistices.  It will
!    update the various overall statistic parameters.
!
! CALLING SEQUENCE:
!
!    END_STATS ();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    SND_COUNT = .SND_COUNT + .SMSG_COUNT;
    RCV_COUNT = .RCV_COUNT + .RMSG_COUNT;
    SND_TOTAL_CHARS = .SND_TOTAL_CHARS + .SMSG_TOTAL_CHARS;
    SND_DATA_CHARS = .SND_DATA_CHARS + .SMSG_DATA_CHARS;
    RCV_TOTAL_CHARS = .RCV_TOTAL_CHARS + .RMSG_TOTAL_CHARS;
    RCV_DATA_CHARS = .RCV_DATA_CHARS + .RMSG_DATA_CHARS;
    SND_NAKS = .SND_NAKS + .SMSG_NAKS;
    RCV_NAKS = .RCV_NAKS + .RMSG_NAKS;
    XFR_TIME = SY_TIME () - .XFR_TIME;
    TOTAL_TIME = .TOTAL_TIME + .XFR_TIME;
    END;                    ! End of END_STATS

%SBTTL 'Status type out -- STS_OUTPUT'
ROUTINE STS_OUTPUT : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will output the current status of a transfer.
!    This is used when the user types a ^A during a transfer.
!
! CALLING SEQUENCE:
!
!    STS_OUTPUT ()
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    Statistics blocks, file names, etc.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TT_CHAR (%C'[');                ! Start the message

    CASE .STATE FROM STATE_MIN TO STATE_MAX OF
    SET

    [STATE_ID, STATE_II] :
        TT_TEXT (UPLIT (%ASCIZ'Idle in server mode'));

    [STATE_S, STATE_SF] :
        BEGIN
        TT_TEXT (UPLIT (%ASCIZ'Initializing for sending file '));
        TT_TEXT (FILE_NAME);
        END;

    [STATE_SI] :
        TT_TEXT (UPLIT (%ASCIZ'Initializing for remote command'));

    [STATE_SG] :
        TT_TEXT (UPLIT (%ASCIZ'Waiting for response to remote command'));

    [STATE_SD] :
        BEGIN
        TT_NUMBER (.FILE_CHARS);
        TT_TEXT (UPLIT (%ASCIZ' characters sent for file '));
        TT_TEXT (FILE_NAME);
        END;

    [STATE_SZ] :
        BEGIN
        TT_TEXT (UPLIT (%ASCIZ'At end of file '));
        TT_TEXT (FILE_NAME);
        END;

    [STATE_SB] :
        TT_TEXT (UPLIT (%ASCIZ'Finishing transfer session'));

    [STATE_R] :
        TT_TEXT (UPLIT (%ASCIZ'Waiting for initialization'));

    [STATE_RF] :
        TT_TEXT (UPLIT (%ASCIZ'Waiting for next file or end of session'));

    [STATE_RD] :
        BEGIN
        TT_NUMBER (.FILE_CHARS);
        TT_TEXT (UPLIT (%ASCIZ' characters received for file '));
        TT_TEXT (FILE_NAME);
        END;

    [STATE_C] :
        TT_TEXT (UPLIT (%ASCIZ' Session complete'));

    [STATE_A] :
        TT_TEXT (UPLIT (%ASCIZ' Session aborted'));

    [INRANGE, OUTRANGE] :
        TT_TEXT (UPLIT (%ASCIZ' Unknown state'));
    TES;

    SELECTONE .STATE OF
    SET

    [STATE_S, STATE_SF, STATE_SD, STATE_SZ, STATE_SB] :
        BEGIN

        IF .RMSG_NAKS GTR 0
        THEN
        BEGIN
        TT_TEXT (UPLIT (%ASCIZ', '));
        TT_NUMBER (.RMSG_NAKS);
        TT_TEXT (UPLIT (%ASCIZ' NAKs received'));
        END;

        END;

    [STATE_R, STATE_RF, STATE_RD] :
        BEGIN

        IF .SMSG_NAKS GTR 0
        THEN
        BEGIN
        TT_TEXT (UPLIT (%ASCIZ', '));
        TT_NUMBER (.SMSG_NAKS);
        TT_TEXT (UPLIT (%ASCIZ' NAKs sent'));
        END;

        END;
    TES;

    TT_CHAR (%C']');                ! End the line
    TT_CRLF ();                    ! with a CRLF
    END;                    ! End of STS_OUTPUT

%SBTTL 'TYPE_CHAR - Type out a character'
ROUTINE TYPE_CHAR (CHARACTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is used as an alternate output routine for BFR_EMPTY.
! It will type the character on the terminal, and always return a
! true status.
!
! CALLING SEQUENCE:
!
!    STATUS = TYPE_CHAR (.CHARACTER);
!
! INPUT PARAMETERS:
!
!    CHARACTER - The character to type
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    TT_CHAR (.CHARACTER);            ! Type the character
    RETURN KER_NORMAL;                ! And return OK
    END;                    ! End of TYPE_CHAR

%SBTTL 'Debugging -- DBG_SEND'
ROUTINE DBG_SEND (ADDRESS, LENGTH) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will output the message that is going to be sent
!    as part of the debugging information that is turned on in the
!    SET DEBUG command.
!
! CALLING SEQUENCE:
!
!    DBG_SEND(MSG_ADDRESS, MSG_LENGTH);
!
! INPUT PARAMETERS:
!
!    MSG_ADDRESS - Address of the message that is going to be sent
!        to the remote KERMIT.  The bytes are CHR_SIZE.
!    MSG_LENGTH - Length of the message.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    BIND
    SEND_TEXT = UPLIT (%ASCIZ'Sending...');

    IF .DEBUG_FLAG
    THEN
    BEGIN

    LOCAL
        OLD_RTN;

    OLD_RTN = TT_SET_OUTPUT (DBG_DUMP);
    TT_TEXT (SEND_TEXT);
    DBG_MESSAGE (.ADDRESS, .LENGTH);
    TT_SET_OUTPUT (.OLD_RTN);
    END;

    END;                    ! End of DBG_SEND

%SBTTL 'Debugging -- DBG_RECEIVE'
ROUTINE DBG_RECEIVE (ADDRESS) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will output the message that was received from
!    the remote KERMIT.  This routine is called only if the DEBUG_FLAG
!    is true.
!
! CALLING SEQUENCE:
!
!    DBG_RECEIVE(MSG_ADDRESS);
!
! INPUT PARAMETERS:
!
!    MSG_ADDRESS - Address of the message received by the remote KERMIT.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    BIND
    RECEIVE_TEXT = UPLIT (%ASCIZ'Received...');

    IF .DEBUG_FLAG
    THEN
    BEGIN

    LOCAL
        OLD_RTN;

    OLD_RTN = TT_SET_OUTPUT (DBG_DUMP);
    TT_TEXT (RECEIVE_TEXT);
    DBG_MESSAGE (.ADDRESS, .REC_LENGTH);
    TT_SET_OUTPUT (.OLD_RTN);
    END;

    END;                    ! End of DBG_RECEIVE

%SBTTL 'Debugging -- DBG_MESSAGE'
ROUTINE DBG_MESSAGE (MSG_ADDRESS, MSG_LENGTH) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will display a message that is either being sent
!    or received on the user's terminal.
!
! CALLING SEQUENCE:
!
!    DBG_MESSAGE(MSG_ADDRESS, MSG_LENGTH);
!
! INPUT PARAMETERS:
!
!    MSG_ADDRESS - Address of the message to be output
!    MSG_LENGTH - Length of the message to be output.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    MAP
    MSG_ADDRESS : REF VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)];    ! Point to the vector

    LOCAL
    OLD_RTN,                ! Old type out routine
    CHKSUM,                    ! Numeric value of block check
    TEMP_POINTER,                ! Temporary character pointer
    MSG_LEN;

!
! Message type text
!

    BIND
    DATA_TEXT = UPLIT (%ASCIZ' (Data)'),
    ACK_TEXT = UPLIT (%ASCIZ' (ACK)'),
    NAK_TEXT = UPLIT (%ASCIZ' (NAK)'),
    SND_INIT_TEXT = UPLIT (%ASCIZ' (Send init)'),
    BREAK_TEXT = UPLIT (%ASCIZ' (Break)'),
    TEXT_TEXT = UPLIT (%ASCIZ' (Text header)'),
    FILE_TEXT = UPLIT (%ASCIZ' (File header)'),
    EOF_TEXT = UPLIT (%ASCIZ' (EOF)'),
    ERROR_TEXT = UPLIT (%ASCIZ' (Error)'),
    RCV_INIT_TEXT = UPLIT (%ASCIZ' (Receive initiate)'),
    COMMAND_TEXT = UPLIT (%ASCIZ' (Command)'),
    KERMIT_TEXT = UPLIT (%ASCIZ' (Generic KERMIT command)');

!
! Header information
!

    BIND
    MN_TEXT = UPLIT (%ASCIZ'Message number: '),
    LENGTH_TEXT = UPLIT (%ASCIZ'    Length: '),
    DEC_TEXT = UPLIT (%ASCIZ' (dec)'),
    MSG_TYP_TEXT = UPLIT (%ASCIZ'Message type: '),
    CHKSUM_TEXT = UPLIT (%ASCIZ'Checksum: '),
    CHKSUM_NUM_TEXT = UPLIT (%ASCIZ' = '),
    OPT_DATA_TEXT = UPLIT (%ASCIZ'Optional data: '),
    PRE_CHAR_TEXT = UPLIT (%ASCIZ' "');

!
! Ensure that the type out will go to the debugging location
!
    OLD_RTN = TT_SET_OUTPUT (DBG_DUMP);
!
! Preliminary calculations
!
    MSG_LEN = UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_COUNT, CHR_SIZE)));
!
! First output some header information for the packet.
!
    TT_CRLF ();
    TT_TEXT (MN_TEXT);
    TT_NUMBER (UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_SEQ, CHR_SIZE))));
    TT_TEXT (DEC_TEXT);
    TT_TEXT (LENGTH_TEXT);
    TT_NUMBER (.MSG_LEN);
    TT_TEXT (DEC_TEXT);
    TT_CRLF ();
!
! Now output the message type and dependent information
!
    TT_TEXT (MSG_TYP_TEXT);
    TT_CHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_TYPE, CHR_SIZE)));

    SELECTONE CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_TYPE, CHR_SIZE)) OF
    SET

    [MSG_DATA] :
        TT_TEXT (DATA_TEXT);

    [MSG_ACK] :
        TT_TEXT (ACK_TEXT);

    [MSG_NAK] :
        TT_TEXT (NAK_TEXT);

    [MSG_SND_INIT] :
        TT_TEXT (SND_INIT_TEXT);

    [MSG_BREAK] :
        TT_TEXT (BREAK_TEXT);

    [MSG_FILE] :
        TT_TEXT (FILE_TEXT);

    [MSG_TEXT] :
        TT_TEXT (TEXT_TEXT);

    [MSG_EOF] :
        TT_TEXT (EOF_TEXT);

    [MSG_ERROR] :
        TT_TEXT (ERROR_TEXT);

    [MSG_GENERIC] :
        TT_TEXT (KERMIT_TEXT);

    [MSG_COMMAND] :
        TT_TEXT (COMMAND_TEXT);
    TES;

    TT_CRLF ();
!
! Now output any of the optional data.
!

    IF .MSG_LEN - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR) NEQ 0
    THEN
    BEGIN
    TT_TEXT (OPT_DATA_TEXT);
    TT_CRLF ();
    TEMP_POINTER = CH$PTR (.MSG_ADDRESS, PKT_MSG, CHR_SIZE);

    INCR I FROM 1 TO .MSG_LEN - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR) DO
        BEGIN

        IF (.I MOD 10) EQL 1
        THEN
        BEGIN
        TT_CRLF ();
        TT_CHAR (CHR_TAB);
        END;

        TT_TEXT (PRE_CHAR_TEXT);
        TT_CHAR (CH$RCHAR_A (TEMP_POINTER));
        TT_CHAR (%C'"');
        END;

    IF ((.MSG_LEN - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR)) MOD 10) EQL 1 THEN TT_CRLF ();

    TT_CRLF ();
    END;

!
! Now output the checksum for the message that we received
!
! This could be either 1 two or three characters.
    TT_TEXT (CHKSUM_TEXT);
    TEMP_POINTER = CH$PTR (.MSG_ADDRESS,
    PKT_MSG + .MSG_LEN + PKT_CHKSUM - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR), CHR_SIZE);

    CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF
    SET

    [CHK_1CHAR] :
        BEGIN
        TT_TEXT (PRE_CHAR_TEXT);
        TT_CHAR (CH$RCHAR (.TEMP_POINTER));
        TT_CHAR (%C'"');
        CHKSUM = UNCHAR (CH$RCHAR (.TEMP_POINTER));
        END;

    [CHK_2CHAR] :
        BEGIN
        CHKSUM = 0;
        TT_TEXT (PRE_CHAR_TEXT);
        TT_CHAR (CH$RCHAR (.TEMP_POINTER));
        TT_CHAR (%C'"');
        CHKSUM<6, 6> = UNCHAR (CH$RCHAR_A (TEMP_POINTER));
        TT_TEXT (PRE_CHAR_TEXT);
        TT_CHAR (CH$RCHAR (.TEMP_POINTER));
        TT_CHAR (%C'"');
        CHKSUM<0, 6> = UNCHAR (CH$RCHAR (.TEMP_POINTER));
        END;

    [CHK_CRC] :
        BEGIN
        CHKSUM = 0;
        TT_TEXT (PRE_CHAR_TEXT);
        TT_CHAR (CH$RCHAR (.TEMP_POINTER));
        TT_CHAR (%C'"');
        CHKSUM<12, 4> = UNCHAR (CH$RCHAR_A (TEMP_POINTER));
        TT_TEXT (PRE_CHAR_TEXT);
        TT_CHAR (CH$RCHAR (.TEMP_POINTER));
        TT_CHAR (%C'"');
        CHKSUM<6, 6> = UNCHAR (CH$RCHAR_A (TEMP_POINTER));
        TT_TEXT (PRE_CHAR_TEXT);
        TT_CHAR (CH$RCHAR (.TEMP_POINTER));
        TT_CHAR (%C'"');
        CHKSUM<0, 6> = UNCHAR (CH$RCHAR (.TEMP_POINTER));
        END;
    TES;

    TT_TEXT (CHKSUM_NUM_TEXT);
    TT_NUMBER (.CHKSUM);
    TT_TEXT (DEC_TEXT);
    TT_CRLF ();
    TT_SET_OUTPUT (.OLD_RTN);            ! Reset output destination
    END;                    ! End of DBG_MESSAGE

%SBTTL 'End of KERMSG'
END

ELUDOM