MODULE KERMIT (IDENT = '1.0.000', 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 Create this program. !-- %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 STORE_TEXT, ! Routine to store a file name COPY_DEVICE, ! 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 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. 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]; %; ! ! EQUATED SYMBOLS: ! ! Command offsets LITERAL CMD_CONN = 1, ! Connect command CMD_EXIT = 2, ! Exit command CMD_HELP = 3, ! Help command CMD_RECE = 4, ! Receive command CMD_SET = 5, ! Set command CMD_SEND = 6, ! Send command CMD_SHOW = 7, ! Show command CMD_SERVER = 8; ! SERVER 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 ! 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 ! ! ! GLOBAL STORAGE: ! GLOBAL TERM_NAME : VECTOR [CH$ALLOCATION(TERM_LENGTH)], TERM_DESC : BLOCK [8, BYTE]; ! Terminal name descriptor ! ! 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 ! Misc constants. TEMP_DESC : BLOCK [8, BYTE], ! Temporary descriptor TEMP_NAME : VECTOR [CH$ALLOCATION(TEMP_LENGTH)], ESCAPE_CHR; ! Escape character for CONNECT ! ! ! ! EXTERNAL REFERENCES: ! EXTERNAL ROUTINE ! ! Library routines ! LIB$GET_FOREIGN : ADDRESSING_MODE(GENERAL), LIB$GET_INPUT : ADDRESSING_MODE(GENERAL), LIB$PUT_OUTPUT : ADDRESSING_MODE(GENERAL), LIB$TPARSE : 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 SERVER : NOVALUE, ! 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_OPEN, ! Open the terminal line TERM_CLOSE, ! Close the terminal line TT_INIT : NOVALUE, ! Initialization routine TT_CHAR : NOVALUE, ! Output a single character TT_CRLF : NOVALUE; ! Output the line ! ! 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 ! 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_8QUOTE_CHR, ! 8-bit quoting character ! Misc constants. FILE_SIZE, ! Number of characters in FILE_NAME FILE_NAME : VECTOR [CH$ALLOCATION(MAX_FILE_NAME)], DELAY, ! Amount of time to delay DEBUG_FLAG, ! Debugging mode on/off WARN_FLAG, ! File warning flag 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 ! ! !++ ! !The following are the command state tables for the KERMIT-32 !command processing. ! !-- $INIT_STATE (KERMIT_STATE, KERMIT_KEY); $STATE (START, ('CONNECT', CONN_STATE, , CMD_CONN, COMMAND), ('EXIT', DONE_STATE, , CMD_EXIT, COMMAND), ('HELP', HELP_STATE, HELP_START, CMD_HELP, COMMAND), ('QUIT', DONE_STATE, , CMD_EXIT, COMMAND), ('RECEIVE', REC_STATE, , CMD_RECE, 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) ) !++ ! CONNECT command. Format is: ! ! Kermit-32>CONNECT device ! ! Where: ! Device - Terminal line to connect to ! !-- $STATE (CONN_STATE, (TPA$_SYMBOL, DONE_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, REC_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: ! SEND ! RECEIVE ! !-- $STATE (SET_STATE, ('DEBUGGING', SET_DEB_STATE), ('DELAY', SET_DEL_STATE), ('ESCAPE', SET_ESC_STATE), ('FILE_TYPE', SET_FIL_STATE), ('LINE', SET_LIN_STATE), ('LOCAL_ECHO', SET_ECH_STATE), ('RECEIVE', SET_REC_STATE), ('SEND', SET_SND_STATE) ) !++ ! ! 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 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 Cotnrol-]. !-- $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) ) !++ ! 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_DEVICE) ) !++ ! 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) ) %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_PKT_STATE), ('PACKET_LENGTH', SR_PKT_STATE), ('PADDING', SR_PAD_STATE), ('PADCHAR', SR_PDC_STATE), ('TIMEOUT', SR_TIM_STATE), ('END_OF_LINE', SR_EOL_STATE), ('QUOTE', SR_QUO_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 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 QUOTA command. The format is: ! ! Kermit-32>SET RECEIVE QUOTA ! ! Where: ! is the octal number representing the quoting character. ! !-- $STATE (SR_QUO_STATE, (TPA$_OCTAL, DONE_STATE, , ,RCV_QUOTE_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, ! ('EIGHT_BIT_QUOTE, SS_PKT_STATE), ('PACKET_LENGTH', SS_PKT_STATE), ('PADDING', SS_PAD_STATE), ('PADCHAR', SS_PDC_STATE), ('TIMEOUT', SS_TIM_STATE), ('END_OF_LINE', SS_EOL_STATE), ('QUOTE', SS_QUO_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 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), ('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), ('LINE', DONE_STATE, ,SHOW_LIN, SHOW_TYPE), ('LOCAL_ECHO', DONE_STATE, ,SHOW_ECH, SHOW_TYPE), ('SEND', DONE_STATE, ,SHOW_SEN, SHOW_TYPE), ('RECEIVE', DONE_STATE, ,SHOW_REC, 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 LOOP_FLAG; ! Initialize some variables MSG_INIT (); TT_INIT (); FILE_INIT (); ESCAPE_CHR = CHR_ESCAPE; LIB$ESTABLISH (KERM_HANDLER); ! 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; 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_CONN] : BEGIN STATUS = LIB$PUT_OUTPUT (%ASCID'CONNECT is not implemented yet'); IF .STATUS NEQ SS$_NORMAL THEN LIB$SIGNAL (.STATUS); ! TERM_CONNECT(); END; [CMD_EXIT] : EXITLOOP KER_NORMAL; [CMD_HELP] : COMND_HELP (); [CMD_RECE] : 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 SERVER (); TERM_CLOSE (); EXITLOOP KER_NORMAL; END; END; [CMD_SHOW] : COMND_SHOW (); TES; END ELSE LIB$SIGNAL (.STATUS); END ELSE LIB$SIGNAL (.STATUS); END; ! End of WHILE TRUE DO BEGIN END; ! End of COMND %SBTTL '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), LIB$GET_INPUT); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); END; %SBTTL '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 OWN OUTPUT_LINE : VECTOR [OUT_BFR_LENGTH, BYTE, UNSIGNED], OUTPUT_DESC : BLOCK [8, BYTE], OUTPUT_SIZE : WORD UNSIGNED; 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_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', SHOW_LIN_MSG = %ASCID' Line used !AS', SHOW_ECH_MSG = %ASCID' Local echo !AS', SHOW_REC_HDR = %ASCID' Receive parameters', SHOW_REC_PKT_MSG = %ASCID' Packet length !ZL (dec)', SHOW_REC_PAD_MSG = %ASCID' Padding length !ZL (dec)', SHOW_REC_PDC_MSG = %ASCID' Padding character !3OL (octal)', SHOW_REC_TIM_MSG = %ASCID' Time out !ZL (sec)', SHOW_REC_EOL_MSG = %ASCID' End of line character !3OL (octal)', SHOW_REC_QUO_MSG = %ASCID' Quoting character !3OL (octal)', SHOW_SND_HDR = %ASCID' Send parameters', SHOW_SND_PKT_MSG = %ASCID' Packet length !ZL (dec)', SHOW_SND_PAD_MSG = %ASCID' Padding length !ZL (dec)', SHOW_SND_PDC_MSG = %ASCID' Paddind character !3OL (octal)', SHOW_SND_TIM_MSG = %ASCID' Time out !ZL (sec)', SHOW_SND_EOL_MSG = %ASCID' End of line character !3OL (octal)', SHOW_SND_QUO_MSG = %ASCID' Quoting character !3OL (octal)'; ROUTINE INIT_DESC : NOVALUE = 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; !++ ! 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_TO_OUTPUT); ! ! INPUT PARAMETERS: ! ! MSG_ASCID - %ASCID of the text to use for the $FAO call. ! ! LONG_WORD_TO_OUTPUT - Address of the long word to pass to the $FAO. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- ROUTINE OUTPUT_LONG_WORD (MSG_ADDR, LONG_ADDR) : NOVALUE = BEGIN MAP LONG_ADDR : LONG UNSIGNED, MSG_ADDR : LONG UNSIGNED; LOCAL STATUS : UNSIGNED; ! Status return by LIB$xxx INIT_DESC (); $FAO (.MSG_ADDR, OUTPUT_SIZE, OUTPUT_DESC, ..LONG_ADDR); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); END; !++ ! 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_DEB] : OUTPUT_TRUE_FALSE (SHOW_DEB_MSG, DEBUG_FLAG); [SHOW_ALL, SHOW_DEL] : OUTPUT_LONG_WORD (SHOW_DEL_MSG, DELAY); [SHOW_ALL, SHOW_ESC] : OUTPUT_LONG_WORD (SHOW_ESC_MSG, ESCAPE_CHR); [SHOW_ALL, SHOW_FTP] : BEGIN INIT_DESC (); $FAO (SHOW_FTP_MSG, OUTPUT_SIZE, OUTPUT_DESC, (SELECTONE .FILE_TYPE OF SET [FILE_ASC] : FTP_ASCII; [FILE_BIN] : FTP_BINARY; TES)); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); END; [SHOW_ALL, SHOW_LIN] : 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] : OUTPUT_TRUE_FALSE (SHOW_ECH_MSG, ECHO_FLAG); [SHOW_ALL, SHOW_SEN] : BEGIN STATUS = LIB$PUT_OUTPUT (SHOW_SND_HDR); OUTPUT_LONG_WORD (SHOW_SND_PKT_MSG, SND_PKT_SIZE); OUTPUT_LONG_WORD (SHOW_SND_PAD_MSG, SND_NPAD); OUTPUT_LONG_WORD (SHOW_SND_PDC_MSG, SND_PADCHAR); OUTPUT_LONG_WORD (SHOW_SND_TIM_MSG, SND_TIMEOUT); OUTPUT_LONG_WORD (SHOW_SND_EOL_MSG, SND_EOL); OUTPUT_LONG_WORD (SHOW_SND_QUO_MSG, SND_QUOTE_CHR); END; [SHOW_ALL, SHOW_REC] : BEGIN STATUS = LIB$PUT_OUTPUT (SHOW_REC_HDR); OUTPUT_LONG_WORD (SHOW_REC_PKT_MSG, RCV_PKT_SIZE); OUTPUT_LONG_WORD (SHOW_REC_PAD_MSG, RCV_NPAD); OUTPUT_LONG_WORD (SHOW_REC_PDC_MSG, RCV_PADCHAR); OUTPUT_LONG_WORD (SHOW_REC_TIM_MSG, RCV_TIMEOUT); OUTPUT_LONG_WORD (SHOW_REC_EOL_MSG, RCV_EOL); OUTPUT_LONG_WORD (SHOW_REC_QUO_MSG, RCV_QUOTE_CHR); END; TES; END; ! End of COMND_SHOW %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. ! ! OUPTUT 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_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. ! ! OUPTUT 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_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. ! ! OUPTUT 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 -- 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. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; IF .AP [TPA$L_NUMBER] LSS %C' ' THEN RETURN SS$_NORMAL ELSE RETURN KER_ILLEOL; END; ! End of CHECK_EOL %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. ! ! OUPTUT 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. ! ! OUPTUT 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. ! ! OUPTUT 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 'COPY_FILE' 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_DEVICE' ROUTINE COPY_DEVICE = !++ ! 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). ! ! CALLING SEQUENCE: ! ! COPY_DEVICE(); ! ! 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 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; ! End of COPY_DEVICE %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. ! ! OUPTUT 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. ! ! OUPTUT 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 'SYS_LOGOUT - delete the process.' GLOBAL ROUTINE SYS_LOGOUT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will delete this process. ! ! CALLING SEQUENCE: ! ! SYS_LOGOUT (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN $DELPRC (); END; ! End of SYS_LOGOUT %SBTTL 'DISMISS - Sleep for N seconds' GLOBAL ROUTINE DISMISS (SECONDS) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to cause KERMIT to sleep for the ! specified number of seconds. ! ! CALLING SEQUENCE: ! ! 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 DISMISS(time) %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. ! ! OUPTUT 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. ! ! OUPTUT 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