MODULE KERMIT (IDENT = '2.0.011', MAIN = MAIN_ROUTINE ) = BEGIN !++ ! 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 ! 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 !-- %SBTTL 'Routine definitions -- Forwards' ! ! ! Forward definitions ! ! Command processing routines FORWARD ROUTINE COMND, ! Process a command COMND_HELP : NOVALUE, ! Process the HELP command COMND_SHOW : NOVALUE, ! Process the SHOW command COMND_STATUS : NOVALUE, ! Process the STATUS command STORE_TEXT, ! Routine to store a file name COPY_TERM_NAME, ! Copy device name (TERM_xxxx) COPY_FILE, ! Copy file name (FILE_xxx) STORE_DEBUG, ! Store the debuging flag STORE_FTP, ! Store the file type 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_SOH, ! Validate the start of packet character given HELP_START, ! Start of the HELP command (set TPA$V_BLANK) HELP_DONE; ! End of the HELP command (clear TPA$V_BLANK) ! ! 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 'Structure definitions -- $GETDVI arguments' ! ! $GETDVI interface fields and structure definition ! LITERAL DVI_SIZE = 3; ! Length of a DVI item list entry ! ! Fields for accessing the items in a DVI item list ! FIELD DVI_FIELDS = SET DVI_BFR_LENGTH = [0, 0, 16, 0], DVI_ITEM_CODE = [0, 16, 16, 0], DVI_BFR_ADDRESS = [1, 0, 32, 0], DVI_RTN_LENGTH = [2, 0, 32, 0] TES; ! ! Structure definition for item list STRUCTURE DVI_ITEM_LIST [I, O, P, S, E; N] = [(N + 1)*DVI_SIZE*4] (DVI_ITEM_LIST + ((I*DVI_SIZE) + O)*4); %SBTTL 'Macro definitions' ! ! MACROS: ! MACRO TPARSE_ARGS = BUILTIN AP; MAP AP : REF BLOCK [,BYTE]; %; %SBTTL 'Equated symbols -- Command types' ! ! EQUATED SYMBOLS: ! ! Command offsets LITERAL 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 ! 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_FTP = 5, ! Show the file type 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 %SBTTL 'Equated symbols -- Constants' ! Constants LITERAL CMD_BFR_LENGTH = 132, ! Command buffer length OUT_BFR_LENGTH = 80, ! Output buffer length (SHOW cmd) TERM_LENGTH = 80, ! Length of a terminal name HELP_LENGTH = 132, ! Length of the help buffer TEMP_LENGTH = 132; ! Length of the temporary area %SBTTL 'Storage -- Global' ! ! ! GLOBAL STORAGE: ! GLOBAL ESCAPE_CHR, ! Escape character for CONNECT TERM_NAME : VECTOR [CH$ALLOCATION(TERM_LENGTH)], TERM_DESC : BLOCK [8, BYTE]; ! Terminal name descriptor %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 COMMAND, ! Type of command we are doing SHOW_TYPE, ! Type of show command ! ! Output data area ! OUTPUT_LINE : VECTOR [OUT_BFR_LENGTH, BYTE, UNSIGNED], OUTPUT_DESC : BLOCK [8, BYTE], OUTPUT_SIZE : WORD UNSIGNED, ! Misc constants. CRC_TABLE : BLOCK [16, LONG], ! CRC-CCITT table TIMER_HANDLE, ! Pointer to the TIMER block TEMP_DESC : BLOCK [8, BYTE], ! Temporary descriptor TEMP_NAME : VECTOR [CH$ALLOCATION(TEMP_LENGTH)]; ! %SBTTL 'External routines' ! ! EXTERNAL REFERENCES: ! EXTERNAL ROUTINE ! ! Library routines ! LIB$INIT_TIMER : ADDRESSING_MODE (GENERAL), LIB$STAT_TIMER : ADDRESSING_MODE (GENERAL), LIB$FREE_TIMER : ADDRESSING_MODE (GENERAL), LIB$EDIV : ADDRESSING_MODE (GENERAL), LIB$GET_FOREIGN : ADDRESSING_MODE (GENERAL), 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), ! ! 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 ! ! 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 ! ! 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 ! ! 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, ! Number of packets received SND_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 ! ! 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 WARN_FLAG, ! File warning flag 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 TERM_FLAG; ! Terminal open flag %SBTTL 'Command parsing tables' ! !++ ! !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', REC_STATE, , CMD_RECEIVE, COMMAND), ('HELP', HELP_STATE, HELP_START, CMD_HELP, COMMAND), ('LOGOUT', DONE_STATE, , CMD_LOGOUT, COMMAND), ('QUIT', DONE_STATE, , CMD_EXIT, COMMAND), ('RECEIVE', REC_STATE, , CMD_RECEIVE, 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) ) !++ ! 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, HELP_DONE) ) %SBTTL 'QUIT command table' !++ ! QUIT command. Format is: ! ! Kermit-32>QUIT ! ! This command will just exit back to VMS. ! !-- %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_FILE) ) %SBTTL 'SET command tables' !++ ! SET command. Format is: ! ! Kermit-32>SET parameter ! ! Where: ! Parameter - One of the following: ! DEBUGGING ! DELAY ! LINE ! PARITY ! SEND ! RECEIVE ! !-- $STATE (SET_STATE, ('BLOCK_CHECK_TYPE', SET_CHK_STATE), ('DEBUGGING', SET_DEB_STATE), ('DELAY', SET_DEL_STATE), ('ESCAPE', SET_ESC_STATE), ('FILE_TYPE', SET_FIL_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), ('RECEIVE', SET_REC_STATE), ('REPEAT_QUOTE',SET_RPT_STATE), ('RETRY', SET_RTY_STATE), ('SEND', SET_SND_STATE) ) !++ ! ! 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) ) !++ ! ! 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) ) !++ ! ! 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) ) !++ ! ! 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) ) !++ ! ! SET DELAY command. The format is: ! ! Kermit-32>SET DELAY ! ! Where: ! 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 ! ! Where: ! 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-TYPE command. The format is: ! ! Kermit-32>SET FILE-TYPE ! ! Where: ! is one of the following: ! ASCII - Normal ASCII file (stream ascii) ! BINARY - Micro binary file. !-- $STATE (SET_FIL_STATE, ('ASCII', DONE_STATE, STORE_FTP, , ,FILE_ASC), ('BINARY', DONE_STATE, STORE_FTP, , ,FILE_BIN), ('BLOCK', DONE_STATE, STORE_FTP, , ,FILE_BLK) ) !++ ! 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) ) !++ ! SET MESSAGE command. Format is: ! ! Kermit-32>SET MESSAGE ! ! 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)) $STATE (SET_MSG_FIL_STATE, ('OFF', DONE_STATE, STORE_MSG_FIL, , ,FALSE), ('ON', DONE_STATE, STORE_MSG_FIL, , ,TRUE) ) $STATE (SET_MSG_PKT_STATE, ('OFF', DONE_STATE, STORE_MSG_PKT, , ,FALSE), ('ON', DONE_STATE, STORE_MSG_PKT, , ,TRUE) ) !++ ! SET REPEAT_QUOTE command. Format is: ! ! Kermit-32>SET REPEAT_QUOTE ! !-- $STATE (SET_RPT_STATE, (TPA$_OCTAL, DONE_STATE, , ,SET_REPT_CHR) ) !++ ! SET RETRY command. Format is: ! ! Kermit-32>SET RETRY ! ! 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) ) $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_NONE), ('SPACE', DONE_STATE, STORE_PARITY, , ,PR_SPACE) ) %SBTTL 'SET RECEIVE table' !++ ! SET RECEIVE command. Format is: ! ! Kermit-32>SET RECEIVE item ! ! Where: ! Item - One of the following: ! PACKET-LENGTH ! PADDING ! PADCHAR ! TIMEOUT ! END-OF-LINE ! QUOTE ! !-- $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) ) !++ ! ! SET RECEIVE PACKET-LENGTH command. Format is: ! ! Kermit-32>SET RECEIVE PACKET-LENGTH ! ! Where: ! 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 ! ! Where: ! 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 ! ! Where: ! 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 ! ! Where: ! 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 ! ! Where: ! 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 ! ! Where: ! 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 ! ! Where: ! is the octal number representing the quoting character. ! !-- $STATE (SR_QUO_STATE, (TPA$_OCTAL, DONE_STATE, , ,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 ! ! Where: ! is the octal number representing the quoting character. ! !-- $STATE (SR_8QU_STATE, (TPA$_OCTAL, DONE_STATE, , ,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 ! PADDING ! PADCHAR ! TIMEOUT ! END-OF-LINE ! QUOTE ! !-- $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) ) !++ ! ! SET SEND PACKET-LENGTH command. Format is: ! ! Kermit-32>SET SEND PACKET-LENGTH ! ! Where: ! 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 ! ! Where: ! 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 ! ! Where: ! 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 ! ! Where: ! is the octal representation of the padding character ! that is to be used. ! !-- $STATE (SS_SOH_STATE, (TPA$_OCTAL, DONE_STATE, CHECK_SOH, ,RCV_SOH) ) !++ ! ! SET SEND TIMEOUT command. The format is: ! ! Kermit-32>SET SEND TIMEOUT ! ! Where: ! 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 ! ! Where: ! 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 ! ! Where: ! is the octal number representing the quoting character. ! !-- $STATE (SS_QUO_STATE, (TPA$_OCTAL, DONE_STATE, , ,SND_QUOTE_CHR) ) %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_FILE) ) %SBTTL 'SHOW command' !++ ! SHOW command. The format is: ! ! Kermit-32>SHOW ! ! Where: ! 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_TYPE', DONE_STATE, ,SHOW_FTP, 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), ('RECEIVE', DONE_STATE, ,SHOW_REC, SHOW_TYPE), ('RETRY', DONE_STATE, ,SHOW_RTY, SHOW_TYPE) ) %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$; ! 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 ! MSG_INIT (); ! Initialize message processing TERM_INIT (); ! Init terminal processing TT_INIT (); ! Init text processing FILE_INIT (); ! Init file processing 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); TIMER_HANDLE = 0; ! Clear to get free block STATUS = LIB$INIT_TIMER (TIMER_HANDLE); ! Initialize ! ! 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 BIND SERVER_TEXT = %ASCID'[Kermit Server running on VAX 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.]'; OWN DESC : BLOCK [8, BYTE], CMD_BUF : VECTOR [80, BYTE, UNSIGNED], CMD_SIZE : UNSIGNED WORD, FORCE_PROMPT, ! Cause prompt to be forced STATUS : UNSIGNED LONG; FORCE_PROMPT = 0; RETURN WHILE TRUE DO BEGIN ! Initialize some per-command data areas. TEMP_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TEMP_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TEMP_DESC [DSC$W_LENGTH] = 0; TEMP_DESC [DSC$A_POINTER] = TEMP_NAME; COMMAND = 0; SHOW_TYPE = 0; ! Initialize variables for the scanning of a command. DESC [DSC$B_CLASS] = DSC$K_CLASS_S; DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; DESC [DSC$W_LENGTH] = 80; DESC [DSC$A_POINTER] = CMD_BUF; FILE_SIZE = 0; DO STATUS = LIB$GET_FOREIGN (DESC, %ASCID'Kermit-32>', CMD_SIZE, FORCE_PROMPT) UNTIL (.CMD_SIZE NEQ 0 OR .STATUS NEQ SS$_NORMAL); IF .STATUS EQL RMS$_EOF THEN EXITLOOP SS$_NORMAL; DESC [DSC$W_LENGTH] = .CMD_SIZE; IF .STATUS THEN BEGIN TPARSE_BLOCK [TPA$L_STRINGCNT] = .CMD_SIZE; TPARSE_BLOCK [TPA$L_STRINGPTR] = CMD_BUF; STATUS = LIB$TPARSE (TPARSE_BLOCK, KERMIT_STATE, KERMIT_KEY); IF .STATUS THEN BEGIN SELECTONE .COMMAND OF SET [CMD_BYE] : BEGIN IF TERM_OPEN () THEN BEGIN DO_GENERIC (GC_LOGOUT); TERM_CLOSE () END; EXITLOOP KER_NORMAL; END; [CMD_CONN] : TERM_CONNECT (); [CMD_EXIT] : EXITLOOP KER_NORMAL; [CMD_FINISH] : IF TERM_OPEN () THEN BEGIN DO_GENERIC (GC_EXIT); TERM_CLOSE () END; [CMD_HELP] : COMND_HELP (); [CMD_LOGOUT] : IF TERM_OPEN () THEN BEGIN DO_GENERIC (GC_LOGOUT); TERM_CLOSE () END; [CMD_RECEIVE] : IF TERM_OPEN () THEN BEGIN REC_SWITCH (); TERM_CLOSE (); END; [CMD_SEND] : IF TERM_OPEN () THEN BEGIN SEND_SWITCH (); TERM_CLOSE (); END; [CMD_SERVER] : BEGIN STATUS = LIB$PUT_OUTPUT (SERVER_TEXT); STATUS = LIB$PUT_OUTPUT (SERVER_TEXT_1); STATUS = LIB$PUT_OUTPUT (SERVER_TEXT_2); IF TERM_OPEN () THEN BEGIN STATUS = SERVER (); TERM_CLOSE (); IF .STATUS NEQ KER_ABORTED THEN EXITLOOP KER_NORMAL; END; END; [CMD_SHOW] : COMND_SHOW (); [CMD_STATUS] : COMND_STATUS (); TES; END ELSE LIB$SIGNAL (.STATUS); END ELSE LIB$SIGNAL (.STATUS); END; ! End of WHILE TRUE DO BEGIN END; ! End of 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 routine -- INIT_DESC' ROUTINE INIT_DESC : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the output descriptor for the various ! commands that use $FAO to output text. ! ! CALLING SEQUENCE: ! ! INIT_DESC() ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN OUTPUT_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; OUTPUT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; OUTPUT_DESC [DSC$W_LENGTH] = OUT_BFR_LENGTH; OUTPUT_DESC [DSC$A_POINTER] = OUTPUT_LINE; END; ! End of INIT_DESC () %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_DESC (); $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_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_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', SHOW_IBM_MSG = %ASCID' IBM mode !AS', 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_DESC (); $FAO (.MSG_ADDR, OUTPUT_SIZE, OUTPUT_DESC, (SELECTONE ..FLAG_ADDR OF SET [TRUE] : ON_TEXT; [FALSE] : OFF_TEXT; TES)); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); END; SELECT .SHOW_TYPE OF SET [SHOW_ALL, SHOW_CHK, SHOW_PAC] : BEGIN INIT_DESC (); $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] : OUTPUT_LONG_WORD (SHOW_DEL_MSG, .DELAY); [SHOW_ALL, SHOW_ESC, SHOW_COM] : OUTPUT_LONG_WORD (SHOW_ESC_MSG, .ESCAPE_CHR); [SHOW_ALL, SHOW_FTP, SHOW_FIL] : BEGIN INIT_DESC (); $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; TES)); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); END; [SHOW_ALL, SHOW_COM] : OUTPUT_TRUE_FALSE (SHOW_IBM_MSG, IBM_FLAG); [SHOW_ALL, SHOW_ABT, SHOW_FIL] : BEGIN INIT_DESC (); $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_DESC (); $FAO (SHOW_LIN_MSG, OUTPUT_SIZE, OUTPUT_DESC, TERM_DESC); 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_DESC (); $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_TOTAL_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_CHR_RCV, .RMSG_TOTAL_CHARS); OUTPUT_LONG_WORD (TEXT_DATA_CHAR_RCV, .RMSG_DATA_CHARS); OUTPUT_LONG_WORD (TEXT_NAKS_RCV, .RMSG_NAKS); 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_XFR_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_DESC (); 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 '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 TPARSE_ARGS; IBM_FLAG = .AP [TPA$L_PARAM]; 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_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_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] LEQ 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 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) LEQ TEMP_LENGTH THEN BEGIN CH$WCHAR (.AP [TPA$B_CHAR], CH$PTR (TEMP_NAME, .TEMP_DESC [DSC$W_LENGTH] - 1)); RETURN SS$_NORMAL; END ELSE RETURN KER_LINTOOLNG; END; ! End of STORE_TEXT %SBTTL 'TPARSE support -- COPY_FILE - Copy file specification' ROUTINE COPY_FILE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will copy the file name from the temporary ! descriptor to the descriptor that is used for the file name. ! (FILE_NAME and FILE_DESC). ! ! 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: ! ! FILE_NAME and FILE_DESC set up with what was in TEMP_NAME and ! TEMP_DESC. ! ! COMPLETION CODES: ! ! 0 - Failure. ! 1 - Success. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN FILE_DESC [DSC$W_LENGTH] = .TEMP_DESC [DSC$W_LENGTH]; FILE_SIZE = .FILE_DESC [DSC$W_LENGTH]; CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1, CH$PTR (FILE_NAME)); RETURN SS$_NORMAL; END; ! End of COPY_FILE %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 then check to see if TERM_DESC is a terminal. ! If it is not a terminal, it will return KER_LINTERM. ! ! 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 LOCAL STATUS, ! ! The following variables are used to test if device is a terminal. ! TERM_ITM : DVI_ITEM_LIST [0] FIELD (DVI_FIELDS), TERM_CLASS, TERM_STATUS; ! ! Initialize the GETDVI call for the terminal name given ! TERM_ITM [0, DVI_ITEM_CODE] = DVI$_DEVCLASS; TERM_ITM [0, DVI_BFR_LENGTH] = 4; TERM_ITM [0, DVI_BFR_ADDRESS] = TERM_CLASS; TERM_ITM [0, DVI_RTN_LENGTH] = 0; ! ! Get the device information ! TERM_STATUS = $GETDVI (EFN = 2, DEVNAM = TEMP_DESC, ITMLST = TERM_ITM); IF NOT .TERM_STATUS THEN BEGIN LIB$SIGNAL (.TERM_STATUS); RETURN .TERM_STATUS; END; STATUS = $WAITFR (EFN = 2); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; ! ! Make sure that .TERM_CLASS is a terminal ! IF .TERM_CLASS EQL DC$_TERM THEN BEGIN TERM_DESC [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], CH$PTR (TERM_NAME)); RETURN SS$_NORMAL; END ELSE RETURN KER_LINTERM; END; ! End of COPY_TERM_NAME %SBTTL 'HELP_START' ROUTINE HELP_START = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called after the HELP verb has been parsed off ! of the command. This routine will then turn the TPA$V_BLANK bit ! on in the TPARSE_BLOCK. This will allow us to scan multi-words in ! the "HELP xyz" command. ! ! CALLING SEQUENCE: ! ! HELP_START(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUPTUTS: ! ! None. ! ! COMPLETION CODES: ! ! 0 - Failure ! 1 - Success ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_BLOCK [TPA$V_BLANKS] = 1; RETURN SS$_NORMAL; END; ! End of HELP_START %SBTTL 'HELP_DONE' ROUTINE HELP_DONE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will clear the TPA$V_BLANKS flag. This will allow the ! normal parsing to work. ! ! CALLING SEQUENCE: ! ! HELP_DONE(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUPTUTS: ! ! None. ! ! COMPLETION CODES: ! ! 0 - Failure ! 1 - Success ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_BLOCK [TPA$V_BLANKS] = 0; RETURN SS$_NORMAL; END; ! End of HELP_DONE %SBTTL 'SY_LOGOUT - delete the process.' GLOBAL ROUTINE SY_LOGOUT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will delete this process. ! ! CALLING SEQUENCE: ! ! SY_LOGOUT (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN $DELPRC (); END; ! End of SY_LOGOUT %SBTTL 'SY_DISMISS - Sleep for N seconds' GLOBAL ROUTINE SY_DISMISS (SECONDS) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to cause KERMIT to sleep for the ! specified number of seconds. ! ! CALLING SEQUENCE: ! ! SY_DISMISS(Number of seconds); ! ! INPUT PARAMETERS: ! ! Number of seconds to sleep. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS, TOTAL_TIME : VECTOR [2, LONG]; ! Quad word for length of time to sleep IF .SECONDS EQL 0 THEN RETURN KER_NORMAL; TOTAL_TIME [0] = -.SECONDS*10*1000*1000; TOTAL_TIME [1] = -1; STATUS = $SETIMR (EFN = 1, DAYTIM = TOTAL_TIME); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); STATUS = $WAITFR (EFN = 1); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); END; ! End of SY_DISMISS(time) %SBTTL 'SY_TIME - Return elapsed time' GLOBAL ROUTINE SY_TIME = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will return the elapsed time to the calling routine. ! This will allow for the calculation of the effective baud rate. ! ! CALLING SEQUENCE: ! ! TIME = SY_TIME (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! Time in milliseconds. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! Local storage ! LOCAL STATUS, ! Status returned by lower level TIMER_MILLI_SECONDS, ! Time in milliseconds TIMER_REMAINDER, ! Remainder on EDIV TIMER_VALUE : VECTOR [2, LONG], ! Quad word TIME value TEN_FOURTH : VECTOR [2, LONG], ! to hold 10**4 TIMER_CODE; ! Type of TIMER request ! ! Set up the type of request we want (elapsed time) ! TIMER_CODE = 1; ! ! Get the elapsed time from VMS ! STATUS = LIB$STAT_TIMER (TIMER_CODE, TIMER_VALUE, TIMER_HANDLE); IF NOT .STATUS THEN RETURN 0; ! ! Compute the LONG word value from the QUAD word given ! TEN_FOURTH [0] = 1000*10; TEN_FOURTH [1] = 0; STATUS = LIB$EDIV (TEN_FOURTH, TIMER_VALUE, TIMER_MILLI_SECONDS, TIMER_REMAINDER); IF NOT .STATUS THEN RETURN 0; RETURN .TIMER_MILLI_SECONDS; END; ! End of SY_TIME %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 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 (.RCV_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 (.SND_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 TEMP_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TEMP_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TEMP_DESC [DSC$W_LENGTH] = .SIZE; TEMP_DESC [DSC$A_POINTER] = .POINTER; 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 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 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