*DECK C$SQOC
          IDENT  C$SQOC 
          TITLE  C$SQOC - SEQUENTIAL OPEN, CLOSE
  
          MACHINE  ANY,I
          COMMENT  SEQUENTIAL OPEN, CLOSE 
          SST 
          B1=1
          SPACE  4
**        CBSQOC -  SEQUENTIAL OPEN, CLOSE
* 
*         CALLING SEQUENCE
*            ALL ENTRY POINTS 
*                SB6  RETURN ADDRESS
*                SA0   ADDR OF FIT
*                EQ    C.XXXSQ  WHERE XXX IS TYPE OF OPERATION
* 
*                XXX = OP - OPEN
*                SB3  #R# OR #N# FOR REWIND OR NO 
*                SB5  ADDR OF OPEN PROCESS IN CBCOMIO 
* 
*                XXX = CLO  -  CLOSE
*                SB3  #N#  IF NO REWIND 
*                SB3  #R#  IF REWIND
*                SB3  #LOCK# FOR LOCK 
* 
*         DOES - ROUTES I-O REQUESTS TO CRM 
*         USES   - ALL REGISTERS EXCEPT A0 CHANGED
* 
  
  
*CALL IOMICROS
  
*CALL IODEFSC 
          ENTRY  C.OPSQ 
 C.OPSQ   BSS    0           OPEN 
          RJ     =XC.SFEQ    SET FILE EQUIVALENCE AND SAVE PTRS 
          SB2    #REVD# 
          STORE  A0,ORFL=B0,4  CLEAR OPEN REVERSED FLAGS
          NE     B2,B3,INITOC      JUMP IF NOT OPEN REVERSE 
          SB3    #N#         SET TO NO REWIND 
          STORE  A0,ORVF=YES,4  SET FLAGS FOR REVERSED
          STORE  A0,ORFT=YES,4  SET FLAGS FOR REVERSED
          STORE  A0,SPR=YES  SUPPRESS READ AHEAD
 INITOC   BSS    0
          SB2    #N#
          NE     B2,B3,OPNTRW JP IF NOT OPENED WITH NO REWIND 
          FETCH  A0,MFN,X4,4  GET MULTI-FILE NAME 
          NZ     X4,OPNTRW   JP IF A MULTI-FILE TAPE - MUST DO LABEL PR 
          STORE  A0,ULP=NO,4  CLEAR LABEL PROCESSING - CRM DOES NOT LIKE
          STORE  A0,LX=0,4
 OPNTRW   BSS    0
          RJ     C.TSTSF     TEST SYSTEM FILES
          STORE  A0,LIFW=YES SET LINAGE FIRST WRITE 
          FETCH  A0,LFN,X2
          FETCH  A0,MFN,X3
          ZR     X3,OPNTMF   JP IF NOT A MULTI-FILE 
          BX2    X3          USE MULTI FILE SET NAME
          SB3    #R#
 OPNTMF   BSS    0
          RJ     =XC.FINFO   DO FILINFO REQUEST 
          SB2    =XC.OPOUT   SET FOR LATER TEST 
          ZR     X2,OPNOEV   JP IF NO FILE EXISTS 
          LX2    59-15       MASS STORAGE BIT 
          PL     X2,OPNOEV   JP IF NOT MASS STORAGE - ASSUME ASSIGNED 
          SA2    =XC.FINRT+3  GET WORD WITH NBR OF PRUS IN FILE 
          AX2    36          NUMBER OF PRUS 
          ZR     X2,OPNOEV   JP IF ASGD BUT NOTHING THERE 
          NE     B2,B5,OPNOEV      JP IF NOT OPENED OUTPUT
          SB2    #R#
          NE     B2,B3,OPNOEV      JP IF NOT OPENED WITH REWIND 
*      AN OUTPUT FILE IS ON MASS STORAGE AND HAS DATA ON IT - EVICT IT
          SA5    A0 
          MX7    42 
          SX4    B1+B1
          BX7    X7+X4       INCLUDE BINARY FILE BIT
          BX7    X7*X5       MASK OFF MISC STATUS BITS
          SX5    B1 
          BX7    X5+X7       SET COMPLETE BIT 
          SA7    A5 
          FETCH  A0,FWB,X4
          BX7    X4 
          SA7    =SSAVEFWB
          SX4    *           DUMMY BUFFER ADDRESS 
          STORE  A0,FWB=X4   SET BUFFER POINTERS TO DUMMY TO PREVENT
*                            BUFFER ARGUMENT ERRORS ON THE EVICT
          BX6    X4 
          SA6    A0+2        IN 
          SA6    A6+B1       OUT
          SX6    X6+64
          SA6    A6+B1       LIMIT
          EVICT  A0,RCL      RETURN THE FILE
          SA4    =SSAVEFWB
          STORE  A0,FWB=X4
 OPNOEV   BSS    0
          FETCH  A0,COBO,X5  GET COBOL OPENED FLAG
          NG     X5,OPTSTEF  JP IF OPENED BY COBOL BEFORE 
 CDCS1    IFEQ   OP.DCS,OP.DCS1 
          FETCH  A0,DBFO,X5  GET DATABASE FILE ORDINAL
          NZ     X5,OPEX     JP IF A CDCS FILE
 CDCS1    ENDIF 
          FETCH  A0,BT,X2    GET BLOCK TYPE 
          SA3    =XC.FINRT+1 GET FILINFO WORD WITH TAPE BITS
          LX3    60-18
          MX5    60-3 
          BX3    -X5*X3      TAPE BITS - 18 TO 20 
          ZR     X3,OPNTSQT  JP IF NOT ON TAPE
          SA3    =XC.FINRT+5  GET S OR L TAPE INFO
          LX3    60-6 
          MX5    60-6 
          BX3    -X5*X3 
          SX3    X3-3 
          ZR     X3,OPISTP   JP IF S TAPE 
          SX3    X3-1 
          NZ     X3,OPSCPTP  JP IF NOT L TPAE 
 OPISTP   BSS    0           HERE IF DEVICE IS TAPE 
*      DEVICE ASSIGNED IS TAPE
*      DEVICE ASSIGNED IS S OR L TAPE 
          SX3    X2-#CT#
          NZ     X3,OPSETFT  JP IF NOT C TYPE BLOCKS
          STORE  A0,BT=E     SET BLOCK TYPE TO E - C NOT OK ON S TAPES
          EQ     OPSETFT
*      DEVICE ASSIGNED IS NOT TAPE (PROBABLY MASS STORAGE)
 OPNTSQT  BSS    0           HERE IF NOT TAPE 
          FETCH  A0,MFN,X5   GET MULTI-FILE NAME
          ZR     X5,OPNTMF2  JP IF NOT A MULTI-FILE 
          SX1    #OPNMF      ERROR MESSAGE
          RJ     =XC.FIOER   FATAL ERROR - MULTI-FILE MUST BE A TAPE
 OPNTMF2  BSS    0
          STORE  A0,LT=UL    SET LABELS TO UNLAB
          STORE  A0,ULP=NO   NO LABEL PROCESSING ON MS
*      DEVICE ASSIGNED IS SCOPE DEVICE (MASS STORAGE OR SCOPE TAPE )
 OPSCPTP  BSS    0           SCOPE TAPE 
          FETCH  A0,BT,X5    GET BLOCK TYPE 
          SX4    X5-#KT#
          ZR     X4,OPSTCB   JUMP IF K BLOCKS 
          SX4    X5-#ET#
          NZ     X4,OPSETFT  JP IF NOT E BLOCKS 
 OPSTCB   BSS    0
          STORE  A0,BT=C     SET BLOCK TYPE TO C
          STORE  A0,RB=0     SET RB TO ZERO FOR C BLOCKS
 OPSETFT  BSS    0
          FETCH  A0,BFS,X6   GET BUFFER SIZE
          SA6    =SOPSVBFS   SAVE IT
          STORE  A0,BFS=377777B    SET TO IMPOSSIBLE VALUE
          FETCH  A0,MBL,X6   MAX BLOCK LENGTH 
          SA6    =SOPSVMBL   SAVE IT
          SX7    B3 
          SX5    B5 
          LX5    30 
          BX6    X7+X5
          SA6    =SOPSVB35   SAVE B3 AND B5 
 CDCS     IFNE   OP.DCS,OP.NO 
          FETCH  A0,DBFO,X5 
          ZR     X5,OPNSDC1  JUMP IF NOT CDCS FILE
          STORE  A0,EX==XC.EXDMO  SET ERROR EXIT FOR CDCS 
          EQ     OPNSDC2
 OPNSDC1  BSS    0
 CDCS     ENDIF 
          STORE  A0,EX==XC.EX SET ERROR EXIT
 CDCS     IFNE   OP.DCS,OP.NO 
 OPNSDC2  BSS    0
 CDCS     ENDIF 
          SETFIT A0          GO HAVE CRM SET VALUES FROM FILE CARD, ETC 
          FETCH  A0,CF,X5    GET CLOSE FLAG 
          ZR     X5,OPNCFC   JP IF NOT CHANGED (GENERATED AS ZERO)
          STORE  A0,CFST=YES SET AS CHANGED VIA FILE CARD 
 OPNCFC   BSS    0
          SA1    OPSVB35
          SB3    X1          RESTORE B3 AND B5
          AX1    30 
          SB5    X1 
          FETCH  A0,BFS,X3
          SX3    X3-377777B 
          NZ     X3,OPSFCSB  JP IF FILE CARD SET BFS
          SA2    OPSVBFS
          STORE  A0,BFS=X2   RESTORE BUFFER SIZE
 OPSFCSB  BSS    0
          FETCH  A0,MBL,X5
          SA2    OPSVMBL
          IX5    X2-X5
          ZR     X5,OPNFMBL  JP IF FILE CARD DID NOT CHANGE MBL 
          STORE  A0,BCTC=YES INDICATE THAT FILE CARD DID CHANGE 
          EQ     OPTSTEF
 OPNFMBL  STORE  A0,MBL=X2   RESTORE MBL TO BEFORE SETFIT 
 OPTSTEF  BSS    0
          SB2    =XC.OPOUT
          EQ     B2,B5,OPASGD      NO MISSING FILE CHECK IF OPEN OUTPUT 
          SA5    =XC.FINRT+1  GET FILINFO WORD WITH MS BITS 
          NZ     X5,OPASGD   JP IF FILE ASSIGNED
          FETCH  A0,CNF,X5   GET CONNECT FLAG 
          NG     X5,OPASGD   ASSUME ASSIGNED IF CONNECTED 
          SB2    =XC.OPIN 
          EQ     B2,B5,OPINP JP IF OPENING FOR INPUT
          SB2    =XC.OPEXT
          NE     B2,B5,OPNTEXT     JP IF NOT OPEN EXTEND
          SB5    =XC.OPOUT   CHANGE TO OPEN FOR OUTPUT
          EQ     OPASGD 
 OPNTEXT  BSS    0
          FETCH  A0,USOM,X2  GET USE FOR I-O DECL NBR 
 OPIFNE   BSS    0
          FETCH  A0,USFN,X5  GET USE ... FILE NAME FLAG 
          ZR     X5,OPIFN1   JP IF USFN NOT SET 
          BX2    X5          ERROR DECL NBR FROM USFN 
 OPIFN1   BSS    0
          STORE  A0,USEX=X2  SET ERROR DECL NBR 
          EQ     =XC.IFNE    JP TO I/O FILE NOT EXIST ERROR PROC
 OPINP    BSS    0
          SA2    C.SYSF+#INPT#-1   GET NAME INPUT 
          FETCH  A0,LFN,X5   GET FILE NAME
          IX2    X2-X5
          ZR     X2,OPASGD   IGNORE IF INPUT - ALWAYS OK
          FETCH  A0,OPFL,X5 
          NG     X5,OPTN     JP IF OPTINAL
          FETCH  A0,USOI,X2  GET USE FOR INPUT FLAG 
          EQ     OPIFNE 
 OPTN     BSS    0
          STORE  A0,FNEX=YES SET OPTINAL FILE NOT EXISTING
 OPASGD   BSS    0
          FETCH  A0,COBO,X5  GET COBOL OPENED FLAG
          NG     X5,OPEX     JP IF OPENED BY COBOL BEFORE 
          SX6    64          PRU SIZE FOR MOST
          SA6    =SOPPRUS    SAVE 
          FETCH  A0,DVT,X5   GET DEVICE TYPE
          LX5    48          SHIFT OVER TAPE BIT
          PL     X5,OPNTTP   JP IF NOT A TAPE 
*      DEVICE ASSIGNED IS TAPE
          FETCH  A0,CDST,X4 
          ZR     X4,SQOP2          IF CODE-SET = 0 JUMP 
          SX6    X4-CS.STND1
          ZR     X6,SQOP1          IF STANDARD-1 JUMP 
          SX6    X4-CS.ASCII
          ZR     X6,SQOP1          IF ASCII JUMP
          SX6    X4-CS.EBCDC
          ZR     X6,SQOP1          IF EBCDIC JUMP 
          EQ     SQOP2             JUMP TO NORMAL SQ OPEN 
 SQOP1    SX4    B0                FOR TAPE FILE
          STORE  A0,CDST=X4        TURN CODE-SET OFF
          FETCH  A0,MRL,X4
          AX4    1                 MRL = MRL / 2
          STORE  A0,MRL=X4
 SQOP2    BSS    0
          FETCH  A0,SOL,X3   GET S OR L TAPE FLAG 
          PL     X3,OPSCPT2  JP IF SCOPE TAPE 
*      DEVICE ASSIGNED IS S OR L TAPE 
          FETCH  A0,BFS,X2   GET BUFFER SIZE FROM FIT 
          NZ     X2,OPNBFS   JP IF ALREADY SPECIFIED
* 
*      BUFFER SIZE CALCULATION FOR S OR L TAPES 
* 
          FETCH  A0,MBL,X2   MAX BLOCK LENGTH 
          SX3    9
          IX2    X2+X3       FOR ROUND
          SA4    =XC.TNTH    1/10*2**24 
          IX2    X2*X4
          AX2    24          BLOCK SIZE IN WORDS
          EQ     OPCBFS      GO COMPUTE BUFFER SIZE 
 OPSCPT2  BSS    0
*      DEVICE ASSIGNED IS SCOPE TAPE
          FETCH  A0,CM,X5    GET MODE 
          SX6    128         PRU SIZE FOR CODED SCOPE TAPE
          NG     X5,OPSCTCD  JUMP IF CODED
          SX6    512         PRU SIZE FOR BINARY SCOPE TAPE 
 OPSCTCD  BSS    0
          SA6    OPPRUS      SET PRU SIZE 
 OPNTTP   BSS    0
*      DEVICE ASSIGNED IS A SCOPE DEVICE
          FETCH  A0,RT,X3    GET RECORD TYPE
          SX5    X3-#WT#
          NZ     X5,OPSMBL0  JP IF NOT W RECORDS
          FETCH  A0,BT,X5    BLOCK TYPE 
          SX5    X5-#IT#
          ZR     X5,OPISEO   JP IF BLOCK TYPE IS I - DONT CHANGE MBL
          FETCH  A0,EO,X5    GET ERROR OPTION 
          NZ     X5,OPISEO   JP IF ERROR OP - MBL MAY BE SET FOR ERROR
 OPSMBL0  BSS    0
          STORE  A0,MBL=0    SET MAX BLOCK TO 0 
 OPISEO   BSS    0
          FETCH  A0,BFS,X2   GET BUFFER SIZE FROM FIT 
          NZ     X2,OPNBFS   JP IF ALREADY SPECIFIED
* 
*      BUFFER SIZE CALCULATION FOR DEVICES OTHER THAN S OR L TAPES
* 
          SA4    OPPRUS      GET PRU SIZE 
          FETCH  A0,RLWD,X5  REC LENGTH IN WORDS
          SX3    -B1
          IX2    X4-X3       PRU SIZE + 1 
          IX5    X5+X2       ROUNDS 
 OPCPRUS  BSS    0           CALC NBR PRUS NEEDED FOR BIGGEST RECORD
          IX5    X5-X4       BACK  OFF A PRU
          SX3    X3+B1       MAINTAIN COUNT OF PRUS 
          PL     X5,OPCPRUS  JUMP IF ANOTHER FITS 
          IX2    X3*X4       NBR PRUS * PRU SIZE GIVES BLK SIZE IN WDS
          SX1    10 
          IX3    X2*X1       BLOCK SIZE IN CHARACTERS 
          FETCH  A0,BCTC,X5  GET FLAG FOR BLOCK CONTAINS OR FILE CARD 
          PL     X5,OPNBCT   JP IF NOT SET EITHER PLACE 
          FETCH  A0,MBL,X5   GET ORIG MAX BLOCK LENGTH
          IX6    X5-X3
          NG     X6,OPNBCT   JP IF SMALLER THAN PRU SIZE
          SA4    =XC.TNTH    1/10*2**24 
          IX2    X5*X4       MBL*TENTH
          BX3    X5 
          AX2    24          BLOCK SIZE IN WORDS
 OPNBCT   BSS    0
 OPCBFS   BSS    0           COMPUTE BUFFER SIZE
          FETCH  A0,REAR,X4  GET RESERVE AREA NUMBER
          IX6    X4*X2       NBR AREAS * BLOCK SIZE GIVES BUFFER SIZE 
          BX5    X6          COPY TO X5 
          AX5    6           DIVIDE BY 100B 
          NZ     X5,OPCBFS1  JIF BFS\100B 
          SX6    100B        SET BFS TO MIN FOR ANY TYPE OF FILE
 OPCBFS1  SX4    X6+2        PLUS TWO WORDS FOR CIO 
          STORE  A0,BFS=X4
 OPNBFS   BSS    0
 OPEX     BSS    0
          STORE  A0,DSPO=NO  SET NOT OPENED BY ACC/DISPLAY
          RJ     =XC.GETRT   RESET FOR RETURN 
          JP     B5          GO TO APPROPIATE ROUTINE 
          SPACE  2
          ENTRY  C.CLOSQ
 C.CLOSQ  BSS    0           CLOSE
          RJ     =XC.SVRTN   SAVE RETURN
          RJ     C.TSTSF     CHECK FOR SYSTEM FILE
          FETCH  A0,OC,X5 
          SX5    X5-#OPE# 
          NZ     X5,CLNTTR   JP IF NOT OPEN - CLOSE WILL DIAGNOSE IT
 CDCS1    IFEQ   OP.DCS,OP.DCS1 
          FETCH  A0,DBFO,X5 
          NZ     X5,CLNTTR   JP IF CDCS FILE - NO SPECIAL PROCESS 
 CDCS1    ENDIF 
          FETCH  A0,PD,X5 
          SX5    X5-#OUTPUT#
          NZ     X5,CLOSE2   JUMP IF NOT OPENED FOR OUTPUT
          FETCH  A0,LT,X5 
          SX5    X5-#UL#
          NZ     X5,CLOSE2   JUMP IF NOT UNLABELED
          SX5    B3-#N# 
          NZ     X5,CLOSE2   JUMP IF NOT CLOSE WITH NO REWIND 
          FETCH  A0,CNF,X5   GET CONNECT FLAG 
          NG     X5,CLOSE3   DO NOT WRITE EOF IF CONNECTED FILE 
          ENDFILE  A0,SQ     WRITE AN EOF ON THE FILE - CRM WILL NOT
          EQ     CLOSE3 
 CLOSE2   BSS    0
          SB2    #R#
          NE     B2,B3,CLNR  JUMP IF NOT CLOSE WITH REWIND
          REWINDM  A0        REWIND THE FILE (CLOSE WITH DET WONT)
 CLOSE3   BSS    0
          SB3    #DET#       SET CLOSE FLAG TO DETACH FILE
 CLNR     BSS    0
          FETCH  A0,LFN,X5   GET FILE NAME
          SA4    C.SYSF+#TERM#-1
          IX4    X4-X5
          NZ     X4,CLNTTR   JP IF NOT THE FILE TERMINAL
          SB3    #RET#       RETURN TERMINAL
 CLNTTR   BSS    0
          RJ     =XC.GETRT   GET RETURN 
          EQ     =XC.CLOSE   GO TO COMMON CLOSE ROUTINE 
*      TEST FOR SYSTEM FILES
*         SETS B3 TO #N# (NO REWIND) IF IS IS A SYS FILE
*         OTHERWISE, DOES NOT CHANGE B3 
*         ALSO X3 = 0 IF SYS FILE, NZ OTHERWISE 
* 
*         CHANGES A2, A3, B7, X2, X3
          ENTRY  C.TSTSF
 C.TSTSF  DATA   0
          SB7    LASTF-C.SYSF 
          FETCH  A0,LFN,X2,2,3     GET FILE NAME
          SA3    C.SYSF 
 TSTFLP   BSS    0
          IX3    X2-X3
          ZR     X3,TSSFEX   EXIT IF IT IS A SYS FILE 
          SB7    B7-B1
          SA3    A3+B1
          NZ     B7,TSTFLP
          MX3    1           RETURN NON ZERO FOR NON SYS FILE 
          EQ     C.TSTSF
 TSSFEX   BSS    0
          SB3    #N#         SET RETURN 
          EQ     C.TSTSF     EXIT 
          ENTRY  C.GTDF 
*         C.GTDF GETDS DUPLICATE FILE FIT POINTER - IF ANY
*         RETURNS POINTER IN X0 
*         CHANGES A5,X0,X5,X7 
 C.GTDF   DATA   0
          FETCH  A0,DPFP,X0  GET DUPL FILE POINTER
          NZ     X0,C.GTDF   JP IF THERE IS ONE 
          SX0    A0          OTHERWISE, SET IT TO THE CURRENT FILE
          EQ     C.GTDF 
* 
          ENTRY  C.SYSF 
          ENTRY  C.INPUT
 C.SYSF   BSS    0           LIST OF SYSTEM FILE NAMES
          DATA   0LOUTPUT    SYSTEM OUTPUT FILE 
 C.INPUT  DATA   0LINPUT     SYSTEM INPUT FILE
          DATA   0LPUNCH     SYSTEM HOLLERITH PUNCH FILE
          DATA   0LPUNCHB    SYSTEM BINARY PUNCH FILE 
          DATA   0LCONSOLE   SYSTEM CONSOLE DEVICE
          DATA   0LTERMINL   SPECIAL COBOL TERMINAL (CONNECTED) FILE
 LASTF    BSS    0
          END 
