*DECK C$CLOSF 
          IDENT  C$CLOSF
          TITLE  C$CLOSF - STOP RUN FILE CLOSING ROUTINE
  
          MACHINE  ANY,I
          COMMENT  STOP RUN FILE CLOSING ROUTINE
          SST 
          SPACE  4
**
*         STOP RUN FILE CLOSING 
* 
*         CALLING SEQUENCE -
*         RJ     C.CLOSF
* 
*         CLOSES COBOL FILES WHICH ARE STILL OPEN 
* 
*         USES ALL REGISTERS
* 
**
*CALL IODEFSC 
*CALL IOMICROS
  
 CLOSFEX  BSS    0           EXIT 
          MX7    0
          SA7    C.CLSFF     CLEAR FWA AND LWA CHECK WORD 
          ENTRY  C.CLOSF
 C.CLOSF  BSSZ   1
          SA1    C.CLOSF
          AX1    30 
          SA1    X1-1        GET LINE NUMBER
          BX6    X1 
          SA6    CLOSFQ      SAVE FOR DIAGS 
          SA2    =XLOF$RM    GET LIST OF FILES POINTER
          SX2    X2 
          NG     X2,CLOSFEX  JP IF NO LIST
          SA2    X2          GET HEADER 
          LX2    30 
          SX3    A2+B1       POINT TO FIRST FILE ITEM 
          IX6    X2+X3       MAKE POINTER WORD
          SA6    CLOSFNB     SAVE IT
 CLOSFLP  BSS    0           CLOSE FILES WHICH ARE STILL OPEN 
          SA2    CLOSFNB
          SX6    X2+B1       BUMP FILE POINTER
          SA3    X2          GET ITEM FROM LIST OF FILES
          AX2    30 
          SX2    X2-1 
          ZR     X2,CLOSFEX  JP IF LIST EMPTY 
          LX2    30 
          IX6    X6+X2       NEW LENGTH PLUS NEW ADDR 
          SA6    A2 
          ZR     X3,CLOSFEX  JP IF DONE 
          MX4    12 
          BX5    X4*X3
          LX5    12 
          SX5    X5-7777B 
          ZR     X5,CLOSFLP  IGNORE IF FILE MARKED NOT PRESENT
          SA5    65B         GET CMM FL POINTER WORD
          MX7    42 
          BX7    X7*X3
          SA7    =XC.MSINS   SAVE FILE NAME IN CASE OF MESSAGE
          BX5    -X5
          SA4    X5          FL NOW IN X4 
          SX4    X4-#MNF# 
          SX5    X3          ADDR OF FIT
          IX6    X5-X4
          SA1    C.CLSFF     FWA-LWA CHECK FLAG FROM C.CNCL 
          PL     X6,CLOSFC1  JP IF NOT W/IN FIELD LENGTH
          FETCH  X3,LFN,X5,,4      GET FILE NAME FROM FIT 
          IX7    X7-X5
          NZ     X7,CLOSFC1  JP IF LFNS NOT SAME - FIT CLOBBERED
          FETCH  X3,FTS,X5   FETCH FET/FIT LENGTH FIELD 
          SX6    X5-#MNF#    SUBTRACT MINIMUM 
          NG     X6,CLOSFLP  JUMP, ASSUME THIS IS NOT A FIT 
          FETCH  X3,LNG,X5   GET COMPILE LANGUAGE CODE
          SX6    X5-#CBL#    TEST FOR COBOL FIT 
          NZ     X6,CLOSFLP  JUMP, IF NOT A COBOL-DESCRIBED FILE
          FETCH  X3,OC,X5    GET OPEN/CLOSE FLAG
          SX5    X5-#OPE# 
          NZ     X5,CLOSFLP  JUMP IF NOT OPEN 
          FETCH  X3,COBO,X5  GET COBOL OPENED FLAG
          PL     X5,CLOSFLP  JUMP IF COBOL DID NOT OPEN IT
 CDCS     IFNE   OP.DCS,OP.NO 
          FETCH  X3,DBFO,X5 
          NZ     X5,CLOSFLP  JUMP IF A CDCS I/O FILE
 CDCS     ENDIF 
          ZR     X1,CLOSF0   JP IF NOT A CHECK
          SX5    X1          CALL FROM C.CNCL - FWA OF CAPSULE
          AX1    18 
          SX3    X3 
          IX5    X3-X5
          NG     X5,CLOSFLP  JP IF FIT ADDR < FWA OF CAPSULE
          IX1    X1-X3
          NG     X1,CLOSFLP  JP IF FIT ADDR > LWA OF CAPSULE
 CLOSF0   BSS    0
          FETCH  X3,FO,X5    GET FILE ORGANIZATION
          AX6    B1,X5       AAM BIT
          ZR     X6,CLOSF2   JP IF NOT AAM FILE 
          SB4    =YC.CLOSE   NORMAL CLOSE IN C$COMIO
 CLOSF1   BSS    0
          NG     B4,CLOSFCC  CLOSE ROUTINE NOT LOADED - CANT CLOSE
          SA0    X3          FIT ADDR 
          FETCH  X3,DSPO,X5  GET ACCEPT OR DISPLAY OPENED FLAG
          NG     X5,CLOSFNM  JP IF OPENED BY THEM 
          SX1    #CLOSF2     MSG NBR
          MX2    1           INSERT FILE NAME (ALREADY IN C.MSINS 
          MX3    1           NO LINE NUMBER 
          MX6    0           NO ABORT 
          SX7    B4 
          SA7    =SSVB4      SAVE OPEN ADDRESS
          RJ     =XC.MSG     OUTPUT MSG SAYING CLOSING AUTOMATICALLY
          SA1    SVB4 
          SB4    X1          RESTORE CLOSE ADDRESS
 CLOSFNM  BSS    0
          SB3    #R#         CLOSE WITH REWIND
          SB6    CLOSRTN     RETURN 
          JP     B4          GO TO CLOSE
 CLOSFQ   DATA   0           GO CLOSE FILE
 CLOSRTN  BSS    0           MUST FOLLOW CLOSFQ FOR ERROR TRACEBACK 
          EQ     CLOSFLP
 CLOSF2   BSS    0
          SX6    X5-#SQ#
          NZ     X6,CLOSFWA  JP IF NOT SEQUENTIAL - MUST BE WA
          SB4    =YC.CLOSQ   SEQUENTIAL CLOSE ROUTINE 
          EQ     CLOSF1 
 CLOSFWA  BSS    0
          FETCH  X3,RLFG,X5  GET RELATIVE FILE FLAG 
          PL     X5,CLOSFNR  JP IF NOT RELATIVE 
          SB4    =YC.CLORL   RELATIVE CLOSE ROUTINE 
          EQ     CLOSF1 
 CLOSFNR  BSS    0
          SB4    =YC.CLOWA   WORD ADDRESS CLOSE ROUTINE 
          EQ     CLOSF1 
 CLOSFC1  NZ     X1,CLOSFLP  JP IF C.CNCL CALL - IGNORE ERROR 
 CLOSFCC  BSS    0           CANNOT CLOSE FOR SOME REASON OR ANOTHER
          SX1    #CLOSF1     MSG NBR
          MX2    1           INSERT FILE NAME (ALREADY IN C.MSINS 
          MX3    1           NO LINE NUMBER 
          MX6    0           NO ABORT 
          RJ     =XC.MSG     OUTPUT MESSAGE STATING CANT CLOSE
          EQ     CLOSFLP
 CLOSFNB  VFD    42/0,18/=XC.GETBK  FORCE LOAD FOR OLD BINARIES 
          ENTRY  C.CLSFF
 C.CLSFF  DATA   0           FLAG FOR C.CNCL CALL OR STOP RUN CALL
          END 
