*DECK OPENTL
          IDENT  OPENTL 
          SST 
          COMMENT  MISCELLANEOUS HELPFUL ROUTINES 
OPENTL    TITLE    OPENTL - MISCELLANEOUS HELPFUL ROUTINES
          LIST   F
          SPACE  2                                                      000840
*CALL ENVIRON 
          SPACE  2
*CALL MACRO 
*CALL NUMOPT
*CALL CREPCMP                                                           000110
 WIUEQP   EQU    10B               W.IUEQP WORD IN USER TABLE 
 WIOTPUT  EQU    5                 W.IOTPUT WORD IN USER TABLE
 WIUSIA   EQU    0                 W.IUSA WORD OF USER TABLE
 NTTYCH   EQU    72                NUMBER OF CHAR / TTY LINE
 NTTYLIN  EQU    16 
 NCRTCH1  EQU    50                NO. CHAR / CRT LINE - 20 BY 50 
 NCRTLN1  EQU    20                NO. LINES / CRT SCREEN - 20 BY 50
 NCRTCH2  EQU    80                NO CHAR / CRT LINE - 13 BY 80
 NCRTLN2  EQU    13                NO. LINES / CRT SCREEN - 13 BY 80
 BATMOD   EQU    0                 BATCH MODE FLAG IN TERMINAL
 TTYMOD   EQU    1                 TTY TERMINAL MODE FLAG 
 CRTMOD   EQU    2                 CRT TERMINAL MODE FLAG 
OUTLENG   EQU    65 
          ENTRY  CIOWD
 CIOWD    VFD    18/3LCIO,3/2,39/0   CIO CALL WORD
OUTBUFF   BSS    0                 OUTPUT BUFFER HAS SOME ONE-TINE CODE 
          SPACE  1
         LOC    0 
 RA0     BSS    0 
         LOC    *O
         ENTRY  RA0 
          SPACE  2
A         SET    *-OUTBUFF
          IFLT   A,OUTLENG,1
          BSS    OUTLENG-A
          IFEQ   OS$NAME,NOS
 OPL      XTEXT  COMCCMD
          ENDIF 
          SPACE  3
          ENTRY  INPUT
INPUT     FILEB 
          ENTRY  OUTPUT 
OUTPUT    FILEB  OUTBUFF,OUTLENG
          ENTRY  TFILE
TFILE     FILEB 
          ENTRY  IPROCES
IPROCES   BSSZ   1
          ENTRY  OPROCES
OPROCES   BSSZ   1
          ENTRY  TPROCES
TPROCES   BSSZ   1
          ENTRY  INTERIN
INTERIN   BSSZ   1           SET BY *USE* WHEN CALLING *WRITEBL*
          ENTRY  DUMMY
DUMMY     BSSZ   1           DUMMY ITEM FOR -FOR- LOOPS (SYMPLDEFS) 
          SPACE  3
          EJECT 
          ENTRY  ABTADDR
********************************************
*    THIS RESERVES 31B WORDS FOR -RPV-     *
********************************************
 ABTADDR  BSSZ   1                 -RPV- PARAMETER BLOCK
          CON    BOMB1
          BSSZ   27B
 ABTEQ    EQ     BOMB1             RA+0 WORD FOR *RPV*
          ENTRY  BOMB,BOMB1 
  
 BOMB1    SA1    =XRECOVER         (X1) = RECOVERY ADDRESS               FEAT157
          ZR     X1,BOMB3          IF NO RECOVERY ADDRESS                FEAT157
          SA2    BOMB2.1           (X2) = WORD WITH *RJ* IN LOW 30 BITS 
          MX0    42                                                      FEAT157
          BX1    -X0*X1            (X1) = BOTTOM 18 BITS OF RECOVERY ADR FEAT157
          BX2    X0*X2             (X2) = -RJ- WITH ZERO ADDRESS         FEAT157
          BX6    X1+X2             (X6) = -RJ- RECOVERY ADDRESS          FEAT157
          SA6    A2                REPLACE -RJ- WORD                     FEAT157
          MX7    0                                                       FEAT157
          SA7    A1                CLEAR RECOVERY ADDRESS                FEAT157
          RJ     BOMB2             FLUSH THE INSTRUCTION STACK
                                                                         FEAT157
          ENTRY  RECOVER                                                 FEAT157
 RECOVER  DATA   0                 ADDRESS AT WHICH WE RECOVER ABORTS    FEAT157
                                                                         FEAT157
 BOMB2    JP     *+1S17            RJ HERE TO USE DYNAMIC RECOVERY WORD 
 BOMB2.1  SB0    0                 RECOVERY RJ STORED IN LOW 30 BITS
          RJ     *+1S17            RECOVERY ADDRESS WILL REPLACE *+1S17  FEAT157
 BOMB3    RJ     FETCOMP           SET FET COMPLETE BIT FOR BASIC I/O 
          RJ     CLOSETL           FLUSH OUTPUT FILES 
          IFEQ   OS$NAME,NOS
          RJ     SYSMAP      MAP SYS ERR CODE TO QU DIAG
          ENDIF 
          RJ     =XABORT           CLEAN UP ODDS AND ENDS 
 BOMB     JP     *+1               -JP- IN CASE NOT ENTERED WITH -RJ- 
          SA1    DFLAG
          LX1    59 
          NG     X1,BOMB5    IF D = 1 (NO REPRIEVE) 
          SB2    ABTADDR
          SA2    B2+7 
          MX3    12                LOOK AT ERROR CODE 
          LX3    12 
          BX4    X2*X3
          SB3    X4 
          IFEQ   OS$NAME,NOS
          SB4    TIET        CODE FOR TERMINAL INTERRUPT
          ELSE
          SB4    40B
          ENDIF 
          SB2    B4-B3             IF CAUSED BY TERMINAL INTERRUPT
          ZR     B2,BOMB5          CONDITIONS NEED NOT BE RESET 
          NE     B2,B4,RPVCAL3     IF NOT REPRIEVED,SET RPV MASK TO 0 
 RPVCAL1  SA1    RPV1              SET UP PARAMETER BLOCK 
          BX6    X1 
          SA6    ABTADDR           ALLOW CLEAN EXIT FOR QU FATALS 
          REPRIEVE  ABTADDR,SETUP,0 
          EQ     BOMB5             EXIT 
 RPVCAL3  SA1    RPV3              SET UP PARAMETER BLOCK 
          BX6    X1 
          SA6    ABTADDR           CALL REPRIEVE TO RESET CONDITIONS
          REPRIEVE   ABTADDR,RESET,277B 
BOMB5     ABORT              ABORT TO REACH EXIT CARD 
  
  
 RPVEQ    EQ     BOMB1       DATA WORD FOR COMPARISON WITH *ABTEQ*
  
 RPV1     VFD    36/0,12/31B,2/0,9/1,1/0
 RPV3     VFD    36/0,12/31B,2/0,9/3,1/0
          SPACE  5
***       FETCOMP  SET COMPLETE BITS FOR BASIC I/O FETS 
* 
*         UNCONDITIONALLY SETS THE COMPLETE BITS OF THE FETS FOR FILES
*         INPUT, OUTPUT, AND TFILE. 
* 
*         IF A CIO REQUEST WAS IN PROGRESS AT 
*         THE TIME OF A TERMINAL INTERRUPT, THE 
*         FET'S COMPLETE BIT IS SET.
*         *NOTE* THIS SHOULD ONLY OCCUR IF QU DOES
*         NOT RESUME ACTIVITY AFTER THE REPRIEVE. 
* 
*         ENTRY  NONE 
* 
*         EXIT   NONE 
* 
*         CALLING SEQUENCE         RJ    FETCOMP
* 
*         USES   A - 1, 2, 3, 7 
*                X - 1, 2, 3, 6, 7
  
  
  
 FETCOMP  JP     *+1S17      ENTRY/EXIT 
          SA1    INPUT
          SA2    OUTPUT 
          SA3    TFILE
          MX6    59          (X6) = COMPLEMENT OF A COMPLETE BIT
          BX7    -X6+X1      *OR* IN A COMPLETE BIT 
          SA7    A1          REPLACE FET+0 WORD 
          BX7    -X6+X2      *OR* IN A COMPLETE BIT 
          SA7    A2          REPLACE THE FET+0 WORD 
          BX7    -X6+X3      *OR* IN A COMPLETE BIT 
          SA7    A3          REPLACE THE FET+0 WORD 
          SB2    ABTADDR     POSITION TO REPRIEVE PARAMETER BLOCK 
          SA2    B2+6        CK THE TERMINAL INTERRUPT REQUEST
          ZR     X2,FETCOMP  IF NO I/O INTERRUPTED, RETURN
          SB2    X2          EXTRACT FET ADDRESS
          SA2    B2 
          MX3    59 
          BX6    -X3+X2      *OR* IN A COMPLETE BIT 
          SA6    A2          REPLACE THE FET+0 WORD 
          EQ     FETCOMP
          SPACE  3
                                                                         FEAT157
          ENTRY CIOREQ
 CIOREQ   BSSZ   1
          SA1    CIOWD             FETCH THE WORD FOR CIO 
          BX6    X1                (X1) = CIO REQUEST WORD
          RJ     =XSYS=            ISSUE THE SYSTEM REQUEST 
          EQ     CIOREQ 
          SPACE  5
          ENTRY  DFLAG
DFLAG     BSSZ   1                 OCTAL VALUE ENTERED BY D= ON -QU- CAR
          ENTRY  QU$RPT 
 QU$RPT   DATA   0                 0 FOR QU, 1 FOR REPORT...REPORT SETS 
          EJECT 
          ENTRY  CLOSETL
************************************************************************
*                                                                      *
*      CLOSETL   DOES A FINAL -WRITER- ON -OUTPUT- TO FLUSH THE BUFFER.*
*                ALSO FLUSHES THE -TFILE- BUFFER IF A TRANSACTION FILE *
*                WAS USED. NO PARAMETERS.                              *
*                ALSO INSURES WE POSITION TO EOR ON THE INPUT FILE.    *
*                                                                      *
************************************************************************
          SPACE  3
 CLOSETL  JP     *+400000B   ENTRY EXIT 
          WRITER OUTPUT,RECALL     FLUSH -OUTPUT- BUFFER
          SA1    =XTPROCES         EXTERNAL ITEM -TPROCESSED- 
          ZR     X1,CLOSETL1       IF NO TRANSACTION FILE 
          WRITER TFILE,RECALL      FLUSH TRANSACTION FILE BUFFER
 CLOSETL1 SA1    QU$RPT      (X1) = 0 IF QU, 1 IF REPORT
          NZ     X1,CLOSETL3       IF NOT QU
          SA1    CLOSETLA          0 IF SHOULD FLUSH INPUT TO EOR 
          NZ     X1,CLOSETL3       IF SHOULD NOT FLUSH INPUT TO EOR 
          SA1    =XIPROCES         EXTERNAL ITEM -IPROCESSED- 
          ZR     X1,CLOSETL3       IF NOT BATCH STYLE INPUT 
          SA5    =XRBUFFER         (X5) = ADDRESS OF READ BUFFER
 CLOSETL2 READW  INPUT,X5,60       READ 60 WORDS.RBUFFER HOLDS 60, MIN. 
          ZR     X1,CLOSETL2       IF NO EOR ON INPUT YET 
 CLOSETL3 BSS    0
          EQ     CLOSETL
          SPACE  2
 CLOSETLA DATA   0                 0 IF SHOULD FLUSH INPUT TO EOR 
          EJECT 
          ENTRY  READLN 
************************************************************************
*                                                                      *
*      READLN    TRANSFERS A CODED LINE, TERMINATED WITH A ZERO-BYTE,  *
*                FROM THE -INPUT- BUFFER TO THE WORKING BUFFER. KRONOS *
*                I/O MACROS TAKE CARE OF THE -CIO- REQUESTS AND FET    *
*                POINTERS.                                             *
*                THE -READSKP- MACRO IS USED ON TERMINALS TO FORCE A   *
*                READ AND PREVENT READ-AHEAD. ALSO PROTECTS OUR WORKING*
*                BUFFER FROM OVERFLOWING.                              *
*                                                                      *
*                CALLING SEQUENCE  READLN (BUFFER, LENGTH, RC)         *
*                                                                      *
************************************************************************
          SPACE  3
 READLN   JP     *+400000B   ENTRY/EXIT 
          SB1    1           B1 SHALL BE 1 FOR ALL OF -READLN-
          BX6    X1          (X1) HAS BUFFER ADDRESS
          SA2    A1+B1       FETCH SECOND PARAMETER 
          SA6    BUFFADDR    STORE THE FIRST
          BX7    X2          (X2) HAS ADDRESS FOR LENGTH RETURN 
          SA3    A2+B1       FETCH THE THIRD PARAMETER
          SA7    LENGADDR    STORE THE SECOND 
          BX7    X3          (X3) HAS ADDRESS FOR RETURN CODE 
          SA5    RCADDR      FETCH PREVIOUS RCADDR. ZERO ON FIRST TRY 
          SA7    A5          STORE THE THIRD IN -RCADDR-
          SA2    =XIPROCES         EXTERNAL ITEM -IPROCESSED- 
          ZR     X2,READLN1  IF NO -I- PARAMETER...IF CONNECTED 
          NZ     X5,READLN3  IF -READLN- WAS CALLED PREVIOUSLY
          READ   INPUT,RCL   FIRST TIME READ TO SET UP FOR MACROS 
          EQ     READLN3
          SPACE  2
 READLN1  BSS    0
          IFEQ   OS$NAME,SCOPE     FLUSH OUTPUT FILES FOR SCOPE ONLY
          SA1    OUTPUT+2    (X1) IS -IN- WORD OF FET 
          SA2    OUTPUT+3    (X2) IS -OUT- WORD OF FET
          IX1    X1-X2       (X1) WILL BE IN-OUT
          ZR     X1,READLN2  IF EMPTY OUTPUT BUFFER 
          SA1    =XOPROCES         EXTERNAL ITEM -OPROCESSED- 
          NZ     X1,READLN2  IF NOT A CONNECTED FILE
          WRITER OUTPUT,RCL  FORCED WRITE ON SCOPE TERMINALS TO FLUSH 
          ENDIF 
 READLN2  READSKP INPUT,,RCL       FORCED READ ON TERMINALS TO AVOID
                                   READ-AHEAD AND BUFFER OVERFLOW 
          IFEQ   OS$NAME,SCOPE
          SX5    40020B      MASK TO SET EOR LEVEL 1 AS STATUS
          SA1    INPUT       GET FET+0 WORD 
          BX6    X1+X5       -OR- IN THE LEVEL 1 EOR
          SA6    A1          REPLACE THE OLD FET+0
          ENDIF 
 READLN3  SA5    BUFFADDR    FETCH ADDRESS OF BUFFER
          READC  INPUT,X5    TRANSFER CODED LINE TO BUFFER AT (X5)
          IFEQ   OS$NAME,NOS
          SA2    =XIPROCES   EXTERNAL ITEM -IPROCESSED- 
          NZ     X2,READLN4  IF BATCH STYLE INPUT 
          NG     X1,READLN2  IF EOF ON NOS TERMINAL READ...READ AGAIN 
          ENDIF 
 READLN4  BX6    X1          (X1) HAS THE EDITTED STATUS
          SX4    B6          (B6) LWA+1 OF WORDS TRANSFERRED
          SA1    RCADDR      FETCH WHERE TO PUT RETURN CODE 
          IX7    X4-X5       CALCULATE HOW MANY WORDS TRANSFERRED 
          SA2    LENGADDR    FETCH LENGTH RETURN ADDRESS
          SA6    X1          (X1) HAS RETURN CODE ADDRESS 
          SA7    X2          (X2) HAS LENGTH RETURN ADDRESS 
          PL     X6,READLN5        IF NOT EOR/EOF/EOI 
          SX6    1
          SA6    CLOSETLA          TO PREVENT FLUSH TO SUBSEQUENT EOR*S 
 READLN5  BSS    0
          EQ     READLN 
          SPACE  3
 BUFFADDR BSSZ   1           ADDRESS OF THE TARGET BUFFER 
 LENGADDR BSSZ   1           ADDRESS OF THE LENGTH RETURN WORD
 RCADDR   BSSZ   1           ADDRESS OF THE RETURN CODE WORD
          EJECT 
 WRITEC   SPACE  4,8
**        WRITEC - WRITE CODED LINE IN -C- FORMAT.
* 
*                THIS ROUTNIE TRANSFER 1 CODED LINE IN -C- FORMAT BY
*         CALLING *COMCWTC*.  *WTC* WILL PERFORM A *WRITE* FUNCTION 
*         WHEN THE BUFFER BECOMES FULL. 
* 
*         WRITEC(FET,LINE)
* 
*         ENTRY  (A1) = FWA OF SYMPL/FTN PARAMETER BLOCK. 
*                (FET) = FWA OF THE FET.
*                (LINE) = ADDRESS OF CODED LINE.
* 
*         CALLS  WTC=.
  
  
 WRITEC   SUBR   =           ENTRY/EXIT 
          SA3    A1+1 
          WRITEC X1,X3       WRITE A LINE IN -C- FORMAT 
          EQ     EXIT.
 WRITEH   SPACE  4,8
**        WRITEH - WRITE CODED LINES IN -H- FORMAT. 
* 
*                THIS ROUTINE TRANSFERS 1 CODED LINE IN -H- FORMAT BY 
*         CALLING *COMCWTH*.  *WTH* WILL PERFORM A *WRITE* FUNCTION 
*         WHEN THE FET BUFFER BECOMES FULL. 
* 
*         WRITEH(FET,LINE,LEN)
* 
*         ENTRY  (A1) = FWA OF SYMPL/FTN PARAMETER BLOCK. 
*                (FET) = FWA OF FET.
*                (LINE) = FWA OF CODED LINE.
*                (LEN) = LENGTH OF CODED LINE.
* 
*         CALLS  WTH=.
  
  
 WRITEH   SUBR   =           ENTRY/EXIT 
          SA4    A1+2 
          SA3    A1+1 
          SA4    X4 
          WRITEH X1,X3,X4    WRITE A LINE IN -H- FORMAT 
          EQ     EXIT.
 WRITER   SPACE  4,10 
**        WRITER - WRITE END-OF-RECORD ON A SEQUENTIAL FILE.
* 
*                THIS ROUTINE FLUSHES THE BUFFER AND WRITES AN END-OF-
*         RECORD. 
* 
*         WRITER(FET) 
* 
*         ENTRY  (A1) = PARAMETER LIST. 
*                (FET) = FWA OF THE FET.
* 
*         CALLS  CIO=.
  
  
 WRITER   SUBR   =           ENTRY/EXIT 
          WRITER X1,RCL      WRITE EOR
          EQ     EXIT.
 WRITEW   SPACE  4,8
**        WRITEW - WRITE WORDS FROM A WORKING STORAGE BUFFER. 
* 
*                THIS ROUTINE CALLS *WTW=* TO TRANSFER WORDS FROM A 
*         WORKING BUFFER.  *WTW* CALLS CIO WHENEVER THE FET BUFFER
*         IS GETTING NEARLY FULL. 
* 
*         WRITEW(FET,BUF,LEN) 
* 
*         ENTRY  (A1) = FWA OF SYMPL/FTN PARAMETER BLOCK. 
*                (FET) = FWA OF FET.
*                (BUF) = FWA OF WORKING BUFFER. 
*                (LEN) = LENGTH OF TRANSFER.
* 
*         CALLS  WTW=.
  
  
 WRITEW   SUBR   =           ENTRY/EXIT 
          SA4    A1+2 
          SA3    A1+1 
          SA4    X4          VALUE OF LEN 
          WRITEW X1,X3,X4    TRANSFER WORDS FROM WORKING BUFFER 
          EQ     EXIT.
          SPACE  4
          ENTRY  MOREBE            HOLDS NOS/BE -MORE- QUERY MESSAGE
 MOREBE   DATA   C*0(MORE... ANSWER Y OR N) * 
  
          ENTRY  MORENOS           HOLDS NOS -MORE- QUERY MESSAGE 
MORENOS   VFD    60/10H (MORE...
          VFD    60/10HANSWER Y O 
          VFD    30/5HR N) ,30/0000130000B
  
  
          SPACE  4
**  DEFINE ENTRY POINTS FOR CIO 
          ENTRY  CIO= 
*CALL COMCCIO 
**  DEFINE ENTRY POINTS FOR RDC 
          ENTRY  RDC= 
*CALL COMCRDC 
**  DEFINE ENTRY POINTS FOR RDW 
          ENTRY  RDW=,LCB=,RDX= 
*CALL COMCRDW 
**  DEFINE ENTRY POINTS FOR WTC 
          ENTRY  WTC= 
*CALL COMCWTC 
**  DEFINE ENTRY POINTS FOR WTH 
          ENTRY  WTH= 
*CALL COMCWTH 
**  DEFINE ENTRY POINTS FOR WTW 
          ENTRY  WTW=,DCB=,WTX= 
*CALL COMCWTW 
          SPACE  3
          SPACE  5                                                      000480
          ENTRY  AUTLOC,AUTOPC                                          000490
AUTLOC    BSSZ   1                                                      000500
JP        NO                                                            000510
          NO                                                            000520
          RJ     0                                                      000530
AUTOPC    BSSZ   1                 -CTL- CALLS US TO GET BACK INTO      000540
          SA1    AUTLOC            OVERLAY THAT WAS JUST ACTIVE         000550
          ZR     X1,AUTOPC         NO WAY .....                         000560
          SA2    JP                                                     000570
          MX0    42                                                      FEAT157
          BX1    -X0*X1            MAKE SURE ONLY 18 BITS OF ADDRESS     FEAT157
          BX2    X0*X2             CLEAR ANY PREVIOUS ADDRESS            FEAT157
          BX6    X2+X1                                                  000580
          SA6    JP                                                     000590
          RJ     CLR.INS           CLEAR INSTRUCTION STACK
 CLR.INS  DATA   0
          JP     JP                -JP- JUST IN CASE 6600               000600
          EJECT 
*********************************************************************** 
*                                                                     * 
*    Q U C L O C K    A FUNCTION WHICH UPDATES THE CURRENT-TIME,      * 
*                     UPDATES THE DATE IF NECESSARY, AND RETURNS      * 
*                     RETURNS THE VALUE OF CURRENT-TIME.              * 
*                                                                     * 
*         CALLS-      FTD, FORMAT TIME OR DATE                        * 
*                                                                     * 
*********************************************************************** 
          SPACE  3
          ENTRY  QUCLOCK
 QUCLOCK  SUBR               ENTRY/EXIT 
          CLOCK  FTDA        NEW TIME TO FTDA 
          RJ     FTD         FORMAT TIME/DATE 
          SA1    TIME        FETCH PREVIOUS CURRENT-TIME
          IX2    X6-X1
          SA6    A1          STORE NEW TIME 
          PL     X2,EXIT.    IF OLD TIME GR NEW TIME
          DATE   FTDA        NEW DATE TO FTDA 
          RJ     FTD         FORMAT TIME/DATE 
          SA6    DATE        STORE NEW DATE 
          SA1    TIME        GET RECENTLY STORED TIME 
          BX6    X1          CLOCK IS A FUNCTION...TIME IN X6 
          EQ     EXIT.       RETURN 
          SPACE  5
*********************************************************************** 
*                                                                     * 
*       F T D         FORMAT TIME/DATE                                * 
*                     BLANKS OUT THE END CHARACTER POSITIONS IN THE   * 
*                     TIME/DATE GIVEN IN FTDA.                        * 
*                                                                     * 
*          EXPECTS     TIME/DATE IN FTDA                              * 
*                                                                     * 
*          RETURNS     FORMATTED TIME/DATE IN X6                      * 
*                                                                     * 
*********************************************************************** 
          SPACE  3
 FTD      BSSZ   1           FORMAT TIME/DATE 
          SA1    FTDA        GET THE THING TO BE FORMATTED
          MX0    12          TWO CHARACTER MASK 
          LX0    6           SHIFT FOR ONE ON EACH END
          BX6    -X0*X1      CLEAR OUT END CHARACTERS 
          SX0    5555B       TWO BLANKS 
          LX0    54          SHIFT FOR ONE ON EACH END
          BX6    X6+X0       INSERT THE BLANKS ON THE ENDS
          EQ     FTD         RETURN 
          SPACE  2
 FTDA     BSSZ   1           TIME/DATE TO BE FORMATTED
          SPACE  4
************************************************************************
* 
*         RCLINP
* 
*         IF BUFFER EMPTY (IN = OUT) ISSUE RECALL FOR INPUT FILE
*         REQUIRED WHEN READ NEEDS TO ACCESS NEXT WORD FOLLOWING
*         CARD MOVED FROM CIO BUFFER INTO RBUFFER 
* 
************************************************************************
          SPACE  2
          ENTRY  RCLINP 
 RCLINP   BSSZ   1           ENTRY/EXIT 
          SA1    INPUT+2     IN 
          SA2    INPUT+3     OUT
          IX1    X1-X2
          NZ     X1,RCLINP   IF DATA IN BUFFER
          RECALL INPUT       ISSUE RECALL ON INPUT FET
          EQ     RCLINP      RETURN 
          EJECT 
************************************************************************
*                                                                      *
*         R E S C S F                                                  *
*                                                                      *
*         RESTORE THE ORIGIONAL CONTROL STATEMENT ENVIRONMENT.         *
*         THIS IS CALLED FOR NOS/BE ONLY, NECESSARY SINCE THE *OS*     *
*         DIRECTIVE CREATES A NEW C.S. FILE WHICH REPLACES THE         *
*         EXISTING C.S. ENVIRONMENT.                                   *
*                                                                      *
************************************************************************
          SPACE  3
          ENTRY  RESCSF 
 RESCSF   BSSZ   1           ENTRY/EXIT 
          SA1    CSF
          ZR     X1,RETRN    RETURN IF NO INFORMATION WAS SAVED 
          ENCSF  CSF,CSF+1   RESTORE CONTROL STATEMENT FILE 
 RETRN    EQ     RESCSF 
          SPACE  10 
************************************************************************
*                                                                      *
*         S A V E C S F                                                *
*                                                                      *
*         SAVE THE CONTROL STATEMENT ENVIRONMENT.  THIS IS CALLED      *
*         FOR NOS/BE ONLY, NECESSARY SINCE THE *OS* DIRECTIVE WILL     *
*         DESTROY THE EXISTING C.S. FILE BY PASSING A NEW ONE          *
*         TO THE OPERATING SYSTEM.                                     *
*                                                                      *
************************************************************************
          SPACE  3
          ENTRY  SAVECSF
 SAVECSF  BSSZ   1           ENTRY/EXIT 
          ACCSF  CSF,CSF+1   SAVE CONTROL STATEMENT FILE
          EQ     SAVECSF
          SPACE  2
 CSF      BSSZ   2
          EJECT 
          IFEQ   OS$NAME,NOS
************************************************************************
*                                                                      *
*         ESTABLISHES A MAP BETWEEN THE SYSTEM ERROR CODE AND THE      *
*         QU DIAGNOSTIC TO BE PRINTED.  UPON EXIT, *QUMAP* WILL        *
*         HOLD THE VALUE OF THE SWITCH SUBSCRIPT USED IN *BSTOP* TO    *
*         BRANCH TO THE PROPER DIAGNOSTIC.                             *
*                                                                      *
*         USES   B0,B2,B3,B6                                           *
*                A2                                                    *
*                X2,X3,X4,X6                                           *
*                                                                      *
************************************************************************
          SPACE  3
          ENTRY  SYSMAP 
          ENTRY  QUMAP
 SYSMAP   BSS    1
          SA2    ABTADDR+7   EXTRACT ERROR CODE FROM RPV BLOCK
          MX3    48D
          BX4    -X3*X2 
          SB6    B1          ( B6 ) = COUNTER, START AT ONE 
          SB2    X4          ( B2 ) = SYSTEM ERROR CODE 
          SA2    SYSERR      ( X2 ) = ADDR OF SYSTEM MAP TABLE
 COMPAR   BX4    -X3*X2 
          SB3    X4          ( B3 ) = SYSTEM MAP TABLE ITEM VALUE 
          LE     B3,NEWWD    ( B3 ) LE 0, EXHAUSTED WORD IN TABLE 
          NE     B2,B3,UPIT  NO MATCH, UP COUNTER, CHK NEXT VALUE 
          SX6    B6+
          SA6    QUMAP       MATCH, STORE COUNTER INTO QUMAP
          EQ     FINIS       RETURN 
 UPIT     SB6    B6+B1       UP THE COUNTER 
          AX2    12          POSITION TO NEXT VALUE IN TABLE
          EQ     COMPAR      CHECK AGAIN FOR A MATCH
 NEWWD    SA2    A2+1        POSITION TO NEXT WORD IN TABLE 
          NZ     X2,COMPAR   IF NOT END OF TABLE, TRY AGAIN 
 FINIS    EQ     SYSMAP      RETURN 
          SPACE  2
 QUMAP    DATA   0
 SYSERR   VFD    12/PCET,12/CPET,12/PPET,12/ARET,12/TLET
          VFD    12/TKET,12/ECET,12/RRET,12/OKET,12/ODET
          VFD    12/TAET,12/SYET,12/FLET,12/PSET,12/SRET
          DATA   0
          ENDIF 
          SPACE  2
          END 
