%TITLE 'KERMSG - Kermit message processing'
MODULE KERMSG (IDENT = '3.3.108'
		) =
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.
!
! 3.1.042	By: Nick Bush			On: 27-August-1984
!		If we get too many retries when sending a server init (I)
!		packet, don't abort.  Instead, just try sending the server
!		command, since the Kermit on the other end might be coded
!		wrong and is responding to packets it doesn't understand
!		with a NAK.
!
! 3.1.043	By: Nick Bush			On: 27-August-1984
!		Don't abort receives on zero length messages.  Just treat
!		it like a timeout.
!
! 3.1.044	By: Nick Bush			On: 10-April-1985
!		Remove IBM mode.  It will be instituted by IBM_CHAR being
!		set >= 0 if handshaking is needed.
!
! 3.1.045	BY: David Stevens		On: 15-July-1985
!		Fix terminal message for multiple file sendings. Type out
!		"Sending: " in the system dependent NEXT_FILE routine.
!
! Start of version 3.2
!
! 3.2.070	By: Robert McQueen		On: 17-Dec-1985
!		Fix CRC calculations when sending 8 bit data and not
!		using 8 bit quoting.
!
! 3.2.071	By: Robert McQueen		On: 11-March-186
!		Include space in the message buffer for the line termination
!		character.
!
! 3.3.100	By: Gregory P. Welsh	    On: 1-June-1986
!		Made FILE_OPEN_FLAG GLOBAL so it could be updated properly for
!		Transmit function from module KERTRM. Also renamed it to
!		FFILE_OPEN_FLAG so it could be distinguished externally from
!		routine FILE_OPEN.
!
! 3.3.104	By: Robert McQueen			On: 5-July-1986
!		Add changes/fixes suggested by Art Guion and David Deley for
!		KERMSG.BLI.
!		- Always attempt a handshake in IBM mode.  Failing to handshake
!		  may cause 3704/5 style controller to hang a VM system.
!		- Don't lose the last character in a buffer.   BFR_FILL logic
!		  forgets to send the last cahracters of a file when it doesn't
!		  fit into the current packet.
!
! 3.3.107	By: Antonino N. Mione			On: 8-Sep-1986
!		Do not abort on ERROR packet while in SERVER mode. Instead,
!		return to SERVER IDLE mode.
!
! 3.3.108	By: Dan Norstedt		On: 17-June-1989
!		Added sketchy support for Extended Length packets;
!		Header parity is computed, but not used.
!		Undone 3.3.107, to allow for Ctrl-Cs to work properly
!--

%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.
!	FLAG_FILE_OPEN
!		File is opened.
!
!--

%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.
! [108] Charavcter count = 0 means extended length type packet.
!
! <CHAR(Seq)>
!	Packet sequence number, modulo 100 (octal).
!
! [108]	<CHAR(Type)>
! [108]		Packet type, usually a mnemonic ASCII character.
! [108]
! [108]	For Extended Length packets only:
! [108]   <CHAR(Count/95)>
! [108]		Count of the number of characters / 95, from (HeaderCheck)
! [108]
! [108]   <CHAR(Count MOD 95)>
! [108]		Count of the number of characters MOD 95, from (HeaderCheck)
! [108]
! [108]   <CHAR(HeaderCheck)>
! [108]		Kermit type-1 checksum of the 5 preceding ASCII characters.
!
! <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_COUNTX1 = 4,			! [108]	! Ext. pkt: <CHAR(MSB(Count))>
    PKT_COUNTX2 = 5,			! [108]	! Ext. pkt: <CHAR(LSB(Count))>
    PKT_HCHECK = 6,			! [108]	! Ext. pkt: Header parity
    PKT_MSGX = 7,			! [108]	! <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
! [108]   PKT_OVR_HEAD_B = 2,			! Header overhead
! [108]   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).
!
! [108]	Capability byte(s)
! [108]		Bit mask containing extra capabilities, currently we only use
! [108]		bit 1 (extended-length packets) and bit 0 (more capability
! [108]		bytes follows).
! [108]
! [108]	Window length (not used)
! [108]
! [108]	Extended packet length
! [108]		Maximum length for extended-length packets
!
!--

LITERAL
    P_SI_BUFSIZ = 0,				! Buffersize
    MY_PKT_SIZE = 80,				! My packet size
    P_SI_TIMOUT = 1,				! Time out
    MY_TIME_OUT = 60,			! [046] Increased ! 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 std message
					! [108]
    P_SI_CAPAS = 9,			! [108]	! Capability field (if used)
    EXTLEN_CAPAS = 2,			! [108]	! Extended length packets
    P_SI_WINDO = 10,			! [108]	! (Send only) Not used, filler
    P_SI_MAXLX1 = 11,			! [108]	! (Send only) Ext. len / 95
    MY_MAXLX1 = 0,			! [108]
    P_SI_MAXLX2 = 12,			! [108]	! (Send only) Ext. len MOD 95
    MY_MAXLX2 = 80,			! [108]
					! [108]
    P_SI_XLENGTH = 13;			! [108]	! (Send only) Len of ext. msg

%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_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
    RECV_PKT_MSG,			! [108]	! Msg offset (4 std, 7 ext.)
!
! 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
    SEND_INIT_SIZE,				! Size of INIT message
!
! 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
! [108]						  Negative len for ext msgs
    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 + 1, CHR_SIZE)],	! Message received
    SND_MSG : VECTOR [CH$ALLOCATION (MAX_MSG + 1, CHR_SIZE)],	! Message sent
    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,			! Address of routine to get a character for BFR_FILL
    PUT_CHR_ROUTINE;			! Address of routine to put a character for BFR_EMPTY
!
! KERMSG Global storage
!
GLOBAL
    FLAG_FILE_OPEN;			! File is opened.

%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
    FLAG_FILE_OPEN = FALSE;
    IBM_CHAR = -1;				![044] No handsake by default
    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 .FLAG_FILE_OPEN
		THEN
		    BEGIN
		    FLAG_FILE_OPEN = 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, .SEND_INIT_SIZE, .REC_SEQ)) ! [108]
		    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, .SEND_INIT_SIZE, .REC_SEQ) ! [108]
		    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_SG;

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

    IF NOT SEND_PACKET (MSG_SER_INIT, .SEND_INIT_SIZE, .MSG_NUMBER) THEN RETURN
 STATE_A; ! [108]

![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 NEQ 0			! [108]
    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, .RECV_PKT_MSG, CHR_SIZE)) OF ! [108]
		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 NEQ 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 .FLAG_FILE_OPEN 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);
	FLAG_FILE_OPEN = 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
	FLAG_FILE_OPEN = 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
!![045]	    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, .SEND_INIT_SIZE, .MSG_NUMBER) THEN RETURN
 STATE_EX; ! [108]

!
! 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 FLAG_FILE_OPEN = 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, .SEND_INIT_SIZE, .MSG_NUMBER);	! [108] ! 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, .SEND_INIT_SIZE, .MSG_NUMBER);	! [108]
    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, .SEND_INIT_SIZE, .REC_SEQ); ! [108]
		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
	    FLAG_FILE_OPEN = 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
		FLAG_FILE_OPEN = FALSE;
		DISCARD_FILE_FLAG = FALSE;	! Assume we want file

		IF .REC_LENGTH EQL 1
		THEN

		    IF CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG, CHR_SIZE)) EQL
 MSG_EOF_DISCARD ! [108]
		    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		! [108]
      (IF .SND_PKT_SIZE GTR 94 THEN 94 ELSE .SND_PKT_SIZE) ELSE	! [108]
	BEGIN

	IF .REC_LENGTH GTR P_SI_BUFSIZ
	THEN
	    UNCHAR (CH$RCHAR (CH$PTR (REC_MSG,
			.RECV_PKT_MSG + P_SI_BUFSIZ, CHR_SIZE))) ! [108]
	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,
			.RECV_PKT_MSG + P_SI_TIMOUT, CHR_SIZE))) ! [108]
	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, .RECV_PKT_MSG + P_SI_NPAD,
			CHR_SIZE)))				       ! [108]
	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, .RECV_PKT_MSG + P_SI_PAD,
			CHR_SIZE)))				       ! [108]
	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, .RECV_PKT_MSG + P_SI_EOL,
			CHR_SIZE)))				       ! [108]
	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, .RECV_PKT_MSG + P_SI_QUOTE,     ! [108]
		    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,
		.RECV_PKT_MSG + P_SI_8QUOTE, CHR_SIZE)) ELSE %C'N' ! [108] ! 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, .RECV_PKT_MSG +      ! [108]
					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,
		.RECV_PKT_MSG + P_SI_REPEAT, CHR_SIZE)) ELSE %C' ');   ! [108]
!								       ! [108]
! Parse the capas field, if present and if we enabled extended length  ! [108]
!								       ! [108]
								       ! [108]
    IF (.REC_LENGTH GTR P_SI_CAPAS) AND (ABS(.SND_PKT_SIZE) GTR 94)    ! [108]
    THEN							       ! [108]
	BEGIN							       ! [108]
								       ! [108]
	LOCAL							       ! [108]
	    CAPAS_OFFSET;					       ! [108]
								       ! [108]
	CAPAS_OFFSET = .RECV_PKT_MSG + P_SI_CAPAS;		       ! [108]

	IF (UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, .CAPAS_OFFSET, CHR_SIZE))) AND 2) NEQ 0
	THEN							       ! [108]
	    BEGIN						       ! [108]
								       ! [108]
	    SEND_PKT_SIZE = 500;				       ! [108]
								       ! [108]
	    WHILE (.REC_LENGTH GTR .CAPAS_OFFSET-.RECV_PKT_MSG) AND    ! [108]
		  ((UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, .CAPAS_OFFSET,  ! [108]
		    			CHR_SIZE))) AND 1) EQL 1) DO   ! [108]
		BEGIN						       ! [108]
		CAPAS_OFFSET = .CAPAS_OFFSET + 1;		       ! [108]
		END;						       ! [108]
	    IF .REC_LENGTH GTR .CAPAS_OFFSET-.RECV_PKT_MSG+3	       ! [108]
	    THEN						       ! [108]
		SEND_PKT_SIZE = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG,     ! [108]
					.CAPAS_OFFSET+2, CHR_SIZE))) * 95 +
				UNCHAR (CH$RCHAR (CH$PTR (REC_MSG,     ! [108]
					.CAPAS_OFFSET+3, CHR_SIZE)));  ! [108]
	    IF .SEND_PKT_SIZE GTR MAX_MSG - 2			       ! [108]
	    THEN						       ! [108]
		SEND_PKT_SIZE = MAX_MSG - 2;			       ! [108]
	    IF .SEND_PKT_SIZE GTR ABS(.SND_PKT_SIZE)		       ! [108]
	    THEN						       ! [108]
		SEND_PKT_SIZE = ABS(.SND_PKT_SIZE);		       ! [108]
	    END;						       ! [108]
	END;							       ! [108]
!
! 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 ((IF .RCV_PKT_SIZE LSS 94 THEN .RCV_PKT_SIZE ELSE 94)),
		CH$PTR (SND_MSG, PKT_MSG + P_SI_BUFSIZ, CHR_SIZE)); ! [108]
    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));
    SEND_INIT_SIZE = P_SI_LENGTH;				       ! [108]
    IF .RCV_PKT_SIZE GTR 94					       ! [108]
    THEN							       ! [108]
	BEGIN							       ! [108]
	CH$WCHAR (CHAR (EXTLEN_CAPAS), CH$PTR (SND_MSG, PKT_MSG + P_SI_CAPAS,
 CHR_SIZE));
	CH$WCHAR (CHAR (0), CH$PTR (SND_MSG, PKT_MSG + P_SI_WINDO, CHR_SIZE));
	CH$WCHAR (CHAR (.RCV_PKT_SIZE/95), CH$PTR (SND_MSG, PKT_MSG + P_SI_MAXLX1,
 CHR_SIZE));
	CH$WCHAR (CHAR (.RCV_PKT_SIZE MOD 95), CH$PTR (SND_MSG, PKT_MSG + P_SI_MAXLX2,
 CHR_SIZE));
								       ! [108]
	SEND_INIT_SIZE = P_SI_XLENGTH;				       ! [108]
	END;							       ! [108]

    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.
! [108]		 Negative length means it's an extended length packet
!
! 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 (IF .MN LSS 0 THEN 0 ELSE .MN), CH$PTR (SND_MSG, PKT_SEQ,
 CHR_SIZE));

    IF .LENGTH LSS 0						       ! [108]
    THEN							       ! [108]
	BEGIN							       ! [108]
	TOT_MSG_LEN = PKT_OVR_HEAD + 3 - .LENGTH;		       ! [108]
	CH$WCHAR (CHAR (0), CH$PTR (SND_MSG, PKT_COUNT, CHR_SIZE));    ! [108]
	CH$WCHAR (CHAR ((.TOT_MSG_LEN - PKT_HCHECK + 1 +	       ! [108]
			 (.BLK_CHK_TYPE - CHK_1CHAR)) / 95),	       ! [108]
			CH$PTR (SND_MSG, PKT_COUNTX1, CHR_SIZE));      ! [108]
	CH$WCHAR (CHAR ((.TOT_MSG_LEN - PKT_HCHECK + 1 +	       ! [108]
			 (.BLK_CHK_TYPE - CHK_1CHAR)) MOD 95),	       ! [108]
			CH$PTR (SND_MSG, PKT_COUNTX2, CHR_SIZE));      ! [108]

	POINTER = CH$PTR(SND_MSG, PKT_SEQ, CHR_SIZE);		       ! [108]
	CHKSUM = CHAR (0) + CH$RCHAR_A (POINTER);		       ! [108]
	CHKSUM = .CHKSUM + CH$RCHAR_A (POINTER);		       ! [108]
	CHKSUM = .CHKSUM + CH$RCHAR_A (POINTER);		       ! [108]
	CHKSUM = .CHKSUM + CH$RCHAR_A (POINTER);		       ! [108]

	CH$WCHAR (CHAR ((.CHKSUM + ((.CHKSUM AND %O'300')/%O'100')) AND %O'77'),
			CH$PTR (SND_MSG, PKT_HCHECK, CHR_SIZE));       ! [108]
	END							       ! [108]
    ELSE							       ! [108]
	BEGIN							       ! [108]
	TOT_MSG_LEN = PKT_OVR_HEAD + .LENGTH;			       ! [108]
	CH$WCHAR (CHAR (.TOT_MSG_LEN + (.BLK_CHK_TYPE - CHK_1CHAR)),   ! [108]
				CH$PTR (SND_MSG, PKT_COUNT, CHR_SIZE));
	END;							       ! [108]

!
! Calculate the block check value
!
    POINTER = CH$PTR (SND_MSG, PKT_MARK + 1, CHR_SIZE);
    CHKSUM = CALC_BLOCK_CHECK (.POINTER, .TOT_MSG_LEN);		       ! [108]
!
! Store the checksum into the message
!
    POINTER = CH$PTR (SND_MSG, .TOT_MSG_LEN + 1, CHR_SIZE);	       ! [108]

    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 + PKT_TOT_OVR_HEAD - PKT_OVR_HEAD));
!
! Update the stats for total characters and the data characters
!
    SMSG_TOTAL_CHARS = .SMSG_TOTAL_CHARS + .TOT_MSG_LEN + PKT_TOT_OVR_HEAD -
 PKT_OVR_HEAD;
! 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_CHAR GEQ 0) 			! If handshaking on
    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 + PKT_TOT_OVR_HEAD - PKT_OVR_HEAD);
    RETURN SEND (SND_MSG, .TOT_MSG_LEN + PKT_TOT_OVR_HEAD - PKT_OVR_HEAD);
    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 ();
![043] Don't abort on errors which might just be due to noise.

	    IF NOT .STATUS AND .STATUS NEQ KER_CHKSUMERR AND .STATUS NEQ KER_TIMEOUT
 AND .STATUS NEQ
		KER_ZEROLENMSG
	    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;

    IF UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNT, CHR_SIZE))) EQL 0 ! [108]
    THEN							       ! [108]
	BEGIN							       ! [108]
	IF .MSG_LENGTH LSS PKT_TOT_OVR_HEAD - 1 + 3		       ! [108]
	THEN							       ! [108]
	    BEGIN						       ! [108]
	    RETURN KER_ZEROLENMSG;				       ! [108]
	    END;						       ! [108]
	END;							       ! [108]
!
! 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.
!
    RECV_PKT_MSG = PKT_MSG;					       ! [108]
    REC_LENGTH = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNT, CHR_SIZE)));
    IF .REC_LENGTH EQL 0					       ! [108]
    THEN							       ! [108]
	BEGIN							       ! [108]
	REC_LENGTH = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNTX1, CHR_SIZE))) * 95 +
		UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNTX2, CHR_SIZE))) +
						PKT_HCHECK - 1;	       ! [108]
	RECV_PKT_MSG = PKT_MSGX;				       ! [108]
	END;							       ! [108]

    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);
    REC_LENGTH = .REC_LENGTH - (.BLK_CHK_TYPE - CHK_1CHAR);	       ! [108]
    CHKSUM = CALC_BLOCK_CHECK (.POINTER, .REC_LENGTH);		       ! [108]
    POINTER = CH$PTR (REC_MSG, .REC_LENGTH + 1, CHR_SIZE);	       ! [108]
    REC_LENGTH = .REC_LENGTH - .RECV_PKT_MSG + 1;		       ! [108]
    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 + .RECV_PKT_MSG - 1); !
 [108]
	    POINTER = CH$PTR (REC_MSG, .REC_LENGTH + .RECV_PKT_MSG, CHR_SIZE); ! [108]

	    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 NEQ 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;
    IF .SEND_PKT_SIZE GTR 94					       ! [108]
    THEN							       ! [108]
	BEGIN							       ! [108]
	POINTER = CH$PTR (SND_MSG, PKT_MSGX, CHR_SIZE);		       ! [108]
	MAX_SIZE = .SEND_PKT_SIZE - PKT_MSGX + 1 - (.BLK_CHK_TYPE - CHK_1CHAR);
	END							       ! [108]
    ELSE							       ! [108]
	BEGIN							       ! [108]
	POINTER = CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE);		       ! [108]
	MAX_SIZE = .SEND_PKT_SIZE - PKT_MSG + 1 - (.BLK_CHK_TYPE - CHK_1CHAR);
        END;							       ! [108]
!
! 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;
!
! If this is the last character of the file,
! remember that for next time, but give good return now.
!
		IF .CHAR_8_BIT EQL EOF_CHAR
		THEN
		    BEGIN
		    NEXT_CHR = EOF_CHAR;
		    STATUS = KER_NORMAL
		    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 had to defer EOF condition, reactivate it now.
!
	    IF (.CHAR_8_BIT EQL EOF_CHAR) THEN STATUS = KER_EOF;
!
! 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;

! [108] Return negative size if we use extend packet format

    IF .SEND_PKT_SIZE GTR 94					       ! [108]
    THEN							       ! [108]
	SIZE = -.SIZE;						       ! [108]

!
! 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, .RECV_PKT_MSG, CHR_SIZE);	       ! [108]
    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;


    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_MSG,			! [108]	! Starting point for data
	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)));
    MSG_MSG = PKT_MSG;						       ! [108]
    IF .MSG_LEN EQL 0						       ! [108]
    THEN							       ! [108]
	BEGIN							       ! [108]
	MSG_LEN = UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_COUNTX1, CHR_SIZE))) * 95
 +
		UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_COUNTX2, CHR_SIZE))) +
						PKT_HCHECK - 1;	       ! [108]
	MSG_MSG = PKT_MSGX;					       ! [108]
	END;							       ! [108]

!
! 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 - .MSG_MSG + 1 - (.BLK_CHK_TYPE - CHK_1CHAR) NEQ 0     ! [108]
    THEN
	BEGIN
	TT_TEXT (OPT_DATA_TEXT);
	TT_CRLF ();
	TEMP_POINTER = CH$PTR (.MSG_ADDRESS, .MSG_MSG, CHR_SIZE);      ! [108]

	INCR I FROM 1 TO .MSG_LEN - .MSG_MSG + 1 - (.BLK_CHK_TYPE - CHK_1CHAR) DO !
 [108]
	    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 - .MSG_MSG + 1 - (.BLK_CHK_TYPE - CHK_1CHAR)) MOD 10) EQL 1 THEN
 TT_CRLF (); ! [108]

	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,
	.MSG_LEN + PKT_CHKSUM + 1 - (.BLK_CHK_TYPE - CHK_1CHAR), CHR_SIZE); ! [108]

    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
