MODULE KERTRM (IDENT = '3.3.120', ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL) ) = BEGIN ! !++ ! FACILITY: ! ! KERMIT-32 terminal processing. ! ! ABSTRACT: ! ! This module will do all of the terminal processing for KERMIT-32. ! It contains the output routines for the terminal to send and ! receive messages as well as the routines to output text for debugging. ! ! ENVIRONMENT: ! ! VAX/VMS user mode. ! ! AUTHOR: Robert C. McQueen, CREATION DATE: 25-March-1983 !-- %SBTTL 'Table of Contents' ! ! TABLE OF CONTENTS: ! %SBTTL 'Revision History' !++ ! ! Start of version 1. 25-March-1983 ! ! 1.0.000 By: Robert C. McQueen On: 25-March-1983 ! Create this module. ! ! 1.1.001 By: W. Hom On: 6-July-83 ! Implement CONNECT command. ! ! 1.1.002 By: Nick Bush On: 7-July-83 ! Fix RECEIVE QIO to time out correctly. ! ! 1.2.003 By: Robert C. McQueen On: 16-Aug-83 ! Get the status correctly for the SS$_TIMEOUT checks. ! ! 1.2.004 By: Robert C. McQueen On: 9-Sept-1983 ! Flag if we just opened the terminal, so that we can ! clear the input that is coming into the terminal. This ! will clear up some of the junk that we get on start up. ! ! 2.0.005 Release VAX/VMS Kermit-32 version 2.0 ! ! 2.0.006 By: Nick Bush On: 10-Nov-1983 ! Fix local echo and IBM mode. ! ! 2.0.013 By: Nick Bush On: 11-Nov-1983 ! Make it possible to redirect debugging output to DBG$OUTPUT. ! ! 2.0.015 By: Nick Bush On: 17-Nov-1983 ! Always purge typeahead when posting the receive QIO. ! Also eat any received data just before sending a packet. ! ! 2.0.020 By: Nick Bush On: 9-Dec-1983 ! Only abort (when remote) if we seen two control-Y's in ! succession. This way a single glitch does not kill us. ! ! 2.0.021 By: Nick Bush On: 12-Dec-1983 ! Add status type-out character (^A), debug toggle ! character (^D), and force timeout character (^M) ! to those accepted during a transfer when we are remote. ! ! 2.0.023 By: Nick Bush On: 16-Dec-1983 ! Add a default terminal name for the communications line. ! If KER$COMM is defined, that will be the default. ! ! 2.0.027 By: Nick Bush On: 20-Jan-1983 ! Fix reset of parity to use the correct field in the ! IO status block from the IO$_SENSEMODE. It was using ! the LF fill count instead. ! ! 2.0.031 By: Nick Bush On: 4-Feb-1983 ! Change connect code to improve response (hopefully ! without worsening throughput or runtime requirements). ! When either terminal is idle we will be waiting for ! a single character with a larger buffered read queued ! up immediately after it. ! ! 2.0.033 By: Nick Bush On: 6-March-1984 ! Change command input and terminal processing so that ! we will always have SYS$OUTPUT and SYS$COMMAND open ! when they are terminals, and will also always have ! the transfer terminal line open. This makes it ! unnecessary for the user to allocate a dialup line ! in order to go between CONNECT and a transfer command, ! and keep anyone else from grabbing the line between ! commands. ! Also add the command parsing for the rest of the LOCAL/REMOTE ! commands. This makes use of the fact that we have ! SYS$COMMAND open to allow us to read passwords without echo. ! Commands which should only be done when Kermit is local ! (GET, BYE, etc.) will now give an error if the transfer ! line is the same as the controlling terminal. ! SEND will now check for the files existance before calling ! KERMSG to send it. ! ! 2.0.034 By: Nick Bush On: 7-March-1984 ! Default the parity type to be that of the default transfer ! line. This should make things simpler for systems which use ! parity by default. ! ! 2.0.035 By: Nick Bush On: 8-March-1984 ! Add LOG SESSION command to set a log file for CONNECT. ! While we are doing so, clean up the command parsing a little ! so that we don't have as many COPY_xxx routines. ! ! 2.0.036 By: Robert C. McQueen On: 20-March-1984 ! Fix call to LOG_OPEN to make the debug log file work. ! Module: KERTRM ! ! 2.0.037 By: Robert C. McQueen On: 20-March-1984 ! Fix call to LOG_OPEN for debug log file. ! Module: KERTRM. ! ! 2.0.042 By: Nick Bush On: 26-March-1984 ! Fix connect processing to make it easy to type messages ! on the user's terminal while connected. Use this ! to type messages when log file stopped and started. ! Include the node name in the messages to keep ! users who are running through multiple Kermit's from ! getting confused. ! ! 2.0.043 By: Nick Bush On: 28-March-1984 ! Fix SET PARITY ODD to work. Somehow, the table entry ! had PR_NONE instead of PR_ODD. Also add status type ! out and help message to connect command. ! ! 3.0.045 Start of version 3. ! ! 3.0.046 By: Nick Bush On: 29-March-1984 ! Fix debugging log file to correctly set/clear file open ! flag. Also make log files default to .LOG. ! ! 3.1.054 By: Nick Bush On: 13-July-1984 ! Change TERM_OPEN to take an argument which determines ! whether it should post any QIO's. This makes it unnecessary ! for TERM_CONNECT to cancel the QIO's, and avoids problems ! with DECnet remote terminals. ! ! 3.1.060 By: Nick Bush On: 16-March-1985 ! Increase size of terminal name buffers to account for large ! unit numbers (most likely seen with VTA's). ! ! 3.1.061 By: Nick Bush On: 16-March-1985 ! Only attempt to set parity back when closing terminal. ! ! 3.1.065 By: Nick Bush On: 10-April-1985 ! Split IBM handshaking from parity and local echo. Allow ! link time setting of IBM_MODE defaults by defining symbols: ! ! IBM_MODE_CHARACTER = character value of handshake character ! IBM_MODE_ECHO = 1 for local echo, 2 for no local echo ! IBM_MODE_PARITY = (0 = none), (1 = mark), (2 = even), ! (3 = odd), (4 = space). ! ! If not specified, Kermit will continue to use DC1, local echo ! and odd parity for IBM_MODE. ! ! ! Start of version 3.2 on 8-May-1985 ! ! 3.2.073 By: Robert McQueen On: 11-March-1985 ! Fix a problem restoring the terminal characteristics under ! VMS 4.x ! ! 3.2.100 By: Gregory P. Welsh On: 1-June-1986 ! Added code for Transmit function (COMND_TRANSMIT). ! ! Start of version 3.3 ! ! 3.3.101 By: Robert McQueen On: 2-July-1986 ! Change $TRNLOG system service to be LIB$SYS_TRNLOG and ! handle the errors better. (LIB$ shouldn't change even if the ! system service does). ! ! 3.3.102 By: Robert McQueen On: 5-July-1986 ! Add changes/fixes suggested by Art Guion and David Deley. ! - Turn off FALLBACK terminal characteristics for eightbit ! operations. ! - Decrease IBM timeouts when waiting for a handshake. ! ! 3.3.105 By: Robert McQueen On: 8-July-1986 ! Attempt to fix the truncation errors that we now get from ! LINK with BLISS-32 v4.2. Also do code clean up in VMSTRM and ! VMSFIL. ! ! 3.3.115 JHW004 Jonathan H. Welch, 9-May-1988 14:35 ! Added the ability to send a break character to ! the outgoing terminal session using the sequence ! esc-chr B. The break will be sent after the next ! character arrives. This is because there must be ! no outstanding I/O on a channel in order to modify ! terminal characteristics (necessary to send a break). ! ! 3.3.116 JHW008 Jonathan H. Welch, 12-Apr-1990 12:20 ! Added and modified routines in to notify the user if ! SS$_HANGUP occurs on the outgoing terminal line. ! ! 3.3.117 JHW012 Jonathan H. Welch, 18-May-1990 7:56 ! Modified asn_wth_mbx to obtain the master PID in the ! process tree before asking for JPI$_TERMINAL. $GETJPI ! was returning a null string for this item when called ! from a subprocess resulting in a "No default terminal ! line for transfers" message. ! ! 3.3.118 JHW013 Jonathan H. Welch, 18-May-1990 13:00 ! Extended the buffer size for terminal names from 20 ! characters to 255 to make sure any terminal name can ! be accomodated. ! ! 3.3.119 JHW014 Jonathan H. Welch, 5-Jun-1990 12:38 ! Modified asn_wth_mbx to add a ':' to the end of the ! terminal name is one is not returned by VMS. ! This will keep LIB$GETDVI from failing with an ! "invalid device name" which results in the kermit ! error "no default terminal line for transfers." ! ! 3.3.120 JHW016 Jonathan H. Welch, 17-Oct-1990 9:42 ! Modified asn_wth_mbx to work properly in non-interactive mode. !-- %SBTTL 'Library files' ! ! INCLUDE FILES: ! ! ! System definitions ! LIBRARY 'SYS$LIBRARY:STARLET'; ! ! KERMIT common definitions ! REQUIRE 'KERCOM'; REQUIRE 'KERERR'; %SBTTL 'Structure definitions -- $GETDVI arguments' ! ! $GETDVI interface fields and structure definition ! LITERAL ITEM_SIZE = 3; ! Length of a DVI item list entry ! ! Fields for accessing the items in a DVI item list ! FIELD ITEM_FIELDS = SET ITEM_BFR_LENGTH = [0, 0, 16, 0], ITEM_ITEM_CODE = [0, 16, 16, 0], ITEM_BFR_ADDRESS = [1, 0, 32, 0], ITEM_RTN_LENGTH = [2, 0, 32, 0] TES; ! ! Structure definition for item list STRUCTURE ITEM_LIST [I, O, P, S, E; N] = [(N + 1)*ITEM_SIZE*4] (ITEM_LIST + ((I*ITEM_SIZE) + O)*4); %SBTTL 'Structures definitions -- Terminal characteristics' ! ! Terminal characteristics words ! LITERAL TC$_CHAR_LENGTH = 12; ! ! Fields for accessing the items in a characteristic block ! FIELD TC$_FIELDS = SET TC$_CLASS = [0, 0, 8, 0], TC$_TYPE = [0, 8, 8, 0], TC$_BFR_SIZE = [0, 16, 16, 0], TC$_PAGE_LEN = [1, 24, 8, 0], TC$_CHAR = [1, 0, 24, 0], TC$_CHAR_2 = [2, 0, 32, 0] TES; ! ! Structure definition for item list ! STRUCTURE TC$_CHAR_STR [O, P, S, E; N] = [TC$_CHAR_LENGTH] (TC$_CHAR_STR + O*4); %SBTTL 'Literals' ! ! Literal definitions ! LITERAL MAX_NODE_NAME = 255, ! Size of a node name TERM_NAME_SIZE = 255, ! Size of a terminal name - be generous RECV_BUFF_SIZE = MAX_MSG + 20, ! Size of receive buffer GET_DEV_EFN = 7, ! For GET_DEV_CHAR CONS_O_EFN = 6, ! Event flag for console output CONS_EFN = 5, ! Event flag for console input TERM_O_EFN = 4, ! Event flag for terminal output TIME_EFN = 3, ! Event flag number for receive timer TERM_EFN = 2; ! Event flag number to use for Terminal input %SBTTL 'Storage' ! ! OWN STORAGE: ! ! ! Communications routines storage ! OWN FORCE_ABORT, ! Force abort next receive FORCE_TIMEOUT, ! Force time out on next receive TERM_FIRST_TIME, ! First time QIO to read done TERM_CHAN, ! Channel the terminal is opened on mbx_chan : INITIAL(0), ! Mailbox channel associated with TERM_CHAN device. new_mbx_chan : INITIAL(0), ! Mailbox channel associated with new (temporary) TERM_CHAN device. CONS_CHAN, ! Channel the console terminal is opened on SYS_OUTPUT_CHAN, ! Channel to SYS$OUTPUT (if it is a terminal) SYS_OUTPUT_OPEN, ! SYS$OUTPUT open SYS_OUTPUT_NAME : VECTOR [TERM_NAME_SIZE, BYTE], ! Text of physical name for SYS$OUTPUT SYS_OUTPUT_DESC : BLOCK [8, BYTE], ! Descriptor for physical name SYS_COMMAND_CHAN, ! Channel to SYS$COMMAND if a terminal SYS_COMMAND_OPEN, ! SYS$COMMAND open SYS_COMMAND_NAME : VECTOR [TERM_NAME_SIZE, BYTE], ! Text of physical name for SYS$COMMAND SYS_COMMAND_DESC : BLOCK [8, BYTE], ! Descriptor for physical name TERM_NAME : VECTOR [TERM_NAME_SIZE, BYTE], ! Text of current transfer terminal name JOB_TERM_NAME : VECTOR [TERM_NAME_SIZE, BYTE], ! Text of jobs controlling terminal name TERM_OPEN_FLAG, ! The transfer terminal is open SESSION_FAB : $FAB_DECL, ! FAB for session logging SESSION_RAB : $RAB_DECL, ! RAB for session logging SESSION_NAME : VECTOR [MAX_FILE_NAME, BYTE], ! Actual name of session log file SESSION_OPEN, ! Session log file open SESSION_LOGGING, ! Session logging enabled DEBUG_FAB : $FAB_DECL, ! FAB for debugging DEBUG_RAB : $RAB_DECL, ! RAB for debugging DEBUG_NAME : VECTOR [MAX_FILE_NAME, BYTE], ! Name of debugging log file DEBUG_REDIRECTED, ! Debugging output redirected NODE_NAME : VECTOR [MAX_NODE_NAME, BYTE], ! Node name text IO_STATUS : VECTOR [4, WORD], ! IOSB for receive QIO RECV_BUFFER : VECTOR [CH$ALLOCATION (RECV_BUFF_SIZE, CHR_SIZE)], ! Input buffer OLD_PARITY : BLOCK [8, BYTE], ! Old IOSB information OLD_TERM_CHAR : TC$_CHAR_STR FIELD (TC$_FIELDS), ! Old terminal chars NEW_TERM_CHAR : TC$_CHAR_STR FIELD (TC$_FIELDS); ! New terminal chars GLOBAL NODE_DESC : BLOCK [8, BYTE] PRESET ! Descriptor for node name ([DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Text descriptor [DSC$W_LENGTH ] = MAX_NODE_NAME, ! Maximum length [DSC$A_POINTER ] = NODE_NAME), ! Address of the item DEBUG_DESC : BLOCK [8, BYTE] PRESET ! Debugging log file ([DSC$B_CLASS ] = DSC$K_CLASS_S, ! descriptor [DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Standard string descriptor [DSC$W_LENGTH ] = 0, ! initialially zero length [DSC$A_POINTER ] = DEBUG_NAME), ! pointing to DEBUG_NAME SESSION_DESC : BLOCK [8, BYTE], ! Descriptor for session log file name TERM_DESC : BLOCK [8, BYTE], ! Descriptor for current transfer terminal JOB_TERM_DESC : BLOCK [8, BYTE], ! Descriptor for controlling terminal (if any) TRANS_DELAY, ! The transmit delay TRANS_ECHO_FLAG, ! The transmit echo flag TERM_FLAG, ! Terminal setup for transfer Send_Break_TTY_Flag; ! Flag to indicate if a break should be sent. %SBTTL 'External routines' ! ! EXTERNAL REFERENCES: ! ! ! System library routines ! EXTERNAL ROUTINE LIB$ASN_WTH_MBX : ADDRESSING_MODE (GENERAL), LIB$GETJPI : ADDRESSING_MODE (GENERAL), LIB$GETDVI : ADDRESSING_MODE (GENERAL), LIB$PUT_SCREEN : ADDRESSING_MODE (GENERAL), LIB$PUT_OUTPUT : ADDRESSING_MODE (GENERAL), LIB$EMUL : ADDRESSING_MODE (GENERAL), LIB$ADDX : ADDRESSING_MODE (GENERAL), LIB$SIGNAL : ADDRESSING_MODE (GENERAL), LIB$WAIT : ADDRESSING_MODE (GENERAL); ! ! Forward routines: ! FORWARD ROUTINE TERM_DUMP : NOVALUE, ! Routine to type on terminal GET_DEV_CHAR, ! Get device characteristics Term_Hangup : NOVALUE, Mbx_Ast_Rtn : NOVALUE, asn_wth_mbx, Send_Break_TTY, DO_RECEIVE_QIO, DO_CONS_QIO; %SBTTL 'External storage' !++ ! The following is the various external storage locations that are ! referenced from this module. !-- ! ! KERMSG storage ! EXTERNAL PARITY_TYPE, ! Type of parity being used ECHO_FLAG, ! Local echo IBM_CHAR, ! IBM mode turn-around character RCV_EOL, ! Receive EOL character SEND_TIMEOUT, ! Receive time out counter CONNECT_FLAG; ! Flag if communications line is TT: ! ! KERMIT storage ! EXTERNAL ESCAPE_CHR; ! Escape char. for CONNECT. %SBTTL 'Terminal routines -- TERM_INIT - Initialize this module' GLOBAL ROUTINE TERM_INIT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the terminal processing module. It will ! initialize the various data locations in this module. ! ! CALLING SEQUENCE: ! ! TERM_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL COUNTER, ! Counter for logical name translation STATUS, ! System call status DEV_TYPE, ! Device type result RSL_LENGTH : VOLATILE, ! Resulting length of translation RSL_NAME : BLOCK [TERM_NAME_SIZE, BYTE], ! Translated name RSL_DESC : BLOCK [8, BYTE], ! Descriptor for translated name NODE_ITEM_LIST : FIELD(ITEM_FIELDS) ITEM_LIST [2] PRESET ! Node name ([0, ITEM_BFR_LENGTH ] = MAX_NODE_NAME, ! Translation [0, ITEM_ITEM_CODE ] = LNM$_STRING, ! Item list [0, ITEM_BFR_ADDRESS ] = NODE_NAME, ! to xlate [0, ITEM_RTN_LENGTH ] = NODE_DESC[DSC$W_LENGTH]), ! SYS$NODE ITMLST : ITEM_LIST [1] FIELD (ITEM_FIELDS) PRESET ([0, ITEM_ITEM_CODE ] = JPI$_TERMINAL, ! Get terminal name [0, ITEM_BFR_LENGTH ] = TERM_NAME_SIZE - 1, ! Max name size [0, ITEM_BFR_ADDRESS ] = JOB_TERM_NAME + 1, ! Place to store it [0, ITEM_RTN_LENGTH ] = RSL_LENGTH); ! Resulting length ! ! Initialize session log file descriptor ! SESSION_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; SESSION_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; SESSION_DESC [DSC$W_LENGTH] = 0; SESSION_DESC [DSC$A_POINTER] = SESSION_NAME; ! ! Get system node name (if any) ! NODE_DESC [DSC$W_LENGTH] = MAX_NODE_NAME; STATUS = $TRNLNM(ATTR = %REF(LNM$M_CASE_BLIND), TABNAM = %ASCID 'LNM$SYSTEM', LOGNAM = %ASCID 'SYS$NODE', ITMLST = NODE_ITEM_LIST); COUNTER = 64; ! Max number of translations WHILE .STATUS ! Translation fails AND .COUNTER GTR 0 ! or we do too many translations DO BEGIN STATUS = $TRNLNM(ATTR = %REF(LNM$M_CASE_BLIND), TABNAM = %ASCID 'LNM$SYSTEM', LOGNAM = NODE_DESC, ITMLST = NODE_ITEM_LIST); COUNTER = .COUNTER - 1; END; ! ! If call failed, we don't really know the node name ! IF (NOT .STATUS) OR (NODE_NAME[0] EQL 0) THEN NODE_DESC[DSC$W_LENGTH] = 0; ! ! Get controlling terminal ! JOB_TERM_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; JOB_TERM_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; JOB_TERM_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; JOB_TERM_DESC [DSC$A_POINTER] = JOB_TERM_NAME; JOB_TERM_NAME [0] = %C'_'; STATUS = $GETJPIW (ITMLST = ITMLST); JOB_TERM_DESC [DSC$W_LENGTH] = .RSL_LENGTH + 1; IF NOT .STATUS OR .RSL_LENGTH EQL 0 THEN JOB_TERM_DESC [DSC$W_LENGTH] = 0; ! ! Open the output device and command device (if they are terminals) ! SYS_OUTPUT_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; SYS_OUTPUT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; SYS_OUTPUT_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; SYS_OUTPUT_DESC [DSC$A_POINTER] = SYS_OUTPUT_NAME; STATUS = GET_DEV_CHAR (%ASCID'SYS$OUTPUT', SYS_OUTPUT_DESC, DEV_TYPE); IF .STATUS AND .DEV_TYPE EQL DC$_TERM THEN BEGIN STATUS = $ASSIGN (CHAN = SYS_OUTPUT_CHAN, DEVNAM = SYS_OUTPUT_DESC); IF .STATUS THEN SYS_OUTPUT_OPEN = TRUE; END; SYS_COMMAND_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; SYS_COMMAND_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; SYS_COMMAND_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; SYS_COMMAND_DESC [DSC$A_POINTER] = SYS_COMMAND_NAME; STATUS = GET_DEV_CHAR (%ASCID'SYS$COMMAND', SYS_COMMAND_DESC, DEV_TYPE); IF .STATUS AND .DEV_TYPE EQL DC$_TERM THEN BEGIN STATUS = $ASSIGN (CHAN = SYS_COMMAND_CHAN, DEVNAM = SYS_COMMAND_DESC); IF .STATUS THEN SYS_COMMAND_OPEN = TRUE; END; ! ! Set up the terminal name descriptor ! TERM_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TERM_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TERM_DESC [DSC$A_POINTER] = TERM_NAME; TERM_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; ! ! If KER$COMM is a terminal, then use it as the default. ! STATUS = GET_DEV_CHAR (%ASCID'KER$COMM', TERM_DESC, DEV_TYPE); IF NOT .STATUS OR .DEV_TYPE NEQ DC$_TERM THEN BEGIN ! ! If KER$COMM is not a terminal (or is not anything), try SYS$INPUT. ! TERM_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; STATUS = GET_DEV_CHAR (%ASCID'SYS$INPUT', TERM_DESC, DEV_TYPE); IF NOT .STATUS OR .DEV_TYPE NEQ DC$_TERM THEN BEGIN ! ! If SYS$INPUT is not a terminal, check out SYS$OUTPUT. We will already have ! it open if it is a terminal. ! IF .SYS_OUTPUT_OPEN THEN BEGIN CH$COPY (.SYS_OUTPUT_DESC [DSC$W_LENGTH], CH$PTR (.SYS_OUTPUT_DESC [DSC$A_POINTER]), CHR_NUL, TERM_NAME_SIZE, CH$PTR (TERM_NAME)); TERM_DESC [DSC$W_LENGTH] = .SYS_OUTPUT_DESC [DSC$W_LENGTH]; END ELSE BEGIN ! ! SYS$OUTPUT is not a terminal. Next we try SYS$COMMAND. It should already ! be open if it is a valid terminal. ! IF .SYS_COMMAND_OPEN THEN BEGIN CH$COPY (.SYS_COMMAND_DESC [DSC$W_LENGTH], CH$PTR (.SYS_COMMAND_DESC [DSC$A_POINTER]), CHR_NUL, TERM_NAME_SIZE, CH$PTR (TERM_NAME)); TERM_DESC [DSC$W_LENGTH] = .SYS_OUTPUT_DESC [DSC$W_LENGTH]; END ELSE BEGIN ! ! Here we start to get desparate. Nothing we have tried so far was a terminal. ! Try the terminal which is controlling the job which owns this process. ! TERM_DESC [DSC$W_LENGTH] = .JOB_TERM_DESC [DSC$W_LENGTH]; CH$COPY (.JOB_TERM_DESC [DSC$W_LENGTH], CH$PTR (.JOB_TERM_DESC [DSC$A_POINTER]), CHR_NUL, TERM_NAME_SIZE, CH$PTR (TERM_NAME)); END; END; END; END; ! ! At this point TERM_DESC should be set up with something resembling ! the phyiscal name of a terminal (unless this is a detached process). ! We can now assign a channel to the terminal and tell the user what the ! default device is. ! CH$WCHAR (CHR_NUL, CH$PTR (TERM_NAME, .TERM_DESC [DSC$W_LENGTH])); status = asn_wth_mbx(term_desc, %REF(100), %REF(100), term_chan, mbx_chan); TERM_DUMP (UPLIT BYTE(CHR_CRT, CHR_LFD), 2); IF .STATUS THEN BEGIN BIND DEFTRM_TEXT = %ASCID'Default terminal for transfers is: '; MAP DEFTRM_TEXT : BLOCK [8, BYTE]; TERM_OPEN_FLAG = TRUE; TERM_DUMP (.DEFTRM_TEXT [DSC$A_POINTER], .DEFTRM_TEXT [DSC$W_LENGTH]); TERM_DUMP (TERM_NAME, .TERM_DESC [DSC$W_LENGTH]); IF .mbx_chan NEQ 0 THEN Term_Hangup(); END ELSE BEGIN BIND NODEFTRM_TEXT = %ASCID'No default terminal line for transfers'; MAP NODEFTRM_TEXT : BLOCK [8, BYTE]; TERM_OPEN_FLAG = FALSE; TERM_DESC [DSC$W_LENGTH] = 0; TERM_DUMP (.NODEFTRM_TEXT [DSC$A_POINTER], .NODEFTRM_TEXT [DSC$W_LENGTH]) END; TERM_DUMP (UPLIT BYTE(CHR_CRT, CHR_LFD), 2); ! ! Initialize the flags ! TERM_FLAG = FALSE; TRANS_DELAY = '0'; ! init transmit delay to .0 seconds ! ! If we really did get the terminal open, then determine what type of ! parity it uses, and default to using that parity. ! IF .TERM_OPEN_FLAG THEN BEGIN STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SENSEMODE, P1 = OLD_TERM_CHAR, P2 = TC$_CHAR_LENGTH, IOSB = OLD_PARITY); IF .STATUS THEN IF (.OLD_PARITY [6, 0, 8, 0] AND TT$M_PARITY) NEQ 0 THEN IF (.OLD_PARITY [6, 0, 8, 0] AND TT$M_ODD) NEQ 0 THEN PARITY_TYPE = PR_ODD ELSE PARITY_TYPE = PR_EVEN ELSE PARITY_TYPE = PR_NONE; END; END; ! End of TERM_INIT %SBTTL 'ASN_WTH_MBX - Assign channel to device and mailbox.' global ROUTINE ASN_WTH_MBX(p_device_name, p_message_size, p_buffer_quota, p_device_channel, p_mailbox_channel) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will assign a channel to TERM_DESC and if TERM_DESC is not ! the users' terminal create and assign a mailbox to receive messages ! about the outgoing session's state (in particular we're watching for ! SS$_HANGUP). ! ! CALLING SEQUENCE: ! ! STATUS = ASN_WTH_MBX(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_DESC ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! TERM_CHAN, MBX_CHAN ! ! COMPLETION CODES: ! ! Status of LIB$GETJPI, $ASN_WTH_MBX, and/or $ASSIGN ! ! SIDE EFFECTS: ! ! A channel is assigned to TERM_CHAN and conditionally a mailbox ! is created and a channel assigned to it. ! BEGIN BIND buffer_quota = .p_buffer_quota, device_channel = .p_device_channel, device_name = .p_device_name, message_size = .p_message_size, mailbox_channel = .p_mailbox_channel; LOCAL master_pid, mode, sts, terminal_name : BLOCK [term_name_size, BYTE], terminal_desc : BLOCK [8, BYTE] PRESET ([DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$W_LENGTH] = term_name_size, [DSC$A_POINTER] = terminal_name), temp_name : BLOCK [term_name_size, BYTE], temp_desc : BLOCK [8, BYTE] PRESET ([DSC$B_CLASS] = DSC$K_CLASS_S, [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$W_LENGTH] = term_name_size, [DSC$A_POINTER] = temp_name); MAP device_name : BLOCK [term_name_size, BYTE]; sts = LIB$GETJPI(%REF(JPI$_MODE),0,0,mode); if .mode NEQ JPI$K_INTERACTIVE THEN $ASSIGN(CHAN = device_channel, DEVNAM = device_name) ELSE BEGIN sts = LIB$GETJPI(%REF(JPI$_MASTER_PID),0,0,master_pid,0,0); IF NOT .sts THEN RETURN .sts; sts = LIB$GETJPI(%REF(JPI$_TERMINAL), master_pid, 0, 0, temp_desc, temp_desc); IF NOT .sts THEN RETURN .sts; IF .(.temp_desc[dsc$a_pointer] - 1 + .temp_desc[dsc$w_length])<0,8> NEQ %C ':' THEN BEGIN (.temp_desc[dsc$a_pointer] + .temp_desc[dsc$w_length])<0,8> = %C ':'; temp_desc[dsc$w_length] = .temp_desc[dsc$w_length] + 1; END; sts = LIB$GETDVI(%REF(DVI$_DEVNAM), 0, temp_desc, 0, terminal_desc, terminal_desc); IF NOT .sts THEN RETURN .sts; IF CH$EQL(.terminal_desc[DSC$W_LENGTH], .terminal_desc[DSC$A_POINTER], .device_name[DSC$W_LENGTH], .device_name[DSC$A_POINTER], %C' ') THEN BEGIN IF .mailbox_channel NEQ 0 THEN $DASSGN(CHAN = .mailbox_channel); mailbox_channel = 0; $ASSIGN(CHAN = device_channel, DEVNAM = device_name) END ELSE LIB$ASN_WTH_MBX(device_name, message_size, buffer_quota, device_channel, mailbox_channel) END END; %SBTTL 'SET_TRANS_TERM - Set new transfer terminal line' GLOBAL ROUTINE SET_TRANS_TERM (NEW_NAME) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will validate the terminal name that a user wishes to set ! as the transfer line. If the name is valid, it will store the physical ! name in TERM_DESC, and open the new terminal line. ! ! CALLING SEQUENCE: ! ! STATUS = SET_TRANS_TERM (NEW_NAME); ! ! INPUT PARAMETERS: ! ! NEW_NAME - Descriptor for new terminal name. ! ! IMPLICIT INPUTS: ! ! TERM_OPEN_FLAG, TERM_CHAN ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! True/false status value - error code ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN MAP NEW_NAME : REF BLOCK [8, BYTE]; ! Descriptor for new name LOCAL NEW_CHAN, ! Temp for channel to new terminal RSL_DESC : BLOCK [8, BYTE], ! Descriptor for physical name RSL_NAME : VECTOR [TERM_NAME_SIZE, BYTE], ! String of resulting name DEV_TYPE, ! Device type STATUS; ! Random status values ! ! Set up descriptor ! RSL_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; RSL_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; RSL_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; ! Maximum length RSL_DESC [DSC$A_POINTER] = RSL_NAME; ! Where to store name STATUS = GET_DEV_CHAR (.NEW_NAME, RSL_DESC, DEV_TYPE); IF NOT .STATUS THEN RETURN .STATUS; IF .DEV_TYPE NEQ DC$_TERM THEN RETURN KER_LINTERM; ! ! The device is a terminal, now make sure we can get it. ! ! If we are CONNECTing to the same device and this device is a LAT ! device then we must deassign our channel to it (in order for things ! to reset properly). There is a chance the reassignment will fail. ! If this happens then we are in a bad state - no valid output device. ! ! Otherwise keep a channel to either the old or new device at all times. ! IF CH$EQL(.rsl_desc[DSC$W_LENGTH], .rsl_desc[DSC$A_POINTER], .term_desc[DSC$W_LENGTH], .term_desc[DSC$A_POINTER], %C' ') AND CH$EQL(4, .rsl_desc[DSC$A_POINTER], 4, UPLIT('_LTA')) ! (..rsl_desc[DSC$A_POINTER] EQL '_LTA') THEN BEGIN IF .mbx_chan NEQ 0 THEN BEGIN $DASSGN (CHAN = .mbx_chan); mbx_chan = 0; END; $DASSGN (CHAN = .TERM_CHAN); status = asn_wth_mbx(rsl_desc, %REF(100), %REF(100), new_chan, new_mbx_chan); IF NOT .STATUS THEN RETURN .STATUS; END ELSE BEGIN status = asn_wth_mbx(rsl_desc, %REF(100), %REF(100), new_chan, new_mbx_chan); IF NOT .STATUS THEN RETURN .STATUS; ! ! We have the new terminal. Deassign the old one and copy the new data ! $DASSGN (CHAN = .TERM_CHAN); IF .mbx_chan NEQ 0 THEN BEGIN $DASSGN (CHAN = .mbx_chan); mbx_chan = 0; END; CH$COPY (.RSL_DESC [DSC$W_LENGTH], CH$PTR (RSL_NAME), CHR_NUL, TERM_NAME_SIZE, CH$PTR (TERM_NAME)); TERM_DESC [DSC$W_LENGTH] = .RSL_DESC [DSC$W_LENGTH]; END; TERM_CHAN = .NEW_CHAN; IF .new_mbx_chan NEQ 0 THEN mbx_chan = .new_mbx_chan; IF .mbx_chan NEQ 0 THEN Term_Hangup(); RETURN KER_NORMAL; END; ! End of SET_TRANS_TERM %SBTTL 'TERM_DUMP - This routine will dump text on the terminal' GLOBAL ROUTINE TERM_DUMP (BUFFER_ADDRESS, BUFFER_COUNT) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will dump the text specified on the user's terminal. ! It will then return to the caller. ! ! CALLING SEQUENCE: ! ! TERM_DUMP( TEXT-BUFFER-ADDRESS, COUNT) ! ! INPUT PARAMETERS: ! ! TEXT-BUFFER-ADDRESS - Address of the buffer containing the characters. ! ! COUNT - Count of the characters in the buffer. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL TEXT_DESC : BLOCK [8, BYTE]; IF NOT .CONNECT_FLAG THEN BEGIN IF .SYS_OUTPUT_OPEN THEN $QIOW (CHAN = .SYS_OUTPUT_CHAN, EFN = CONS_O_EFN, FUNC = IO$_WRITEVBLK, P1 = .BUFFER_ADDRESS, P2 = .BUFFER_COUNT, P4 = 0) ELSE BEGIN TEXT_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TEXT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TEXT_DESC [DSC$W_LENGTH] = .BUFFER_COUNT; TEXT_DESC [DSC$A_POINTER] = .BUFFER_ADDRESS; LIB$PUT_OUTPUT (TEXT_DESC); END; END; END; ! End of TERM_DUMP %SBTTL 'DBG_DUMP - This routine will dump text on the terminal' GLOBAL ROUTINE DBG_DUMP (BUFFER_ADDRESS, BUFFER_COUNT) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will dump the text specified on the user's terminal. ! It will then return to the caller. ! ! CALLING SEQUENCE: ! ! DBG_DUMP( TEXT-BUFFER-ADDRESS, COUNT) ! ! INPUT PARAMETERS: ! ! TEXT-BUFFER-ADDRESS - Address of the buffer containing the characters. ! ! COUNT - Count of the characters in the buffer. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS, ! Status from $PUT TEXT_DESC : BLOCK [8, BYTE]; IF NOT .CONNECT_FLAG AND NOT .DEBUG_REDIRECTED ! Check where debugging should go THEN BEGIN IF .SYS_OUTPUT_OPEN THEN $QIOW (CHAN = .SYS_OUTPUT_CHAN, EFN = CONS_O_EFN, FUNC = IO$_WRITEVBLK OR IO$M_NOFORMAT, P1 = .BUFFER_ADDRESS, P2 = .BUFFER_COUNT) ELSE BEGIN TEXT_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TEXT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TEXT_DESC [DSC$W_LENGTH] = .BUFFER_COUNT; TEXT_DESC [DSC$A_POINTER] = .BUFFER_ADDRESS; LIB$PUT_OUTPUT (TEXT_DESC); END; END ELSE IF .DEBUG_REDIRECTED THEN BEGIN EXTERNAL ROUTINE LOG_CHAR, ! Routine to write a character to log file LOG_CLOSE; ! Routine to close log file LOCAL POINTER; POINTER = CH$PTR (.BUFFER_ADDRESS); DECR I FROM .BUFFER_COUNT TO 1 DO IF NOT LOG_CHAR (CH$RCHAR_A (POINTER), DEBUG_RAB) THEN BEGIN LOG_CLOSE (DEBUG_FAB, DEBUG_RAB); DEBUG_REDIRECTED = FALSE; END; END; END; ! End of DBG_DUMP %SBTTL 'GET_COMMAND - Get a command line' GLOBAL ROUTINE GET_COMMAND (CMD_DESC, PROMPT_DESC, CMD_LENGTH, ECHO_FLAG) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will get a command line from SYS$COMMAND:. If ! SYS$COMMAND is a terminal, it will do input using a QIO, which will ! allow input without echo if desired. If SYS$COMMAND is not a terminal, ! it will use LIB$GET_COMMAND. ! ! CALLING SEQUENCE: ! ! STATUS = GET_COMMAND (CMD_DESC, PROMPT_DESC, CMD_LENGTH, ECHO_FLAG); ! ! INPUT PARAMETERS: ! ! CMD_DESC - String descriptor for command being input ! PROMPT_DESC - String descriptor for prompt ! ECHO_FLAG - True if input should be echoed, false if not ! ! IMPLICIT INPUTS: ! ! SYS_COMMAND_OPEN - Flag whether SYS$COMMAND is open ! SYS_COMMAND_CHAN - Channel SYS$COMMAND is open on, if open ! ! OUPTUT PARAMETERS: ! ! CMD_LENGTH - Actual length of command input ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! Returns status value, true unless error has occured. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN MAP CMD_DESC : REF BLOCK [8, BYTE], ! Where to put input PROMPT_DESC : REF BLOCK [8, BYTE]; ! Prompt string EXTERNAL ROUTINE TT_CRLF : NOVALUE, ! Type a CRLF STR$UPCASE : ADDRESSING_MODE (GENERAL), ! Upcase a string LIB$GET_COMMAND : ADDRESSING_MODE (GENERAL); ! Get string from SYS$COMMAND LOCAL QIO_FUNC, ! Function for QIO IOSB : VECTOR [4, WORD], ! IOSB for QIO STATUS; ! Random status values IF .SYS_COMMAND_OPEN THEN BEGIN QIO_FUNC = IO$_READPROMPT; ! Assume just read with prompt IF NOT .ECHO_FLAG THEN QIO_FUNC = IO$_READPROMPT OR IO$M_NOECHO; ! Don't echo input STATUS = $QIOW (CHAN = .SYS_COMMAND_CHAN, FUNC = .QIO_FUNC, IOSB = IOSB, P1 = .CMD_DESC [DSC$A_POINTER], P2 = .CMD_DESC [DSC$W_LENGTH], P5 = .PROMPT_DESC [DSC$A_POINTER], P6 = .PROMPT_DESC [DSC$W_LENGTH]); IF NOT .STATUS THEN RETURN .STATUS; ! ! If we didn't echo, then dump a CRLF so we look nice ! IF NOT .ECHO_FLAG THEN TT_CRLF (); IF .IOSB [0] THEN BEGIN .CMD_LENGTH = .IOSB [1]; ! Get actual length input IF .IOSB [3] EQL 1 AND .IOSB [2] EQL CHR_CTL_Z THEN RETURN RMS$_EOF; END; ! ! Upcase the resulting string ! STATUS = STR$UPCASE (.CMD_DESC, .CMD_DESC); IF NOT .STATUS THEN RETURN .STATUS; RETURN .IOSB [0]; ! Return resulting status END; ! ! Here if SYS$COMMAND is not open. Get the command via LIB$GET_COMMAND. ! RETURN LIB$GET_COMMAND (.CMD_DESC, .PROMPT_DESC, .CMD_LENGTH); END; ! End of GET_COMMAND %SBTTL 'Communcations line -- TERM_OPEN' GLOBAL ROUTINE TERM_OPEN (POST_QIOS) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will assign a channel that is used in the CONNECT ! processing and to send/receive a file from. ! ! CALLING SEQUENCE: ! ! TERM_OPEN(POST_QIOS); ! ! INPUT PARAMETERS: ! ! POST_QIOS - True if initial read QIO's should be posted. ! ! IMPLICIT INPUTS: ! ! TERM_DESC - Descriptor of a vector of ASCII characters that represent ! the name of the terminal to use. ! ! TERM_CHAN - Channel open to terminal if TERM_OPEN_FLAG is true. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! TERM_CHAN - Channel number of the terminal line we are using. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN EXTERNAL ROUTINE LOG_FAOL, ! Write FAOL style text LOG_OPEN; ! Open a log file EXTERNAL TRANSACTION_OPEN, TRANSACTION_DESC : BLOCK [8, BYTE], TRANSACTION_FAB : $FAB_DECL, TRANSACTION_RAB : $RAB_DECL; LOCAL STATUS; ! ! If the terminal is not open, we must open it first. ! IF NOT .TERM_OPEN_FLAG THEN IF .TERM_DESC [DSC$W_LENGTH] GTR 0 THEN BEGIN STATUS = SET_TRANS_TERM (TERM_DESC); IF NOT .STATUS THEN RETURN .STATUS; END ELSE RETURN KER_LINTERM; ! ! Set up connect flag properly ! IF CH$NEQ (.SYS_OUTPUT_DESC [DSC$W_LENGTH], CH$PTR (.SYS_OUTPUT_DESC [DSC$A_POINTER]), .TERM_DESC [DSC$W_LENGTH], CH$PTR (TERM_NAME), CHR_NUL) OR NOT .SYS_OUTPUT_OPEN THEN CONNECT_FLAG = FALSE ELSE CONNECT_FLAG = TRUE; ! ! If we aren't connected, remember the channel to use for the console I/O ! IF NOT .CONNECT_FLAG AND .SYS_OUTPUT_OPEN THEN CONS_CHAN = .SYS_OUTPUT_CHAN; ! ! Get current settings for transfer terminal ! STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SENSEMODE, P1 = OLD_TERM_CHAR, P2 = TC$_CHAR_LENGTH, IOSB = OLD_PARITY); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; NEW_TERM_CHAR [TC$_BFR_SIZE] = .OLD_TERM_CHAR [TC$_BFR_SIZE]; NEW_TERM_CHAR [TC$_TYPE] = .OLD_TERM_CHAR [TC$_TYPE]; NEW_TERM_CHAR [TC$_CLASS] = .OLD_TERM_CHAR [TC$_CLASS]; NEW_TERM_CHAR [TC$_PAGE_LEN] = .OLD_TERM_CHAR [TC$_PAGE_LEN]; NEW_TERM_CHAR [TC$_CHAR] = (.OLD_TERM_CHAR [TC$_CHAR] OR TT$M_NOBRDCST) AND NOT (TT$M_CRFILL OR TT$M_LFFILL OR TT$M_WRAP OR TT$M_NOTYPEAHD); ! We do not want to use eightbit if using parity IF .PARITY_TYPE EQL PR_NONE THEN NEW_TERM_CHAR [TC$_CHAR] = .NEW_TERM_CHAR [TC$_CHAR] OR TT$M_EIGHTBIT ELSE NEW_TERM_CHAR [TC$_CHAR] = .NEW_TERM_CHAR [TC$_CHAR] AND NOT TT$M_EIGHTBIT; NEW_TERM_CHAR [TC$_CHAR_2] = TT2$M_XON OR TT2$M_PASTHRU OR (.OLD_TERM_CHAR [TC$_CHAR_2] AND NOT TT2$M_FALLBACK); STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SETMODE, P1 = NEW_TERM_CHAR, P2 = TC$_CHAR_LENGTH, P5 = TT$M_ALTRPAR); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; TERM_FLAG = TRUE; ! Terminal now open TERM_FIRST_TIME = TRUE; ! Flag first time QIO should clear input FORCE_TIMEOUT = FALSE; ! Don't timeout for no reason FORCE_ABORT = FALSE; ! Don't abort yet ! ! Now post the initial receive QIO ! IF .POST_QIOS ! Need the QIO's? THEN BEGIN STATUS = DO_RECEIVE_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR; END; ! ! Also post the QIO for the console ! IF NOT .CONNECT_FLAG AND .SYS_OUTPUT_OPEN THEN BEGIN STATUS = DO_CONS_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); $CANCEL (CHAN = .TERM_CHAN); $DASSGN (CHAN = .TERM_CHAN); RETURN KER_RECERR; END; END; END; ! ! Open any debugging log file ! IF .DEBUG_DESC [DSC$W_LENGTH] GTR 0 THEN IF LOG_OPEN (DEBUG_DESC, DEBUG_FAB, DEBUG_RAB) THEN DEBUG_REDIRECTED = TRUE ELSE DEBUG_REDIRECTED = FALSE ELSE DEBUG_REDIRECTED = FALSE; IF .TRANSACTION_DESC [DSC$W_LENGTH] GTR 0 THEN IF LOG_OPEN (TRANSACTION_DESC, TRANSACTION_FAB, TRANSACTION_RAB) THEN BEGIN TRANSACTION_OPEN = TRUE; LOG_FAOL (%ASCID'!-!-!11%D!/!-!%T!_Starting transaction log in file !AS!/', UPLIT (0, TRANSACTION_DESC), TRANSACTION_RAB); END ELSE TRANSACTION_OPEN = FALSE ELSE TRANSACTION_OPEN = FALSE; RETURN KER_NORMAL; END; ! End of TERM_OPEN %SBTTL 'Communications line -- TERM_CLOSE' GLOBAL ROUTINE TERM_CLOSE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will deassign the channel that was assigned by ! TERM_OPEN. ! ! CALLING SEQUENCE: ! ! TERM_CLOSE(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_CHAN - Channel number to deassign. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN EXTERNAL ROUTINE LOG_FAOL, ! Routine to dump FAOL string LOG_CLOSE; ! Routine to close log file EXTERNAL TRANSACTION_OPEN, TRANSACTION_DESC : BLOCK [8, BYTE], TRANSACTION_FAB, TRANSACTION_RAB; LOCAL PAR, ! Parity being set STATUS; ! Status returned by system service STATUS = $CANCEL (CHAN = .TERM_CHAN); ! Kill pending QIO IF .SYS_OUTPUT_OPEN THEN $CANCEL (CHAN = .CONS_CHAN); CONNECT_FLAG = FALSE; PAR = (.OLD_PARITY [6, 0, 8, 0] AND (TT$M_ODD OR TT$M_PARITY)) OR TT$M_ALTRPAR; ! Only set parity STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SETMODE, P1 = OLD_TERM_CHAR, P2 = TC$_CHAR_LENGTH, P4 = .OLD_PARITY [4, 0, 16, 0], P5 = .PAR); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; ! ! Flag terminal parameters are reset ! TERM_FLAG = FALSE; ! ! Close the debugging log file ! IF .DEBUG_REDIRECTED THEN BEGIN LOG_CLOSE (DEBUG_FAB, DEBUG_RAB); DEBUG_REDIRECTED = FALSE; END; ! ! Close the transaction log ! IF .TRANSACTION_OPEN THEN BEGIN LOG_FAOL (%ASCID'!-!-!11%D!/!-!%T!_Closing transaction log file !AS!/', UPLIT (0, TRANSACTION_DESC), TRANSACTION_RAB); LOG_CLOSE (TRANSACTION_FAB, TRANSACTION_RAB); TRANSACTION_OPEN = FALSE; END; ! ! If all worked, say so ! RETURN KER_NORMAL END; ! End of TERM_CLOSE %SBTTL 'Communications line -- SEND' GLOBAL ROUTINE SEND (ADDRESS, LENGTH) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send a stream of 8-bit bytes over the terminal ! line to the remote KERMIT. This routine is called from KERMSG. ! ! CALLING SEQUENCE: ! ! SEND(Address-of-msg, Length-of-msg); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_CHAN - Channel number to deassign. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL CUR_EFN, ! Current EFN settings STATUS; ! Status returned by $QIOW ! ! If we already got a complete buffer of input we should ignore it. ! This is because we are probably retransmitting something and the ! incoming data is the response to the previous copy of this message. ! If we don't ignore it, we could get into a situation where every message ! gets transmitted twice. ! STATUS = $READEF (EFN = TERM_EFN, STATE = CUR_EFN); IF (.CUR_EFN AND 1^TERM_EFN) EQL 1 THEN DO_RECEIVE_QIO (); STATUS = $QIOW (CHAN = .TERM_CHAN, EFN = TERM_O_EFN, FUNC = IO$_WRITEVBLK + IO$M_NOFORMAT, P1 = .ADDRESS, P2 = .LENGTH); IF .STATUS EQL SS$_NORMAL THEN RETURN KER_NORMAL ELSE BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; END; ! End of SEND %SBTTL 'Communications line -- RECEIVE' GLOBAL ROUTINE RECEIVE (ADDRESS, LENGTH) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will receive a stream of 8-bit bytes over the terminal ! line to the remote KERMIT. This routine is called from KERMSG. ! The text that is stored will always contain the control-A as the ! first character. ! ! CALLING SEQUENCE: ! ! RECEIVE(Address-of-msg); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_CHAN - Channel number to deassign. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN EXTERNAL RCV_SOH; ! Character to use for start of packet LOCAL QWORD_TIMEOUT : VECTOR [2, LONG], ! Quad word TIMEOUT value TIMER_VALUE : VECTOR [2, LONG], ! Quad word TIME value OLD_POINTER, ! Pointer into the message NEW_POINTER, ! Other pointer for finding SOH CUR_LENGTH, ! Running length while finding SOH CUR_EFN, ! Current EFN value STATUS; ! Status returned by $QIO OWN INT_CHR_SEEN; ! Interrupt character seen last ! ! Flag we haven't seen a ^Y yet. We must get two control-Y's in fairly ! quick succession (no timeouts in between) in order to give up. ! INT_CHR_SEEN = FALSE; ! ! Set up the timer if we have a time out parameter ! IF NOT .FORCE_TIMEOUT THEN STATUS = $CLREF (EFN = TIME_EFN); IF .SEND_TIMEOUT GTR 0 THEN BEGIN STATUS = $CANTIM (REQIDT = TIME_EFN); STATUS = $GETTIM (TIMADR = TIMER_VALUE); STATUS = LIB$EMUL (SEND_TIMEOUT, UPLIT (10000000), UPLIT (0), QWORD_TIMEOUT); STATUS = LIB$ADDX (TIMER_VALUE, QWORD_TIMEOUT, QWORD_TIMEOUT); STATUS = $SETIMR (DAYTIM = QWORD_TIMEOUT, EFN = TIME_EFN, REQIDT = TIME_EFN); END; ! ! Loop until we get something that is acceptable ! WHILE TRUE DO BEGIN ! ! Wait for something to happen. Either the terminal EFN will come up ! indicating we have some data, or the timer EFN will indicate that ! the time has run out. ! STATUS = $WFLOR (EFN = TERM_EFN, MASK = (1^TERM_EFN OR 1^TIME_EFN)); STATUS = $READEF (EFN = TERM_EFN, STATE = CUR_EFN); FORCE_TIMEOUT = FALSE; ! Timeout had it chance to happen ! ! If the terminal EFN is not set, the time must have expired. Therefore, ! we have timed out, and need to return that fact. ! IF (.CUR_EFN AND 1^TERM_EFN) EQL 0 THEN RETURN KER_TIMEOUT; ! ! If we have a request to abort, start it up the chain. ! IF .FORCE_ABORT THEN BEGIN STATUS = $CANTIM (REQIDT = TIME_EFN); RETURN KER_ABORTED; END; ! ! Check if the QIO completed successfully. If not, we will return ! an error. ! IF NOT .IO_STATUS [0] THEN BEGIN LIB$SIGNAL (.IO_STATUS [0]); RETURN KER_RECERR; END; ! ! First check for a control-Y as the terminator. If it was, then ! just abort now, since the user probably typed it. ! IF .CONNECT_FLAG THEN IF (.IO_STATUS [2] EQL CHR_CTL_Y) AND (.RCV_EOL NEQ CHR_CTL_Y) THEN BEGIN IF .INT_CHR_SEEN AND .IO_STATUS [1] EQL 0 THEN BEGIN STATUS = $CANTIM (REQIDT = TIME_EFN); RETURN KER_ABORTED END ELSE BEGIN INT_CHR_SEEN = TRUE; IO_STATUS [1] = 0; ! Force no input seen END END ELSE INT_CHR_SEEN = FALSE; ! Last character not ^Y ! ! Now find the final start of header character in the buffer. We ! will only return the text from that point on. If there is no SOH, ! then just get another buffer. It was probably noise on the line. ! OLD_POINTER = CH$PTR (RECV_BUFFER, 0, CHR_SIZE); CUR_LENGTH = .IO_STATUS [1]; ! Length without terminating character NEW_POINTER = CH$FIND_CH (.CUR_LENGTH, .OLD_POINTER, .RCV_SOH); ! ! If we found a start of header character, then we probably have something ! to return. However, first we must find the last start of header, in case ! something is garbled. ! IF NOT CH$FAIL (.NEW_POINTER) THEN BEGIN ! ! Search until we can't find any more start of headers, or until we run ! out of string to search (last character before EOL is an SOH). ! WHILE (.CUR_LENGTH GTR 0) AND ( NOT CH$FAIL (.NEW_POINTER)) DO BEGIN CUR_LENGTH = .CUR_LENGTH - CH$DIFF (.NEW_POINTER, .OLD_POINTER); ! Adjust the length for the characters we are skipping OLD_POINTER = .NEW_POINTER; ! Remember where we start NEW_POINTER = CH$FIND_CH (.CUR_LENGTH - 1, CH$PLUS (.OLD_POINTER, 1), .RCV_SOH); ! Find the next SOH (if any) END; ! ! If we have something left of the buffer, move from the SOH until the end ! into the callers buffer. ! IF (.CUR_LENGTH GTR 0) THEN BEGIN .LENGTH = .CUR_LENGTH + 1; IF .PARITY_TYPE EQL PR_NONE ! Have eight-bit? THEN CH$MOVE (.CUR_LENGTH + 1, .OLD_POINTER, CH$PTR (.ADDRESS, 0, CHR_SIZE)) ELSE BEGIN NEW_POINTER = CH$PTR (.ADDRESS, 0, CHR_SIZE); DECR CUR_LENGTH FROM .CUR_LENGTH TO 0 DO CH$WCHAR_A ((CH$RCHAR_A (OLD_POINTER) AND %O'177'), NEW_POINTER); END; EXITLOOP END END; ! End of IF NOT CH$FAIL(.POINTER) ! ! If we have gotten here, we have input a buffer without a valid message. ! Make sure we post the QIO again ! STATUS = DO_RECEIVE_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR END; END; ! End of WHILE TRUE DO ! ! If we have gotten here, we have a valid message to return. ! Post the QIO so the buffer is available for the next message. ! STATUS = DO_RECEIVE_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR END; RETURN KER_NORMAL; ! Return happy END; ! End of RECEIVE %SBTTL 'Communications line -- IBM_WAIT' GLOBAL ROUTINE IBM_WAIT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will wait until the IBM turnaround character ! is seen on the communications line, or until the timeout ! parameter is exceeded. ! ! CALLING SEQUENCE: ! ! STATUS = IBM_WAIT (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_CHAN - Channel number for terminal ! ! OUTPUT PARAMETERS: ! ! Status value is returned as routine value. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL QWORD_TIMEOUT : VECTOR [2, LONG], ! Quad word TIMEOUT value TIMER_VALUE : VECTOR [2, LONG], ! Quad word TIME value CUR_EFN, ! Current EFN value STATUS; ! Status returned by $QIO ! ! Set up the timer if we have a time out parameter ! STATUS = $CLREF (EFN = TIME_EFN); IF .SEND_TIMEOUT GTR 0 THEN BEGIN STATUS = $CANTIM (REQIDT = TIME_EFN); STATUS = $GETTIM (TIMADR = TIMER_VALUE); STATUS = LIB$EMUL (SEND_TIMEOUT, UPLIT (1000000), UPLIT (0), QWORD_TIMEOUT); STATUS = LIB$ADDX (TIMER_VALUE, QWORD_TIMEOUT, QWORD_TIMEOUT); STATUS = $SETIMR (DAYTIM = QWORD_TIMEOUT, EFN = TIME_EFN, REQIDT = TIME_EFN); END; ! ! Loop until we get something that is acceptable ! WHILE TRUE DO BEGIN ! ! Wait for something to happen. Either the terminal EFN will come up ! indicating we have some data, or the timer EFN will indicate that ! the time has run out. ! STATUS = $WFLOR (EFN = TERM_EFN, MASK = (1^TERM_EFN OR 1^TIME_EFN)); STATUS = $READEF (EFN = TERM_EFN, STATE = CUR_EFN); ! ! If the terminal EFN is not set, the time must have expired. Therefore, ! pretend we got the character. ! IF (.CUR_EFN AND 1^TERM_EFN) EQL 0 THEN RETURN KER_NORMAL; ! ! Check if the QIO completed successfully. If not, we will return ! an error. ! IF NOT .IO_STATUS [0] THEN BEGIN LIB$SIGNAL (.IO_STATUS [0]); RETURN KER_RECERR; END; ! ! First check for a control-Y as the terminator. If it was, then ! just abort now, since the user probably typed it. ! IF .CONNECT_FLAG THEN IF (.IO_STATUS [2] EQL CHR_CTL_Y) AND (.RCV_EOL NEQ CHR_CTL_Y) THEN BEGIN STATUS = $CANTIM (REQIDT = TIME_EFN); RETURN KER_ABORTED END; ! Check if terminator was the turnaround character IF (.IO_STATUS [2] EQL .IBM_CHAR) THEN EXITLOOP; ! ! Make sure we post the QIO again ! STATUS = DO_RECEIVE_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR END; END; ! End of WHILE TRUE DO ! ! If we have gotten here, we have a valid message to return. ! Post the QIO so the buffer is available for the next message. ! STATUS = DO_RECEIVE_QIO (); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR END; RETURN KER_NORMAL; ! Return happy END; ! End of RECEIVE %SBTTL 'GET_DEV_CHAR - Determine device characteristics' ROUTINE GET_DEV_CHAR (LOG_NAME_DESC, PHYS_NAME_DESC, DEV_CLASS) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will get the device characteristics from VMS. It returns ! both the physical name of the device and the device class. ! ! CALLING SEQUENCE: ! ! STATUS = GET_DEV_CHAR (LOG_NAME_DESC, PHYS_NAME_DESC, DEV_CLASS); ! ! INPUT PARAMETERS: ! ! LOG_NAME_DESC - Descriptor for logical device for which the device ! class is desired. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! PHYS_NAME_DESC - Descriptor for physical device name ! DEV_CLASS - Device class for device ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES/RETURN VALUE: ! ! Status value returned from $GETDVI if it fails, ! KER_NORMAL otherwise. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN MAP PHYS_NAME_DESC : REF BLOCK [8, BYTE]; ! Physical name descriptor LOCAL ITMLST : ITEM_LIST [2] FIELD (ITEM_FIELDS), PHYS_NAME_LENGTH : VOLATILE, STATUS; ! ! Set up item list for device class ! ITMLST [0, ITEM_ITEM_CODE] = DVI$_DEVCLASS; ITMLST [0, ITEM_BFR_LENGTH] = 4; ! 4 byte result ITMLST [0, ITEM_BFR_ADDRESS] = .DEV_CLASS; ! Where to return result ITMLST [0, ITEM_RTN_LENGTH] = 0; ! We know how long it is ! ! Item list entry for device name ! ITMLST [1, ITEM_ITEM_CODE] = DVI$_DEVNAM; ! Want the name of the device ITMLST [1, ITEM_BFR_LENGTH] = .PHYS_NAME_DESC [DSC$W_LENGTH]; ! Max length to return ITMLST [1, ITEM_BFR_ADDRESS] = .PHYS_NAME_DESC [DSC$A_POINTER]; ! Where to return name ITMLST [1, ITEM_RTN_LENGTH] = PHYS_NAME_LENGTH; ! Where to return length ! ! End the list of items ! ITMLST [2, ITEM_ITEM_CODE] = 0; ITMLST [2, ITEM_BFR_LENGTH] = 0; ! ! Request the information ! STATUS = $GETDVIW (EFN = GET_DEV_EFN, DEVNAM = .LOG_NAME_DESC, ITMLST = ITMLST); IF NOT .STATUS THEN RETURN .STATUS; ! ! Assign the length and return happy ! PHYS_NAME_DESC [DSC$W_LENGTH] = .PHYS_NAME_LENGTH; RETURN KER_NORMAL; END; ! End of GET_DEV_CHAR %SBTTL 'Term_Hangup' global ROUTINE Term_Hangup : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine puts a read-attention AST on the mailbox associated with ! TERM_DESC - the port being used for external communications. The ! mailbox will receive 3 types of messages: Unsolicited data, Terminal ! hangup, and Broadcast messages. Only Terminal hangup messages are of ! interest here. ! ! ! CALLING SEQUENCE: ! ! TERM_HANGUP(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! MBX_CHAN - The channel to the mailbox associated with TERM_DESC. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! Return status from $QIOW ! ! SIDE EFFECTS: ! ! A write-attention AST is queued to the mailbox. The ast routine ! MBX_AST_RTN will be called if a message is written to the mailbox. ! !-- BEGIN LOCAL Function, Iosb : VECTOR [4, WORD], ! I/O status block. Sts; Function = IO$_SETMODE + IO$M_WRTATTN; Sts = $QIOW(CHAN = .Mbx_Chan, FUNC = .Function, IOSB = Iosb, P1 = Mbx_Ast_Rtn); IF .sts THEN sts = .Iosb[0]; IF NOT .sts THEN LIB$SIGNAL(.Sts); END; %SBTTL 'Mbx_Ast_Rtn' ROUTINE Mbx_Ast_Rtn : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called at AST level whenever a mailbox message ! arrives in the mailbox associated with TERM_DESC. If the message ! is a hangup notification the user will be 1) notified his outgoing ! connection is no longer present (technically there is no longer ! a channel to the device represented in TERM_DESC) and 2) ! ! CALLING SEQUENCE: ! ! MBX_AST_RTN(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_DESC ! MBX_CHAN - The channel to the mailbox associated with TERM_DESC. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! MBX_CHAN ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! A message may be output to the user if his outgoing session is ! no longer valid. ! !-- BEGIN LOCAL Function, Iosb : VECTOR [4, WORD], Mbx_Msg : VECTOR [124, BYTE], Sts; Function = IO$_READVBLK; Sts = $QIOW(CHAN = .Mbx_Chan, FUNC = .Function, IOSB = Iosb, P1 = Mbx_Msg, P2 = 100); IF .Sts THEN Sts = .Iosb[0]; IF NOT .sts THEN LIB$SIGNAL(.Sts); IF .Mbx_Msg<0,16> EQL MSG$_TRMHANGUP THEN BEGIN ! asn_wth_mbx(term_desc, %REF(100), %REF(100), term_chan, mbx_chan); $DASSGN(CHAN = .mbx_chan); mbx_chan = 0; LIB$SIGNAL(SS$_HANGUP) END ELSE Term_Hangup(); END; %SBTTL 'Send_Break_TTY' GLOBAL ROUTINE Send_Break_TTY = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine sends a break to the user's current terminal line. ! ! ! CALLING SEQUENCE: ! ! STATUS = Send_Break_TTY (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! Term_Desc - The current outgoing terminal line. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! Return status from $QIOW ! ! SIDE EFFECTS: ! ! A break is sent to the user's outgoing terminal line. ! !-- BEGIN LOCAL Char : VECTOR [2], ! Terminal characteristics. Iosb : VECTOR [4, WORD], ! I/O status block. Parity_Flags, Sts; Sts = $QIOW(CHAN = .Term_Chan, FUNC = IO$_SENSEMODE, IOSB = Iosb, P1 = Char); IF .Sts THEN Sts = .Iosb [0]; IF NOT .Sts THEN RETURN .Sts; Parity_Flags<4,16> = .Iosb [3]; Sts = $QIOW(CHAN = .Term_Chan, FUNC = IO$_SETMODE, IOSB = Iosb, P1 = Char, P5 = (.Parity_Flags OR TT$M_BREAK)); IF .Sts THEN Sts = .Iosb [0]; IF NOT .Sts THEN RETURN .Sts; LIB$WAIT(%REF(%E'0.25')); Sts = $QIOW(CHAN = .Term_Chan, FUNC = IO$_SETMODE, IOSB = Iosb, P1 = Char, P5 = .Parity_Flags); IF (.Sts) THEN Sts = .Iosb [0]; Send_Break_TTY_Flag = 0; RETURN .Sts; END; %SBTTL 'DO_RECEIVE_QIO' ROUTINE DO_RECEIVE_QIO = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to perform a QIO input from the terminal. This ! ensures that there is usually a receive buffer pending. ! ! CALLING SEQUENCE: ! ! STATUS = DO_RECEIVE_QIO (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! RCV_EOL - Receive end-of-line character ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! IO_STATUS - IOSB for the QIO ! RCV_BUFFER - Data input from terminal ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! TERM_EFN is set when I/O completes ! !-- BEGIN LOCAL QIO_FUNC, TERMINATOR : VECTOR [2, LONG], STATUS; ! For status of QIO call ! ! Initialize the terminating characters for the QIO. Only terminate ! on the end-of-line character and a control-Y ! TERMINATOR [0] = 0; TERMINATOR [1] = 1^.RCV_EOL OR 1^CHR_CTL_Y; IF .IBM_CHAR GEQ 0 THEN TERMINATOR [1] = .TERMINATOR [1] OR 1^.IBM_CHAR; ! Need IBM turnaround? ! ! Initialize the QIO function ! Always purge typeahead ! QIO_FUNC = IO$_TTYREADALL OR IO$M_NOECHO OR IO$M_PURGE; RETURN $QIO (CHAN = .TERM_CHAN, EFN = TERM_EFN, FUNC = .QIO_FUNC, IOSB = IO_STATUS, P1 = RECV_BUFFER, P2 = RECV_BUFF_SIZE, P4 = TERMINATOR); END; ! End of DO_RECEIVE_QIO %SBTTL 'DO_CONS_QIO' ROUTINE DO_CONS_QIO = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to perform a QIO input from the terminal. This ! ensures that there is usually a receive buffer pending. ! ! CALLING SEQUENCE: ! ! STATUS = DO_CONS_QIO (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! RCV_EOL - Receive end-of-line character ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! IO_STATUS - IOSB for the QIO ! RCV_BUFFER - Data input from terminal ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! TERM_EFN is set when I/O completes ! !-- BEGIN EXTERNAL ABT_CUR_FILE, ABT_ALL_FILE, DEBUG_FLAG, TYP_STS_FLAG; LOCAL I, ! Random index variable TERMINATOR : VECTOR [2, LONG], ! Pointer at terminator mask TERM_MASK : VECTOR [8, LONG], ! Terminator mask STATUS; ! For status of QIO call LITERAL CONS_BUFF_SIZE = 1; OWN CONS_STATUS : VECTOR [4, WORD], CONS_BUFFER : VECTOR [CONS_BUFF_SIZE, BYTE]; ! ! AST routine for console ! ROUTINE CONS_AST (DUMMY) = BEGIN IF .CONS_STATUS [0] THEN SELECT .CONS_STATUS [2] OF SET [CHR_CTL_Z] : ABT_ALL_FILE = TRUE; [CHR_CTL_X] : ABT_CUR_FILE = TRUE; [CHR_CTL_Y] : RETURN SS$_NORMAL; [CHR_CTL_C] : BEGIN FORCE_TIMEOUT = TRUE; FORCE_ABORT = TRUE; END; [CHR_CTL_D] : DEBUG_FLAG = NOT .DEBUG_FLAG; [CHR_CTL_A] : TYP_STS_FLAG = TRUE; [CHR_CTL_M] : FORCE_TIMEOUT = TRUE; [CHR_CTL_Z, CHR_CTL_X, CHR_CTL_A, CHR_CTL_M, CHR_CTL_C] : ! Make sure what we did gets noticed, even if we are currently waiting ! forever for input. IF .FORCE_TIMEOUT OR .SEND_TIMEOUT EQL 0 THEN $SETEF (EFN = TIME_EFN); TES; IF .CONS_STATUS [0] NEQ SS$_CANCEL AND .CONS_STATUS [0] NEQ SS$_ABORT THEN RETURN DO_CONS_QIO () ELSE RETURN SS$_NORMAL; END; ! ! Start of main portion of DO_CONS_QIO ! TERMINATOR [0] = 32; ! Length of terminator mask in bytes TERMINATOR [1] = TERM_MASK; ! Address of mask INCR I FROM 0 TO 7 DO TERM_MASK [.I] = -1; ! All characters are terminators RETURN $QIO (CHAN = .CONS_CHAN, EFN = CONS_EFN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO, IOSB = CONS_STATUS, ASTADR = CONS_AST, P1 = CONS_BUFFER, P2 = CONS_BUFF_SIZE, P4 = TERMINATOR); END; ! End of DO_CONS_QIO %SBTTL 'TERM_CONNECT' GLOBAL ROUTINE TERM_CONNECT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine TERM_CONNECT will enable two terminal-like devices, ! MY_TERM and TERM_NAME, to communicate with each other. Anything ! that the user types on his terminal, MYTERM, will be sent to the ! other device, TERM_NAME, over the terminal line TERM_CHAN. ! Anything that TERM_NAME cares to output will be sent to MYTERM. ! The main routine TERM_CONNECT performs the initialization. It ! opens the input and output files and connects streams. ! ! CALLING SEQUENCE: ! ! TERM_CONNECT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TERM_DESC - Descriptor of a vector of ASCII characters that represent ! the name of the terminal to use. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! TERM_CHAN - Channel number used by the terminal line to TERM_DESC. ! ! COMPLETION CODES: ! ! SS$_NORMAL or error condition. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN EXTERNAL ROUTINE LOG_OPEN, ! Open log file LOG_CLOSE; ! Close log file LITERAL OUT_BUFLEN = 80, ! Max # of char. in output buffer INP_BUFSIZ = 80, ! Max # of char. in input buffer NUM_OUT_BUF = 2, ! # of output buffers per device NUM_IN_BUF = 2, ! # of input buffers per device MYT = 0, ! Device MY_TERM TRM = 1, ! Device TERM_NAME OFFSET = 1, ! IOSB : offset to terminator EOFSIZ = 3, ! IOSB : terminator size T_EFN_DISP = NUM_OUT_BUF, XITEFN = 2*NUM_OUT_BUF + 1, ! Exit event flag number EFN_MASK = (1^XITEFN - 1) AND ( NOT 1); ! Mask of flags set by CONNECT STRUCTURE IOSB_VECTOR [D, BUFNUM, INFO; NUMBUF] = [NUMBUF*16] (IOSB_VECTOR + (D*NUMBUF + BUFNUM)*8 + 2*INFO)<0, 16, 0>, BUFFER_VECTOR [D, BUFNUM; NUMBUF, BUFSIZ] = [NUMBUF*BUFSIZ*2 + NUMBUF] (BUFFER_VECTOR + (D*NUMBUF + BUFNUM)*BUFSIZ + D); OWN BTIMUP : VECTOR [4, WORD], ! Time limit in binary format CHANNEL : VECTOR [2, LONG], ! Contains channel #s CHR_COUNT : VECTOR [2, WORD] INITIAL (0), ! # of char. in out buffer ESC_FLG : INITIAL (FALSE), ! Was last char. the ESCAPE_CHR IN_IOSB : IOSB_VECTOR [NUM_IN_BUF], ! IOSB status block INP_BUF : BUFFER_VECTOR [NUM_IN_BUF, INP_BUFSIZ], ! Input buffers MSG : VECTOR [80, BYTE], ! Combined escape message MSG_DES : BLOCK [8, BYTE], ! Descriptor for message OUT_BUF : BUFFER_VECTOR [NUM_OUT_BUF, OUT_BUFLEN], ! Output buffers OUT_BUFNUM : VECTOR [2, BYTE], ! Present output buffer OUT_EFN : VECTOR [2, BYTE], ! Present event flag # OUT_PTR : VECTOR [2, LONG], ! CS-pointer for output buffer MYT_QIO_FUNC, ! Function for QIO input for my terminal ESC_CHR_LEN, ! Length of escape character message ESC_CHR_MSG : VECTOR [30, BYTE], ! Escape character message STATE; ! Used by $READEF to store state of EFs BIND CON_MSG_1 = %ASCID'Connecting to ', CON_MSG_2 = %ASCID'. Type ', CON_MSG_3 = %ASCID'C to return to VAX/VMS Kermit-32]', CON_MSG_4 = %ASCID'Returning to VAX/VMS Kermit-32]'; MAP CON_MSG_1 : BLOCK [8, BYTE], CON_MSG_2 : BLOCK [8, BYTE], CON_MSG_3 : BLOCK [8, BYTE], CON_MSG_4 : BLOCK [8, BYTE]; BIND ATIMUP = %ASCID'0 00:00:00.050', ! Time to wait for more output MYT_CHAN = CHANNEL [1], MY_TERM = %ASCID'SYS$INPUT:'; LABEL CONN_STREAMS; LOCAL CON_MSG : VECTOR [80, BYTE], CON_MSG_DESC : BLOCK [8, BYTE], STATUS; %SBTTL 'TERM_CONNECT -- TYPE_OUT_BUF' ROUTINE TYPE_OUT_BUF (DEV) = !++ ! This routine send the contents of the output buffer to the other ! device. It also resets the OUT_PTR and the CHR_COUNT and it ! increments OUT_EFN and OUT_BUFNUM. !-- BEGIN LOCAL STATUS; ! Check to make sure exit flag not set before $QIO IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN BEGIN $SETEF (EFN = .OUT_EFN [.DEV]); RETURN .STATUS; END; $WAITFR (EFN = .OUT_EFN [.DEV]); $CLREF (EFN = .OUT_EFN [.DEV]); IF $READEF (EFN = XITEFN, STATE = STATE) EQL SS$_WASCLR THEN STATUS = $QIO (CHAN = .CHANNEL [.DEV], EFN = .OUT_EFN [.DEV], FUNC = IO$_WRITEVBLK OR IO$M_NOFORMAT, P1 = OUT_BUF [.DEV, .OUT_BUFNUM [.DEV]], P2 = .CHR_COUNT [.DEV]) ELSE BEGIN $SETEF (EFN = .OUT_EFN [.DEV]); RETURN .STATUS; END; CHR_COUNT [.DEV] = 0; OUT_EFN [.DEV] = .OUT_EFN [.DEV] + 1; IF (OUT_BUFNUM [.DEV] = .OUT_BUFNUM [.DEV] + 1) GEQ NUM_OUT_BUF THEN BEGIN OUT_BUFNUM [.DEV] = 0; OUT_EFN [.DEV] = .DEV*T_EFN_DISP + 1; END; OUT_PTR [.DEV] = CH$PTR (OUT_BUF [.DEV, .OUT_BUFNUM [.DEV]]); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); $SETEF (EFN = XITEFN); END; RETURN .STATUS; END; %SBTTL 'TERM_CONNECT -- TIME_UP' ROUTINE TIME_UP (OUTEFN) : NOVALUE = !++ ! AST routine called 0.1 second after first character is input. It calls ! TYPE_OUT_BUF to transmit output buffer. !-- BEGIN LOCAL DEV; IF (.OUTEFN - T_EFN_DISP) LEQ 0 THEN DEV = 0 ! Device was MY_TERM ELSE DEV = 1; ! Device was TERM_NAME TYPE_OUT_BUF (.DEV); END; ! End of TIME_UP %SBTTL 'TERM_CONNECT -- STORE_INPUT' ROUTINE STORE_INPUT (DEV, INP_POINTER, NUM_CHR_IN) : NOVALUE = !++ ! This routine stores the input buffer in the output buffer and keeps ! track of the number of characters in the output buffer. It also ! calls TYPE_OUT_BUF when the output buffer is full and it sets up ! the timer routine TIME_UP. !-- BEGIN EXTERNAL ROUTINE LOG_CHAR, ! Routine to log characters GEN_PARITY; ! Routine to generate parity LOCAL STATUS; IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN RETURN; IF .NUM_CHR_IN EQL 0 THEN RETURN .STATUS; IF .NUM_CHR_IN + .CHR_COUNT [.DEV] GTR OUT_BUFLEN THEN BEGIN ! ! If we don't have enough room in the buffer for all of the characters, call ! ourself to dump what will fit, then proceed with what remains. ! LOCAL SAVED_CHR_CNT; ! Saved character count SAVED_CHR_CNT = OUT_BUFLEN - .CHR_COUNT [.DEV]; NUM_CHR_IN = .NUM_CHR_IN - .SAVED_CHR_CNT; STORE_INPUT (.DEV, .INP_POINTER, .SAVED_CHR_CNT); INP_POINTER = CH$PLUS (.INP_POINTER, .SAVED_CHR_CNT); END; IF .CHR_COUNT [.DEV] EQL 0 THEN BEGIN STATUS = $SETIMR (DAYTIM = BTIMUP, ASTADR = TIME_UP, REQIDT = .OUT_EFN [.DEV]); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); $SETEF (EFN = XITEFN); RETURN .STATUS; END; END; ! We must generate parity for the communications terminal IF .DEV EQL 0 THEN BEGIN LOCAL POINTER; POINTER = .INP_POINTER; DECR I FROM .NUM_CHR_IN TO 1 DO CH$WCHAR_A (GEN_PARITY (CH$RCHAR_A (POINTER)), OUT_PTR [.DEV]); END ELSE OUT_PTR [.DEV] = CH$MOVE (.NUM_CHR_IN, .INP_POINTER, .OUT_PTR [.DEV]); ! ! If we want logging, do it now ! IF (.DEV EQL 1 OR .ECHO_FLAG) AND .SESSION_OPEN AND .SESSION_LOGGING THEN BEGIN LOCAL STATUS, POINTER; POINTER = .INP_POINTER; DECR I FROM .NUM_CHR_IN TO 1 DO IF NOT LOG_CHAR (CH$RCHAR_A (POINTER), SESSION_RAB) THEN BEGIN SESSION_LOGGING = FALSE; EXITLOOP; END; END; IF (CHR_COUNT [.DEV] = .CHR_COUNT [.DEV] + .NUM_CHR_IN) GEQ OUT_BUFLEN - INP_BUFSIZ THEN BEGIN $CANTIM (REQIDT = .OUT_EFN [.DEV]); TYPE_OUT_BUF (.DEV); END; RETURN .STATUS; END; ! End of STORE_INPUT %SBTTL 'TERM_CONNECT -- MYTINP' ROUTINE MYTINP (INP_BUFNUM) = !++ ! This AST routine gets characters from the channel MYT_CHAN and outputs ! them on the channel TERM_CHAN. It also checks to see if the exit ! characters have been typed. If they have been typed, MYTINP sets the ! event flag XITEFN. INP_BUFNUM contains the # of the input buffer. !-- BEGIN OWN STATUS, NUM_CHR_IN; %SBTTL 'TERM_CONNECT -- MYTINP -- CHK_FOR_EXIT' ROUTINE CHK_FOR_EXIT (INP_BUFNUM) = !++ ! This routine checks to see if the exit characters have been typed. It ! returns TRUE if found and FALSE if not. If only 1 ESCAPE_CHR found ! then ESC_FLG is set to TRUE. !-- BEGIN ROUTINE TYPE_MSG (MSG_DESC, OPEN_FLAG, CLOSE_FLAG, CRLF_FLAG) : NOVALUE = BEGIN MAP MSG_DESC : REF BLOCK [8, BYTE]; IF .OPEN_FLAG THEN BEGIN STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(%C'[')), 1); IF .NODE_DESC [DSC$W_LENGTH] GTR 0 THEN STORE_INPUT (TRM, CH$PTR (.NODE_DESC [DSC$A_POINTER]), .NODE_DESC [DSC$W_LENGTH]); END; STORE_INPUT (TRM, CH$PTR (.MSG_DESC [DSC$A_POINTER]), .MSG_DESC [DSC$W_LENGTH]); IF .CLOSE_FLAG THEN STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(%C']')), 1); IF .CRLF_FLAG THEN STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(CHR_CRT, CHR_LFD)), 2); END; LOCAL EAT_CHR, ! Number of input characters to eat ESC_PTR, INDEX : INITIAL (0), ! Displacement of ESC from beginning of buffer PTR0; ! Points to beginning of input buffer PTR0 = CH$PTR (INP_BUF [MYT, .INP_BUFNUM]); IF .ESC_FLG EQL TRUE ! ESCAPE_CHR was previously typed. THEN BEGIN INDEX = 0; ESC_PTR = .PTR0; ESC_FLG = FALSE; END ELSE IF (ESC_PTR = CH$FIND_CH (.NUM_CHR_IN, .PTR0, .ESCAPE_CHR)) EQL 0 THEN RETURN FALSE ELSE BEGIN INDEX = CH$DIFF (.PTR0, .ESC_PTR); IF .INDEX NEQ (NUM_CHR_IN = .NUM_CHR_IN - 1) THEN BEGIN CH$COPY (.NUM_CHR_IN - .INDEX, CH$PLUS (.ESC_PTR, 1), 0, .NUM_CHR_IN - .INDEX, .ESC_PTR); END ELSE ! ESCAPE_CHR was last character. BEGIN ESC_FLG = TRUE; RETURN FALSE; END; END; EAT_CHR = 0; ! No characters to eat SELECTONE CH$RCHAR (.ESC_PTR) OF SET ['?'] : BEGIN TYPE_MSG (%ASCID'Escape commands are:', TRUE, FALSE, TRUE); Type_Msg (%ASCID' B - Sends a break', FALSE, FALSE, TRUE); TYPE_MSG (%ASCID' C - Return to VAX/VMS Kermit-32', FALSE, FALSE, TRUE); TYPE_MSG (%ASCID' Q - Suspend logging to session log file (if any)', FALSE, FALSE, TRUE); TYPE_MSG (%ASCID' R - Resume logging to session log file (if any)', FALSE, FALSE, TRUE); TYPE_MSG (%ASCID' S - Show status', FALSE, FALSE, TRUE); TYPE_MSG (%ASCID' 0 - Send a null', FALSE, FALSE, TRUE); TYPE_MSG (%ASCID' ? - Type this text', FALSE, FALSE, TRUE); TYPE_MSG (%ASCID' ', FALSE, FALSE, FALSE); STORE_INPUT (TRM, ESC_CHR_MSG, .ESC_CHR_LEN); TYPE_MSG (%ASCID' - Send escape character', FALSE, TRUE, TRUE); EAT_CHR = 1; END; ['B', 'b'] : BEGIN Send_Break_TTY_Flag = 1; EAT_CHR = 1; END; ['C', 'c'] : BEGIN NUM_CHR_IN = .INDEX; RETURN TRUE; END; ['Q', 'q'] : BEGIN BIND NO_LOG_TEXT = %ASCID'logging already disabled', STOP_LOG_TEXT = %ASCID'logging disabled'; IF .SESSION_LOGGING THEN TYPE_MSG (STOP_LOG_TEXT, TRUE, TRUE, TRUE) ELSE TYPE_MSG (NO_LOG_TEXT, TRUE, TRUE, TRUE); SESSION_LOGGING = FALSE; EAT_CHR = 1; END; ['R', 'r'] : BEGIN ! Resume logging BIND NO_LOG_TEXT = %ASCID'no log file to enable', START_LOG_TEXT = %ASCID'logging enabled'; SESSION_LOGGING = .SESSION_OPEN; IF .SESSION_LOGGING THEN TYPE_MSG (START_LOG_TEXT, TRUE, TRUE, TRUE) ELSE TYPE_MSG (NO_LOG_TEXT, TRUE, TRUE, TRUE); EAT_CHR = 1; END; ['S', 's'] : BEGIN TYPE_MSG (%ASCID'Connected to ', TRUE, FALSE, FALSE); TYPE_MSG (TERM_DESC, FALSE, FALSE, TRUE); TYPE_MSG (%ASCID' Escape character: "', FALSE, FALSE, FALSE); STORE_INPUT (TRM, ESC_CHR_MSG, .ESC_CHR_LEN); TYPE_MSG (%ASCID'"', FALSE, FALSE, TRUE); TYPE_MSG (%ASCID' Local echo: ', FALSE, FALSE, FALSE); IF .ECHO_FLAG THEN TYPE_MSG (%ASCID'On', FALSE, FALSE, TRUE) ELSE TYPE_MSG (%ASCID'Off', FALSE, FALSE, TRUE); TYPE_MSG (%ASCID' Parity: ', FALSE, FALSE, FALSE); CASE .PARITY_TYPE FROM PR_MIN TO PR_MAX OF SET [PR_NONE] : TYPE_MSG (%ASCID'None', FALSE, FALSE, TRUE); [PR_ODD] : TYPE_MSG (%ASCID'Odd', FALSE, FALSE, TRUE); [PR_EVEN] : TYPE_MSG (%ASCID'Even', FALSE, FALSE, TRUE); [PR_MARK] : TYPE_MSG (%ASCID'Mark', FALSE, FALSE, TRUE); [PR_SPACE] : TYPE_MSG (%ASCID'Space', FALSE, FALSE, TRUE); TES; TYPE_MSG (%ASCID' Logging: ', FALSE, FALSE, FALSE); IF .SESSION_OPEN GTR 0 THEN BEGIN TYPE_MSG (SESSION_DESC, FALSE, FALSE, FALSE); IF .SESSION_LOGGING THEN TYPE_MSG (%ASCID' Enabled', FALSE, TRUE, TRUE) ELSE TYPE_MSG (%ASCID' Disabled', FALSE, TRUE, TRUE); END ELSE TYPE_MSG (%ASCID' None specifed', FALSE, TRUE, TRUE); EAT_CHR = 1; ! Eat the "S" END; [.ESCAPE_CHR] : CH$WCHAR (.ESCAPE_CHR, .ESC_PTR); ! Write the escape character ['0'] : CH$WCHAR (CHR_NUL, .ESC_PTR); ! Write a null [OTHERWISE] : BEGIN ! Send a bell char. to MY_TERM STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(CHR_BEL)), 1); EAT_CHR = 1; ! Eat the character END; TES; IF .EAT_CHR GTR 0 THEN IF (NUM_CHR_IN = .NUM_CHR_IN - .EAT_CHR) NEQ .INDEX THEN CH$COPY (.NUM_CHR_IN - .INDEX, CH$PLUS (.ESC_PTR, .EAT_CHR), CHR_NUL, .NUM_CHR_IN - .INDEX, .ESC_PTR); RETURN FALSE; END; ! End of CHK_FOR_EXIT %SBTTL 'TERM_CONNECT -- MYTINP' ! Main portion of MYTINP IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN RETURN .STATUS; NUM_CHR_IN = .IN_IOSB [MYT, .INP_BUFNUM, OFFSET] + .IN_IOSB [MYT, .INP_BUFNUM, EOFSIZ]; IF .NUM_CHR_IN NEQ 0 THEN IF CHK_FOR_EXIT (.INP_BUFNUM) THEN BEGIN $CANTIM (); $SETEF (EFN = XITEFN); ! Exit characters typed. Set flag. RETURN 1; END ELSE STORE_INPUT (MYT, CH$PTR (INP_BUF [MYT, .INP_BUFNUM]), .NUM_CHR_IN); ! Store char. IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) EQL SS$_WASCLR THEN ! If we got some characters, then queue up the next read for lots of ! characters with a 0 timeout (get what we can). Otherwise queue up ! a read for one character waiting forever. IF .NUM_CHR_IN GTR 0 OR .INP_BUFNUM NEQ 0 THEN ! Queue up a read for the console terminal STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC OR IO$M_TIMED, ASTADR = MYTINP, P1 = INP_BUF [MYT, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = 0, ASTPRM = .INP_BUFNUM, IOSB = IN_IOSB [MYT, .INP_BUFNUM, 0]) ELSE STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC, ASTADR = MYTINP, P1 = INP_BUF [MYT, .INP_BUFNUM], P2 = 1, ASTPRM = .INP_BUFNUM, IOSB = IN_IOSB [MYT, .INP_BUFNUM, 0]); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); $SETEF (EFN = XITEFN); END; RETURN .STATUS; END; ! End of MYTINP %SBTTL 'TERM_CONNECT -- TRMINP' ROUTINE TRMINP (INP_BUFNUM) = !++ ! This AST routine receives characters from the channel TERM_CHAN and ! outputs the characters to the channel MYT_CHAN. INP_BUFNUM contains ! the number of the input buffer. !-- BEGIN LOCAL NUM_CHR_IN, STATUS; IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN RETURN .STATUS; NUM_CHR_IN = .IN_IOSB [TRM, .INP_BUFNUM, OFFSET] + .IN_IOSB [TRM, .INP_BUFNUM, EOFSIZ]; IF .NUM_CHR_IN NEQ 0 THEN STORE_INPUT (TRM, CH$PTR (INP_BUF [TRM, .INP_BUFNUM]), .NUM_CHR_IN); IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) EQL SS$_WASCLR THEN BEGIN ! Now that there are no pending I/Os we can call the routine to send ! a break signal to the outgoing terminal line if necessary. ! Pending I/Os would block the QIO SETMODE instruction from taking ! place, effectively hanging kermit until the current I/O read ! completes (if ever). IF .Send_Break_TTY_Flag EQL 1 THEN Send_Break_TTY (); ! ! If we actually got something input, then queue up a read with a 0 ! timeout for the whole buffer. Otherwise, queue up a single character ! read, if this is the first buffer. ! IF .NUM_CHR_IN GTR 0 OR .INP_BUFNUM NEQ 0 THEN STATUS = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO OR IO$M_TIMED, ASTADR = TRMINP, P1 = INP_BUF [TRM, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = 0, IOSB = IN_IOSB [TRM, .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM) ELSE STATUS = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO, ASTADR = TRMINP, P1 = INP_BUF [TRM, .INP_BUFNUM], P2 = 1, IOSB = IN_IOSB [TRM, .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM); END; IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); $SETEF (EFN = XITEFN); END; RETURN .STATUS; END; ! End of TRMINP %SBTTL 'TERM_CONNECT -- ESC_MSG' ROUTINE ESC_MSG (ESC_TEXT) = BEGIN MAP ESC_TEXT : REF VECTOR [, BYTE]; SELECTONE .ESCAPE_CHR OF SET [CHR_NUL, 0] : BEGIN BIND NUL_TXT = %ASCID'^@ or control-space on VT-100'; MAP NUL_TXT : BLOCK [8, BYTE]; CH$MOVE (.NUL_TXT [DSC$W_LENGTH], CH$PTR (.NUL_TXT [DSC$A_POINTER]), CH$PTR (.ESC_TEXT)); RETURN .NUL_TXT [DSC$W_LENGTH]; END; [CHR_RS, %O'36'] : BEGIN BIND RS_TXT = %ASCID'^^ or ^~ on VT-100'; MAP RS_TXT : BLOCK [8, BYTE]; CH$MOVE (.RS_TXT [DSC$W_LENGTH], CH$PTR (.RS_TXT [DSC$A_POINTER]), CH$PTR (.ESC_TEXT)); RETURN .RS_TXT [DSC$W_LENGTH]; END; [CHR_US, %O'37'] : BEGIN BIND US_TXT = %ASCID'^_ or ^? on VT-100'; MAP US_TXT : BLOCK [8, BYTE]; CH$MOVE (.US_TXT [DSC$W_LENGTH], CH$PTR (.US_TXT [DSC$A_POINTER]), CH$PTR (.ESC_TEXT)); RETURN .US_TXT [DSC$W_LENGTH]; END; [1 TO %O'37'] : BEGIN ESC_TEXT [0] = %C'^'; ESC_TEXT [1] = .ESCAPE_CHR + %O'100'; RETURN 2; END; [CHR_DEL, %O'177'] : BEGIN ESC_TEXT = 'DEL'; RETURN 3; END; TES; RETURN 0; ! No escape character? END; ! End of ESC_MSG %SBTTL 'TERM_CONNECT -- COMND_TRANSMIT' GLOBAL ROUTINE COMND_TRANSMIT : NOVALUE = ! and below !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine transmits a file (or files) to the remote side one character ! at a time. It can display the numbers of the lines as they are transfered, ! or echo back to the controling terminal from the remote so that progress of ! the transmit can be monitored. It can also delay between 0 and .9 secs ! after each carriage return for machines that cannot keep up with the ! transfer. The file is transmitted blindly (except line feeds are removed) ! with no error correction or packets. This is useful for sending files to ! systems where KERMIT is unavailable. ! ! CALLING SEQUENCE: ! ! COMND_TRANSMIT (); ! ! IMPLICIT INPUTS: ! ! TRANS_DELAY - time (0.0 - 0.9 seconds) to delay after carriage return is transmitted. ! TRANS_ECHO_FLAG - flags whether data from remote side is echoed to the console terminal (ON); ! or line numbers are printed during transmit. ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! Standard status values. ! ! SIDE EFFECTS: ! ! Line feed characters are not transmitted. !-- BEGIN EXTERNAL FILE_SIZE, FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], TY_FIL; EXTERNAL ROUTINE FILE_OPEN; LOCAL STATUS, ! KERMIT status values TRANSMIT_DELAY : VECTOR [CH$ALLOCATION(8)], ! String for transmit delay TR_DESC : BLOCK [8,BYTE]; ! Descriptor for transmit delay OWN SAVE_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], ! File name SAVE_FILE_SIZE, ! File size SAVE_TY_FIL, ! File type out flag DELAY : VECTOR [2,LONG,SIGNED]; ! Time after transmitting carriage return BIND D_TIME = PLIT('0 ::00.'); ! First part of delta time used to find delay %SBTTL 'TERM_CONNECT -- TRANSMIT_FILE' ROUTINE TRANSMIT_FILE = ! and below !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine transmits the current file (that has already been opened) and ! then opens the next file (if there is one). ! !-- BEGIN ! TRANSMIT_FILE EXTERNAL ABT_ALL_FILE, ABT_CUR_FILE, SMG$_PASALREXI, ! Pasteboard exits for device msg FLAG_FILE_OPEN; EXTERNAL ROUTINE NEXT_FILE, FILE_OPEN, FILE_CLOSE, TT_TEXT, TT_CRLF : NOVALUE, SY_DISMISS : NOVALUE, SMG$CREATE_PASTEBOARD : ADDRESSING_MODE (GENERAL), SMG$DELETE_PASTEBOARD : ADDRESSING_MODE (GENERAL); LOCAL STATUS, ! KERMIT status values ISTAT, ! qiow status values PASTE_STAT, ! SMG status values NEW_ID : VECTOR [1, LONG, UNSIGNED]; ! Dummy new pasteboard id OWN LINE_NUM; ! Line number counter %SBTTL 'TERM_CONNECT -- TRANSMIT_CHARACTERS' ROUTINE TRANSMIT_CHARACTERS : NOVALUE = ! and below !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is a loop that transmits all of the characters in a file, ! one character per pass. ! !-- BEGIN ! TRANSMIT_CHARACTERS LITERAL WAIT_EFN = 22, CHARACTER_LEN = 1; EXTERNAL ROUTINE GET_FILE, TT_NUMBER, TT_OUTPUT : NOVALUE; LOCAL STATUS, ! KERMIT status values TSTAT, ! timer status values ISTAT, ! qiow status values CHARACTER, ! Character from get-a-char routine TERM_IOSB : VECTOR [4, WORD, UNSIGNED]; ! IO status block for term chan ! ! Begin TRANSMIT_CHARACTERS: ! DO BEGIN ! Transmit a character ! Get next character STATUS = GET_FILE (CHARACTER); IF .STATUS AND NOT .STATUS EQL KER_EOF AND NOT .CHARACTER EQL CHR_LFD ! Did we get one? THEN BEGIN ! Have a character ! Write character out transfer terminal: ISTAT = $QIOW (CHAN = .TERM_CHAN, EFN = TERM_O_EFN, FUNC = IO$_WRITEVBLK + IO$M_NOFORMAT, IOSB = TERM_IOSB, P1 = CHARACTER, P2 = CHARACTER_LEN); IF NOT .ISTAT THEN LIB$SIGNAL (.ISTAT); IF NOT .TERM_IOSB THEN LIB$SIGNAL (.TERM_IOSB); IF .CHARACTER EQL CHR_CRT THEN BEGIN ! Just transmitted a carriage return IF NOT .DELAY EQL 0 THEN ! Delay desired time: BEGIN TSTAT = $SETIMR (EFN = WAIT_EFN, DAYTIM = DELAY); IF NOT .STATUS THEN LIB$SIGNAL (.TSTAT); TSTAT = $WAITFR (EFN = WAIT_EFN); IF NOT .STATUS THEN LIB$SIGNAL (.TSTAT); END; IF NOT .TRANS_ECHO_FLAG THEN ! Purge term_chan typeahead buffer to get rid of the echoed data and type packet number to console: BEGIN TSTAT = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_READVBLK OR IO$M_PURGE, P1 = INP_BUF [TRM, 0], P2 = 0, IOSB = IN_IOSB [TRM, 0, 0]); IF NOT .TSTAT THEN LIB$SIGNAL (.TSTAT); TT_NUMBER (.LINE_NUM); TT_TEXT (UPLIT (%ASCIZ' ')); TT_OUTPUT (); LINE_NUM = .LINE_NUM + 1; END; END; ! Just transmitted a cariage return END; ! Have a character END ! Transmit a character UNTIL NOT .STATUS OR .STATUS EQL KER_EOF OR NOT .ISTAT OR NOT .TERM_IOSB OR .FORCE_ABORT OR .ABT_CUR_FILE OR .ABT_ALL_FILE; END; ! End TRANSMIT_CHARACTERS ! ! Begin TRANSMIT_FILE: ! FLAG_FILE_OPEN = TRUE; TT_TEXT (UPLIT (%ASCIZ' File: ')); TT_TEXT (FILE_NAME); ! Type out file name TT_CRLF (); FILE_SIZE = .SAVE_FILE_SIZE; ! Reset the file name size INCR I FROM 0 TO .FILE_SIZE - 1 DO FILE_NAME [.I] = .SAVE_FILE_NAME [.I]; TY_FIL = .SAVE_TY_FIL; ! Reset type out flag LINE_NUM = 1; ! Initialize line number counter IF (STATUS = TERM_OPEN (TRUE)) ! Open the terminal THEN BEGIN ! Term open ! Cancel qio's to term_chan to start from scratch: STATUS = $CANCEL (CHAN = .TERM_CHAN); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); ! Test to see if we are supposed to echo from the term_chan to the cons_chan: IF .TRANS_ECHO_FLAG THEN BEGIN ! Echo data ! Clear screen (by creating a default pasteboard using SMG utility): SY_DISMISS (3); ! Wait a bit so user can see file name PASTE_STAT = SMG$CREATE_PASTEBOARD (NEW_ID); IF NOT .PASTE_STAT THEN LIB$SIGNAL (.PASTE_STAT); ! Prepare event flags $CLREF (EFN = XITEFN); INCR FLAG FROM 1 TO XITEFN - 1 DO $SETEF (EFN = .FLAG); $SETAST (ENBFLG = 0); ! Disable AST until after all QIOs ! Set up read qio's to echo characters to controling terminal ISTAT = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO, ASTADR = TRMINP, P1 = INP_BUF [TRM, 0], P2 = INP_BUFSIZ, P3 = 0, IOSB = IN_IOSB [TRM, 0, 0], ASTPRM = 0); IF NOT .ISTAT THEN LIB$SIGNAL (.ISTAT); INCR INP_BUFNUM FROM 1 TO NUM_IN_BUF - 1 DO BEGIN ISTAT = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO OR IO$M_TIMED, ASTADR=TRMINP, P1=INP_BUF[TRM,.INP_BUFNUM], P2=INP_BUFSIZ, P3=0, IOSB = IN_IOSB [TRM, .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM); IF NOT .ISTAT THEN LIB$SIGNAL (.ISTAT); END; $SETAST (ENBFLG = 1); ! Enable AST END ! End echo data ELSE ! No echo; output line number title to console: TT_TEXT (UPLIT (%ASCIZ' Transmitting line number... ')); ! Start a loop that handles one character per pass: TRANSMIT_CHARACTERS (); ! Finished transmitting file - close it: FILE_CLOSE (); ABT_CUR_FILE = FALSE; IF .TRANS_ECHO_FLAG THEN SY_DISMISS (1); ! Wait a bit so user can see the end of the file ! Cancel read qio's: $SETAST (ENBFLG = 0); ! Disable AST's STATUS = $CANCEL (CHAN = .TERM_CHAN); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); STATUS = $CANCEL (CHAN = .CONS_CHAN); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); ! Clear screen again if we did it before - ie delete pasteboard if we created one: IF .TRANS_ECHO_FLAG AND NOT .PASTE_STAT EQL SMG$_PASALREXI THEN BEGIN PASTE_STAT = SMG$DELETE_PASTEBOARD (NEW_ID); IF NOT .PASTE_STAT THEN LIB$SIGNAL (.PASTE_STAT); END ELSE BEGIN TT_CRLF (); TT_CRLF (); END; ! Post normal qio's that were canceled: STATUS = DO_CONS_QIO(); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR END; STATUS = DO_RECEIVE_QIO(); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN KER_RECERR END; ! Close the console terminal to clean up: STATUS = TERM_CLOSE (); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); $SETAST (ENBFLG = 1); ! Enable AST's END; ! Term open ! Determine if there is another file to send. SAVE_TY_FIL = .TY_FIL; ! Save current type out flag TY_FIL = FALSE; ! Supress the type out of names IF NOT .ABT_ALL_FILE AND NOT .FORCE_ABORT THEN STATUS=NEXT_FILE () ELSE STATUS=KER_NOMORFILES; TY_FIL = .SAVE_TY_FIL; ! Reset the type out flag ABT_ALL_FILE = FALSE; FORCE_ABORT = FALSE; FORCE_TIMEOUT = FALSE; RETURN .STATUS; END; ! End TRANSMIT_FILE ! ! Begin COMND_TRANSMIT: ! ! Initialize variables CHR_COUNT [0] = 0; CHR_COUNT [1] = 0; OUT_BUFNUM [0] = 0; OUT_BUFNUM [1] = 0; OUT_EFN [0] = 1; OUT_EFN [1] = T_EFN_DISP + 1; OUT_PTR [0] = CH$PTR (OUT_BUF [0, .OUT_BUFNUM [0]]); OUT_PTR [1] = CH$PTR (OUT_BUF [1, .OUT_BUFNUM [1]]); ! Assign channels to devices TERM_NAME and MY_TERM. STATUS = TERM_OPEN (FALSE); ! Open terminal, no QIO's IF .CONNECT_FLAG ! Check if TERM_NAME is TT: THEN BEGIN TERM_CLOSE (); LIB$SIGNAL (KER_CON_SAME); RETURN KER_CON_SAME; END; IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; IF NOT .SYS_OUTPUT_OPEN ! Make sure we have terminals THEN BEGIN TERM_CLOSE (); LIB$SIGNAL (KER_LINTERM); ! Must both be terminals RETURN KER_LINTERM; ! So give up if not END; CHANNEL [0] = .TERM_CHAN; CHANNEL [1] = .CONS_CHAN; IF NOT .STATUS THEN BEGIN TERM_CLOSE (); LIB$SIGNAL (.STATUS); RETURN .STATUS; END; ! Have two terminals - Set up delay: CH$COPY (7,CH$PTR(D_TIME), 1,CH$PTR(TRANS_DELAY), %C ' ', 8,CH$PTR(TRANSMIT_DELAY)); TR_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TR_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TR_DESC [DSC$W_LENGTH] = 8; TR_DESC [DSC$A_POINTER] = TRANSMIT_DELAY; STATUS = $BINTIM (TIMBUF=TR_DESC, TIMADR=DELAY); ! Calculate delta time IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); ! Get the first file and try to open it: SAVE_TY_FIL = .TY_FIL; ! Save current type out flag TY_FIL = FALSE; ! Supress the type out of names SAVE_FILE_SIZE = .FILE_SIZE; ! Save the file name size INCR I FROM 0 TO .FILE_SIZE - 1 DO SAVE_FILE_NAME [.I] = .FILE_NAME [.I]; ! If we can open the file, then transmit it: IF FILE_OPEN (FNC_READ) THEN ! Loop to handle one file at a time: DO STATUS = TRANSMIT_FILE () UNTIL ( NOT .STATUS) OR (.STATUS EQL KER_NOMORFILES) ELSE TY_FIL = .SAVE_TY_FIL; ! Reset type out flag END; ! End COMND_TRANSMIT routine %SBTTL 'TERM_CONNECT -- INITIALIZATION' ! Initialize variables CHR_COUNT [0] = 0; CHR_COUNT [1] = 0; ESC_FLG = FALSE; OUT_BUFNUM [0] = 0; OUT_BUFNUM [1] = 0; OUT_EFN [0] = 1; OUT_EFN [1] = T_EFN_DISP + 1; OUT_PTR [0] = CH$PTR (OUT_BUF [0, .OUT_BUFNUM [0]]); OUT_PTR [1] = CH$PTR (OUT_BUF [1, .OUT_BUFNUM [1]]); $BINTIM (TIMBUF = ATIMUP, TIMADR = BTIMUP); ! ! Initialize Connect message ! ESC_CHR_LEN = ESC_MSG (ESC_CHR_MSG); CON_MSG_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; CON_MSG_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; CON_MSG_DESC [DSC$A_POINTER] = CON_MSG; CON_MSG_DESC [DSC$W_LENGTH] = 1 + .NODE_DESC [DSC$W_LENGTH] + .CON_MSG_1 [DSC$W_LENGTH] + .TERM_DESC [DSC$W_LENGTH] + .CON_MSG_2 [DSC$W_LENGTH] + .ESC_CHR_LEN + .CON_MSG_3 [DSC$W_LENGTH] ; CH$COPY (1, CH$PTR (UPLIT BYTE(%C'[')), .NODE_DESC [DSC$W_LENGTH], CH$PTR (.NODE_DESC [DSC$A_POINTER]), .CON_MSG_1 [DSC$W_LENGTH], CH$PTR (.CON_MSG_1 [DSC$A_POINTER]), .TERM_DESC [DSC$W_LENGTH], CH$PTR (.TERM_DESC [DSC$A_POINTER]), .CON_MSG_2 [DSC$W_LENGTH], CH$PTR (.CON_MSG_2 [DSC$A_POINTER]), .ESC_CHR_LEN, CH$PTR (ESC_CHR_MSG), .CON_MSG_3 [DSC$W_LENGTH], CH$PTR (.CON_MSG_3 [DSC$A_POINTER]), CHR_NUL, .CON_MSG_DESC [DSC$W_LENGTH], CH$PTR (CON_MSG)); ! ! Assign channels to devices TERM_NAME and MY_TERM. ! STATUS = TERM_OPEN (FALSE); ![054] Open terminal, no QIO's IF .CONNECT_FLAG ! Check if TERM_NAME is TT: THEN BEGIN TERM_CLOSE (); LIB$SIGNAL (KER_CON_SAME); RETURN KER_CON_SAME; END; IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; IF NOT .SYS_OUTPUT_OPEN ![013] Make sure we have terminals THEN BEGIN TERM_CLOSE (); LIB$SIGNAL (KER_LINTERM); ![013] Must both be terminals RETURN KER_LINTERM; ![013] So give up if not END; ![054] STATUS = $CANCEL (CHAN = .TERM_CHAN); ! Kill all pending QIOs for terminal CHANNEL [0] = .TERM_CHAN; CHANNEL [1] = .CONS_CHAN; ![054] STATUS = $CANCEL (CHAN = .CONS_CHAN); ! Kill pending QIOs for console as well ! STATUS = $ASSIGN (DEVNAM = MY_TERM, CHAN = MYT_CHAN); IF NOT .STATUS THEN BEGIN TERM_CLOSE (); LIB$SIGNAL (.STATUS); RETURN .STATUS; END; ! ! Open any session logging file ! SESSION_OPEN = FALSE; ! Assume not logging SESSION_LOGGING = FALSE; ! . . . IF .SESSION_DESC [DSC$W_LENGTH] GTR 0 THEN BEGIN STATUS = LOG_OPEN (SESSION_DESC, SESSION_FAB, SESSION_RAB); IF .STATUS THEN BEGIN SESSION_OPEN = TRUE; SESSION_LOGGING = TRUE; END; END; ! Prepare event flags $CLREF (EFN = XITEFN); INCR FLAG FROM 1 TO XITEFN - 1 DO $SETEF (EFN = .FLAG); ! ! Set up proper function for reading from console terminal. This is done ! so that the NOECHO flag only gets used if LOCAL_ECHO is OFF. ! MYT_QIO_FUNC = IO$_TTYREADALL; IF NOT .ECHO_FLAG THEN MYT_QIO_FUNC = IO$M_NOECHO OR IO$_TTYREADALL; ! Connect streams CONN_STREAMS : BEGIN ! Send connect message LIB$PUT_OUTPUT (%ASCID''); LIB$PUT_OUTPUT (CON_MSG_DESC); LIB$PUT_OUTPUT (%ASCID''); $SETAST (ENBFLG = 0); ! Disable AST until after all QIOs ! ! The first input for each terminal will be for one character. ! This read will wait forever for a character. The subsequent ! reads will have a timeout of 0 (immediate return). This ! gets us good response without using large amounts of run time. ! STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC, ASTADR = MYTINP, P1 = INP_BUF [MYT, 0], P2 = 1, IOSB = IN_IOSB [MYT, 0, 0], ASTPRM = 0); IF NOT .STATUS THEN LEAVE CONN_STREAMS; STATUS = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO, ASTADR = TRMINP, P1 = INP_BUF [TRM, 0], P2 = INP_BUFSIZ, P3 = 0, IOSB = IN_IOSB [TRM, 0, 0], ASTPRM = 0); IF NOT .STATUS THEN LEAVE CONN_STREAMS; INCR INP_BUFNUM FROM 1 TO NUM_IN_BUF - 1 DO BEGIN ! Queue up an input for console terminal STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC OR IO$M_TIMED, ASTADR = MYTINP, P1 = INP_BUF [MYT, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = 0, IOSB = IN_IOSB [MYT, .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM); IF NOT .STATUS THEN LEAVE CONN_STREAMS; STATUS = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO OR IO$M_TIMED, ASTADR = TRMINP, P1 = INP_BUF [TRM, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = 0, IOSB = IN_IOSB [TRM, .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM); IF NOT .STATUS THEN LEAVE CONN_STREAMS; END; $SETAST (ENBFLG = 1); ! Enable AST $WAITFR (EFN = XITEFN); ! Wait for exit flag $WFLAND (EFN = 0, MASK = EFN_MASK); ! Go when outputs completed CON_MSG_DESC [DSC$W_LENGTH] = 1 + .NODE_DESC [DSC$W_LENGTH] + .CON_MSG_4 [DSC$W_LENGTH]; CH$COPY (1, CH$PTR (UPLIT BYTE(%C'[')), .NODE_DESC [DSC$W_LENGTH], CH$PTR (.NODE_DESC [DSC$A_POINTER]), .CON_MSG_4 [DSC$W_LENGTH], CH$PTR (.CON_MSG_4 [DSC$A_POINTER]), CHR_NUL, .CON_MSG_DESC [DSC$W_LENGTH], CH$PTR (.CON_MSG_DESC [DSC$A_POINTER])); LIB$PUT_OUTPUT (CON_MSG_DESC); LIB$PUT_OUTPUT (%ASCID''); END; ! ! Program end -- Close both channels and return with STATUS ! $CANTIM (); ! ! Close any log file ! IF .SESSION_OPEN THEN LOG_CLOSE (SESSION_FAB, SESSION_RAB); SESSION_OPEN = FALSE; ! ! Call TERM_CLOSE to clean up ! STATUS = TERM_CLOSE (); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); $SETAST (ENBFLG = 1); RETURN .STATUS; END; ! End of TERM_CONNECT %SBTTL 'End of KERTRM' END ! End of module ELUDOM