*DECK C$COMIO 
          IDENT  C$COMIO
          TITLE  C$COMIO - COMMON INPUT-OUTPUT ROUTINES 
  
          MACHINE  ANY,I
          COMMENT  COMMON INPUT-OUTPUT ACTIONS
          SST 
          B1=1
          SPACE  4
**        CBCOMIO - COMMON INPUT-OUTPUT ROUTINES
* 
*         CALLING SEQUENCE - DEPENDS ON INDIVIDUAL ROUTINE
*                A0 ALWAYS CONTAINS FIT ADDRESS 
* 
*         ROUTINES CONTAINED HEREIN:  
* 
*                C.ATEND     TAKE AT END RETURN 
*                C.CLOSE     CLOSE THE FILE 
*                C.A0B1      RESTORE A0, B1 UPON RETURN FROM CDCS CALL
*                C.EX        ERROR EXIT 
*                C.GETRT     GETS LAST RETURN FROM STACK
*                C.INVKY     TAKE INVALID KEY RETURN
*                C.NORRT     TAKE NORMAL RETURN 
*                C.OPIN      OPEN INPUT 
*                C.OPIO      OPEN INPUT-OUTPUT
*                C.OPOUT     OPEN OUTPUT
*                C.SVRTN     SAVES RETURN IN STACK
*                C.USE       CAUSE DECLARATIVE TO BE PERFORMED
* 
  
  
*CALL IOMICROS
  
*CALL IODEFSC 
 C.ATEND  EJECT 
**        C.ATEND - TAKES AT END EXIT IF SPECIFIED
* 
*         CALLING SEQUENCE
*                JUMP DIRECTLY TO IT
* 
*         GIVEN  - RETURN IN STACK
* 
*         DOES   - IF AT END WAS SPECIFIED, TAKES IT
*                IF DECLARATIVE SPECIFIED, EXECUTES IT
*                SETS FILE-STATUS TO 10 IN ALL CASES
* 
*         USES   - ALL REGISTERS
*                CALLS C.GETRT AND C.SETFS
* 
          ENTRY  C.ATEND
 C.ATEND  BSS    0
          STORE  A0,ATEN=YES  SET AT END FLAG 
          STORE  A0,INVK=YES  ALSO SET INV KEY FLAG SINCE DEBUG TESTS IT
          SX1    2R10        FILE STATUS CODE 10
 ATENST   BSS    0           COMES HERE TO STORE STATUS 
          RJ     C.SETFS     PUT IT INTO FILE-STATUS DATA ITEM
          RJ     C.GETRT     GET THE RETURN 
          PL     X4,ATEN1    JUMP IF NO AT END SPECIFIED
          EQ     ATENEX 
 ATEN1    BSS    0
          MX4    0           CLEAR FOR SVRTN
          RJ     C.SVRTN     SAVE THE RETURN AGAIN
          FETCH  A0,USEX,X5  GET EXCEPTION DECLARATIVE
          ZR     X5,ATEN2    JUMP IF NO EXCEPTION DECL PROVIDED 
          RJ     C.USE       EXECUTE USE PROCEDURE
 ATENRTN  BSS    0
          RJ     C.GETRT     GET RETURN ADDRESS 
 ATENEX   BSS    0
          SB3    B1          INDICATE AN EXCEPTION
          JP     B6 
*      ERROR - NO AT END OR USE DECLARATIVE 
 ATEN2    BSS    0
          FETCH  A0,FSWD,X5  FILE STATUS WORD POINTER 
          NZ     X5,ATENRTN  JP IF FILE STATUS PROVIDED - NO ERROR
          SX1    #COMNDC
          RJ     C.FIOER     GO TO FATAL I-O ERROR PROCESS
          EQ     ATENRTN     RETURN IF C.IOENA CALLED 
          TITLE  C.A0B1 - RESTORE A0 AND SET B1 TO 1
          EJECT 
**        C.A0B1 - RESTORE A0 AND B1
* 
*         CALLING SEQUENCE
*                RJ  C.A0B1 
* 
*         GIVEN - STACK 
* 
*         DOES -  SET A0 = FIT FROM LAST STACK ENTRY
*                      B1 = 1 
*                      X4 = TOP OF STACK (RETURN ADDR IN LOWER 18 BITS) 
* 
*         USES -  A4, X4, A0, B1
* 
          ENTRY  C.A0B1 
 C.A0B1   DATA   0
          SA4    IOSTACK
          SA4    X4-1        LAST STACK ENTRY 
          LX4    30 
          SA0    X4          RESTORE A0 
          SB1    1           RESTORE B1 
          LX4    30          REPOSITION STACK ENTRY 
          EQ     C.A0B1 
          TITLE  C.CLOSE - CLOSE THE FILE 
 C.CLOSE  EJECT 
**        C.CLOSE - CLOSES THE FILE 
* 
*         CALLING SEQUENCE
*                SB3  CLOSE FLAG
*                EQ   =XC.CLOSE 
* 
*         GIVEN  - SEE ABOVE
* 
*         DOES   - EXECUTES THE CLOSE 
*                RETURNS BUFFER SPACE 
*                RETURNS TO MAIN LINE NORMALLY
* 
*         USES   - ALL REGISTERS DUE TO CRM 
* 
          ENTRY  C.CLOSE
 C.CLOSE  BSS    0
          RJ     C.SVRTN     SAVE RETURN
          SB2    #LOCK# 
          NE     B2,B3,CLONLK  JUMP IF NOT CLOSED WITH LOCK 
          STORE  A0,CLCK=YES   SET CLOSED WITH LOCK 
          SB3    #RET#       SET TO RETURN FILE 
          EQ     CLOOK1 
 CLONLK   BSS    0
          SB3    #DET#       SET TO DETACH THE FILE (WONT REWIND IT)
 CLOOK1   BSS    0
          FETCH  A0,CFST,X5  GET FILE CARD OR C.FILE FLAG 
          NG     X5,CLONCF   JP IF USER SET CLOSE FLAG
          STORE  A0,CF=B3    STORE CLOSE FLAG 
 CLONCF   BSS    0
          FETCH  A0,FNEX,X5  OPTIONAL FILE NOT EXISTING FLAG
          STORE  A0,FNEX=NO,4  CLEAR IT 
          NG     X5,C.NORRT  TAKE NORMAL RETURN IF SET
 CDCS     IFNE   OP.DCS,OP.NO 
          FETCH  A0,DBFO,X5  GET DB ORDINAL 
          ZR     X5,CLOSCAL  JUMP IF NOT DB FILE
          RJ     =XC.DMCLS   -CLOSE- VIA CDCS 
          EQ     CLOSRET
 CDCS     ENDIF 
 CLOSCAL  BSS    0
          FETCH  A0,DPFF,X5  GET DUPLICATE FILE FLAG
          PL     X5,CLONDF   JP IF NOT DUPLICATE
          FETCH  A0,DPFP,X2  GET DUPLICATE FILE POINTER 
          STORE  X2,ADDFA=NO CLEAR DUPLICATE FILE ASGD IN ACC OR DIS
          STORE  A0,DPFF=NO 
          STORE  A0,DPFP=0
          EQ     CLOSRET     NO CLOSE - ASSOCIATED ACCEPT OR DISPLAY OPEN 
 CLONDF   BSS    0
          FETCH  A0,OC,X5 
          SX5    X5-#OPE# 
          ZR     X5,CLOPN    JP IF FILE IS OPEN 
          SX1    #CLUOF      ERROR - FILE IS NOT OPEN 
          MX2    0           NO MESSAGE INSERT
          MX7    0           NO ABORT 
          RJ     C.IOERR     OUTPUT MESSAGE AND CONTINUE
          FETCH  A0,CFST,X5 
          NG     X5,CLONDF1  HAVE WE SET CF ABOVE 
          STORE  A0,CF=B0    IF SO, RESET IT
 CLONDF1  BSS    0
          EQ     CLOSRET     RETURN - IGNORE CLOSE
 CLOPN    BSS    0
          CLOSEM A0          CALL CLOSE 
 CLOSRET  BSS    0
          STORE  A0,EX=B0    CLEAR ERROR EXIT 
          EQ     C.NORRT     RETURN 
 CDCS     IFNE   OP.DCS,OP.NO 
          TITLE  C.EXDMO - CDCS OPEN ERROR EXIT 
 C.EXDMO  EJECT 
**        C.EXDMO - CDCS -OPEN- ERROR EXIT
* 
*         CALLED BY CDCS ON -OPEN- ERROR.  DOES NORMAL -C.EX- PROCESSING
* 
          ENTRY  C.EXDMO
 C.EXDMO  DATA   0
          RJ     C.A0B1      RESTORE A0 AND B1
          RJ     C.EX 
          EQ     C.EXDMO
 CDCS     ENDIF 
          TITLE  C.EX - CRM ERROR EXIT PROCESSOR
 C.EX     EJECT 
**        C.EX   - CRM ERROR EXIT 
* 
*         CALLED BY CRM ON ERROR CONDITION DETECTED 
*                A0 HAS FIT ADDRESS 
*                ENTERED FROM CRM BY FAKE RJ WITH RETURN ADDR AS
*                NORMAL COMPLETION OF I-O OPERATION 
* 
*         GIVEN - IRS IN FIT HAS ERROR CODE.
*                A0 HAS FIT ADDRESS 
* 
*         DOES
*                1.  CONVERTS ERROR CODE TO DISPLAY CODE
*                2.  OUTPUTS MESSAGE TO DAYFILE WITH ERROR CODE IN IT 
*                3.  BOMBS JOB
* 
*         USES   - ALL REGISTERS
*                A0 NOT DESTROYED 
* 
          ENTRY  C.EX 
 C.EX     DATA   0
 CDCS     IFNE   OP.DCS,OP.NO,1 
          RJ     C.A0B1      RESTORE A0, B1 (IF RETURN FROM CDCS) 
          FETCH  A0,IRS,X1   GET ERROR CODE 
 CDCS     IFNE   OP.DCS,OP.NO 
          LX1    54 
          SX5    X1-6        CDCS ERRORS ARE 600B THRU 677B 
          LX1    6           RESTORE ERROR CODE 
          NZ     X5,C.EX1    JUMP IF NOT A CDCS ERROR 
          SX5    X1-630B     630B ERROR - CDCS OPEN OLD ON ABSENT FILE
          ZR     X5,EXFATAL    AND NO CDCS PROC SPECIFIED - JP IF SO
 CDCS2    IFEQ   OP.DCS,OP.DCS2 
          SX5    X1-663B     CHECK FOR LOCKED 
          NZ     X5,C.EX0    JUMP IF NOT DEADLOCK 
          FETCH  A0,USDL,X5  DEADLOCK DECLARATIVE NUMBER
          NZ     X5,C.EXNFE  JP IF DECLARATIVE IS GIVEN 
          SX1    #DMLOK1     ERROR MESSAGE NBR
          RJ     C.FIOER     ABORT W/MSG - NO DEADLOCK DECLARATIVE
 C.EXNFE  BSS    0
          STORE  A0,USEX=X5 
 C.EX0    BSS    0
 CDCS2    ENDIF 
          EQ     EXRTN
 C.EX1    BSS    0
 CDCS     ENDIF 
          SA2    EXERLST     LIST OF NON FATAL ERRORS 
          MX7    60-9 
 EXLP0    BSS    0
          SB2    5
 EXLP0A   BSS    0           CHECK FOR NON FATAL ERRORS 
          LX2    12 
          BX3    -X7*X2 
          ZR     X3,EXFATAL  JP IF END OF LIST - MUST BE FATAL
          IX4    X1-X3
          ZR     X4,EXNONF   JP IF NOT A FATAL ERROR
          SB2    B2-B1
          NZ     B2,EXLP0A
          SA2    A2+B1
          EQ     EXLP0
 EXFATAL  BSS    0           FATAL ERROR IF HERE
          MX7    1           FLAG TO ABORT JOB
          EQ     EXMSG       GO OUTPUT MSG, DO USE AND ABORT
 EXNONF   BSS    0           NON FATAL ERROR
          LX2    59-11
          PL     X2,EXNP     JP IF NOT PARITY ERROR 
          FETCH  A0,EO,X5    GET ERROR OPTION 
          ZR     X5,EXFATAL  JP IF OPTION IS TO ABORT 
 EXNP     BSS    0
          LX2    1
          PL     X2,EXRTN    JP IF NO DAYFILE MESSAGES
          MX7    0           NO ABORT 
 EXMSG    BSS    0
          RJ     EXOPMS      OUTPUT MSG, DO USE AND CONTINUE OR ABORT 
          EQ     C.EX        RETURN 
 EXRTN    BSS    0
          SX1    2R90        CRM ERROR DETECTED FILE STATUS 
          RJ     C.SETFS     SET IT 
          STORE  A0,FSSET=YES      FLAG THAT IT HAS BEEN SET
          RJ     C.USE       PERFORM ANY USE PROCEDURE
          EQ     C.EX        RETURN 
  
 EXOPMS   DATA   0           OUTPUT DAYFILE MSG, DO USE AND ABORT OR NOT
          SB2    3
          SX3    333333B
          LX1    60-9 
          MX2    0
          MX5    57 
 EXLP1    BSS    0           CONVERT ERROR CODE TO DISPLAY CODE 
          LX1    3
          LX2    6
          SX6    X1 
          BX2    X6+X2
          SB2    B2-B1
          BX1    X5*X1       MASK OFF USED CHAR 
          NZ     B2,EXLP1 
          IX6    X3+X2
          LX6    60-18
          SX1    #COMCRM     ERROR MESSAGE NUMBER 
          RJ     C.IOERR     MESSAGE TO DAYFILE, AND ANY USE PROCEDURE
          EQ     EXOPMS      RETURN 
  
*         EXERLST IS A LIST OF NON FATAL CRM ERRORS 
*         EACH ENTRY IS 12 BITS - TABLE ENDED BY 12 ZERO BITS 
*                BIT 11 SET IF PARITY ERROR CODE
*                BIT 10 SET IF DAYFILE MESSAGE TO BE PRINTED
*                BIT 9 UNUSED 
*                BITS 0-8 SET TO CRM ERROR CODE 
  
 EXERLST  BSS    0
          VFD    3/2,9/040B  REDUNDANT OPEN 
          VFD    3/0,9/052B  FILE IN UNKNOWN STATE
          VFD    3/2,9/060B  REDUNDANT CLOSE
          VFD    3/6,9/135B  RMS READ PARITY ERROR
          VFD    3/6,9/137B  SQ READ PARITY ERROR 
          VFD    3/0,9/176B  MRL IN FSTT > MRL IN FIT 
          VFD    12/0        END OF LIST
          TITLE  C.FINFO - DO FILINFO REQUEST 
 C.FINFO  EJECT 
**        C.FINFO - DO FILINFO REQUEST
* 
*         ON INPUT X2 HAS LFN 
* 
*         ON OUTPUT X2 HAS RETURN WORD +1 - WHICH IS ZERO IF FILE GONE
* 
          ENTRY  C.FINFO
 C.FINFO  DATA   0
          SX5    60000B      REQUEST PARAM
          BX7    X2+X5
          SA7    C.FINRT
          SX6    B1 
          SA6    C.FINRT+5   SET FOR EXTENDED INFO
          FILINFO C.FINRT    DO FILINFO CALL
          SA2    C.FINRT+1   RETURN 
          EQ     C.FINFO     EXIT 
          ENTRY  C.FINRT
 C.FINRT  BSSZ   6           FILINFO RETURN ARRAY 
          TITLE  C.GETRT - GETS LATEST RECURN FROM STACK
 C.GETRT  EJECT 
**        C.GETRT - GETS THE LATEST RETURN FROM THE TOP OF THE STACK
* 
*         CALLING SEQUENCE
*                RJ  C.GETRT
* 
*         GIVEN  - STACK
* 
*         DOES   - REMOVES LAST RETURN FROM STACK - DEC STACK PTR 
*                ON RETURN
*                   A0 = FIT FROM STACK 
*                   X4 = BIT 59 1 IF INV KEY OR AT END, 0 IF NOT
*                   B6 = RETURN ADDRESS 
*                     THESE ARE THE SAME AS INPUTS TO C.SVRTN EXCEPT
*                     X4 HAS ENTIRE STACK ENTRY 
* 
*         USES   - A4, A6, X4, X5, X6 
* 
          ENTRY  C.GETRT
 C.GETRT  DATA   0
          SA4    IOSTACK     GET STACK POINTER
          SX6    X4-1        DEC
          SA6    A4          STORE NEW
          SX5    A4 
          IX5    X5-X6
          PL     X5,GETRSU   JUMP IF STACK UNDERFLOW
          SA4    X6          GET STACK ENTRY
          SB6    X4          SET RETURN ADDR
          LX4    30          POSITION FIT 
          SA0    X4          SET FIT
          LX4    30          SET X4 
          EQ     C.GETRT
 GETRSU   BSS    0
          SX1    #COMSTU
 STACKERR BSS    0
          SX2    B0          NO MESSAGE INSERT
          MX3    1           NO LINE NUMBER MESSAGE 
          MX6    1           ABORT BY -CBMSG- 
          RJ     =XC.MSG     MESSAGE TO DAYFILE AND ABORT 
          TITLE  C.INVKY - INVALID KEY ENTRY
 C.INVKY  EJECT 
* 
**        C.INVKY - INVALID KEY ENTRY 
* 
*         CALLING SEQUENCE
*                SX1  2RXX  WHERE XX IS THE STATUS CODE IN DISPLAY CODE 
*                EQ  =XC.INVKY
* 
*         DOES   SETS STATUS CODE AND TAKES INVALID KEY RETURN OR 
*                EXECUTES EXCEPTION DECLARATIVE 
* 
*         USES   ALL REGISTERS DUE TO POSSIBILITY OF EXCEPTION DECL 
* 
          ENTRY  C.INVKY
 C.INVKY  BSS    0
          STORE  A0,INVK=YES FLAG AS INVALID KEY
          EQ     ATENST      GO TO PROCESS FOR AT END (IS SAME) 
          TITLE  C.IOERR - INPUT OUTPUT ERROR MESSAGE PROCESSOR 
 C.FIOER  EJECT 
* 
**        C.IOERR - INPUT-OUTPUT DAYFILE ERROR MESSAGE PROCESSOR
* 
*         CALLING SEQUENCE
*                X1 = ERROR MESSAGE NUMBER
*                X2 = 0 IF NO MESSAGE INSERT
*                   " 0 IF MESSAGE INSERT(S) (NOTE X6)
*                X6 = 1ST MESSAGE INSERT OR 1ST WORD OF 1ST MESSAGE IN- 
*                     SERT - ANY OTHER INSERTS IN =XC.MSINS+1 THRU 5
*                     (EACH INSERT IS LEFT-JUSTIFIED, ZERO-FILLED)
*                X7 = 0 IF JOB NOT TO BE ABORTED AFTER MESSAGE
*                   " 0 IF JOB TO BE ABORTED AFTER MESSAGE
*                RJ  C.IOERR
* 
*         GIVEN  THE RETURN MUST BE THE LAST ITEM IN THE STACK AND
*                THE RETURN ADDR MINUS 1 MUST CONTAIN THE LINE NBR
* 
*         DOES   WRITES ERROR MESSAGE TO DAYFILE (VIA CBMSG)
*                IF SPECIFIED, ABORTS JOB (VIA CBMSG) 
*                IF CID ACTIVE SET STATUS AND EXECUTE USE CODE
*                    BEFORE ISSUING MESSAGES
* 
*         USES   ALL REGISTERS
* 
          ENTRY  C.IOERR
 C.IOERR  DATA   0
 C.IOERR1 SA6    =XC.MSINS   PERHAPS SET UP INSERT
          RJ     C.A0B1      GET TOP OF STACK ENTRY 
          SA7    FLG.ABT     PERHAPS SET JOB ABORT FLAG 
          SX6    X1 
          SA6    =SERRORCD
          SX3    X4-1        LINE NUMBER ADDRESS
          SB2    =YDBUG.FN
          NG     B2,NOCID    NOT INTERACTIVE DEBUGGING
          BX6    X3 
          SA6    =SSVX3      SAVE X3
          BX6    X2 
          SA6    =SSVX2      SAVE X2 MESSAGE INSERT FLAG
          EQ     CIDCIO1     GO SET STATUS AND EXECUTE USE PROCEDURE
 NOCID    BSS    0
          MX6    0           FLAG NOT TO ABORT
          MX7    1
          SA7    =XC.HLDMS   FLAG TO HOLD MESSAGE CAPSULE 
          RJ     =XC.MSG     OUTPUT MESSAGE 
          SX1    #COMFIL     -  FILE NAME- MESSAGE NUMBER 
          SA2    A0          FILE NAME, AND X2"0 FLAGS INSERT 
          MX6    42 
          BX6    X6*X2
          SA6    =XC.MSINS   SET UP INSERT
          MX3    1           NO LINE NUMBER MESSAGE 
          SX6    B0          NO ABORT BY -CBMSG-
          SA6    =XC.HLDMS   CLEAR HLD MESSAGE CAPSULE FLAG 
          RJ     =XC.MSG     MESSAGE TO DAYFILE 
          SB2    =YDBUG.FN
          PL     B2,C.IOERR  RETURN IF INTERACTIVE DEBUGGING
 CIDCIO1  BSS    0
          SA4    ERRORCD     GET SAVED ERROR CODE 
          SB2    ERRTBLE-ERRTBL-1 
          MX5    60-8 
          MX6    60-12
 IOERLP1  BSS    0
          SA1    ERRTBL+B2   GET ERROR TABLE ENTRY
          SB3    3
 IOERLP2  BSS    0
          BX3    -X5*X1      ERROR CODE 
          AX1    8
          BX2    -X6*X1      CB5TEXT MSG NUMBER 
          AX1    12 
          IX7    X2-X4       CHECK AGAINST THIS ERROR 
          ZR     X7,IOERFND  JP IF THIS IS A COBOL DETECTED ERROR 
          SB3    B3-B1
          NZ     B3,IOERLP2 
          SB2    B2-B1
          SX1    2R90        FLAG AS CRM ERROR
          PL     B2,IOERLP1 
          EQ     IOERUSE
 IOERFND  BSS    0
          STORE  A0,ES=777B  FLAG AS COBOL ERROR
          STORE  A0,CBER=X3  SAVE COBOL ERROR NUMBER
          SX1    2R99        SET STATUS ERROR CODE
 IOERUSE  BSS    0
          RJ     C.SETFS     SET FILE STATUS TO 90 OR 99
          STORE  A0,FSSET=YES      SET FILE STATUS SET
          SX6    1RF         FATAL FLAG 
          SA5    FLG.ABT     ABORT FLAG 
          ZR     X5,IOENAB   JP IF NOT FATAL
          SA6    C.ERFLG     SET FLAG TO FATAL FOR C.IOST 
 IOENAB   BSS    0
          RJ     C.USE       PERFORM ANY USE PROCEDURE
          SA5    FLG.ABT
          SB2    =YDBUG.FN
          NG     B2,CIDCIO2  NOT INTERACTIVE DEBUGGING
          SA1    ERRORCD     RETRIEVE ORIGINAL MESSAGE NUMBER 
          SA2    SVX2        RETRIEVE MESSAGE INSERT FLAG 
          SA3    SVX3        RETRIEVE X3
          ZR     X5,NOCID    NO ABORT GO ISSUE MESSAGES NORMALLY
          MX6    1
          RJ     =XC.MSG     SEND MESSAGE TO CID, NO RETURN 
 CIDCIO2  BSS    0
          ZR     X5,C.IOERR  JUMP IF JOB NOT TO BE ABORTED
 C.IOERR2 SX1    #CBMSG2     -JOB ABORTED- MESSAGE NUMBER 
          SX2    B0          NO MESSAGE INSERT
          MX3    1           NO LINE NUMBER MESSAGE 
          SX6    B0          NO ABORT BY -CBMSG-
          RJ     =XC.MSG     MESSAGE TO DAYFILE 
          ABORT 
          SPACE  1
 FLG.ABT  DATA   0           FLAG SET NON-ZERO TO ABORT JOB 
          ENTRY  C.ERFLG
 C.ERFLG  VFD    54/0,6/1RT  TRIVIAL OR FATAL FLAG FOR C.IOST 
          ENTRY  C.CBLER
 C.CBLER  DATA   0           COBOL DETECTED ERROR FLAG - NZ IF SO 
 ERRTBL   BSS    0           TABLE OF CB5TEXT ERROR CODES AND CBL RTN CO
          VFD    12/#ADVRMB,8/1    RM BINARY ON ADVANCING FILE
          VFD    12/#ADVRTZ,8/2    RT WRONG ON ADVANDING FILE 
          VFD    12/#COMDPF,8/3    OPEN DUPL NAME OF OPEN FILE
          VFD    12/#COMFNE,8/4    OPEN OF INPUT OR IO FILE NOT EXIST 
          VFD    12/#COMLCK,8/5    OPEN OF LOCKED FILE
          VFD    12/#DAOC1,8/6     HMB NOT GIVEN FOR DA OPEN OUTPUT 
          VFD    12/#RLMSG2,8/7    REC LEN ON OLD REL DIFF THAN PROG
          VFD    12/#RLMSG3,8/10B  REL FILE HDR BAD 
          VFD    12/#RLMSG4,8/11B  OLD REL FILE HAS NO HEADER 
          VFD    12/#DLRWSQ,8/12B  DEL OR REW ON SQ ACC - NO READ 
          VFD    12/#IOMSG1,8/13B  READ W/UNDEF CURR REC PTR
          VFD    12/#RLERR,8/14B   REWRITE RL NOT = OLD RL
          VFD    12/#RTERR,8/15B   ILLEG REC TYPE FOR REWRITE 
          VFD    12/#OPNMF,8/16B   MULTI-FILE NOT ASGD TO TAPE
          VFD    12/#RDOPF,8/17B   READ ON FILE OPENED OUTPUT 
          VFD    12/#COMOPW,8/20B  OPEN ACC OR DISP W/PD DIFF 
          VFD    12/#DLFLOP,8/21B  DELETE FILE ON OPEN FILE 
          VFD    12/#ATENAC,8/22B  AT END WHEN ACCEPTING
          VFD    12/#RLPRUM,8/23B  PRU FILE/PROGRAM MISMATCH
          VFD    12/#OPRLBG,8/24B  MRL CHANGED IN FILE CARD 
          VFD    12/#CLUOF,8/25B   CLOSE ON UNOPENED FILE 
 ERRTBLE  BSS    0
          SPACE  2
          ENTRY  C.IOENA
 C.IOENA  DATA   0           DO NOT ABORT AFTER EXECUTING DECLARATIVE 
          MX6    0
          SA6    FLG.ABT     CLEAR ABORT FLAG 
          EQ     C.IOENA     RETURN 
          TITLE  C.FIOER - FATAL I-O DAYFILE ERROR MESSAGE PROCESSOR
          EJECT 
* 
**        C.FIOER - FATAL I-O DAYFILE ERROR MESSAGE PROCESSOR 
* 
*         CALLING SEQUENCE
*                X1 = ERROR MESSAGE NUMBER
*                RJ  C.FIOER
* 
*         GIVEN  NOTE -C.IOERR- 
* 
*         DOES   CALLS -C.IOERR- TO OUTPUT DAYFILE MESSAGE (WITH NO 
*                INSERT) AND ABORT JOB
* 
*         USES   ALL REGISTERS
* 
          ENTRY  C.FIOER
 C.FIOER  DATA   0
          SX2    B0          INDICATE NO MESSAGE INSERT 
          MX7    1           INDICATE ABORT JOB 
          RJ     C.IOERR     PUT OUT ERROR MSG
*      WILL RETURN HERE ONLY IF USER CALLS C.IOENA FROM DECLARATIVE 
          EQ     C.NORRX
          TITLE  C.NORRT - NORMAL RETURN TO I-O CALL
 C.NORTT  EJECT 
**        C.NORRT - NORMAL RETURN TO IO CALL
* 
*         CALLING SEQUENCE - EQ C.NORRT 
*                EQ  C.NORRX  IF DIFFERENT FILE STATUS TO BE RETURNED 
* 
*         GIVEN  - RETURN IN STACK
* 
*         DOES   - SETS FILE STATUS TO 00 AND RETURNS TO TOP OF STACK 
* 
*         USES   - N/A
* 
          ENTRY  C.NORRT
          ENTRY  C.NORRX
 C.NORRT  BSS    0
          SX1    2R00 
 C.NORRX  BSS    0           HERE IF NOT 00 TO BE RETURNED
          FETCH  A0,FSSET,X5 GET FILE STATUS SET FLAG 
          PL     X5,NORRT1   JP IF FS NOT SET BY FATAL CRM ERROR
          STORE  A0,FSSET=NO CLEAR
          EQ     NORRT2 
 NORRT1   BSS    0
          RJ     C.SETFS     SET FILE STATUS TO NO PROBLEM
 NORRT2   BSS    0
          STORE  A0,INVK=NO  CLEAR INVALID KEY AND AT END FLAGS 
          STORE  A0,ATEN=NO 
          RJ     C.GETRT
          SB3    B0          INDICATE NO EXCEPTION
          FETCH  A0,RL,X3    GET RECORD LENGTH FOR W REC READS
          JP     B6 
          TITLE  C.OPXX - OPEN ROUTINES 
 C.OPXX   EJECT 
**        C.OPXX - OPEN ROUTINES
* 
*         CALLING SEQUENCE
*                B3 HAS OPEN FLAG 
*                X1 HAS NUMBER OF APPROPRIATE DECLARATIVE 
*                      XX = EXT FOR EXTEND
*                SA4  OPEN ROUTINE RETURN JUMP
*                EQ   C.OPXX
*                     XX = IN FOR INPUT 
*                     XX = OUT FOR OUTPUT 
*                     XX = IO  FOR I-O
* 
*         DOES  -  CALLS APPROPRIATE CRM THROUGH THE X4 PARAM 
*                CHECKS DEVICE AND SETS BUFFER SIZES AND BLOCK SIZES
*                SETS PROPER FLAGS
* 
*         USES - ALL REGISTERS EXCEPT A0 AND B1 CHANGED 
*                THROUGHOUT THE COMMON CODE, B2 HAS  THE OLD/NEW FLAG 
*                    AND B5 HAS THE PROCESSING DIRECTION. 
*                    THESE REGISTERS MUST NOT BE DESTROYED
* 
          ENTRY  C.OPEXT
 C.OPEXT  BSS    0           OPEN EXTEND
          SB2    #OLD#
          SB5    #OUTPUT# 
          SA3    =XC.FINRT+1
          LX3    60-18
          MX5    60-3 
          BX3    -X5*X3      GET TAPE BITS
          ZR     X3,OPXTMS   MASS STORAGE FILE
*OPEN EXTEND ON TAPE, WHICH CRM DOES NOT LIKE 
          SB3    #N#         NO REWIND INSTEAD OF -E- 
          SB5    #INPUT#     WILL BECOME -OUTPUT- 
          SX6    B1 
          SA6    TAPEXT      SET FLAG FOR TAPE EXTEND 
          EQ     OPXTTP 
 OPXTMS   SB3    #E#
 OPXTTP   FETCH  A0,USOE,X1  GET DECLARATIVE NUMBER 
          EQ     OPCOMM 
          ENTRY  C.OPIN 
 C.OPIN   BSS    0           OPEN INPUT 
          SB2    #OLD#
          SB5    #INPUT#
          FETCH  A0,USOI,X1 
          EQ     OPCOMM 
          ENTRY  C.OPIO 
 C.OPIO   BSS    0           OPEN INPUT-OUTPUT
          SB2    #OLD#
          SB5    #IO# 
          FETCH  A0,USOM,X1 
          EQ     OPCOMM 
          ENTRY  C.OPOUT
 C.OPOUT  BSS    0           OPEN OUTPUT
          SB2    #NEW#
          SB5    #OUTPUT# 
          FETCH  A0,USOO,X1 
 OPCOMM   BSS    0
          FETCH  A0,USFN,X2  GET USE FILE NAME DECL NUMBER
          NZ     X2,OPNSDC   JUMP IF ONE SPECIFIED
          BX2    X1          USE ONE FOR OPEN MODE (IF ANY) 
 OPNSDC   BSS    0
          STORE  A0,USEX=X2  SET ERROR DECLARATIVE NUMBER 
          STORE  A0,ON=B2    SET OLD/NEW FLAG 
          SX6    B2 
          SA6    =SOPONFLG         SAVE ON FLAG 
          RJ     C.SVRTN     SAVE RETURN
 CDCS     IFNE   OP.DCS,OP.NO 
          FETCH  A0,DBFO,X5 
          ZR     X5,OPNSDC1  JUMP IF NOT A CDCS FILE
          STORE  A0,EX=C.EXDMO  SET ERROR EXIT FOR CDCS FILE
          EQ     OPNSDC2
 OPNSDC1  BSS    0
 CDCS     ENDIF 
          STORE  A0,EX=C.EX  SET ERROR EXIT 
 CDCS     IFNE   OP.DCS,OP.NO 
 OPNSDC2  BSS    0
 CDCS     ENDIF 
          STORE  A0,PD=B5    SET PROCESSING DIRECTION 
          STORE  A0,OF=B3    SET REWIND FLAG
          FETCH  A0,CLCK,X5  CLOSE WITH LOCK FLAG 
          PL     X5,OPNTLCK  JP IF NOT CLOSED WITH LOCK 
          SX1    #COMLCK     ERROR - CLOSED WITH LOCK AND RE-OPENED 
          RJ     C.FIOER     DAYFILE AND POSSIBLE BOMB JOB
 OPNTLCK  BSS    0
          STORE  A0,ATEN=NO  CLEAR AT END FLAG
          STORE  A0,FNEX=NO  CLEAR OP FILE NOT EXISTING FLAG
          FETCH  A0,COBO,X5   GET COBOL OPENED FLAG 
          NG     X5,OPNOPR   JP IF OPENED BY COBOL BEFORE 
 CDCS     IFNE   OP.DCS,OP.NO 
          FETCH  A0,DBFO,X5  CHECK FOR CDCS FILE
          NZ     X5,OPNSRAK  JUMP, IF CDCS FILE 
 CDCS     ENDIF 
          FETCH  A0,FO,X5    GET FILE ORGANIZATION
          SX5    X5-#SQ#
          ZR     X5,OPASGD   JP IF SEQUENTIAL FILE - ALREADY CHECKED IN 
          SETFIT A0          SET UP ANY FIT FIELDS FROM FILE CARD 
          FETCH  A0,FO,X4 
          SX4    X4-#WA#
          NZ     X4,OPNOTWA  JUMP IF NOT RELATIVE OR WORD ADDRESS 
          STORE  A0,SBF=NO   FORCE USE OF BUFFERS SO TO WRITE CBL HDR 
 OPNOTWA  BSS    0
          SA4    OPONFLG           GET SAVED ON FLAG
          STORE  A0,ON=X4          RESTORE IT - SETFIT CLOBBERS IT
          FETCH  A0,LFN,X2   GET FILE NAME
          RJ     C.FINFO     DO FILINFO REQUEST 
          NZ     X2,OPASGD   JP IF FILE ASSIGNED
          SA5    OPONFLG
          NZ     X5,OPASGD   JP IF OPENED OLD - NEED NOT BE ASSIGNED
          FETCH  A0,PD,X5 
          SX5    X5-#INPUT# 
          NZ     X5,OPNTOP   JP IF NOT OPENED FOR INPUT 
          FETCH  A0,OPFL,X5 
          PL     X5,OPNTOP   JUMP IF NOT AN OPTIONAL FILE 
          STORE  A0,FNEX=YES  SET NOT EXISTING
 OPASGD   BSS    0
*      THE FILE EXISTS OR IS AN OPTIONAL INPUT FILE OR AN OUTPUT FILE 
          FETCH  A0,CF,X5 
          ZR     X5,OPCFNC   JP IF CLOSE FLAG NOT CHANGED BY FILE CD
          STORE  A0,CFST=YES SET AS CHANGED BY CARD 
 OPCFNC   BSS    0
          SA1    C.MRLFC
          ZR     X1,MNROK    JP IF  MRL NOT CHANGED BY FILE CARD
          FETCH  A0,RLWD,X4  LENGTH IN WORDS (SIZE OF REC AREA) 
          FETCH  A0,MRL,X5   CURRENT MAX REC LEN
          SX6    10 
          IX3    X6*X4       REC AREA SIZE IN CHARS 
          IX7    X3-X5
          PL     X7,OPRLOK   JPIF MRL WITHIN REC AREA 
          STORE  A0,MRL=X3   NOT - SET IT TO BE SO
          MX2    0           NO INSERTS 
          MX7    0           NO ABORT 
          SX1    #OPRLBG     MSG
          RJ     C.IOERR     OUTPUT MESSAGE AND CONTINUE
 OPRLOK   BSS    0
          FETCH  A0,MNR,X4,4 GET MIN REC LEN
          IX4    X5-X4       MRL-MNR
          PL     X4,MNROK    JP IF MNR NOT BIGGER THAN MRL
          STORE  A0,MNR=X5   SET MNR TO MRL 
 MNROK    BSS    0
          FETCH  A0,FO,X2    GET FILE ORG 
          FETCH  A0,RT,X5 
          SX3    B1          USE MNR OF 1 FOR Z RECS
          SX4    X5-#ZT#
          NZ     X4,OPON1    JP IF NOT Z RECORDS
          ZR     X2,OPSETMN  JP IF SEQUENTIAL FILE ORG
          SX1    X2-#WA#
          ZR     X1,OPON1    JP IF RELATIVE OR WORD-ADDRESS 
          FETCH  A0,KEYT,X4  GET KEY TABLE ADDRESS
          ZR     X4,OPON1    JP IF NONE (SOME ERROR ) 
          SB2    B0 
 OPLOOPK  BSS    0
          SA5    X4+B2       FIND LAST ENTRY IN KEY TABLE 
          SB2    B2+2 
          NZ     X5,OPLOOPK  JP IF NOT LAST 
          SA3    A5+B1       GET NBR OF CHARS INCLUDING ALL KEYS
 OPSETMN  BSS    0
          FETCH  A0,MNR,X5
          IX5    X3-X5       NEW MNR - STATED MNR 
          PL     X5,OPON1    DO NOT CHANGE IF STATED ONE SMALLER
          STORE  A0,MNR=X3   SET TO NEW MNR 
 OPON1    BSS    0
 OPNOPR   BSS    0
          STORE  A0,COBO=YES  SET COBOL OPENED FLAG 
 OPNSRAK  BSS    0
          SA4    =XLOF$RM    GET LIST OF FILES POINTER
          SX4    X4 
          NG     X4,OPNNOF   JP IF NO LIST OF FILES 
          FETCH  A0,LFN,X1   GET FILE NAME
          SA5    X4          GET NBR OF WORDS IN LOF
          SB5    X5-1        COUNT OF WORDS IN BLOCK - 1
 OPNSLF   BSS    0           SEARCH LIST OF FILES FOR EQUAL NAME
          MX7    42 
          ZR     B5,OPNNOF   JP IF DONE WITH LIST 
          SA5    A5+B1       GET NEXT ENTRY 
          SB5    B5-B1
          ZR     X5,OPNNOF   JP IF DONE 
          BX6    X7*X5       MASK OUT EXTRA STUFF 
          IX3    X1-X6
          ZR     X3,OPNDPF   JP IF DUPLICATE FOUND
          EQ     OPNSLF      TRY AGAIN
 OPNNOF   BSS    0
          SA1    C.AMFLG
          ZR     X1,C.OPRTN  JP IF NOT AN AAM FILE
          MX6    0
          SA6    A1          CLEAR AAM FLAG 
          SB4    X1 
          JP     B4          GO TO AAM OPEN PRE-OPEN PROCESS
*                            IT WILL RETURN TO C.OPRTN
          ENTRY  C.OPRTN
 C.OPRTN  BSS    0           RETURN HERE FROM AAM OPEN EXTRA PROCESS
 CDCS     IFNE   OP.DCS,OP.NO 
          FETCH  A0,DBFO,X5 
          ZR     X5,OPCALL   JUMP IF I/O NOT VIA CDCS 
          RJ     =XC.DMOPN   -OPEN- VIA CDCS
          EQ     C.NORRT
 CDCS     ENDIF 
 OPCALL   BSS    0
          FETCH  A0,DPFF,X5  GET DUPLICATE FILE FLAG
          NG     X5,C.NORRT  JP IF DUPL - NO OPEN SINCE ACC DISP HAS
          OPENM  A0          OPEN FILE
          SA1    TAPEXT      TAPE EXTEND FLAG 
          ZR     X1,C.NORRT  GO HOME IF NOT SPECIAL CASE
*IF WE GET HERE, THIS IS OPEN EXTEND ON A TAPE FILE 
          SX6    B0 
          SA6    TAPEXT      CLEAR FLAG FOR TAPE EXTEND 
          STORE  A0,DX=DONE 
 LOUP     SKIPFF A0 
          EQ     LOUP 
 DONE     BSSZ   1
          STORE  A0,DX=0
          STORE  A0,LX=0
          CLOSEM A0,N 
          OPENM  A0,OUTPUT,N
          EQ     C.NORRT
 OPNDPF   BSS    0           DUPLICATE FOUND IN RA+2 LIST 
          SX5    X5 
          SX6    A0 
          IX6    X6-X5       JUMP IF THE FILE FOUND IS THE
          ZR     X6,OPNNOF   SAME FILE WE ARE OPENING 
*      A FILE HAS A MATCH IN THE LIST OF FILES - SEE IF IT IS THE 
*      FILE FOR ACCEPT OR DISPLAY AND IF SO RETURN THE COBOL GENNED ONE 
          SA2    A5          GET LIST OF FILES WORD 
          FETCH  X2,FTS,X3,3 GET FIT SIZE 
          SX3    X3-#MNF# 
          NG     X3,OPNSLF   JP IF NOT MINIMUM SIZE - PROBABLY CRM CONNE
          FETCH  X2,LNG,X3,3 GET LANGUAGE 
          SX3    X3-#CBL# 
          NZ     X3,OPNDPER  JP TO ERROR IF NOT A COBOL FIT 
          FETCH  A0,FO,X3,3 
          NZ     X3,OPNDPER  JP IF NOT A SEQUENTIAL FILE
          FETCH  X2,DSPC,X3,3,6  GET DISPLAY OR ACCEPT CREATED FLAG 
          PL     X3,OPNDPER  JP TO ERROR IF NOT SO
          FETCH  X2,ADDFA,X3,3     GET DUP FILE ASGD FLAG 
          NG     X3,OPNDPER  JP IF IT IS - ALREADY ONE DUPL 
          FETCH  A0,PD,X4,3  GET PROCESSING DIRECTION FROM OPEN FILE
          FETCH  X2,PD,X3,3  GET IT FROM ACCEPT-DISPLAY FILE
          IX5    X3-X4
          ZR     X5,OPPDOK   JP IF PDS ARE THE SAME 
          SX5    X3-#IO#
          ZR     X5,OPPDOK   JP IF ACC OR DISP OPENED IO
          SX1    #COMOPW
          RJ     C.FIOER     CANT PROCESS IF PDS DIFFER - BOMB JOB
 OPPDOK   BSS    0
          STORE  A0,DPFF=YES,3     SET DUPLICATE FILE FLAG
          STORE  A0,DPFP=X2,3  SET POINTER TO DUPLICATE FILE
          STORE  X2,ADDFA=YES,3    SET DUPLICATE ASGD IN ACC DISP FIT 
          EQ     OPNSLF      GO SEE IF THERE IS ANOTHER OPEN ONE
 OPNDPER  BSS    0           ERROR - DUPLICATE OPENED 
          FETCH  X2,OC,X3,3  GET OPEN - CLOSE FLAG
          SX3    X3-#OPE# 
          NZ     X3,OPNSLF   JP IF OTHER FILE NOT OPEN - CHK MORE 
          SX1    #COMDPF     OUTPUT ERROR 
          MX2    0
          MX7    0
          RJ     C.IOERR
          EQ     OPNNOF      EXIT IF RETURN REQUESTED 
  
  
          ENTRY  C.IFNE 
 C.IFNE   BSS    0
*      FILE HAS BEEN OPENED AS A NEW FILE BUT DOES NOT EXIST
 OPNTOP   BSS    0
 CDCS     IFNE   OP.DCS,OP.NO 
          FETCH  A0,DBFO,X5 
          NZ     X5,OPASGD   JUMP IF CDCS I/O FILE
 CDCS     ENDIF 
          SX1    #COMFNE     MESSAGE
          RJ     C.FIOER     OUTPUT ERROR AND BOMB JOB
          EQ     OPASGD      COMTINUE IF C.IOENA CALLED 
          ENTRY  C.AMFLG
 C.AMFLG  DATA   0           SET TO ADDR OF AAM OPEN ROUTINE IF AAM FILE
          TITLE  C.SEEK - PERFORM A SEEK
          EJECT  C.SEEK 
* 
**        C.SEEK - PERFORM SEEK 
* 
*         CALLING SEQUENCE - CALLED FROM IN LINE VIA ENTER WITH FILE. 
* 
*         DOES - CALLS CRM SEEK TO DO A SEEK. 
* 
          ENTRY  C.SEEK 
 C.SEEK   DATA   0
          SA2    C.SEEK      PICK UP RETURN 
          SA0    X1          SET TO FIT ADDRESS 
          LX2    30 
          SB6    X2          RETURN ADDRESS 
          RJ     C.SVRTN     SAVE RTN FOR DIAGS, ETC. 
          SEEK   A0          DO SEEK
          RJ     C.GETRT     GET RETURN 
          JP     B6          RETURN (NO FILE STATUS UPDATE) 
          TITLE  C.SETFS - SETS FILE STATUS ITEM TO PROPER CODE 
 C.SETFS  EJECT 
**        C.SETFS - SETS FILE STATUS ITEM TO PROPER CODE
* 
*         CALLING SEQUENCE
*                SX1  2RNN   NN IS TNE DESIRED RETURN 
*                RJ   C.SETFS 
* 
*         GIVEN  - CODE IN X1, FIT IN A0
*                POINTERS TO FILE STATUS WORD IN COBOL FIT
* 
*         DOES   - SETS FILE STATUS 
* 
*         USES   - A5, A6, X1, X5, X6, X7, B2 
* 
          ENTRY  C.SETFS
 C.SETFS  DATA   0
          FETCH  A0,FSWD,X6  GET WORD 
          FETCH  A0,FSSC,X5  GET SHIFT COUNT
          ZR     X6,C.SETFS  JUMP IF NO FILE-STATUS GIVEN 
          SB2    X5 
          LX1    B2,X1
          MX7    48 
          LX7    B2,X7
          SA5    X6 
          SX6    B2-54
          ZR     X6,SETF2WD  JUMP IF IT CROSSES WORDS 
          BX5    X7*X5
          BX7    X5+X1
          SA7    A5          STORE FILE STATUS
          EQ     C.SETFSX    EXIT 
 SETF2WD  BSS    0           TWO WORDS
          MX7    54 
          BX6    -X7*X1 
          BX7    X7*X5
          BX7    X7+X6       PUT IN FIRST CHARACTER 
          SA7    A5 
          SA5    A5+B1       GET NEXT WORD
          MX7    6
          BX1    X7*X1       ISOLATE SECOND CHAR
          BX7    -X7*X5 
          BX7    X7+X1       PUT IN SECOND CHAR 
          SA7    A5 
 C.SETFSX BSS    0
          STORE  A0,FSSET=NO CLEAR FILE STATUS ALREADY SET FLAG 
          EQ     C.SETFS
          TITLE  C.SFEQ - SET FILE EQUIVALENCE
 C.SFEQ   EJECT 
**        C.SFEQ - SET FILE EQUIVALENCE 
* 
*         CALLING SEQUENCE
*                RJ   =XC.SFEQ
* 
*         GIVEN 
*                FIT IN A0
* 
*         DOES
*                SETS LFN TO THE EQUIVALENT NAME IF SPECIFIED 
*                CALLS C.SVRTN TO SAVE THE RETURN 
*                DOES NOT DO EQUIV IF COBOL OPENED FILE PREVIOUSLY
* 
*         USES   ALL A EXCEPT A0 AND ALL X REGISTERS
* 
          ENTRY  C.SFEQ 
 C.SFEQ   DATA   0
          RJ     C.SVRTN     SAVE RETURN
          MX7    0
          SA7    C.MRLFC
          FETCH  A0,COBO,X5 
          NG     X5,C.SFEQ   EXIT IF COBOL OPENED IT BEFORE 
 CDCS     IFNE   OP.DCS,OP.NO 
          FETCH  A0,DBFO,X5 
          NZ     X5,SFEQDB   JP IF A CDCS FILE
 CDCS     ENDIF 
          SX6    B2          SAVE B REGISTERS 
          SX7    B3 
          MX5    42 
          BX6    -X5*X6 
          LX6    36 
          BX7    -X5*X7 
          LX7    18 
          SX4    B4 
          IX6    X6+X7
          BX4    -X5*X4 
          IX6    X6+X4
          SA6    =XC.BUFF+2 
          SX7    B5 
          BX7    -X5*X7 
          SX4    B6 
          BX4    -X5*X4 
          LX7    36 
          LX4    18 
          IX6    X4+X7
          SX7    B7 
          BX7    -X5*X7 
          IX6    X6+X7
          SA6    A6+B1
          SB6    EXTAREA     SIZE OF FIT
          SB5    =XC.BUFF    ADDR TO PUT LOCN 
          SB7    B0 
          RJ     =XC.GETBK   ALLOCATE SPACE FOR TEMP FIT
          SA4    =XC.BUFF    GET ADDR 
          FETCH  A0,MRL,X6   GET MAX REC LENGTH 
          SA6    A4+B1       SAVE FOR LATER CHECK 
          SB6    EXTAREA-1
 SFEQM1   SA5    A0+B6       MOVE REAL FIT TO TEMP ONE
          BX6    X5 
          SA6    X4+B6
          SB6    B6-B1
          PL     B6,SFEQM1
          STORE  X4,BT=C     USE TO PREVENT 154 DIAGNOSTICS 
          SETFIT X4          SET UP TEMPORARY FIT - GETS FILE CARD STUFF
          RJ     C.A0B1      RESTORE A0 AND B1
          SA1    =XC.BUFF    ADDR OF TEMP FIT 
          SA2    A1+B1       GET ORIGINAL MRL 
          FETCH  X1,MRL,X6
          IX7    X2-X6
          ZR     X7,SFEQNC   JP IF MRL NOT CHANGED BY FILE CARD 
          SA6    C.MRLFC     SAVE NEW MRL IN CASE CHANGED BY FILE CARD
 SFEQNC   BSS    0
          SA2    X1          GET FILE NAME
          STORE  A0,LFN=X2   PUT EQUIVALENCED ONE (IF ANY) INTO REAL ONE
          SB7    =XC.BUFF 
          RJ     =XC.FREBK   RETURN TEMPORARY FIT 
          SA1    =XC.BUFF+2  RESTORE B REGS 
          SA2    A1+B1
          SB4    X1 
          AX1    18 
          SB3    X1 
          AX1    18 
          SB2    X1 
          SB7    X2 
          AX2    18 
          SB6    X2 
          AX2    18 
          SB5    X2 
 CDCS     IFNE   OP.DCS,OP.NO 
 SFEQDB   BSS    0
 CDCS     ENDIF 
          SA4    =XC.FITNM   GET LIST OF EQUIVALENCED NAMES 
          ZR     X4,C.SFEQ   EXIT IF NONE 
          FETCH  A0,LFN,X5   GEF FILE NAME
          SA4    X4          GET FIRST EQUIV NAME 
 SFEQL    BSS    0
          ZR     X4,C.SFEQ   EXIT IF NO MORE NAMES
          IX6    X4-X5
          ZR     X6,SFEQ1    JP IF NAMES SAME 
          SA4    A4+2        GET NEXT NAME
          EQ     SFEQL
 SFEQ1    BSS    0
          SA4    A4+B1       GET EQUIVALENCED NAME
          STORE  A0,LFN=X4
          EQ     C.SFEQ 
          ENTRY  C.MRLFC
 C.MRLFC  DATA   0           MRL SET BY FILE CARD 
          TITLE  C.SVRTN - SAVE RETURN AND A0 IN STACK
 C.SVRTN  EJECT 
**        C.SVRTN - SAVES RETURN IN STACK 
* 
*         CALLING SEQUENCE
*                A0 HAS FIT ADDR
*                X4 IS NEG OR POSITIVE
*                B6 HAS RETURN ADDRESS
*                RJ  C.SVRTN
* 
*         GIVEN  - AS ABOVE PLUS STACK POINTER
* 
*         DOES   - PUTS A0, B6 AND BIT 59 OF X4 IN STACK
*                BUMPS STACK POINTER
*                CHECKS FOR STACK OVERFLOW
*                RETURNS
*                  X7 HAS STACK ENTRY 
*                  A7 HAS ADDRESS OF ENTRY
* 
*         USES   - A4, A7, X4, X5, X7 
* 
          ENTRY  C.SVRTN
 C.SVRTN  DATA   0
          MX7    1
          BX7    X7*X4       GET SIGN BIT OF X4 
          SA4    IOSTACK
          SX5    B6 
          BX5    X7+X5       SET BIT IN X5
          SX7    X4+B1       BUMP PTR 
          SA7    A4          STORE IT AWAY
          SX7    X7-IOSTKEN 
          PL     X7,SVRTSOF  JUMP IF OVERFLOW 
          SX7    A0          FIT
          LX7    30 
          BX7    X5+X7       COMPLETE ENTRY 
          SA7    X4          STORE IT 
          EQ     C.SVRTN
 SVRTSOF  BSS    0           STACK OVERFLOW - FATAL ERROR - IS MALFUNCT.
          SX1    #COMSTO
          EQ     STACKERR    MESSAGE TO DAYFILE AND ABORT 
* 
*      THIS IS THE I-O STACK
* 
*         WORD 0 IS THE POINTER TO THE NEXT AVAILABLE ENTRY 
* 
*         AN ENTRY CONSISTS OF
*                BIT 59 - BIT 59 OF X4 ON ENTRY TO C.SVRTN
*                BITS 48-58 UNUSED - CAN BE USED BY OTHER ROUTINES
*                BITS 30-47 - ADDRESS OF FIT FROM A0
*                BITS 18-29 UNUSED - SEE ABOVE
*                BITS 00-17 - ADDRESS OF RETURN 
* 
          ENTRY  C.IOSTK
 IOSTACK  VFD    42/0,18/*+1
          BSSZ   20 
 IOSTKEN  BSS    0
 C.IOSTK  EQU    IOSTACK
          TITLE  C.USE - USE DECLARATIVE PROCESSOR
 C.USE    EJECT 
**        C.USE  - USE DECLARATIVE EXECUTER - USE FOR EXEPTION
* 
*                CALLING SEQUENCE 
*                RJ C.USE 
* 
*         GIVEN  - USE PTR IN FIT 
*                USE TABLE POINTER IN C.USETB 
* 
*         DOES   - CALLS USE DECLARATIVE (AFTER SAVING CURRENT RTN AND
*                      FIT).
*                RESTORES A0 AND STACK
*                RETURNS TO CALLER
* 
*         USES   ALL REGISTERS EXCEPT A0 CHANGED
* 
          ENTRY  C.USE
 C.USE    DATA   0
          SA4    =XC.USETB   GET ADDR OF USE ROUTINES JUMP VECTOR 
          FETCH  A0,USEX,X5 
          ZR     X5,C.USE    EXIT IF NO DECLARATIVES
          SA2    C.USE
          IX4    X4+X5
          SA4    X4-1        GET TABLE ENTRY (DECL NBR BIASED BY 1) 
          BX6    X4 
          AX2    30 
          SA6    C.USERJ     STORE RJ IN CORRECT PLACE
          SB4    =YC.OVL
          NG     B4,NOSEG1   JP IF NOT A SEGMENTED PROGRAM
          SA1    B4          GET CURRENT OVERLAY NUMBER 
          BX7    X1 
          SA7    SAVEOV      SAVE IT
 NOSEG1   BSS    0
          SB6    X2          RETURN 
          RJ     C.SVRTN     SAVE ENTRY + A0 FOR REENTRANCE - CLEAR STK 
 C.USERJ  DATA   0
 C.USEX   BSS    0           EXIT 
          SA1    SAVEOV 
          ZR     X1,C.USEXX  EXIT IF NOT SEGMENTED
          MX6    0
          SA6    A1 
          SA2    =YC.OVL     GET CURRENT OVERLAY
          IX2    X2-X1
          ZR     X2,C.USEXX  EXIT IF STILL THE SAME ONE 
          LX1    11 
          SX7    C.USEXX
          SA7    =YC.DCFLG   SET FLAG IN C$SEG FOR RETURN 
          EQ     =YC.SEG     GO LOAD ORIGINAL OVERLAY BACK IN 
 C.USEXX  BSS    0
          RJ     C.GETRT     GET RETURN 
          JP     B6          RETURN 
 SAVEOV   DATA   0
 TAPEXT   DATA   0           FLAG OPEN EXTEND ON TAPE FILE
          END 
