; 0001 0 MODULE KERTRM (IDENT = '3.3.104', ; 0002 0 ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL) ; 0003 0 ) = ; 0004 1 BEGIN ; 0005 1 ! ; 0006 1 ; 0007 1 !++ ; 0008 1 ! FACILITY: ; 0009 1 ! ; 0010 1 ! KERMIT-32 terminal processing. ; 0011 1 ! ; 0012 1 ! ABSTRACT: ; 0013 1 ! ; 0014 1 ! This module will do all of the terminal processing for KERMIT-32. ; 0015 1 ! It contains the output routines for the terminal to send and ; 0016 1 ! receive messages as well as the routines to output text for debugging. ; 0017 1 ! ; 0018 1 ! ENVIRONMENT: ; 0019 1 ! ; 0020 1 ! VAX/VMS user mode. ; 0021 1 ! ; 0022 1 ! AUTHOR: Robert C. McQueen, CREATION DATE: 25-March-1983 ; 0023 1 !-- ; 0024 1 ; 0025 1 %SBTTL 'Table of Contents' ; 0026 1 ! ; 0027 1 ! TABLE OF CONTENTS: ; 0028 1 ! ; 0029 1 %SBTTL 'Revision History' ; 0030 1 ; 0031 1 !++ ; 0032 1 ! ; 0033 1 ! Start of version 1. 25-March-1983 ; 0034 1 ! ; 0035 1 ! 1.0.000 By: Robert C. McQueen On: 25-March-1983 ; 0036 1 ! Create this module. ; 0037 1 ! ; 0038 1 ! 1.1.001 By: W. Hom On: 6-July-83 ; 0039 1 ! Implement CONNECT command. ; 0040 1 ! ; 0041 1 ! 1.1.002 By: Nick Bush On: 7-July-83 ; 0042 1 ! Fix RECEIVE QIO to time out correctly. ; 0043 1 ! ; 0044 1 ! 1.2.003 By: Robert C. McQueen On: 16-Aug-83 ; 0045 1 ! Get the status correctly for the SS$_TIMEOUT checks. ; 0046 1 ! ; 0047 1 ! 1.2.004 By: Robert C. McQueen On: 9-Sept-1983 ; 0048 1 ! Flag if we just opened the terminal, so that we can ; 0049 1 ! clear the input that is coming into the terminal. This ; 0050 1 ! will clear up some of the junk that we get on start up. ; 0051 1 ! ; 0052 1 ! 2.0.005 Release VAX/VMS Kermit-32 version 2.0 ; 0053 1 ! ; 0054 1 ! 2.0.006 By: Nick Bush On: 10-Nov-1983 ; 0055 1 ! Fix local echo and IBM mode. ; 0056 1 ! ; 0057 1 ! 2.0.013 By: Nick Bush On: 11-Nov-1983 ; 0058 1 ! Make it possible to redirect debugging output to DBG$OUTPUT. ; 0059 1 ! ; 0060 1 ! 2.0.015 By: Nick Bush On: 17-Nov-1983 ; 0061 1 ! Always purge typeahead when posting the receive QIO. ; 0062 1 ! Also eat any received data just before sending a packet. ; 0063 1 ! ; 0064 1 ! 2.0.020 By: Nick Bush On: 9-Dec-1983 ; 0065 1 ! Only abort (when remote) if we seen two control-Y's in ; 0066 1 ! succession. This way a single glitch does not kill us. ; 0067 1 ! ; 0068 1 ! 2.0.021 By: Nick Bush On: 12-Dec-1983 ; 0069 1 ! Add status type-out character (^A), debug toggle ; 0070 1 ! character (^D), and force timeout character (^M) ; 0071 1 ! to those accepted during a transfer when we are remote. ; 0072 1 ! ; 0073 1 ! 2.0.023 By: Nick Bush On: 16-Dec-1983 ; 0074 1 ! Add a default terminal name for the communications line. ; 0075 1 ! If KER$COMM is defined, that will be the default. ; 0076 1 ! ; 0077 1 ! 2.0.027 By: Nick Bush On: 20-Jan-1983 ; 0078 1 ! Fix reset of parity to use the correct field in the ; 0079 1 ! IO status block from the IO$_SENSEMODE. It was using ; 0080 1 ! the LF fill count instead. ; 0081 1 ! ; 0082 1 ! 2.0.031 By: Nick Bush On: 4-Feb-1983 ; 0083 1 ! Change connect code to improve response (hopefully ; 0084 1 ! without worsening throughput or runtime requirements). ; 0085 1 ! When either terminal is idle we will be waiting for ; 0086 1 ! a single character with a larger buffered read queued ; 0087 1 ! up immediately after it. ; 0088 1 ! ; 0089 1 ! 2.0.033 By: Nick Bush On: 6-March-1984 ; 0090 1 ! Change command input and terminal processing so that ; 0091 1 ! we will always have SYS$OUTPUT and SYS$COMMAND open ; 0092 1 ! when they are terminals, and will also always have ; 0093 1 ! the transfer terminal line open. This makes it ; 0094 1 ! unnecessary for the user to allocate a dialup line ; 0095 1 ! in order to go between CONNECT and a transfer command, ; 0096 1 ! and keep anyone else from grabbing the line between ; 0097 1 ! commands. ; 0098 1 ! Also add the command parsing for the rest of the LOCAL/REMOTE ; 0099 1 ! commands. This makes use of the fact that we have ; 0100 1 ! SYS$COMMAND open to allow us to read passwords without echo. ; 0101 1 ! Commands which should only be done when Kermit is local ; 0102 1 ! (GET, BYE, etc.) will now give an error if the transfer ; 0103 1 ! line is the same as the controlling terminal. ; 0104 1 ! SEND will now check for the files existance before calling ; 0105 1 ! KERMSG to send it. ; 0106 1 ! ; 0107 1 ! 2.0.034 By: Nick Bush On: 7-March-1984 ; 0108 1 ! Default the parity type to be that of the default transfer ; 0109 1 ! line. This should make things simpler for systems which use ; 0110 1 ! parity by default. ; 0111 1 ! ; 0112 1 ! 2.0.035 By: Nick Bush On: 8-March-1984 ; 0113 1 ! Add LOG SESSION command to set a log file for CONNECT. ; 0114 1 ! While we are doing so, clean up the command parsing a little ; 0115 1 ! so that we don't have as many COPY_xxx routines. ; 0116 1 ! ; 0117 1 ! 2.0.036 By: Robert C. McQueen On: 20-March-1984 ; 0118 1 ! Fix call to LOG_OPEN to make the debug log file work. ; 0119 1 ! Module: KERTRM ; 0120 1 ! ; 0121 1 ! 2.0.037 By: Robert C. McQueen On: 20-March-1984 ; 0122 1 ! Fix call to LOG_OPEN for debug log file. ; 0123 1 ! Module: KERTRM. ; 0124 1 ! ; 0125 1 ! 2.0.042 By: Nick Bush On: 26-March-1984 ; 0126 1 ! Fix connect processing to make it easy to type messages ; 0127 1 ! on the user's terminal while connected. Use this ; 0128 1 ! to type messages when log file stopped and started. ; 0129 1 ! Include the node name in the messages to keep ; 0130 1 ! users who are running through multiple Kermit's from ; 0131 1 ! getting confused. ; 0132 1 ! ; 0133 1 ! 2.0.043 By: Nick Bush On: 28-March-1984 ; 0134 1 ! Fix SET PARITY ODD to work. Somehow, the table entry ; 0135 1 ! had PR_NONE instead of PR_ODD. Also add status type ; 0136 1 ! out and help message to connect command. ; 0137 1 ! ; 0138 1 ! 3.0.045 Start of version 3. ; 0139 1 ! ; 0140 1 ! 3.0.046 By: Nick Bush On: 29-March-1984 ; 0141 1 ! Fix debugging log file to correctly set/clear file open ; 0142 1 ! flag. Also make log files default to .LOG. ; 0143 1 ! ; 0144 1 ! 3.1.054 By: Nick Bush On: 13-July-1984 ; 0145 1 ! Change TERM_OPEN to take an argument which determines ; 0146 1 ! whether it should post any QIO's. This makes it unnecessary ; 0147 1 ! for TERM_CONNECT to cancel the QIO's, and avoids problems ; 0148 1 ! with DECnet remote terminals. ; 0149 1 ! ; 0150 1 ! 3.1.060 By: Nick Bush On: 16-March-1985 ; 0151 1 ! Increase size of terminal name buffers to account for large ; 0152 1 ! unit numbers (most likely seen with VTA's). ; 0153 1 ! ; 0154 1 ! 3.1.061 By: Nick Bush On: 16-March-1985 ; 0155 1 ! Only attempt to set parity back when closing terminal. ; 0156 1 ! ; 0157 1 ! 3.1.065 By: Nick Bush On: 10-April-1985 ; 0158 1 ! Split IBM handshaking from parity and local echo. Allow ; 0159 1 ! link time setting of IBM_MODE defaults by defining symbols: ; 0160 1 ! ; 0161 1 ! IBM_MODE_CHARACTER = character value of handshake character ; 0162 1 ! IBM_MODE_ECHO = 1 for local echo, 2 for no local echo ; 0163 1 ! IBM_MODE_PARITY = (0 = none), (1 = mark), (2 = even), ; 0164 1 ! (3 = odd), (4 = space). ; 0165 1 ! ; 0166 1 ! If not specified, Kermit will continue to use DC1, local echo ; 0167 1 ! and odd parity for IBM_MODE. ; 0168 1 ! ; 0169 1 ! ; 0170 1 ! Start of version 3.2 on 8-May-1985 ; 0171 1 ! ; 0172 1 ! 3.2.073 By: Robert McQueen On: 11-March-1985 ; 0173 1 ! Fix a problem restoring the terminal characteristics under ; 0174 1 ! VMS 4.x ; 0175 1 ! ; 0176 1 ! 3.2.100 By: Gregory P. Welsh On: 1-June-1986 ; 0177 1 ! Added code for Transmit function (COMND_TRANSMIT). ; 0178 1 ! ; 0179 1 ! Start of version 3.3 ; 0180 1 ! ; 0181 1 ! 3.3.101 By: Robert McQueen On: 2-July-1986 ; 0182 1 ! Change $TRNLOG system service to be LIB$SYS_TRNLOG and ; 0183 1 ! handle the errors better. (LIB$ shouldn't change even if the ; 0184 1 ! system service does). ; 0185 1 ! ; 0186 1 ! 3.3.102 By: Robert McQueen On: 5-July-1986 ; 0187 1 ! Add changes/fixes suggested by Art Guion and David Deley. ; 0188 1 ! - Turn off FALLBACK terminal characteristics for eightbit ; 0189 1 ! operations. ; 0190 1 ! - Decrease IBM timeouts when waiting for a handshake. ; 0191 1 ! ; 0192 1 ! 3.3.105 By: Robert McQueen On: 8-July-1986 ; 0193 1 ! Attempt to fix the truncation errors that we now get from ; 0194 1 ! LINK with BLISS-32 v4.2. Also do code clean up in VMSTRM and ; 0195 1 ! VMSFIL. ; 0196 1 !-- ; 0197 1 ; 0198 1 %SBTTL 'Library files' ; 0199 1 ! ; 0200 1 ! INCLUDE FILES: ; 0201 1 ! ; 0202 1 ! ; 0203 1 ! System definitions ; 0204 1 ! ; 0205 1 ; 0206 1 LIBRARY 'SYS$LIBRARY:STARLET'; ; 0207 1 ; 0208 1 ! ; 0209 1 ! KERMIT common definitions ; 0210 1 ! ; 0211 1 ; 0212 1 REQUIRE 'KERCOM'; ; 0420 1 ; 0421 1 REQUIRE 'KERERR'; ; 0487 1 ; 0488 1 %SBTTL 'Structure definitions -- $GETDVI arguments' ; 0489 1 ! ; 0490 1 ! $GETDVI interface fields and structure definition ; 0491 1 ! ; 0492 1 ; 0493 1 LITERAL ; 0494 1 ITEM_SIZE = 3; ! Length of a DVI item list entry ; 0495 1 ; 0496 1 ! ; 0497 1 ! Fields for accessing the items in a DVI item list ; 0498 1 ! ; 0499 1 ; 0500 1 FIELD ; 0501 1 ITEM_FIELDS = ; 0502 1 SET ; 0503 1 ITEM_BFR_LENGTH = [0, 0, 16, 0], ; 0504 1 ITEM_ITEM_CODE = [0, 16, 16, 0], ; 0505 1 ITEM_BFR_ADDRESS = [1, 0, 32, 0], ; 0506 1 ITEM_RTN_LENGTH = [2, 0, 32, 0] ; 0507 1 TES; ; 0508 1 ; 0509 1 ! ; 0510 1 ! Structure definition for item list ; 0511 1 ; 0512 1 STRUCTURE ; 0513 1 ITEM_LIST [I, O, P, S, E; N] = ; 0514 1 [(N + 1)*ITEM_SIZE*4] ; 0515 1 (ITEM_LIST + ((I*ITEM_SIZE) + O)*4); ; 0516 1 ; 0517 1 %SBTTL 'Structures definitions -- Terminal characteristics' ; 0518 1 ! ; 0519 1 ! Terminal characteristics words ; 0520 1 ! ; 0521 1 ; 0522 1 LITERAL ; 0523 1 TC$_CHAR_LENGTH = 12; ; 0524 1 ; 0525 1 ! ; 0526 1 ! Fields for accessing the items in a characteristic block ; 0527 1 ! ; 0528 1 ; 0529 1 FIELD ; 0530 1 TC$_FIELDS = ; 0531 1 SET ; 0532 1 TC$_CLASS = [0, 0, 8, 0], ; 0533 1 TC$_TYPE = [0, 8, 8, 0], ; 0534 1 TC$_BFR_SIZE = [0, 16, 16, 0], ; 0535 1 TC$_PAGE_LEN = [1, 24, 8, 0], ; 0536 1 TC$_CHAR = [1, 0, 24, 0], ; 0537 1 TC$_CHAR_2 = [2, 0, 32, 0] ; 0538 1 TES; ; 0539 1 ; 0540 1 ! ; 0541 1 ! Structure definition for item list ; 0542 1 ! ; 0543 1 ; 0544 1 STRUCTURE ; 0545 1 TC$_CHAR_STR [O, P, S, E; N] = ; 0546 1 [TC$_CHAR_LENGTH] ; 0547 1 (TC$_CHAR_STR + O*4); ; 0548 1 ; 0549 1 %SBTTL 'Literals' ; 0550 1 ! ; 0551 1 ! Literal definitions ; 0552 1 ! ; 0553 1 ; 0554 1 LITERAL ; 0555 1 MAX_NODE_NAME = 255, ! Size of a node name ; 0556 1 TERM_NAME_SIZE = 16, ! Size of a terminal name ; 0557 1 RECV_BUFF_SIZE = MAX_MSG + 20, ! Size of receive buffer ; 0558 1 GET_DEV_EFN = 7, ! For GET_DEV_CHAR ; 0559 1 CONS_O_EFN = 6, ! Event flag for console output ; 0560 1 CONS_EFN = 5, ! Event flag for console input ; 0561 1 TERM_O_EFN = 4, ! Event flag for terminal output ; 0562 1 TIME_EFN = 3, ! Event flag number for receive timer ; 0563 1 TERM_EFN = 2; ! Event flag number to use for Terminal input ; 0564 1 ; 0565 1 %SBTTL 'Storage' ; 0566 1 ! ; 0567 1 ! OWN STORAGE: ; 0568 1 ! ; 0569 1 ! ; 0570 1 ! Communications routines storage ; 0571 1 ! ; 0572 1 ; 0573 1 OWN ; 0574 1 FORCE_ABORT, ! Force abort next receive ; 0575 1 FORCE_TIMEOUT, ! Force time out on next receive ; 0576 1 TERM_FIRST_TIME, ! First time QIO to read done ; 0577 1 TERM_CHAN, ! Channel the terminal is opened on ; 0578 1 CONS_CHAN, ! Channel the console terminal is opened on ; 0579 1 SYS_OUTPUT_CHAN, ! Channel to SYS$OUTPUT (if it is a terminal) ; 0580 1 SYS_OUTPUT_OPEN, ! SYS$OUTPUT open ; 0581 1 SYS_OUTPUT_NAME : VECTOR [TERM_NAME_SIZE, BYTE], ! Text of physical name for SYS$OUTPUT ; 0582 1 SYS_OUTPUT_DESC : BLOCK [8, BYTE], ! Descriptor for physical name ; 0583 1 SYS_COMMAND_CHAN, ! Channel to SYS$COMMAND if a terminal ; 0584 1 SYS_COMMAND_OPEN, ! SYS$COMMAND open ; 0585 1 SYS_COMMAND_NAME : VECTOR [TERM_NAME_SIZE, BYTE], ! Text of physical name for SYS$COMMAND ; 0586 1 SYS_COMMAND_DESC : BLOCK [8, BYTE], ! Descriptor for physical name ; 0587 1 TERM_NAME : VECTOR [TERM_NAME_SIZE, BYTE], ! Text of current transfer terminal name ; 0588 1 JOB_TERM_NAME : VECTOR [TERM_NAME_SIZE, BYTE], ! Text of jobs controlling terminal name ; 0589 1 TERM_OPEN_FLAG, ! The transfer terminal is open ; 0590 1 SESSION_FAB : $FAB_DECL, ! FAB for session logging ; 0591 1 SESSION_RAB : $RAB_DECL, ! RAB for session logging ; 0592 1 SESSION_NAME : VECTOR [MAX_FILE_NAME, BYTE], ! Actual name of session log file ; 0593 1 SESSION_OPEN, ! Session log file open ; 0594 1 SESSION_LOGGING, ! Session logging enabled ; 0595 1 DEBUG_FAB : $FAB_DECL, ! FAB for debugging ; 0596 1 DEBUG_RAB : $RAB_DECL, ! RAB for debugging ; 0597 1 DEBUG_NAME : VECTOR [MAX_FILE_NAME, BYTE], ! Name of debugging log file ; 0598 1 DEBUG_REDIRECTED, ! Debugging output redirected ; 0599 1 NODE_NAME : VECTOR [MAX_NODE_NAME, BYTE], ! Node name text ; 0600 1 IO_STATUS : VECTOR [4, WORD], ! IOSB for receive QIO ; 0601 1 RECV_BUFFER : VECTOR [CH$ALLOCATION (RECV_BUFF_SIZE, CHR_SIZE)], ! Input buffer ; 0602 1 OLD_PARITY : BLOCK [8, BYTE], ! Old IOSB information ; 0603 1 OLD_TERM_CHAR : TC$_CHAR_STR FIELD (TC$_FIELDS), ! Old terminal chars ; 0604 1 NEW_TERM_CHAR : TC$_CHAR_STR FIELD (TC$_FIELDS); ! New terminal chars ; 0605 1 ; 0606 1 GLOBAL ; 0607 1 NODE_DESC : BLOCK [8, BYTE] PRESET ! Descriptor for node name ; 0608 1 ([DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class ; 0609 1 [DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Text descriptor ; 0610 1 [DSC$W_LENGTH ] = MAX_NODE_NAME, ! Maximum length ; 0611 1 [DSC$A_POINTER ] = NODE_NAME), ! Address of the item ; 0612 1 DEBUG_DESC : BLOCK [8, BYTE] PRESET ! Debugging log file ; 0613 1 ([DSC$B_CLASS ] = DSC$K_CLASS_S, ! descriptor ; 0614 1 [DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Standard string descriptor ; 0615 1 [DSC$W_LENGTH ] = 0, ! initialially zero length ; 0616 1 [DSC$A_POINTER ] = DEBUG_NAME), ! pointing to DEBUG_NAME ; 0617 1 SESSION_DESC : BLOCK [8, BYTE], ! Descriptor for session log file name ; 0618 1 TERM_DESC : BLOCK [8, BYTE], ! Descriptor for current transfer terminal ; 0619 1 JOB_TERM_DESC : BLOCK [8, BYTE], ! Descriptor for controlling terminal (if any) ; 0620 1 TRANS_DELAY, ! The transmit delay ; 0621 1 TRANS_ECHO_FLAG, ! The transmit echo flag ; 0622 1 TERM_FLAG; ! Terminal setup for transfer ; 0623 1 ; 0624 1 %SBTTL 'External routines' ; 0625 1 ! ; 0626 1 ! EXTERNAL REFERENCES: ; 0627 1 ! ; 0628 1 ! ; 0629 1 ! System library routines ; 0630 1 ! ; 0631 1 ; 0632 1 EXTERNAL ROUTINE ; 0633 1 LIB$PUT_SCREEN : ADDRESSING_MODE (GENERAL), ; 0634 1 LIB$PUT_OUTPUT : ADDRESSING_MODE (GENERAL), ; 0635 1 LIB$EMUL : ADDRESSING_MODE (GENERAL), ; 0636 1 LIB$ADDX : ADDRESSING_MODE (GENERAL), ; 0637 1 LIB$SIGNAL : ADDRESSING_MODE (GENERAL); ; 0638 1 ; 0639 1 ! ; 0640 1 ! Forward routines: ; 0641 1 ! ; 0642 1 ; 0643 1 FORWARD ROUTINE ; 0644 1 TERM_DUMP : NOVALUE, ! Routine to type on terminal ; 0645 1 GET_DEV_CHAR, ! Get device characteristics ; 0646 1 DO_RECEIVE_QIO, ; 0647 1 DO_CONS_QIO; ; 0648 1 ; 0649 1 %SBTTL 'External storage' ; 0650 1 ; 0651 1 !++ ; 0652 1 ! The following is the various external storage locations that are ; 0653 1 ! referenced from this module. ; 0654 1 !-- ; 0655 1 ; 0656 1 ! ; 0657 1 ! KERMSG storage ; 0658 1 ! ; 0659 1 ; 0660 1 EXTERNAL ; 0661 1 PARITY_TYPE, ! Type of parity being used ; 0662 1 ECHO_FLAG, ! Local echo ; 0663 1 IBM_CHAR, ! IBM mode turn-around character ; 0664 1 RCV_EOL, ! Receive EOL character ; 0665 1 SEND_TIMEOUT, ! Receive time out counter ; 0666 1 CONNECT_FLAG; ! Flag if communications line is TT: ; 0667 1 ; 0668 1 ! ; 0669 1 ! KERMIT storage ; 0670 1 ! ; 0671 1 ; 0672 1 EXTERNAL ; 0673 1 ESCAPE_CHR; ! Escape char. for CONNECT. ; 0674 1 ; 0675 1 %SBTTL 'Terminal routines -- TERM_INIT - Initialize this module' ; 0676 1 ; 0677 1 GLOBAL ROUTINE TERM_INIT : NOVALUE = ; 0678 1 ; 0679 1 !++ ; 0680 1 ! FUNCTIONAL DESCRIPTION: ; 0681 1 ! ; 0682 1 ! This routine will initialize the terminal processing module. It will ; 0683 1 ! initialize the various data locations in this module. ; 0684 1 ! ; 0685 1 ! CALLING SEQUENCE: ; 0686 1 ! ; 0687 1 ! TERM_INIT(); ; 0688 1 ! ; 0689 1 ! INPUT PARAMETERS: ; 0690 1 ! ; 0691 1 ! None. ; 0692 1 ! ; 0693 1 ! IMPLICIT INPUTS: ; 0694 1 ! ; 0695 1 ! None. ; 0696 1 ! ; 0697 1 ! OUTPUT PARAMETERS: ; 0698 1 ! ; 0699 1 ! None. ; 0700 1 ! ; 0701 1 ! IMPLICIT OUTPUTS: ; 0702 1 ! ; 0703 1 ! None. ; 0704 1 ! ; 0705 1 ! COMPLETION CODES: ; 0706 1 ! ; 0707 1 ! None. ; 0708 1 ! ; 0709 1 ! SIDE EFFECTS: ; 0710 1 ! ; 0711 1 ! None. ; 0712 1 ! ; 0713 1 !-- ; 0714 1 ; 0715 2 BEGIN ; 0716 2 ; 0717 2 LOCAL ; 0718 2 COUNTER, ! Counter for logical name translation ; 0719 2 STATUS, ! System call status ; 0720 2 DEV_TYPE, ! Device type result ; 0721 2 RSL_LENGTH : VOLATILE, ! Resulting length of translation ; 0722 2 RSL_NAME : BLOCK [TERM_NAME_SIZE, BYTE], ! Translated name ; 0723 2 RSL_DESC : BLOCK [8, BYTE], ! Descriptor for translated name ; 0724 2 ; 0725 2 NODE_ITEM_LIST : FIELD(ITEM_FIELDS) ITEM_LIST [2] PRESET ! Node name ; 0726 2 ([0, ITEM_BFR_LENGTH ] = MAX_NODE_NAME, ! Translation ; 0727 2 [0, ITEM_ITEM_CODE ] = LNM$_STRING, ! Item list ; 0728 2 [0, ITEM_BFR_ADDRESS ] = NODE_NAME, ! to xlate ; 0729 2 [0, ITEM_RTN_LENGTH ] = NODE_DESC[DSC$W_LENGTH]), ! SYS$NODE ; 0730 2 ; 0731 2 ITMLST : ITEM_LIST [1] FIELD (ITEM_FIELDS) PRESET ; 0732 2 ([0, ITEM_ITEM_CODE ] = JPI$_TERMINAL, ! Get terminal name ; 0733 2 [0, ITEM_BFR_LENGTH ] = TERM_NAME_SIZE - 1, ! Max name size ; 0734 2 [0, ITEM_BFR_ADDRESS ] = JOB_TERM_NAME + 1, ! Place to store it ; 0735 2 [0, ITEM_RTN_LENGTH ] = RSL_LENGTH); ! Resulting length ; 0736 2 ; 0737 2 ! ; 0738 2 ! Initialize session log file descriptor ; 0739 2 ! ; 0740 2 SESSION_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 0741 2 SESSION_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 0742 2 SESSION_DESC [DSC$W_LENGTH] = 0; ; 0743 2 SESSION_DESC [DSC$A_POINTER] = SESSION_NAME; ; 0744 2 ! ; 0745 2 ! Get system node name (if any) ; 0746 2 ! ; 0747 2 NODE_DESC [DSC$W_LENGTH] = MAX_NODE_NAME; ; P 0748 2 STATUS = $TRNLNM(ATTR = %REF(LNM$M_CASE_BLIND), ; P 0749 2 TABNAM = %ASCID 'LNM$SYSTEM', LOGNAM = %ASCID 'SYS$NODE', ; 0750 2 ITMLST = NODE_ITEM_LIST); ; 0751 2 ; 0752 2 COUNTER = 64; ! Max number of translations ; 0753 2 ; 0754 2 WHILE .STATUS ! Translation fails ; 0755 2 AND .COUNTER GTR 0 ! or we do too many translations ; 0756 2 DO ; 0757 3 BEGIN ; P 0758 3 STATUS = $TRNLNM(ATTR = %REF(LNM$M_CASE_BLIND), ; P 0759 3 TABNAM = %ASCID 'LNM$SYSTEM', LOGNAM = NODE_DESC, ; 0760 3 ITMLST = NODE_ITEM_LIST); ; 0761 3 COUNTER = .COUNTER - 1; ; 0762 2 END; ; 0763 2 ! ; 0764 2 ! If call failed, we don't really know the node name ; 0765 2 ! ; 0766 3 IF (NOT .STATUS) OR (NODE_NAME[0] EQL 0) ; 0767 2 THEN ; 0768 2 NODE_DESC[DSC$W_LENGTH] = 0; ; 0769 2 ! ; 0770 2 ! Get controlling terminal ; 0771 2 ! ; 0772 2 JOB_TERM_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 0773 2 JOB_TERM_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 0774 2 JOB_TERM_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; ; 0775 2 JOB_TERM_DESC [DSC$A_POINTER] = JOB_TERM_NAME; ; 0776 2 JOB_TERM_NAME [0] = %C'_'; ; 0777 2 ; 0778 2 STATUS = $GETJPIW (ITMLST = ITMLST); ; 0779 2 JOB_TERM_DESC [DSC$W_LENGTH] = .RSL_LENGTH + 1; ; 0780 2 ; 0781 2 IF NOT .STATUS OR .RSL_LENGTH EQL 0 THEN JOB_TERM_DESC [DSC$W_LENGTH] = 0; ; 0782 2 ; 0783 2 ! ; 0784 2 ! Open the output device and command device (if they are terminals) ; 0785 2 ! ; 0786 2 SYS_OUTPUT_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 0787 2 SYS_OUTPUT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 0788 2 SYS_OUTPUT_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; ; 0789 2 SYS_OUTPUT_DESC [DSC$A_POINTER] = SYS_OUTPUT_NAME; ; 0790 2 STATUS = GET_DEV_CHAR (%ASCID'SYS$OUTPUT', SYS_OUTPUT_DESC, DEV_TYPE); ; 0791 2 ; 0792 2 IF .STATUS AND .DEV_TYPE EQL DC$_TERM ; 0793 2 THEN ; 0794 3 BEGIN ; 0795 3 STATUS = $ASSIGN (CHAN = SYS_OUTPUT_CHAN, DEVNAM = SYS_OUTPUT_DESC); ; 0796 3 ; 0797 3 IF .STATUS THEN SYS_OUTPUT_OPEN = TRUE; ; 0798 3 ; 0799 2 END; ; 0800 2 ; 0801 2 SYS_COMMAND_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 0802 2 SYS_COMMAND_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 0803 2 SYS_COMMAND_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; ; 0804 2 SYS_COMMAND_DESC [DSC$A_POINTER] = SYS_COMMAND_NAME; ; 0805 2 STATUS = GET_DEV_CHAR (%ASCID'SYS$COMMAND', SYS_COMMAND_DESC, DEV_TYPE); ; 0806 2 ; 0807 2 IF .STATUS AND .DEV_TYPE EQL DC$_TERM ; 0808 2 THEN ; 0809 3 BEGIN ; 0810 3 STATUS = $ASSIGN (CHAN = SYS_COMMAND_CHAN, DEVNAM = SYS_COMMAND_DESC); ; 0811 3 ; 0812 3 IF .STATUS THEN SYS_COMMAND_OPEN = TRUE; ; 0813 3 ; 0814 2 END; ; 0815 2 ! ; 0816 2 ! Set up the terminal name descriptor ; 0817 2 ! ; 0818 2 TERM_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 0819 2 TERM_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 0820 2 TERM_DESC [DSC$A_POINTER] = TERM_NAME; ; 0821 2 TERM_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; ; 0822 2 ! ; 0823 2 ! If KER$COMM is a terminal, then use it as the default. ; 0824 2 ! ; 0825 2 STATUS = GET_DEV_CHAR (%ASCID'KER$COMM', TERM_DESC, DEV_TYPE); ; 0826 2 ; 0827 2 IF NOT .STATUS OR .DEV_TYPE NEQ DC$_TERM ; 0828 2 THEN ; 0829 3 BEGIN ; 0830 3 ! ; 0831 3 ! If KER$COMM is not a terminal (or is not anything), try SYS$INPUT. ; 0832 3 ! ; 0833 3 TERM_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; ; 0834 3 STATUS = GET_DEV_CHAR (%ASCID'SYS$INPUT', TERM_DESC, DEV_TYPE); ; 0835 3 ; 0836 3 IF NOT .STATUS OR .DEV_TYPE NEQ DC$_TERM ; 0837 3 THEN ; 0838 4 BEGIN ; 0839 4 ! ; 0840 4 ! If SYS$INPUT is not a terminal, check out SYS$OUTPUT. We will already have ; 0841 4 ! it open if it is a terminal. ; 0842 4 ! ; 0843 4 ; 0844 4 IF .SYS_OUTPUT_OPEN ; 0845 4 THEN ; 0846 5 BEGIN ; 0847 5 CH$COPY (.SYS_OUTPUT_DESC [DSC$W_LENGTH], ; 0848 5 CH$PTR (.SYS_OUTPUT_DESC [DSC$A_POINTER]), CHR_NUL, TERM_NAME_SIZE, ; 0849 5 CH$PTR (TERM_NAME)); ; 0850 5 TERM_DESC [DSC$W_LENGTH] = .SYS_OUTPUT_DESC [DSC$W_LENGTH]; ; 0851 5 END ; 0852 4 ELSE ; 0853 5 BEGIN ; 0854 5 ! ; 0855 5 ! SYS$OUTPUT is not a terminal. Next we try SYS$COMMAND. It should already ; 0856 5 ! be open if it is a valid terminal. ; 0857 5 ! ; 0858 5 ; 0859 5 IF .SYS_COMMAND_OPEN ; 0860 5 THEN ; 0861 6 BEGIN ; 0862 6 CH$COPY (.SYS_COMMAND_DESC [DSC$W_LENGTH], ; 0863 6 CH$PTR (.SYS_COMMAND_DESC [DSC$A_POINTER]), CHR_NUL, TERM_NAME_SIZE, ; 0864 6 CH$PTR (TERM_NAME)); ; 0865 6 TERM_DESC [DSC$W_LENGTH] = .SYS_OUTPUT_DESC [DSC$W_LENGTH]; ; 0866 6 END ; 0867 5 ELSE ; 0868 6 BEGIN ; 0869 6 ! ; 0870 6 ! Here we start to get desparate. Nothing we have tried so far was a terminal. ; 0871 6 ! Try the terminal which is controlling the job which owns this process. ; 0872 6 ! ; 0873 6 TERM_DESC [DSC$W_LENGTH] = .JOB_TERM_DESC [DSC$W_LENGTH]; ; 0874 6 CH$COPY (.JOB_TERM_DESC [DSC$W_LENGTH], ; 0875 6 CH$PTR (.JOB_TERM_DESC [DSC$A_POINTER]), CHR_NUL, TERM_NAME_SIZE, ; 0876 6 CH$PTR (TERM_NAME)); ; 0877 5 END; ; 0878 5 ; 0879 4 END; ; 0880 4 ; 0881 3 END; ; 0882 3 ; 0883 2 END; ; 0884 2 ; 0885 2 ! ; 0886 2 ! At this pointer, TERM_DESC should be set up with something resembling ; 0887 2 ! the phyiscal name of a terminal (unless this is a detached process). ; 0888 2 ! We can now assign a channel to the terminal and tell the user what the ; 0889 2 ! default device is. ; 0890 2 ! ; 0891 2 CH$WCHAR (CHR_NUL, CH$PTR (TERM_NAME, .TERM_DESC [DSC$W_LENGTH])); ; 0892 2 STATUS = $ASSIGN (CHAN = TERM_CHAN, DEVNAM = TERM_DESC); ; 0893 2 TERM_DUMP (UPLIT BYTE(CHR_CRT, CHR_LFD), 2); ; 0894 2 ; 0895 2 IF .STATUS ; 0896 2 THEN ; 0897 3 BEGIN ; 0898 3 ; 0899 3 BIND ; 0900 3 DEFTRM_TEXT = %ASCID'Default terminal for transfers is: '; ; 0901 3 ; 0902 3 MAP ; 0903 3 DEFTRM_TEXT : BLOCK [8, BYTE]; ; 0904 3 ; 0905 3 TERM_OPEN_FLAG = TRUE; ; 0906 3 TERM_DUMP (.DEFTRM_TEXT [DSC$A_POINTER], .DEFTRM_TEXT [DSC$W_LENGTH]); ; 0907 3 TERM_DUMP (TERM_NAME, .TERM_DESC [DSC$W_LENGTH]); ; 0908 3 END ; 0909 2 ELSE ; 0910 3 BEGIN ; 0911 3 ; 0912 3 BIND ; 0913 3 NODEFTRM_TEXT = %ASCID'No default terminal line for transfers'; ; 0914 3 ; 0915 3 MAP ; 0916 3 NODEFTRM_TEXT : BLOCK [8, BYTE]; ; 0917 3 ; 0918 3 TERM_OPEN_FLAG = FALSE; ; 0919 3 TERM_DESC [DSC$W_LENGTH] = 0; ; 0920 3 TERM_DUMP (.NODEFTRM_TEXT [DSC$A_POINTER], .NODEFTRM_TEXT [DSC$W_LENGTH]) ; 0921 2 END; ; 0922 2 ; 0923 2 TERM_DUMP (UPLIT BYTE(CHR_CRT, CHR_LFD), 2); ; 0924 2 ! ; 0925 2 ! Initialize the flags ; 0926 2 ! ; 0927 2 TERM_FLAG = FALSE; ; 0928 2 TRANS_DELAY = '0'; ! init transmit delay to .0 seconds ; 0929 2 ! ; 0930 2 ! If we really did get the terminal open, then determine what type of ; 0931 2 ! parity it uses, and default to using that parity. ; 0932 2 ! ; 0933 2 ; 0934 2 IF .TERM_OPEN_FLAG ; 0935 2 THEN ; 0936 3 BEGIN ; P 0937 3 STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SENSEMODE, P1 = OLD_TERM_CHAR, ; 0938 3 P2 = TC$_CHAR_LENGTH, IOSB = OLD_PARITY); ; 0939 3 ; 0940 3 IF .STATUS ; 0941 3 THEN ; 0942 3 ; 0943 3 IF (.OLD_PARITY [6, 0, 8, 0] AND TT$M_PARITY) NEQ 0 ; 0944 3 THEN ; 0945 3 ; 0946 3 IF (.OLD_PARITY [6, 0, 8, 0] AND TT$M_ODD) NEQ 0 ; 0947 3 THEN ; 0948 3 PARITY_TYPE = PR_ODD ; 0949 3 ELSE ; 0950 3 PARITY_TYPE = PR_EVEN ; 0951 3 ; 0952 3 ELSE ; 0953 3 PARITY_TYPE = PR_NONE; ; 0954 3 ; 0955 2 END; ; 0956 2 ; 0957 1 END; ! End of TERM_INIT .TITLE KERTRM .IDENT \3.3.104\ .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAA: .WORD 255, 2 ; ; .ADDRESS U.26, NODE_DESC ; ; P.AAB: .WORD 15, 797 ; ; .ADDRESS U.15+1 ; ; .LONG 0 ; ; P.AAD: .ASCII \LNM$SYSTEM\<0><0> ; ; P.AAC: .LONG 17694730 ; ; .ADDRESS P.AAD ; ; P.AAF: .ASCII \SYS$NODE\ ; ; P.AAE: .LONG 17694728 ; ; .ADDRESS P.AAF ; ; P.AAH: .ASCII \LNM$SYSTEM\<0><0> ; ; P.AAG: .LONG 17694730 ; ; .ADDRESS P.AAH ; ; P.AAJ: .ASCII \SYS$OUTPUT\<0><0> ; ; P.AAI: .LONG 17694730 ; ; .ADDRESS P.AAJ ; ; P.AAL: .ASCII \SYS$COMMAND\<0> ; ; P.AAK: .LONG 17694731 ; ; .ADDRESS P.AAL ; ; P.AAN: .ASCII \KER$COMM\ ; ; P.AAM: .LONG 17694728 ; ; .ADDRESS P.AAN ; ; P.AAP: .ASCII \SYS$INPUT\<0><0><0> ; ; P.AAO: .LONG 17694729 ; ; .ADDRESS P.AAP ; ; P.AAQ: .BYTE 13, 10 ; ; .BLKB 2 P.AAS: .ASCII \Default terminal for transfers is: \<0> ; ; P.AAR: .LONG 17694755 ; ; .ADDRESS P.AAS ; ; P.AAU: .ASCII \No default terminal line for transfers\<0><0> ; ; P.AAT: .LONG 17694758 ; ; .ADDRESS P.AAU ; ; P.AAV: .BYTE 13, 10 ; ; .PSECT $OWN$,NOEXE,2 ;FORCE_ABORT U.1: .BLKB 4 ;FORCE_TIMEOUT U.2: .BLKB 4 ;TERM_FIRST_TIME U.3: .BLKB 4 ;TERM_CHAN U.4: .BLKB 4 ;CONS_CHAN U.5: .BLKB 4 ;SYS_OUTPUT_CHAN U.6: .BLKB 4 ;SYS_OUTPUT_OPEN U.7: .BLKB 4 ;SYS_OUTPUT_NAME U.8: .BLKB 16 ;SYS_OUTPUT_DESC U.9: .BLKB 8 ;SYS_COMMAND_CHAN U.10: .BLKB 4 ;SYS_COMMAND_OPEN U.11: .BLKB 4 ;SYS_COMMAND_NAME U.12: .BLKB 16 ;SYS_COMMAND_DESC U.13: .BLKB 8 ;TERM_NAME U.14: .BLKB 16 ;JOB_TERM_NAME U.15: .BLKB 16 ;TERM_OPEN_FLAG U.16: .BLKB 4 ;SESSION_FAB U.17: .BLKB 80 ;SESSION_RAB U.18: .BLKB 68 ;SESSION_NAME U.19: .BLKB 132 ;SESSION_OPEN U.20: .BLKB 4 ;SESSION_LOGGING U.21: .BLKB 4 ;DEBUG_FAB U.22: .BLKB 80 ;DEBUG_RAB U.23: .BLKB 68 ;DEBUG_NAME U.24: .BLKB 132 ;DEBUG_REDIRECTED U.25: .BLKB 4 ;NODE_NAME U.26: .BLKB 255 .BLKB 1 ;IO_STATUS U.27: .BLKB 8 ;RECV_BUFFER U.28: .BLKB 116 ;OLD_PARITY U.29: .BLKB 8 ;OLD_TERM_CHAR U.30: .BLKB 12 ;NEW_TERM_CHAR U.31: .BLKB 12 .PSECT $GLOBAL$,NOEXE,2 NODE_DESC:: .WORD 255 ; ; .BYTE 14, 1 ; ; .ADDRESS U.26 ; ; DEBUG_DESC:: .WORD 0 ; ; .BYTE 14, 1 ; ; .ADDRESS U.24 ; ; SESSION_DESC:: .BLKB 8 TERM_DESC:: .BLKB 8 JOB_TERM_DESC:: .BLKB 8 TRANS_DELAY:: .BLKB 4 TRANS_ECHO_FLAG:: .BLKB 4 TERM_FLAG:: .BLKB 4 FNM_NORMAL== 1 FNM_FULL== 2 FNM_UNTRAN== 4 PR_MIN== 0 PR_NONE== 0 PR_MARK== 1 PR_EVEN== 2 PR_ODD== 3 PR_SPACE== 4 PR_MAX== 4 GC_MIN== 1 GC_EXIT== 1 GC_DIRECTORY== 2 GC_DISK_USAGE== 3 GC_DELETE== 4 GC_TYPE== 5 GC_HELP== 6 GC_LOGOUT== 7 GC_LGN== 8 GC_CONNECT== 9 GC_RENAME== 10 GC_COPY== 11 GC_WHO== 12 GC_SEND_MSG== 13 GC_STATUS== 14 GC_COMMAND== 15 GC_KERMIT== 16 GC_JOURNAL== 17 GC_VARIABLE== 18 GC_PROGRAM== 19 GC_MAX== 19 DP_FULL== 0 DP_HALF== 1 CHK_1CHAR== 49 CHK_2CHAR== 50 CHK_CRC== 51 MAX_MSG== 96 U.45= P.AAR U.47= P.AAT .EXTRN LIB$PUT_SCREEN, LIB$PUT_OUTPUT, LIB$EMUL, LIB$ADDX, LIB$SIGNAL, PARITY_TYPE, ECHO_FLAG .EXTRN IBM_CHAR, RCV_EOL, SEND_TIMEOUT, CONNECT_FLAG, ESCAPE_CHR, SYS$TRNLNM, SYS$GETJPIW .EXTRN SYS$ASSIGN, SYS$QIOW .PSECT $CODE$,NOWRT,2 .ENTRY TERM_INIT, ^M ; ; MOVAB G^U.41, R11 ;U.41, R11 ; MOVAB G^P.AAA, R10 ;P.AAA, R10 ; MOVAB G^TERM_DESC, R9 ;TERM_DESC, R9 ; MOVAB G^U.14, R8 ;U.14, R8 ; MOVAB -96(SP), SP ;-96(SP), SP ; MOVC5 #12, (R10), #0, #36, 32(SP) ;#12, P.AAA, #0, #36, NODE_ITEM_LIST ; 0729 MOVC5 #12, 12(R10), #0, #24, 8(SP) ;#12, P.AAB, #0, #24, ITMLST ; 0735 MOVAB 92(SP), 16(SP) ;RSL_LENGTH, ITMLST+8 ; MOVL #17694720, -8(R9) ;#17694720, SESSION_DESC ; 0742 MOVAB 184(R8), -4(R9) ;SESSION_NAME, SESSION_DESC+4 ; 0743 MOVZBW #255, -24(R9) ;#255, NODE_DESC ; 0747 PUSHAB 32(SP) ;NODE_ITEM_LIST ; 0750 CLRL -(SP) ;-(SP) ; PUSHAB 52(R10) ;P.AAE ; PUSHAB 36(R10) ;P.AAC ; MOVL #33554432, 16(SP) ;#33554432, 16(SP) ; PUSHAB 16(SP) ;16(SP) ; CALLS #5, G^SYS$TRNLNM ;#5, SYS$TRNLNM ; MOVL R0, R7 ;R0, STATUS ; MOVZBL #64, R2 ;#64, COUNTER ; 0752 1$: BLBC R7, 3$ ;STATUS, 3$ ; 0754 BLEQ 2$ ;2$ ; 0755 PUSHAB 32(SP) ;NODE_ITEM_LIST ; 0760 CLRL -(SP) ;-(SP) ; PUSHAB -24(R9) ;NODE_DESC ; PUSHAB 72(R10) ;P.AAG ; MOVL #33554432, 16(SP) ;#33554432, 16(SP) ; PUSHAB 16(SP) ;16(SP) ; CALLS #5, G^SYS$TRNLNM ;#5, SYS$TRNLNM ; MOVL R0, R7 ;R0, STATUS ; DECL R2 ;COUNTER ; 0761 BRB 1$ ;1$ ; 2$: BLBC R7, 3$ ;STATUS, 3$ ; 0766 MOVAB 608(R8), R0 ;NODE_NAME, R0 ; BNEQ 4$ ;4$ ; 3$: CLRW -24(R9) ;NODE_DESC ; 0768 4$: MOVL #17694736, 8(R9) ;#17694736, JOB_TERM_DESC ; 0774 MOVAB 16(R8), 12(R9) ;JOB_TERM_NAME, JOB_TERM_DESC+4 ; 0775 MOVB #95, 16(R8) ;#95, JOB_TERM_NAME ; 0776 CLRQ -(SP) ;-(SP) ; 0778 CLRL -(SP) ;-(SP) ; PUSHAB 20(SP) ;ITMLST ; CLRQ -(SP) ;-(SP) ; CLRL -(SP) ;-(SP) ; CALLS #7, G^SYS$GETJPIW ;#7, SYS$GETJPIW ; MOVL R0, R7 ;R0, STATUS ; ADDW3 #1, 92(SP), 8(R9) ;#1, RSL_LENGTH, JOB_TERM_DESC ; 0779 BLBC R7, 5$ ;STATUS, 5$ ; 0781 TSTL 92(SP) ;RSL_LENGTH ; BNEQ 6$ ;6$ ; 5$: CLRW 8(R9) ;JOB_TERM_DESC ; 6$: MOVL #17694736, -40(R8) ;#17694736, SYS_OUTPUT_DESC ; 0788 MOVAB -56(R8), -36(R8) ;SYS_OUTPUT_NAME, SYS_OUTPUT_DESC+4 ; 0789 PUSHAB 4(SP) ;DEV_TYPE ; 0790 PUSHAB -40(R8) ;SYS_OUTPUT_DESC ; PUSHAB 92(R10) ;P.AAI ; CALLS #3, (R11) ;#3, GET_DEV_CHAR ; MOVL R0, R7 ;R0, STATUS ; BLBC R7, 7$ ;STATUS, 7$ ; 0792 CMPL 4(SP), #66 ;DEV_TYPE, #66 ; BNEQ 7$ ;7$ ; CLRQ -(SP) ;-(SP) ; 0795 PUSHAB -64(R8) ;SYS_OUTPUT_CHAN ; PUSHAB -40(R8) ;SYS_OUTPUT_DESC ; CALLS #4, G^SYS$ASSIGN ;#4, SYS$ASSIGN ; MOVL R0, R7 ;R0, STATUS ; BLBC R7, 7$ ;STATUS, 7$ ; 0797 MOVL #1, -60(R8) ;#1, SYS_OUTPUT_OPEN ; 7$: MOVL #17694736, -8(R8) ;#17694736, SYS_COMMAND_DESC ; 0803 MOVAB -24(R8), -4(R8) ;SYS_COMMAND_NAME, SYS_COMMAND_DESC+4 ; 0804 PUSHAB 4(SP) ;DEV_TYPE ; 0805 PUSHAB -8(R8) ;SYS_COMMAND_DESC ; PUSHAB 112(R10) ;P.AAK ; CALLS #3, (R11) ;#3, GET_DEV_CHAR ; MOVL R0, R7 ;R0, STATUS ; BLBC R7, 8$ ;STATUS, 8$ ; 0807 CMPL 4(SP), #66 ;DEV_TYPE, #66 ; BNEQ 8$ ;8$ ; CLRQ -(SP) ;-(SP) ; 0810 PUSHAB -32(R8) ;SYS_COMMAND_CHAN ; PUSHAB -8(R8) ;SYS_COMMAND_DESC ; CALLS #4, G^SYS$ASSIGN ;#4, SYS$ASSIGN ; MOVL R0, R7 ;R0, STATUS ; BLBC R7, 8$ ;STATUS, 8$ ; 0812 MOVL #1, -28(R8) ;#1, SYS_COMMAND_OPEN ; 8$: MOVL #17694736, (R9) ;#17694736, TERM_DESC ; 0821 MOVAB (R8), 4(R9) ;TERM_NAME, TERM_DESC+4 ; 0820 PUSHAB 4(SP) ;DEV_TYPE ; 0825 PUSHL R9 ;R9 ; PUSHAB 128(R10) ;P.AAM ; CALLS #3, (R11) ;#3, GET_DEV_CHAR ; MOVL R0, R7 ;R0, STATUS ; BLBC R7, 9$ ;STATUS, 9$ ; 0827 CMPL 4(SP), #66 ;DEV_TYPE, #66 ; BEQL 13$ ;13$ ; 9$: MOVW #16, (R9) ;#16, TERM_DESC ; 0833 PUSHAB 4(SP) ;DEV_TYPE ; 0834 PUSHL R9 ;R9 ; PUSHAB 148(R10) ;P.AAO ; CALLS #3, (R11) ;#3, GET_DEV_CHAR ; MOVL R0, R7 ;R0, STATUS ; BLBC R7, 10$ ;STATUS, 10$ ; 0836 CMPL 4(SP), #66 ;DEV_TYPE, #66 ; BEQL 13$ ;13$ ; 10$: BLBC -60(R8), 11$ ;SYS_OUTPUT_OPEN, 11$ ; 0844 MOVZWL -40(R8), R6 ;SYS_OUTPUT_DESC, R6 ; 0847 MOVL -36(R8), R0 ;SYS_OUTPUT_DESC+4, R0 ; 0848 MOVC5 R6, (R0), #0, #16, (R8) ;R6, (R0), #0, #16, TERM_NAME ; 0849 MOVW R6, (R9) ;R6, TERM_DESC ; 0850 BRB 13$ ;13$ ; 11$: BLBC -28(R8), 12$ ;SYS_COMMAND_OPEN, 12$ ; 0859 MOVL -4(R8), R0 ;SYS_COMMAND_DESC+4, R0 ; 0863 MOVC5 -8(R8), (R0), #0, #16, (R8) ;SYS_COMMAND_DESC, (R0), #0, #16, TERM_NAME ; 0864 MOVW -40(R8), (R9) ;SYS_OUTPUT_DESC, TERM_DESC ; 0865 BRB 13$ ;13$ ; 12$: MOVZWL 8(R9), R0 ;JOB_TERM_DESC, R0 ; 0873 MOVW R0, (R9) ;R0, TERM_DESC ; MOVL 12(R9), R1 ;JOB_TERM_DESC+4, R1 ; 0875 MOVC5 R0, (R1), #0, #16, (R8) ;R0, (R1), #0, #16, TERM_NAME ; 0876 13$: MOVZWL (R9), R0 ;TERM_DESC, R0 ; 0891 CLRB (R8)[R0] ;TERM_NAME[R0] ; CLRQ -(SP) ;-(SP) ; 0892 PUSHAB -72(R8) ;TERM_CHAN ; PUSHL R9 ;R9 ; CALLS #4, G^SYS$ASSIGN ;#4, SYS$ASSIGN ; MOVL R0, R7 ;R0, STATUS ; PUSHL #2 ;#2 ; 0893 PUSHAB 156(R10) ;P.AAQ ; CALLS #2, G^U.40 ;#2, U.40 ; BLBC R7, 14$ ;STATUS, 14$ ; 0895 MOVL #1, 32(R8) ;#1, TERM_OPEN_FLAG ; 0905 MOVZWL 196(R10), -(SP) ;DEFTRM_TEXT, -(SP) ; 0906 PUSHL 200(R10) ;DEFTRM_TEXT+4 ; CALLS #2, G^U.40 ;#2, U.40 ; MOVZWL (R9), -(SP) ;TERM_DESC, -(SP) ; 0907 PUSHL R8 ;R8 ; BRB 15$ ;15$ ; 14$: CLRL 32(R8) ;TERM_OPEN_FLAG ; 0918 CLRW (R9) ;TERM_DESC ; 0919 MOVZWL 244(R10), -(SP) ;NODEFTRM_TEXT, -(SP) ; 0920 PUSHL 248(R10) ;NODEFTRM_TEXT+4 ; 15$: CALLS #2, G^U.40 ;#2, U.40 ; PUSHL #2 ;#2 ; 0923 PUSHAB 252(R10) ;P.AAV ; CALLS #2, G^U.40 ;#2, U.40 ; CLRL 24(R9) ;TERM_FLAG ; 0927 MOVL #48, 16(R9) ;#48, TRANS_DELAY ; 0928 BLBC 32(R8), 18$ ;TERM_OPEN_FLAG, 18$ ; 0934 CLRQ -(SP) ;-(SP) ; 0938 CLRQ -(SP) ;-(SP) ; PUSHL #12 ;#12 ; PUSHAB 996(R8) ;OLD_TERM_CHAR ; CLRQ -(SP) ;-(SP) ; PUSHAB 988(R8) ;OLD_PARITY ; PUSHL #39 ;#39 ; PUSHL -72(R8) ;TERM_CHAN ; CLRL -(SP) ;-(SP) ; CALLS #12, G^SYS$QIOW ;#12, SYS$QIOW ; MOVL R0, R7 ;R0, STATUS ; BLBC R7, 18$ ;STATUS, 18$ ; 0940 MOVZBL 994(R8), R0 ;OLD_PARITY+6, R0 ; 0943 BBC #6, R0, 17$ ;#6, R0, 17$ ; TSTB R0 ;R0 ; 0946 BGEQ 16$ ;16$ ; MOVL #3, G^PARITY_TYPE ;#3, PARITY_TYPE ; 0948 RET ; ; 16$: MOVL #2, G^PARITY_TYPE ;#2, PARITY_TYPE ; 0950 RET ; ; 0946 17$: CLRL G^PARITY_TYPE ;PARITY_TYPE ; 0953 18$: RET ; ; 0957 ; Routine Size: 665 bytes, Routine Base: $CODE$ + 0000 ; 0958 1 ; 0959 1 %SBTTL 'SET_TRANS_TERM - Set new transfer terminal line' ; 0960 1 ; 0961 1 GLOBAL ROUTINE SET_TRANS_TERM (NEW_NAME) = ; 0962 1 ; 0963 1 !++ ; 0964 1 ! FUNCTIONAL DESCRIPTION: ; 0965 1 ! ; 0966 1 ! This routine will validate the terminal name that a user wishes to set ; 0967 1 ! as the transfer line. If the name is valid, it will store the physical ; 0968 1 ! name in TERM_DESC, and open the new terminal line. ; 0969 1 ! ; 0970 1 ! CALLING SEQUENCE: ; 0971 1 ! ; 0972 1 ! STATUS = SET_TRANS_TERM (NEW_NAME); ; 0973 1 ! ; 0974 1 ! INPUT PARAMETERS: ; 0975 1 ! ; 0976 1 ! NEW_NAME - Descriptor for new terminal name. ; 0977 1 ! ; 0978 1 ! IMPLICIT INPUTS: ; 0979 1 ! ; 0980 1 ! TERM_OPEN_FLAG, TERM_CHAN ; 0981 1 ! ; 0982 1 ! OUPTUT PARAMETERS: ; 0983 1 ! ; 0984 1 ! None. ; 0985 1 ! ; 0986 1 ! IMPLICIT OUTPUTS: ; 0987 1 ! ; 0988 1 ! None. ; 0989 1 ! ; 0990 1 ! COMPLETION CODES: ; 0991 1 ! ; 0992 1 ! True/false status value - error code ; 0993 1 ! ; 0994 1 ! SIDE EFFECTS: ; 0995 1 ! ; 0996 1 ! None. ; 0997 1 ! ; 0998 1 !-- ; 0999 1 ; 1000 2 BEGIN ; 1001 2 ; 1002 2 MAP ; 1003 2 NEW_NAME : REF BLOCK [8, BYTE]; ! Descriptor for new name ; 1004 2 ; 1005 2 LOCAL ; 1006 2 NEW_CHAN, ! Temp for channel to new terminal ; 1007 2 RSL_DESC : BLOCK [8, BYTE], ! Descriptor for physical name ; 1008 2 RSL_NAME : VECTOR [TERM_NAME_SIZE, BYTE], ! String of resulting name ; 1009 2 DEV_TYPE, ! Device type ; 1010 2 STATUS; ! Random status values ; 1011 2 ; 1012 2 ! ; 1013 2 ! Set up descriptor ; 1014 2 ! ; 1015 2 RSL_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 1016 2 RSL_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 1017 2 RSL_DESC [DSC$W_LENGTH] = TERM_NAME_SIZE; ! Maximum length ; 1018 2 RSL_DESC [DSC$A_POINTER] = RSL_NAME; ! Where to store name ; 1019 2 STATUS = GET_DEV_CHAR (.NEW_NAME, RSL_DESC, DEV_TYPE); ; 1020 2 ; 1021 2 IF NOT .STATUS THEN RETURN .STATUS; ; 1022 2 ; 1023 2 IF .DEV_TYPE NEQ DC$_TERM THEN RETURN KER_LINTERM; ; 1024 2 ; 1025 2 ! ; 1026 2 ! The device is a terminal, now make sure we can get it. ; 1027 2 ! ; 1028 2 STATUS = $ASSIGN (CHAN = NEW_CHAN, DEVNAM = RSL_DESC); ; 1029 2 ; 1030 2 IF NOT .STATUS THEN RETURN .STATUS; ; 1031 2 ; 1032 2 ! ; 1033 2 ! We have the new terminal. Deassign the old one and copy the new data ; 1034 2 ! ; 1035 2 $DASSGN (CHAN = .TERM_CHAN); ; 1036 2 TERM_CHAN = .NEW_CHAN; ; 1037 2 CH$COPY (.RSL_DESC [DSC$W_LENGTH], CH$PTR (RSL_NAME), CHR_NUL, TERM_NAME_SIZE, ; 1038 2 CH$PTR (TERM_NAME)); ; 1039 2 TERM_DESC [DSC$W_LENGTH] = .RSL_DESC [DSC$W_LENGTH]; ; 1040 2 RETURN KER_NORMAL; ; 1041 1 END; ! End of SET_TRANS_TERM .EXTRN SYS$DASSGN .ENTRY SET_TRANS_TERM, ^M ;SET_TRANS_TERM, Save R2,R3,R4,R5,R6 ; 0961 MOVAB G^U.4, R6 ;U.4, R6 ; SUBL2 #32, SP ;#32, SP ; MOVL #17694736, 24(SP) ;#17694736, RSL_DESC ; 1017 MOVAB 8(SP), 28(SP) ;RSL_NAME, RSL_DESC+4 ; 1018 PUSHL SP ;SP ; 1019 PUSHAB 28(SP) ;RSL_DESC ; PUSHL 4(AP) ;NEW_NAME ; CALLS #3, G^U.41 ;#3, U.41 ; BLBC R0, 2$ ;STATUS, 2$ ; 1021 CMPL (SP), #66 ;DEV_TYPE, #66 ; 1023 BEQL 1$ ;1$ ; MOVL #134316242, R0 ;#134316242, R0 ; RET ; ; 1$: CLRQ -(SP) ;-(SP) ; 1028 PUSHAB 12(SP) ;NEW_CHAN ; PUSHAB 36(SP) ;RSL_DESC ; CALLS #4, G^SYS$ASSIGN ;#4, SYS$ASSIGN ; BLBC R0, 2$ ;STATUS, 2$ ; 1030 PUSHL (R6) ;TERM_CHAN ; 1035 CALLS #1, G^SYS$DASSGN ;#1, SYS$DASSGN ; MOVL 4(SP), (R6) ;NEW_CHAN, TERM_CHAN ; 1036 MOVC5 24(SP), 8(SP), #0, #16, 72(R6) ;RSL_DESC, RSL_NAME, #0, #16, TERM_NAME ; 1038 MOVW 24(SP), G^TERM_DESC ;RSL_DESC, TERM_DESC ; 1039 MOVL #134316043, R0 ;#134316043, R0 ; 1040 2$: RET ; ; 1041 ; Routine Size: 116 bytes, Routine Base: $CODE$ + 0299 ; 1042 1 ; 1043 1 %SBTTL 'TERM_DUMP - This routine will dump text on the terminal' ; 1044 1 ; 1045 1 GLOBAL ROUTINE TERM_DUMP (BUFFER_ADDRESS, BUFFER_COUNT) : NOVALUE = ; 1046 1 ; 1047 1 !++ ; 1048 1 ! FUNCTIONAL DESCRIPTION: ; 1049 1 ! ; 1050 1 ! This routine will dump the text specified on the user's terminal. ; 1051 1 ! It will then return to the caller. ; 1052 1 ! ; 1053 1 ! CALLING SEQUENCE: ; 1054 1 ! ; 1055 1 ! TERM_DUMP( TEXT-BUFFER-ADDRESS, COUNT) ; 1056 1 ! ; 1057 1 ! INPUT PARAMETERS: ; 1058 1 ! ; 1059 1 ! TEXT-BUFFER-ADDRESS - Address of the buffer containing the characters. ; 1060 1 ! ; 1061 1 ! COUNT - Count of the characters in the buffer. ; 1062 1 ! ; 1063 1 ! IMPLICIT INPUTS: ; 1064 1 ! ; 1065 1 ! None. ; 1066 1 ! ; 1067 1 ! OUPTUT PARAMETERS: ; 1068 1 ! ; 1069 1 ! None. ; 1070 1 ! ; 1071 1 ! IMPLICIT OUTPUTS: ; 1072 1 ! ; 1073 1 ! None. ; 1074 1 ! ; 1075 1 ! COMPLETION CODES: ; 1076 1 ! ; 1077 1 ! None. ; 1078 1 ! ; 1079 1 ! SIDE EFFECTS: ; 1080 1 ! ; 1081 1 ! None. ; 1082 1 ! ; 1083 1 !-- ; 1084 1 ; 1085 2 BEGIN ; 1086 2 ; 1087 2 LOCAL ; 1088 2 TEXT_DESC : BLOCK [8, BYTE]; ; 1089 2 ; 1090 2 IF NOT .CONNECT_FLAG ; 1091 2 THEN ; 1092 3 BEGIN ; 1093 3 ; 1094 3 IF .SYS_OUTPUT_OPEN ; 1095 3 THEN ; P 1096 3 $QIOW (CHAN = .SYS_OUTPUT_CHAN, EFN = CONS_O_EFN, ; 1097 4 FUNC = IO$_WRITEVBLK, P1 = .BUFFER_ADDRESS, P2 = .BUFFER_COUNT, P4 = 0) ; 1098 3 ELSE ; 1099 4 BEGIN ; 1100 4 TEXT_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 1101 4 TEXT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 1102 4 TEXT_DESC [DSC$W_LENGTH] = .BUFFER_COUNT; ; 1103 4 TEXT_DESC [DSC$A_POINTER] = .BUFFER_ADDRESS; ; 1104 4 LIB$PUT_OUTPUT (TEXT_DESC); ; 1105 3 END; ; 1106 3 ; 1107 2 END; ; 1108 2 ; 1109 1 END; ! End of TERM_DUMP U.40: .ENTRY TERM_DUMP, ^M<> ;TERM_DUMP, Save nothing ; 1045 SUBL2 #8, SP ;#8, SP ; BLBS G^CONNECT_FLAG, 2$ ;CONNECT_FLAG, 2$ ; 1090 BLBC G^U.7, 1$ ;U.7, 1$ ; 1094 CLRQ -(SP) ;-(SP) ; 1097 CLRQ -(SP) ;-(SP) ; MOVQ 4(AP), -(SP) ;BUFFER_ADDRESS, -(SP) ; CLRQ -(SP) ;-(SP) ; MOVQ #48, -(SP) ;#48, -(SP) ; PUSHL G^U.6 ;U.6 ; PUSHL #6 ;#6 ; CALLS #12, G^SYS$QIOW ;#12, SYS$QIOW ; RET ; ; 1$: MOVW #270, 2(SP) ;#270, TEXT_DESC+2 ; 1101 MOVW 8(AP), (SP) ;BUFFER_COUNT, TEXT_DESC ; 1102 MOVL 4(AP), 4(SP) ;BUFFER_ADDRESS, TEXT_DESC+4 ; 1103 PUSHL SP ;SP ; 1104 CALLS #1, G^LIB$PUT_OUTPUT ;#1, LIB$PUT_OUTPUT ; 2$: RET ; ; 1109 ; Routine Size: 73 bytes, Routine Base: $CODE$ + 030D ; 1110 1 ; 1111 1 %SBTTL 'DBG_DUMP - This routine will dump text on the terminal' ; 1112 1 ; 1113 1 GLOBAL ROUTINE DBG_DUMP (BUFFER_ADDRESS, BUFFER_COUNT) : NOVALUE = ; 1114 1 ; 1115 1 !++ ; 1116 1 ! FUNCTIONAL DESCRIPTION: ; 1117 1 ! ; 1118 1 ! This routine will dump the text specified on the user's terminal. ; 1119 1 ! It will then return to the caller. ; 1120 1 ! ; 1121 1 ! CALLING SEQUENCE: ; 1122 1 ! ; 1123 1 ! DBG_DUMP( TEXT-BUFFER-ADDRESS, COUNT) ; 1124 1 ! ; 1125 1 ! INPUT PARAMETERS: ; 1126 1 ! ; 1127 1 ! TEXT-BUFFER-ADDRESS - Address of the buffer containing the characters. ; 1128 1 ! ; 1129 1 ! COUNT - Count of the characters in the buffer. ; 1130 1 ! ; 1131 1 ! IMPLICIT INPUTS: ; 1132 1 ! ; 1133 1 ! None. ; 1134 1 ! ; 1135 1 ! OUPTUT PARAMETERS: ; 1136 1 ! ; 1137 1 ! None. ; 1138 1 ! ; 1139 1 ! IMPLICIT OUTPUTS: ; 1140 1 ! ; 1141 1 ! None. ; 1142 1 ! ; 1143 1 ! COMPLETION CODES: ; 1144 1 ! ; 1145 1 ! None. ; 1146 1 ! ; 1147 1 ! SIDE EFFECTS: ; 1148 1 ! ; 1149 1 ! None. ; 1150 1 ! ; 1151 1 !-- ; 1152 1 ; 1153 2 BEGIN ; 1154 2 ; 1155 2 LOCAL ; 1156 2 STATUS, ! Status from $PUT ; 1157 2 TEXT_DESC : BLOCK [8, BYTE]; ; 1158 2 ; 1159 2 IF NOT .CONNECT_FLAG AND NOT .DEBUG_REDIRECTED ! Check where debugging should go ; 1160 2 THEN ; 1161 3 BEGIN ; 1162 3 ; 1163 3 IF .SYS_OUTPUT_OPEN ; 1164 3 THEN ; P 1165 3 $QIOW (CHAN = .SYS_OUTPUT_CHAN, EFN = CONS_O_EFN, ; 1166 4 FUNC = IO$_WRITEVBLK OR IO$M_NOFORMAT, P1 = .BUFFER_ADDRESS, P2 = .BUFFER_COUNT) ; 1167 3 ELSE ; 1168 4 BEGIN ; 1169 4 TEXT_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 1170 4 TEXT_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 1171 4 TEXT_DESC [DSC$W_LENGTH] = .BUFFER_COUNT; ; 1172 4 TEXT_DESC [DSC$A_POINTER] = .BUFFER_ADDRESS; ; 1173 4 LIB$PUT_OUTPUT (TEXT_DESC); ; 1174 3 END; ; 1175 3 ; 1176 3 END ; 1177 2 ELSE ; 1178 2 ; 1179 2 IF .DEBUG_REDIRECTED ; 1180 2 THEN ; 1181 3 BEGIN ; 1182 3 ; 1183 3 EXTERNAL ROUTINE ; 1184 3 LOG_CHAR, ! Routine to write a character to log file ; 1185 3 LOG_CLOSE; ! Routine to close log file ; 1186 3 ; 1187 3 LOCAL ; 1188 3 POINTER; ; 1189 3 ; 1190 3 POINTER = CH$PTR (.BUFFER_ADDRESS); ; 1191 3 ; 1192 3 DECR I FROM .BUFFER_COUNT TO 1 DO ; 1193 3 ; 1194 3 IF NOT LOG_CHAR (CH$RCHAR_A (POINTER), DEBUG_RAB) ; 1195 3 THEN ; 1196 4 BEGIN ; 1197 4 LOG_CLOSE (DEBUG_FAB, DEBUG_RAB); ; 1198 4 DEBUG_REDIRECTED = FALSE; ; 1199 3 END; ; 1200 3 ; 1201 2 END; ; 1202 2 ; 1203 1 END; ! End of DBG_DUMP .EXTRN LOG_CHAR, LOG_CLOSE .ENTRY DBG_DUMP, ^M ;DBG_DUMP, Save R2,R3,R4 ; 1113 MOVAB G^U.25, R4 ;U.25, R4 ; SUBL2 #8, SP ;#8, SP ; BLBS G^CONNECT_FLAG, 2$ ;CONNECT_FLAG, 2$ ; 1159 BLBS (R4), 3$ ;DEBUG_REDIRECTED, 3$ ; BLBC -664(R4), 1$ ;SYS_OUTPUT_OPEN, 1$ ; 1163 CLRQ -(SP) ;-(SP) ; 1166 CLRQ -(SP) ;-(SP) ; MOVQ 4(AP), -(SP) ;BUFFER_ADDRESS, -(SP) ; CLRQ -(SP) ;-(SP) ; CLRL -(SP) ;-(SP) ; MOVZWL #304, -(SP) ;#304, -(SP) ; PUSHL -668(R4) ;SYS_OUTPUT_CHAN ; PUSHL #6 ;#6 ; CALLS #12, G^SYS$QIOW ;#12, SYS$QIOW ; RET ; ; 1$: MOVW #270, 2(SP) ;#270, TEXT_DESC+2 ; 1170 MOVW 8(AP), (SP) ;BUFFER_COUNT, TEXT_DESC ; 1171 MOVL 4(AP), 4(SP) ;BUFFER_ADDRESS, TEXT_DESC+4 ; 1172 PUSHL SP ;SP ; 1173 CALLS #1, G^LIB$PUT_OUTPUT ;#1, LIB$PUT_OUTPUT ; RET ; ; 2$: BLBC (R4), 6$ ;DEBUG_REDIRECTED, 6$ ; 1179 3$: MOVL 4(AP), R3 ;BUFFER_ADDRESS, POINTER ; 1190 ADDL3 #1, 8(AP), R2 ;#1, BUFFER_COUNT, I ; 1192 BRB 5$ ;5$ ; 4$: PUSHAB -200(R4) ;DEBUG_RAB ; 1194 MOVZBL (R3)+, -(SP) ;(POINTER)+, -(SP) ; CALLS #2, G^LOG_CHAR ;#2, LOG_CHAR ; BLBS R0, 5$ ;R0, 5$ ; PUSHAB -200(R4) ;DEBUG_RAB ; 1197 PUSHAB -280(R4) ;DEBUG_FAB ; CALLS #2, G^LOG_CLOSE ;#2, LOG_CLOSE ; CLRL (R4) ;DEBUG_REDIRECTED ; 1198 5$: SOBGTR R2, 4$ ;I, 4$ ; 6$: RET ; ; 1203 ; Routine Size: 135 bytes, Routine Base: $CODE$ + 0356 ; 1204 1 ; 1205 1 %SBTTL 'GET_COMMAND - Get a command line' ; 1206 1 ; 1207 1 GLOBAL ROUTINE GET_COMMAND (CMD_DESC, PROMPT_DESC, CMD_LENGTH, ECHO_FLAG) = ; 1208 1 ; 1209 1 !++ ; 1210 1 ! FUNCTIONAL DESCRIPTION: ; 1211 1 ! ; 1212 1 ! This routine will get a command line from SYS$COMMAND:. If ; 1213 1 ! SYS$COMMAND is a terminal, it will do input using a QIO, which will ; 1214 1 ! allow input without echo if desired. If SYS$COMMAND is not a terminal, ; 1215 1 ! it will use LIB$GET_COMMAND. ; 1216 1 ! ; 1217 1 ! CALLING SEQUENCE: ; 1218 1 ! ; 1219 1 ! STATUS = GET_COMMAND (CMD_DESC, PROMPT_DESC, CMD_LENGTH, ECHO_FLAG); ; 1220 1 ! ; 1221 1 ! INPUT PARAMETERS: ; 1222 1 ! ; 1223 1 ! CMD_DESC - String descriptor for command being input ; 1224 1 ! PROMPT_DESC - String descriptor for prompt ; 1225 1 ! ECHO_FLAG - True if input should be echoed, false if not ; 1226 1 ! ; 1227 1 ! IMPLICIT INPUTS: ; 1228 1 ! ; 1229 1 ! SYS_COMMAND_OPEN - Flag whether SYS$COMMAND is open ; 1230 1 ! SYS_COMMAND_CHAN - Channel SYS$COMMAND is open on, if open ; 1231 1 ! ; 1232 1 ! OUPTUT PARAMETERS: ; 1233 1 ! ; 1234 1 ! CMD_LENGTH - Actual length of command input ; 1235 1 ! ; 1236 1 ! IMPLICIT OUTPUTS: ; 1237 1 ! ; 1238 1 ! None. ; 1239 1 ! ; 1240 1 ! COMPLETION CODES: ; 1241 1 ! ; 1242 1 ! Returns status value, true unless error has occured. ; 1243 1 ! ; 1244 1 ! SIDE EFFECTS: ; 1245 1 ! ; 1246 1 ! None. ; 1247 1 ! ; 1248 1 !-- ; 1249 1 ; 1250 2 BEGIN ; 1251 2 ; 1252 2 MAP ; 1253 2 CMD_DESC : REF BLOCK [8, BYTE], ! Where to put input ; 1254 2 PROMPT_DESC : REF BLOCK [8, BYTE]; ! Prompt string ; 1255 2 ; 1256 2 EXTERNAL ROUTINE ; 1257 2 TT_CRLF : NOVALUE, ! Type a CRLF ; 1258 2 STR$UPCASE : ADDRESSING_MODE (GENERAL), ! Upcase a string ; 1259 2 LIB$GET_COMMAND : ADDRESSING_MODE (GENERAL); ! Get string from SYS$COMMAND ; 1260 2 ; 1261 2 LOCAL ; 1262 2 QIO_FUNC, ! Function for QIO ; 1263 2 IOSB : VECTOR [4, WORD], ! IOSB for QIO ; 1264 2 STATUS; ! Random status values ; 1265 2 ; 1266 2 IF .SYS_COMMAND_OPEN ; 1267 2 THEN ; 1268 3 BEGIN ; 1269 3 QIO_FUNC = IO$_READPROMPT; ! Assume just read with prompt ; 1270 3 ; 1271 3 IF NOT .ECHO_FLAG THEN QIO_FUNC = IO$_READPROMPT OR IO$M_NOECHO; ! Don't echo input ; 1272 3 ; P 1273 3 STATUS = $QIOW (CHAN = .SYS_COMMAND_CHAN, FUNC = .QIO_FUNC, IOSB = IOSB, ; P 1274 3 P1 = .CMD_DESC [DSC$A_POINTER], P2 = .CMD_DESC [DSC$W_LENGTH], ; 1275 3 P5 = .PROMPT_DESC [DSC$A_POINTER], P6 = .PROMPT_DESC [DSC$W_LENGTH]); ; 1276 3 ; 1277 3 IF NOT .STATUS THEN RETURN .STATUS; ; 1278 3 ; 1279 3 ! ; 1280 3 ! If we didn't echo, then dump a CRLF so we look nice ; 1281 3 ! ; 1282 3 ; 1283 3 IF NOT .ECHO_FLAG THEN TT_CRLF (); ; 1284 3 ; 1285 3 IF .IOSB [0] ; 1286 3 THEN ; 1287 4 BEGIN ; 1288 4 .CMD_LENGTH = .IOSB [1]; ! Get actual length input ; 1289 4 ; 1290 4 IF .IOSB [3] EQL 1 AND .IOSB [2] EQL CHR_CTL_Z THEN RETURN RMS$_EOF; ; 1291 4 ; 1292 3 END; ; 1293 3 ; 1294 3 ! ; 1295 3 ! Upcase the resulting string ; 1296 3 ! ; 1297 3 STATUS = STR$UPCASE (.CMD_DESC, .CMD_DESC); ; 1298 3 ; 1299 3 IF NOT .STATUS THEN RETURN .STATUS; ; 1300 3 ; 1301 3 RETURN .IOSB [0]; ! Return resulting status ; 1302 2 END; ; 1303 2 ; 1304 2 ! ; 1305 2 ! Here if SYS$COMMAND is not open. Get the command via LIB$GET_COMMAND. ; 1306 2 ! ; 1307 2 RETURN LIB$GET_COMMAND (.CMD_DESC, .PROMPT_DESC, .CMD_LENGTH); ; 1308 1 END; ! End of GET_COMMAND .EXTRN TT_CRLF, STR$UPCASE, LIB$GET_COMMAND .ENTRY GET_COMMAND, ^M ;GET_COMMAND, Save R2,R3 ; 1207 SUBL2 #8, SP ;#8, SP ; BLBC G^U.11, 6$ ;U.11, 6$ ; 1266 MOVL #55, R1 ;#55, QIO_FUNC ; 1269 BLBS 16(AP), 1$ ;ECHO_FLAG, 1$ ; 1271 MOVZBL #119, R1 ;#119, QIO_FUNC ; 1$: MOVL 8(AP), R0 ;PROMPT_DESC, R0 ; 1275 MOVZWL (R0), -(SP) ;(R0), -(SP) ; PUSHL 4(R0) ;4(R0) ; CLRQ -(SP) ;-(SP) ; MOVL 4(AP), R2 ;CMD_DESC, R2 ; MOVZWL (R2), -(SP) ;(R2), -(SP) ; PUSHL 4(R2) ;4(R2) ; CLRQ -(SP) ;-(SP) ; PUSHAB 32(SP) ;IOSB ; PUSHL R1 ;QIO_FUNC ; PUSHL G^U.10 ;U.10 ; CLRL -(SP) ;-(SP) ; CALLS #12, G^SYS$QIOW ;#12, SYS$QIOW ; MOVL R0, R3 ;R0, STATUS ; BLBC R3, 4$ ;STATUS, 4$ ; 1277 BLBS 16(AP), 2$ ;ECHO_FLAG, 2$ ; 1283 CALLS #0, G^TT_CRLF ;#0, TT_CRLF ; 2$: BLBC (SP), 3$ ;IOSB, 3$ ; 1285 MOVZWL 2(SP), @12(AP) ;IOSB+2, @CMD_LENGTH ; 1288 CMPW 6(SP), #1 ;IOSB+6, #1 ; 1290 BNEQ 3$ ;3$ ; CMPW 4(SP), #26 ;IOSB+4, #26 ; BNEQ 3$ ;3$ ; MOVL #98938, R0 ;#98938, R0 ; RET ; ; 3$: PUSHL R2 ;R2 ; 1297 PUSHL R2 ;R2 ; CALLS #2, G^STR$UPCASE ;#2, STR$UPCASE ; MOVL R0, R3 ;R0, STATUS ; BLBS R3, 5$ ;STATUS, 5$ ; 1299 4$: MOVL R3, R0 ;STATUS, R0 ; RET ; ; 5$: MOVZWL (SP), R0 ;IOSB, R0 ; 1301 RET ; ; 6$: MOVQ 8(AP), -(SP) ;PROMPT_DESC, -(SP) ; 1307 PUSHL 4(AP) ;CMD_DESC ; CALLS #3, G^LIB$GET_COMMAND ;#3, LIB$GET_COMMAND ; RET ; ; 1308 ; Routine Size: 152 bytes, Routine Base: $CODE$ + 03DD ; 1309 1 ; 1310 1 %SBTTL 'Communcations line -- TERM_OPEN' ; 1311 1 ; 1312 1 GLOBAL ROUTINE TERM_OPEN (POST_QIOS) = ; 1313 1 ; 1314 1 !++ ; 1315 1 ! FUNCTIONAL DESCRIPTION: ; 1316 1 ! ; 1317 1 ! This routine will assign a channel that is used in the CONNECT ; 1318 1 ! processing and to send/receive a file from. ; 1319 1 ! ; 1320 1 ! CALLING SEQUENCE: ; 1321 1 ! ; 1322 1 ! TERM_OPEN(POST_QIOS); ; 1323 1 ! ; 1324 1 ! INPUT PARAMETERS: ; 1325 1 ! ; 1326 1 ! POST_QIOS - True if initial read QIO's should be posted. ; 1327 1 ! ; 1328 1 ! IMPLICIT INPUTS: ; 1329 1 ! ; 1330 1 ! TERM_DESC - Descriptor of a vector of ASCII characters that represent ; 1331 1 ! the name of the terminal to use. ; 1332 1 ! ; 1333 1 ! TERM_CHAN - Channel open to terminal if TERM_OPEN_FLAG is true. ; 1334 1 ! ; 1335 1 ! OUTPUT PARAMETERS: ; 1336 1 ! ; 1337 1 ! None. ; 1338 1 ! ; 1339 1 ! IMPLICIT OUTPUTS: ; 1340 1 ! ; 1341 1 ! TERM_CHAN - Channel number of the terminal line we are using. ; 1342 1 ! ; 1343 1 ! COMPLETION CODES: ; 1344 1 ! ; 1345 1 ! SS$_NORMAL or error condition. ; 1346 1 ! ; 1347 1 ! SIDE EFFECTS: ; 1348 1 ! ; 1349 1 ! None. ; 1350 1 ! ; 1351 1 !-- ; 1352 1 ; 1353 2 BEGIN ; 1354 2 ; 1355 2 EXTERNAL ROUTINE ; 1356 2 LOG_FAOL, ! Write FAOL style text ; 1357 2 LOG_OPEN; ! Open a log file ; 1358 2 ; 1359 2 EXTERNAL ; 1360 2 TRANSACTION_OPEN, ; 1361 2 TRANSACTION_DESC : BLOCK [8, BYTE], ; 1362 2 TRANSACTION_FAB : $FAB_DECL, ; 1363 2 TRANSACTION_RAB : $RAB_DECL; ; 1364 2 ; 1365 2 LOCAL ; 1366 2 STATUS; ; 1367 2 ; 1368 2 ! ; 1369 2 ! If the terminal is not open, we must open it first. ; 1370 2 ! ; 1371 2 ; 1372 2 IF NOT .TERM_OPEN_FLAG ; 1373 2 THEN ; 1374 2 ; 1375 2 IF .TERM_DESC [DSC$W_LENGTH] GTR 0 ; 1376 2 THEN ; 1377 3 BEGIN ; 1378 3 STATUS = SET_TRANS_TERM (TERM_DESC); ; 1379 3 ; 1380 3 IF NOT .STATUS THEN RETURN .STATUS; ; 1381 3 ; 1382 3 END ; 1383 2 ELSE ; 1384 2 RETURN KER_LINTERM; ; 1385 2 ; 1386 2 ! ; 1387 2 ! Set up connect flag properly ; 1388 2 ! ; 1389 2 ; 1390 2 IF CH$NEQ (.SYS_OUTPUT_DESC [DSC$W_LENGTH], CH$PTR (.SYS_OUTPUT_DESC [DSC$A_POINTER]), ; 1391 2 .TERM_DESC [DSC$W_LENGTH], CH$PTR (TERM_NAME), CHR_NUL) OR NOT .SYS_OUTPUT_OPEN ; 1392 2 THEN ; 1393 2 CONNECT_FLAG = FALSE ; 1394 2 ELSE ; 1395 2 CONNECT_FLAG = TRUE; ; 1396 2 ; 1397 2 ! ; 1398 2 ! If we aren't connected, remember the channel to use for the console I/O ; 1399 2 ! ; 1400 2 ; 1401 2 IF NOT .CONNECT_FLAG AND .SYS_OUTPUT_OPEN THEN CONS_CHAN = .SYS_OUTPUT_CHAN; ; 1402 2 ; 1403 2 ! ; 1404 2 ! Get current settings for transfer terminal ; 1405 2 ! ; P 1406 2 STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SENSEMODE, P1 = OLD_TERM_CHAR, ; 1407 2 P2 = TC$_CHAR_LENGTH, IOSB = OLD_PARITY); ; 1408 2 ; 1409 2 IF NOT .STATUS ; 1410 2 THEN ; 1411 3 BEGIN ; 1412 3 LIB$SIGNAL (.STATUS); ; 1413 3 RETURN .STATUS; ; 1414 2 END; ; 1415 2 ; 1416 2 NEW_TERM_CHAR [TC$_BFR_SIZE] = .OLD_TERM_CHAR [TC$_BFR_SIZE]; ; 1417 2 NEW_TERM_CHAR [TC$_TYPE] = .OLD_TERM_CHAR [TC$_TYPE]; ; 1418 2 NEW_TERM_CHAR [TC$_CLASS] = .OLD_TERM_CHAR [TC$_CLASS]; ; 1419 2 NEW_TERM_CHAR [TC$_PAGE_LEN] = .OLD_TERM_CHAR [TC$_PAGE_LEN]; ; 1420 3 NEW_TERM_CHAR [TC$_CHAR] = (.OLD_TERM_CHAR [TC$_CHAR] OR TT$M_NOBRDCST) AND NOT (TT$M_CRFILL OR ; 1421 2 TT$M_LFFILL OR TT$M_WRAP OR TT$M_NOTYPEAHD); ; 1422 2 ! We do not want to use eightbit if using parity ; 1423 2 ; 1424 2 IF .PARITY_TYPE EQL PR_NONE ; 1425 2 THEN ; 1426 2 NEW_TERM_CHAR [TC$_CHAR] = .NEW_TERM_CHAR [TC$_CHAR] OR TT$M_EIGHTBIT ; 1427 2 ELSE ; 1428 2 NEW_TERM_CHAR [TC$_CHAR] = .NEW_TERM_CHAR [TC$_CHAR] AND NOT TT$M_EIGHTBIT; ; 1429 2 ; 1430 2 NEW_TERM_CHAR [TC$_CHAR_2] = TT2$M_XON OR TT2$M_PASTHRU OR ; 1431 2 (.OLD_TERM_CHAR [TC$_CHAR_2] AND NOT TT2$M_FALLBACK); ; 1432 2 ; P 1433 2 STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SETMODE, P1 = NEW_TERM_CHAR, ; 1434 2 P2 = TC$_CHAR_LENGTH, P5 = TT$M_ALTRPAR); ; 1435 2 ; 1436 2 IF NOT .STATUS ; 1437 2 THEN ; 1438 3 BEGIN ; 1439 3 LIB$SIGNAL (.STATUS); ; 1440 3 RETURN .STATUS; ; 1441 2 END; ; 1442 2 ; 1443 2 TERM_FLAG = TRUE; ! Terminal now open ; 1444 2 TERM_FIRST_TIME = TRUE; ! Flag first time QIO should clear input ; 1445 2 FORCE_TIMEOUT = FALSE; ! Don't timeout for no reason ; 1446 2 FORCE_ABORT = FALSE; ! Don't abort yet ; 1447 2 ! ; 1448 2 ! Now post the initial receive QIO ; 1449 2 ! ; 1450 2 ; 1451 2 IF .POST_QIOS ! Need the QIO's? ; 1452 2 THEN ; 1453 3 BEGIN ; 1454 3 STATUS = DO_RECEIVE_QIO (); ; 1455 3 ; 1456 3 IF NOT .STATUS ; 1457 3 THEN ; 1458 4 BEGIN ; 1459 4 LIB$SIGNAL (.STATUS); ; 1460 4 RETURN KER_RECERR; ; 1461 3 END; ; 1462 3 ; 1463 3 ! ; 1464 3 ! Also post the QIO for the console ; 1465 3 ! ; 1466 3 ; 1467 3 IF NOT .CONNECT_FLAG AND .SYS_OUTPUT_OPEN ; 1468 3 THEN ; 1469 4 BEGIN ; 1470 4 STATUS = DO_CONS_QIO (); ; 1471 4 ; 1472 4 IF NOT .STATUS ; 1473 4 THEN ; 1474 5 BEGIN ; 1475 5 LIB$SIGNAL (.STATUS); ; 1476 5 $CANCEL (CHAN = .TERM_CHAN); ; 1477 5 $DASSGN (CHAN = .TERM_CHAN); ; 1478 5 RETURN KER_RECERR; ; 1479 4 END; ; 1480 4 ; 1481 3 END; ; 1482 3 ; 1483 2 END; ; 1484 2 ; 1485 2 ! ; 1486 2 ! Open any debugging log file ; 1487 2 ! ; 1488 2 ; 1489 2 IF .DEBUG_DESC [DSC$W_LENGTH] GTR 0 ; 1490 2 THEN ; 1491 2 ; 1492 2 IF LOG_OPEN (DEBUG_DESC, DEBUG_FAB, DEBUG_RAB) ; 1493 2 THEN ; 1494 2 DEBUG_REDIRECTED = TRUE ; 1495 2 ELSE ; 1496 2 DEBUG_REDIRECTED = FALSE ; 1497 2 ; 1498 2 ELSE ; 1499 2 DEBUG_REDIRECTED = FALSE; ; 1500 2 ; 1501 2 IF .TRANSACTION_DESC [DSC$W_LENGTH] GTR 0 ; 1502 2 THEN ; 1503 2 ; 1504 2 IF LOG_OPEN (TRANSACTION_DESC, TRANSACTION_FAB, TRANSACTION_RAB) ; 1505 2 THEN ; 1506 3 BEGIN ; 1507 3 TRANSACTION_OPEN = TRUE; ; 1508 3 LOG_FAOL (%ASCID'!-!-!11%D!/!-!%T!_Starting transaction log in file !AS!/', ; 1509 3 UPLIT (0, TRANSACTION_DESC), TRANSACTION_RAB); ; 1510 3 END ; 1511 2 ELSE ; 1512 2 TRANSACTION_OPEN = FALSE ; 1513 2 ; 1514 2 ELSE ; 1515 2 TRANSACTION_OPEN = FALSE; ; 1516 2 ; 1517 2 RETURN KER_NORMAL; ; 1518 1 END; ! End of TERM_OPEN .PSECT $PLIT$,NOWRT,NOEXE,2 .BLKB 2 P.AAX: .ASCII \!-!-!11%D!/!-!%T!_Starting transaction log in file !AS!/\ ; ; P.AAW: .LONG 17694776 ; ; .ADDRESS P.AAX ; ; P.AAY: .LONG 0 ; ; .ADDRESS TRANSACTION_DESC ; ; .EXTRN LOG_FAOL, LOG_OPEN, TRANSACTION_OPEN, TRANSACTION_DESC, TRANSACTION_FAB, TRANSACTION_RAB .EXTRN SYS$CANCEL .PSECT $CODE$,NOWRT,2 .ENTRY TERM_OPEN, ^M ; ; MOVAB G^TRANSACTION_DESC, R11 ;TRANSACTION_DESC, R11 ; MOVAB G^LOG_OPEN, R10 ;LOG_OPEN, R10 ; MOVAB G^SYS$QIOW, R9 ;SYS$QIOW, R9 ; MOVAB G^LIB$SIGNAL, R8 ;LIB$SIGNAL, R8 ; MOVAB G^CONNECT_FLAG, R7 ;CONNECT_FLAG, R7 ; MOVAB G^TERM_DESC, R6 ;TERM_DESC, R6 ; MOVAB G^U.31+4, R5 ;U.31+4, R5 ; BLBS -980(R5), 2$ ;TERM_OPEN_FLAG, 2$ ; 1372 TSTW (R6) ;TERM_DESC ; 1375 BEQL 1$ ;1$ ; PUSHL R6 ;R6 ; 1378 CALLS #1, W^SET_TRANS_TERM ;#1, SET_TRANS_TERM ; MOVL R0, R4 ;R0, STATUS ; BLBS R4, 2$ ;STATUS, 2$ ; 1380 BRW 10$ ;10$ ; 1$: MOVL #134316242, R0 ;#134316242, R0 ; 1384 RET ; ; 2$: MOVL -1048(R5), R0 ;SYS_OUTPUT_DESC+4, R0 ; 1390 CMPC5 -1052(R5), (R0), #0, (R6), -1012(R5) ;SYS_OUTPUT_DESC, (R0), #0, TERM_DESC, TERM_NAME ; BNEQ 3$ ;3$ ; BLBS -1072(R5), 4$ ;SYS_OUTPUT_OPEN, 4$ ; 1391 3$: CLRL (R7) ;CONNECT_FLAG ; 1393 BRB 5$ ;5$ ; 4$: MOVL #1, (R7) ;#1, CONNECT_FLAG ; 1395 5$: BLBS (R7), 6$ ;CONNECT_FLAG, 6$ ; 1401 BLBC -1072(R5), 6$ ;SYS_OUTPUT_OPEN, 6$ ; MOVL -1076(R5), -1080(R5) ;SYS_OUTPUT_CHAN, CONS_CHAN ; 6$: CLRQ -(SP) ;-(SP) ; 1407 CLRQ -(SP) ;-(SP) ; PUSHL #12 ;#12 ; PUSHAB -16(R5) ;OLD_TERM_CHAR ; CLRQ -(SP) ;-(SP) ; PUSHAB -24(R5) ;OLD_PARITY ; PUSHL #39 ;#39 ; PUSHL -1084(R5) ;TERM_CHAN ; CLRL -(SP) ;-(SP) ; CALLS #12, (R9) ;#12, SYS$QIOW ; MOVL R0, R4 ;R0, STATUS ; BLBC R4, 9$ ;STATUS, 9$ ; 1409 MOVL -16(R5), -4(R5) ;OLD_TERM_CHAR, NEW_TERM_CHAR ; 1418 MOVB -9(R5), 3(R5) ;OLD_TERM_CHAR+7, NEW_TERM_CHAR+7 ; 1419 EXTZV #0, #24, -12(R5), R0 ;#0, #24, OLD_TERM_CHAR+4, R0 ; 1420 BICL2 #3588, R0 ;#3588, R0 ; BISL3 #131072, R0, R1 ;#131072, R0, R1 ; INSV R1, #0, #24, (R5) ;R1, #0, #24, NEW_TERM_CHAR+4 ; TSTL G^PARITY_TYPE ;PARITY_TYPE ; 1424 BNEQ 7$ ;7$ ; EXTZV #0, #24, (R5), R0 ;#0, #24, NEW_TERM_CHAR+4, R0 ; 1426 INSV #1, #15, #1, R0 ;#1, #15, #1, R0 ; BRB 8$ ;8$ ; 7$: EXTZV #0, #24, (R5), R0 ;#0, #24, NEW_TERM_CHAR+4, R0 ; 1428 INSV #0, #15, #1, R0 ;#0, #15, #1, R0 ; 8$: INSV R0, #0, #24, (R5) ;R0, #0, #24, NEW_TERM_CHAR+4 ; BICL3 #16384, -8(R5), R0 ;#16384, OLD_TERM_CHAR+8, R0 ; 1431 BISL3 #262176, R0, 4(R5) ;#262176, R0, NEW_TERM_CHAR+8 ; 1430 MOVQ #32, -(SP) ;#32, -(SP) ; 1434 CLRQ -(SP) ;-(SP) ; PUSHL #12 ;#12 ; PUSHAB -4(R5) ;NEW_TERM_CHAR ; CLRQ -(SP) ;-(SP) ; MOVQ #35, -(SP) ;#35, -(SP) ; PUSHL -1084(R5) ;TERM_CHAN ; CLRL -(SP) ;-(SP) ; CALLS #12, (R9) ;#12, SYS$QIOW ; MOVL R0, R4 ;R0, STATUS ; BLBS R4, 11$ ;STATUS, 11$ ; 1436 9$: PUSHL R4 ;STATUS ; 1439 CALLS #1, (R8) ;#1, LIB$SIGNAL ; 10$: MOVL R4, R0 ;STATUS, R0 ; 1440 RET ; ; 11$: MOVL #1, 24(R6) ;#1, TERM_FLAG ; 1443 MOVL #1, -1088(R5) ;#1, TERM_FIRST_TIME ; 1444 CLRQ -1096(R5) ;FORCE_ABORT ; 1446 BLBC 4(AP), 14$ ;POST_QIOS, 14$ ; 1451 CALLS #0, G^U.42 ;#0, U.42 ; 1454 MOVL R0, R4 ;R0, STATUS ; BLBS R4, 12$ ;STATUS, 12$ ; 1456 PUSHL R4 ;STATUS ; 1459 CALLS #1, (R8) ;#1, LIB$SIGNAL ; BRB 13$ ;13$ ; 1460 12$: BLBS (R7), 14$ ;CONNECT_FLAG, 14$ ; 1467 BLBC -1072(R5), 14$ ;SYS_OUTPUT_OPEN, 14$ ; CALLS #0, G^U.43 ;#0, U.43 ; 1470 MOVL R0, R4 ;R0, STATUS ; BLBS R4, 14$ ;STATUS, 14$ ; 1472 PUSHL R4 ;STATUS ; 1475 CALLS #1, (R8) ;#1, LIB$SIGNAL ; PUSHL -1084(R5) ;TERM_CHAN ; 1476 CALLS #1, G^SYS$CANCEL ;#1, SYS$CANCEL ; PUSHL -1084(R5) ;TERM_CHAN ; 1477 CALLS #1, G^SYS$DASSGN ;#1, SYS$DASSGN ; 13$: MOVL #134316266, R0 ;#134316266, R0 ; 1478 RET ; ; 14$: TSTW -16(R6) ;DEBUG_DESC ; 1489 BEQL 15$ ;15$ ; PUSHAB -608(R5) ;DEBUG_RAB ; 1492 PUSHAB -688(R5) ;DEBUG_FAB ; PUSHAB -16(R6) ;DEBUG_DESC ; CALLS #3, (R10) ;#3, LOG_OPEN ; BLBC R0, 15$ ;R0, 15$ ; MOVL #1, -408(R5) ;#1, DEBUG_REDIRECTED ; 1494 BRB 16$ ;16$ ; 15$: CLRL -408(R5) ;DEBUG_REDIRECTED ; 1499 16$: TSTW (R11) ;TRANSACTION_DESC ; 1501 BEQL 17$ ;17$ ; PUSHAB G^TRANSACTION_RAB ;TRANSACTION_RAB ; 1504 PUSHAB G^TRANSACTION_FAB ;TRANSACTION_FAB ; PUSHL R11 ;R11 ; CALLS #3, (R10) ;#3, LOG_OPEN ; BLBC R0, 17$ ;R0, 17$ ; MOVL #1, G^TRANSACTION_OPEN ;#1, TRANSACTION_OPEN ; 1507 PUSHAB G^TRANSACTION_RAB ;TRANSACTION_RAB ; 1508 PUSHAB G^P.AAY ;P.AAY ; 1509 PUSHAB G^P.AAW ;P.AAW ; 1508 CALLS #3, G^LOG_FAOL ;#3, LOG_FAOL ; BRB 18$ ;18$ ; 17$: CLRL G^TRANSACTION_OPEN ;TRANSACTION_OPEN ; 1515 18$: MOVL #134316043, R0 ;#134316043, R0 ; 1517 RET ; ; 1518 ; Routine Size: 485 bytes, Routine Base: $CODE$ + 0475 ; 1519 1 ; 1520 1 %SBTTL 'Communications line -- TERM_CLOSE' ; 1521 1 ; 1522 1 GLOBAL ROUTINE TERM_CLOSE = ; 1523 1 ; 1524 1 !++ ; 1525 1 ! FUNCTIONAL DESCRIPTION: ; 1526 1 ! ; 1527 1 ! This routine will deassign the channel that was assigned by ; 1528 1 ! TERM_OPEN. ; 1529 1 ! ; 1530 1 ! CALLING SEQUENCE: ; 1531 1 ! ; 1532 1 ! TERM_CLOSE(); ; 1533 1 ! ; 1534 1 ! INPUT PARAMETERS: ; 1535 1 ! ; 1536 1 ! None. ; 1537 1 ! ; 1538 1 ! IMPLICIT INPUTS: ; 1539 1 ! ; 1540 1 ! TERM_CHAN - Channel number to deassign. ; 1541 1 ! ; 1542 1 ! OUTPUT PARAMETERS: ; 1543 1 ! ; 1544 1 ! None. ; 1545 1 ! ; 1546 1 ! IMPLICIT OUTPUTS: ; 1547 1 ! ; 1548 1 ! None. ; 1549 1 ! ; 1550 1 ! COMPLETION CODES: ; 1551 1 ! ; 1552 1 ! SS$_NORMAL or error condition. ; 1553 1 ! ; 1554 1 ! SIDE EFFECTS: ; 1555 1 ! ; 1556 1 ! None. ; 1557 1 ! ; 1558 1 !-- ; 1559 1 ; 1560 2 BEGIN ; 1561 2 ; 1562 2 EXTERNAL ROUTINE ; 1563 2 LOG_FAOL, ! Routine to dump FAOL string ; 1564 2 LOG_CLOSE; ! Routine to close log file ; 1565 2 ; 1566 2 EXTERNAL ; 1567 2 TRANSACTION_OPEN, ; 1568 2 TRANSACTION_DESC : BLOCK [8, BYTE], ; 1569 2 TRANSACTION_FAB, ; 1570 2 TRANSACTION_RAB; ; 1571 2 ; 1572 2 LOCAL ; 1573 2 PAR, ! Parity being set ; 1574 2 STATUS; ! Status returned by system service ; 1575 2 ; 1576 2 STATUS = $CANCEL (CHAN = .TERM_CHAN); ! Kill pending QIO ; 1577 2 ; 1578 2 IF .SYS_OUTPUT_OPEN THEN $CANCEL (CHAN = .CONS_CHAN); ; 1579 2 ; 1580 2 CONNECT_FLAG = FALSE; ; 1581 2 PAR = (.OLD_PARITY [6, 0, 8, 0] AND (TT$M_ODD OR TT$M_PARITY)) OR TT$M_ALTRPAR; ; 1582 2 ! Only set parity ; P 1583 2 STATUS = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_SETMODE, P1 = OLD_TERM_CHAR, ; 1584 2 P2 = TC$_CHAR_LENGTH, P4 = .OLD_PARITY [4, 0, 16, 0], P5 = .PAR); ; 1585 2 ; 1586 2 IF NOT .STATUS ; 1587 2 THEN ; 1588 3 BEGIN ; 1589 3 LIB$SIGNAL (.STATUS); ; 1590 3 RETURN .STATUS; ; 1591 2 END; ; 1592 2 ; 1593 2 ! ; 1594 2 ! Flag terminal parameters are reset ; 1595 2 ! ; 1596 2 TERM_FLAG = FALSE; ; 1597 2 ! ; 1598 2 ! Close the debugging log file ; 1599 2 ! ; 1600 2 ; 1601 2 IF .DEBUG_REDIRECTED ; 1602 2 THEN ; 1603 3 BEGIN ; 1604 3 LOG_CLOSE (DEBUG_FAB, DEBUG_RAB); ; 1605 3 DEBUG_REDIRECTED = FALSE; ; 1606 2 END; ; 1607 2 ; 1608 2 ! ; 1609 2 ! Close the transaction log ; 1610 2 ! ; 1611 2 ; 1612 2 IF .TRANSACTION_OPEN ; 1613 2 THEN ; 1614 3 BEGIN ; 1615 3 LOG_FAOL (%ASCID'!-!-!11%D!/!-!%T!_Closing transaction log file !AS!/', ; 1616 3 UPLIT (0, TRANSACTION_DESC), TRANSACTION_RAB); ; 1617 3 LOG_CLOSE (TRANSACTION_FAB, TRANSACTION_RAB); ; 1618 3 TRANSACTION_OPEN = FALSE; ; 1619 2 END; ; 1620 2 ; 1621 2 ! ; 1622 2 ! If all worked, say so ; 1623 2 ! ; 1624 2 RETURN KER_NORMAL ; 1625 1 END; ! End of TERM_CLOSE .PSECT $PLIT$,NOWRT,NOEXE,2 P.ABA: .ASCII \!-!-!11%D!/!-!%T!_Closing transaction log file !AS!/\ ; ; P.AAZ: .LONG 17694772 ; ; .ADDRESS P.ABA ; ; P.ABB: .LONG 0 ; ; .ADDRESS TRANSACTION_DESC ; ; .PSECT $CODE$,NOWRT,2 .ENTRY TERM_CLOSE, ^M ;TERM_CLOSE, Save R2,R3,R4,R5,R6,R7 ; 1522 MOVAB G^TRANSACTION_RAB, R7 ;TRANSACTION_RAB, R7 ; MOVAB G^TRANSACTION_OPEN, R6 ;TRANSACTION_OPEN, R6 ; MOVAB G^LOG_CLOSE, R5 ;LOG_CLOSE, R5 ; MOVAB G^SYS$CANCEL, R4 ;SYS$CANCEL, R4 ; MOVAB G^U.4, R3 ;U.4, R3 ; PUSHL (R3) ;TERM_CHAN ; 1576 CALLS #1, (R4) ;#1, SYS$CANCEL ; MOVL R0, R2 ;R0, STATUS ; BLBC 12(R3), 1$ ;SYS_OUTPUT_OPEN, 1$ ; 1578 PUSHL 4(R3) ;CONS_CHAN ; CALLS #1, (R4) ;#1, SYS$CANCEL ; 1$: CLRL G^CONNECT_FLAG ;CONNECT_FLAG ; 1580 MOVZBL 1066(R3), R0 ;OLD_PARITY+6, R0 ; 1581 BICL2 #-193, R0 ;#-193, R0 ; BISB2 #32, R0 ;#32, PAR ; CLRL -(SP) ;-(SP) ; 1584 PUSHL R0 ;PAR ; MOVZWL 1064(R3), -(SP) ;OLD_PARITY+4, -(SP) ; MOVQ #12, -(SP) ;#12, -(SP) ; PUSHAB 1068(R3) ;OLD_TERM_CHAR ; CLRQ -(SP) ;-(SP) ; MOVQ #35, -(SP) ;#35, -(SP) ; PUSHL (R3) ;TERM_CHAN ; CLRL -(SP) ;-(SP) ; CALLS #12, G^SYS$QIOW ;#12, SYS$QIOW ; MOVL R0, R2 ;R0, STATUS ; BLBS R2, 2$ ;STATUS, 2$ ; 1586 PUSHL R2 ;STATUS ; 1589 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; MOVL R2, R0 ;STATUS, R0 ; 1590 RET ; ; 2$: CLRL G^TERM_FLAG ;TERM_FLAG ; 1596 BLBC 676(R3), 3$ ;DEBUG_REDIRECTED, 3$ ; 1601 PUSHAB 476(R3) ;DEBUG_RAB ; 1604 PUSHAB 396(R3) ;DEBUG_FAB ; CALLS #2, (R5) ;#2, LOG_CLOSE ; CLRL 676(R3) ;DEBUG_REDIRECTED ; 1605 3$: BLBC (R6), 4$ ;TRANSACTION_OPEN, 4$ ; 1612 PUSHL R7 ;R7 ; 1615 PUSHAB G^P.ABB ;P.ABB ; 1616 PUSHAB G^P.AAZ ;P.AAZ ; 1615 CALLS #3, G^LOG_FAOL ;#3, LOG_FAOL ; PUSHL R7 ;R7 ; 1617 PUSHAB G^TRANSACTION_FAB ;TRANSACTION_FAB ; CALLS #2, (R5) ;#2, LOG_CLOSE ; CLRL (R6) ;TRANSACTION_OPEN ; 1618 4$: MOVL #134316043, R0 ;#134316043, R0 ; 1624 RET ; ; 1625 ; Routine Size: 198 bytes, Routine Base: $CODE$ + 065A ; 1626 1 ; 1627 1 %SBTTL 'Communications line -- SEND' ; 1628 1 ; 1629 1 GLOBAL ROUTINE SEND (ADDRESS, LENGTH) = ; 1630 1 ; 1631 1 !++ ; 1632 1 ! FUNCTIONAL DESCRIPTION: ; 1633 1 ! ; 1634 1 ! This routine will send a stream of 8-bit bytes over the terminal ; 1635 1 ! line to the remote KERMIT. This routine is called from KERMSG. ; 1636 1 ! ; 1637 1 ! CALLING SEQUENCE: ; 1638 1 ! ; 1639 1 ! SEND(Address-of-msg, Length-of-msg); ; 1640 1 ! ; 1641 1 ! INPUT PARAMETERS: ; 1642 1 ! ; 1643 1 ! None. ; 1644 1 ! ; 1645 1 ! IMPLICIT INPUTS: ; 1646 1 ! ; 1647 1 ! TERM_CHAN - Channel number to deassign. ; 1648 1 ! ; 1649 1 ! OUTPUT PARAMETERS: ; 1650 1 ! ; 1651 1 ! None. ; 1652 1 ! ; 1653 1 ! IMPLICIT OUTPUTS: ; 1654 1 ! ; 1655 1 ! None. ; 1656 1 ! ; 1657 1 ! COMPLETION CODES: ; 1658 1 ! ; 1659 1 ! SS$_NORMAL or error condition. ; 1660 1 ! ; 1661 1 ! SIDE EFFECTS: ; 1662 1 ! ; 1663 1 ! None. ; 1664 1 ! ; 1665 1 !-- ; 1666 1 ; 1667 2 BEGIN ; 1668 2 ; 1669 2 LOCAL ; 1670 2 CUR_EFN, ! Current EFN settings ; 1671 2 STATUS; ! Status returned by $QIOW ; 1672 2 ; 1673 2 ! ; 1674 2 ! If we already got a complete buffer of input we should ignore it. ; 1675 2 ! This is because we are probably retransmitting something and the ; 1676 2 ! incoming data is the response to the previous copy of this message. ; 1677 2 ! If we don't ignore it, we could get into a situation where every message ; 1678 2 ! gets transmitted twice. ; 1679 2 ! ; 1680 2 STATUS = $READEF (EFN = TERM_EFN, STATE = CUR_EFN); ; 1681 2 ; 1682 2 IF (.CUR_EFN AND 1^TERM_EFN) EQL 1 THEN DO_RECEIVE_QIO (); ; 1683 2 ; P 1684 2 STATUS = $QIOW (CHAN = .TERM_CHAN, EFN = TERM_O_EFN, FUNC = IO$_WRITEVBLK + IO$M_NOFORMAT, ; 1685 2 P1 = .ADDRESS, P2 = .LENGTH); ; 1686 2 ; 1687 2 IF .STATUS EQL SS$_NORMAL ; 1688 2 THEN ; 1689 2 RETURN KER_NORMAL ; 1690 2 ELSE ; 1691 3 BEGIN ; 1692 3 LIB$SIGNAL (.STATUS); ; 1693 3 RETURN .STATUS; ; 1694 2 END; ; 1695 2 ; 1696 1 END; ! End of SEND .EXTRN SYS$READEF .ENTRY SEND, ^M ;SEND, Save R2 ; 1629 SUBL2 #4, SP ;#4, SP ; PUSHL SP ;SP ; 1680 PUSHL #2 ;#2 ; CALLS #2, G^SYS$READEF ;#2, SYS$READEF ; MOVL R0, R2 ;R0, STATUS ; BICL3 #-5, (SP), R0 ;#-5, CUR_EFN, R0 ; 1682 CMPL R0, #1 ;R0, #1 ; BNEQ 1$ ;1$ ; CALLS #0, G^U.42 ;#0, U.42 ; 1$: CLRQ -(SP) ;-(SP) ; 1685 CLRQ -(SP) ;-(SP) ; MOVQ 4(AP), -(SP) ;ADDRESS, -(SP) ; CLRQ -(SP) ;-(SP) ; CLRL -(SP) ;-(SP) ; MOVZWL #304, -(SP) ;#304, -(SP) ; PUSHL G^U.4 ;U.4 ; PUSHL #4 ;#4 ; CALLS #12, G^SYS$QIOW ;#12, SYS$QIOW ; MOVL R0, R2 ;R0, STATUS ; CMPL R2, #1 ;STATUS, #1 ; 1687 BNEQ 2$ ;2$ ; MOVL #134316043, R0 ;#134316043, R0 ; 1691 RET ; ; 2$: PUSHL R2 ;STATUS ; 1692 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; MOVL R2, R0 ;STATUS, R0 ; 1693 RET ; ; 1696 ; Routine Size: 100 bytes, Routine Base: $CODE$ + 0720 ; 1697 1 ; 1698 1 %SBTTL 'Communications line -- RECEIVE' ; 1699 1 ; 1700 1 GLOBAL ROUTINE RECEIVE (ADDRESS, LENGTH) = ; 1701 1 ; 1702 1 !++ ; 1703 1 ! FUNCTIONAL DESCRIPTION: ; 1704 1 ! ; 1705 1 ! This routine will receive a stream of 8-bit bytes over the terminal ; 1706 1 ! line to the remote KERMIT. This routine is called from KERMSG. ; 1707 1 ! The text that is stored will always contain the control-A as the ; 1708 1 ! first character. ; 1709 1 ! ; 1710 1 ! CALLING SEQUENCE: ; 1711 1 ! ; 1712 1 ! RECEIVE(Address-of-msg); ; 1713 1 ! ; 1714 1 ! INPUT PARAMETERS: ; 1715 1 ! ; 1716 1 ! None. ; 1717 1 ! ; 1718 1 ! IMPLICIT INPUTS: ; 1719 1 ! ; 1720 1 ! TERM_CHAN - Channel number to deassign. ; 1721 1 ! ; 1722 1 ! OUTPUT PARAMETERS: ; 1723 1 ! ; 1724 1 ! None. ; 1725 1 ! ; 1726 1 ! IMPLICIT OUTPUTS: ; 1727 1 ! ; 1728 1 ! None. ; 1729 1 ! ; 1730 1 ! COMPLETION CODES: ; 1731 1 ! ; 1732 1 ! SS$_NORMAL or error condition. ; 1733 1 ! ; 1734 1 ! SIDE EFFECTS: ; 1735 1 ! ; 1736 1 ! None. ; 1737 1 ! ; 1738 1 !-- ; 1739 1 ; 1740 2 BEGIN ; 1741 2 ; 1742 2 EXTERNAL ; 1743 2 RCV_SOH; ! Character to use for start of packet ; 1744 2 ; 1745 2 LOCAL ; 1746 2 QWORD_TIMEOUT : VECTOR [2, LONG], ! Quad word TIMEOUT value ; 1747 2 TIMER_VALUE : VECTOR [2, LONG], ! Quad word TIME value ; 1748 2 OLD_POINTER, ! Pointer into the message ; 1749 2 NEW_POINTER, ! Other pointer for finding SOH ; 1750 2 CUR_LENGTH, ! Running length while finding SOH ; 1751 2 CUR_EFN, ! Current EFN value ; 1752 2 STATUS; ! Status returned by $QIO ; 1753 2 ; 1754 2 OWN ; 1755 2 INT_CHR_SEEN; ! Interrupt character seen last ; 1756 2 ; 1757 2 ! ; 1758 2 ! Flag we haven't seen a ^Y yet. We must get two control-Y's in fairly ; 1759 2 ! quick succession (no timeouts in between) in order to give up. ; 1760 2 ! ; 1761 2 INT_CHR_SEEN = FALSE; ; 1762 2 ! ; 1763 2 ! Set up the timer if we have a time out parameter ; 1764 2 ! ; 1765 2 ; 1766 2 IF NOT .FORCE_TIMEOUT THEN STATUS = $CLREF (EFN = TIME_EFN); ; 1767 2 ; 1768 2 IF .SEND_TIMEOUT GTR 0 ; 1769 2 THEN ; 1770 3 BEGIN ; 1771 3 STATUS = $CANTIM (REQIDT = TIME_EFN); ; 1772 3 STATUS = $GETTIM (TIMADR = TIMER_VALUE); ; 1773 3 STATUS = LIB$EMUL (SEND_TIMEOUT, UPLIT (10000000), UPLIT (0), QWORD_TIMEOUT); ; 1774 3 STATUS = LIB$ADDX (TIMER_VALUE, QWORD_TIMEOUT, QWORD_TIMEOUT); ; 1775 3 STATUS = $SETIMR (DAYTIM = QWORD_TIMEOUT, EFN = TIME_EFN, REQIDT = TIME_EFN); ; 1776 2 END; ; 1777 2 ; 1778 2 ! ; 1779 2 ! Loop until we get something that is acceptable ; 1780 2 ! ; 1781 2 ; 1782 2 WHILE TRUE DO ; 1783 3 BEGIN ; 1784 3 ! ; 1785 3 ! Wait for something to happen. Either the terminal EFN will come up ; 1786 3 ! indicating we have some data, or the timer EFN will indicate that ; 1787 3 ! the time has run out. ; 1788 3 ! ; 1789 3 STATUS = $WFLOR (EFN = TERM_EFN, MASK = (1^TERM_EFN OR 1^TIME_EFN)); ; 1790 3 STATUS = $READEF (EFN = TERM_EFN, STATE = CUR_EFN); ; 1791 3 FORCE_TIMEOUT = FALSE; ! Timeout had it chance to happen ; 1792 3 ! ; 1793 3 ! If the terminal EFN is not set, the time must have expired. Therefore, ; 1794 3 ! we have timed out, and need to return that fact. ; 1795 3 ! ; 1796 3 ; 1797 3 IF (.CUR_EFN AND 1^TERM_EFN) EQL 0 THEN RETURN KER_TIMEOUT; ; 1798 3 ; 1799 3 ! ; 1800 3 ! If we have a request to abort, start it up the chain. ; 1801 3 ! ; 1802 3 ; 1803 3 IF .FORCE_ABORT ; 1804 3 THEN ; 1805 4 BEGIN ; 1806 4 STATUS = $CANTIM (REQIDT = TIME_EFN); ; 1807 4 RETURN KER_ABORTED; ; 1808 3 END; ; 1809 3 ; 1810 3 ! ; 1811 3 ! Check if the QIO completed successfully. If not, we will return ; 1812 3 ! an error. ; 1813 3 ! ; 1814 3 ; 1815 3 IF NOT .IO_STATUS [0] ; 1816 3 THEN ; 1817 4 BEGIN ; 1818 4 LIB$SIGNAL (.IO_STATUS [0]); ; 1819 4 RETURN KER_RECERR; ; 1820 3 END; ; 1821 3 ; 1822 3 ! ; 1823 3 ! First check for a control-Y as the terminator. If it was, then ; 1824 3 ! just abort now, since the user probably typed it. ; 1825 3 ! ; 1826 3 ; 1827 3 IF .CONNECT_FLAG ; 1828 3 THEN ; 1829 3 ; 1830 4 IF (.IO_STATUS [2] EQL CHR_CTL_Y) AND (.RCV_EOL NEQ CHR_CTL_Y) ; 1831 3 THEN ; 1832 4 BEGIN ; 1833 4 ; 1834 4 IF .INT_CHR_SEEN AND .IO_STATUS [1] EQL 0 ; 1835 4 THEN ; 1836 5 BEGIN ; 1837 5 STATUS = $CANTIM (REQIDT = TIME_EFN); ; 1838 5 RETURN KER_ABORTED ; 1839 5 END ; 1840 4 ELSE ; 1841 5 BEGIN ; 1842 5 INT_CHR_SEEN = TRUE; ; 1843 5 IO_STATUS [1] = 0; ! Force no input seen ; 1844 5 END ; 1845 5 ; 1846 4 END ; 1847 3 ELSE ; 1848 3 INT_CHR_SEEN = FALSE; ! Last character not ^Y ; 1849 3 ; 1850 3 ! ; 1851 3 ! Now find the final start of header character in the buffer. We ; 1852 3 ! will only return the text from that point on. If there is no SOH, ; 1853 3 ! then just get another buffer. It was probably noise on the line. ; 1854 3 ! ; 1855 3 OLD_POINTER = CH$PTR (RECV_BUFFER, 0, CHR_SIZE); ; 1856 3 CUR_LENGTH = .IO_STATUS [1]; ! Length without terminating character ; 1857 3 NEW_POINTER = CH$FIND_CH (.CUR_LENGTH, .OLD_POINTER, .RCV_SOH); ; 1858 3 ! ; 1859 3 ! If we found a start of header character, then we probably have something ; 1860 3 ! to return. However, first we must find the last start of header, in case ; 1861 3 ! something is garbled. ; 1862 3 ! ; 1863 3 ; 1864 3 IF NOT CH$FAIL (.NEW_POINTER) ; 1865 3 THEN ; 1866 4 BEGIN ; 1867 4 ! ; 1868 4 ! Search until we can't find any more start of headers, or until we run ; 1869 4 ! out of string to search (last character before EOL is an SOH). ; 1870 4 ! ; 1871 4 ; 1872 4 WHILE (.CUR_LENGTH GTR 0) AND ( NOT CH$FAIL (.NEW_POINTER)) DO ; 1873 5 BEGIN ; 1874 5 CUR_LENGTH = .CUR_LENGTH - CH$DIFF (.NEW_POINTER, .OLD_POINTER); ; 1875 5 ! Adjust the length for the characters we are skipping ; 1876 5 OLD_POINTER = .NEW_POINTER; ! Remember where we start ; 1877 5 NEW_POINTER = CH$FIND_CH (.CUR_LENGTH - 1, CH$PLUS (.OLD_POINTER, 1), .RCV_SOH); ; 1878 5 ! Find the next SOH (if any) ; 1879 4 END; ; 1880 4 ; 1881 4 ! ; 1882 4 ! If we have something left of the buffer, move from the SOH until the end ; 1883 4 ! into the callers buffer. ; 1884 4 ! ; 1885 4 ; 1886 5 IF (.CUR_LENGTH GTR 0) ; 1887 4 THEN ; 1888 5 BEGIN ; 1889 5 .LENGTH = .CUR_LENGTH + 1; ; 1890 5 ; 1891 5 IF .PARITY_TYPE EQL PR_NONE ! Have eight-bit? ; 1892 5 THEN ; 1893 5 CH$MOVE (.CUR_LENGTH + 1, .OLD_POINTER, CH$PTR (.ADDRESS, 0, CHR_SIZE)) ; 1894 5 ELSE ; 1895 6 BEGIN ; 1896 6 NEW_POINTER = CH$PTR (.ADDRESS, 0, CHR_SIZE); ; 1897 6 ; 1898 6 DECR CUR_LENGTH FROM .CUR_LENGTH TO 0 DO ; 1899 6 CH$WCHAR_A ((CH$RCHAR_A (OLD_POINTER) AND %O'177'), NEW_POINTER); ; 1900 6 ; 1901 5 END; ; 1902 5 ; 1903 5 EXITLOOP ; 1904 5 END ; 1905 5 ; 1906 3 END; ! End of IF NOT CH$FAIL(.POINTER) ; 1907 3 ; 1908 3 ! ; 1909 3 ! If we have gotten here, we have input a buffer without a valid message. ; 1910 3 ! Make sure we post the QIO again ; 1911 3 ! ; 1912 3 STATUS = DO_RECEIVE_QIO (); ; 1913 3 ; 1914 3 IF NOT .STATUS ; 1915 3 THEN ; 1916 4 BEGIN ; 1917 4 LIB$SIGNAL (.STATUS); ; 1918 4 RETURN KER_RECERR ; 1919 3 END; ; 1920 3 ; 1921 2 END; ! End of WHILE TRUE DO ; 1922 2 ; 1923 2 ! ; 1924 2 ! If we have gotten here, we have a valid message to return. ; 1925 2 ! Post the QIO so the buffer is available for the next message. ; 1926 2 ! ; 1927 2 STATUS = DO_RECEIVE_QIO (); ; 1928 2 ; 1929 2 IF NOT .STATUS ; 1930 2 THEN ; 1931 3 BEGIN ; 1932 3 LIB$SIGNAL (.STATUS); ; 1933 3 RETURN KER_RECERR ; 1934 2 END; ; 1935 2 ; 1936 2 RETURN KER_NORMAL; ! Return happy ; 1937 1 END; ! End of RECEIVE .PSECT $PLIT$,NOWRT,NOEXE,2 P.ABC: .LONG 10000000 ; ; P.ABD: .LONG 0 ; ; .PSECT $OWN$,NOEXE,2 ;INT_CHR_SEEN U.59: .BLKB 4 .EXTRN RCV_SOH, SYS$CLREF, SYS$CANTIM, SYS$GETTIM, SYS$SETIMR, SYS$WFLOR .PSECT $CODE$,NOWRT,2 .ENTRY RECEIVE, ^M ; ; MOVAB G^SEND_TIMEOUT, R11 ;SEND_TIMEOUT, R11 ; MOVAB G^U.59, R10 ;U.59, R10 ; SUBL2 #20, SP ;#20, SP ; CLRL (R10) ;INT_CHR_SEEN ; 1761 BLBS -1100(R10), 1$ ;FORCE_TIMEOUT, 1$ ; 1766 PUSHL #3 ;#3 ; CALLS #1, G^SYS$CLREF ;#1, SYS$CLREF ; MOVL R0, R9 ;R0, STATUS ; 1$: TSTL (R11) ;SEND_TIMEOUT ; 1768 BLEQ 2$ ;2$ ; MOVQ #3, -(SP) ;#3, -(SP) ; 1771 CALLS #2, G^SYS$CANTIM ;#2, SYS$CANTIM ; MOVL R0, R9 ;R0, STATUS ; PUSHAB 4(SP) ;TIMER_VALUE ; 1772 CALLS #1, G^SYS$GETTIM ;#1, SYS$GETTIM ; MOVL R0, R9 ;R0, STATUS ; PUSHAB 12(SP) ;QWORD_TIMEOUT ; 1773 PUSHAB G^P.ABD ;P.ABD ; PUSHAB G^P.ABC ;P.ABC ; PUSHL R11 ;R11 ; CALLS #4, G^LIB$EMUL ;#4, LIB$EMUL ; MOVL R0, R9 ;R0, STATUS ; PUSHAB 12(SP) ;QWORD_TIMEOUT ; 1774 PUSHAB 16(SP) ;QWORD_TIMEOUT ; PUSHAB 12(SP) ;TIMER_VALUE ; CALLS #3, G^LIB$ADDX ;#3, LIB$ADDX ; MOVL R0, R9 ;R0, STATUS ; PUSHL #3 ;#3 ; 1775 CLRL -(SP) ;-(SP) ; PUSHAB 20(SP) ;QWORD_TIMEOUT ; PUSHL #3 ;#3 ; CALLS #4, G^SYS$SETIMR ;#4, SYS$SETIMR ; MOVL R0, R9 ;R0, STATUS ; 2$: PUSHL #12 ;#12 ; 1789 PUSHL #2 ;#2 ; CALLS #2, G^SYS$WFLOR ;#2, SYS$WFLOR ; MOVL R0, R9 ;R0, STATUS ; PUSHL SP ;SP ; 1790 PUSHL #2 ;#2 ; CALLS #2, G^SYS$READEF ;#2, SYS$READEF ; MOVL R0, R9 ;R0, STATUS ; CLRL -1100(R10) ;FORCE_TIMEOUT ; 1791 BBS #2, (SP), 3$ ;#2, CUR_EFN, 3$ ; 1797 MOVL #134316248, R0 ;#134316248, R0 ; RET ; ; 3$: BLBS -1104(R10), 5$ ;FORCE_ABORT, 5$ ; 1803 MOVZWL -156(R10), R0 ;IO_STATUS, R0 ; 1815 BLBS R0, 4$ ;R0, 4$ ; PUSHL R0 ;R0 ; 1818 BRW 19$ ;19$ ; 4$: BLBC G^CONNECT_FLAG, 8$ ;CONNECT_FLAG, 8$ ; 1827 CMPW -152(R10), #25 ;IO_STATUS+4, #25 ; 1830 BNEQ 7$ ;7$ ; CMPL G^RCV_EOL, #25 ;RCV_EOL, #25 ; BEQL 7$ ;7$ ; BLBC (R10), 6$ ;INT_CHR_SEEN, 6$ ; 1834 TSTW -154(R10) ;IO_STATUS+2 ; BNEQ 6$ ;6$ ; 5$: MOVQ #3, -(SP) ;#3, -(SP) ; 1837 CALLS #2, G^SYS$CANTIM ;#2, SYS$CANTIM ; MOVL R0, R9 ;R0, STATUS ; MOVL #134316258, R0 ;#134316258, R0 ; 1838 RET ; ; 6$: MOVL #1, (R10) ;#1, INT_CHR_SEEN ; 1842 CLRW -154(R10) ;IO_STATUS+2 ; 1843 BRB 8$ ;8$ ; 7$: CLRL (R10) ;INT_CHR_SEEN ; 1848 8$: MOVAB -148(R10), R6 ;RECV_BUFFER, OLD_POINTER ; 1855 MOVZWL -154(R10), R7 ;IO_STATUS+2, CUR_LENGTH ; 1856 MOVL G^RCV_SOH, R2 ;RCV_SOH, R2 ; 1857 LOCC R2, R7, (R6) ;R2, CUR_LENGTH, (OLD_POINTER) ; BNEQ 9$ ;9$ ; CLRL R1 ;R1 ; 9$: MOVL R1, R8 ;R1, NEW_POINTER ; BEQL 16$ ;16$ ; 1864 10$: TSTL R7 ;CUR_LENGTH ; 1872 BLEQ 12$ ;12$ ; TSTL R8 ;NEW_POINTER ; BEQL 12$ ;12$ ; SUBL3 R8, R6, R0 ;NEW_POINTER, OLD_POINTER, R0 ; 1874 ADDL2 R0, R7 ;R0, CUR_LENGTH ; MOVL R8, R6 ;NEW_POINTER, OLD_POINTER ; 1876 MOVAB -1(R7), R0 ;-1(R7), R0 ; 1877 LOCC R2, R0, 1(R6) ;R2, R0, 1(OLD_POINTER) ; BNEQ 11$ ;11$ ; CLRL R1 ;R1 ; 11$: MOVL R1, R8 ;R1, NEW_POINTER ; BRB 10$ ;10$ ; 12$: TSTL R7 ;CUR_LENGTH ; 1886 BLEQ 16$ ;16$ ; MOVAB 1(R7), R0 ;1(R7), R0 ; 1889 MOVL R0, @8(AP) ;R0, @LENGTH ; TSTL G^PARITY_TYPE ;PARITY_TYPE ; 1891 BNEQ 13$ ;13$ ; MOVC3 R0, (R6), @4(AP) ;R0, (OLD_POINTER), @ADDRESS ; 1893 BRB 17$ ;17$ ; 13$: MOVL 4(AP), R8 ;ADDRESS, NEW_POINTER ; 1896 MOVAB 1(R7), R0 ;1(R7), CUR_LENGTH ; 1899 BRB 15$ ;15$ ; 14$: MOVZBL (R6)+, R1 ;(OLD_POINTER)+, R1 ; EXTZV #0, #7, R1, R2 ;#0, #7, R1, R2 ; MOVB R2, (R8)+ ;R2, (NEW_POINTER)+ ; 15$: SOBGEQ R0, 14$ ;CUR_LENGTH, 14$ ; BRB 17$ ;17$ ; 16$: CALLS #0, G^U.42 ;#0, U.42 ; 1912 MOVL R0, R9 ;R0, STATUS ; BLBC R9, 18$ ;STATUS, 18$ ; 1914 BRW 2$ ;2$ ; 17$: CALLS #0, G^U.42 ;#0, U.42 ; 1927 MOVL R0, R9 ;R0, STATUS ; BLBS R9, 20$ ;STATUS, 20$ ; 1929 18$: PUSHL R9 ;STATUS ; 1932 19$: CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; MOVL #134316266, R0 ;#134316266, R0 ; 1933 RET ; ; 20$: MOVL #134316043, R0 ;#134316043, R0 ; 1936 RET ; ; 1937 ; Routine Size: 432 bytes, Routine Base: $CODE$ + 0784 ; 1938 1 ; 1939 1 %SBTTL 'Communications line -- IBM_WAIT' ; 1940 1 ; 1941 1 GLOBAL ROUTINE IBM_WAIT = ; 1942 1 ; 1943 1 !++ ; 1944 1 ! FUNCTIONAL DESCRIPTION: ; 1945 1 ! ; 1946 1 ! This routine will wait until the IBM turnaround character ; 1947 1 ! is seen on the communications line, or until the timeout ; 1948 1 ! parameter is exceeded. ; 1949 1 ! ; 1950 1 ! CALLING SEQUENCE: ; 1951 1 ! ; 1952 1 ! STATUS = IBM_WAIT (); ; 1953 1 ! ; 1954 1 ! INPUT PARAMETERS: ; 1955 1 ! ; 1956 1 ! None. ; 1957 1 ! ; 1958 1 ! IMPLICIT INPUTS: ; 1959 1 ! ; 1960 1 ! TERM_CHAN - Channel number for terminal ; 1961 1 ! ; 1962 1 ! OUTPUT PARAMETERS: ; 1963 1 ! ; 1964 1 ! Status value is returned as routine value. ; 1965 1 ! ; 1966 1 ! IMPLICIT OUTPUTS: ; 1967 1 ! ; 1968 1 ! None. ; 1969 1 ! ; 1970 1 ! COMPLETION CODES: ; 1971 1 ! ; 1972 1 ! SS$_NORMAL or error condition. ; 1973 1 ! ; 1974 1 ! SIDE EFFECTS: ; 1975 1 ! ; 1976 1 ! None. ; 1977 1 ! ; 1978 1 !-- ; 1979 1 ; 1980 2 BEGIN ; 1981 2 ; 1982 2 LOCAL ; 1983 2 QWORD_TIMEOUT : VECTOR [2, LONG], ! Quad word TIMEOUT value ; 1984 2 TIMER_VALUE : VECTOR [2, LONG], ! Quad word TIME value ; 1985 2 CUR_EFN, ! Current EFN value ; 1986 2 STATUS; ! Status returned by $QIO ; 1987 2 ; 1988 2 ! ; 1989 2 ! Set up the timer if we have a time out parameter ; 1990 2 ! ; 1991 2 STATUS = $CLREF (EFN = TIME_EFN); ; 1992 2 ; 1993 2 IF .SEND_TIMEOUT GTR 0 ; 1994 2 THEN ; 1995 3 BEGIN ; 1996 3 STATUS = $CANTIM (REQIDT = TIME_EFN); ; 1997 3 STATUS = $GETTIM (TIMADR = TIMER_VALUE); ; 1998 3 STATUS = LIB$EMUL (SEND_TIMEOUT, UPLIT (1000000), UPLIT (0), QWORD_TIMEOUT); ; 1999 3 STATUS = LIB$ADDX (TIMER_VALUE, QWORD_TIMEOUT, QWORD_TIMEOUT); ; 2000 3 STATUS = $SETIMR (DAYTIM = QWORD_TIMEOUT, EFN = TIME_EFN, REQIDT = TIME_EFN); ; 2001 2 END; ; 2002 2 ; 2003 2 ! ; 2004 2 ! Loop until we get something that is acceptable ; 2005 2 ! ; 2006 2 ; 2007 2 WHILE TRUE DO ; 2008 3 BEGIN ; 2009 3 ! ; 2010 3 ! Wait for something to happen. Either the terminal EFN will come up ; 2011 3 ! indicating we have some data, or the timer EFN will indicate that ; 2012 3 ! the time has run out. ; 2013 3 ! ; 2014 3 STATUS = $WFLOR (EFN = TERM_EFN, MASK = (1^TERM_EFN OR 1^TIME_EFN)); ; 2015 3 STATUS = $READEF (EFN = TERM_EFN, STATE = CUR_EFN); ; 2016 3 ! ; 2017 3 ! If the terminal EFN is not set, the time must have expired. Therefore, ; 2018 3 ! pretend we got the character. ; 2019 3 ! ; 2020 3 ; 2021 3 IF (.CUR_EFN AND 1^TERM_EFN) EQL 0 THEN RETURN KER_NORMAL; ; 2022 3 ; 2023 3 ! ; 2024 3 ! Check if the QIO completed successfully. If not, we will return ; 2025 3 ! an error. ; 2026 3 ! ; 2027 3 ; 2028 3 IF NOT .IO_STATUS [0] ; 2029 3 THEN ; 2030 4 BEGIN ; 2031 4 LIB$SIGNAL (.IO_STATUS [0]); ; 2032 4 RETURN KER_RECERR; ; 2033 3 END; ; 2034 3 ; 2035 3 ! ; 2036 3 ! First check for a control-Y as the terminator. If it was, then ; 2037 3 ! just abort now, since the user probably typed it. ; 2038 3 ! ; 2039 3 ; 2040 3 IF .CONNECT_FLAG ; 2041 3 THEN ; 2042 3 ; 2043 4 IF (.IO_STATUS [2] EQL CHR_CTL_Y) AND (.RCV_EOL NEQ CHR_CTL_Y) ; 2044 3 THEN ; 2045 4 BEGIN ; 2046 4 STATUS = $CANTIM (REQIDT = TIME_EFN); ; 2047 4 RETURN KER_ABORTED ; 2048 3 END; ; 2049 3 ; 2050 3 ! Check if terminator was the turnaround character ; 2051 3 ; 2052 3 IF (.IO_STATUS [2] EQL .IBM_CHAR) THEN EXITLOOP; ; 2053 3 ; 2054 3 ! ; 2055 3 ! Make sure we post the QIO again ; 2056 3 ! ; 2057 3 STATUS = DO_RECEIVE_QIO (); ; 2058 3 ; 2059 3 IF NOT .STATUS ; 2060 3 THEN ; 2061 4 BEGIN ; 2062 4 LIB$SIGNAL (.STATUS); ; 2063 4 RETURN KER_RECERR ; 2064 3 END; ; 2065 3 ; 2066 2 END; ! End of WHILE TRUE DO ; 2067 2 ; 2068 2 ! ; 2069 2 ! If we have gotten here, we have a valid message to return. ; 2070 2 ! Post the QIO so the buffer is available for the next message. ; 2071 2 ! ; 2072 2 STATUS = DO_RECEIVE_QIO (); ; 2073 2 ; 2074 2 IF NOT .STATUS ; 2075 2 THEN ; 2076 3 BEGIN ; 2077 3 LIB$SIGNAL (.STATUS); ; 2078 3 RETURN KER_RECERR ; 2079 2 END; ; 2080 2 ; 2081 2 RETURN KER_NORMAL; ! Return happy ; 2082 1 END; ! End of RECEIVE .PSECT $PLIT$,NOWRT,NOEXE,2 P.ABE: .LONG 1000000 ; ; P.ABF: .LONG 0 ; ; .PSECT $CODE$,NOWRT,2 .ENTRY IBM_WAIT, ^M ;IBM_WAIT, Save R2,R3,R4,R5,R6 ; 1941 MOVAB G^U.42, R6 ;U.42, R6 ; MOVAB G^SYS$CANTIM, R5 ;SYS$CANTIM, R5 ; MOVAB G^SEND_TIMEOUT, R4 ;SEND_TIMEOUT, R4 ; MOVAB G^U.27+4, R3 ;U.27+4, R3 ; SUBL2 #20, SP ;#20, SP ; PUSHL #3 ;#3 ; 1991 CALLS #1, G^SYS$CLREF ;#1, SYS$CLREF ; MOVL R0, R2 ;R0, STATUS ; TSTL (R4) ;SEND_TIMEOUT ; 1993 BLEQ 1$ ;1$ ; MOVQ #3, -(SP) ;#3, -(SP) ; 1996 CALLS #2, (R5) ;#2, SYS$CANTIM ; MOVL R0, R2 ;R0, STATUS ; PUSHAB 4(SP) ;TIMER_VALUE ; 1997 CALLS #1, G^SYS$GETTIM ;#1, SYS$GETTIM ; MOVL R0, R2 ;R0, STATUS ; PUSHAB 12(SP) ;QWORD_TIMEOUT ; 1998 PUSHAB G^P.ABF ;P.ABF ; PUSHAB G^P.ABE ;P.ABE ; PUSHL R4 ;R4 ; CALLS #4, G^LIB$EMUL ;#4, LIB$EMUL ; MOVL R0, R2 ;R0, STATUS ; PUSHAB 12(SP) ;QWORD_TIMEOUT ; 1999 PUSHAB 16(SP) ;QWORD_TIMEOUT ; PUSHAB 12(SP) ;TIMER_VALUE ; CALLS #3, G^LIB$ADDX ;#3, LIB$ADDX ; MOVL R0, R2 ;R0, STATUS ; PUSHL #3 ;#3 ; 2000 CLRL -(SP) ;-(SP) ; PUSHAB 20(SP) ;QWORD_TIMEOUT ; PUSHL #3 ;#3 ; CALLS #4, G^SYS$SETIMR ;#4, SYS$SETIMR ; MOVL R0, R2 ;R0, STATUS ; 1$: PUSHL #12 ;#12 ; 2014 PUSHL #2 ;#2 ; CALLS #2, G^SYS$WFLOR ;#2, SYS$WFLOR ; MOVL R0, R2 ;R0, STATUS ; PUSHL SP ;SP ; 2015 PUSHL #2 ;#2 ; CALLS #2, G^SYS$READEF ;#2, SYS$READEF ; MOVL R0, R2 ;R0, STATUS ; BBC #2, (SP), 7$ ;#2, CUR_EFN, 7$ ; 2021 MOVZWL -4(R3), R0 ;IO_STATUS, R0 ; 2028 BLBS R0, 2$ ;R0, 2$ ; PUSHL R0 ;R0 ; 2031 BRB 6$ ;6$ ; 2$: BLBC G^CONNECT_FLAG, 3$ ;CONNECT_FLAG, 3$ ; 2040 CMPW (R3), #25 ;IO_STATUS+4, #25 ; 2043 BNEQ 3$ ;3$ ; CMPL G^RCV_EOL, #25 ;RCV_EOL, #25 ; BEQL 3$ ;3$ ; MOVQ #3, -(SP) ;#3, -(SP) ; 2046 CALLS #2, (R5) ;#2, SYS$CANTIM ; MOVL R0, R2 ;R0, STATUS ; MOVL #134316258, R0 ;#134316258, R0 ; 2047 RET ; ; 3$: CMPZV #0, #16, (R3), G^IBM_CHAR ;#0, #16, IO_STATUS+4, IBM_CHAR ; 2052 BEQL 4$ ;4$ ; CALLS #0, (R6) ;#0, DO_RECEIVE_QIO ; 2057 MOVL R0, R2 ;R0, STATUS ; BLBS R2, 1$ ;STATUS, 1$ ; 2059 BRB 5$ ;5$ ; 2062 4$: CALLS #0, (R6) ;#0, DO_RECEIVE_QIO ; 2072 MOVL R0, R2 ;R0, STATUS ; BLBS R2, 7$ ;STATUS, 7$ ; 2074 5$: PUSHL R2 ;STATUS ; 2077 6$: CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; MOVL #134316266, R0 ;#134316266, R0 ; 2078 RET ; ; 7$: MOVL #134316043, R0 ;#134316043, R0 ; 2081 RET ; ; 2082 ; Routine Size: 273 bytes, Routine Base: $CODE$ + 0934 ; 2083 1 ; 2084 1 %SBTTL 'GET_DEV_CHAR - Determine device characteristics' ; 2085 1 ROUTINE GET_DEV_CHAR (LOG_NAME_DESC, PHYS_NAME_DESC, DEV_CLASS) = ; 2086 1 ; 2087 1 !++ ; 2088 1 ! FUNCTIONAL DESCRIPTION: ; 2089 1 ! ; 2090 1 ! This routine will get the device characteristics from VMS. It returns ; 2091 1 ! both the physical name of the device and the device class. ; 2092 1 ! ; 2093 1 ! CALLING SEQUENCE: ; 2094 1 ! ; 2095 1 ! STATUS = GET_DEV_CHAR (LOG_NAME_DESC, PHYS_NAME_DESC, DEV_CLASS); ; 2096 1 ! ; 2097 1 ! INPUT PARAMETERS: ; 2098 1 ! ; 2099 1 ! LOG_NAME_DESC - Descriptor for logical device for which the device ; 2100 1 ! class is desired. ; 2101 1 ! ; 2102 1 ! IMPLICIT INPUTS: ; 2103 1 ! ; 2104 1 ! None. ; 2105 1 ! ; 2106 1 ! OUPTUT PARAMETERS: ; 2107 1 ! ; 2108 1 ! PHYS_NAME_DESC - Descriptor for physical device name ; 2109 1 ! DEV_CLASS - Device class for device ; 2110 1 ! ; 2111 1 ! IMPLICIT OUTPUTS: ; 2112 1 ! ; 2113 1 ! None. ; 2114 1 ! ; 2115 1 ! COMPLETION CODES/RETURN VALUE: ; 2116 1 ! ; 2117 1 ! Status value returned from $GETDVI if it fails, ; 2118 1 ! KER_NORMAL otherwise. ; 2119 1 ! ; 2120 1 ! SIDE EFFECTS: ; 2121 1 ! ; 2122 1 ! None. ; 2123 1 ! ; 2124 1 !-- ; 2125 1 ; 2126 2 BEGIN ; 2127 2 ; 2128 2 MAP ; 2129 2 PHYS_NAME_DESC : REF BLOCK [8, BYTE]; ! Physical name descriptor ; 2130 2 ; 2131 2 LOCAL ; 2132 2 ITMLST : ITEM_LIST [2] FIELD (ITEM_FIELDS), ; 2133 2 PHYS_NAME_LENGTH : VOLATILE, ; 2134 2 STATUS; ; 2135 2 ; 2136 2 ! ; 2137 2 ! Set up item list for device class ; 2138 2 ! ; 2139 2 ITMLST [0, ITEM_ITEM_CODE] = DVI$_DEVCLASS; ; 2140 2 ITMLST [0, ITEM_BFR_LENGTH] = 4; ! 4 byte result ; 2141 2 ITMLST [0, ITEM_BFR_ADDRESS] = .DEV_CLASS; ! Where to return result ; 2142 2 ITMLST [0, ITEM_RTN_LENGTH] = 0; ! We know how long it is ; 2143 2 ! ; 2144 2 ! Item list entry for device name ; 2145 2 ! ; 2146 2 ITMLST [1, ITEM_ITEM_CODE] = DVI$_DEVNAM; ! Want the name of the device ; 2147 2 ITMLST [1, ITEM_BFR_LENGTH] = .PHYS_NAME_DESC [DSC$W_LENGTH]; ! Max length to return ; 2148 2 ITMLST [1, ITEM_BFR_ADDRESS] = .PHYS_NAME_DESC [DSC$A_POINTER]; ! Where to return name ; 2149 2 ITMLST [1, ITEM_RTN_LENGTH] = PHYS_NAME_LENGTH; ! Where to return length ; 2150 2 ! ; 2151 2 ! End the list of items ; 2152 2 ! ; 2153 2 ITMLST [2, ITEM_ITEM_CODE] = 0; ; 2154 2 ITMLST [2, ITEM_BFR_LENGTH] = 0; ; 2155 2 ! ; 2156 2 ! Request the information ; 2157 2 ! ; 2158 2 STATUS = $GETDVIW (EFN = GET_DEV_EFN, DEVNAM = .LOG_NAME_DESC, ITMLST = ITMLST); ; 2159 2 ; 2160 2 IF NOT .STATUS THEN RETURN .STATUS; ; 2161 2 ! ; 2162 2 ! Assign the length and return happy ; 2163 2 ! ; 2164 2 PHYS_NAME_DESC [DSC$W_LENGTH] = .PHYS_NAME_LENGTH; ; 2165 2 RETURN KER_NORMAL; ; 2166 1 END; ! End of GET_DEV_CHAR .EXTRN SYS$GETDVIW ;GET_DEV_CHAR U.41: .WORD ^M ;Save R2 ; 2085 SUBL2 #40, SP ;#40, SP ; MOVL #262148, 4(SP) ;#262148, ITMLST ; 2140 MOVL 12(AP), 8(SP) ;DEV_CLASS, ITMLST+4 ; 2141 CLRL 12(SP) ;ITMLST+8 ; 2142 MOVW #32, 18(SP) ;#32, ITMLST+14 ; 2146 MOVL 8(AP), R2 ;PHYS_NAME_DESC, R2 ; 2147 MOVW (R2), 16(SP) ;(R2), ITMLST+12 ; MOVL 4(R2), 20(SP) ;4(R2), ITMLST+16 ; 2148 MOVAB (SP), 24(SP) ;PHYS_NAME_LENGTH, ITMLST+20 ; 2149 CLRL 28(SP) ;ITMLST+24 ; 2154 CLRQ -(SP) ;-(SP) ; 2158 CLRQ -(SP) ;-(SP) ; PUSHAB 20(SP) ;ITMLST ; PUSHL 4(AP) ;LOG_NAME_DESC ; MOVQ #7, -(SP) ;#7, -(SP) ; CALLS #8, G^SYS$GETDVIW ;#8, SYS$GETDVIW ; BLBC R0, 1$ ;STATUS, 1$ ; 2160 MOVW (SP), (R2) ;PHYS_NAME_LENGTH, (R2) ; 2164 MOVL #134316043, R0 ;#134316043, R0 ; 2165 1$: RET ; ; 2166 ; Routine Size: 79 bytes, Routine Base: $CODE$ + 0A45 ; 2167 1 %SBTTL 'DO_RECEIVE_QIO' ; 2168 1 ROUTINE DO_RECEIVE_QIO = ; 2169 1 ; 2170 1 !++ ; 2171 1 ! FUNCTIONAL DESCRIPTION: ; 2172 1 ! ; 2173 1 ! This routine is called to perform a QIO input from the terminal. This ; 2174 1 ! ensures that there is usually a receive buffer pending. ; 2175 1 ! ; 2176 1 ! CALLING SEQUENCE: ; 2177 1 ! ; 2178 1 ! STATUS = DO_RECEIVE_QIO (); ; 2179 1 ! ; 2180 1 ! INPUT PARAMETERS: ; 2181 1 ! ; 2182 1 ! None. ; 2183 1 ! ; 2184 1 ! IMPLICIT INPUTS: ; 2185 1 ! ; 2186 1 ! RCV_EOL - Receive end-of-line character ; 2187 1 ! ; 2188 1 ! OUPTUT PARAMETERS: ; 2189 1 ! ; 2190 1 ! None. ; 2191 1 ! ; 2192 1 ! IMPLICIT OUTPUTS: ; 2193 1 ! ; 2194 1 ! IO_STATUS - IOSB for the QIO ; 2195 1 ! RCV_BUFFER - Data input from terminal ; 2196 1 ! ; 2197 1 ! COMPLETION CODES: ; 2198 1 ! ; 2199 1 ! None. ; 2200 1 ! ; 2201 1 ! SIDE EFFECTS: ; 2202 1 ! ; 2203 1 ! TERM_EFN is set when I/O completes ; 2204 1 ! ; 2205 1 !-- ; 2206 1 ; 2207 2 BEGIN ; 2208 2 ; 2209 2 LOCAL ; 2210 2 QIO_FUNC, ; 2211 2 TERMINATOR : VECTOR [2, LONG], ; 2212 2 STATUS; ! For status of QIO call ; 2213 2 ; 2214 2 ! ; 2215 2 ! Initialize the terminating characters for the QIO. Only terminate ; 2216 2 ! on the end-of-line character and a control-Y ; 2217 2 ! ; 2218 2 TERMINATOR [0] = 0; ; 2219 2 TERMINATOR [1] = 1^.RCV_EOL OR 1^CHR_CTL_Y; ; 2220 2 ; 2221 2 IF .IBM_CHAR GEQ 0 THEN TERMINATOR [1] = .TERMINATOR [1] OR 1^.IBM_CHAR; ; 2222 2 ; 2223 2 ! Need IBM turnaround? ; 2224 2 ! ; 2225 2 ! Initialize the QIO function ; 2226 2 ! Always purge typeahead ; 2227 2 ! ; 2228 2 QIO_FUNC = IO$_TTYREADALL OR IO$M_NOECHO OR IO$M_PURGE; ; P 2229 2 RETURN $QIO (CHAN = .TERM_CHAN, EFN = TERM_EFN, FUNC = .QIO_FUNC, IOSB = IO_STATUS, ; 2230 2 P1 = RECV_BUFFER, P2 = RECV_BUFF_SIZE, P4 = TERMINATOR); ; 2231 1 END; ! End of DO_RECEIVE_QIO .EXTRN SYS$QIO ;DO_RECEIVE_QIO U.42: .WORD ^M ;Save R2 ; 2168 MOVAB G^U.28, R2 ;U.28, R2 ; SUBL2 #4, SP ;#4, SP ; CLRL -(SP) ;TERMINATOR ; 2218 ASHL G^RCV_EOL, #1, R0 ;RCV_EOL, #1, R0 ; 2219 BISL3 #33554432, R0, 4(SP) ;#33554432, R0, TERMINATOR+4 ; MOVL G^IBM_CHAR, R0 ;IBM_CHAR, R0 ; 2221 BLSS 1$ ;1$ ; ASHL R0, #1, R0 ;R0, #1, R0 ; BISL2 R0, 4(SP) ;R0, TERMINATOR+4 ; 1$: MOVZWL #2170, R0 ;#2170, QIO_FUNC ; 2228 CLRQ -(SP) ;-(SP) ; 2230 PUSHAB 8(SP) ;TERMINATOR ; CLRL -(SP) ;-(SP) ; MOVZBL #116, -(SP) ;#116, -(SP) ; PUSHL R2 ;R2 ; CLRQ -(SP) ;-(SP) ; PUSHAB -8(R2) ;IO_STATUS ; PUSHL R0 ;QIO_FUNC ; PUSHL -944(R2) ;TERM_CHAN ; PUSHL #2 ;#2 ; CALLS #12, G^SYS$QIO ;#12, SYS$QIO ; RET ; ; 2231 ; Routine Size: 87 bytes, Routine Base: $CODE$ + 0A94 ; 2232 1 %SBTTL 'DO_CONS_QIO' ; 2233 1 ROUTINE DO_CONS_QIO = ; 2234 1 ; 2235 1 !++ ; 2236 1 ! FUNCTIONAL DESCRIPTION: ; 2237 1 ! ; 2238 1 ! This routine is called to perform a QIO input from the terminal. This ; 2239 1 ! ensures that there is usually a receive buffer pending. ; 2240 1 ! ; 2241 1 ! CALLING SEQUENCE: ; 2242 1 ! ; 2243 1 ! STATUS = DO_CONS_QIO (); ; 2244 1 ! ; 2245 1 ! INPUT PARAMETERS: ; 2246 1 ! ; 2247 1 ! None. ; 2248 1 ! ; 2249 1 ! IMPLICIT INPUTS: ; 2250 1 ! ; 2251 1 ! RCV_EOL - Receive end-of-line character ; 2252 1 ! ; 2253 1 ! OUPTUT PARAMETERS: ; 2254 1 ! ; 2255 1 ! None. ; 2256 1 ! ; 2257 1 ! IMPLICIT OUTPUTS: ; 2258 1 ! ; 2259 1 ! IO_STATUS - IOSB for the QIO ; 2260 1 ! RCV_BUFFER - Data input from terminal ; 2261 1 ! ; 2262 1 ! COMPLETION CODES: ; 2263 1 ! ; 2264 1 ! None. ; 2265 1 ! ; 2266 1 ! SIDE EFFECTS: ; 2267 1 ! ; 2268 1 ! TERM_EFN is set when I/O completes ; 2269 1 ! ; 2270 1 !-- ; 2271 1 ; 2272 2 BEGIN ; 2273 2 ; 2274 2 EXTERNAL ; 2275 2 ABT_CUR_FILE, ; 2276 2 ABT_ALL_FILE, ; 2277 2 DEBUG_FLAG, ; 2278 2 TYP_STS_FLAG; ; 2279 2 ; 2280 2 LOCAL ; 2281 2 I, ! Random index variable ; 2282 2 TERMINATOR : VECTOR [2, LONG], ! Pointer at terminator mask ; 2283 2 TERM_MASK : VECTOR [8, LONG], ! Terminator mask ; 2284 2 STATUS; ! For status of QIO call ; 2285 2 ; 2286 2 LITERAL ; 2287 2 CONS_BUFF_SIZE = 1; ; 2288 2 ; 2289 2 OWN ; 2290 2 CONS_STATUS : VECTOR [4, WORD], ; 2291 2 CONS_BUFFER : VECTOR [CONS_BUFF_SIZE, BYTE]; ; 2292 2 ; 2293 2 ! ; 2294 2 ! AST routine for console ; 2295 2 ! ; 2296 2 ROUTINE CONS_AST (DUMMY) = ; 2297 3 BEGIN ; 2298 3 ; 2299 3 IF .CONS_STATUS [0] ; 2300 3 THEN ; 2301 3 ; 2302 3 SELECT .CONS_STATUS [2] OF ; 2303 3 SET ; 2304 3 ; 2305 3 [CHR_CTL_Z] : ; 2306 3 ABT_ALL_FILE = TRUE; ; 2307 3 ; 2308 3 [CHR_CTL_X] : ; 2309 3 ABT_CUR_FILE = TRUE; ; 2310 3 ; 2311 3 [CHR_CTL_Y] : ; 2312 3 RETURN SS$_NORMAL; ; 2313 3 ; 2314 3 [CHR_CTL_C] : ; 2315 4 BEGIN ; 2316 4 FORCE_TIMEOUT = TRUE; ; 2317 4 FORCE_ABORT = TRUE; ; 2318 3 END; ; 2319 3 ; 2320 3 [CHR_CTL_D] : ; 2321 3 DEBUG_FLAG = NOT .DEBUG_FLAG; ; 2322 3 ; 2323 3 [CHR_CTL_A] : ; 2324 3 TYP_STS_FLAG = TRUE; ; 2325 3 ; 2326 3 [CHR_CTL_M] : ; 2327 3 FORCE_TIMEOUT = TRUE; ; 2328 3 ; 2329 3 [CHR_CTL_Z, CHR_CTL_X, CHR_CTL_A, CHR_CTL_M, CHR_CTL_C] : ; 2330 3 ! Make sure what we did gets noticed, even if we are currently waiting ; 2331 3 ! forever for input. ; 2332 3 ; 2333 3 IF .FORCE_TIMEOUT OR .SEND_TIMEOUT EQL 0 THEN $SETEF (EFN = TIME_EFN); ; 2334 3 ; 2335 3 TES; ; 2336 3 ; 2337 3 IF .CONS_STATUS [0] NEQ SS$_CANCEL AND .CONS_STATUS [0] NEQ SS$_ABORT ; 2338 3 THEN ; 2339 3 RETURN DO_CONS_QIO () ; 2340 3 ELSE ; 2341 3 RETURN SS$_NORMAL; ; 2342 3 ; 2343 2 END; .PSECT $OWN$,NOEXE,2 ;CONS_STATUS U.62: .BLKB 8 ;CONS_BUFFER U.63: .BLKB 1 .EXTRN ABT_CUR_FILE, ABT_ALL_FILE, DEBUG_FLAG, TYP_STS_FLAG, SYS$SETEF .PSECT $CODE$,NOWRT,2 ;CONS_AST U.64: .WORD ^M ;Save R2,R3 ; 2296 MOVAB G^DEBUG_FLAG, R3 ;DEBUG_FLAG, R3 ; MOVAB G^U.2, R2 ;U.2, R2 ; BLBC 1104(R2), 9$ ;CONS_STATUS, 9$ ; 2299 MOVZWL 1108(R2), R0 ;CONS_STATUS+4, R0 ; 2302 CMPW R0, #26 ;R0, #26 ; 2305 BNEQ 1$ ;1$ ; MOVL #1, G^ABT_ALL_FILE ;#1, ABT_ALL_FILE ; 2306 1$: CMPW R0, #24 ;R0, #24 ; 2308 BNEQ 2$ ;2$ ; MOVL #1, G^ABT_CUR_FILE ;#1, ABT_CUR_FILE ; 2309 2$: CMPW R0, #25 ;R0, #25 ; 2311 BEQL 10$ ;10$ ; CMPW R0, #3 ;R0, #3 ; 2314 BNEQ 3$ ;3$ ; MOVL #1, (R2) ;#1, FORCE_TIMEOUT ; 2316 MOVL #1, -4(R2) ;#1, FORCE_ABORT ; 2317 3$: CMPW R0, #4 ;R0, #4 ; 2320 BNEQ 4$ ;4$ ; MCOML (R3), (R3) ;DEBUG_FLAG, DEBUG_FLAG ; 2321 4$: CMPW R0, #1 ;R0, #1 ; 2323 BNEQ 5$ ;5$ ; MOVL #1, G^TYP_STS_FLAG ;#1, TYP_STS_FLAG ; 2324 5$: CMPW R0, #13 ;R0, #13 ; 2326 BNEQ 6$ ;6$ ; MOVL #1, (R2) ;#1, FORCE_TIMEOUT ; 2327 6$: CMPW R0, #1 ;R0, #1 ; 2329 BEQL 7$ ;7$ ; CMPW R0, #3 ;R0, #3 ; BEQL 7$ ;7$ ; CMPW R0, #13 ;R0, #13 ; BEQL 7$ ;7$ ; CMPW R0, #24 ;R0, #24 ; BEQL 7$ ;7$ ; CMPW R0, #26 ;R0, #26 ; BNEQ 9$ ;9$ ; 7$: BLBS (R2), 8$ ;FORCE_TIMEOUT, 8$ ; 2333 TSTL G^SEND_TIMEOUT ;SEND_TIMEOUT ; BNEQ 9$ ;9$ ; 8$: PUSHL #3 ;#3 ; CALLS #1, G^SYS$SETEF ;#1, SYS$SETEF ; 9$: MOVZWL 1104(R2), R0 ;CONS_STATUS, R0 ; 2337 CMPW R0, #2096 ;R0, #2096 ; BEQL 10$ ;10$ ; CMPW R0, #44 ;R0, #44 ; BEQL 10$ ;10$ ; CALLS #0, G^U.43 ;#0, U.43 ; 2339 RET ; ; 2341 10$: MOVL #1, R0 ;#1, R0 ; RET ; ; 2343 ; Routine Size: 169 bytes, Routine Base: $CODE$ + 0AEB ; 2344 2 ! ; 2345 2 ! Start of main portion of DO_CONS_QIO ; 2346 2 ! ; 2347 2 TERMINATOR [0] = 32; ! Length of terminator mask in bytes ; 2348 2 TERMINATOR [1] = TERM_MASK; ! Address of mask ; 2349 2 ; 2350 2 INCR I FROM 0 TO 7 DO ; 2351 2 TERM_MASK [.I] = -1; ! All characters are terminators ; 2352 2 ; P 2353 2 RETURN $QIO (CHAN = .CONS_CHAN, EFN = CONS_EFN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO, ; P 2354 2 IOSB = CONS_STATUS, ASTADR = CONS_AST, P1 = CONS_BUFFER, P2 = CONS_BUFF_SIZE, ; 2355 2 P4 = TERMINATOR); ; 2356 1 END; ! End of DO_CONS_QIO ;DO_CONS_QIO U.43: .WORD ^M ;Save R2 ; 2233 MOVAB G^U.63, R2 ;U.63, R2 ; SUBL2 #40, SP ;#40, SP ; MOVL #32, 32(SP) ;#32, TERMINATOR ; 2347 MOVAB (SP), 36(SP) ;TERM_MASK, TERMINATOR+4 ; 2348 CLRL R0 ;I ; 2350 1$: MNEGL #1, (SP)[R0] ;#1, TERM_MASK[I] ; 2351 AOBLEQ #7, R0, 1$ ;#7, I, 1$ ; CLRQ -(SP) ;-(SP) ; 2355 PUSHAB 40(SP) ;TERMINATOR ; MOVQ #1, -(SP) ;#1, -(SP) ; PUSHL R2 ;R2 ; CLRL -(SP) ;-(SP) ; PUSHAB W^U.64 ;U.64 ; PUSHAB -8(R2) ;CONS_STATUS ; MOVZBL #122, -(SP) ;#122, -(SP) ; PUSHL -1100(R2) ;CONS_CHAN ; PUSHL #5 ;#5 ; CALLS #12, G^SYS$QIO ;#12, SYS$QIO ; RET ; ; 2356 ; Routine Size: 67 bytes, Routine Base: $CODE$ + 0B94 ; 2357 1 %SBTTL 'TERM_CONNECT' ; 2358 1 ; 2359 1 GLOBAL ROUTINE TERM_CONNECT = ; 2360 1 ; 2361 1 !++ ; 2362 1 ! FUNCTIONAL DESCRIPTION: ; 2363 1 ! ; 2364 1 ! This routine TERM_CONNECT will enable two terminal-like devices, ; 2365 1 ! MY_TERM and TERM_NAME, to communicate with each other. Anything ; 2366 1 ! that the user types on his terminal, MYTERM, will be sent to the ; 2367 1 ! other device, TERM_NAME, over the terminal line TERM_CHAN. ; 2368 1 ! Anything that TERM_NAME cares to output will be sent to MYTERM. ; 2369 1 ! The main routine TERM_CONNECT performs the initialization. It ; 2370 1 ! opens the input and output files and connects streams. ; 2371 1 ! ; 2372 1 ! CALLING SEQUENCE: ; 2373 1 ! ; 2374 1 ! TERM_CONNECT(); ; 2375 1 ! ; 2376 1 ! INPUT PARAMETERS: ; 2377 1 ! ; 2378 1 ! None. ; 2379 1 ! ; 2380 1 ! IMPLICIT INPUTS: ; 2381 1 ! ; 2382 1 ! TERM_DESC - Descriptor of a vector of ASCII characters that represent ; 2383 1 ! the name of the terminal to use. ; 2384 1 ! ; 2385 1 ! OUTPUT PARAMETERS: ; 2386 1 ! ; 2387 1 ! None. ; 2388 1 ! ; 2389 1 ! IMPLICIT OUTPUTS: ; 2390 1 ! ; 2391 1 ! TERM_CHAN - Channel number used by the terminal line to TERM_DESC. ; 2392 1 ! ; 2393 1 ! COMPLETION CODES: ; 2394 1 ! ; 2395 1 ! SS$_NORMAL or error condition. ; 2396 1 ! ; 2397 1 ! SIDE EFFECTS: ; 2398 1 ! ; 2399 1 ! None. ; 2400 1 ! ; 2401 1 !-- ; 2402 1 ; 2403 2 BEGIN ; 2404 2 ; 2405 2 EXTERNAL ROUTINE ; 2406 2 LOG_OPEN, ! Open log file ; 2407 2 LOG_CLOSE; ! Close log file ; 2408 2 ; 2409 2 LITERAL ; 2410 2 OUT_BUFLEN = 80, ! Max # of char. in output buffer ; 2411 2 INP_BUFSIZ = 80, ! Max # of char. in input buffer ; 2412 2 NUM_OUT_BUF = 2, ! # of output buffers per device ; 2413 2 NUM_IN_BUF = 2, ! # of input buffers per device ; 2414 2 MYT = 0, ! Device MY_TERM ; 2415 2 TRM = 1, ! Device TERM_NAME ; 2416 2 OFFSET = 1, ! IOSB : offset to terminator ; 2417 2 EOFSIZ = 3, ! IOSB : terminator size ; 2418 2 T_EFN_DISP = NUM_OUT_BUF, ; 2419 2 XITEFN = 2*NUM_OUT_BUF + 1, ! Exit event flag number ; 2420 2 EFN_MASK = (1^XITEFN - 1) AND ( NOT 1); ! Mask of flags set by CONNECT ; 2421 2 ; 2422 2 STRUCTURE ; 2423 2 IOSB_VECTOR [D, BUFNUM, INFO; NUMBUF] = ; 2424 2 [NUMBUF*16] ; 2425 2 (IOSB_VECTOR + (D*NUMBUF + BUFNUM)*8 + 2*INFO)<0, 16, 0>, ; 2426 2 BUFFER_VECTOR [D, BUFNUM; NUMBUF, BUFSIZ] = ; 2427 2 [NUMBUF*BUFSIZ*2 + NUMBUF] ; 2428 2 (BUFFER_VECTOR + (D*NUMBUF + BUFNUM)*BUFSIZ + D); ; 2429 2 ; 2430 2 OWN ; 2431 2 BTIMUP : VECTOR [4, WORD], ! Time limit in binary format ; 2432 2 CHANNEL : VECTOR [2, LONG], ! Contains channel #s ; 2433 2 CHR_COUNT : VECTOR [2, WORD] INITIAL (0), ! # of char. in out buffer ; 2434 2 ESC_FLG : INITIAL (FALSE), ! Was last char. the ESCAPE_CHR ; 2435 2 IN_IOSB : IOSB_VECTOR [NUM_IN_BUF], ! IOSB status block ; 2436 2 INP_BUF : BUFFER_VECTOR [NUM_IN_BUF, INP_BUFSIZ], ! Input buffers ; 2437 2 MSG : VECTOR [80, BYTE], ! Combined escape message ; 2438 2 MSG_DES : BLOCK [8, BYTE], ! Descriptor for message ; 2439 2 OUT_BUF : BUFFER_VECTOR [NUM_OUT_BUF, OUT_BUFLEN], ! Output buffers ; 2440 2 OUT_BUFNUM : VECTOR [2, BYTE], ! Present output buffer ; 2441 2 OUT_EFN : VECTOR [2, BYTE], ! Present event flag # ; 2442 2 OUT_PTR : VECTOR [2, LONG], ! CS-pointer for output buffer ; 2443 2 MYT_QIO_FUNC, ! Function for QIO input for my terminal ; 2444 2 ESC_CHR_LEN, ! Length of escape character message ; 2445 2 ESC_CHR_MSG : VECTOR [30, BYTE], ! Escape character message ; 2446 2 STATE; ! Used by $READEF to store state of EFs ; 2447 2 ; 2448 2 BIND ; 2449 2 CON_MSG_1 = %ASCID'Connecting to ', ; 2450 2 CON_MSG_2 = %ASCID'. Type ', ; 2451 2 CON_MSG_3 = %ASCID'C to return to VAX/VMS Kermit-32]', ; 2452 2 CON_MSG_4 = %ASCID'Returning to VAX/VMS Kermit-32]'; ; 2453 2 ; 2454 2 MAP ; 2455 2 CON_MSG_1 : BLOCK [8, BYTE], ; 2456 2 CON_MSG_2 : BLOCK [8, BYTE], ; 2457 2 CON_MSG_3 : BLOCK [8, BYTE], ; 2458 2 CON_MSG_4 : BLOCK [8, BYTE]; ; 2459 2 ; 2460 2 BIND ; 2461 2 ATIMUP = %ASCID'0 00:00:00.050', ! Time to wait for more output ; 2462 2 MYT_CHAN = CHANNEL [1], ; 2463 2 MY_TERM = %ASCID'SYS$INPUT:'; ; 2464 2 ; 2465 2 LABEL ; 2466 2 CONN_STREAMS; ; 2467 2 ; 2468 2 LOCAL ; 2469 2 CON_MSG : VECTOR [80, BYTE], ; 2470 2 CON_MSG_DESC : BLOCK [8, BYTE], ; 2471 2 STATUS; ; 2472 2 ; 2473 2 %SBTTL 'TERM_CONNECT -- TYPE_OUT_BUF' ; 2474 2 ROUTINE TYPE_OUT_BUF (DEV) = ; 2475 2 ; 2476 2 !++ ; 2477 2 ! This routine send the contents of the output buffer to the other ; 2478 2 ! device. It also resets the OUT_PTR and the CHR_COUNT and it ; 2479 2 ! increments OUT_EFN and OUT_BUFNUM. ; 2480 2 !-- ; 2481 2 ; 2482 3 BEGIN ; 2483 3 ; 2484 3 LOCAL ; 2485 3 STATUS; ; 2486 3 ; 2487 3 ! Check to make sure exit flag not set before $QIO ; 2488 3 ; 2489 3 IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR ; 2490 3 THEN ; 2491 4 BEGIN ; 2492 4 $SETEF (EFN = .OUT_EFN [.DEV]); ; 2493 4 RETURN .STATUS; ; 2494 3 END; ; 2495 3 ; 2496 3 $WAITFR (EFN = .OUT_EFN [.DEV]); ; 2497 3 $CLREF (EFN = .OUT_EFN [.DEV]); ; 2498 3 ; 2499 3 IF $READEF (EFN = XITEFN, STATE = STATE) EQL SS$_WASCLR ; 2500 3 THEN ; P 2501 3 STATUS = $QIO (CHAN = .CHANNEL [.DEV], EFN = .OUT_EFN [.DEV], ; P 2502 3 FUNC = IO$_WRITEVBLK OR IO$M_NOFORMAT, P1 = OUT_BUF [.DEV, .OUT_BUFNUM [.DEV]], ; 2503 4 P2 = .CHR_COUNT [.DEV]) ; 2504 3 ELSE ; 2505 4 BEGIN ; 2506 4 $SETEF (EFN = .OUT_EFN [.DEV]); ; 2507 4 RETURN .STATUS; ; 2508 3 END; ; 2509 3 ; 2510 3 CHR_COUNT [.DEV] = 0; ; 2511 3 OUT_EFN [.DEV] = .OUT_EFN [.DEV] + 1; ; 2512 3 ; 2513 3 IF (OUT_BUFNUM [.DEV] = .OUT_BUFNUM [.DEV] + 1) GEQ NUM_OUT_BUF ; 2514 3 THEN ; 2515 4 BEGIN ; 2516 4 OUT_BUFNUM [.DEV] = 0; ; 2517 4 OUT_EFN [.DEV] = .DEV*T_EFN_DISP + 1; ; 2518 3 END; ; 2519 3 ; 2520 3 OUT_PTR [.DEV] = CH$PTR (OUT_BUF [.DEV, .OUT_BUFNUM [.DEV]]); ; 2521 3 ; 2522 3 IF NOT .STATUS ; 2523 3 THEN ; 2524 4 BEGIN ; 2525 4 LIB$SIGNAL (.STATUS); ; 2526 4 $SETEF (EFN = XITEFN); ; 2527 3 END; ; 2528 3 ; 2529 3 RETURN .STATUS; ; 2530 2 END; .PSECT $PLIT$,NOWRT,NOEXE,2 P.ABH: .ASCII \Connecting to \<0><0> ; ; P.ABG: .LONG 17694734 ; ; .ADDRESS P.ABH ; ; P.ABJ: .ASCII \. Type \ ; ; P.ABI: .LONG 17694728 ; ; .ADDRESS P.ABJ ; ; P.ABL: .ASCII \C to return to VAX/VMS Kermit-32]\<0><0><0> ; ; P.ABK: .LONG 17694753 ; ; .ADDRESS P.ABL ; ; P.ABN: .ASCII \Returning to VAX/VMS Kermit-32]\<0> ; ; P.ABM: .LONG 17694751 ; ; .ADDRESS P.ABN ; ; P.ABP: .ASCII \0 00:00:00.050\<0><0> ; ; P.ABO: .LONG 17694734 ; ; .ADDRESS P.ABP ; ; P.ABR: .ASCII \SYS$INPUT:\<0><0> ; ; P.ABQ: .LONG 17694730 ; ; .ADDRESS P.ABR ; ; .PSECT $OWN$,NOEXE,2 .BLKB 3 ;BTIMUP U.66: .BLKB 8 ;CHANNEL U.67: .BLKB 8 ;CHR_COUNT U.68: .LONG 0 ; ; ;ESC_FLG U.69: .LONG 0 ; ; ;IN_IOSB U.70: .BLKB 32 ;INP_BUF U.71: .BLKB 322 .BLKB 2 ;MSG U.72: .BLKB 80 ;MSG_DES U.73: .BLKB 8 ;OUT_BUF U.74: .BLKB 322 .BLKB 2 ;OUT_BUFNUM U.75: .BLKB 2 .BLKB 2 ;OUT_EFN U.76: .BLKB 2 .BLKB 2 ;OUT_PTR U.77: .BLKB 8 ;MYT_QIO_FUNC U.78: .BLKB 4 ;ESC_CHR_LEN U.79: .BLKB 4 ;ESC_CHR_MSG U.80: .BLKB 30 .BLKB 2 ;STATE U.81: .BLKB 4 U.82= P.ABG U.83= P.ABI U.84= P.ABK U.85= P.ABM U.90= P.ABO U.91= U.67+4 U.92= P.ABQ .EXTRN SYS$WAITFR .PSECT $CODE$,NOWRT,2 ;TYPE_OUT_BUF U.93: .WORD ^M ;Save R2,R3,R4,R5,R6 ; 2474 MOVAB G^SYS$READEF, R6 ;SYS$READEF, R6 ; MOVAB G^U.81, R5 ;U.81, R5 ; PUSHL R5 ;R5 ; 2489 PUSHL #5 ;#5 ; CALLS #2, (R6) ;#2, SYS$READEF ; MOVL R0, R4 ;R0, STATUS ; CMPL R4, #1 ;STATUS, #1 ; BEQL 1$ ;1$ ; MOVAB -52(R5), R0 ;OUT_EFN, R0 ; 2492 MOVZBL @4(AP)[R0], -(SP) ;@DEV[R0], -(SP) ; BRB 3$ ;3$ ; 1$: MOVL 4(AP), R2 ;DEV, R2 ; 2496 MOVAB -52(R5)[R2], R3 ;OUT_EFN[R2], R3 ; MOVZBL (R3), -(SP) ;(R3), -(SP) ; CALLS #1, G^SYS$WAITFR ;#1, SYS$WAITFR ; MOVZBL (R3), -(SP) ;(R3), -(SP) ; 2497 CALLS #1, G^SYS$CLREF ;#1, SYS$CLREF ; PUSHL R5 ;R5 ; 2499 PUSHL #5 ;#5 ; CALLS #2, (R6) ;#2, SYS$READEF ; CMPL R0, #1 ;R0, #1 ; BNEQ 2$ ;2$ ; CLRQ -(SP) ;-(SP) ; 2503 CLRQ -(SP) ;-(SP) ; MOVZWL -832(R5)[R2], -(SP) ;CHR_COUNT[R2], -(SP) ; MOVZBL -56(R5)[R2], R0 ;OUT_BUFNUM[R2], R0 ; MOVAW (R0)[R2], R0 ;(R0)[R2], R0 ; MULL2 #80, R0 ;#80, R0 ; MOVAB -380(R5)[R0], R0 ;OUT_BUF[R0], R0 ; PUSHAB (R2)[R0] ;(R2)[R0] ; CLRQ -(SP) ;-(SP) ; CLRL -(SP) ;-(SP) ; MOVZWL #304, -(SP) ;#304, -(SP) ; PUSHL -840(R5)[R2] ;CHANNEL[R2] ; MOVZBL (R3), -(SP) ;(R3), -(SP) ; CALLS #12, G^SYS$QIO ;#12, SYS$QIO ; MOVL R0, R4 ;R0, STATUS ; BRB 4$ ;4$ ; 2501 2$: MOVZBL (R3), -(SP) ;(R3), -(SP) ; 2506 3$: BRB 6$ ;6$ ; 4$: CLRW -832(R5)[R2] ;CHR_COUNT[R2] ; 2510 INCB (R3) ;(R3) ; 2511 MOVAB -56(R5)[R2], R1 ;OUT_BUFNUM[R2], R1 ; 2513 MOVZBL (R1), R0 ;(R1), R0 ; INCL R0 ;R0 ; MOVB R0, (R1) ;R0, (R1) ; CMPL R0, #2 ;R0, #2 ; BLSS 5$ ;5$ ; CLRB (R1) ;(R1) ; 2516 ASHL #1, R2, R0 ;#1, R2, R0 ; 2517 ADDB3 #1, R0, (R3) ;#1, R0, (R3) ; 5$: MOVZBL (R1), R0 ;(R1), R0 ; 2520 MOVAW (R0)[R2], R0 ;(R0)[R2], R0 ; MULL2 #80, R0 ;#80, R0 ; MOVAB -380(R5)[R0], R0 ;OUT_BUF[R0], R0 ; ADDL3 R2, R0, -48(R5)[R2] ;R2, R0, OUT_PTR[R2] ; BLBS R4, 7$ ;STATUS, 7$ ; 2522 PUSHL R4 ;STATUS ; 2525 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; PUSHL #5 ;#5 ; 2526 6$: CALLS #1, G^SYS$SETEF ;#1, SYS$SETEF ; 7$: MOVL R4, R0 ;STATUS, R0 ; 2529 RET ; ; 2530 ; Routine Size: 238 bytes, Routine Base: $CODE$ + 0BD7 ; 2531 2 %SBTTL 'TERM_CONNECT -- TIME_UP' ; 2532 2 ROUTINE TIME_UP (OUTEFN) : NOVALUE = ; 2533 2 ; 2534 2 !++ ; 2535 2 ! AST routine called 0.1 second after first character is input. It calls ; 2536 2 ! TYPE_OUT_BUF to transmit output buffer. ; 2537 2 !-- ; 2538 2 ; 2539 3 BEGIN ; 2540 3 ; 2541 3 LOCAL ; 2542 3 DEV; ; 2543 3 ; 2544 3 IF (.OUTEFN - T_EFN_DISP) LEQ 0 ; 2545 3 THEN ; 2546 3 DEV = 0 ! Device was MY_TERM ; 2547 3 ELSE ; 2548 3 DEV = 1; ! Device was TERM_NAME ; 2549 3 ; 2550 3 TYPE_OUT_BUF (.DEV); ; 2551 2 END; ! End of TIME_UP ;TIME_UP U.94: .WORD ^M<> ;Save nothing ; 2532 SUBL3 #2, 4(AP), R0 ;#2, OUTEFN, R0 ; 2544 BGTR 1$ ;1$ ; CLRL R0 ;DEV ; 2546 BRB 2$ ;2$ ; 1$: MOVL #1, R0 ;#1, DEV ; 2548 2$: PUSHL R0 ;DEV ; 2550 CALLS #1, W^U.93 ;#1, U.93 ; RET ; ; 2551 ; Routine Size: 24 bytes, Routine Base: $CODE$ + 0CC5 ; 2552 2 %SBTTL 'TERM_CONNECT -- STORE_INPUT' ; 2553 2 ROUTINE STORE_INPUT (DEV, INP_POINTER, NUM_CHR_IN) : NOVALUE = ; 2554 2 ; 2555 2 !++ ; 2556 2 ! This routine stores the input buffer in the output buffer and keeps ; 2557 2 ! track of the number of characters in the output buffer. It also ; 2558 2 ! calls TYPE_OUT_BUF when the output buffer is full and it sets up ; 2559 2 ! the timer routine TIME_UP. ; 2560 2 !-- ; 2561 2 ; 2562 3 BEGIN ; 2563 3 ; 2564 3 EXTERNAL ROUTINE ; 2565 3 LOG_CHAR, ! Routine to log characters ; 2566 3 GEN_PARITY; ! Routine to generate parity ; 2567 3 ; 2568 3 LOCAL ; 2569 3 STATUS; ; 2570 3 ; 2571 3 IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN RETURN; ; 2572 3 ; 2573 3 IF .NUM_CHR_IN EQL 0 THEN RETURN .STATUS; ; 2574 3 ; 2575 3 IF .NUM_CHR_IN + .CHR_COUNT [.DEV] GTR OUT_BUFLEN ; 2576 3 THEN ; 2577 4 BEGIN ; 2578 4 ! ; 2579 4 ! If we don't have enough room in the buffer for all of the characters, call ; 2580 4 ! ourself to dump what will fit, then proceed with what remains. ; 2581 4 ! ; 2582 4 ; 2583 4 LOCAL ; 2584 4 SAVED_CHR_CNT; ! Saved character count ; 2585 4 ; 2586 4 SAVED_CHR_CNT = OUT_BUFLEN - .CHR_COUNT [.DEV]; ; 2587 4 NUM_CHR_IN = .NUM_CHR_IN - .SAVED_CHR_CNT; ; 2588 4 STORE_INPUT (.DEV, .INP_POINTER, .SAVED_CHR_CNT); ; 2589 4 INP_POINTER = CH$PLUS (.INP_POINTER, .SAVED_CHR_CNT); ; 2590 3 END; ; 2591 3 ; 2592 3 IF .CHR_COUNT [.DEV] EQL 0 ; 2593 3 THEN ; 2594 4 BEGIN ; 2595 4 STATUS = $SETIMR (DAYTIM = BTIMUP, ASTADR = TIME_UP, REQIDT = .OUT_EFN [.DEV]); ; 2596 4 ; 2597 4 IF NOT .STATUS ; 2598 4 THEN ; 2599 5 BEGIN ; 2600 5 LIB$SIGNAL (.STATUS); ; 2601 5 $SETEF (EFN = XITEFN); ; 2602 5 RETURN .STATUS; ; 2603 4 END; ; 2604 4 ; 2605 3 END; ; 2606 3 ; 2607 3 ! We must generate parity for the communications terminal ; 2608 3 ; 2609 3 IF .DEV EQL 0 ; 2610 3 THEN ; 2611 4 BEGIN ; 2612 4 ; 2613 4 LOCAL ; 2614 4 POINTER; ; 2615 4 ; 2616 4 POINTER = .INP_POINTER; ; 2617 4 ; 2618 4 DECR I FROM .NUM_CHR_IN TO 1 DO ; 2619 4 CH$WCHAR_A (GEN_PARITY (CH$RCHAR_A (POINTER)), OUT_PTR [.DEV]); ; 2620 4 ; 2621 4 END ; 2622 3 ELSE ; 2623 3 OUT_PTR [.DEV] = CH$MOVE (.NUM_CHR_IN, .INP_POINTER, .OUT_PTR [.DEV]); ; 2624 3 ; 2625 3 ! ; 2626 3 ! If we want logging, do it now ; 2627 3 ! ; 2628 3 ; 2629 3 IF (.DEV EQL 1 OR .ECHO_FLAG) AND .SESSION_OPEN AND .SESSION_LOGGING ; 2630 3 THEN ; 2631 4 BEGIN ; 2632 4 ; 2633 4 LOCAL ; 2634 4 STATUS, ; 2635 4 POINTER; ; 2636 4 ; 2637 4 POINTER = .INP_POINTER; ; 2638 4 ; 2639 4 DECR I FROM .NUM_CHR_IN TO 1 DO ; 2640 4 ; 2641 4 IF NOT LOG_CHAR (CH$RCHAR_A (POINTER), SESSION_RAB) ; 2642 4 THEN ; 2643 5 BEGIN ; 2644 5 SESSION_LOGGING = FALSE; ; 2645 5 EXITLOOP; ; 2646 4 END; ; 2647 4 ; 2648 3 END; ; 2649 3 ; 2650 3 IF (CHR_COUNT [.DEV] = .CHR_COUNT [.DEV] + .NUM_CHR_IN) GEQ OUT_BUFLEN - INP_BUFSIZ ; 2651 3 THEN ; 2652 4 BEGIN ; 2653 4 $CANTIM (REQIDT = .OUT_EFN [.DEV]); ; 2654 4 TYPE_OUT_BUF (.DEV); ; 2655 3 END; ; 2656 3 ; 2657 3 RETURN .STATUS; ; 2658 2 END; ! End of STORE_INPUT .EXTRN GEN_PARITY ;STORE_INPUT U.95: .WORD ^M ;Save R2,R3,R4,R5,R6,R7,R8,R9,R10 ; 2553 MOVAB B^U.95, R10 ;U.95, R10 ; MOVAB G^U.76, R9 ;U.76, R9 ; PUSHAB 52(R9) ;STATE ; 2571 PUSHL #5 ;#5 ; CALLS #2, G^SYS$READEF ;#2, SYS$READEF ; MOVL R0, R3 ;R0, STATUS ; CMPL R3, #1 ;STATUS, #1 ; BEQL 1$ ;1$ ; RET ; ; 1$: TSTL 12(AP) ;NUM_CHR_IN ; 2573 BNEQ 2$ ;2$ ; RET ; ; 2$: MOVL 4(AP), R7 ;DEV, R7 ; 2575 MOVAW -780(R9)[R7], R8 ;CHR_COUNT[R7], R8 ; MOVZWL (R8), R0 ;(R8), R0 ; ADDL2 12(AP), R0 ;NUM_CHR_IN, R0 ; CMPL R0, #80 ;R0, #80 ; BLEQ 3$ ;3$ ; MOVZWL (R8), R2 ;(R8), SAVED_CHR_CNT ; 2586 SUBL3 R2, #80, R2 ;SAVED_CHR_CNT, #80, SAVED_CHR_CNT ; SUBL2 R2, 12(AP) ;SAVED_CHR_CNT, NUM_CHR_IN ; 2587 PUSHL R2 ;SAVED_CHR_CNT ; 2588 PUSHL 8(AP) ;INP_POINTER ; PUSHL R7 ;R7 ; CALLS #3, (R10) ;#3, STORE_INPUT ; ADDL2 R2, 8(AP) ;SAVED_CHR_CNT, INP_POINTER ; 2589 3$: TSTW (R8) ;(R8) ; 2592 BNEQ 4$ ;4$ ; MOVZBL (R9)[R7], -(SP) ;OUT_EFN[R7], -(SP) ; 2595 PUSHAB -24(R10) ;TIME_UP ; PUSHAB -796(R9) ;BTIMUP ; CLRL -(SP) ;-(SP) ; CALLS #4, G^SYS$SETIMR ;#4, SYS$SETIMR ; MOVL R0, R3 ;R0, STATUS ; BLBS R3, 4$ ;STATUS, 4$ ; 2597 PUSHL R3 ;STATUS ; 2600 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; PUSHL #5 ;#5 ; 2601 CALLS #1, G^SYS$SETEF ;#1, SYS$SETEF ; RET ; ; 2602 4$: MOVAL 4(R9)[R7], R6 ;OUT_PTR[R7], R6 ; 2619 TSTL R7 ;R7 ; 2609 BNEQ 7$ ;7$ ; MOVL 8(AP), R3 ;INP_POINTER, POINTER ; 2616 ADDL3 #1, 12(AP), R2 ;#1, NUM_CHR_IN, I ; 2619 BRB 6$ ;6$ ; 5$: MOVZBL (R3)+, -(SP) ;(POINTER)+, -(SP) ; CALLS #1, G^GEN_PARITY ;#1, GEN_PARITY ; MOVB R0, @0(R6) ;R0, @0(R6) ; INCL (R6) ;(R6) ; 6$: SOBGTR R2, 5$ ;I, 5$ ; BRB 8$ ;8$ ; 7$: MOVC3 12(AP), @8(AP), @0(R6) ;NUM_CHR_IN, @INP_POINTER, @0(R6) ; 2623 MOVL R3, (R6) ;R3, (R6) ; 8$: CMPL R7, #1 ;R7, #1 ; 2629 BEQL 9$ ;9$ ; BLBC G^ECHO_FLAG, 12$ ;ECHO_FLAG, 12$ ; 9$: BLBC -1516(R9), 12$ ;SESSION_OPEN, 12$ ; BLBC -1512(R9), 12$ ;SESSION_LOGGING, 12$ ; MOVL 8(AP), R3 ;INP_POINTER, POINTER ; 2637 ADDL3 #1, 12(AP), R2 ;#1, NUM_CHR_IN, I ; 2639 BRB 11$ ;11$ ; 10$: PUSHAB -1716(R9) ;SESSION_RAB ; 2641 MOVZBL (R3)+, -(SP) ;(POINTER)+, -(SP) ; CALLS #2, G^LOG_CHAR ;#2, LOG_CHAR ; BLBS R0, 11$ ;R0, 11$ ; CLRL -1512(R9) ;SESSION_LOGGING ; 2644 BRB 12$ ;12$ ; 11$: SOBGTR R2, 10$ ;I, 10$ ; 2643 12$: MOVZWL (R8), R0 ;(R8), R0 ; 2650 ADDL2 12(AP), R0 ;NUM_CHR_IN, R0 ; MOVW R0, (R8) ;R0, (R8) ; TSTL R0 ;R0 ; BLSS 13$ ;13$ ; CLRL -(SP) ;-(SP) ; 2653 MOVZBL (R9)[R7], -(SP) ;OUT_EFN[R7], -(SP) ; CALLS #2, G^SYS$CANTIM ;#2, SYS$CANTIM ; PUSHL R7 ;R7 ; 2654 CALLS #1, -262(R10) ;#1, TYPE_OUT_BUF ; 13$: RET ; ; 2658 ; Routine Size: 289 bytes, Routine Base: $CODE$ + 0CDD ; 2659 2 %SBTTL 'TERM_CONNECT -- MYTINP' ; 2660 2 ROUTINE MYTINP (INP_BUFNUM) = ; 2661 2 ; 2662 2 !++ ; 2663 2 ! This AST routine gets characters from the channel MYT_CHAN and outputs ; 2664 2 ! them on the channel TERM_CHAN. It also checks to see if the exit ; 2665 2 ! characters have been typed. If they have been typed, MYTINP sets the ; 2666 2 ! event flag XITEFN. INP_BUFNUM contains the # of the input buffer. ; 2667 2 !-- ; 2668 2 ; 2669 3 BEGIN ; 2670 3 ; 2671 3 OWN ; 2672 3 STATUS, ; 2673 3 NUM_CHR_IN; ; 2674 3 ; 2675 3 %SBTTL 'TERM_CONNECT -- MYTINP -- CHK_FOR_EXIT' ; 2676 3 ROUTINE CHK_FOR_EXIT (INP_BUFNUM) = ; 2677 3 ; 2678 3 !++ ; 2679 3 ! This routine checks to see if the exit characters have been typed. It ; 2680 3 ! returns TRUE if found and FALSE if not. If only 1 ESCAPE_CHR found ; 2681 3 ! then ESC_FLG is set to TRUE. ; 2682 3 !-- ; 2683 3 ; 2684 4 BEGIN ; 2685 4 ROUTINE TYPE_MSG (MSG_DESC, OPEN_FLAG, CLOSE_FLAG, CRLF_FLAG) : NOVALUE = ; 2686 5 BEGIN ; 2687 5 ; 2688 5 MAP ; 2689 5 MSG_DESC : REF BLOCK [8, BYTE]; ; 2690 5 ; 2691 5 IF .OPEN_FLAG ; 2692 5 THEN ; 2693 6 BEGIN ; 2694 6 STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(%C'[')), 1); ; 2695 6 ; 2696 6 IF .NODE_DESC [DSC$W_LENGTH] GTR 0 ; 2697 6 THEN ; 2698 6 STORE_INPUT (TRM, ; 2699 6 CH$PTR (.NODE_DESC [DSC$A_POINTER]), .NODE_DESC [DSC$W_LENGTH]); ; 2700 6 ; 2701 5 END; ; 2702 5 ; 2703 5 STORE_INPUT (TRM, CH$PTR (.MSG_DESC [DSC$A_POINTER]), .MSG_DESC [DSC$W_LENGTH]); ; 2704 5 ; 2705 5 IF .CLOSE_FLAG THEN STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(%C']')), 1); ; 2706 5 ; 2707 5 IF .CRLF_FLAG THEN STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(CHR_CRT, CHR_LFD)), 2); ; 2708 5 ; 2709 4 END; .PSECT $PLIT$,NOWRT,NOEXE,2 P.ABS: .BYTE 91 ; ; P.ABT: .BYTE 93 ; ; P.ABU: .BYTE 13, 10 ; ; .PSECT $OWN$,NOEXE,2 ;STATUS U.97: .BLKB 4 ;NUM_CHR_IN U.98: .BLKB 4 .PSECT $CODE$,NOWRT,2 ;TYPE_MSG U.100: .WORD ^M ;Save R2,R3 ; 2685 MOVAB G^P.ABS, R3 ;P.ABS, R3 ; MOVAB W^U.95, R2 ;U.95, R2 ; BLBC 8(AP), 1$ ;OPEN_FLAG, 1$ ; 2691 PUSHL #1 ;#1 ; 2694 PUSHL R3 ;R3 ; PUSHL #1 ;#1 ; CALLS #3, (R2) ;#3, STORE_INPUT ; MOVZWL G^NODE_DESC, R0 ;NODE_DESC, R0 ; 2696 BLEQ 1$ ;1$ ; PUSHL R0 ;R0 ; 2699 PUSHL G^NODE_DESC+4 ;NODE_DESC+4 ; PUSHL #1 ;#1 ; CALLS #3, (R2) ;#3, STORE_INPUT ; 1$: MOVL 4(AP), R0 ;MSG_DESC, R0 ; 2703 MOVZWL (R0), -(SP) ;(R0), -(SP) ; PUSHL 4(R0) ;4(R0) ; PUSHL #1 ;#1 ; CALLS #3, (R2) ;#3, STORE_INPUT ; BLBC 12(AP), 2$ ;CLOSE_FLAG, 2$ ; 2705 PUSHL #1 ;#1 ; PUSHAB 1(R3) ;P.ABT ; PUSHL #1 ;#1 ; CALLS #3, (R2) ;#3, STORE_INPUT ; 2$: BLBC 16(AP), 3$ ;CRLF_FLAG, 3$ ; 2707 PUSHL #2 ;#2 ; PUSHAB 2(R3) ;P.ABU ; PUSHL #1 ;#1 ; CALLS #3, (R2) ;#3, STORE_INPUT ; 3$: RET ; ; 2709 ; Routine Size: 93 bytes, Routine Base: $CODE$ + 0DFE ; 2710 4 ; 2711 4 LOCAL ; 2712 4 EAT_CHR, ! Number of input characters to eat ; 2713 4 ESC_PTR, ; 2714 4 INDEX : INITIAL (0), ! Displacement of ESC from beginning of buffer ; 2715 4 PTR0; ! Points to beginning of input buffer ; 2716 4 ; 2717 4 PTR0 = CH$PTR (INP_BUF [MYT, .INP_BUFNUM]); ; 2718 4 ; 2719 4 IF .ESC_FLG EQL TRUE ! ESCAPE_CHR was previously typed. ; 2720 4 THEN ; 2721 5 BEGIN ; 2722 5 INDEX = 0; ; 2723 5 ESC_PTR = .PTR0; ; 2724 5 ESC_FLG = FALSE; ; 2725 5 END ; 2726 4 ELSE ; 2727 4 ; 2728 4 IF (ESC_PTR = CH$FIND_CH (.NUM_CHR_IN, .PTR0, .ESCAPE_CHR)) EQL 0 ; 2729 4 THEN ; 2730 4 RETURN FALSE ; 2731 4 ELSE ; 2732 5 BEGIN ; 2733 5 INDEX = CH$DIFF (.PTR0, .ESC_PTR); ; 2734 5 ; 2735 6 IF .INDEX NEQ (NUM_CHR_IN = .NUM_CHR_IN - 1) ; 2736 5 THEN ; 2737 6 BEGIN ; 2738 6 CH$COPY (.NUM_CHR_IN - .INDEX, CH$PLUS (.ESC_PTR, 1), 0, ; 2739 6 .NUM_CHR_IN - .INDEX, .ESC_PTR); ; 2740 6 END ; 2741 5 ELSE ! ESCAPE_CHR was last character. ; 2742 6 BEGIN ; 2743 6 ESC_FLG = TRUE; ; 2744 6 RETURN FALSE; ; 2745 5 END; ; 2746 5 ; 2747 4 END; ; 2748 4 ; 2749 4 EAT_CHR = 0; ! No characters to eat ; 2750 4 ; 2751 4 SELECTONE CH$RCHAR (.ESC_PTR) OF ; 2752 4 SET ; 2753 4 ; 2754 4 ['?'] : ; 2755 5 BEGIN ; 2756 5 TYPE_MSG (%ASCID'Escape commands are:', TRUE, FALSE, TRUE); ; 2757 5 TYPE_MSG (%ASCID' C - Return to VAX/VMS Kermit-32', FALSE, FALSE, TRUE); ; 2758 5 TYPE_MSG (%ASCID' Q - Suspend logging to session log file (if any)', FALSE, ; 2759 5 FALSE, TRUE); ; 2760 5 TYPE_MSG (%ASCID' R - Resume logging to session log file (if any)', FALSE, ; 2761 5 FALSE, TRUE); ; 2762 5 TYPE_MSG (%ASCID' S - Show status', FALSE, FALSE, TRUE); ; 2763 5 TYPE_MSG (%ASCID' 0 - Send a null', FALSE, FALSE, TRUE); ; 2764 5 TYPE_MSG (%ASCID' ? - Type this text', FALSE, FALSE, TRUE); ; 2765 5 TYPE_MSG (%ASCID' ', FALSE, FALSE, FALSE); ; 2766 5 STORE_INPUT (TRM, ESC_CHR_MSG, .ESC_CHR_LEN); ; 2767 5 TYPE_MSG (%ASCID' - Send escape character', FALSE, TRUE, TRUE); ; 2768 5 EAT_CHR = 1; ; 2769 4 END; ; 2770 4 ; 2771 4 ['C', 'c'] : ; 2772 5 BEGIN ; 2773 5 NUM_CHR_IN = .INDEX; ; 2774 5 RETURN TRUE; ; 2775 4 END; ; 2776 4 ; 2777 4 ['Q', 'q'] : ; 2778 5 BEGIN ; 2779 5 ; 2780 5 BIND ; 2781 5 NO_LOG_TEXT = %ASCID'logging already disabled', ; 2782 5 STOP_LOG_TEXT = %ASCID'logging disabled'; ; 2783 5 ; 2784 5 IF .SESSION_LOGGING ; 2785 5 THEN ; 2786 5 TYPE_MSG (STOP_LOG_TEXT, TRUE, TRUE, TRUE) ; 2787 5 ELSE ; 2788 5 TYPE_MSG (NO_LOG_TEXT, TRUE, TRUE, TRUE); ; 2789 5 ; 2790 5 SESSION_LOGGING = FALSE; ; 2791 5 EAT_CHR = 1; ; 2792 4 END; ; 2793 4 ; 2794 4 ['R', 'r'] : ; 2795 5 BEGIN ! Resume logging ; 2796 5 ; 2797 5 BIND ; 2798 5 NO_LOG_TEXT = %ASCID'no log file to enable', ; 2799 5 START_LOG_TEXT = %ASCID'logging enabled'; ; 2800 5 ; 2801 5 SESSION_LOGGING = .SESSION_OPEN; ; 2802 5 ; 2803 5 IF .SESSION_LOGGING ; 2804 5 THEN ; 2805 5 TYPE_MSG (START_LOG_TEXT, TRUE, TRUE, TRUE) ; 2806 5 ELSE ; 2807 5 TYPE_MSG (NO_LOG_TEXT, TRUE, TRUE, TRUE); ; 2808 5 ; 2809 5 EAT_CHR = 1; ; 2810 4 END; ; 2811 4 ; 2812 4 ['S', 's'] : ; 2813 5 BEGIN ; 2814 5 TYPE_MSG (%ASCID'Connected to ', TRUE, FALSE, FALSE); ; 2815 5 TYPE_MSG (TERM_DESC, FALSE, FALSE, TRUE); ; 2816 5 TYPE_MSG (%ASCID' Escape character: "', FALSE, FALSE, FALSE); ; 2817 5 STORE_INPUT (TRM, ESC_CHR_MSG, .ESC_CHR_LEN); ; 2818 5 TYPE_MSG (%ASCID'"', FALSE, FALSE, TRUE); ; 2819 5 TYPE_MSG (%ASCID' Local echo: ', FALSE, FALSE, FALSE); ; 2820 5 ; 2821 5 IF .ECHO_FLAG ; 2822 5 THEN ; 2823 5 TYPE_MSG (%ASCID'On', FALSE, FALSE, TRUE) ; 2824 5 ELSE ; 2825 5 TYPE_MSG (%ASCID'Off', FALSE, FALSE, TRUE); ; 2826 5 ; 2827 5 TYPE_MSG (%ASCID' Parity: ', FALSE, FALSE, FALSE); ; 2828 5 ; 2829 5 CASE .PARITY_TYPE FROM PR_MIN TO PR_MAX OF ; 2830 5 SET ; 2831 5 ; 2832 5 [PR_NONE] : ; 2833 5 TYPE_MSG (%ASCID'None', FALSE, FALSE, TRUE); ; 2834 5 ; 2835 5 [PR_ODD] : ; 2836 5 TYPE_MSG (%ASCID'Odd', FALSE, FALSE, TRUE); ; 2837 5 ; 2838 5 [PR_EVEN] : ; 2839 5 TYPE_MSG (%ASCID'Even', FALSE, FALSE, TRUE); ; 2840 5 ; 2841 5 [PR_MARK] : ; 2842 5 TYPE_MSG (%ASCID'Mark', FALSE, FALSE, TRUE); ; 2843 5 ; 2844 5 [PR_SPACE] : ; 2845 5 TYPE_MSG (%ASCID'Space', FALSE, FALSE, TRUE); ; 2846 5 TES; ; 2847 5 ; 2848 5 TYPE_MSG (%ASCID' Logging: ', FALSE, FALSE, FALSE); ; 2849 5 ; 2850 5 IF .SESSION_OPEN GTR 0 ; 2851 5 THEN ; 2852 6 BEGIN ; 2853 6 TYPE_MSG (SESSION_DESC, FALSE, FALSE, FALSE); ; 2854 6 ; 2855 6 IF .SESSION_LOGGING ; 2856 6 THEN ; 2857 6 TYPE_MSG (%ASCID' Enabled', FALSE, TRUE, TRUE) ; 2858 6 ELSE ; 2859 6 TYPE_MSG (%ASCID' Disabled', FALSE, TRUE, TRUE); ; 2860 6 ; 2861 6 END ; 2862 5 ELSE ; 2863 5 TYPE_MSG (%ASCID' None specifed', FALSE, TRUE, TRUE); ; 2864 5 ; 2865 5 EAT_CHR = 1; ! Eat the "S" ; 2866 4 END; ; 2867 4 ; 2868 4 [.ESCAPE_CHR] : ; 2869 4 CH$WCHAR (.ESCAPE_CHR, .ESC_PTR); ! Write the escape character ; 2870 4 ; 2871 4 ['0'] : ; 2872 4 CH$WCHAR (CHR_NUL, .ESC_PTR); ! Write a null ; 2873 4 ; 2874 4 [OTHERWISE] : ; 2875 5 BEGIN ! Send a bell char. to MY_TERM ; 2876 5 STORE_INPUT (TRM, CH$PTR (UPLIT BYTE(CHR_BEL)), 1); ; 2877 5 EAT_CHR = 1; ! Eat the character ; 2878 4 END; ; 2879 4 TES; ; 2880 4 ; 2881 4 IF .EAT_CHR GTR 0 ; 2882 4 THEN ; 2883 4 ; 2884 4 IF (NUM_CHR_IN = .NUM_CHR_IN - .EAT_CHR) NEQ .INDEX ; 2885 4 THEN ; 2886 4 CH$COPY (.NUM_CHR_IN - .INDEX, CH$PLUS (.ESC_PTR, .EAT_CHR), CHR_NUL, ; 2887 4 .NUM_CHR_IN - .INDEX, .ESC_PTR); ; 2888 4 ; 2889 4 RETURN FALSE; ; 2890 3 END; ! End of CHK_FOR_EXIT .PSECT $PLIT$,NOWRT,NOEXE,2 P.ABW: .ASCII \Escape commands are:\ ; ; P.ABV: .LONG 17694740 ; ; .ADDRESS P.ABW ; ; P.ABY: .ASCII <9>\C - Return to VAX/VMS Kermit-32\ ; ; P.ABX: .LONG 17694752 ; ; .ADDRESS P.ABY ; ; P.ACA: .ASCII <9>\Q - Suspend logging to session log file (if any)\<0><0><0> ; ; P.ABZ: .LONG 17694769 ; ; .ADDRESS P.ACA ; ; P.ACC: .ASCII <9>\R - Resume logging to session log file (if any)\ ; ; P.ACB: .LONG 17694768 ; ; .ADDRESS P.ACC ; ; P.ACE: .ASCII <9>\S - Show status\ ; ; P.ACD: .LONG 17694736 ; ; .ADDRESS P.ACE ; ; P.ACG: .ASCII <9>\0 - Send a null\ ; ; P.ACF: .LONG 17694736 ; ; .ADDRESS P.ACG ; ; P.ACI: .ASCII <9>\? - Type this text\<0> ; ; P.ACH: .LONG 17694739 ; ; .ADDRESS P.ACI ; ; P.ACK: .ASCII <9><0><0><0> ; ; P.ACJ: .LONG 17694721 ; ; .ADDRESS P.ACK ; ; P.ACM: .ASCII \ - Send escape character\ ; ; P.ACL: .LONG 17694744 ; ; .ADDRESS P.ACM ; ; P.ACO: .ASCII \logging already disabled\ ; ; P.ACN: .LONG 17694744 ; ; .ADDRESS P.ACO ; ; P.ACQ: .ASCII \logging disabled\ ; ; P.ACP: .LONG 17694736 ; ; .ADDRESS P.ACQ ; ; P.ACS: .ASCII \no log file to enable\<0><0><0> ; ; P.ACR: .LONG 17694741 ; ; .ADDRESS P.ACS ; ; P.ACU: .ASCII \logging enabled\<0> ; ; P.ACT: .LONG 17694735 ; ; .ADDRESS P.ACU ; ; P.ACW: .ASCII \Connected to \<0><0><0> ; ; P.ACV: .LONG 17694733 ; ; .ADDRESS P.ACW ; ; P.ACY: .ASCII <9>\Escape character: "\ ; ; P.ACX: .LONG 17694740 ; ; .ADDRESS P.ACY ; ; P.ADA: .ASCII \"\<0><0><0> ; ; P.ACZ: .LONG 17694721 ; ; .ADDRESS P.ADA ; ; P.ADC: .ASCII <9>\Local echo: \<0><0><0> ; ; P.ADB: .LONG 17694733 ; ; .ADDRESS P.ADC ; ; P.ADE: .ASCII \On\<0><0> ; ; P.ADD: .LONG 17694722 ; ; .ADDRESS P.ADE ; ; P.ADG: .ASCII \Off\<0> ; ; P.ADF: .LONG 17694723 ; ; .ADDRESS P.ADG ; ; P.ADI: .ASCII <9>\Parity: \<0><0><0> ; ; P.ADH: .LONG 17694729 ; ; .ADDRESS P.ADI ; ; P.ADK: .ASCII \None\ ; ; P.ADJ: .LONG 17694724 ; ; .ADDRESS P.ADK ; ; P.ADM: .ASCII \Odd\<0> ; ; P.ADL: .LONG 17694723 ; ; .ADDRESS P.ADM ; ; P.ADO: .ASCII \Even\ ; ; P.ADN: .LONG 17694724 ; ; .ADDRESS P.ADO ; ; P.ADQ: .ASCII \Mark\ ; ; P.ADP: .LONG 17694724 ; ; .ADDRESS P.ADQ ; ; P.ADS: .ASCII \Space\<0><0><0> ; ; P.ADR: .LONG 17694725 ; ; .ADDRESS P.ADS ; ; P.ADU: .ASCII <9>\Logging: \<0><0> ; ; P.ADT: .LONG 17694730 ; ; .ADDRESS P.ADU ; ; P.ADW: .ASCII \ Enabled\ ; ; P.ADV: .LONG 17694728 ; ; .ADDRESS P.ADW ; ; P.ADY: .ASCII \ Disabled\<0><0><0> ; ; P.ADX: .LONG 17694729 ; ; .ADDRESS P.ADY ; ; P.AEA: .ASCII \ None specifed\<0><0> ; ; P.ADZ: .LONG 17694734 ; ; .ADDRESS P.AEA ; ; P.AEB: .BYTE 7 ; ; U.102= P.ACN U.103= P.ACP U.104= P.ACR U.105= P.ACT .PSECT $CODE$,NOWRT,2 ;CHK_FOR_EXIT U.99: .WORD ^M ;Save R2,R3,R4,R5,R6,R7,R8,R9,R10,R11 ; 2676 MOVAB G^ESCAPE_CHR, R11 ;ESCAPE_CHR, R11 ; MOVAB G^U.98, R10 ;U.98, R10 ; MOVAB B^U.100, R9 ;U.100, R9 ; MOVAB G^P.ABV, R8 ;P.ABV, R8 ; CLRL R7 ;INDEX ; 2684 MULL3 #80, 4(AP), R0 ;#80, INP_BUFNUM, R0 ; 2717 MOVAB -800(R10)[R0], R2 ;INP_BUF[R0], PTR0 ; CMPL -836(R10), #1 ;ESC_FLG, #1 ; 2719 BNEQ 1$ ;1$ ; CLRL R7 ;INDEX ; 2722 MOVL R2, R6 ;PTR0, ESC_PTR ; 2723 CLRL -836(R10) ;ESC_FLG ; 2724 BRB 5$ ;5$ ; 1$: LOCC (R11), (R10), (R2) ;ESCAPE_CHR, NUM_CHR_IN, (PTR0) ; 2728 BNEQ 2$ ;2$ ; CLRL R1 ;R1 ; 2$: MOVL R1, R6 ;R1, ESC_PTR ; BEQL 4$ ;4$ ; SUBL3 R6, R2, R7 ;ESC_PTR, PTR0, INDEX ; 2733 SUBL3 #1, (R10), R0 ;#1, NUM_CHR_IN, R0 ; 2735 MOVL R0, (R10) ;R0, NUM_CHR_IN ; CMPL R7, R0 ;INDEX, R0 ; BEQL 3$ ;3$ ; SUBL3 R7, (R10), R0 ;INDEX, NUM_CHR_IN, R0 ; 2738 MOVC3 R0, 1(R6), (R6) ;R0, 1(ESC_PTR), (ESC_PTR) ; 2739 BRB 5$ ;5$ ; 2738 3$: MOVL #1, -836(R10) ;#1, ESC_FLG ; 2743 4$: BRW 36$ ;36$ ; 2744 5$: CLRL R2 ;EAT_CHR ; 2749 CMPB (R6), #63 ;(ESC_PTR), #63 ; 2754 BNEQ 7$ ;7$ ; PUSHL #1 ;#1 ; 2756 MOVQ #1, -(SP) ;#1, -(SP) ; PUSHL R8 ;R8 ; CALLS #4, (R9) ;#4, TYPE_MSG ; PUSHL #1 ;#1 ; 2757 CLRQ -(SP) ;-(SP) ; PUSHAB 40(R8) ;P.ABX ; CALLS #4, (R9) ;#4, TYPE_MSG ; PUSHL #1 ;#1 ; 2758 CLRQ -(SP) ;-(SP) ; PUSHAB 100(R8) ;P.ABZ ; CALLS #4, (R9) ;#4, TYPE_MSG ; PUSHL #1 ;#1 ; 2760 CLRQ -(SP) ;-(SP) ; PUSHAB 156(R8) ;P.ACB ; CALLS #4, (R9) ;#4, TYPE_MSG ; PUSHL #1 ;#1 ; 2762 CLRQ -(SP) ;-(SP) ; PUSHAB 180(R8) ;P.ACD ; CALLS #4, (R9) ;#4, TYPE_MSG ; PUSHL #1 ;#1 ; 2763 CLRQ -(SP) ;-(SP) ; PUSHAB 204(R8) ;P.ACF ; CALLS #4, (R9) ;#4, TYPE_MSG ; PUSHL #1 ;#1 ; 2764 CLRQ -(SP) ;-(SP) ; PUSHAB 232(R8) ;P.ACH ; CALLS #4, (R9) ;#4, TYPE_MSG ; CLRQ -(SP) ;-(SP) ; 2765 CLRL -(SP) ;-(SP) ; PUSHAB 244(R8) ;P.ACJ ; CALLS #4, (R9) ;#4, TYPE_MSG ; PUSHL -44(R10) ;ESC_CHR_LEN ; 2766 PUSHAB -40(R10) ;ESC_CHR_MSG ; PUSHL #1 ;#1 ; CALLS #3, -289(R9) ;#3, STORE_INPUT ; PUSHL #1 ;#1 ; 2767 PUSHL #1 ;#1 ; CLRL -(SP) ;-(SP) ; PUSHAB 276(R8) ;P.ACL ; 6$: CALLS #4, (R9) ;#4, TYPE_MSG ; BRB 13$ ;13$ ; 2768 7$: CMPB (R6), #67 ;(ESC_PTR), #67 ; 2771 BEQL 8$ ;8$ ; CMPB (R6), #99 ;(ESC_PTR), #99 ; BNEQ 9$ ;9$ ; 8$: MOVL R7, (R10) ;INDEX, NUM_CHR_IN ; 2773 MOVL #1, R0 ;#1, R0 ; 2774 RET ; ; 9$: CMPB (R6), #81 ;(ESC_PTR), #81 ; 2777 BEQL 10$ ;10$ ; CMPB (R6), #113 ;(ESC_PTR), #113 ; BNEQ 14$ ;14$ ; 10$: BLBC -1572(R10), 11$ ;SESSION_LOGGING, 11$ ; 2784 PUSHL #1 ;#1 ; 2786 PUSHL #1 ;#1 ; PUSHL #1 ;#1 ; PUSHAB 332(R8) ;STOP_LOG_TEXT ; BRB 12$ ;12$ ; 11$: PUSHL #1 ;#1 ; 2788 PUSHL #1 ;#1 ; PUSHL #1 ;#1 ; PUSHAB 308(R8) ;NO_LOG_TEXT ; 12$: CALLS #4, (R9) ;#4, TYPE_MSG ; CLRL -1572(R10) ;SESSION_LOGGING ; 2790 13$: BRW 34$ ;34$ ; 2791 14$: CMPB (R6), #82 ;(ESC_PTR), #82 ; 2794 BEQL 15$ ;15$ ; CMPB (R6), #114 ;(ESC_PTR), #114 ; BNEQ 17$ ;17$ ; 15$: MOVL -1576(R10), -1572(R10) ;SESSION_OPEN, SESSION_LOGGING ; 2801 BLBC -1572(R10), 16$ ;SESSION_LOGGING, 16$ ; 2803 PUSHL #1 ;#1 ; 2805 PUSHL #1 ;#1 ; PUSHL #1 ;#1 ; PUSHAB 388(R8) ;START_LOG_TEXT ; BRB 6$ ;6$ ; 16$: PUSHL #1 ;#1 ; 2807 PUSHL #1 ;#1 ; PUSHL #1 ;#1 ; PUSHAB 364(R8) ;NO_LOG_TEXT ; BRB 6$ ;6$ ; 17$: CMPB (R6), #83 ;(ESC_PTR), #83 ; 2812 BEQL 18$ ;18$ ; CMPB (R6), #115 ;(ESC_PTR), #115 ; BEQL 18$ ;18$ ; BRW 31$ ;31$ ; 18$: CLRQ -(SP) ;-(SP) ; 2814 PUSHL #1 ;#1 ; PUSHAB 412(R8) ;P.ACV ; CALLS #4, (R9) ;#4, TYPE_MSG ; PUSHL #1 ;#1 ; 2815 CLRQ -(SP) ;-(SP) ; PUSHAB G^TERM_DESC ;TERM_DESC ; CALLS #4, (R9) ;#4, TYPE_MSG ; CLRQ -(SP) ;-(SP) ; 2816 CLRL -(SP) ;-(SP) ; PUSHAB 440(R8) ;P.ACX ; CALLS #4, (R9) ;#4, TYPE_MSG ; PUSHL -44(R10) ;ESC_CHR_LEN ; 2817 PUSHAB -40(R10) ;ESC_CHR_MSG ; PUSHL #1 ;#1 ; CALLS #3, -289(R9) ;#3, STORE_INPUT ; PUSHL #1 ;#1 ; 2818 CLRQ -(SP) ;-(SP) ; PUSHAB 452(R8) ;P.ACZ ; CALLS #4, (R9) ;#4, TYPE_MSG ; CLRQ -(SP) ;-(SP) ; 2819 CLRL -(SP) ;-(SP) ; PUSHAB 476(R8) ;P.ADB ; CALLS #4, (R9) ;#4, TYPE_MSG ; BLBC G^ECHO_FLAG, 19$ ;ECHO_FLAG, 19$ ; 2821 PUSHL #1 ;#1 ; 2823 CLRQ -(SP) ;-(SP) ; PUSHAB 488(R8) ;P.ADD ; BRB 20$ ;20$ ; 19$: PUSHL #1 ;#1 ; 2825 CLRQ -(SP) ;-(SP) ; PUSHAB 500(R8) ;P.ADF ; 20$: CALLS #4, (R9) ;#4, TYPE_MSG ; CLRQ -(SP) ;-(SP) ; 2827 CLRL -(SP) ;-(SP) ; PUSHAB 520(R8) ;P.ADH ; CALLS #4, (R9) ;#4, TYPE_MSG ; CASEL G^PARITY_TYPE, #0, #4 ;PARITY_TYPE, #0, #4 ; 2829 21$: .WORD 22$-21$,- ;22$-21$,- ; 25$-21$,- ;25$-21$,- ; 24$-21$,- ;24$-21$,- ; 23$-21$,- ;23$-21$,- ; 26$-21$ ;26$-21$ ; 22$: PUSHL #1 ;#1 ; 2833 CLRQ -(SP) ;-(SP) ; PUSHAB 532(R8) ;P.ADJ ; BRB 27$ ;27$ ; 23$: PUSHL #1 ;#1 ; 2836 CLRQ -(SP) ;-(SP) ; PUSHAB 544(R8) ;P.ADL ; BRB 27$ ;27$ ; 24$: PUSHL #1 ;#1 ; 2839 CLRQ -(SP) ;-(SP) ; PUSHAB 556(R8) ;P.ADN ; BRB 27$ ;27$ ; 25$: PUSHL #1 ;#1 ; 2842 CLRQ -(SP) ;-(SP) ; PUSHAB 568(R8) ;P.ADP ; BRB 27$ ;27$ ; 26$: PUSHL #1 ;#1 ; 2845 CLRQ -(SP) ;-(SP) ; PUSHAB 584(R8) ;P.ADR ; 27$: CALLS #4, (R9) ;#4, TYPE_MSG ; CLRQ -(SP) ;-(SP) ; 2848 CLRL -(SP) ;-(SP) ; PUSHAB 604(R8) ;P.ADT ; CALLS #4, (R9) ;#4, TYPE_MSG ; TSTL -1576(R10) ;SESSION_OPEN ; 2850 BLEQ 29$ ;29$ ; CLRQ -(SP) ;-(SP) ; 2853 CLRL -(SP) ;-(SP) ; PUSHAB G^SESSION_DESC ;SESSION_DESC ; CALLS #4, (R9) ;#4, TYPE_MSG ; BLBC -1572(R10), 28$ ;SESSION_LOGGING, 28$ ; 2855 PUSHL #1 ;#1 ; 2857 PUSHL #1 ;#1 ; CLRL -(SP) ;-(SP) ; PUSHAB 620(R8) ;P.ADV ; BRB 30$ ;30$ ; 28$: PUSHL #1 ;#1 ; 2859 PUSHL #1 ;#1 ; CLRL -(SP) ;-(SP) ; PUSHAB 640(R8) ;P.ADX ; BRB 30$ ;30$ ; 29$: PUSHL #1 ;#1 ; 2863 PUSHL #1 ;#1 ; CLRL -(SP) ;-(SP) ; PUSHAB 664(R8) ;P.ADZ ; 30$: BRW 6$ ;6$ ; 31$: MOVL (R11), R0 ;ESCAPE_CHR, R0 ; 2868 CMPZV #0, #8, (R6), R0 ;#0, #8, (ESC_PTR), R0 ; BNEQ 32$ ;32$ ; MOVB R0, (R6) ;R0, (ESC_PTR) ; 2869 BRB 35$ ;35$ ; 32$: CMPB (R6), #48 ;(ESC_PTR), #48 ; 2871 BNEQ 33$ ;33$ ; CLRB (R6) ;(ESC_PTR) ; 2872 BRB 35$ ;35$ ; 33$: PUSHL #1 ;#1 ; 2876 PUSHAB 672(R8) ;P.AEB ; PUSHL #1 ;#1 ; CALLS #3, -289(R9) ;#3, STORE_INPUT ; 34$: MOVL #1, R2 ;#1, EAT_CHR ; 2877 35$: TSTL R2 ;EAT_CHR ; 2881 BLEQ 36$ ;36$ ; SUBL3 R2, (R10), R0 ;EAT_CHR, NUM_CHR_IN, R0 ; 2884 MOVL R0, (R10) ;R0, NUM_CHR_IN ; CMPL R0, R7 ;R0, INDEX ; BEQL 36$ ;36$ ; SUBL3 R7, (R10), R0 ;INDEX, NUM_CHR_IN, R0 ; 2886 MOVC3 R0, (R2)[R6], (R6) ;R0, (EAT_CHR)[ESC_PTR], (ESC_PTR) ; 2887 36$: CLRL R0 ;R0 ; 2890 RET ; ; ; Routine Size: 679 bytes, Routine Base: $CODE$ + 0E5B ; 2891 3 %SBTTL 'TERM_CONNECT -- MYTINP' ; 2892 3 ! Main portion of MYTINP ; 2893 3 ; 2894 3 IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN RETURN .STATUS; ; 2895 3 ; 2896 3 NUM_CHR_IN = .IN_IOSB [MYT, .INP_BUFNUM, OFFSET] + .IN_IOSB [MYT, .INP_BUFNUM, EOFSIZ]; ; 2897 3 ; 2898 3 IF .NUM_CHR_IN NEQ 0 ; 2899 3 THEN ; 2900 3 ; 2901 3 IF CHK_FOR_EXIT (.INP_BUFNUM) ; 2902 3 THEN ; 2903 4 BEGIN ; 2904 4 $CANTIM (); ; 2905 4 $SETEF (EFN = XITEFN); ! Exit characters typed. Set flag. ; 2906 4 RETURN 1; ; 2907 4 END ; 2908 3 ELSE ; 2909 3 STORE_INPUT (MYT, CH$PTR (INP_BUF [MYT, .INP_BUFNUM]), .NUM_CHR_IN); ; 2910 3 ; 2911 3 ! Store char. ; 2912 3 ; 2913 3 IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) EQL SS$_WASCLR ; 2914 3 THEN ; 2915 3 ! If we got some characters, then queue up the next read for lots of ; 2916 3 ! characters with a 0 timeout (get what we can). Otherwise queue up ; 2917 3 ! a read for one character waiting forever. ; 2918 3 ; 2919 3 IF .NUM_CHR_IN GTR 0 OR .INP_BUFNUM NEQ 0 ; 2920 3 THEN ; 2921 3 ! Queue up a read for the console terminal ; P 2922 3 STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC OR IO$M_TIMED, ; P 2923 3 ASTADR = MYTINP, P1 = INP_BUF [MYT, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = 0, ; 2924 4 ASTPRM = .INP_BUFNUM, IOSB = IN_IOSB [MYT, .INP_BUFNUM, 0]) ; 2925 3 ELSE ; P 2926 3 STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC, ASTADR = MYTINP, ; P 2927 3 P1 = INP_BUF [MYT, .INP_BUFNUM], P2 = 1, ASTPRM = .INP_BUFNUM, ; 2928 3 IOSB = IN_IOSB [MYT, .INP_BUFNUM, 0]); ; 2929 3 ; 2930 3 IF NOT .STATUS ; 2931 3 THEN ; 2932 4 BEGIN ; 2933 4 LIB$SIGNAL (.STATUS); ; 2934 4 $SETEF (EFN = XITEFN); ; 2935 3 END; ; 2936 3 ; 2937 3 RETURN .STATUS; ; 2938 2 END; ! End of MYTINP ;MYTINP U.96: .WORD ^M ;Save R2,R3,R4,R5,R6,R7,R8 ; 2660 MOVAB G^SYS$SETEF, R8 ;SYS$SETEF, R8 ; MOVAB G^SYS$READEF, R7 ;SYS$READEF, R7 ; MOVAB B^U.96, R6 ;U.96, R6 ; MOVAB G^U.97, R5 ;U.97, R5 ; PUSHAB -4(R5) ;STATE ; 2894 PUSHL #5 ;#5 ; CALLS #2, (R7) ;#2, SYS$READEF ; MOVL R0, (R5) ;R0, STATUS ; CMPL R0, #1 ;R0, #1 ; BEQL 1$ ;1$ ; BRW 8$ ;8$ ; 1$: MOVL 4(AP), R2 ;INP_BUFNUM, R2 ; 2896 PUSHAQ -826(R5)[R2] ;IN_IOSB+2[R2] ; MOVZWL @(SP)+, R0 ;@(SP)+, R0 ; PUSHAQ -822(R5)[R2] ;IN_IOSB+6[R2] ; MOVZWL @(SP)+, R1 ;@(SP)+, R1 ; ADDL3 R1, R0, 4(R5) ;R1, R0, NUM_CHR_IN ; BEQL 3$ ;3$ ; 2898 PUSHL R2 ;R2 ; 2901 CALLS #1, -679(R6) ;#1, CHK_FOR_EXIT ; BLBC R0, 2$ ;R0, 2$ ; CLRQ -(SP) ;-(SP) ; 2904 CALLS #2, G^SYS$CANTIM ;#2, SYS$CANTIM ; PUSHL #5 ;#5 ; 2905 CALLS #1, (R8) ;#1, SYS$SETEF ; MOVL #1, R0 ;#1, R0 ; 2906 RET ; ; 2$: PUSHL 4(R5) ;NUM_CHR_IN ; 2909 MULL3 #80, R2, R0 ;#80, R2, R0 ; PUSHAB -796(R5)[R0] ;INP_BUF[R0] ; CLRL -(SP) ;-(SP) ; CALLS #3, -1061(R6) ;#3, STORE_INPUT ; 3$: PUSHAB -4(R5) ;STATE ; 2913 PUSHL #5 ;#5 ; CALLS #2, (R7) ;#2, SYS$READEF ; MOVL R0, (R5) ;R0, STATUS ; CMPL R0, #1 ;R0, #1 ; BNEQ 7$ ;7$ ; MULL3 #80, R2, R0 ;#80, R2, R0 ; 2924 MOVAB -796(R5)[R0], R4 ;INP_BUF[R0], R4 ; MOVAQ -828(R5)[R2], R3 ;IN_IOSB[R2], R3 ; MOVL -44(R5), R1 ;MYT_QIO_FUNC, R1 ; MOVL -840(R5), R0 ;MYT_CHAN, R0 ; TSTL 4(R5) ;NUM_CHR_IN ; 2919 BGTR 4$ ;4$ ; TSTL R2 ;R2 ; BEQL 5$ ;5$ ; 4$: CLRQ -(SP) ;-(SP) ; 2924 CLRQ -(SP) ;-(SP) ; MOVZBL #80, -(SP) ;#80, -(SP) ; PUSHR #^M ;#^M ; PUSHR #^M ;#^M ; BISL3 #128, R1, -(SP) ;#128, R1, -(SP) ; BRB 6$ ;6$ ; 5$: CLRQ -(SP) ;-(SP) ; 2928 CLRQ -(SP) ;-(SP) ; PUSHL #1 ;#1 ; PUSHR #^M ;#^M ; PUSHR #^M ;#^M ; 6$: PUSHL R0 ;R0 ; CLRL -(SP) ;-(SP) ; CALLS #12, G^SYS$QIO ;#12, SYS$QIO ; MOVL R0, (R5) ;R0, STATUS ; 7$: MOVL (R5), R0 ;STATUS, R0 ; 2930 BLBS R0, 8$ ;R0, 8$ ; PUSHL R0 ;R0 ; 2933 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; PUSHL #5 ;#5 ; 2934 CALLS #1, (R8) ;#1, SYS$SETEF ; 8$: MOVL (R5), R0 ;STATUS, R0 ; 2937 RET ; ; 2938 ; Routine Size: 252 bytes, Routine Base: $CODE$ + 1102 ; 2939 2 %SBTTL 'TERM_CONNECT -- TRMINP' ; 2940 2 ROUTINE TRMINP (INP_BUFNUM) = ; 2941 2 ; 2942 2 !++ ; 2943 2 ! This AST routine receives characters from the channel TERM_CHAN and ; 2944 2 ! outputs the characters to the channel MYT_CHAN. INP_BUFNUM contains ; 2945 2 ! the number of the input buffer. ; 2946 2 !-- ; 2947 2 ; 2948 3 BEGIN ; 2949 3 ; 2950 3 LOCAL ; 2951 3 NUM_CHR_IN, ; 2952 3 STATUS; ; 2953 3 ; 2954 3 IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) NEQ SS$_WASCLR THEN RETURN .STATUS; ; 2955 3 ; 2956 3 NUM_CHR_IN = .IN_IOSB [TRM, .INP_BUFNUM, OFFSET] + .IN_IOSB [TRM, .INP_BUFNUM, EOFSIZ]; ; 2957 3 ; 2958 3 IF .NUM_CHR_IN NEQ 0 ; 2959 3 THEN ; 2960 3 STORE_INPUT (TRM, CH$PTR (INP_BUF [TRM, .INP_BUFNUM]), ; 2961 3 .NUM_CHR_IN); ; 2962 3 ; 2963 3 IF (STATUS = $READEF (EFN = XITEFN, STATE = STATE)) EQL SS$_WASCLR ; 2964 3 THEN ; 2965 3 ! ; 2966 3 ! If we actually got something input, then queue up a read with a 0 ; 2967 3 ! timeout for the whole buffer. Otherwise, queue up a single character ; 2968 3 ! read, if this is the first buffer. ; 2969 3 ! ; 2970 3 ; 2971 3 IF .NUM_CHR_IN GTR 0 OR .INP_BUFNUM NEQ 0 ; 2972 3 THEN ; P 2973 3 STATUS = $QIO (CHAN = .TERM_CHAN, ; P 2974 3 FUNC = IO$_TTYREADALL OR IO$M_NOECHO OR IO$M_TIMED, ASTADR = TRMINP, ; P 2975 3 P1 = INP_BUF [TRM, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = 0, ; P 2976 3 IOSB = IN_IOSB [TRM, ; 2977 4 .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM) ; 2978 3 ELSE ; P 2979 3 STATUS = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO, ; P 2980 3 ASTADR = TRMINP, P1 = INP_BUF [TRM, .INP_BUFNUM], P2 = 1, ; P 2981 3 IOSB = IN_IOSB [TRM, ; 2982 3 .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM); ; 2983 3 ; 2984 3 IF NOT .STATUS ; 2985 3 THEN ; 2986 4 BEGIN ; 2987 4 LIB$SIGNAL (.STATUS); ; 2988 4 $SETEF (EFN = XITEFN); ; 2989 3 END; ; 2990 3 ; 2991 3 RETURN .STATUS; ; 2992 2 END; ! End of TRMINP ;TRMINP U.106: .WORD ^M ;Save R2,R3,R4,R5,R6,R7,R8 ; 2940 MOVAB G^SYS$READEF, R8 ;SYS$READEF, R8 ; MOVAB B^U.106, R7 ;U.106, R7 ; MOVAB G^U.81, R6 ;U.81, R6 ; PUSHL R6 ;R6 ; 2954 PUSHL #5 ;#5 ; CALLS #2, (R8) ;#2, SYS$READEF ; MOVL R0, R5 ;R0, STATUS ; CMPL R5, #1 ;STATUS, #1 ; BEQL 1$ ;1$ ; BRW 7$ ;7$ ; 1$: MOVL 4(AP), R2 ;INP_BUFNUM, R2 ; 2956 PUSHAQ -806(R6)[R2] ;IN_IOSB+18[R2] ; MOVZWL @(SP)+, R4 ;@(SP)+, NUM_CHR_IN ; PUSHAQ -802(R6)[R2] ;IN_IOSB+22[R2] ; MOVZWL @(SP)+, R0 ;@(SP)+, R0 ; ADDL2 R0, R4 ;R0, NUM_CHR_IN ; BEQL 2$ ;2$ ; 2958 PUSHL R4 ;NUM_CHR_IN ; 2961 MULL3 #80, R2, R0 ;#80, R2, R0 ; 2960 PUSHAB -631(R6)[R0] ;INP_BUF+161[R0] ; PUSHL #1 ;#1 ; CALLS #3, -1313(R7) ;#3, STORE_INPUT ; 2$: PUSHL R6 ;R6 ; 2963 PUSHL #5 ;#5 ; CALLS #2, (R8) ;#2, SYS$READEF ; MOVL R0, R5 ;R0, STATUS ; CMPL R5, #1 ;STATUS, #1 ; BNEQ 6$ ;6$ ; MULL3 #80, R2, R0 ;#80, R2, R0 ; 2977 MOVAB -631(R6)[R0], R3 ;INP_BUF+161[R0], R3 ; MOVAQ -808(R6)[R2], R1 ;IN_IOSB+16[R2], R1 ; MOVL -1956(R6), R0 ;TERM_CHAN, R0 ; TSTL R4 ;NUM_CHR_IN ; 2971 BGTR 3$ ;3$ ; TSTL R2 ;R2 ; BEQL 4$ ;4$ ; 3$: CLRQ -(SP) ;-(SP) ; 2977 CLRQ -(SP) ;-(SP) ; MOVZBL #80, -(SP) ;#80, -(SP) ; PUSHR #^M ;#^M ; PUSHR #^M ;#^M ; MOVZBL #250, -(SP) ;#250, -(SP) ; BRB 5$ ;5$ ; 4$: CLRQ -(SP) ;-(SP) ; 2982 CLRQ -(SP) ;-(SP) ; PUSHL #1 ;#1 ; PUSHR #^M ;#^M ; PUSHR #^M ;#^M ; MOVZBL #122, -(SP) ;#122, -(SP) ; 5$: PUSHL R0 ;R0 ; CLRL -(SP) ;-(SP) ; CALLS #12, G^SYS$QIO ;#12, SYS$QIO ; MOVL R0, R5 ;R0, STATUS ; 6$: BLBS R5, 7$ ;STATUS, 7$ ; 2984 PUSHL R5 ;STATUS ; 2987 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; PUSHL #5 ;#5 ; 2988 CALLS #1, G^SYS$SETEF ;#1, SYS$SETEF ; 7$: MOVL R5, R0 ;STATUS, R0 ; 2991 RET ; ; 2992 ; Routine Size: 208 bytes, Routine Base: $CODE$ + 11FE ; 2993 2 %SBTTL 'TERM_CONNECT -- ESC_MSG' ; 2994 2 ROUTINE ESC_MSG (ESC_TEXT) = ; 2995 3 BEGIN ; 2996 3 ; 2997 3 MAP ; 2998 3 ESC_TEXT : REF VECTOR [, BYTE]; ; 2999 3 ; 3000 3 SELECTONE .ESCAPE_CHR OF ; 3001 3 SET ; 3002 3 ; 3003 3 [CHR_NUL, 0] : ; 3004 4 BEGIN ; 3005 4 ; 3006 4 BIND ; 3007 4 NUL_TXT = %ASCID'^@ or control-space on VT-100'; ; 3008 4 ; 3009 4 MAP ; 3010 4 NUL_TXT : BLOCK [8, BYTE]; ; 3011 4 ; 3012 4 CH$MOVE (.NUL_TXT [DSC$W_LENGTH], CH$PTR (.NUL_TXT [DSC$A_POINTER]), ; 3013 4 CH$PTR (.ESC_TEXT)); ; 3014 4 RETURN .NUL_TXT [DSC$W_LENGTH]; ; 3015 3 END; ; 3016 3 ; 3017 3 [CHR_RS, %O'36'] : ; 3018 4 BEGIN ; 3019 4 ; 3020 4 BIND ; 3021 4 RS_TXT = %ASCID'^^ or ^~ on VT-100'; ; 3022 4 ; 3023 4 MAP ; 3024 4 RS_TXT : BLOCK [8, BYTE]; ; 3025 4 ; 3026 4 CH$MOVE (.RS_TXT [DSC$W_LENGTH], CH$PTR (.RS_TXT [DSC$A_POINTER]), ; 3027 4 CH$PTR (.ESC_TEXT)); ; 3028 4 RETURN .RS_TXT [DSC$W_LENGTH]; ; 3029 3 END; ; 3030 3 ; 3031 3 [CHR_US, %O'37'] : ; 3032 4 BEGIN ; 3033 4 ; 3034 4 BIND ; 3035 4 US_TXT = %ASCID'^_ or ^? on VT-100'; ; 3036 4 ; 3037 4 MAP ; 3038 4 US_TXT : BLOCK [8, BYTE]; ; 3039 4 ; 3040 4 CH$MOVE (.US_TXT [DSC$W_LENGTH], CH$PTR (.US_TXT [DSC$A_POINTER]), ; 3041 4 CH$PTR (.ESC_TEXT)); ; 3042 4 RETURN .US_TXT [DSC$W_LENGTH]; ; 3043 3 END; ; 3044 3 ; 3045 3 [1 TO %O'37'] : ; 3046 4 BEGIN ; 3047 4 ESC_TEXT [0] = %C'^'; ; 3048 4 ESC_TEXT [1] = .ESCAPE_CHR + %O'100'; ; 3049 4 RETURN 2; ; 3050 3 END; ; 3051 3 ; 3052 3 [CHR_DEL, %O'177'] : ; 3053 4 BEGIN ; 3054 4 ESC_TEXT = 'DEL'; ; 3055 4 RETURN 3; ; 3056 3 END; ; 3057 3 TES; ; 3058 3 ; 3059 3 RETURN 0; ! No escape character? ; 3060 2 END; ! End of ESC_MSG .PSECT $PLIT$,NOWRT,NOEXE,2 .BLKB 3 P.AED: .ASCII \^@ or control-space on VT-100\<0><0><0> ; ; P.AEC: .LONG 17694749 ; ; .ADDRESS P.AED ; ; P.AEF: .ASCII \^^ or ^~ on VT-100\<0><0> ; ; P.AEE: .LONG 17694738 ; ; .ADDRESS P.AEF ; ; P.AEH: .ASCII \^_ or ^? on VT-100\<0><0> ; ; P.AEG: .LONG 17694738 ; ; .ADDRESS P.AEH ; ; U.109= P.AEC U.111= P.AEE U.113= P.AEG .PSECT $CODE$,NOWRT,2 ;ESC_MSG U.107: .WORD ^M ;Save R2,R3,R4,R5,R6,R7,R8 ; 2994 MOVAB G^U.109, R8 ;U.109, R8 ; MOVL G^ESCAPE_CHR, R6 ;ESCAPE_CHR, R6 ; 3000 BNEQ 1$ ;1$ ; 3003 MOVZWL (R8), R7 ;NUL_TXT, R7 ; 3012 MOVL 4(R8), R0 ;NUL_TXT+4, R0 ; BRB 3$ ;3$ ; 3013 1$: CMPL R6, #30 ;R6, #30 ; 3017 BNEQ 2$ ;2$ ; MOVZWL 28(R8), R7 ;RS_TXT, R7 ; 3026 MOVL 32(R8), R0 ;RS_TXT+4, R0 ; BRB 3$ ;3$ ; 3027 2$: CMPL R6, #31 ;R6, #31 ; 3031 BNEQ 4$ ;4$ ; MOVZWL 56(R8), R7 ;US_TXT, R7 ; 3040 MOVL 60(R8), R0 ;US_TXT+4, R0 ; 3$: MOVC3 R7, (R0), @4(AP) ;R7, (R0), @ESC_TEXT ; 3041 MOVL R7, R0 ;R7, R0 ; 3042 RET ; ; 4$: TSTL R6 ;R6 ; 3045 BLEQ 5$ ;5$ ; CMPL R6, #31 ;R6, #31 ; BGTR 5$ ;5$ ; MOVL 4(AP), R0 ;ESC_TEXT, R0 ; 3047 MOVB #94, (R0) ;#94, (R0) ; ADDB3 #64, R6, 1(R0) ;#64, R6, 1(R0) ; 3048 MOVL #2, R0 ;#2, R0 ; 3049 RET ; ; 5$: CMPL R6, #127 ;R6, #127 ; 3052 BNEQ 6$ ;6$ ; MOVL #4998468, 4(AP) ;#4998468, ESC_TEXT ; 3054 MOVL #3, R0 ;#3, R0 ; 3055 RET ; ; 6$: CLRL R0 ;R0 ; 3059 RET ; ; 3060 ; Routine Size: 115 bytes, Routine Base: $CODE$ + 12CE ; 3061 2 %SBTTL 'TERM_CONNECT -- COMND_TRANSMIT' ; 3062 2 ; 3063 2 GLOBAL ROUTINE COMND_TRANSMIT : NOVALUE = ! and below ; 3064 2 ; 3065 2 !++ ; 3066 2 ! FUNCTIONAL DESCRIPTION: ; 3067 2 ! ; 3068 2 ! This routine transmits a file (or files) to the remote side one character ; 3069 2 ! at a time. It can display the numbers of the lines as they are transfered, ; 3070 2 ! or echo back to the controling terminal from the remote so that progress of ; 3071 2 ! the transmit can be monitored. It can also delay between 0 and .9 secs ; 3072 2 ! after each carriage return for machines that cannot keep up with the ; 3073 2 ! transfer. The file is transmitted blindly (except line feeds are removed) ; 3074 2 ! with no error correction or packets. This is useful for sending files to ; 3075 2 ! systems where KERMIT is unavailable. ; 3076 2 ! ; 3077 2 ! CALLING SEQUENCE: ; 3078 2 ! ; 3079 2 ! COMND_TRANSMIT (); ; 3080 2 ! ; 3081 2 ! IMPLICIT INPUTS: ; 3082 2 ! ; 3083 2 ! TRANS_DELAY - time (0.0 - 0.9 seconds) to delay after carriage return is transmitted. ; 3084 2 ! TRANS_ECHO_FLAG - flags whether data from remote side is echoed to the console terminal (ON); ; 3085 2 ! or line numbers are printed during transmit. ; 3086 2 ! ; 3087 2 ! IMPLICIT OUTPUTS: ; 3088 2 ! ; 3089 2 ! None ; 3090 2 ! ; 3091 2 ! COMPLETION_CODES: ; 3092 2 ! ; 3093 2 ! Standard status values. ; 3094 2 ! ; 3095 2 ! SIDE EFFECTS: ; 3096 2 ! ; 3097 2 ! Line feed characters are not transmitted. ; 3098 2 !-- ; 3099 2 ; 3100 3 BEGIN ; 3101 3 ; 3102 3 EXTERNAL ; 3103 3 FILE_SIZE, ; 3104 3 FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], ; 3105 3 TY_FIL; ; 3106 3 ; 3107 3 EXTERNAL ROUTINE ; 3108 3 FILE_OPEN; ; 3109 3 ; 3110 3 LOCAL ; 3111 3 STATUS, ! KERMIT status values ; 3112 3 TRANSMIT_DELAY : VECTOR [CH$ALLOCATION(8)], ! String for transmit delay ; 3113 3 TR_DESC : BLOCK [8,BYTE]; ! Descriptor for transmit delay ; 3114 3 ; 3115 3 OWN ; 3116 3 SAVE_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], ! File name ; 3117 3 SAVE_FILE_SIZE, ! File size ; 3118 3 SAVE_TY_FIL, ! File type out flag ; 3119 3 DELAY : VECTOR [2,LONG,SIGNED]; ! Time after transmitting carriage return ; 3120 3 ; 3121 3 BIND ; 3122 3 D_TIME = PLIT('0 ::00.'); ! First part of delta time used to find delay ; 3123 3 ; 3124 3 %SBTTL 'TERM_CONNECT -- TRANSMIT_FILE' ; 3125 3 ; 3126 3 ROUTINE TRANSMIT_FILE = ! and below ; 3127 3 ; 3128 3 !++ ; 3129 3 ! FUNCTIONAL DESCRIPTION: ; 3130 3 ! ; 3131 3 ! This routine transmits the current file (that has already been opened) and ; 3132 3 ! then opens the next file (if there is one). ; 3133 3 ! ; 3134 3 !-- ; 3135 4 BEGIN ! TRANSMIT_FILE ; 3136 4 ; 3137 4 EXTERNAL ; 3138 4 ABT_ALL_FILE, ; 3139 4 ABT_CUR_FILE, ; 3140 4 SMG$_PASALREXI, ! Pasteboard exits for device msg ; 3141 4 FLAG_FILE_OPEN; ; 3142 4 ; 3143 4 EXTERNAL ROUTINE ; 3144 4 NEXT_FILE, ; 3145 4 FILE_OPEN, ; 3146 4 FILE_CLOSE, ; 3147 4 TT_TEXT, ; 3148 4 TT_CRLF : NOVALUE, ; 3149 4 SY_DISMISS : NOVALUE, ; 3150 4 SMG$CREATE_PASTEBOARD : ADDRESSING_MODE (GENERAL), ; 3151 4 SMG$DELETE_PASTEBOARD : ADDRESSING_MODE (GENERAL); ; 3152 4 ; 3153 4 LOCAL ; 3154 4 STATUS, ! KERMIT status values ; 3155 4 ISTAT, ! qiow status values ; 3156 4 PASTE_STAT, ! SMG status values ; 3157 4 NEW_ID : VECTOR [1, LONG, UNSIGNED]; ! Dummy new pasteboard id ; 3158 4 ; 3159 4 OWN ; 3160 4 LINE_NUM; ! Line number counter ; 3161 4 ; 3162 4 %SBTTL 'TERM_CONNECT -- TRANSMIT_CHARACTERS' ; 3163 4 ; 3164 4 ROUTINE TRANSMIT_CHARACTERS : NOVALUE = ! and below ; 3165 4 ; 3166 4 !++ ; 3167 4 ! FUNCTIONAL DESCRIPTION: ; 3168 4 ! ; 3169 4 ! This routine is a loop that transmits all of the characters in a file, ; 3170 4 ! one character per pass. ; 3171 4 ! ; 3172 4 !-- ; 3173 5 BEGIN ! TRANSMIT_CHARACTERS ; 3174 5 ; 3175 5 LITERAL ; 3176 5 WAIT_EFN = 22, ; 3177 5 CHARACTER_LEN = 1; ; 3178 5 ; 3179 5 EXTERNAL ROUTINE ; 3180 5 GET_FILE, ; 3181 5 TT_NUMBER, ; 3182 5 TT_OUTPUT : NOVALUE; ; 3183 5 ; 3184 5 LOCAL ; 3185 5 STATUS, ! KERMIT status values ; 3186 5 TSTAT, ! timer status values ; 3187 5 ISTAT, ! qiow status values ; 3188 5 CHARACTER, ! Character from get-a-char routine ; 3189 5 TERM_IOSB : VECTOR [4, WORD, UNSIGNED]; ! IO status block for term chan ; 3190 5 ! ; 3191 5 ! Begin TRANSMIT_CHARACTERS: ; 3192 5 ! ; 3193 5 DO ; 3194 5 ; 3195 6 BEGIN ! Transmit a character ; 3196 6 ! Get next character ; 3197 6 STATUS = GET_FILE (CHARACTER); ; 3198 6 ; 3199 6 IF .STATUS AND NOT .STATUS EQL KER_EOF AND NOT .CHARACTER EQL CHR_LFD ! Did we get one? ; 3200 6 THEN ; 3201 6 ; 3202 7 BEGIN ! Have a character ; 3203 7 ! Write character out transfer terminal: ; P 3204 7 ISTAT = $QIOW (CHAN = .TERM_CHAN, EFN = TERM_O_EFN, ; P 3205 7 FUNC = IO$_WRITEVBLK + IO$M_NOFORMAT, ; P 3206 7 IOSB = TERM_IOSB, ; 3207 7 P1 = CHARACTER, P2 = CHARACTER_LEN); ; 3208 7 IF NOT .ISTAT THEN LIB$SIGNAL (.ISTAT); ; 3209 7 IF NOT .TERM_IOSB THEN LIB$SIGNAL (.TERM_IOSB); ; 3210 7 IF .CHARACTER EQL CHR_CRT ; 3211 7 THEN ; 3212 8 BEGIN ! Just transmitted a carriage return ; 3213 8 ; 3214 8 IF NOT .DELAY EQL 0 ; 3215 8 THEN ; 3216 8 ! Delay desired time: ; 3217 9 BEGIN ; 3218 9 TSTAT = $SETIMR (EFN = WAIT_EFN, DAYTIM = DELAY); ; 3219 9 IF NOT .STATUS THEN LIB$SIGNAL (.TSTAT); ; 3220 9 TSTAT = $WAITFR (EFN = WAIT_EFN); ; 3221 9 IF NOT .STATUS THEN LIB$SIGNAL (.TSTAT); ; 3222 8 END; ; 3223 8 ; 3224 8 IF NOT .TRANS_ECHO_FLAG ; 3225 8 THEN ; 3226 8 ! Purge term_chan typeahead buffer to get rid of the echoed data and type packet number to console: ; 3227 9 BEGIN ; P 3228 9 TSTAT = $QIOW (CHAN = .TERM_CHAN, FUNC = IO$_READVBLK OR IO$M_PURGE, ; 3229 9 P1 = INP_BUF [TRM, 0], P2 = 0, IOSB = IN_IOSB [TRM, 0, 0]); ; 3230 9 IF NOT .TSTAT THEN LIB$SIGNAL (.TSTAT); ; 3231 9 TT_NUMBER (.LINE_NUM); ; 3232 9 TT_TEXT (UPLIT (%ASCIZ' ')); ; 3233 9 TT_OUTPUT (); ; 3234 9 LINE_NUM = .LINE_NUM + 1; ; 3235 8 END; ; 3236 8 ; 3237 7 END; ! Just transmitted a cariage return ; 3238 7 ; 3239 6 END; ! Have a character ; 3240 6 ; 3241 6 END ! Transmit a character ; 3242 5 UNTIL NOT .STATUS OR .STATUS EQL KER_EOF OR NOT .ISTAT OR NOT .TERM_IOSB ; 3243 5 OR .FORCE_ABORT OR .ABT_CUR_FILE OR .ABT_ALL_FILE; ; 3244 5 ; 3245 4 END; ! End TRANSMIT_CHARACTERS .PSECT $PLIT$,NOWRT,NOEXE,2 .LONG 2 ; ; P.AEI: .ASCII \0 ::00.\<0> ; ; P.AEJ: .ASCII \ \<0><0><0> ; ; .PSECT $OWN$,NOEXE,2 ;SAVE_FILE_NAME U.116: .BLKB 132 ;SAVE_FILE_SIZE U.117: .BLKB 4 ;SAVE_TY_FIL U.118: .BLKB 4 ;DELAY U.119: .BLKB 8 ;LINE_NUM U.122: .BLKB 4 U.120= P.AEI .EXTRN FILE_SIZE, FILE_NAME, TY_FIL, FILE_OPEN, SMG$_PASALREXI, FLAG_FILE_OPEN, NEXT_FILE .EXTRN FILE_CLOSE, TT_TEXT, SY_DISMISS, SMG$CREATE_PASTEBOARD, SMG$DELETE_PASTEBOARD, GET_FILE .EXTRN TT_NUMBER, TT_OUTPUT .PSECT $CODE$,NOWRT,2 ;TRANSMIT_CHARACTERS U.123: .WORD ^M ;Save R2,R3,R4,R5,R6,R7 ; 3164 MOVAB G^SYS$QIOW, R7 ;SYS$QIOW, R7 ; MOVAB G^LIB$SIGNAL, R6 ;LIB$SIGNAL, R6 ; MOVAB G^U.4, R5 ;U.4, R5 ; SUBL2 #12, SP ;#12, SP ; 1$: PUSHL SP ;SP ; 3197 CALLS #1, G^GET_FILE ;#1, GET_FILE ; MOVL R0, R3 ;R0, STATUS ; BLBS R3, 2$ ;STATUS, 2$ ; 3199 RET ; ; 2$: CMPL R3, #134316131 ;STATUS, #134316131 ; BEQL 5$ ;5$ ; CMPL (SP), #10 ;CHARACTER, #10 ; BEQL 5$ ;5$ ; CLRQ -(SP) ;-(SP) ; 3207 CLRQ -(SP) ;-(SP) ; PUSHL #1 ;#1 ; PUSHAB 20(SP) ;CHARACTER ; CLRQ -(SP) ;-(SP) ; PUSHAB 36(SP) ;TERM_IOSB ; MOVZWL #304, -(SP) ;#304, -(SP) ; PUSHL (R5) ;TERM_CHAN ; PUSHL #4 ;#4 ; CALLS #12, (R7) ;#12, SYS$QIOW ; MOVL R0, R4 ;R0, ISTAT ; BLBS R4, 3$ ;ISTAT, 3$ ; 3208 PUSHL R4 ;ISTAT ; CALLS #1, (R6) ;#1, LIB$SIGNAL ; 3$: BLBS 4(SP), 4$ ;TERM_IOSB, 4$ ; 3209 PUSHL 4(SP) ;TERM_IOSB ; CALLS #1, (R6) ;#1, LIB$SIGNAL ; 4$: CMPL (SP), #13 ;CHARACTER, #13 ; 3210 BEQL 6$ ;6$ ; 5$: BRW 10$ ;10$ ; 6$: TSTL 2108(R5) ;DELAY ; 3214 BEQL 8$ ;8$ ; CLRQ -(SP) ;-(SP) ; 3218 PUSHAB 2108(R5) ;DELAY ; PUSHL #22 ;#22 ; CALLS #4, G^SYS$SETIMR ;#4, SYS$SETIMR ; MOVL R0, R2 ;R0, TSTAT ; BLBS R3, 7$ ;STATUS, 7$ ; 3219 PUSHL R2 ;TSTAT ; CALLS #1, (R6) ;#1, LIB$SIGNAL ; 7$: PUSHL #22 ;#22 ; 3220 CALLS #1, G^SYS$WAITFR ;#1, SYS$WAITFR ; MOVL R0, R2 ;R0, TSTAT ; BLBS R3, 8$ ;STATUS, 8$ ; 3221 PUSHL R2 ;TSTAT ; CALLS #1, (R6) ;#1, LIB$SIGNAL ; 8$: BLBS G^TRANS_ECHO_FLAG, 10$ ;TRANS_ECHO_FLAG, 10$ ; 3224 CLRQ -(SP) ;-(SP) ; 3229 CLRQ -(SP) ;-(SP) ; CLRL -(SP) ;-(SP) ; PUSHAB 1325(R5) ;INP_BUF+161 ; CLRQ -(SP) ;-(SP) ; PUSHAB 1148(R5) ;IN_IOSB+16 ; MOVZWL #2097, -(SP) ;#2097, -(SP) ; PUSHL (R5) ;TERM_CHAN ; CLRL -(SP) ;-(SP) ; CALLS #12, (R7) ;#12, SYS$QIOW ; MOVL R0, R2 ;R0, TSTAT ; BLBS R2, 9$ ;TSTAT, 9$ ; 3230 PUSHL R2 ;TSTAT ; CALLS #1, (R6) ;#1, LIB$SIGNAL ; 9$: PUSHL 2116(R5) ;LINE_NUM ; 3231 CALLS #1, G^TT_NUMBER ;#1, TT_NUMBER ; PUSHAB G^P.AEJ ;P.AEJ ; 3232 CALLS #1, G^TT_TEXT ;#1, TT_TEXT ; CALLS #0, G^TT_OUTPUT ;#0, TT_OUTPUT ; 3233 INCL 2116(R5) ;LINE_NUM ; 3234 10$: BLBC R3, 11$ ;STATUS, 11$ ; 3242 CMPL R3, #134316131 ;STATUS, #134316131 ; BEQL 11$ ;11$ ; BLBC R4, 11$ ;ISTAT, 11$ ; BLBC 4(SP), 11$ ;TERM_IOSB, 11$ ; BLBS -12(R5), 11$ ;FORCE_ABORT, 11$ ; 3243 BLBS G^ABT_CUR_FILE, 11$ ;ABT_CUR_FILE, 11$ ; BLBS G^ABT_ALL_FILE, 11$ ;ABT_ALL_FILE, 11$ ; BRW 1$ ;1$ ; 11$: RET ; ; 3245 ; Routine Size: 285 bytes, Routine Base: $CODE$ + 1341 ; 3246 4 ! ; 3247 4 ! Begin TRANSMIT_FILE: ; 3248 4 ! ; 3249 4 FLAG_FILE_OPEN = TRUE; ; 3250 4 TT_TEXT (UPLIT (%ASCIZ' File: ')); ; 3251 4 TT_TEXT (FILE_NAME); ! Type out file name ; 3252 4 TT_CRLF (); ; 3253 4 FILE_SIZE = .SAVE_FILE_SIZE; ! Reset the file name size ; 3254 4 INCR I FROM 0 TO .FILE_SIZE - 1 DO ; 3255 4 FILE_NAME [.I] = .SAVE_FILE_NAME [.I]; ; 3256 4 TY_FIL = .SAVE_TY_FIL; ! Reset type out flag ; 3257 4 LINE_NUM = 1; ! Initialize line number counter ; 3258 4 ; 3259 5 IF (STATUS = TERM_OPEN (TRUE)) ! Open the terminal ; 3260 4 THEN ; 3261 4 ; 3262 5 BEGIN ! Term open ; 3263 5 ! Cancel qio's to term_chan to start from scratch: ; 3264 5 STATUS = $CANCEL (CHAN = .TERM_CHAN); ; 3265 5 IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); ; 3266 5 ; 3267 5 ! Test to see if we are supposed to echo from the term_chan to the cons_chan: ; 3268 5 IF .TRANS_ECHO_FLAG ; 3269 5 THEN ; 3270 5 ; 3271 6 BEGIN ! Echo data ; 3272 6 ! Clear screen (by creating a default pasteboard using SMG utility): ; 3273 6 SY_DISMISS (3); ! Wait a bit so user can see file name ; 3274 6 PASTE_STAT = SMG$CREATE_PASTEBOARD (NEW_ID); ; 3275 6 IF NOT .PASTE_STAT THEN LIB$SIGNAL (.PASTE_STAT); ; 3276 6 ; 3277 6 ! Prepare event flags ; 3278 6 $CLREF (EFN = XITEFN); ; 3279 6 INCR FLAG FROM 1 TO XITEFN - 1 DO ; 3280 6 $SETEF (EFN = .FLAG); ; 3281 6 $SETAST (ENBFLG = 0); ! Disable AST until after all QIOs ; 3282 6 ; 3283 6 ! Set up read qio's to echo characters to controling terminal ; P 3284 6 ISTAT = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO, ; P 3285 6 ASTADR = TRMINP, P1 = INP_BUF [TRM, 0], P2 = INP_BUFSIZ, P3 = 0, ; 3286 6 IOSB = IN_IOSB [TRM, 0, 0], ASTPRM = 0); ; 3287 6 IF NOT .ISTAT THEN LIB$SIGNAL (.ISTAT); ; 3288 6 INCR INP_BUFNUM FROM 1 TO NUM_IN_BUF - 1 DO ; 3289 7 BEGIN ; P 3290 7 ISTAT = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR ; P 3291 7 IO$M_NOECHO OR IO$M_TIMED, ASTADR=TRMINP, ; P 3292 7 P1=INP_BUF[TRM,.INP_BUFNUM], P2=INP_BUFSIZ, P3=0, ; 3293 7 IOSB = IN_IOSB [TRM, .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM); ; 3294 7 IF NOT .ISTAT THEN LIB$SIGNAL (.ISTAT); ; 3295 6 END; ; 3296 6 $SETAST (ENBFLG = 1); ! Enable AST ; 3297 6 END ! End echo data ; 3298 6 ; 3299 5 ELSE ! No echo; output line number title to console: ; 3300 5 ; 3301 5 TT_TEXT (UPLIT (%ASCIZ' Transmitting line number... ')); ; 3302 5 ; 3303 5 ! Start a loop that handles one character per pass: ; 3304 5 TRANSMIT_CHARACTERS (); ; 3305 5 ; 3306 5 ! Finished transmitting file - close it: ; 3307 5 FILE_CLOSE (); ; 3308 5 ABT_CUR_FILE = FALSE; ; 3309 5 IF .TRANS_ECHO_FLAG THEN SY_DISMISS (1); ! Wait a bit so user can see the end of the file ; 3310 5 ; 3311 5 ! Cancel read qio's: ; 3312 5 $SETAST (ENBFLG = 0); ! Disable AST's ; 3313 5 STATUS = $CANCEL (CHAN = .TERM_CHAN); ; 3314 5 IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); ; 3315 5 STATUS = $CANCEL (CHAN = .CONS_CHAN); ; 3316 5 IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); ; 3317 5 ; 3318 5 ! Clear screen again if we did it before - ie delete pasteboard if we created one: ; 3319 5 IF .TRANS_ECHO_FLAG AND NOT .PASTE_STAT EQL SMG$_PASALREXI ; 3320 5 THEN ; 3321 6 BEGIN ; 3322 6 PASTE_STAT = SMG$DELETE_PASTEBOARD (NEW_ID); ; 3323 6 IF NOT .PASTE_STAT THEN LIB$SIGNAL (.PASTE_STAT); ; 3324 6 END ; 3325 5 ELSE ; 3326 6 BEGIN ; 3327 6 TT_CRLF (); ; 3328 6 TT_CRLF (); ; 3329 5 END; ; 3330 5 ; 3331 5 ! Post normal qio's that were canceled: ; 3332 5 STATUS = DO_CONS_QIO(); ; 3333 5 IF NOT .STATUS ; 3334 5 THEN ; 3335 6 BEGIN ; 3336 6 LIB$SIGNAL (.STATUS); ; 3337 6 RETURN KER_RECERR ; 3338 5 END; ; 3339 5 ; 3340 5 STATUS = DO_RECEIVE_QIO(); ; 3341 5 IF NOT .STATUS ; 3342 5 THEN ; 3343 6 BEGIN ; 3344 6 LIB$SIGNAL (.STATUS); ; 3345 6 RETURN KER_RECERR ; 3346 5 END; ; 3347 5 ; 3348 5 ! Close the console terminal to clean up: ; 3349 5 STATUS = TERM_CLOSE (); ; 3350 5 IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); ; 3351 5 $SETAST (ENBFLG = 1); ! Enable AST's ; 3352 4 END; ! Term open ; 3353 4 ; 3354 4 ! Determine if there is another file to send. ; 3355 4 SAVE_TY_FIL = .TY_FIL; ! Save current type out flag ; 3356 4 TY_FIL = FALSE; ! Supress the type out of names ; 3357 4 IF NOT .ABT_ALL_FILE AND NOT .FORCE_ABORT THEN STATUS=NEXT_FILE () ELSE STATUS=KER_NOMORFILES; ; 3358 4 TY_FIL = .SAVE_TY_FIL; ! Reset the type out flag ; 3359 4 ABT_ALL_FILE = FALSE; ; 3360 4 FORCE_ABORT = FALSE; ; 3361 4 FORCE_TIMEOUT = FALSE; ; 3362 4 RETURN .STATUS; ; 3363 4 ; 3364 3 END; ! End TRANSMIT_FILE .PSECT $PLIT$,NOWRT,NOEXE,2 P.AEK: .ASCII \ File: \<0><0> ; ; P.AEL: .ASCII \ Transmitting line number... \<0><0><0><0> ; ; .EXTRN SYS$SETAST .PSECT $CODE$,NOWRT,2 ;TRANSMIT_FILE U.121: .WORD ^M ;Save R2,R3,R4,R5,R6,R7,R8,R9,R10,R11 ; 3126 MOVAB G^TT_TEXT, R11 ;TT_TEXT, R11 ; MOVAB G^SYS$SETAST, R10 ;SYS$SETAST, R10 ; MOVAB G^TY_FIL, R9 ;TY_FIL, R9 ; MOVAB W^U.106, R8 ;U.106, R8 ; MOVAB G^LIB$SIGNAL, R7 ;LIB$SIGNAL, R7 ; MOVAB G^U.4, R6 ;U.4, R6 ; SUBL2 #4, SP ;#4, SP ; MOVL #1, G^FLAG_FILE_OPEN ;#1, FLAG_FILE_OPEN ; 3249 PUSHAB G^P.AEK ;P.AEK ; 3250 CALLS #1, (R11) ;#1, TT_TEXT ; PUSHAB G^FILE_NAME ;FILE_NAME ; 3251 CALLS #1, (R11) ;#1, TT_TEXT ; CALLS #0, G^TT_CRLF ;#0, TT_CRLF ; 3252 MOVL 2100(R6), G^FILE_SIZE ;SAVE_FILE_SIZE, FILE_SIZE ; 3253 MNEGL #1, R0 ;#1, I ; 3254 BRB 2$ ;2$ ; 1$: MOVL 1968(R6)[R0], G^FILE_NAME[R0] ;SAVE_FILE_NAME[I], FILE_NAME[I] ; 3255 2$: AOBLSS G^FILE_SIZE, R0, 1$ ;FILE_SIZE, I, 1$ ; MOVL 2104(R6), (R9) ;SAVE_TY_FIL, TY_FIL ; 3256 MOVL #1, 2116(R6) ;#1, LINE_NUM ; 3257 PUSHL #1 ;#1 ; 3259 CALLS #1, -3465(R8) ;#1, TERM_OPEN ; MOVL R0, R4 ;R0, STATUS ; BLBS R4, 3$ ;STATUS, 3$ ; BRW 21$ ;21$ ; 3$: PUSHL (R6) ;TERM_CHAN ; 3264 CALLS #1, G^SYS$CANCEL ;#1, SYS$CANCEL ; MOVL R0, R4 ;R0, STATUS ; BLBS R4, 4$ ;STATUS, 4$ ; 3265 PUSHL R4 ;STATUS ; CALLS #1, (R7) ;#1, LIB$SIGNAL ; 4$: BLBS G^TRANS_ECHO_FLAG, 5$ ;TRANS_ECHO_FLAG, 5$ ; 3268 BRW 11$ ;11$ ; 5$: PUSHL #3 ;#3 ; 3273 CALLS #1, G^SY_DISMISS ;#1, SY_DISMISS ; PUSHL SP ;SP ; 3274 CALLS #1, G^SMG$CREATE_PASTEBOARD ;#1, SMG$CREATE_PASTEBOARD ; MOVL R0, R5 ;R0, PASTE_STAT ; BLBS R5, 6$ ;PASTE_STAT, 6$ ; 3275 PUSHL R5 ;PASTE_STAT ; CALLS #1, (R7) ;#1, LIB$SIGNAL ; 6$: PUSHL #5 ;#5 ; 3278 CALLS #1, G^SYS$CLREF ;#1, SYS$CLREF ; MOVL #1, R2 ;#1, FLAG ; 3279 7$: PUSHL R2 ;FLAG ; 3280 CALLS #1, G^SYS$SETEF ;#1, SYS$SETEF ; AOBLEQ #4, R2, 7$ ;#4, FLAG, 7$ ; CLRL -(SP) ;-(SP) ; 3281 CALLS #1, (R10) ;#1, SYS$SETAST ; CLRQ -(SP) ;-(SP) ; 3286 CLRQ -(SP) ;-(SP) ; MOVZBL #80, -(SP) ;#80, -(SP) ; PUSHAB 1325(R6) ;INP_BUF+161 ; CLRL -(SP) ;-(SP) ; PUSHL R8 ;R8 ; PUSHAB 1148(R6) ;IN_IOSB+16 ; MOVZBL #122, -(SP) ;#122, -(SP) ; PUSHL (R6) ;TERM_CHAN ; CLRL -(SP) ;-(SP) ; CALLS #12, G^SYS$QIO ;#12, SYS$QIO ; MOVL R0, R3 ;R0, ISTAT ; BLBS R3, 8$ ;ISTAT, 8$ ; 3287 PUSHL R3 ;ISTAT ; CALLS #1, (R7) ;#1, LIB$SIGNAL ; 8$: MOVL #1, R2 ;#1, INP_BUFNUM ; 3288 9$: CLRQ -(SP) ;-(SP) ; 3293 CLRQ -(SP) ;-(SP) ; MOVZBL #80, -(SP) ;#80, -(SP) ; MULL3 #80, R2, R0 ;#80, INP_BUFNUM, R0 ; PUSHAB 1325(R6)[R0] ;INP_BUF+161[R0] ; PUSHL R2 ;INP_BUFNUM ; PUSHL R8 ;R8 ; PUSHAQ 1148(R6)[R2] ;IN_IOSB+16[INP_BUFNUM] ; MOVZBL #250, -(SP) ;#250, -(SP) ; PUSHL (R6) ;TERM_CHAN ; CLRL -(SP) ;-(SP) ; CALLS #12, G^SYS$QIO ;#12, SYS$QIO ; MOVL R0, R3 ;R0, ISTAT ; BLBS R3, 10$ ;ISTAT, 10$ ; 3294 PUSHL R3 ;ISTAT ; CALLS #1, (R7) ;#1, LIB$SIGNAL ; 10$: AOBLEQ #1, R2, 9$ ;#1, INP_BUFNUM, 9$ ; PUSHL #1 ;#1 ; 3296 CALLS #1, (R10) ;#1, SYS$SETAST ; BRB 12$ ;12$ ; 11$: PUSHAB G^P.AEL ;P.AEL ; 3301 CALLS #1, (R11) ;#1, TT_TEXT ; 12$: CALLS #0, 323(R8) ;#0, TRANSMIT_CHARACTERS ; 3304 CALLS #0, G^FILE_CLOSE ;#0, FILE_CLOSE ; 3307 CLRL G^ABT_CUR_FILE ;ABT_CUR_FILE ; 3308 BLBC G^TRANS_ECHO_FLAG, 13$ ;TRANS_ECHO_FLAG, 13$ ; 3309 PUSHL #1 ;#1 ; CALLS #1, G^SY_DISMISS ;#1, SY_DISMISS ; 13$: CLRL -(SP) ;-(SP) ; 3312 CALLS #1, (R10) ;#1, SYS$SETAST ; PUSHL (R6) ;TERM_CHAN ; 3313 CALLS #1, G^SYS$CANCEL ;#1, SYS$CANCEL ; MOVL R0, R4 ;R0, STATUS ; BLBS R4, 14$ ;STATUS, 14$ ; 3314 PUSHL R4 ;STATUS ; CALLS #1, (R7) ;#1, LIB$SIGNAL ; 14$: PUSHL 4(R6) ;CONS_CHAN ; 3315 CALLS #1, G^SYS$CANCEL ;#1, SYS$CANCEL ; MOVL R0, R4 ;R0, STATUS ; BLBS R4, 15$ ;STATUS, 15$ ; 3316 PUSHL R4 ;STATUS ; CALLS #1, (R7) ;#1, LIB$SIGNAL ; 15$: BLBC G^TRANS_ECHO_FLAG, 16$ ;TRANS_ECHO_FLAG, 16$ ; 3319 MOVAB G^SMG$_PASALREXI, R0 ;SMG$_PASALREXI, R0 ; CMPL R5, R0 ;PASTE_STAT, R0 ; BEQL 16$ ;16$ ; PUSHL SP ;SP ; 3322 CALLS #1, G^SMG$DELETE_PASTEBOARD ;#1, SMG$DELETE_PASTEBOARD ; MOVL R0, R5 ;R0, PASTE_STAT ; BLBS R5, 17$ ;PASTE_STAT, 17$ ; 3323 PUSHL R5 ;PASTE_STAT ; CALLS #1, (R7) ;#1, LIB$SIGNAL ; BRB 17$ ;17$ ; 16$: CALLS #0, G^TT_CRLF ;#0, TT_CRLF ; 3327 CALLS #0, G^TT_CRLF ;#0, TT_CRLF ; 3328 17$: CALLS #0, -1642(R8) ;#0, DO_CONS_QIO ; 3332 MOVL R0, R4 ;R0, STATUS ; BLBC R4, 18$ ;STATUS, 18$ ; 3333 CALLS #0, -1898(R8) ;#0, DO_RECEIVE_QIO ; 3340 MOVL R0, R4 ;R0, STATUS ; BLBS R4, 19$ ;STATUS, 19$ ; 3341 18$: PUSHL R4 ;STATUS ; 3344 CALLS #1, (R7) ;#1, LIB$SIGNAL ; MOVL #134316266, R0 ;#134316266, R0 ; 3345 RET ; ; 19$: CALLS #0, -2980(R8) ;#0, TERM_CLOSE ; 3349 MOVL R0, R4 ;R0, STATUS ; BLBS R4, 20$ ;STATUS, 20$ ; 3350 PUSHL R4 ;STATUS ; CALLS #1, (R7) ;#1, LIB$SIGNAL ; 20$: PUSHL #1 ;#1 ; 3351 CALLS #1, (R10) ;#1, SYS$SETAST ; 21$: MOVL (R9), 2104(R6) ;TY_FIL, SAVE_TY_FIL ; 3355 CLRL (R9) ;TY_FIL ; 3356 BLBS G^ABT_ALL_FILE, 22$ ;ABT_ALL_FILE, 22$ ; 3357 BLBS -12(R6), 22$ ;FORCE_ABORT, 22$ ; CALLS #0, G^NEXT_FILE ;#0, NEXT_FILE ; MOVL R0, R4 ;R0, STATUS ; BRB 23$ ;23$ ; 22$: MOVL #134316147, R4 ;#134316147, STATUS ; 23$: MOVL 2104(R6), (R9) ;SAVE_TY_FIL, TY_FIL ; 3358 CLRL G^ABT_ALL_FILE ;ABT_ALL_FILE ; 3359 CLRQ -12(R6) ;FORCE_ABORT ; 3360 MOVL R4, R0 ;STATUS, R0 ; 3362 RET ; ; 3364 ; Routine Size: 596 bytes, Routine Base: $CODE$ + 145E ; 3365 3 ; 3366 3 ! ; 3367 3 ! Begin COMND_TRANSMIT: ; 3368 3 ! ; 3369 3 ! Initialize variables ; 3370 3 CHR_COUNT [0] = 0; ; 3371 3 CHR_COUNT [1] = 0; ; 3372 3 OUT_BUFNUM [0] = 0; ; 3373 3 OUT_BUFNUM [1] = 0; ; 3374 3 OUT_EFN [0] = 1; ; 3375 3 OUT_EFN [1] = T_EFN_DISP + 1; ; 3376 3 OUT_PTR [0] = CH$PTR (OUT_BUF [0, .OUT_BUFNUM [0]]); ; 3377 3 OUT_PTR [1] = CH$PTR (OUT_BUF [1, .OUT_BUFNUM [1]]); ; 3378 3 ; 3379 3 ! Assign channels to devices TERM_NAME and MY_TERM. ; 3380 3 STATUS = TERM_OPEN (FALSE); ! Open terminal, no QIO's ; 3381 3 ; 3382 3 IF .CONNECT_FLAG ! Check if TERM_NAME is TT: ; 3383 3 THEN ; 3384 4 BEGIN ; 3385 4 TERM_CLOSE (); ; 3386 4 LIB$SIGNAL (KER_CON_SAME); ; 3387 4 RETURN KER_CON_SAME; ; 3388 3 END; ; 3389 3 ; 3390 3 IF NOT .STATUS ; 3391 3 THEN ; 3392 4 BEGIN ; 3393 4 LIB$SIGNAL (.STATUS); ; 3394 4 RETURN .STATUS; ; 3395 3 END; ; 3396 3 ; 3397 3 IF NOT .SYS_OUTPUT_OPEN ! Make sure we have terminals ; 3398 3 THEN ; 3399 4 BEGIN ; 3400 4 TERM_CLOSE (); ; 3401 4 LIB$SIGNAL (KER_LINTERM); ! Must both be terminals ; 3402 4 RETURN KER_LINTERM; ! So give up if not ; 3403 3 END; ; 3404 3 ; 3405 3 CHANNEL [0] = .TERM_CHAN; ; 3406 3 CHANNEL [1] = .CONS_CHAN; ; 3407 3 ; 3408 3 IF NOT .STATUS ; 3409 3 THEN ; 3410 4 BEGIN ; 3411 4 TERM_CLOSE (); ; 3412 4 LIB$SIGNAL (.STATUS); ; 3413 4 RETURN .STATUS; ; 3414 3 END; ; 3415 3 ; 3416 3 ! Have two terminals - Set up delay: ; 3417 3 CH$COPY (7,CH$PTR(D_TIME), 1,CH$PTR(TRANS_DELAY), %C ' ', 8,CH$PTR(TRANSMIT_DELAY)); ; 3418 3 TR_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 3419 3 TR_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 3420 3 TR_DESC [DSC$W_LENGTH] = 8; ; 3421 3 TR_DESC [DSC$A_POINTER] = TRANSMIT_DELAY; ; 3422 3 STATUS = $BINTIM (TIMBUF=TR_DESC, TIMADR=DELAY); ! Calculate delta time ; 3423 3 IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); ; 3424 3 ; 3425 3 ! Get the first file and try to open it: ; 3426 3 SAVE_TY_FIL = .TY_FIL; ! Save current type out flag ; 3427 3 TY_FIL = FALSE; ! Supress the type out of names ; 3428 3 SAVE_FILE_SIZE = .FILE_SIZE; ! Save the file name size ; 3429 3 INCR I FROM 0 TO .FILE_SIZE - 1 DO ; 3430 3 SAVE_FILE_NAME [.I] = .FILE_NAME [.I]; ; 3431 3 ; 3432 3 ! If we can open the file, then transmit it: ; 3433 3 IF FILE_OPEN (FNC_READ) ; 3434 3 THEN ! Loop to handle one file at a time: ; 3435 3 DO ; 3436 3 STATUS = TRANSMIT_FILE () ; 3437 4 UNTIL ( NOT .STATUS) OR (.STATUS EQL KER_NOMORFILES) ; 3438 3 ELSE ; 3439 3 TY_FIL = .SAVE_TY_FIL; ! Reset type out flag ; 3440 3 ; 3441 2 END; ! End COMND_TRANSMIT routine .EXTRN SYS$BINTIM .ENTRY COMND_TRANSMIT, ^M ; ; MOVAB G^LIB$SIGNAL, R10 ;LIB$SIGNAL, R10 ; MOVAB G^TY_FIL, R9 ;TY_FIL, R9 ; MOVAB W^TERM_CLOSE, R8 ;TERM_CLOSE, R8 ; MOVAB G^U.75, R7 ;U.75, R7 ; SUBL2 #16, SP ;#16, SP ; CLRL -776(R7) ;CHR_COUNT ; 3370 CLRW (R7) ;OUT_BUFNUM ; 3372 MOVW #769, 4(R7) ;#769, OUT_EFN ; 3374 MOVZBL (R7), R0 ;OUT_BUFNUM, R0 ; 3376 MULL2 #80, R0 ;#80, R0 ; MOVAB -324(R7)[R0], 8(R7) ;OUT_BUF[R0], OUT_PTR ; MOVZBL 1(R7), R0 ;OUT_BUFNUM+1, R0 ; 3377 MULL2 #80, R0 ;#80, R0 ; MOVAB -163(R7)[R0], 12(R7) ;OUT_BUF+161[R0], OUT_PTR+4 ; CLRL -(SP) ;-(SP) ; 3380 CALLS #1, -485(R8) ;#1, TERM_OPEN ; MOVL R0, R6 ;R0, STATUS ; BLBC G^CONNECT_FLAG, 1$ ;CONNECT_FLAG, 1$ ; 3382 CALLS #0, (R8) ;#0, TERM_CLOSE ; 3385 PUSHL #134316274 ;#134316274 ; 3386 BRB 4$ ;4$ ; 1$: BLBC R6, 3$ ;STATUS, 3$ ; 3390 BLBS -1888(R7), 2$ ;SYS_OUTPUT_OPEN, 2$ ; 3397 CALLS #0, (R8) ;#0, TERM_CLOSE ; 3400 PUSHL #134316242 ;#134316242 ; 3401 BRB 4$ ;4$ ; 2$: MOVQ -1900(R7), -784(R7) ;TERM_CHAN, CHANNEL ; 3405 BLBS R6, 5$ ;STATUS, 5$ ; 3408 CALLS #0, (R8) ;#0, TERM_CLOSE ; 3411 3$: PUSHL R6 ;STATUS ; 3412 4$: CALLS #1, (R10) ;#1, LIB$SIGNAL ; RET ; ; 3413 5$: MOVC3 #7, G^U.120, 8(SP) ;#7, U.120, TRANSMIT_DELAY ; 3417 MOVC3 #1, G^TRANS_DELAY, (R3) ;#1, TRANS_DELAY, (R3) ; MOVL #17694728, (SP) ;#17694728, TR_DESC ; 3420 MOVAB 8(SP), 4(SP) ;TRANSMIT_DELAY, TR_DESC+4 ; 3421 PUSHAB 208(R7) ;DELAY ; 3422 PUSHAB 4(SP) ;TR_DESC ; CALLS #2, G^SYS$BINTIM ;#2, SYS$BINTIM ; MOVL R0, R6 ;R0, STATUS ; BLBS R6, 6$ ;STATUS, 6$ ; 3423 PUSHL R6 ;STATUS ; CALLS #1, (R10) ;#1, LIB$SIGNAL ; 6$: MOVL (R9), 204(R7) ;TY_FIL, SAVE_TY_FIL ; 3426 CLRL (R9) ;TY_FIL ; 3427 MOVL G^FILE_SIZE, R1 ;FILE_SIZE, R1 ; 3428 MOVL R1, 200(R7) ;R1, SAVE_FILE_SIZE ; MNEGL #1, R0 ;#1, I ; 3429 BRB 8$ ;8$ ; 7$: MOVL G^FILE_NAME[R0], 68(R7)[R0] ;FILE_NAME[I], SAVE_FILE_NAME[I] ; 3430 8$: AOBLSS R1, R0, 7$ ;R1, I, 7$ ; CLRL -(SP) ;-(SP) ; 3433 CALLS #1, G^FILE_OPEN ;#1, FILE_OPEN ; BLBC R0, 10$ ;R0, 10$ ; 9$: CALLS #0, 3588(R8) ;#0, TRANSMIT_FILE ; 3436 MOVL R0, R6 ;R0, STATUS ; BLBC R6, 11$ ;STATUS, 11$ ; 3437 CMPL R6, #134316147 ;STATUS, #134316147 ; BNEQ 9$ ;9$ ; RET ; ; 3435 10$: MOVL 204(R7), (R9) ;SAVE_TY_FIL, TY_FIL ; 3439 11$: RET ; ; 3441 ; Routine Size: 275 bytes, Routine Base: $CODE$ + 16B2 ; 3442 2 %SBTTL 'TERM_CONNECT -- INITIALIZATION' ; 3443 2 ! Initialize variables ; 3444 2 CHR_COUNT [0] = 0; ; 3445 2 CHR_COUNT [1] = 0; ; 3446 2 ESC_FLG = FALSE; ; 3447 2 OUT_BUFNUM [0] = 0; ; 3448 2 OUT_BUFNUM [1] = 0; ; 3449 2 OUT_EFN [0] = 1; ; 3450 2 OUT_EFN [1] = T_EFN_DISP + 1; ; 3451 2 OUT_PTR [0] = CH$PTR (OUT_BUF [0, .OUT_BUFNUM [0]]); ; 3452 2 OUT_PTR [1] = CH$PTR (OUT_BUF [1, .OUT_BUFNUM [1]]); ; 3453 2 $BINTIM (TIMBUF = ATIMUP, TIMADR = BTIMUP); ; 3454 2 ! ; 3455 2 ! Initialize Connect message ; 3456 2 ! ; 3457 2 ESC_CHR_LEN = ESC_MSG (ESC_CHR_MSG); ; 3458 2 CON_MSG_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ; 3459 2 CON_MSG_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; ; 3460 2 CON_MSG_DESC [DSC$A_POINTER] = CON_MSG; ; 3461 2 CON_MSG_DESC [DSC$W_LENGTH] = 1 + .NODE_DESC [DSC$W_LENGTH] + .CON_MSG_1 [DSC$W_LENGTH] + ; 3462 2 .TERM_DESC [DSC$W_LENGTH] + .CON_MSG_2 [DSC$W_LENGTH] + .ESC_CHR_LEN + .CON_MSG_3 [DSC$W_LENGTH] ; 3463 2 ; ; 3464 2 CH$COPY (1, CH$PTR (UPLIT BYTE(%C'[')), .NODE_DESC [DSC$W_LENGTH], ; 3465 2 CH$PTR (.NODE_DESC [DSC$A_POINTER]), .CON_MSG_1 [DSC$W_LENGTH], ; 3466 2 CH$PTR (.CON_MSG_1 [DSC$A_POINTER]), .TERM_DESC [DSC$W_LENGTH], ; 3467 2 CH$PTR (.TERM_DESC [DSC$A_POINTER]), .CON_MSG_2 [DSC$W_LENGTH], ; 3468 2 CH$PTR (.CON_MSG_2 [DSC$A_POINTER]), .ESC_CHR_LEN, CH$PTR (ESC_CHR_MSG), ; 3469 2 .CON_MSG_3 [DSC$W_LENGTH], CH$PTR (.CON_MSG_3 [DSC$A_POINTER]), CHR_NUL, ; 3470 2 .CON_MSG_DESC [DSC$W_LENGTH], CH$PTR (CON_MSG)); ; 3471 2 ! ; 3472 2 ! Assign channels to devices TERM_NAME and MY_TERM. ; 3473 2 ! ; 3474 2 STATUS = TERM_OPEN (FALSE); ![054] Open terminal, no QIO's ; 3475 2 ; 3476 2 IF .CONNECT_FLAG ! Check if TERM_NAME is TT: ; 3477 2 THEN ; 3478 3 BEGIN ; 3479 3 TERM_CLOSE (); ; 3480 3 LIB$SIGNAL (KER_CON_SAME); ; 3481 3 RETURN KER_CON_SAME; ; 3482 2 END; ; 3483 2 ; 3484 2 IF NOT .STATUS ; 3485 2 THEN ; 3486 3 BEGIN ; 3487 3 LIB$SIGNAL (.STATUS); ; 3488 3 RETURN .STATUS; ; 3489 2 END; ; 3490 2 ; 3491 2 IF NOT .SYS_OUTPUT_OPEN ![013] Make sure we have terminals ; 3492 2 THEN ; 3493 3 BEGIN ; 3494 3 TERM_CLOSE (); ; 3495 3 LIB$SIGNAL (KER_LINTERM); ![013] Must both be terminals ; 3496 3 RETURN KER_LINTERM; ![013] So give up if not ; 3497 2 END; ; 3498 2 ; 3499 2 ![054] STATUS = $CANCEL (CHAN = .TERM_CHAN); ! Kill all pending QIOs for terminal ; 3500 2 CHANNEL [0] = .TERM_CHAN; ; 3501 2 CHANNEL [1] = .CONS_CHAN; ; 3502 2 ![054] STATUS = $CANCEL (CHAN = .CONS_CHAN); ! Kill pending QIOs for console as well ; 3503 2 ! STATUS = $ASSIGN (DEVNAM = MY_TERM, CHAN = MYT_CHAN); ; 3504 2 ; 3505 2 IF NOT .STATUS ; 3506 2 THEN ; 3507 3 BEGIN ; 3508 3 TERM_CLOSE (); ; 3509 3 LIB$SIGNAL (.STATUS); ; 3510 3 RETURN .STATUS; ; 3511 2 END; ; 3512 2 ; 3513 2 ! ; 3514 2 ! Open any session logging file ; 3515 2 ! ; 3516 2 SESSION_OPEN = FALSE; ! Assume not logging ; 3517 2 SESSION_LOGGING = FALSE; ! . . . ; 3518 2 ; 3519 2 IF .SESSION_DESC [DSC$W_LENGTH] GTR 0 ; 3520 2 THEN ; 3521 3 BEGIN ; 3522 3 STATUS = LOG_OPEN (SESSION_DESC, SESSION_FAB, SESSION_RAB); ; 3523 3 ; 3524 3 IF .STATUS ; 3525 3 THEN ; 3526 4 BEGIN ; 3527 4 SESSION_OPEN = TRUE; ; 3528 4 SESSION_LOGGING = TRUE; ; 3529 3 END; ; 3530 3 ; 3531 2 END; ; 3532 2 ; 3533 2 ! Prepare event flags ; 3534 2 $CLREF (EFN = XITEFN); ; 3535 2 ; 3536 2 INCR FLAG FROM 1 TO XITEFN - 1 DO ; 3537 2 $SETEF (EFN = .FLAG); ; 3538 2 ; 3539 2 ! ; 3540 2 ! Set up proper function for reading from console terminal. This is done ; 3541 2 ! so that the NOECHO flag only gets used if LOCAL_ECHO is OFF. ; 3542 2 ! ; 3543 2 MYT_QIO_FUNC = IO$_TTYREADALL; ; 3544 2 ; 3545 2 IF NOT .ECHO_FLAG THEN MYT_QIO_FUNC = IO$M_NOECHO OR IO$_TTYREADALL; ; 3546 2 ; 3547 2 ! Connect streams ; 3548 2 CONN_STREAMS : ; 3549 3 BEGIN ; 3550 3 ! Send connect message ; 3551 3 LIB$PUT_OUTPUT (%ASCID''); ; 3552 3 LIB$PUT_OUTPUT (CON_MSG_DESC); ; 3553 3 LIB$PUT_OUTPUT (%ASCID''); ; 3554 3 $SETAST (ENBFLG = 0); ! Disable AST until after all QIOs ; 3555 3 ! ; 3556 3 ! The first input for each terminal will be for one character. ; 3557 3 ! This read will wait forever for a character. The subsequent ; 3558 3 ! reads will have a timeout of 0 (immediate return). This ; 3559 3 ! gets us good response without using large amounts of run time. ; 3560 3 ! ; P 3561 3 STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC, ASTADR = MYTINP, P1 = INP_BUF [MYT, 0], ; 3562 3 P2 = 1, IOSB = IN_IOSB [MYT, 0, 0], ASTPRM = 0); ; 3563 3 ; 3564 3 IF NOT .STATUS THEN LEAVE CONN_STREAMS; ; 3565 3 ; P 3566 3 STATUS = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO, ASTADR = TRMINP, ; 3567 3 P1 = INP_BUF [TRM, 0], P2 = INP_BUFSIZ, P3 = 0, IOSB = IN_IOSB [TRM, 0, 0], ASTPRM = 0); ; 3568 3 ; 3569 3 IF NOT .STATUS THEN LEAVE CONN_STREAMS; ; 3570 3 ; 3571 3 INCR INP_BUFNUM FROM 1 TO NUM_IN_BUF - 1 DO ; 3572 4 BEGIN ; 3573 4 ! Queue up an input for console terminal ; P 3574 4 STATUS = $QIO (CHAN = .MYT_CHAN, FUNC = .MYT_QIO_FUNC OR IO$M_TIMED, ASTADR = MYTINP, ; P 3575 4 P1 = INP_BUF [MYT, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = 0, ; P 3576 4 IOSB = IN_IOSB [MYT, ; 3577 4 .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM); ; 3578 4 ; 3579 4 IF NOT .STATUS THEN LEAVE CONN_STREAMS; ; 3580 4 ; P 3581 4 STATUS = $QIO (CHAN = .TERM_CHAN, FUNC = IO$_TTYREADALL OR IO$M_NOECHO OR IO$M_TIMED, ; P 3582 4 ASTADR = TRMINP, P1 = INP_BUF [TRM, .INP_BUFNUM], P2 = INP_BUFSIZ, P3 = 0, ; 3583 4 IOSB = IN_IOSB [TRM, .INP_BUFNUM, 0], ASTPRM = .INP_BUFNUM); ; 3584 4 ; 3585 4 IF NOT .STATUS THEN LEAVE CONN_STREAMS; ; 3586 4 ; 3587 3 END; ; 3588 3 ; 3589 3 $SETAST (ENBFLG = 1); ! Enable AST ; 3590 3 $WAITFR (EFN = XITEFN); ! Wait for exit flag ; 3591 3 $WFLAND (EFN = 0, MASK = EFN_MASK); ! Go when outputs completed ; 3592 3 CON_MSG_DESC [DSC$W_LENGTH] = 1 + .NODE_DESC [DSC$W_LENGTH] + .CON_MSG_4 [DSC$W_LENGTH]; ; 3593 3 CH$COPY (1, CH$PTR (UPLIT BYTE(%C'[')), .NODE_DESC [DSC$W_LENGTH], ; 3594 3 CH$PTR (.NODE_DESC [DSC$A_POINTER]), .CON_MSG_4 [DSC$W_LENGTH], ; 3595 3 CH$PTR (.CON_MSG_4 [DSC$A_POINTER]), CHR_NUL, .CON_MSG_DESC [DSC$W_LENGTH], ; 3596 3 CH$PTR (.CON_MSG_DESC [DSC$A_POINTER])); ; 3597 3 LIB$PUT_OUTPUT (CON_MSG_DESC); ; 3598 3 LIB$PUT_OUTPUT (%ASCID''); ; 3599 2 END; ; 3600 2 ! ; 3601 2 ! Program end -- Close both channels and return with STATUS ; 3602 2 ! ; 3603 2 $CANTIM (); ; 3604 2 ! ; 3605 2 ! Close any log file ; 3606 2 ! ; 3607 2 ; 3608 2 IF .SESSION_OPEN THEN LOG_CLOSE (SESSION_FAB, SESSION_RAB); ; 3609 2 ; 3610 2 SESSION_OPEN = FALSE; ; 3611 2 ! ; 3612 2 ! Call TERM_CLOSE to clean up ; 3613 2 ! ; 3614 2 STATUS = TERM_CLOSE (); ; 3615 2 ; 3616 2 IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); ; 3617 2 ; 3618 2 $SETAST (ENBFLG = 1); ; 3619 2 RETURN .STATUS; ; 3620 1 END; ! End of TERM_CONNECT .PSECT $PLIT$,NOWRT,NOEXE,2 P.AEM: .BYTE 91 ; ; .BLKB 3 P.AEO: .BLKB 0 ; ; P.AEN: .LONG 17694720 ; ; .ADDRESS P.AEO ; ; P.AEQ: .BLKB 0 ; ; P.AEP: .LONG 17694720 ; ; .ADDRESS P.AEQ ; ; P.AER: .BYTE 91 ; ; .BLKB 3 P.AET: .BLKB 0 ; ; P.AES: .LONG 17694720 ; ; .ADDRESS P.AET ; ; .EXTRN SYS$WFLAND .PSECT $CODE$,NOWRT,2 .ENTRY TERM_CONNECT, ^M ; ; MOVAB -116(SP), SP ;-116(SP), SP ; CLRQ G^U.68 ;U.68 ; 3444 CLRW G^U.75 ;U.75 ; 3447 MOVW #769, G^U.76 ;#769, U.76 ; 3449 MOVZBL G^U.75, R0 ;U.75, R0 ; 3451 MULL2 #80, R0 ;#80, R0 ; MOVAB G^U.74[R0], G^U.77 ;U.74[R0], U.77 ; MOVZBL G^U.75+1, R0 ;U.75+1, R0 ; 3452 MULL2 #80, R0 ;#80, R0 ; MOVAB G^U.74+161[R0], G^U.77+4 ;U.74+161[R0], U.77+4 ; PUSHAB G^U.66 ;U.66 ; 3453 PUSHAB G^U.90 ;U.90 ; CALLS #2, G^SYS$BINTIM ;#2, SYS$BINTIM ; PUSHAB G^U.80 ;U.80 ; 3457 CALLS #1, W^U.107 ;#1, U.107 ; MOVL R0, G^U.79 ;R0, U.79 ; MOVW #270, 30(SP) ;#270, CON_MSG_DESC+2 ; 3459 MOVAB 36(SP), 32(SP) ;CON_MSG, CON_MSG_DESC+4 ; 3460 MOVZWL G^NODE_DESC, R7 ;NODE_DESC, R7 ; 3461 MOVZWL G^U.82, 24(SP) ;U.82, 24(SP) ; ADDL3 24(SP), R7, R0 ;24(SP), R7, R0 ; MOVZWL G^TERM_DESC, 20(SP) ;TERM_DESC, 20(SP) ; 3462 ADDL2 20(SP), R0 ;20(SP), R0 ; 3461 MOVZWL G^U.83, 16(SP) ;U.83, 16(SP) ; 3462 ADDL2 16(SP), R0 ;16(SP), R0 ; MOVL G^U.79, R11 ;U.79, R11 ; ADDL2 R11, R0 ;R11, R0 ; MOVZWL G^U.84, R6 ;U.84, R6 ; MOVAB 1(R6)[R0], R1 ;1(R6)[R0], R1 ; MOVW R1, 28(SP) ;R1, CON_MSG_DESC ; MOVL G^NODE_DESC+4, 12(SP) ;NODE_DESC+4, 12(SP) ; 3465 MOVL G^U.82+4, 8(SP) ;U.82+4, 8(SP) ; 3466 MOVL G^TERM_DESC+4, 4(SP) ;TERM_DESC+4, 4(SP) ; 3467 MOVL G^U.83+4, (SP) ;U.83+4, (SP) ; 3468 MOVL G^U.84+4, R10 ;U.84+4, R10 ; 3469 MOVZWL 28(SP), R9 ;CON_MSG_DESC, R9 ; 3470 MOVAB 36(SP), R8 ;CON_MSG, R8 ; MOVC5 #1, G^P.AEM, #0, R9, (R8) ;#1, P.AEM, #0, R9, (R8) ; BGEQ 1$ ;1$ ; INCL R8 ;R8 ; DECL R9 ;R9 ; MOVC5 R7, @12(SP), #0, R9, (R8) ;R7, @12(SP), #0, R9, (R8) ; BGEQ 1$ ;1$ ; ADDL2 R7, R8 ;R7, R8 ; SUBL2 R7, R9 ;R7, R9 ; MOVC5 24(SP), @8(SP), #0, R9, (R8) ;24(SP), @8(SP), #0, R9, (R8) ; BGEQ 1$ ;1$ ; ADDL2 24(SP), R8 ;24(SP), R8 ; SUBL2 24(SP), R9 ;24(SP), R9 ; MOVC5 20(SP), @4(SP), #0, R9, (R8) ;20(SP), @4(SP), #0, R9, (R8) ; BGEQ 1$ ;1$ ; ADDL2 20(SP), R8 ;20(SP), R8 ; SUBL2 20(SP), R9 ;20(SP), R9 ; MOVC5 16(SP), @0(SP), #0, R9, (R8) ;16(SP), @0(SP), #0, R9, (R8) ; BGEQ 1$ ;1$ ; ADDL2 16(SP), R8 ;16(SP), R8 ; SUBL2 16(SP), R9 ;16(SP), R9 ; MOVC5 R11, G^U.80, #0, R9, (R8) ;R11, U.80, #0, R9, (R8) ; BGEQ 1$ ;1$ ; ADDL2 R11, R8 ;R11, R8 ; SUBL2 R11, R9 ;R11, R9 ; MOVC5 R6, (R10), #0, R9, (R8) ;R6, (R10), #0, R9, (R8) ; 1$: CLRL -(SP) ;-(SP) ; 3474 CALLS #1, W^TERM_OPEN ;#1, TERM_OPEN ; MOVL R0, R10 ;R0, STATUS ; BLBC G^CONNECT_FLAG, 2$ ;CONNECT_FLAG, 2$ ; 3476 CALLS #0, W^TERM_CLOSE ;#0, TERM_CLOSE ; 3479 PUSHL #134316274 ;#134316274 ; 3480 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; MOVL #134316274, R0 ;#134316274, R0 ; 3481 RET ; ; 2$: BLBC R10, 4$ ;STATUS, 4$ ; 3484 BLBS G^U.7, 3$ ;U.7, 3$ ; 3491 CALLS #0, W^TERM_CLOSE ;#0, TERM_CLOSE ; 3494 PUSHL #134316242 ;#134316242 ; 3495 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; MOVL #134316242, R0 ;#134316242, R0 ; 3496 RET ; ; 3$: MOVQ G^U.4, G^U.67 ;U.4, U.67 ; 3500 BLBS R10, 5$ ;STATUS, 5$ ; 3505 CALLS #0, W^TERM_CLOSE ;#0, TERM_CLOSE ; 3508 4$: PUSHL R10 ;STATUS ; 3509 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; BRW 17$ ;17$ ; 3510 5$: CLRQ G^U.20 ;U.20 ; 3516 TSTW G^SESSION_DESC ;SESSION_DESC ; 3519 BEQL 6$ ;6$ ; PUSHAB G^U.18 ;U.18 ; 3522 PUSHAB G^U.17 ;U.17 ; PUSHAB G^SESSION_DESC ;SESSION_DESC ; CALLS #3, G^LOG_OPEN ;#3, LOG_OPEN ; MOVL R0, R10 ;R0, STATUS ; BLBC R10, 6$ ;STATUS, 6$ ; 3524 MOVL #1, G^U.20 ;#1, U.20 ; 3527 MOVL #1, G^U.21 ;#1, U.21 ; 3528 6$: PUSHL #5 ;#5 ; 3534 CALLS #1, G^SYS$CLREF ;#1, SYS$CLREF ; MOVL #1, R2 ;#1, FLAG ; 3536 7$: PUSHL R2 ;FLAG ; 3537 CALLS #1, G^SYS$SETEF ;#1, SYS$SETEF ; AOBLEQ #4, R2, 7$ ;#4, FLAG, 7$ ; MOVL #58, G^U.78 ;#58, U.78 ; 3543 BLBS G^ECHO_FLAG, 8$ ;ECHO_FLAG, 8$ ; 3545 MOVZBL #122, G^U.78 ;#122, U.78 ; 8$: PUSHAB G^P.AEN ;P.AEN ; 3551 CALLS #1, G^LIB$PUT_OUTPUT ;#1, LIB$PUT_OUTPUT ; PUSHAB 28(SP) ;CON_MSG_DESC ; 3552 CALLS #1, G^LIB$PUT_OUTPUT ;#1, LIB$PUT_OUTPUT ; PUSHAB G^P.AEP ;P.AEP ; 3553 CALLS #1, G^LIB$PUT_OUTPUT ;#1, LIB$PUT_OUTPUT ; CLRL -(SP) ;-(SP) ; 3554 CALLS #1, G^SYS$SETAST ;#1, SYS$SETAST ; CLRQ -(SP) ;-(SP) ; 3562 CLRQ -(SP) ;-(SP) ; PUSHL #1 ;#1 ; PUSHAB G^U.71 ;U.71 ; CLRL -(SP) ;-(SP) ; PUSHAB W^U.96 ;U.96 ; PUSHAB G^U.70 ;U.70 ; PUSHL G^U.78 ;U.78 ; PUSHL G^U.91 ;U.91 ; CLRL -(SP) ;-(SP) ; CALLS #12, G^SYS$QIO ;#12, SYS$QIO ; MOVL R0, R10 ;R0, STATUS ; BLBC R10, 10$ ;STATUS, 10$ ; 3564 CLRQ -(SP) ;-(SP) ; 3567 CLRQ -(SP) ;-(SP) ; MOVZBL #80, -(SP) ;#80, -(SP) ; PUSHAB G^U.71+161 ;U.71+161 ; CLRL -(SP) ;-(SP) ; PUSHAB W^U.106 ;U.106 ; PUSHAB G^U.70+16 ;U.70+16 ; MOVZBL #122, -(SP) ;#122, -(SP) ; PUSHL G^U.4 ;U.4 ; CLRL -(SP) ;-(SP) ; CALLS #12, G^SYS$QIO ;#12, SYS$QIO ; MOVL R0, R10 ;R0, STATUS ; BLBC R10, 11$ ;STATUS, 11$ ; 3569 MOVL #1, R2 ;#1, INP_BUFNUM ; 3571 9$: CLRQ -(SP) ;-(SP) ; 3577 CLRQ -(SP) ;-(SP) ; MOVZBL #80, -(SP) ;#80, -(SP) ; MULL3 #80, R2, R3 ;#80, INP_BUFNUM, R3 ; PUSHAB G^U.71[R3] ;U.71[R3] ; PUSHL R2 ;INP_BUFNUM ; PUSHAB W^U.96 ;U.96 ; PUSHAQ G^U.70[R2] ;U.70[INP_BUFNUM] ; BISL3 #128, G^U.78, -(SP) ;#128, U.78, -(SP) ; PUSHL G^U.91 ;U.91 ; CLRL -(SP) ;-(SP) ; CALLS #12, G^SYS$QIO ;#12, SYS$QIO ; MOVL R0, R10 ;R0, STATUS ; 10$: BLBC R10, 11$ ;STATUS, 11$ ; 3579 CLRQ -(SP) ;-(SP) ; 3583 CLRQ -(SP) ;-(SP) ; MOVZBL #80, -(SP) ;#80, -(SP) ; PUSHAB G^U.71+161[R3] ;U.71+161[R3] ; PUSHL R2 ;INP_BUFNUM ; PUSHAB W^U.106 ;U.106 ; PUSHAQ G^U.70+16[R2] ;U.70+16[INP_BUFNUM] ; MOVZBL #250, -(SP) ;#250, -(SP) ; PUSHL G^U.4 ;U.4 ; CLRL -(SP) ;-(SP) ; CALLS #12, G^SYS$QIO ;#12, SYS$QIO ; MOVL R0, R10 ;R0, STATUS ; 11$: BLBS R10, 12$ ;STATUS, 12$ ; 3585 BRW 14$ ;14$ ; 12$: ACBL #1, #1, R2, 9$ ;#1, #1, INP_BUFNUM, 9$ ; PUSHL #1 ;#1 ; 3589 CALLS #1, G^SYS$SETAST ;#1, SYS$SETAST ; PUSHL #5 ;#5 ; 3590 CALLS #1, G^SYS$WAITFR ;#1, SYS$WAITFR ; PUSHL #30 ;#30 ; 3591 CLRL -(SP) ;-(SP) ; CALLS #2, G^SYS$WFLAND ;#2, SYS$WFLAND ; MOVZWL G^NODE_DESC, R6 ;NODE_DESC, R6 ; 3592 MOVZWL G^U.85, R7 ;U.85, R7 ; MOVAB 1(R7)[R6], R0 ;1(R7)[R6], R0 ; MOVW R0, 28(SP) ;R0, CON_MSG_DESC ; MOVL G^NODE_DESC+4, 24(SP) ;NODE_DESC+4, 24(SP) ; 3594 MOVL G^U.85+4, R11 ;U.85+4, R11 ; 3595 MOVZWL 28(SP), R9 ;CON_MSG_DESC, R9 ; MOVL 32(SP), R8 ;CON_MSG_DESC+4, R8 ; 3596 MOVC5 #1, G^P.AER, #0, R9, (R8) ;#1, P.AER, #0, R9, (R8) ; BGEQ 13$ ;13$ ; INCL R8 ;R8 ; DECL R9 ;R9 ; MOVC5 R6, @24(SP), #0, R9, (R8) ;R6, @24(SP), #0, R9, (R8) ; BGEQ 13$ ;13$ ; ADDL2 R6, R8 ;R6, R8 ; SUBL2 R6, R9 ;R6, R9 ; MOVC5 R7, (R11), #0, R9, (R8) ;R7, (R11), #0, R9, (R8) ; 13$: PUSHAB 28(SP) ;CON_MSG_DESC ; 3597 CALLS #1, G^LIB$PUT_OUTPUT ;#1, LIB$PUT_OUTPUT ; PUSHAB G^P.AES ;P.AES ; 3598 CALLS #1, G^LIB$PUT_OUTPUT ;#1, LIB$PUT_OUTPUT ; 14$: CLRQ -(SP) ;-(SP) ; 3603 CALLS #2, G^SYS$CANTIM ;#2, SYS$CANTIM ; BLBC G^U.20, 15$ ;U.20, 15$ ; 3608 PUSHAB G^U.18 ;U.18 ; PUSHAB G^U.17 ;U.17 ; CALLS #2, G^LOG_CLOSE ;#2, LOG_CLOSE ; 15$: CLRL G^U.20 ;U.20 ; 3610 CALLS #0, W^TERM_CLOSE ;#0, TERM_CLOSE ; 3614 MOVL R0, R10 ;R0, STATUS ; BLBS R10, 16$ ;STATUS, 16$ ; 3616 PUSHL R10 ;STATUS ; CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL ; 16$: PUSHL #1 ;#1 ; 3618 CALLS #1, G^SYS$SETAST ;#1, SYS$SETAST ; 17$: MOVL R10, R0 ;STATUS, R0 ; 3619 RET ; ; 3620 ; Routine Size: 1058 bytes, Routine Base: $CODE$ + 17C5 ; 3621 1 ; 3622 1 %SBTTL 'End of KERTRM' ; 3623 1 END ! End of module ; 3624 1 ; 3625 0 ELUDOM ; PSECT SUMMARY ; ; Name Bytes Attributes ; ; $OWN$ 2132 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $GLOBAL$ 52 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $PLIT$ 1472 NOVEC,NOWRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $CODE$ 7143 NOVEC,NOWRT, RD , EXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; . ABS . 0 NOVEC,NOWRT,NORD ,NOEXE,NOSHR, LCL, ABS, CON,NOPIC,ALIGN(0) ; Library Statistics ; ; -------- Symbols -------- Pages Processing ; File Total Loaded Percent Mapped Time ; ; SYS$COMMON:[SYSLIB]STARLET.L32;2 10093 68 0 598 00:00.9 ; COMMAND QUALIFIERS ; BLISS VMSTRM/LIST=VMSTRM.MAR/MACHINE_CODE=(ASSEM,NOBINARY,UNIQUE)/NOOBJECT/SOURCE=NOHEADER ; Compilation Complete .END