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