MODULE KERMSG (IDENT = '2.0.017' ) = BEGIN SWITCHES LANGUAGE (COMMON); ! !++ ! FACILITY: ! KERMIT-32/36 ! ! ABSTRACT: ! KERMSG is the message processing routines for KERMIT-32/36. ! This module is written in common BLISS, so that it can be ! transported for the DECsystem-10 and VAX/VMS systems. ! ! ENVIRONMENT: ! User mode ! ! AUTHOR: Robert C. McQueen, CREATION DATE: 24-January-1983 ! ! MODIFIED BY: ! !-- %SBTTL 'Table of Contents' %SBTTL 'Revision History' !++ ! Start of version 1. ! ! 1.0.000 By: Robert C. McQueen On: 4-Jan-1983 ! Create this program. ! ! 1.0.001 By: Robert C. McQueen On: 30-Apr-1983 ! Change PAR_xxx to be PR_xxx, so that they can be used for ! KERMIT-10. ! ! 1.0.002 By: Robert C. McQueen On: 1-May-1983 ! Add DO_GENERIC routine to cause a generic Kermit command to ! be executed on the remote Kermit. ! ! 1.0.003 By: Robert C. McQueen On: 3-May-1983 ! Fix message number incrementing. ! ! 1.0.004 By: Robert C. McQueen On: 4-May-1983 ! Allow RECEIVE file-specification to work correctly. ! ! 1.0.005 By: Robert C. McQueen On: 6-May-1983 ! Add more stats support. ! ! 1.0.006 By: Nick Bush On: 13-June-1983 ! Fix SEND_PACKET to copy correct characters when fixing ! parity bits. ! ! 1.1.007 By: Nick Bush On: 15-July-1983 ! Correct SEND-INIT message handling to do the right things ! with the protocol version 3 items. ! ! 1.1.010 By: Robert C. McQueen On: 20-July-1983 ! Make PARITY a global routine, so that it can be called by ! CONNECT processing. Change the name from PARITY to GEN_PARITY ! add a new routine to generate the parity, since it is not ! part of the checksum. ! ! 1.1.011 By: Robert C. McQueen On: 28-July-1983 ! KER_TIMEOUT errors in the SERVER loop would cause ! KER_UNISRV error messages to be returned to the remote. ! Check for receive failures and send NAKs instead. ! ! 1.2.012 By: Robert C. McQueen On: 23-August-1983 ! Don't abort if we get a message that is just an end of line ! character. It could be noise on the line. ! ! 1.2.013 By: Nick Bush On: 7-September-1983 ! Fix several problems with the SEND_xxx parameters ! ! 1.2.014 By: Robert C. McQueen On: 15-September-1983 ! Add routine calls to XFR_STATUS to tell the user on the ! number of packets have changed. ! ! 1.2.015 By: Nick Bush On: 5-October-1983 ! Add 2 and 3 character checksum (block check) support. ! Add support for data within acknowledgement packets ! and withing end-of-file packets to allow for file ! transmission to be aborted. Also add support for ! "I" packet to allow server parameters to be initialized. ! ! 1.2.016 By: Nick Bush On: 19-October-1983 ! Add repeat character support. ! ! 2.0.017 Release TOPS-10 Kermit-10 version 2.0 ! Release VAX/VMS Kermit-32 version 2.0 !-- %SBTTL 'Interface requirements' !++ ! Interface requirements ! ! The following routines and data locations are rquired for a correct ! implementation of KERMIT. ! ! File routines: ! ! FILE_OPEN (Function) ! This routine will open a file for reading or writting. It ! will assume that FILE_SIZE contains the number of bytes ! and FILE_NAME contains the file name of length FILE_SIZE. ! The function that is passed is either FNC_READ or FNC_WRITE. ! ! FILE_CLOSE () ! This routine will close the currently open file. This ! routine will return the status of the operation. ! ! FILE_DUMP () ! This routine will cause the current record to be written to ! the file, this routine will only handle binary files if the ! low level I/O routines are record oriented. Otherwise it is ! not needed. ! ! GET_FILE (Character) ! This routine will get a character from the currently open file ! and store it in the location specified by "Character". There ! will be a true/false value returned by the routine to determine ! if there was an error. ! ! PUT_FILE (Character) ! This routine will output a character to the currently open ! file. It will return a true/false value to determine if the ! routine was successful. ! ! NEXT_FILE () ! This routine will advance to the next file. This routine ! will return false if there are no more files to process. ! ! Communications line routines: ! ! RECEIVE (Buffer address, Address of var to store length into) ! This routine will receive a message from the remote Kermit. ! ! SEND (Buffer address, Length in characters) ! This routine will send a message to the remote Kermit. ! ! GEN_CRC (Buffer address, length in characters) ! This routine will calculate the CRC-CCITT for the characters ! in the buffer. ! ! Operating system routines: ! ! SY_DISMISS (Seconds) ! This routine will cause Kermit to sleep for the specified ! number of seconds. It is used to handle the DELAY parameter. ! ! SY_LOGOUT () ! Log the job off of the system. (Kill the process). ! ! SY_TIME () ! This routine will return the starting time milliseconds. ! It can be the start of Kermit, the system, etc, so long ! as it always is incrementing. ! ! Status routines: ! ! XFR_STATUS (Type, Subtype); ! This routine will call the O/S routine to tell it that ! either the packet count as bee incremented or the ! retry count has been incremented. ! Type: "S" - Send, "R" - Receive ! Subtype: "P" - Packet, "N" - NAK ! ! Error processing: ! ! KRM_ERROR (Error parameter) ! This routine will cause an error message to be issued. ! The error parameter is defined by KERERR. This may cause ! SND_ERROR to be called to send an "E" message to the remote. ! ! Terminal I/O routines: ! ! TERM_DUMP (Buffer, Count) ! DBG_DUMP (Buffer, Count) ! This routine will dump the buffer onto the user's terminal. ! The routine is supplied with the count of the characters ! and the address of the buffer. ! These may be the same routine or different. DBG_DUMP ! is only called for debugging output. ! ! ! ENTRY POINTS ! ! KERMSG contains the following entry points for the KERMIT. ! ! SERVER () ! This routine will cause KERMIT go enter server mode. ! ! SEND_SWITCH () ! This routine will send a file. It expects that the user ! has stored the text of the file name into FILE_NAME and ! the length of the text into FILE_SIZE. ! ! REC_SWITCH () ! This routine will receive a file. It expects that the default ! file name is set up in FILE_NAME and the length is in ! FILE_SIZE. ! ! GEN_PARITY (Character) ! This routine will return the character with the proper parity ! on the character. ! ! SND_ERROR (COUNT, ADDRESS) ! This routine will send the text of an error to the remote ! Kermit. ! ! DO_GENERIC (TYPE) ! This routine will cause a generic function to be sent to ! the remote Kermit. This routine will then do all of the ! necessary hand shaking to handle the local end of the generic ! Kermit command. ! ! ! GLOBAL Storage ! ! The following are the global storage locations that are used to interface ! to KERMSG. These locations contains the various send and receive parameters. ! ! Receive parameters: ! ! RCV_PKT_SIZE ! Receive packet size. ! RCV_NPAD ! Padding length ! RCV_PADCHAR ! Padding character ! RCV_TIMEOUT ! Time out ! RCV_EOL ! End of line character ! RCV_QUOTE_CHR ! Quote character ! RCV_8QUOTE_CHR ! 8-bit quoting character ! RCV_SOH ! Start of header character ! ! Send parameters (Negative values denote the default, positive user supplied): ! ! SND_PKT_SIZE ! Send packet size ! SND_NPAD ! Padding length ! SND_PADCHAR ! Padding character ! SND_TIMEOUT ! Time out ! SND_EOL ! End of line character ! SND_QUOTE_CHR ! Quote character ! SND_SOH ! Start of header character (normally 001) ! ! Statistics: ! ! SND_TOTAL_CHARS ! Total characters sent for this Kermit session ! RCV_TOTAL_CHARS ! Total characters received for this Kermit session ! SND_DATA_CHARS ! Total number of data characters sent for this Kermit session ! RCV_DATA_CHARS ! Total number of data characters received for this Kermit session ! SND_COUNT ! Total number of packets that have been sent ! RCV_COUNT ! Total number of packets that have been received. ! SMSG_TOTAL_CHARS ! Total characters sent for this file transfer ! RMSG_TOTAL_CHARS ! Total characters received for this file transfer ! SMSG_DATA_CHARS ! Total data characters sent for this file transfer ! RMSG_DATA_CHARS ! Total data characters received for this file transfer ! SMSG_NAKS ! Total number of NAKs sent for this file transfer ! RMSG_NAKS ! Total number of NAKs received for this file transfer ! XFR_TIME ! Amount of time the last transfer took in milliseconds. ! TOTAL_TIME ! Total amount of time spend transfering data. ! ! Misc constants: ! ! LAST_ERROR ! ASCIZ of the last error message issued. ! FILE_NAME ! Vector containing the ASCII characters of the file name. ! FILE_SIZE ! Number of characters in the FILE_NAME vector. ! DELAY ! Amount of time to delay ! DUPLEX ! DP_HALF or DP_FULL to denote either half duplex or full duplex. ! [Currently only DP_FULL is supported] ! PKT_RETRIES ! Number of retries to attempt to read a message. ! SI_RETRIES ! Number of retries to attempt on send inits ! DEBUG_FLAG ! Debugging mode on/off ! WARN_FLAG ! File warning flag ! IBM_FLAG ! True if talking to an IBM system, else false. ! ECHO_FLAG ! Local echo flag ! CONNECT_FLAG ! Connected flag; True if terminal and SET LINE are the same ! PARITY_TYPE ! Type of parity to use on sends. ! DEV_PARITY_FLAG ! Device will add parity to message. True if device adds ! parity and false if we must do it. ! !-- %SBTTL 'Declarations -- Forward definitions' ! ! ! Forward definitions ! FORWARD ROUTINE ! Send processing routines SEND_SWITCH, ! Major send routine SEND_SWITCH_WORKER, ! Real portion of send routine SEND_DATA, ! Send data to the micro SEND_FILE, ! Send file name SEND_EOF, ! Send EOF SEND_INIT, ! Send initialization msg SEND_BREAK, ! Send break end of transmission SND_ERROR : NOVALUE, ! Send an error to the remote ! Receive processing routines REC_SWITCH, ! Receive main loop REC_SWITCH_WORKER, ! Worker routine for REC_SWITCH and SERVER REC_INIT, ! Receive initialization REC_FILE, ! Receive file information REC_DATA, ! Receive data ! ! Server processing routines ! SERVER_GENERIC, ! Process generic KERMIT commands ! ! Statistic gathering routines ! END_STATS : NOVALUE, ! End of a message processing stats routine ! Low level send/receive routines CALC_BLOCK_CHECK, ! Routine to calculate the block check value SET_SEND_INIT : NOVALUE, ! Set up the MSG_SND_INIT parameters. PRS_SEND_INIT, ! Parse MSG_SND_INIT parameters. DO_PARITY : NOVALUE, ! Routine to generate parity for a message GEN_PARITY, ! Routine to add parity to a character SEND_PACKET, ! Send a packet to the remote REC_MESSAGE, ! Receive a message with retry processing REC_PACKET, ! Receive a packet from the remote ! Utility routines BFR_EMPTY, ! Empty the data buffer BFR_FILL, ! Fill the data buffer from a file CLEAR : NOVALUE, ! Clear the message buffer. INIT_XFR : NOVALUE, ! Initialize the per transfer processing ! ! Debugging routines ! DBG_MESSAGE : NOVALUE, ! Type out a formatted message DBG_SEND : NOVALUE, ! Send message debugging routine DBG_RECEIVE : NOVALUE; ! Receive message debugging routine %SBTTL 'Require files' ! ! ! ! REQUIRE FILES: ! %IF %BLISS (BLISS32) %THEN LIBRARY 'SYS$LIBRARY:STARLET'; %FI REQUIRE 'KERCOM'; REQUIRE 'KERERR'; %SBTTL 'Macro definitions' ! ! MACROS: ! MACRO CTL (C) = ((C) XOR %O'100')%, CHAR (C) = ((C) + %O'40')%, UNCHAR (C) = ((C) - %O'40')%; %SBTTL 'KERMIT Protocol Definitions' !++ ! The following describes the various items that are found in the ! KERMIT messages. A complete and through desription of the protocol can be ! found in the KERMIT PROTOCOL MANUAL. ! ! ! All KERMIT messages have the following format: ! ! ! ! ! Normally SOH (Control-A, octal 001). ! ! ! Count of the number of characters following this position. ! Character counts of ONLY 0 to 94 are valid. ! ! ! Packet sequence number, modulo 100 (octal). ! ! ! This field contains the message dependent information. There can ! be multiple fields in this section. See the KERMIT Protocol document ! for a complete description of this. ! ! ! A block check on the characters in the packet between, but not ! including, the mark and the checksum itself. It may be one to three ! characters, depending upon the type agreed upon. ! ! 1. Single character arithmetic sum equal to: ! chksum = (s + ((s AND 300)/100)) AND 77 ! Character sent is CHAR(chksum). ! ! 2. Two character arithmetic sum. CHAR of bits 6-11 are the first ! character, CHAR of bits 0-5 are the second character. ! ! 3. Three character CRC-CCITT. First character is CHAR of bits 12-15, ! second is CHAR of bits 6-11, third is CHAR of bits 0-5. ! ! ! ! End of line. Any line terminator that may be required by the host. !-- %SBTTL 'KERMIT Protocol Definitions -- Packet offsets' !++ ! The following define the various offsets of the standard KERMIT ! packets. !-- LITERAL PKT_MARK = 0, ! PKT_COUNT = 1, ! PKT_SEQ = 2, ! PKT_TYPE = 3, ! PKT_MSG = 4, ! PKT_MAX_MSG = 94 - 5, ! Maximum size of the message dependent ! information PKT_CHKSUM = 0, ! offset from end of ! Message dependent information PKT_EOL = 1, ! offset from end of data PKT_OVR_HEAD_B = 2, ! Header overhead PKT_OVR_HEAD_E = 1, ! Overhead at the end PKT_OVR_HEAD = 3, ! Overhead added to data length PKT_TOT_OVR_HEAD = 6; ! Total overhead of the message %SBTTL 'KERMIT Protocol Definitions -- Message dependent field' !++ ! The MESSAGE-DEPENDENT information field of the message contains at ! least one part. That is the type of message. The remainder of the message ! MESSAGE-DEPENDENT field is different depending on the message. ! ! ! ! ! The type defines the type of message that is being processed. ! !-- ! Protocol version 1.0 message types LITERAL MSG_DATA = %C'D', ! Data packet MSG_ACK = %C'Y', ! Acknowledgement MSG_NAK = %C'N', ! Negative acknowledgement MSG_SND_INIT = %C'S', ! Send initiate MSG_BREAK = %C'B', ! Break transmission MSG_FILE = %C'F', ! File header MSG_EOF = %C'Z', ! End of file (EOF) MSG_ERROR = %C'E'; ! Error ! Protocol version 2.0 message types LITERAL MSG_RCV_INIT = %C'R', ! Receive initiate MSG_COMMAND = %C'C', ! Host command MSG_KERMIT = %C'G'; ! Generic KERMIT command. ! Protocol version 4.0 message types LITERAL MSG_SER_INIT = %C'I'; ! Server initialization !++ ! Generic KERMIT commands !-- LITERAL MSG_GEN_LOGIN = %C'I', ! Login MSG_GEN_EXIT = %C'F', ! Finish (exit to OS) MSG_GEN_CONNECT = %C'C', ! Connect to a directory MSG_GEN_LOGOUT = %C'L', ! Logout MSG_GEN_DIRECTORY = %C'D', ! Directory MSG_GEN_DISK_USAGE = %C'U', ! Disk usage MSG_GEN_DELETE = %C'E', ! Delete a file MSG_GEN_TYPE = %C'T', ! Type a file specification MSG_GEN_SUBMIT = %C'S', ! Submit MSG_GEN_PRINT = %C'P', ! Print MSG_GEN_WHO = %C'W', ! Who's logged in MSG_GEN_SEND = %C'M', ! Send a message to a user MSG_GEN_HELP = %C'H', ! Help MSG_GEN_QUERY = %C'Q'; ! Query status ! ! Acknowledgement modifiers (protocol 4.0?) ! LITERAL MSG_ACK_ABT_CUR = %C'X', ! Abort current file MSG_ACK_ABT_ALL = %C'Z'; ! Abort entire stream of files ! ! End of file packet modifier ! LITERAL MSG_EOF_DISCARD = %C'D'; ! Discard data from previous file %SBTTL 'KERMIT Protocol Definitions -- SEND initiate packet' !++ ! ! The following describes the send initiate packet. All fields in the message ! data area are optional. ! ! <"S"> ! <8-bit-quote> ! ! BUFSIZ ! Sending Kermit's maximum buffer size. ! ! Timeout ! Number of seconds after which the sending Kermit wishes to be timed out ! ! Npad ! Number of padding caracters the sending Kermit needs preceding each ! packet. ! ! PAD ! Padding character. ! ! EOL ! A line terminator required on all packets set by the receiving ! Kermit. ! ! Quote ! The printable ASCII characer the sending Kermit will use when quoting ! the control cahracters. Default is "#". ! ! 8-bit-quote ! Specify quoting mecanism for 8-bit quantities. A quoting mecanism is ! mecessary when sending to hosts which prevent the use of the 8th bit ! for data. When elected, the quoting mechanism will be used by both ! hosts, and the quote character must be in the range of 41-76 or 140-176 ! octal, but different from the control-quoting character. This field is ! interpreted as follows: ! ! "Y" - I agree to 8-bit quoting if you request it. ! "N" - I will not do 8-bit quoting. ! "&" - (or any other character in the range of 41-76 or 140-176) I want ! to do 8-bit quoting using this character (it will be done if the ! other Kermit puts a "Y" in this field. ! Anything else: Quoting will not be done. ! ! Check-type ! Type of block check. The only values presently allowed in this ! field are "1", "2" or "3". Future implementations may allow other ! values. Interpretation of the values is: ! ! "1" - Single character checksum. Default value if none specified. ! "2" - Double character checksum. ! "3" - Three character CRC. ! ! Repeat-count-processing ! The prefix character to be used to indicate a repeated character. ! This can be any printable cahracter other than blank (which denotes ! no repeat count). ! ! Fields 10 to 11 reserved. !-- LITERAL P_SI_BUFSIZ = 0, ! Buffersize MY_PKT_SIZE = 80, ! My packet size P_SI_TIMOUT = 1, ! Time out MY_TIME_OUT = 15, ! My time out P_SI_NPAD = 2, ! Number of padding characters MY_NPAD = 0, ! Amount of padding I require P_SI_PAD = 3, ! Padding character MY_PAD_CHAR = 0, ! My pad character P_SI_EOL = 4, ! End of line character MY_EOL_CHAR = %O'015', ! My EOL cahracter P_SI_QUOTE = 5, ! Quote character MY_QUOTE_CHAR = %C'#', ! My quoting character P_SI_8QUOTE = 6, ! 8-bit quote MY_8BIT_QUOTE = %C'&', ! Don't do it P_SI_CHKTYPE = 7, ! Checktype used MY_CHKTYPE = CHK_1CHAR, ! Use single character checksum P_SI_REPEAT = 8, ! Repeat character MY_REPEAT = %C'~', ! My repeat character P_SI_LENGTH = 9; ! Length of the message %SBTTL 'KERMIT Protocol States' !++ ! The following are the various states that KERMIT can be in. ! The state transitions are defined in the KERMIT Protocol manual. !-- LITERAL STATE_MIN = 0, ! Min state number STATE_START = 0, ! Start state STATE_S = 1, ! Send init state STATE_SF = 2, ! Send file header STATE_SD = 3, ! Send file data packet STATE_SZ = 4, ! Send EOF packet STATE_SB = 5, ! Send break STATE_R = 6, ! Receive state (wait for send-init) STATE_RF = 7, ! Receive file header packet STATE_RD = 8, ! Receive file data packet STATE_C = 9, ! Send complete STATE_A = 10, ! Abort STATE_MAX = 10; ! Max state number %SBTTL 'Internal constants' !++ ! The following represent various internal KERMSG constants. !-- LITERAL MAX_PKT_RETRIES = 16, ! Maximum packet retries MAX_SI_RETRIES = 5; ! Maximum send init retries %SBTTL 'Storage - Global' ! ! OWN STORAGE: ! GLOBAL ! ! Receive parameters ! RCV_PKT_SIZE, ! Receive packet size RCV_NPAD, ! Padding length RCV_PADCHAR, ! Padding character RCV_TIMEOUT, ! Time out RCV_EOL, ! EOL character RCV_QUOTE_CHR, ! Quote character RCV_SOH, ! Start of header character RCV_8QUOTE_CHR, ! 8-bit quoting character ! ! Miscellaneous parameters ! SET_REPT_CHR, ! Repeat character ! ! Send parameters ! SND_PKT_SIZE, ! Send packet size SND_NPAD, ! Padding length SND_PADCHAR, ! Padding character SND_TIMEOUT, ! Time out SND_EOL, ! EOL character SND_QUOTE_CHR, ! Quote character SND_SOH, ! Start of header character ! ! Statistics ! SND_TOTAL_CHARS, ! Total characters sent RCV_TOTAL_CHARS, ! Total characters received SND_DATA_CHARS, ! Total number of data characters sent RCV_DATA_CHARS, ! Total number of data characters received SND_NAKS, ! Total NAKs sent RCV_NAKS, ! Total NAKs received SND_COUNT, ! Total number of packets sent RCV_COUNT, ! Total number of packets received SMSG_TOTAL_CHARS, ! Total chars sent this file xfer RMSG_TOTAL_CHARS, ! Total chars rcvd this file xfer SMSG_DATA_CHARS, ! Total data chars this file xfer RMSG_DATA_CHARS, ! Total data chars this file xfer SMSG_NAKS, ! Total number of NAKs this file xfer RMSG_NAKS, ! Total number of NAKs received XFR_TIME, ! Amount of time last xfr took TOTAL_TIME, ! Total time of all xfrs ! this file xfer LAST_ERROR : VECTOR [CH$ALLOCATION (MAX_MSG + 1)], ! Last error message ! ! Misc constants. ! FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], FILE_SIZE, SI_RETRIES, ! Send init retries to attempt PKT_RETRIES, ! Number of retries to try for a message DELAY, ! Amount of time to delay DUPLEX, ! Type of connection (half or full) PARITY_TYPE, ! Type of parity to use DEV_PARITY_FLAG, ! True if output device does ! parity, false if we do it CHKTYPE, ! Type of block check desired ABT_FLAG, ! True if aborted file should be discarded DEBUG_FLAG, ! Debugging mode on/off WARN_FLAG, ! File warning flag IBM_FLAG, ! Talking to an IBM system IBM_CHAR, ! Turnaround character for IBM mode ECHO_FLAG, ! Local echo flag CONNECT_FLAG, ! Connected flag; True if ! terminal and SET LINE are ! the same ABT_CUR_FILE, ! Abort current file ABT_ALL_FILE, ! Abort all files in stream TY_FIL, ! Type file specs TY_PKT; ! Type packet info %SBTTL 'Storage - Local' ! ! LOCAL OWN STORAGE: ! OWN ! ! Receive parameters ! RECV_8QUOTE_CHR, ! 8th-bit quoting character REPT_CHR, ! Repeat prefix character ! ! Send parameters ! SEND_PKT_SIZE, ! Send packet size SEND_NPAD, ! Padding length SEND_PADCHAR, ! Padding character SEND_TIMEOUT, ! Time out SEND_EOL, ! EOL character SEND_QUOTE_CHR, ! Quote character SEND_8QUOTE_CHR, ! 8-bit quoting character ! ! Misc parameters ! INI_CHK_TYPE, ! Type of block checking from init message BLK_CHK_TYPE, ! Type of block check to use FLAG_8QUOTE, ! Flag to determine if doing 8bit quoting FLAG_REPEAT, ! True if doing repeated character compression STATUS, ! Status returned by various routines STATE, ! Current state SIZE, ! Size of the current message OLD_RETRIES, ! Saved number of retries done. NUM_RETRIES, ! Number of retries MSG_NUMBER, ! Current message number REC_SEQ, ! Sequence number of msg in REC_MSG REC_LENGTH, ! Length of the message recv'd REC_TYPE, ! Type of the message received. REC_MSG : VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)], ! Message received SND_MSG : VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)], ! Message sent FILE_OPEN_FLAG; ! File is opened. %SBTTL 'External references' ! ! EXTERNAL REFERENCES: ! ! Packet I/O routines EXTERNAL ROUTINE SEND, ! Send a packet to the remote IBM_WAIT, ! Wait for IBM turnaround RECEIVE; ! Receive a packet from the remote ! ! Terminal I/O routines ! EXTERNAL ROUTINE TERM_DUMP : NOVALUE, ! Normal terminal output DBG_DUMP : NOVALUE, ! Debugging output TT_SET_OUTPUT, ! Set output routine TT_CHAR : NOVALUE, ! Output a single character TT_CRLF : NOVALUE, ! Output a CRLF TT_NUMBER : NOVALUE, ! Output a three digit number to the ! terminal TT_TEXT : NOVALUE, ! Output a string to the user's TT_OUTPUT : NOVALUE; ! Force buffered output to terminal ! Operating system routines and misc routines EXTERNAL ROUTINE CRCCLC, ! Calculate a CRC-CCITT XFR_STATUS : NOVALUE, ! Routine to tell the user the ! status of a transfer KRM_ERROR : NOVALUE, ! Issue an error message SY_LOGOUT : NOVALUE, ! Log the job off SY_TIME, ! Return elapsed time in milliseconds SY_DISMISS : NOVALUE; ! Routine to dismiss for n seconds. ! ! External file processing routines ! EXTERNAL ROUTINE FILE_OPEN, ! Open a file for reading/writing FILE_CLOSE, ! Close an open file NEXT_FILE, ! Determine if there is a next file ! and open it for reading. GET_FILE, ! Get a byte from the file PUT_FILE, ! Put a byte in the file. FILE_DUMP; ! Dump the contents of the current ! record. Used for binary files ! if needed. %SBTTL 'MSG_INIT' GLOBAL ROUTINE MSG_INIT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the message processing for ! KERMIT-32/36. ! ! CALLING SEQUENCE: ! ! MSG_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! Initialize some variables ! ! Receive parameters first ! RCV_PKT_SIZE = MY_PKT_SIZE; RCV_NPAD = MY_NPAD; RCV_PADCHAR = MY_PAD_CHAR; RCV_TIMEOUT = MY_TIME_OUT; RCV_EOL = MY_EOL_CHAR; RCV_QUOTE_CHR = MY_QUOTE_CHAR; RCV_SOH = CHR_SOH; RCV_8QUOTE_CHR = MY_8BIT_QUOTE; SET_REPT_CHR = MY_REPEAT; ! ! Send parameters. ! SND_PKT_SIZE = -MY_PKT_SIZE; SND_NPAD = -MY_NPAD; SND_PADCHAR = -MY_PAD_CHAR; SND_TIMEOUT = -MY_TIME_OUT; SND_EOL = -MY_EOL_CHAR; SND_QUOTE_CHR = -MY_QUOTE_CHAR; SND_SOH = CHR_SOH; ! ! Other random parameters ! PKT_RETRIES = MAX_PKT_RETRIES; ! Number of retries per message SI_RETRIES = MAX_SI_RETRIES; ! Number of retries on send inits DELAY = INIT_DELAY; DUPLEX = DP_FULL; ! Use full duplex DEBUG_FLAG = FALSE; WARN_FLAG = FALSE; ECHO_FLAG = FALSE; BLK_CHK_TYPE = CHK_1CHAR; ! Start using single char checksum CHKTYPE = MY_CHKTYPE; ! Desired block check type INI_CHK_TYPE = .CHKTYPE; ! Same as default for now DEV_PARITY_FLAG = FALSE; ! We generate parity PARITY_TYPE = PR_NONE; ! No parity ABT_FLAG = TRUE; ! Discard incomplete files FILE_OPEN_FLAG = FALSE; IBM_FLAG = FALSE; ! Not talking to an IBM IBM_CHAR = CHR_DC1; ! XON is IBM turnaround character TY_FIL = TRUE; ! Default to typing files TY_PKT = FALSE; ! But not packet numbers END; ! End of MSG_INIT %SBTTL 'SERVER - Server mode' GLOBAL ROUTINE SERVER = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will handle the server function in the v2.0 protocol ! for KERMIT. This routine by it's nature will call various operating ! system routines to do things like logging off the system. ! ! CALLING SEQUENCE: ! ! EXIT_FLAG = SERVER(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN RETURN WHILE TRUE DO BEGIN INIT_XFR (); ! Set up so we can send a message STATUS = REC_PACKET (); ! ! Now determine what to do by the type of message we have receive. ! IF .STATUS EQL KER_ABORTED THEN EXITLOOP .STATUS; IF .STATUS THEN BEGIN SELECTONE .REC_TYPE OF SET ! ! Server initialization message received. ACK the ! message and continue. ! ! [MSG_SER_INIT] : ! BEGIN ! IF (STATUS = PRS_SEND_INIT ()) ! THEN ! BEGIN ! SET_SEND_INIT (); ! STATUS = SEND_PACKET (MSG_ACK, P_SI_LENGTH, .REC_SEQ); ! END; ! END; ! ! Send init message received. We must ACK the message and ! then attempt to receive a file from the remote. ! [MSG_SND_INIT] : BEGIN MSG_NUMBER = (.REC_SEQ + 1) AND %O'77'; IF (STATUS = PRS_SEND_INIT ()) THEN BEGIN SET_SEND_INIT (); ! ! ACK the message then receive everything. ! IF SEND_PACKET (MSG_ACK, P_SI_LENGTH, .REC_SEQ) THEN BEGIN STATE = STATE_RF; BLK_CHK_TYPE = .INI_CHK_TYPE; ! Switch to desired form of block check REC_SWITCH_WORKER (); END; END; END; ! ! Here if we receive a receive init message. ! We will be sending a file to the other end. ! [MSG_RCV_INIT] : BEGIN MSG_NUMBER = .REC_SEQ; ! ! Move the file specification if we received one ! IF .REC_LENGTH GTR 0 THEN BEGIN CH$COPY (.REC_LENGTH, CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE), CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME)); FILE_SIZE = .REC_LENGTH; SEND_SWITCH_WORKER (); END ELSE BEGIN KRM_ERROR (KER_PROTOERR); END; END; ! ! Generic KERMIT commands ! [MSG_KERMIT] : BEGIN STATUS = SERVER_GENERIC (); IF .STATUS EQL KER_EXIT THEN EXITLOOP KER_EXIT; END; ! ! Unimplimented server routines ! [OTHERWISE] : KRM_ERROR (KER_UNISRV); TES; END ELSE SEND_PACKET (MSG_NAK, 0, 0); END; END; ! End of GLOBAL ROUTINE SERVER %SBTTL 'SERVER - Generic commands' ROUTINE SERVER_GENERIC = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will handle the generic server messages. ! The generic server messages include FINISH, LOGOUT. ! ! CALLING SEQUENCE: ! ! SERVER_GENERIC(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! Generic message receive in REC_MSG. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN SELECTONE CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE)) OF SET ! ! EXIT command, just return the status to the upper level ! [MSG_GEN_EXIT] : BEGIN SEND_PACKET (MSG_ACK, 0, .REC_SEQ); RETURN KER_EXIT; END; ! ! LOGOUT command, ACK the message then call the system routine to ! kill the process (log the job out, etc.) ! [MSG_GEN_LOGOUT] : BEGIN SEND_PACKET (MSG_ACK, 0, .REC_SEQ); SY_LOGOUT (); RETURN KER_NORMAL; END; ! ! This routine will cause files to be deleted from disk. ! ![MSG_GEN_DELETE] : ! BEGIN ! END; ! ! This routine will cause file(s) to be printed on the line printer. ! ![MSG_GEN_PRINT] : ! BEGIN ! END; ! ! Here if we have a function that is currently not implemented ! return a unimplmented server function error code. ! [OTHERWISE] : BEGIN KRM_ERROR (KER_UNIMPLGEN); RETURN KER_UNIMPLGEN; END; TES; END; ! End of SERVER_GENERIC %SBTTL 'Server -- DO_GENERIC - Execute a generic command' GLOBAL ROUTINE DO_GENERIC (TYPE) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send a generic command to the remote Kermit. ! it will do all the processing required for the generic command ! that was executed. It will return to the caller after the ! command has be executed. ! ! CALLING SEQUENCE: ! ! STATUS = DO_GENERIC (Command-type); ! ! INPUT PARAMETERS: ! ! Command-type -- Command type to be executed. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN INIT_XFR (); CASE .TYPE FROM GC_MIN TO GC_MAX OF SET ! ! Here if the caller wants the remote server Kermit to exit ! to the operating system prompt level. We send the generic ! message and wait until it is ACK'd. ! Resend the message if we must. ! [GC_EXIT] : BEGIN CH$WCHAR (MSG_GEN_EXIT, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE)); WHILE TRUE DO BEGIN IF NOT (STATUS = SEND_PACKET (MSG_KERMIT, 1, 0)) THEN RETURN .STATUS; IF NOT (STATUS = REC_PACKET ()) THEN RETURN .STATUS; IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ EQL 0 THEN EXITLOOP; END; RETURN KER_NORMAL; END; ! ! Here if the caller wants the remote server to die off. ! Send the generic LOGOUT message and wait until it is ACK'd. ! Resend the message if we must. ! [GC_LOGOUT] : BEGIN CH$WCHAR (MSG_GEN_LOGOUT, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE)); WHILE TRUE DO BEGIN IF NOT (STATUS = SEND_PACKET (MSG_KERMIT, 1, 0)) THEN RETURN .STATUS; IF NOT (STATUS = REC_PACKET ()) THEN RETURN .STATUS; IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ EQL 0 THEN EXITLOOP; END; RETURN KER_NORMAL; END; ! ! Here if the caller wants us to send something that we currently ! don't support. We will return an unimplemented code to the caller. ! [INRANGE, OUTRANGE] : BEGIN KRM_ERROR (KER_UNIMPLGEN); RETURN KER_UNIMPLGEN; END; TES; END; ! End of DO_GENERIC %SBTTL 'SEND_SWITCH' GLOBAL ROUTINE SEND_SWITCH = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is the state table switcher for sending files. It ! loops until either it is finished or an error is encountered. The ! routines called by SEND_SWITCH are responsible for changing the state. ! ! CALLING SEQUENCE: ! ! SEND_SWITCH(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! Returns: ! TRUE - File sent correctly. ! FALSE - Aborted sending the file. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN IF .CONNECT_FLAG THEN SY_DISMISS (.DELAY); ! Sleep if the user wanted us to RETURN SEND_SWITCH_WORKER (); ! Call routine to do real work END; %SBTTL 'SEND_SWITCH_WORKER' ROUTINE SEND_SWITCH_WORKER = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is the state table switcher for sending files. It ! loops until either it is finished or an error is encountered. The ! routines called by SEND_SWITCH_WORKER are responsible for changing ! the state. ! ! CALLING SEQUENCE: ! ! SEND_SWITCH_WORKER(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! Returns: ! TRUE - File sent correctly. ! FALSE - Aborted sending the file. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL VAL_RETURN, FINISHED; INIT_XFR (); ! Initialize for this transfer STATE = STATE_S; ! Initial state is send NUM_RETRIES = 0; ! Initialize number of retries MSG_NUMBER = 0; ! Initial message number CLEAR (); ! Clear the message buffers FINISHED = FALSE; DO BEGIN CASE .STATE FROM STATE_MIN TO STATE_MAX OF SET [STATE_SD] : STATE = SEND_DATA (); [STATE_SF] : STATE = SEND_FILE (); [STATE_SZ] : STATE = SEND_EOF (); [STATE_S] : STATE = SEND_INIT (); [STATE_SB] : STATE = SEND_BREAK (); [STATE_C] : BEGIN FINISHED = TRUE; VAL_RETURN = TRUE; END; [STATE_A] : BEGIN IF .FILE_OPEN_FLAG THEN BEGIN IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN TT_TEXT (UPLIT (%ASCIZ' [Aborted]')); TT_CRLF (); ! End the line END; FILE_CLOSE (FALSE); FILE_OPEN_FLAG = FALSE; END; FINISHED = TRUE; VAL_RETURN = FALSE; END; [INRANGE, OUTRANGE] : BEGIN FINISHED = TRUE; VAL_RETURN = FALSE; END; TES END UNTIL (.FINISHED EQL TRUE); ! ! Close off the stats and return ! END_STATS (); RETURN .VAL_RETURN; END; %SBTTL 'SEND_DATA' ROUTINE SEND_DATA = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send a data message to the remote KERMIT. ! ! CALLING SEQUENCE: ! ! STATE = SEND_DATA(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state to change the finite state machine to. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! Check to see if the number of retries have been exceeded. ! IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_A; ! ! Not exceeded yet. Increment the number of retries we have attempted ! on this message. ! NUM_RETRIES = .NUM_RETRIES + 1; ! ! Attempt to send the packet and abort if the send fails. ! IF NOT SEND_PACKET (MSG_DATA, .SIZE, .MSG_NUMBER) THEN RETURN STATE_A; ! ! Attempt to receive a message from the remote KERMIT. ! STATUS = REC_PACKET (); IF NOT .STATUS THEN BEGIN IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR) THEN RETURN .STATE ELSE RETURN STATE_A; END; ! ! Determine if the message is a NAK and the NAK is for the message number ! that we are current working on. If the NAK is for the next packet then ! ignore the NAK ! IF .REC_TYPE EQL MSG_NAK AND .REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77') THEN RETURN .STATE; ! ! Make sure we have a NAK or ACK ! IF .REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK THEN BEGIN ! ! Is this for this message? ! IF .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE; ! ! It was. Set up for sending the next data message to the remote KERMIT ! and return. ! ! ! Check for data field in ACK indicating abort file or stream ! ! IF .REC_TYPE EQL MSG_ACK AND .REC_LENGTH EQL 1 THEN SELECTONE CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE)) OF SET [MSG_ACK_ABT_CUR] : ABT_CUR_FILE = TRUE; [MSG_ACK_ABT_ALL] : ABT_ALL_FILE = TRUE; TES; NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; IF (BFR_FILL (FALSE) EQL KER_NORMAL) AND NOT (.ABT_CUR_FILE OR .ABT_ALL_FILE) THEN RETURN STATE_SD ELSE BEGIN IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN IF .ABT_ALL_FILE THEN TT_TEXT (UPLIT (%ASCIZ' [Group interrupted]')) ELSE IF .ABT_CUR_FILE THEN TT_TEXT (UPLIT (%ASCIZ' [Interrupted]')) ELSE TT_TEXT (UPLIT (%ASCIZ' [OK]')); TT_CRLF (); END; FILE_CLOSE (FALSE); FILE_OPEN_FLAG = FALSE; RETURN STATE_SZ; END; END ELSE ! ! Not an ACK or NAK, abort. ! RETURN STATE_A; END; %SBTTL 'SEND_FILE' ROUTINE SEND_FILE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send the file specification that is being ! transfered. ! ! CALLING SEQUENCE: ! ! STATE = SEND_FILE(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state to change the finite state machine to. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! Flag we don't want to abort yet ! ABT_CUR_FILE = FALSE; ABT_ALL_FILE = FALSE; ! ! First determine if we have exceed the number of retries that are ! allowed to attempt to send this message. ! IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_A; ! ! The number of retries are not exceeded. Increment the number and then ! attempt to send the packet again. ! NUM_RETRIES = .NUM_RETRIES + 1; IF .FILE_SIZE NEQ 0 THEN CH$MOVE (.FILE_SIZE, CH$PTR (FILE_NAME), CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE)); IF NOT SEND_PACKET (MSG_FILE, .FILE_SIZE, .MSG_NUMBER) THEN RETURN STATE_A; ! ! Now get the responce from the remote KERMIT. ! STATUS = REC_PACKET (); IF NOT .STATUS THEN BEGIN IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR) THEN RETURN .STATE ELSE RETURN STATE_A; END; ! ! Determine if the packet is good. ! IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK) THEN RETURN STATE_A; ! ! If this is a NAK and the message number is not the one we just send ! treat this like an ACK, otherwise resend the last packet. ! IF .REC_TYPE EQL MSG_NAK AND .REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77') THEN RETURN .STATE; IF .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE; ! ! If all is ok, bump the message number and fill first buffer ! NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; IF BFR_FILL (TRUE) THEN RETURN STATE_SD ELSE RETURN STATE_A; END; ! End of SEND_FILE %SBTTL 'SEND_EOF' ROUTINE SEND_EOF = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send the end of file message to the remote ! KERMIT. It will then determine if there are more files to ! send to the remote. ! ! CALLING SEQUENCE: ! ! STATE = SEND_EOF(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state to change the finite state machine to. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! Sets up for the next file to be processed if there is one. ! !-- BEGIN LOCAL EOF_MSG_LEN; ! Length of EOF message to send ! ! First determine if we have exceed the number of retries that are ! allowed to attempt to send this message. ! IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_A; ! ! The number of retries are not exceeded. Increment the number and then ! attempt to send the packet again. ! NUM_RETRIES = .NUM_RETRIES + 1; ! ! Store character in packet to indicate discard of file ! Character will only be sent if file should be discarded ! CH$WCHAR (MSG_EOF_DISCARD, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE)); IF .ABT_CUR_FILE OR .ABT_ALL_FILE THEN EOF_MSG_LEN = 1 ELSE EOF_MSG_LEN = 0; IF NOT SEND_PACKET (MSG_EOF, .EOF_MSG_LEN, .MSG_NUMBER) THEN RETURN STATE_A; ! ! Now get the responce from the remote KERMIT. ! STATUS = REC_PACKET (); IF NOT .STATUS THEN BEGIN IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR) THEN RETURN .STATE ELSE RETURN STATE_A; END; ! ! Determine if the packet is good. ! IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK) THEN RETURN STATE_A; ! ! If this is a NAK and the message number is not the one we just send ! treat this like an ACK, otherwise resend the last packet. ! IF .REC_TYPE EQL MSG_NAK AND .REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77') THEN RETURN .STATE; IF .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE; ! ! Here to determine if there is another file to send. ! NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; IF NOT .ABT_ALL_FILE THEN STATUS = NEXT_FILE () ELSE STATUS = KER_NOMORFILES; IF ( NOT .STATUS) OR (.STATUS EQL KER_NOMORFILES) THEN RETURN STATE_SB ELSE RETURN STATE_SF; END; %SBTTL 'SEND_INIT' ROUTINE SEND_INIT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send the initialization packet to the remote ! KERMIT. The message type sent is S. ! ! CALLING SEQUENCE: ! ! STATE = SEND_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state to change the finite state machine to. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN SET_SEND_INIT (); IF .NUM_RETRIES GTR .SI_RETRIES THEN RETURN STATE_A; ! ! Count the number of times we try this ! NUM_RETRIES = .NUM_RETRIES + 1; IF NOT SEND_PACKET (MSG_SND_INIT, P_SI_LENGTH, .MSG_NUMBER) THEN RETURN STATE_A; ! ! Determine if we received a packet it good condition. If we timed out or ! got an illegal message, just try again. ! STATUS = REC_PACKET (); IF NOT .STATUS THEN BEGIN IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR) THEN RETURN .STATE ELSE RETURN STATE_A; END; ! ! Determine if the packet is good. ! IF .REC_TYPE NEQ MSG_ACK THEN RETURN .STATE; IF .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE; ! ! Here if we have an ACK for the initialization message that was just sent ! to the remote KERMIT. ! IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN STATE_A; BLK_CHK_TYPE = .INI_CHK_TYPE; ! We now use agreed upon block check type NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN TT_TEXT (UPLIT (%ASCIZ'Sending: ')); TT_OUTPUT (); END; IF NOT FILE_OPEN (FNC_READ) THEN RETURN STATE_A ELSE BEGIN IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN TT_TEXT (FILE_NAME); TT_OUTPUT (); END; FILE_OPEN_FLAG = TRUE; RETURN STATE_SF; END; END; %SBTTL 'SEND_BREAK' ROUTINE SEND_BREAK = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send the break (end of transmission) message ! to the remote KERMIT. On an ACK the state becomes STATE_C. ! ! CALLING SEQUENCE: ! ! STATE = SEND_BREAK(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state for the finite state machine. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! First determine if we have exceed the number of retries that are ! allowed to attempt to send this message. ! IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_A; ! ! The number of retries are not exceeded. Increment the number and then ! attempt to send the packet again. ! NUM_RETRIES = .NUM_RETRIES + 1; IF NOT SEND_PACKET (MSG_BREAK, 0, .MSG_NUMBER) THEN RETURN STATE_A; ! ! Now get the responce from the remote KERMIT. ! STATUS = REC_PACKET (); IF NOT .STATUS THEN BEGIN IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR) THEN RETURN .STATE ELSE RETURN STATE_A; END; ! ! Determine if the packet is good. ! IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK) THEN RETURN STATE_A; ! ! If this is a NAK and the message number is not the one we just send ! treat this like an ACK, otherwise resend the last packet. ! IF .REC_TYPE EQL MSG_NAK AND .REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77') THEN RETURN .STATE; IF .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE; ! ! Here to determine if there is another file to send. ! NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_C; END; %SBTTL 'SND_ERROR' GLOBAL ROUTINE SND_ERROR (COUNT, ADDRESS) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send an error packet to the remote KERMIT. It ! is called with the count of characters and the address of the text. ! ! CALLING SEQUENCE: ! ! SND_ERROR(COUNT, %ASCII 'Error text'); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! !-- BEGIN LOCAL CHR, ! Character we are processing SIZE, ! Size of data area STO_PTR, ! Pointer used to store chars FET_PTR; ! Pointer used to fetch characters ! ! Initialize the various pointers and counter. ! FET_PTR = CH$PTR (.ADDRESS); STO_PTR = CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE); ! ! Determine the max size we can use ! SIZE = (IF .COUNT GTR .SEND_PKT_SIZE - PKT_TOT_OVR_HEAD THEN .SEND_PKT_SIZE - PKT_TOT_OVR_HEAD ELSE .COUNT); ! ! Move the information from the source to the destination ! CH$MOVE (.SIZE, .FET_PTR, .STO_PTR); CH$COPY (.SIZE, CH$PTR (.ADDRESS), 0, .SIZE + 1, CH$PTR (LAST_ERROR)); IF NOT SEND_PACKET (MSG_ERROR, .SIZE, .MSG_NUMBER) THEN RETURN STATE_A; END; ! End of SND_ERROR %SBTTL 'REC_SWITCH' GLOBAL ROUTINE REC_SWITCH = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will cause file(s) to be received by the remote ! KERMIT. This routine contains the main loop for the sending of the ! data. ! ! CALLING SEQUENCE: ! ! REC_SWITCH(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! FILE_DESC - Descriptor describing the file to be received by ! the remote KERMIT. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! True - File received correctly. ! FALSE - File transfer aborted. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN STATE = STATE_R; ! Initialize the state MSG_NUMBER = 0; INIT_XFR (); ! Initialize the per transfer info ! ! Determine if they said REC ! Send MSG_RCV_INIT and then receive the file ! IF .FILE_SIZE GTR 0 THEN BEGIN CH$MOVE (.FILE_SIZE, CH$PTR (FILE_NAME), CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE)); IF NOT (STATUS = SEND_PACKET (MSG_RCV_INIT, .FILE_SIZE, .MSG_NUMBER)) THEN RETURN .STATUS; END; ! ! Now receive the file normally ! RETURN REC_SWITCH_WORKER (); END; ! End of REC_SWITCH %SBTTL 'Receive - REC_SWITCH_WORKER' ROUTINE REC_SWITCH_WORKER = !++ ! FUNCTIONAL DESCRIPTION: ! ! This is the worker routine for either REC_SWITCH or SERVER. ! This routine will be called with the STATE variable set to the ! correct state for either the SERVER or the REC_SWITCH routine. ! ! CALLING SEQUENCE: ! ! Status = REC_SWITCH_WORKER(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL RETURN_VALUE; NUM_RETRIES = 0; ! Initialize the number of retries WHILE TRUE DO CASE .STATE FROM STATE_MIN TO STATE_MAX OF SET ! ! Receiving of the data and the end of file message. ! [STATE_RD] : STATE = REC_DATA (); ! ! Receiving the FILE information of the break to end the transfer of ! one or more files ! [STATE_RF] : STATE = REC_FILE (); ! ! Initialization for the receiving of a file ! [STATE_R] : STATE = REC_INIT (); ! ! Here if we have completed the receiving of the file ! [STATE_C] : BEGIN RETURN_VALUE = TRUE; EXITLOOP; END; ! ! Here if we aborted the transfer or we have gotten into some random ! state (internal KERMSG problem). ! [STATE_A, INRANGE, OUTRANGE] : BEGIN RETURN_VALUE = FALSE; ! ! Determine if the file is still open and if so close it ! IF .FILE_OPEN_FLAG THEN BEGIN FILE_OPEN_FLAG = FALSE; IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN TT_TEXT (UPLIT (%ASCIZ' [Aborted]')); TT_CRLF (); END; FILE_CLOSE (.ABT_FLAG AND (.STATE EQL STATE_A)); END; EXITLOOP; END; TES; ! ! End the stats and return to the caller ! END_STATS (); ! RETURN .RETURN_VALUE; END; ! End of REC_SWITCH_WORKER %SBTTL 'REC_INIT' ROUTINE REC_INIT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will process an initialization message received from ! the remote KERMIT. ! ! CALLING SEQUENCE: ! ! STATE = REC_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New machine state. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ROUTINE CHECK_INIT = BEGIN IF .REC_TYPE EQL MSG_SND_INIT THEN RETURN TRUE ELSE RETURN FALSE; END; IF NOT REC_MESSAGE (CHECK_INIT) THEN RETURN STATE_A; MSG_NUMBER = .REC_SEQ; IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN STATE_A; SET_SEND_INIT (); SEND_PACKET (MSG_ACK, P_SI_LENGTH, .MSG_NUMBER); BLK_CHK_TYPE = .INI_CHK_TYPE; ! Can now use agreed upon type OLD_RETRIES = .NUM_RETRIES; NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_RF; END; ! End of REC_INIT %SBTTL 'REC_FILE' ROUTINE REC_FILE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine expects to receive an MSG_FILE packet from the remote ! KERMIT. If the message is correct this routine will change the state ! to STATE_RD. ! ! This routine also expects MSG_SND_INIT, MSG_EOF, or MSG_BREAK. ! ! CALLING SEQUENCE: ! ! STATE = REC_FILE(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ROUTINE CHECK_FILE = BEGIN IF (.REC_TYPE EQL MSG_SND_INIT) OR (.REC_TYPE EQL MSG_EOF) OR (.REC_TYPE EQL MSG_FILE) OR ( .REC_TYPE EQL MSG_BREAK) THEN RETURN TRUE ELSE RETURN FALSE; END; ! ! Initialize the abort flags ! ABT_CUR_FILE = FALSE; ABT_ALL_FILE = FALSE; ! ! Get a message ! IF NOT REC_MESSAGE (CHECK_FILE) THEN RETURN STATE_A; SELECTONE .REC_TYPE OF SET [MSG_SND_INIT] : BEGIN IF .OLD_RETRIES GTR .SI_RETRIES THEN RETURN STATE_A; OLD_RETRIES = .OLD_RETRIES + 1; IF .MSG_NUMBER - 1 EQL .REC_SEQ THEN BEGIN SET_SEND_INIT (); BLK_CHK_TYPE = CHK_1CHAR; ! Must use 1 character CHKSUM SEND_PACKET (MSG_ACK, P_SI_LENGTH, .REC_SEQ); BLK_CHK_TYPE = .INI_CHK_TYPE; ! Back to agreed upon type NUM_RETRIES = 0; RETURN .STATE; END ELSE RETURN STATE_A; END; [MSG_EOF] : BEGIN IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_A; OLD_RETRIES = .OLD_RETRIES + 1; IF .MSG_NUMBER - 1 EQL .REC_SEQ THEN BEGIN SEND_PACKET (MSG_ACK, 0, .REC_SEQ); NUM_RETRIES = 0; RETURN .STATE; END ELSE RETURN STATE_A; END; [MSG_FILE] : BEGIN IF .MSG_NUMBER NEQ .REC_SEQ THEN RETURN STATE_A; IF .REC_LENGTH EQL 0 THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; FILE_SIZE = .REC_LENGTH; CH$COPY (.REC_LENGTH, CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE), CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME)); IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN TT_TEXT (UPLIT (%ASCIZ'Receiving: ')); TT_TEXT (FILE_NAME); TT_OUTPUT (); END; IF NOT FILE_OPEN (FNC_WRITE) THEN RETURN STATE_A; FILE_OPEN_FLAG = TRUE; SEND_PACKET (MSG_ACK, 0, .MSG_NUMBER); OLD_RETRIES = .NUM_RETRIES; NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_RD; END; [MSG_BREAK] : BEGIN IF .MSG_NUMBER NEQ .REC_SEQ THEN RETURN STATE_A; SEND_PACKET (MSG_ACK, 0, .REC_SEQ); RETURN STATE_C; END; [OTHERWISE] : RETURN STATE_A; TES; END; ! End of REC_FILE %SBTTL 'REC_DATA' ROUTINE REC_DATA = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will accept data messages and write them to disk. ! It will also accept MSG_FILE and MSG_EOF messages. ! ! CALLING SEQUENCE: ! ! STATE = REC_DATA(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state for the finite state machine. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ROUTINE CHECK_DATA = BEGIN IF .REC_TYPE EQL MSG_DATA OR .REC_TYPE EQL MSG_FILE OR .REC_TYPE EQL MSG_EOF THEN RETURN TRUE ELSE RETURN FALSE; END; LOCAL DISCARD_FILE_FLAG, ! Sender requested discard ACK_MSG_LEN; ! Length of ACK to send ! ! First get a message ! IF NOT REC_MESSAGE (CHECK_DATA) THEN RETURN STATE_A; SELECTONE .REC_TYPE OF SET [MSG_DATA] : BEGIN IF .MSG_NUMBER NEQ .REC_SEQ THEN BEGIN IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_A; OLD_RETRIES = .OLD_RETRIES + 1; IF .MSG_NUMBER - 1 EQL .REC_SEQ THEN BEGIN SEND_PACKET (MSG_ACK, 0, .REC_SEQ); NUM_RETRIES = 0; RETURN .STATE; END ELSE RETURN STATE_A; END; ! ! Here if we have a message with a valid message number ! IF NOT BFR_EMPTY () THEN RETURN STATE_A; ! ! Check if we wish to abort for some reason ! IF .ABT_CUR_FILE THEN BEGIN CH$WCHAR (MSG_ACK_ABT_CUR, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE)); ACK_MSG_LEN = 1; END ELSE IF .ABT_ALL_FILE THEN BEGIN CH$WCHAR (MSG_ACK_ABT_ALL, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE)); ACK_MSG_LEN = 1; END ELSE ACK_MSG_LEN = 0; ! ! Now send the ACK ! SEND_PACKET (MSG_ACK, .ACK_MSG_LEN, .REC_SEQ); OLD_RETRIES = .NUM_RETRIES; NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_RD; END; [MSG_FILE] : BEGIN IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_A; OLD_RETRIES = .OLD_RETRIES + 1; IF .MSG_NUMBER - 1 EQL .REC_SEQ THEN BEGIN SEND_PACKET (MSG_ACK, 0, .REC_SEQ); NUM_RETRIES = 0; RETURN .STATE; END ELSE RETURN STATE_A; END; [MSG_EOF] : BEGIN IF .MSG_NUMBER NEQ .REC_SEQ THEN RETURN STATE_A; SEND_PACKET (MSG_ACK, 0, .REC_SEQ); FILE_OPEN_FLAG = FALSE; DISCARD_FILE_FLAG = FALSE; ! Assume we want file IF .REC_LENGTH EQL 1 THEN IF CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE)) EQL MSG_EOF_DISCARD THEN DISCARD_FILE_FLAG = .ABT_FLAG; IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN IF .DISCARD_FILE_FLAG THEN IF .ABT_FLAG THEN TT_TEXT (UPLIT (%ASCIZ' [Interrupted]')) ELSE TT_TEXT (UPLIT (%ASCIZ' [Interrupted, partial file saved]')) ELSE TT_TEXT (UPLIT (%ASCIZ' [OK]')); TT_CRLF (); END; IF NOT FILE_CLOSE (.DISCARD_FILE_FLAG) THEN RETURN STATE_A; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_RF; END; [OTHERWISE] : RETURN STATE_A; TES; END; ! End of REC_DATA %SBTTL 'CLEAR' ROUTINE CLEAR : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will clear the message buffer. ! ! CALLING SEQUENCE: ! ! CLEAR(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN CH$FILL (0, MAX_MSG, CH$PTR (SND_MSG, 0, CHR_SIZE)); END; %SBTTL 'Message processing -- PRS_SEND_INIT - Parse send init params' ROUTINE PRS_SEND_INIT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will parse the SEND_INIT parameters that were sent by ! the remote Kermit. The items will be stored into the low segment. ! ! CALLING SEQUENCE: ! ! PRS_SEND_INIT (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! Message stored in REC_MSG. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! The following section of code will parse the various send parameters ! that are found in the send-init message. The following code will store ! the following as the value. ! ! If the user specified a value then the user supplied value will be used else ! the value in the message and if none in the message then the default value. ! ! User supplied values are denoted as positive values in SND_xxxxxxx. ! ! Parse the packet size ! SEND_PKT_SIZE = (IF .SND_PKT_SIZE GEQ 0 THEN .SND_PKT_SIZE ELSE BEGIN IF .REC_LENGTH GTR P_SI_BUFSIZ THEN UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_BUFSIZ, CHR_SIZE))) ELSE ABS (.SND_PKT_SIZE) END ); ! ! Parse the time out value ! SEND_TIMEOUT = (IF .SND_TIMEOUT GEQ 0 THEN .SND_TIMEOUT ELSE BEGIN IF .REC_LENGTH GTR P_SI_TIMOUT THEN UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_TIMOUT, CHR_SIZE))) ELSE ABS (.SND_TIMEOUT) END ); ! ! Parse the number of padding characters supplied ! SEND_NPAD = (IF .SND_NPAD GEQ 0 THEN .SND_NPAD ELSE BEGIN IF .REC_LENGTH GTR P_SI_NPAD THEN UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_NPAD, CHR_SIZE))) ELSE ABS (.SND_NPAD) END ); ! ! Parse the padding character ! SEND_PADCHAR = (IF .SND_PADCHAR GEQ 0 THEN .SND_PADCHAR ELSE BEGIN IF .REC_LENGTH GTR P_SI_PAD THEN CTL (CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_PAD, CHR_SIZE))) ELSE ABS (.SND_PADCHAR) END ); ! ! Parse the end of line character ! SEND_EOL = (IF .SND_EOL GEQ 0 THEN .SND_EOL ELSE BEGIN IF .REC_LENGTH GTR P_SI_EOL THEN UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_EOL, CHR_SIZE))) ELSE ABS (.SND_EOL) END ); ! ! Parse the quoting character ! SEND_QUOTE_CHR = (IF .SND_QUOTE_CHR GEQ 0 THEN .SND_QUOTE_CHR ELSE BEGIN IF .REC_LENGTH GTR P_SI_QUOTE THEN CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_QUOTE, CHR_SIZE)) ELSE ABS (.SND_QUOTE_CHR) END ); ! ! Parse the 8-bit quoting character ! ! If the character was not included in the packet, assume no eight-bit ! quoting allowed (we are probably talking to an old version of Kermit). ! SEND_8QUOTE_CHR = (IF .REC_LENGTH GTR P_SI_8QUOTE THEN CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_8QUOTE, CHR_SIZE)) ELSE %C'N' ! Assume no 8-bit quoting allowed ); ! ! Parse the checksum type ! IF .REC_LENGTH GTR P_SI_CHKTYPE THEN BEGIN IF CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_CHKTYPE, CHR_SIZE)) NEQ .CHKTYPE THEN INI_CHK_TYPE = CHK_1CHAR END ELSE INI_CHK_TYPE = CHK_1CHAR; ! Only single character checksum if not specified ! ! Parse the repeat character ! REPT_CHR = (IF .REC_LENGTH GTR P_SI_REPEAT THEN CH$RCHAR (CH$PTR (REC_MSG, PKT_MSG + P_SI_REPEAT, CHR_SIZE)) ELSE %C' '); ! ! Check for a valid quoting character. If it is not valid, then we have ! a protocol error ! IF NOT ((.SEND_QUOTE_CHR GEQ %O'41' AND .SEND_QUOTE_CHR LEQ %O'76') OR (.SEND_QUOTE_CHR GEQ %O '140' AND .SEND_QUOTE_CHR LEQ %O'176')) THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN KER_PROTOERR; END; ! ! Check for a valid 8 bit quoting and set the 8 bit quoting flag as needed ! IF ( NOT ((.SEND_8QUOTE_CHR GEQ %O'041' AND .SEND_8QUOTE_CHR LEQ %O'076') OR (.SEND_8QUOTE_CHR GEQ %O'140' AND .SEND_8QUOTE_CHR LEQ %O'176') OR (.SEND_8QUOTE_CHR EQL %C'N') OR ( .SEND_8QUOTE_CHR EQL %C'Y'))) OR .SEND_8QUOTE_CHR EQL .SEND_QUOTE_CHR THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN KER_PROTOERR; END; IF .SEND_8QUOTE_CHR EQL %C'Y' THEN SEND_8QUOTE_CHR = .RECV_8QUOTE_CHR; IF .SEND_8QUOTE_CHR NEQ %C'N' AND .SEND_8QUOTE_CHR NEQ %C'Y' THEN FLAG_8QUOTE = TRUE ELSE FLAG_8QUOTE = FALSE; ! ! Check the repeat character and set flags ! IF ( NOT ((.REPT_CHR GEQ %O'41' AND .REPT_CHR LEQ %O'76') OR (.REPT_CHR GEQ %O'140' AND .REPT_CHR LEQ %O'176')) OR .REPT_CHR EQL .SEND_QUOTE_CHR OR .REPT_CHR EQL .SEND_8QUOTE_CHR) AND .REPT_CHR NEQ %C' ' THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN KER_PROTOERR; END; IF .REPT_CHR NEQ %C' ' THEN FLAG_REPEAT = TRUE ELSE FLAG_REPEAT = FALSE; RETURN KER_NORMAL; END; ! End of PRS_SEND_INIT %SBTTL 'SET_SEND_INIT' ROUTINE SET_SEND_INIT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the various parameters for the ! MSG_SND_INIT message. ! ! CALLING SEQUENCE: ! ! SET_SEND_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! SND_MSG parameters set up. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN CH$WCHAR (CHAR (.RCV_PKT_SIZE), CH$PTR (SND_MSG, PKT_MSG + P_SI_BUFSIZ, CHR_SIZE)); CH$WCHAR (CHAR (.RCV_TIMEOUT), CH$PTR (SND_MSG, PKT_MSG + P_SI_TIMOUT, CHR_SIZE)); CH$WCHAR (CHAR (.RCV_NPAD), CH$PTR (SND_MSG, PKT_MSG + P_SI_NPAD, CHR_SIZE)); CH$WCHAR (CTL (.RCV_PADCHAR), CH$PTR (SND_MSG, PKT_MSG + P_SI_PAD, CHR_SIZE)); CH$WCHAR (CHAR (.RCV_EOL), CH$PTR (SND_MSG, PKT_MSG + P_SI_EOL, CHR_SIZE)); CH$WCHAR (.RCV_QUOTE_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_QUOTE, CHR_SIZE)); CH$WCHAR (.SEND_8QUOTE_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_8QUOTE, CHR_SIZE)); CH$WCHAR (.INI_CHK_TYPE, CH$PTR (SND_MSG, PKT_MSG + P_SI_CHKTYPE, CHR_SIZE)); CH$WCHAR (.REPT_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_REPEAT, CHR_SIZE)); END; ! End of SET_SEND_INIT %SBTTL 'SEND_PACKET' ROUTINE SEND_PACKET (TYPE, LENGTH, MN) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will cause a packet to be sent over the line ! that has been opened by OPEN_TERMINAL. ! ! CALLING SEQUENCE: ! ! SEND_PACKET(Type, Length); ! ! INPUT PARAMETERS: ! ! TYPE - Type of packet to send. ! ! LENGTH - Length of the packet being sent. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL FILLER : VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)], TOT_MSG_LEN, ! Length of message including all characters CHKSUM, ! Checksum for the message we calculate POINTER; ! Pointer to the information in the message ! ! Do any filler processing that the remote KERMIT requires. ! IF .SEND_NPAD NEQ 0 THEN BEGIN CH$FILL (.SEND_PADCHAR, MAX_MSG, CH$PTR (FILLER, 0, CHR_SIZE)); ! ! Update the send stats ! SMSG_TOTAL_CHARS = .SMSG_TOTAL_CHARS + .SEND_NPAD; ! ! Send the fill ! DO_PARITY (FILLER, .SEND_NPAD + PKT_TOT_OVR_HEAD); SEND (FILLER, .SEND_NPAD + PKT_TOT_OVR_HEAD); END; ! ! Store the header information into the message. ! CH$WCHAR (.TYPE, CH$PTR (SND_MSG, PKT_TYPE, CHR_SIZE)); CH$WCHAR (.SND_SOH, CH$PTR (SND_MSG, PKT_MARK, CHR_SIZE)); CH$WCHAR (CHAR (.LENGTH + PKT_OVR_HEAD + (.BLK_CHK_TYPE - CHK_1CHAR)), CH$PTR (SND_MSG, PKT_COUNT, CHR_SIZE)); CH$WCHAR (CHAR ((IF .MN LSS 0 THEN 0 ELSE .MN)), CH$PTR (SND_MSG, PKT_SEQ, CHR_SIZE)); ! ! Calculate the block check value ! POINTER = CH$PTR (SND_MSG, PKT_MARK + 1, CHR_SIZE); CHKSUM = CALC_BLOCK_CHECK (.POINTER, .LENGTH + PKT_OVR_HEAD); TOT_MSG_LEN = .LENGTH + PKT_TOT_OVR_HEAD; ! ! Store the checksum into the message ! POINTER = CH$PTR (SND_MSG, .LENGTH + PKT_OVR_HEAD + 1, CHR_SIZE); CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF SET [CHK_1CHAR] : CH$WCHAR_A (CHAR (.CHKSUM), POINTER); [CHK_2CHAR] : BEGIN CH$WCHAR_A (CHAR (.CHKSUM<6, 6>), POINTER); CH$WCHAR_A (CHAR (.CHKSUM<0, 6>), POINTER); TOT_MSG_LEN = .TOT_MSG_LEN + 1; END; [CHK_CRC] : BEGIN CH$WCHAR_A (CHAR (.CHKSUM<12, 4>), POINTER); CH$WCHAR_A (CHAR (.CHKSUM<6, 6>), POINTER); CH$WCHAR_A (CHAR (.CHKSUM<0, 6>), POINTER); TOT_MSG_LEN = .TOT_MSG_LEN + 2; END; TES; ! ! Store in the end of line character ! CH$WCHAR_A (.SEND_EOL, POINTER); ! ! If we are debugging then type out the message we are sending. ! DBG_SEND (SND_MSG, (.TOT_MSG_LEN)); ! ! Update the stats for total characters and the data characters ! SMSG_TOTAL_CHARS = .SMSG_TOTAL_CHARS + .TOT_MSG_LEN; SMSG_DATA_CHARS = .SMSG_DATA_CHARS + .LENGTH; IF .TYPE EQL MSG_NAK THEN BEGIN SMSG_NAKS = .SMSG_NAKS + 1; XFR_STATUS (%C'S', %C'N'); END ELSE BEGIN SND_COUNT = .SND_COUNT + 1; XFR_STATUS (%C'S', %C'P'); END; ! ! Check if we are in IBM mode and need to wait for an XON first ! We will not wait if this is a packet which might be going out ! without previous traffic (generic commands, init packets). IF .IBM_FLAG AND NOT (.TYPE EQL MSG_SND_INIT OR .TYPE EQL MSG_SER_INIT OR .TYPE EQL MSG_RCV_INIT OR .TYPE EQL MSG_COMMAND OR .TYPE EQL MSG_KERMIT) THEN IF NOT IBM_WAIT () THEN RETURN KER_ABORTED; ! ! Now call the O/S routine to send the message out to the remote KERMIT ! DO_PARITY (SND_MSG, .TOT_MSG_LEN); RETURN SEND (SND_MSG, .TOT_MSG_LEN); END; ! End of SEND_PACKET %SBTTL 'REC_MESSAGE - Receive a message' ROUTINE REC_MESSAGE (CHK_ROUTINE) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will handle the retry processing for the various ! messages that can be received. ! ! CALLING SEQUENCE: ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! KER_NORMAL - Normal return ! KER_RETRIES - Too many retries ! (What ever REC_PACKET returns). ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN RETURN WHILE TRUE DO BEGIN ! I don't think this check is needed. ! IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN KER_RETRIES; NUM_RETRIES = .NUM_RETRIES + 1; STATUS = REC_PACKET (); IF NOT .STATUS AND .STATUS NEQ KER_CHKSUMERR THEN EXITLOOP .STATUS; IF NOT .STATUS THEN SEND_PACKET (MSG_NAK, 0, .MSG_NUMBER - 1) ELSE BEGIN IF NOT (.CHK_ROUTINE) () THEN SEND_PACKET (MSG_NAK, 0, .REC_SEQ) ELSE EXITLOOP KER_NORMAL; END; END; END; ! End of REC_PARSE %SBTTL 'REC_PACKET' ROUTINE REC_PACKET = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will do the oppoiste of SEND_PACKET. It will wait ! for the message to be read from the remote and then it will ! check the message for validity. ! ! CALLING SEQUENCE: ! ! Flag = REC_PACKET(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! REC_MSG - Contains the message received. ! ! COMPLETION CODES: ! ! True - Packet receive ok. ! False - Problem occured during the receiving of the packet. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN BIND ATTEMPT_TEXT = UPLIT (%ASCIZ'Attempting to receive'); LOCAL ! BUFFER : VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)], MSG_LENGTH, ERR_POINTER, ! Pointer to the error buffer POINTER, ! OLD_POINTER, ! Character pointer to the data section ! NEW_POINTER, CHKSUM; ! Checksum of the message ! ! Attempt to read the message from the remote. ! ! DO ! BEGIN IF .DEBUG_FLAG THEN BEGIN LOCAL OLD_RTN; OLD_RTN = TT_SET_OUTPUT (DBG_DUMP); TT_TEXT (ATTEMPT_TEXT); TT_CRLF (); TT_SET_OUTPUT (.OLD_RTN); END; ! ! Receive the message from the remote Kermit ! STATUS = RECEIVE (REC_MSG, MSG_LENGTH); ! ! If it failed return the status to the upper level ! IF NOT .STATUS THEN RETURN .STATUS; ! ! Determine if we got a good message ! IF .MSG_LENGTH EQL 0 THEN BEGIN RETURN KER_ZEROLENMSG; END; ! ! Update the stats on the total number of characters received. ! RMSG_TOTAL_CHARS = .RMSG_TOTAL_CHARS + .MSG_LENGTH; ! ! Now find the message in the information we just received. ! (could have fillers supplied by remote Kermit or remote system. ! just discard them and look for the Ctl-A) ! ! OLD_POINTER = CH$PTR (BUFFER, 0, CHR_SIZE); ! NEW_POINTER = CH$FIND_CH (.MSG_LENGTH, .OLD_POINTER, .RCV_SOH); ! ! WHILE TRUE DO ! ! IF CH$FAIL (.NEW_POINTER) EQL 0 ! THEN ! BEGIN ! MSG_LENGTH = .MSG_LENGTH - CH$DIFF (.NEW_POINTER, .OLD_POINTER); ! ! IF .MSG_LENGTH EQL 0 THEN EXITLOOP; ! ! OLD_POINTER = .NEW_POINTER; ! NEW_POINTER = CH$FIND_CH (.MSG_LENGTH, CH$PLUS (.OLD_POINTER, 1), .RCV_SOH); ! END ! ELSE ! EXITLOOP; ! ! END ! UNTIL .MSG_LENGTH NEQ 0; ! ! IF .MSG_LENGTH EQL 0 THEN RETURN KER_ZEROLENMSG; ! ! CH$MOVE (.MSG_LENGTH, .OLD_POINTER, CH$PTR (REC_MSG, 0, CHR_SIZE)); ! ! Initialize the checksum and others ! REC_TYPE = CH$RCHAR (CH$PTR (REC_MSG, PKT_TYPE, CHR_SIZE)); CHKSUM = CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNT, CHR_SIZE)) + CH$RCHAR (CH$PTR (REC_MSG, PKT_SEQ, CHR_SIZE)) + .REC_TYPE; ! ! Now break the message apart byte by byte. ! REC_LENGTH = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNT, CHR_SIZE))) - PKT_OVR_HEAD - ( .BLK_CHK_TYPE - CHK_1CHAR); REC_SEQ = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_SEQ, CHR_SIZE))); ! ! Typed the packet if we are debugging ! DBG_RECEIVE (REC_MSG); ! ! Now compute the final checksum and make sure that it is identical ! to what we received from the remote KERMIT ! POINTER = CH$PTR (REC_MSG, PKT_MARK + 1, CHR_SIZE); CHKSUM = CALC_BLOCK_CHECK (.POINTER, .REC_LENGTH + PKT_OVR_HEAD); POINTER = CH$PTR (REC_MSG, .REC_LENGTH + PKT_OVR_HEAD + 1, CHR_SIZE); CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF SET [CHK_1CHAR] : IF .CHKSUM NEQ UNCHAR (CH$RCHAR_A (POINTER)) THEN RETURN KER_CHKSUMERR; [CHK_2CHAR] : IF (.CHKSUM<6, 6> NEQ UNCHAR (CH$RCHAR_A (POINTER))) OR (.CHKSUM<0, 6> NEQ UNCHAR ( CH$RCHAR_A (POINTER))) THEN RETURN KER_CHKSUMERR; [CHK_CRC] : IF (.CHKSUM<12, 4> NEQ UNCHAR (CH$RCHAR_A (POINTER))) OR (.CHKSUM<6, 6> NEQ UNCHAR ( CH$RCHAR_A (POINTER))) OR (.CHKSUM<0, 6> NEQ UNCHAR (CH$RCHAR_A (POINTER))) THEN RETURN KER_CHKSUMERR; TES; ! ! Update the stats ! RMSG_DATA_CHARS = .RMSG_DATA_CHARS + .REC_LENGTH; IF .REC_TYPE EQL MSG_NAK THEN BEGIN RMSG_NAKS = .RMSG_NAKS + 1; XFR_STATUS (%C'R', %C'N'); END ELSE BEGIN RCV_COUNT = .RCV_COUNT + 1; XFR_STATUS (%C'R', %C'P'); END; ! ! Now check to see if we have an E type (Error) packet. ! IF .REC_TYPE NEQ MSG_ERROR THEN RETURN KER_NORMAL; ! ! Here to process an error packet. Call the user routine to output the ! error message to the terminal. ! ERR_POINTER = CH$PTR (LAST_ERROR); POINTER = CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE); INCR I FROM 1 TO .REC_LENGTH DO CH$WCHAR_A (CH$RCHAR_A (POINTER), ERR_POINTER); CH$WCHAR (CHR_NUL, ERR_POINTER); TT_TEXT (LAST_ERROR); TT_CRLF (); RETURN KER_ERRMSG; END; ! End of REC_PACKET %SBTTL 'CALC_BLOCK_CHECK' ROUTINE CALC_BLOCK_CHECK (POINTER, LENGTH) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will calculate the proper value for the block check ! for a given message. The value it returns is dependant upon the ! type of block check requested in BLK_CHK_TYPE. ! ! CALLING SEQUENCE: ! ! CHKSUM = CALC_BLOCK_CHECK (.POINTER, .LENGTH); ! ! INPUT PARAMETERS: ! ! POINTER - A character pointer to the first character to be ! included in the block check. ! ! LENGTH - The number of characters to be included. ! ! IMPLICIT INPUTS: ! ! BLK_CHK_TYPE - The type of block check to generate. ! ! OUPTUT PARAMETERS: ! ! The value is the block check. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL BLOCK_CHECK, ! To build initial block check value I; ! Loop counter BLOCK_CHECK = 0; ! Start out at 0 CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF SET [CHK_1CHAR, CHK_2CHAR] : INCR I FROM 1 TO .LENGTH DO BLOCK_CHECK = .BLOCK_CHECK + CH$RCHAR_A (POINTER); [CHK_CRC] : BLOCK_CHECK = CRCCLC (.POINTER, .LENGTH); TES; IF .BLK_CHK_TYPE EQL CHK_1CHAR THEN BLOCK_CHECK = (.BLOCK_CHECK + ((.BLOCK_CHECK AND %O'300')/%O'100')) AND %O'77'; RETURN .BLOCK_CHECK; ! Return the correct value END; ! End of CALC_BLOCK_CHK %SBTTL 'Buffer filling -- Main routine' ROUTINE BFR_FILL (FIRST_FLAG) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will fill the buffer with data from the file. It ! will do all the quoting that is required. ! ! CALLING SEQUENCE: ! ! EOF_FLAG = BFR_FILL(.FIRST_FLAG); ! ! INPUT PARAMETERS: ! ! FIRST_FLAG - Flag whether first call for this file ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! True - Buffer filled may be at end of file. ! False - At end of file. ! ! IMPLICIT OUTPUTS: ! ! Number of characters stored in the buffer. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL I, ! Temp loop index MAX_SIZE, ! Maximum size of data POINTER; ! Pointer into the message buffer OWN NEXT_CHR, ! Saved character STATUS, ! Status value REPEAT_COUNT, ! Number of times character repeated CHAR_8_BIT, ! 8 bit character from file CHRS : VECTOR [5], ! String needed to represent character CHR_IDX, ! Index into CHRS OLD_CHAR_8_BIT, ! Previous 8-bit character OLD_CHRS : VECTOR [5], ! String for previous character OLD_CHR_IDX; ! Index for previous character ROUTINE GET_QUOTED_CHAR = ! ! This routine gets a character from the file and returns both ! the character and the string needed to represent the character ! if it needs quoting. ! BEGIN IF .NEXT_CHR GEQ 0 THEN BEGIN CHAR_8_BIT = .NEXT_CHR; NEXT_CHR = -1; STATUS = KER_NORMAL; END ELSE STATUS = GET_FILE (CHAR_8_BIT); IF .STATUS EQL KER_NORMAL THEN BEGIN ! ! Determine if we should just quote the character ! Either: ! Character is a delete (177 octal) ! or Character is a control character (less than 40 octal) ! or Character is a quote character ! or Character is the repeat character and doing repeat compression ! or Character is an eight bit quote character and doing eight bit ! quoting. ! IF ((.CHAR_8_BIT AND %O'177') LSS %C' ') OR ((.CHAR_8_BIT AND %O'177') EQL CHR_DEL) OR ( (.CHAR_8_BIT AND %O'177') EQL .SEND_QUOTE_CHR) OR (.FLAG_REPEAT AND ((.CHAR_8_BIT AND %O'177') EQL .REPT_CHR)) OR (.FLAG_8QUOTE AND ((.CHAR_8_BIT AND %O'177') EQL .SEND_8QUOTE_CHR)) THEN BEGIN ! ! If the character is a control character or delete we must do a CTL(Character) ! so it is something that we can be sure we can send. ! IF ((.CHAR_8_BIT AND %O'177') LSS %C' ') OR ((.CHAR_8_BIT AND %O'177') EQL CHR_DEL) THEN CHRS [0] = CTL (.CHAR_8_BIT) ELSE CHRS [0] = .CHAR_8_BIT; CHR_IDX = 1; CHRS [1] = .SEND_QUOTE_CHR; END ELSE BEGIN CHR_IDX = 0; CHRS [0] = .CHAR_8_BIT; END; END; RETURN .STATUS; END; ROUTINE GET_8_QUOTED_CHAR = ! ! This routine will get the quoted representation of a character ! (by calling GET_QUOTED_CHAR), and return the 8th-bit quoted ! representation. ! BEGIN IF (STATUS = GET_QUOTED_CHAR ()) EQL KER_NORMAL THEN BEGIN ! ! Determine if we must quote the eighth bit (parity bit on) ! IF (((.CHRS [0] AND %O'177') NEQ .CHRS [0]) AND .FLAG_8QUOTE) THEN BEGIN CHRS [0] = .CHRS [0] AND %O'177'; CHR_IDX = .CHR_IDX + 1; CHRS [.CHR_IDX] = .SEND_8QUOTE_CHR; END; END; RETURN .STATUS; END; ! ! Start of code for BFR_FILL ! ! Initialize pointer and count ! SIZE = 0; POINTER = CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE); MAX_SIZE = .SEND_PKT_SIZE - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR); ! ! If last call got an error or eof, return it now ! IF NOT .FIRST_FLAG AND (.STATUS NEQ KER_NORMAL) THEN RETURN .STATUS; ! ! If first time for a file prime the pump with the first character. ! IF .FIRST_FLAG THEN BEGIN FIRST_FLAG = FALSE; NEXT_CHR = -1; ! No backed up character IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR (); OLD_CHAR_8_BIT = .CHAR_8_BIT; INCR OLD_CHR_IDX FROM 0 TO .CHR_IDX DO OLD_CHRS [.OLD_CHR_IDX] = .CHRS [.OLD_CHR_IDX]; OLD_CHR_IDX = .CHR_IDX; REPEAT_COUNT = 0; ! Character was not repeated yet ! Will always be incremented END; ! ! Otherwise, loop until we fill buffer ! WHILE .SIZE LSS .MAX_SIZE DO ! Normal exit is via an EXITLOOP BEGIN ! ! Check if we are doing run compression ! IF .FLAG_REPEAT THEN BEGIN ! ! Here with previous character in OLD_xxx. As long as we ! are getting the same character, just count the run. ! WHILE (.CHAR_8_BIT EQL .OLD_CHAR_8_BIT) AND (.REPEAT_COUNT LSS 94) DO BEGIN REPEAT_COUNT = .REPEAT_COUNT + 1; IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR (); IF (.STATUS NEQ KER_NORMAL) THEN CHAR_8_BIT = -1; END; IF .OLD_CHR_IDX + 1 + 2 LSS ((.OLD_CHR_IDX + 1)*.REPEAT_COUNT) THEN BEGIN IF .SIZE + .OLD_CHR_IDX + 1 + 2 GTR .MAX_SIZE THEN BEGIN IF .CHAR_8_BIT EQL .OLD_CHAR_8_BIT THEN BEGIN NEXT_CHR = .CHAR_8_BIT; REPEAT_COUNT = .REPEAT_COUNT - 1; END; EXITLOOP; END; OLD_CHRS [.OLD_CHR_IDX + 1] = CHAR (.REPEAT_COUNT); OLD_CHRS [.OLD_CHR_IDX + 2] = .REPT_CHR; OLD_CHR_IDX = .OLD_CHR_IDX + 2; REPEAT_COUNT = 1; ! Only one time for this string END; ! ! If we don't have enough room for this character, wait till next ! time. ! IF .SIZE + (.OLD_CHR_IDX + 1)*.REPEAT_COUNT GTR .MAX_SIZE THEN BEGIN ! If the next character is the same, the count will get incremented ! next time we enter, so back it off now. IF .CHAR_8_BIT EQL .OLD_CHAR_8_BIT THEN BEGIN NEXT_CHR = .CHAR_8_BIT; REPEAT_COUNT = .REPEAT_COUNT - 1; END; EXITLOOP; END; DECR REPEAT_COUNT FROM .REPEAT_COUNT TO 1 DO DECR I FROM .OLD_CHR_IDX TO 0 DO BEGIN CH$WCHAR_A (.OLD_CHRS [.I], POINTER); SIZE = .SIZE + 1; END; ! ! If we got an error (or EOF) then exit ! IF (.STATUS NEQ KER_NORMAL) THEN EXITLOOP; ! ! Otherwise, copy the character which broke the run ! OLD_CHAR_8_BIT = .CHAR_8_BIT; INCR OLD_CHR_IDX FROM 0 TO .CHR_IDX DO OLD_CHRS [.OLD_CHR_IDX] = .CHRS [.OLD_CHR_IDX]; OLD_CHR_IDX = .CHR_IDX; REPEAT_COUNT = 0; END ELSE ! ! Here if we are not doing run compression. We can do things much ! easier. ! BEGIN IF (.SIZE + .CHR_IDX + 1) GTR .MAX_SIZE THEN EXITLOOP; DECR CHR_IDX FROM .CHR_IDX TO 0 DO BEGIN CH$WCHAR_A (.CHRS [.CHR_IDX], POINTER); SIZE = .SIZE + 1; END; IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR (); IF (.STATUS NEQ KER_NORMAL) THEN EXITLOOP; END; END; ! ! Determine if we really stored anything into the buffer. ! IF .SIZE NEQ 0 THEN RETURN KER_NORMAL ELSE RETURN .STATUS; END; ! End of BFR_FILL %SBTTL 'Buffer filling -- Add parity routine' ROUTINE DO_PARITY (MESSAGE, LENGTH) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will add parity for a complete message that is to be ! sent to the remote Kermit. ! ! CALLING SEQUENCE: ! ! DO_PARITY (Message_address, Message_length); ! ! INPUT PARAMETERS: ! ! Message_address - Address of the message to put parity on. ! Message_length - Lengtho of the message. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN MAP MESSAGE : REF VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)]; LOCAL POINTER; ! Point into the message IF NOT .DEV_PARITY_FLAG THEN BEGIN POINTER = CH$PTR (.MESSAGE,, CHR_SIZE); INCR I FROM 1 TO .LENGTH DO CH$WCHAR_A (GEN_PARITY (CH$RCHAR (.POINTER)), POINTER); END; END; ! End of DO_PARITY %SBTTL 'Buffer filling -- Parity routine' GLOBAL ROUTINE GEN_PARITY (CHARACTER) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will add parity to the character that is supplied. ! ! CALLING SEQUENCE: ! ! CHARACTER = GEN_PARITY(CHARACTER) ! ! INPUT PARAMETERS: ! ! CHARACTER - Produce the parity for this character depending on the ! setting of the SET PARITY switch. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL TEMP_CHAR; IF .IBM_FLAG THEN RETURN .CHARACTER OR %O'200'; CASE .PARITY_TYPE FROM PR_MIN TO PR_MAX OF SET [PR_NONE] : RETURN .CHARACTER; [PR_SPACE] : RETURN .CHARACTER AND %O'177'; [PR_MARK] : RETURN .CHARACTER OR %O'200'; [PR_ODD] : BEGIN TEMP_CHAR = .CHARACTER AND %O'177' OR %O'200'; TEMP_CHAR = .TEMP_CHAR<0, 4> XOR .TEMP_CHAR<4, 4>; TEMP_CHAR = .TEMP_CHAR<0, 2> XOR .TEMP_CHAR<2, 2>; IF .TEMP_CHAR EQL %B'01' OR .TEMP_CHAR EQL %B'10' THEN RETURN .CHARACTER AND %O'177' OR %O'200' ELSE RETURN .CHARACTER AND %O'177'; END; [PR_EVEN] : BEGIN TEMP_CHAR = .CHARACTER AND %O'177'; TEMP_CHAR = .TEMP_CHAR<0, 4> XOR .TEMP_CHAR<4, 4>; TEMP_CHAR = .TEMP_CHAR<0, 2> XOR .TEMP_CHAR<2, 2>; IF .TEMP_CHAR EQL %B'01' OR .TEMP_CHAR EQL %B'10' THEN RETURN .CHARACTER AND %O'177' OR %O'200' ELSE RETURN .CHARACTER AND %O'177'; END; TES; END; ! End of GEN_PARITY %SBTTL 'BFR_EMPTY' ROUTINE BFR_EMPTY = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will empty the data from the REC_MSG message buffer ! to the file. It will process quoting characters. ! ! CALLING SEQUENCE: ! ! Flag = BFR_EMPTY(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! True - No problems writing the file. ! False - I/O error writing the file. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL REPEAT_COUNT, ! Count of times to repeat character TURN_BIT_8_ON, ! If eight bit quoting COUNTER, ! Count of the characters left CHARACTER, ! Character we are processing POINTER; ! Pointer to the data POINTER = CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE); COUNTER = 0; WHILE (.COUNTER LSS .REC_LENGTH) DO BEGIN CHARACTER = CH$RCHAR_A (POINTER); COUNTER = .COUNTER + 1; ! ! If the character is the repeat character (and we are doing repeat ! compression), then get the count. ! IF ((.CHARACTER EQL .REPT_CHR) AND .FLAG_REPEAT) THEN BEGIN REPEAT_COUNT = UNCHAR (CH$RCHAR_A (POINTER) AND %O'177'); CHARACTER = CH$RCHAR_A (POINTER); COUNTER = .COUNTER + 2; END ELSE REPEAT_COUNT = 1; ! ! If the character is an eight bit quoting character and we are doing eight ! bit quoting then turn on the flag so we turn the eighth bit on when we ! get the real character. ! IF ((.CHARACTER EQL .SEND_8QUOTE_CHR) AND .FLAG_8QUOTE) THEN BEGIN TURN_BIT_8_ON = TRUE; COUNTER = .COUNTER + 1; CHARACTER = CH$RCHAR_A (POINTER); END ELSE TURN_BIT_8_ON = FALSE; ! ! Now determine if we are quoting the character. If so then we must eat ! the quoting character and get the real character. ! IF .CHARACTER EQL .RCV_QUOTE_CHR THEN BEGIN CHARACTER = CH$RCHAR_A (POINTER); COUNTER = .COUNTER + 1; ! ! Determine if we must undo what someone else has done to the character ! IF ((.CHARACTER AND %O'177') GEQ CTL (CHR_DEL)) AND ((.CHARACTER AND %O'177') LEQ CTL ( CHR_DEL) + %O'40') THEN CHARACTER = CTL (.CHARACTER); END; ! ! Turn on the eight bit if needed and then write the character out ! IF .TURN_BIT_8_ON THEN CHARACTER = .CHARACTER OR %O'200'; WHILE (REPEAT_COUNT = .REPEAT_COUNT - 1) GEQ 0 DO BEGIN STATUS = PUT_FILE (.CHARACTER); IF NOT .STATUS THEN RETURN .STATUS; END; END; ! ! Dump the record if we have an RMS based system. Otherwise we will have ! problem with binary files. ! STATUS = FILE_DUMP (); IF NOT .STATUS THEN RETURN .STATUS; RETURN KER_NORMAL; END; ! End of BFR_EMPTY %SBTTL 'Per transfer -- Initialization' ROUTINE INIT_XFR : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the various locations that the ! send and receive statistics are kept. ! ! CALLING SEQUENCE: ! ! INIT_XFR(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! Determine if we should do 8 bit quoting ! IF .PARITY_TYPE NEQ PR_NONE THEN BEGIN RECV_8QUOTE_CHR = .RCV_8QUOTE_CHR; END ELSE BEGIN RECV_8QUOTE_CHR = %C'Y'; END; SEND_8QUOTE_CHR = .RECV_8QUOTE_CHR; ! ! Send parameters that may not get set before we need them for the first ! time. ! SEND_PKT_SIZE = ABS (.SND_PKT_SIZE); SEND_NPAD = ABS (.SND_NPAD); SEND_PADCHAR = ABS (.SND_PADCHAR); SEND_TIMEOUT = ABS (.SND_TIMEOUT); SEND_EOL = ABS (.SND_EOL); SEND_QUOTE_CHR = ABS (.SND_QUOTE_CHR); ! ! For initialization messages, we must use single character checksum ! When the send-init/ack sequence has been done, we will switch to the ! desired form ! BLK_CHK_TYPE = CHK_1CHAR; INI_CHK_TYPE = .CHKTYPE; ! Send desired type ! ! Set desired repeat character for use in we are doing send-init ! Will be overwritten by other ends desired character if it sends ! the send-init. ! REPT_CHR = .SET_REPT_CHR; ! ! Stats information ! SMSG_TOTAL_CHARS = 0; RMSG_TOTAL_CHARS = 0; SMSG_DATA_CHARS = 0; RMSG_DATA_CHARS = 0; RMSG_NAKS = 0; SMSG_NAKS = 0; XFR_TIME = SY_TIME (); END; ! End of INIT_XFR %SBTTL 'Statistics -- Finish message transfer' ROUTINE END_STATS : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will end the collection of the statistices. It will ! update the various overall statistic parameters. ! ! CALLING SEQUENCE: ! ! END_STATS (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN SND_TOTAL_CHARS = .SND_TOTAL_CHARS + .SMSG_TOTAL_CHARS; SND_DATA_CHARS = .SND_DATA_CHARS + .SMSG_DATA_CHARS; RCV_TOTAL_CHARS = .RCV_TOTAL_CHARS + .RMSG_TOTAL_CHARS; RCV_DATA_CHARS = .RCV_DATA_CHARS + .RMSG_DATA_CHARS; SND_NAKS = .SND_NAKS + .SMSG_NAKS; RCV_NAKS = .RCV_NAKS + .RMSG_NAKS; XFR_TIME = SY_TIME () - .XFR_TIME; TOTAL_TIME = .TOTAL_TIME + .XFR_TIME; END; ! End of END_STATS %SBTTL 'Debugging -- DBG_SEND' ROUTINE DBG_SEND (ADDRESS, LENGTH) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will output the message that is going to be sent ! as part of the debugging information that is turned on in the ! SET DEBUG command. ! ! CALLING SEQUENCE: ! ! DBG_SEND(MSG_ADDRESS, MSG_LENGTH); ! ! INPUT PARAMETERS: ! ! MSG_ADDRESS - Address of the message that is going to be sent ! to the remote KERMIT. The bytes are CHR_SIZE. ! MSG_LENGTH - Length of the message. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN BIND SEND_TEXT = UPLIT (%ASCIZ'Sending...'); IF .DEBUG_FLAG THEN BEGIN LOCAL OLD_RTN; OLD_RTN = TT_SET_OUTPUT (DBG_DUMP); TT_TEXT (SEND_TEXT); DBG_MESSAGE (.ADDRESS, .LENGTH); TT_SET_OUTPUT (.OLD_RTN); END; END; ! End of DBG_SEND %SBTTL 'Debugging -- DBG_RECEIVE' ROUTINE DBG_RECEIVE (ADDRESS) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will output the message that was received from ! the remote KERMIT. This routine is called only if the DEBUG_FLAG ! is true. ! ! CALLING SEQUENCE: ! ! DBG_RECEIVE(MSG_ADDRESS); ! ! INPUT PARAMETERS: ! ! MSG_ADDRESS - Address of the message received by the remote KERMIT. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN BIND RECEIVE_TEXT = UPLIT (%ASCIZ'Received...'); IF .DEBUG_FLAG THEN BEGIN LOCAL OLD_RTN; OLD_RTN = TT_SET_OUTPUT (DBG_DUMP); TT_TEXT (RECEIVE_TEXT); DBG_MESSAGE (.ADDRESS, .REC_LENGTH); TT_SET_OUTPUT (.OLD_RTN); END; END; ! End of DBG_RECEIVE %SBTTL 'Debugging -- DBG_MESSAGE' GLOBAL ROUTINE DBG_MESSAGE (MSG_ADDRESS, MSG_LENGTH) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will display a message that is either being sent ! or received on the user's terminal. ! ! CALLING SEQUENCE: ! ! DBG_MESSAGE(MSG_ADDRESS, MSG_LENGTH); ! ! INPUT PARAMETERS: ! ! MSG_ADDRESS - Address of the message to be output ! MSG_LENGTH - Length of the message to be output. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN MAP MSG_ADDRESS : REF VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)]; ! Point to the vector LOCAL OLD_RTN, ! Old type out routine CHKSUM, ! Numeric value of block check TEMP_POINTER, ! Temporary character pointer MSG_LEN; ! ! Message type text ! BIND DATA_TEXT = UPLIT (%ASCIZ' (Data)'), ACK_TEXT = UPLIT (%ASCIZ' (ACK)'), NAK_TEXT = UPLIT (%ASCIZ' (NAK)'), SND_INIT_TEXT = UPLIT (%ASCIZ' (Send init)'), BREAK_TEXT = UPLIT (%ASCIZ' (Break)'), FILE_TEXT = UPLIT (%ASCIZ' (File)'), EOF_TEXT = UPLIT (%ASCIZ' (EOF)'), ERROR_TEXT = UPLIT (%ASCIZ' (Error)'), RCV_INIT_TEXT = UPLIT (%ASCIZ' (Receive initiate)'), COMMAND_TEXT = UPLIT (%ASCIZ' (Command)'), KERMIT_TEXT = UPLIT (%ASCIZ' (Generic KERMIT command)'); ! ! Header information ! BIND MN_TEXT = UPLIT (%ASCIZ'Message number: '), LENGTH_TEXT = UPLIT (%ASCIZ' Length: '), DEC_TEXT = UPLIT (%ASCIZ' (dec)'), MSG_TYP_TEXT = UPLIT (%ASCIZ'Message type: '), CHKSUM_TEXT = UPLIT (%ASCIZ'Checksum: '), CHKSUM_NUM_TEXT = UPLIT (%ASCIZ' = '), OPT_DATA_TEXT = UPLIT (%ASCIZ'Optional data: '), PRE_CHAR_TEXT = UPLIT (%ASCIZ' "'); ! ! Ensure that the type out will go to the debugging location ! OLD_RTN = TT_SET_OUTPUT (DBG_DUMP); ! ! Preliminary calculations ! MSG_LEN = UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_COUNT, CHR_SIZE))); ! ! First output some header information for the packet. ! TT_CRLF (); TT_TEXT (MN_TEXT); TT_NUMBER (UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_SEQ, CHR_SIZE)))); TT_TEXT (DEC_TEXT); TT_TEXT (LENGTH_TEXT); TT_NUMBER (.MSG_LEN); TT_TEXT (DEC_TEXT); TT_CRLF (); ! ! Now output the message type and dependent information ! TT_TEXT (MSG_TYP_TEXT); TT_CHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_TYPE, CHR_SIZE))); SELECTONE CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_TYPE, CHR_SIZE)) OF SET [MSG_DATA] : TT_TEXT (DATA_TEXT); [MSG_ACK] : TT_TEXT (ACK_TEXT); [MSG_NAK] : TT_TEXT (NAK_TEXT); [MSG_SND_INIT] : TT_TEXT (SND_INIT_TEXT); [MSG_BREAK] : TT_TEXT (BREAK_TEXT); [MSG_FILE] : TT_TEXT (FILE_TEXT); [MSG_EOF] : TT_TEXT (EOF_TEXT); [MSG_ERROR] : TT_TEXT (ERROR_TEXT); TES; TT_CRLF (); ! ! Now output any of the optional data. ! IF .MSG_LEN - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR) NEQ 0 THEN BEGIN TT_TEXT (OPT_DATA_TEXT); TT_CRLF (); TEMP_POINTER = CH$PTR (.MSG_ADDRESS, PKT_MSG, CHR_SIZE); INCR I FROM 1 TO .MSG_LEN - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR) DO BEGIN IF (.I MOD 10) EQL 1 THEN BEGIN TT_CRLF (); TT_CHAR (CHR_TAB); END; TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR_A (TEMP_POINTER)); TT_CHAR (%C'"'); END; IF ((.MSG_LEN - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR)) MOD 10) EQL 1 THEN TT_CRLF (); TT_CRLF (); END; ! ! Now output the checksum for the message that we received ! ! This could be either 1 two or three characters. TT_TEXT (CHKSUM_TEXT); TEMP_POINTER = CH$PTR (.MSG_ADDRESS, PKT_MSG + .MSG_LEN + PKT_CHKSUM - PKT_OVR_HEAD - (.BLK_CHK_TYPE - CHK_1CHAR), CHR_SIZE); CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF SET [CHK_1CHAR] : BEGIN TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM = UNCHAR (CH$RCHAR (.TEMP_POINTER)); END; [CHK_2CHAR] : BEGIN CHKSUM = 0; TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM<6, 6> = UNCHAR (CH$RCHAR_A (TEMP_POINTER)); TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM<0, 6> = UNCHAR (CH$RCHAR (.TEMP_POINTER)); END; [CHK_CRC] : BEGIN CHKSUM = 0; TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM<12, 4> = UNCHAR (CH$RCHAR_A (TEMP_POINTER)); TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM<6, 6> = UNCHAR (CH$RCHAR_A (TEMP_POINTER)); TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM<0, 6> = UNCHAR (CH$RCHAR (.TEMP_POINTER)); END; TES; TT_TEXT (CHKSUM_NUM_TEXT); TT_NUMBER (.CHKSUM); TT_TEXT (DEC_TEXT); TT_CRLF (); TT_SET_OUTPUT (.OLD_RTN); ! Reset output destination END; ! End of DBG_MESSAGE %SBTTL 'End of KERMSG' END ELUDOM