MODULE KERMIT (IDENT = '3.2.075',
		MAIN = MAIN_ROUTINE
		) =
BEGIN

BIND
    IDENT_STRING = %ASCID'VMS Kermit-32 version 3.2.075';	![012] Ident message

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

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

!++
! Start of version 1.
!
! 1.0.000	By: Robert C. McQueen		On: 4-Jan-1983
!		Create this program.
!
! 1.0.001	By: Robert C. McQueen		On: 4-May-1983
!		Allow RECEIVE without a file specification to mean
!		use what ever the remote says.
!
! 1.1.002	By: W. Hom			On: 6-July-1983
!		Implement CONNECT command.
!
! 1.2.003	By: Robert C. McQueen		On: 15-Aug-1983
!		Add SET PARITY command and SHOW PARITY to support
!		eight bit quoting.
!
! 1.2.004	By: Robert C. McQueen		On: 23-August-1983
!		Add dummy routine SY_TIME.
!
! 1.2.005	By: Robert C. McQueen		On: 23-August-1983
!		Add SET [SEND | RECEIVE] EIGHT-BIT-QUOTE <octal>
!		command.  Add message for SHOW RECEIVE and SHOW SEND parameters
!
! 1.2.006	By: Robert C. McQueen		On: 26-August-1983
!		Add BYE, FINISH and LOGOUT commands.  These commands call
!		DO_GENERIC to send generic functions to remote servers.
!
! 1.2.007	By: Robert C. McQueen		On: 16-September-1983
!		Implement SY_TIME, and XFR_STATUS routines.
!		Add more stat type out.
!
! 1.2.008	By: Robert C. McQueen		On: 19-September-1983
!		Add the SET RETRY command and the SHOW RETRY command.
!
! 1.2.009	By: Robert C. McQueen		On: 20-September-1983
!		Add CRCCLC routine for calculating CRC-CCITT.
!		Set SET BLOCK_CHECK_TYPE and SHOW BLOCK_CHECK_TYPE commands.
!
! 1.2.010	By: Nick Bush			On: 3-October-1983
!		SERVER (in KERMSG) actually returns a value.  If it
!		is "ABORTED", then we should prompt again.  This allows
!		a ^Y typed to the server to put it back into command
!		level.  (If you want to type out statistics or whatever).
!
! 2.0.011	Release VAX/VMS Kermit-32 version 2.0
!
! 2.0.012	By: Nick Bush			On: 10-Nov-1983
!		Add type out of version number.  Also fix some
!		problems with IBM mode and local echo.
!
! 2.0.013	By: Nick Bush			On: 11-Nov-1983
!		Change how debugging output is done so that it
!		can be redirected to the logical device KER$DEBUG.
!		If the logical name is defined to be something other
!		that SYS$OUTPUT, KERMIT will send any debugging output
!		there.
!
! 2.0.014	By: Robert C. McQueen		On: 16-Nov-1983
!		Make sure all message number checks are mod 64.  There
!		were four that weren't.
!
! 2.0.015	By: Nick Bush			On: 17-Nov-1983
!		Always clear purge typeahead when posting receive QIO.
!		Also, clear any typeahead just before sending a packet.
!
! 2.0.016	By: Nick Bush			On: 4-Dec-1983
!		Change how binary files are written to (hopefully) improve
!		the performance.  We will now use 510 records and only
!		write out the record when it is filled (instead of writing
!		one record per packet).  This should cut down on the overhead
!		substantially.
!
! 2.0.017	By: Nick Bush			On: 9-Dec-1983
!		Fix processing for VFC format files.  Also fix GET_ASCII
!		for PRN and FTN record types.  Change GET_ASCII so that
!		'normal' CR records get sent with trailing CRLF's instead
!		of <LF>record<CR>.  That was confusing too many people.
!
! 2.0.020	By: Nick Bush			On: 9-Dec-1983
!		Only abort (when remote) if we seen two control-Y's in
!		succession.  This way a single glitch does not kill us.
!
! 2.0.021	By: Nick Bush			On: 12-Dec-1983
!		Add status type-out character (^A), debug toggle
!		character (^D), and force timeout character (^M)
!		to those accepted during a transfer when we are remote.
!
! 2.0.022	By: Nick Bush			On: 15-Dec-1983
!		Add Fixed record size (512 byte) format for writing files.
!		This can be used for .EXE files.  Also clean up writing
!		ASCII files so that we don't lose any characters.
!
! 2.0.023	By: Nick Bush			On: 16-Dec-1983
!		Add a default terminal name for the communications line.
!		If KER$COMM is defined, that will be the default.
!
! 2.0.025	By: Robert C. McQueen		On: 22-Dec-1983
!		Use RMSG_COUNT and SMSG_COUNT now.
!
! 2.0.026	By: Nick Bush			On: 3-Jan-1984
!		Add options for format of file specification to be
!		sent in file header packets.  Also type out full file
!		specification being sent/received instead of just
!		the name we are telling the other end to use.
!
! 2.0.027	By: Nick Bush			On: 20-Jan-1984
!		Fix reset of parity to use the correct field in the
!		IO status block from the IO$_SENSEMODE.  It was using
!		the LF fill count instead.
!
! 2.0.030	By: Nick Bush			On: 3-Feb-1984
!		Add the capability of receiving a file with a different
!		name than given by KERMSG.  The RECEIVE and GET commands
!		now really are different.
!
! 2.0.031	By: Nick Bush			On: 4-Feb-1984
!		Change connect code to improve response (hopefully
!		without worsening throughput or runtime requirements).
!		When either terminal is idle we will be waiting for
!		a single character with a larger buffered read queued
!		up immediately after it.
!
! 2.0.032	By: Nick Bush			On: 25-Feb-1984
!		Add code for LOCAL and REMOTE commands.  These depend
!		upon support in KERMSG and KERSYS.
!
! 2.0.033	By: Nick Bush			On: 6-March-1984
!		Change command input and terminal processing so that
!		we will always have SYS$OUTPUT and SYS$COMMAND open
!		when they are terminals, and will also always have
!		the transfer terminal line open.  This makes it
!		unnecessary for the user to allocate a dialup line
!		in order to go between CONNECT and a transfer command,
!		and keep anyone else from grabbing the line between
!		commands.
!		Also add the command parsing for the rest of the LOCAL/REMOTE
!		commands.  This makes use of the fact that we have
!		SYS$COMMAND open to allow us to read passwords without echo.
!		Commands which should only be done when Kermit is local
!		(GET, BYE, etc.) will now give an error if the transfer
!		line is the same as the controlling terminal.
!		SEND will now check for the files existance before calling
!		KERMSG to send it.
!
! 2.0.034	By: Nick Bush				On: 7-March-1984
!		Default the parity type to be that of the default transfer
!		line.  This should make things simpler for systems which use
!		parity by default.
!
! 2.0.035	By: Nick Bush				On: 8-March-1984
!		Add LOG SESSION command to set a log file for CONNECT.
!		While we are doing so, clean up the command parsing a little
!		so that we don't have as many COPY_xxx routines.
!
! 2.0.036	By: Nick Bush				On: 15-March-1984
!		Fix PUT_FILE to correctly handle carriage returns which are
!		not followed by line feeds.  Count was being decremented
!		Instead of incremented.
!
! 2.0.037	By: Robert C. McQueen			On: 20-March-1984
!		Fix call to LOG_OPEN for debug log file.
!		Module: KERTRM.
!
! 2.0.040	By: Nick Bush				On: 22-March-1984
!		Fix processing of FORTRAN carriage control to handle lines
!		which do not contain the carriage control character (i.e., zero
!		length records).  Previously, this type of record was sending
!		infinite nulls.
!
! 2.0.041	By: Nick Bush				On: 26-March-1984
!		Add SET PROMPT command.
!
! 2.0.042	By: Nick Bush				On: 26-March-1984
!		Fix connect processing to make it easy to type messages
!		on the user's terminal while connected.  Use this
!		to type messages when log file stopped and started.
!		Include the node name in the messages to keep
!		users who are running through multiple Kermit's from
!		getting confused.
!
! 2.0.043	By: Nick Bush				On: 28-March-1984
!		Fix SET PARITY ODD to work.  Somehow, the table entry
!		had PR_NONE instead of PR_ODD.  Also add status type
!		out and help message to connect command.
!
! 2.0.044	By: Nick Bush				On: 28-March-1984
!		Fix SET SEND START_OF_PACKET to store in SND_SOH instead
!		of RCV_SOH.  Also, set TY_FIL false before calling FILE_OPEN
!		to check for existence of send files.
!
! 3.0.045	Start of version 3.
!
! 3.0.046	By: Nick Bush				On: 29-March-1984
!		Fix debugging log file to correctly set/clear file open
!		flag.  Also make log files default to .LOG.
!
! 3.0.047	By: Nick Bush				On: 30-March-1984
!		Fix SEND command processing to save and restore the file
!		specification over the call to FILE_OPEN, since FILE_OPEN
!		rewrites it with the resulting file name, losing any
!		wild-cards.
!
! 3.0.050	By: Nick Bush				On: 2-April-1984
!		Add SET SERVER_TIMER to determine period between idle naks.
!		Also allow for a routine to process file specs before
!		FILE_OPEN uses them.  This allows individual sites to
!		restrict the format of file specifications used by Kermit.
!
! 3.0.051	By: Nick Bush				On: 2-April-1984
!		Fix command scanning to correctly exit after performing
!		a single command when entered with a command present.
!
! 3.1.052	By: Nick Bush				On: 3-July-1984
!		Fix KERCOM's definition of MAX_MSG to allow for all characters
!		of packet to fit into buffers, not just the counted ones.
!
! 3.1.053	By: Robert C. McQueen			On: 9-July-1984
!		Fix FORTRAN carriage control processing to pass along
!		any character from the carriage control column that is
!		not really carriage control.
!
! 3.1.054	By: Nick Bush				On: 13-July-1984
!		Change TERM_OPEN to take an argument which determines
!		whether it should post any QIO's.  This makes it unnecessary
!		for TERM_CONNECT to cancel the QIO's, and avoids problems
!		with DECnet remote terminals.
!
! 3.1.055	By: Nick Bush				On: 27-August-1984
!		Clear out FILE_SIZE before processing a RECEIVE command to
!		ensure that KERMSG doesn't perform a GET.
!
! 3.1.056	By: Nick Bush				On: 28-August-1984
!		Add a TAKE (or @) command.  Also perform an initialization
!		file on startup.  This file is either VMSKERMIT.INI or
!		whatever file is pointed to by the logical name VMSKERMIT.
!
! 3.1.057	By: Nick Bush				On: 21-Feb-1985
!		Determine VMS version on startup and remember for later
!		use.  Use it in KERSYS to determine whether we will need
!		to force an end-of-file on the mailbox when the subprocess
!		on the other end goes away.
!
! 3.1.060	By: Nick Bush				On: 16-March-1985
!		Increase size of terminal name buffers to account for large
!		unit numbers (most likely seen with VTA's).
!
! 3.1.061	By: Nick Bush				On: 16-March-1985
!		Only attempt to set parity back when closing terminal.
!
! 3.1.062	By: Nick Bush				On: 16-March-1985
!		Previous edit broke remote commands - must post QIO's
!		when opening terminals for these.
!
! 3.1.063	By: Nick Bush				On: 16-March-1985
!		Fix status command to output right headers over data.
!
! 3.1.064	By: Nick Bush				On: 30-March-1985
!		Fix LIB$SPAWN call to set SYS$INPUT for the subprocess
!		to be NLA0: so that it doesn't try to input from the
!		terminal.
!
! 3.1.065	By: Nick Bush				On: 10-April-1985
!		Split IBM handshaking from parity and local echo.  Allow
!		link time setting of IBM_MODE defaults by defining symbols:
!
!		IBM_MODE_CHARACTER = character value of handshake character
!		IBM_MODE_ECHO = 1 for local echo, 2 for no local echo
!		IBM_MODE_PARITY = (0 = none), (1 = mark), (2 = even),
!		    (3 = odd), (4 = space).
!
!		If not specified, Kermit will continue to use DC1, local echo
!		and odd parity for IBM_MODE.
!
! 3.1.066	By: Nick Bush				On: 22-April-1985
!		Don't use NLA0: as SYS$INPUT when spawning things under VMS 3.
!
!
! Start version 3.2 on 8-May-1985
!
! 3.2.067	By: Robert McQueen			On: 8-May-1985
!		Use $GETJPIW and $GETDVIW instead of $GETJPI and $GETDVI.
!		Module: KERTRM, KERFIL
!
! 3.2.070	By: Robert McQueen			On: 17-Dec-1985
!		Fix a problem with CRC calculations when 8 bit data and not
!		8 bit quoting.
!
! 3.2.071	By: Robert McQueen			On: 11-March-1986
!		Fix a problem were KERMSG didn't allow for a line termination
!		character in the buffer.
!
! 3.2.072	By: Robert McQueen			On: 11-March-1986
!		Allow 0 as a valid value for SET SEND PADDING command.
!
! 3.2.073	By: Robert McQueen			On: 11-March-1986
!		Fix a problem restoring the terminal characteristics under
!		VMS 4.x
!
! 3.2.074	By: Robert McQueen			On: 11-March-1986
!		Put MAX_MSG back the way it was and fix the problem correctly
!		in KERMSG.
!
! 3.2.075	By: Robert McQueen			On: 8-April-1986
!		Change how the FINISH command works.  Cause it to go back to
!		the Kermit-32 prompt, not exit.
!--

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

! Command processing routines

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

!
! Error handling routines
!

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

!
! INCLUDE FILES:
!

LIBRARY 'SYS$LIBRARY:STARLET';

LIBRARY 'SYS$LIBRARY:TPAMAC';

REQUIRE 'KERCOM';				! Common definitions

REQUIRE 'KERERR';				! Error message symbol definitions


%SBTTL 'Macro definitions'

!
! MACROS:
!

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

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

!
! EQUATED SYMBOLS:
!
! Command offsets

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

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

! Constants

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

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

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

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

!
! OWN STORAGE:
!

    OWN

! Command scanning information

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

! Misc constants.

	TRANSACTION_NAME : VECTOR [CH$ALLOCATION(MAX_FILE_NAME)],
	PROMPT_DESC : BLOCK [8, BYTE],		! Descriptor for prompt
	PROMPT_TEXT : VECTOR [CH$ALLOCATION(TEMP_LENGTH)], ! Storage for prompt
	CRC_TABLE : BLOCK [16, LONG],		! CRC-CCITT table
	TAK_FIL_DESC	: BLOCK [8, BYTE],	! Take file descriptor
	TAK_FIL_NAME	: BLOCK [CH$ALLOCATION(MAX_FILE_NAME)],
	TEMP_DESC	: BLOCK [8, BYTE],	! Temporary descriptor
	TEMP_NAME	: VECTOR [CH$ALLOCATION(TEMP_LENGTH)];


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

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

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

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

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

EXTERNAL
    FILE_TYPE,					! Type of file being processed
    FILE_DESC : BLOCK [8, BYTE];		! Descriptor for the file name

!
! KERTRM storage
!

EXTERNAL
    SESSION_DESC : BLOCK [8, BYTE],		! Session log file name
    DEBUG_DESC : BLOCK [8, BYTE],		! Debugging log file name
    TERM_DESC : BLOCK [8, BYTE],		! Terminal name descriptor
    TERM_FLAG;					! Terminal open flag

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

$INIT_STATE	(KERMIT_STATE,	KERMIT_KEY);

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

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

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

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

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

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


	%SBTTL	'QUIT command table'

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

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

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

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

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


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

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

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

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

! State to require a text string argument

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

$STATE	(SET_ESC_STATE,
	(TPA$_OCTAL,	DONE_STATE,	,	,ESCAPE_CHR)
	)
!++
!
! SET FILE xxx command.  The format is:
!
!	Kermit-32>SET FILE <item> <args>
!
! Where:
!	<item> is one of:
!		NAMING - Type of file name to send
!		TYPE - Type of file to create on receive (or send in certain cases)
!
!--
$STATE	(SET_FIL_STATE,
	('NAMING',	SET_FNM_STATE),
	('TYPE',	SET_FTP_STATE),
	(TPA$_SYMBOL,	TPA$_FAIL,	KEY_ERROR)
	)

!++
!
! SET FILE NAMING command.  The format is:
!
!	Kermit-32>SET FILE NAMING <type>
!
! Where:
!	<type> is one of:
!		FULL   - Send complete file specification, including device and
!			directory
!		NORMAL_FORM - Send only name.type
!		UNTRANSLATED - Send name.type, but don't do any fixups on it
!--

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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



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

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


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

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

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

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

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

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

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

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

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

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

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

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

$STATE	(SET_SRV_STATE,
	(TPA$_DECIMAL,	DONE_STATE,	,	,SRV_TIMEOUT)
	)

	%SBTTL	'SEND command'

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

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

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

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

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

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

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

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

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



	%SBTTL	'Take command tables'

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

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

$STATE	(TAK_SWT_STATE,
	('DISPLAY',		DONE_STATE,	,TRUE,		TAKE_DISPLAY),
	(TPA$_SYMBOL,	TPA$_FAIL,	KEY_ERROR)
	)

	%SBTTL	'Done state'

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

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

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

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


!<BLF/FORMAT>
ROUTINE MAIN_ROUTINE : NOVALUE =

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

    BEGIN

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

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

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

    BEGIN

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

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

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

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

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

    IF .CMD_SIZE GTR 0 THEN ONE_COMMAND = TRUE;

    WHILE TRUE DO
	BEGIN

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

	    IF .STATUS THEN STATUS = DO_COMND (DESC);

	    IF .STATUS EQL KER_EXIT THEN RETURN SS$_NORMAL;

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

	    END;

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

	IF .ONE_COMMAND THEN RETURN SS$_NORMAL;

!
! Initialize prompt if null
!

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

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

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

	END;					! End of WHILE TRUE DO BEGIN

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

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

    BEGIN

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

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

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

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

    IF NOT .STATUS
    THEN
	BEGIN

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

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

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

    IF .TAKE_FILE_BSIZ EQL 0 THEN TAKE_FILE_BSIZ = MAX_REC_LENGTH;

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

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

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

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

    STATUS = $CONNECT (RAB = TAKE_FILE_RAB);

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

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

	RETURN KER_TAKE_ERROR;
	END;

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

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

	    IF .DISPLAY_FLAG THEN LIB$PUT_OUTPUT (CMD_DESC);

	    STATUS = DO_COMND (CMD_DESC);

	    IF NOT .STATUS
	    THEN
		BEGIN

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

		EXITLOOP;
		END;

	    END;

	END;					! End of WHILE TRUE DO BEGIN

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

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

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

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

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

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

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

    BEGIN

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

	EXTERNAL LITERAL
	    LIB$_SYNTAXERR;

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

	END;

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

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

    BEGIN

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

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

    LOCAL
	STATUS : UNSIGNED LONG;

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

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

	CASE .COMMAND FROM CMD_MIN TO CMD_MAX OF
	    SET

	    [CMD_BYE] :
		BEGIN

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

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

		    TERM_CLOSE ()
		    END;

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

		END;

	    [CMD_CONN] :
		TERM_CONNECT ();

	    [CMD_EXIT] :
		RETURN KER_EXIT;

	    [CMD_FINISH] :

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

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

		    TERM_CLOSE ()
		    END;

	    [CMD_GET] :

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

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

		    TERM_CLOSE ();
		    END;

	    [CMD_HELP] :
		COMND_HELP ();

	    [CMD_LOGOUT] :

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

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

		    TERM_CLOSE ()
		    END;

	    [CMD_RECEIVE] :

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

	    [CMD_REMOTE] :
		COMND_REMOTE ();

	    [CMD_LOCAL] :
		COMND_LOCAL ();

	    [CMD_PUSH] :
		BEGIN

		OWN
		    PID : INITIAL (0);

		LIB$PUT_OUTPUT (PUSH_TEXT);

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

		    IF NOT .STATUS THEN PID = 0;

		    END;

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

		END;

	    [CMD_SEND] :
		BEGIN

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

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

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

		INCR I FROM 0 TO .FILE_SIZE - 1 DO
		    SAVE_FILE_NAME [.I] = .FILE_NAME [.I];

		IF FILE_OPEN (FNC_READ)
		THEN
		    BEGIN
		    FILE_SIZE = .SAVE_FILE_SIZE;	! Reset the file name size

		    INCR I FROM 0 TO .FILE_SIZE - 1 DO
			FILE_NAME [.I] = .SAVE_FILE_NAME [.I];

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

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

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

		END;

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

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

		    END;

		END;

	    [CMD_SHOW] :
		COMND_SHOW ();

	    [CMD_STATUS] :
		COMND_STATUS ();

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

	    [INRANGE] :
	    TES;

	END;

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

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

    BEGIN

    LOCAL
	STATUS : UNSIGNED LONG;

    EXTERNAL ROUTINE
	LBR$OUTPUT_HELP : ADDRESSING_MODE (GENERAL);

!
! Do the help processing.
!
    STATUS = LBR$OUTPUT_HELP (LIB$PUT_OUTPUT, 0, TEMP_DESC, %ASCID'KERMIT',
	UPLIT (HLP$M_PROMPT + HLP$M_PROCESS + HLP$M_GROUP + HLP$M_SYSTEM), LIB$GET_INPUT);

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

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

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

    BEGIN

    MAP
	LONG_VALUE : LONG UNSIGNED,
	MSG_ADDR : LONG UNSIGNED;

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

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

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

    BEGIN

    IF GET_REM_ARGS (FALSE)
    THEN

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

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

	    TERM_CLOSE ();
	    END;

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

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

    BEGIN

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

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

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

    IF NOT .STATUS THEN RETURN;

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

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

	IF .STR_LENGTH NEQ 0
	THEN
	    BEGIN

	    LOCAL
		POINTER;

	    POINTER = CH$PTR (.STR_ADDRESS);

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

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

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

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

		END;

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

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

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

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

	    TT_OUTPUT ();			! Force out last buffer
	    END;

	END;

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

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

    BEGIN

    LOCAL
	STATUS : WORD;				! Status returned

! Bind some addresses to text

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

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

    ROUTINE OUTPUT_TRUE_FALSE (MSG_ADDR, FLAG_ADDR) : NOVALUE =
	BEGIN

	MAP
	    FLAG_ADDR : LONG UNSIGNED,
	    MSG_ADDR : LONG UNSIGNED;

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

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

    SELECT .SHOW_TYPE OF
	SET
!
![012] Show version
!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    BEGIN

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

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

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

    IF .XFR_TIME NEQ 0
    THEN
	OUTPUT_LONG_WORD (TEXT_BAUD,
	    (((IF .RMSG_DATA_CHARS LEQ .SMSG_DATA_CHARS THEN .SMSG_DATA_CHARS ELSE .RMSG_DATA_CHARS)*10)/((
	    .XFR_TIME + 500)/1000)));

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

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

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

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

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

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

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

	    END;

	END;

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

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

    BEGIN

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

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

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

    SELECTONE .REM_TYPE OF
	SET

	[GC_CONNECT] :

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

	[GC_COPY, GC_RENAME] :

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

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

		END;

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

	    IF NOT .STATUS THEN RETURN .STATUS;

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

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

	[GC_WHO] :

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

	TES;

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

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

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

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

    BEGIN

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

    						! IBM mode
    TPARSE_ARGS;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    BEGIN
    TPARSE_ARGS;

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

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

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

    BEGIN
    TPARSE_ARGS;

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

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

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

    BEGIN
    TPARSE_ARGS;

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

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

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

    BEGIN
    TPARSE_ARGS;

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

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

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

    BEGIN
    TPARSE_ARGS;

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

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

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

    BEGIN
    TPARSE_ARGS;

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

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

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

    BEGIN
    TPARSE_ARGS;

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

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

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

    BEGIN
    TPARSE_ARGS;

    LOCAL
	DESC_ADDR;

    DESC_ADDR = .AP [TPA$L_PARAM];
    BEGIN

    MAP
	DESC_ADDR : REF BLOCK [8, BYTE];

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

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

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

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

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

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

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

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

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

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

    BEGIN

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

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

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

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

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

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

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

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

    BEGIN
    TPARSE_ARGS;

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

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

GLOBAL ROUTINE XFR_STATUS (TYPE, SUB_TYPE) : NOVALUE =

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

    BEGIN

    EXTERNAL ROUTINE
	LOG_FAOL;

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

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

	SELECTONE .SUB_TYPE OF
	    SET

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

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

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

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

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

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

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

	END;

    IF .TY_PKT
    THEN
	BEGIN

	SELECTONE .TYPE OF
	    SET

	    [%ASCII'R'] :
		BEGIN

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

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

		END;

	    [%ASCII'S'] :
		BEGIN

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

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

		END;
	    TES;

	TT_OUTPUT ();
	END;

    END;					! End of XFR_STATUS

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

GLOBAL ROUTINE CRCCLC (POINTER, SIZE) =

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

    BEGIN

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

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

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

GLOBAL ROUTINE KRM_ERROR (ERROR_CODE) : NOVALUE =

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

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


%SBTTL 'KERM_HANDLER - Condition handler'
ROUTINE KERM_HANDLER =

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

    BEGIN

    BIND
	FACILITY_DESC = %ASCID'KERMIT32';

    BUILTIN
	AP;

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

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

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

    ROUTINE HANDLE_MSG =
	BEGIN

	EXTERNAL ROUTINE
	    LOG_FAOL;

	BUILTIN
	    AP;

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

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

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

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

	IF .TRANSACTION_OPEN
	THEN
	    BEGIN

	    OWN
		TMP_DESC : BLOCK [8, BYTE];

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

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

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

	    TT_CRLF ();
	    END;

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

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

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

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

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

ELUDOM