*
*
*M*      SUPCLS    SUPER-CLOSE CAL1,9 6 AND M:LDEV COOP STREAM CLOSER
*
*P*      NAME:     SUPCLS    (ALSO KNOWN AS CCLOSE OR COPNR)
*,*
*,*      PURPOSE:            THE SUPER-CLOSE MODULE IS THE CONTAINER
*,*           FOR THE ROUTINES WHICH, UPON USER REQUEST OR LOGOFF,
*,*           DISPOSE OF COOPERATIVE STREAMS.  THE CONTROL STREAM(C1)
*,*           IS DELETED ONLY UPON USER LOGOFF.  NON-CONTROL INPUT STREAMS
*,*           ARE DELETED AND OUTPUT STREAMS ARE DISPATCHED TO RBBAT BY
*,*           EITHER AN LDEV CAL OR A SUPERCLOSE.
*,*           MAJOR ROUTINES ARE:
*,*
*,*                CCLOSE    SUPER-CLOSE CAL PROCESSOR
*,*
*,*                COP05     ROUTINE CLOSES A SINGLE LOGICAL STREAM
*,*
*,*                CLSOCP    WRITE XEROX 1200 ANS TRAILER LABELS
*,*
*,*                ADDOF     PASSES OUTPUT FILES TO RBBAT
*,*                          (ALSO PASSES NCTL INPUT FOR DELETION)
*,*
*,*                RCBUFF    RELEASE COOP-DATA-BUFFER TO FREE-POOL.
*,*
*,*           MODULE IS ENTERED MAPPED FROM OPNLD OR ALTCP AND RESIDES
*,*           IN THE MONITOR OVERLAY WITH OPNLD.
*,*
*K*      SUPER-CLOSE         A 'CAL1,9 6'. THIS CAL CAUSES CLOSURE OF ALL
*,*           COOPERATIVE OUTPUT STREAMS AND DELETION OF ALL COOPERATIVE
*,*           INPUT STREAMS EXCEPT C1-THE CONTROL STREAM.
*,*
*K*      NON-CONTROL,NCTL    1) THE FILE, AN INPUT SYMBIONT FILE,
*,*           NOT A BATCH JOB, TO BE READ RATHER THAN RUN.  2) THE
*,*           STREAM, ANY STREAM OTHER THAN C1(THE CONTROL STREAM OR
*,*           BATCH JOB),  WHEN OPENED INPUT.
*,*
         DEF      SUPCLS:           PATCHING DEF
SUPCLS:  RES
*                 CATALOG NO. 704933 - SIGMA 5/7 BPM M:COPNRES
MONPROC  SET      1                 WANT SYSTEM MON SYMBS
         SYSTEM   UTS
         DEF      CCLOSE
CCLOSE   EQU      %
         DEF      COP05
         PAGE
*                 SYMBOLIC REGISTER DEFINITIONS.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
         REF      COPGSB
*
         REF      IOSPIN
*
         REF      COP08A
         REF      COP20B
         REF      AOFNB             * ADD OUTPUT FILE NON-BATCH
         REF      AOFL              * ADD OUTPUT FILE-LAST ONE FROM SUPCLS
         REF      PRT               JIT PRIORITY WORD DISP
         REF      AOF               ADD OUT FILE
         REF      Y00FF             =X'00FF0000'
         REF      SGC:NCB           SYM GHO COM NO COMM BUF
         REF      SYSID             JIT: SYSTEM IDENT DISPL
         REF      SGCQ              * SYM GHO CALL Q
         REF      SGCQ2             * SYM GHO CALL Q W/ 2 ENTRIES
         REF      BL:OFS            * BAT LIM: OUT FIL SLOTS
         REF      XFF
         REF      Y002
         REF      SV:LSIZ
         REF      J:USCDX
         REF      J:JIT
         REF      SCBESTDA
         REF      SCDEVTYP
         REF      SCFBUF
         REF      SCCDA
         REF      SCDBI
         REF      SCGCO
         REF      SCMISC
         REF      SCFPC
         REF      SCFORM
         REF      SCRPDA
         REF      SCSVDGI
         REF      COP%RSG
         REF      Y0008
         REF      COPGSG
         REF      ALLOREG
         REF      COOPHDR           * WRITE TRAILING BANNER TO LP.
         REF      Y1,Y2,Y4
         REF      YFF               * MASK
         REF      NB31TO0           * MASKS
         REF      T:RBUF
         REF      SCCOMID           CNTXT DISP TO COMODE ID
         REF      SCCOMFLG          CNTXT DISP TO COMODE FLAGS
         REF      SH:COMID          SEED FOR COMODE ID'S
         REF      UH:FLG2           X'80' BIT SET BY  'OUTPUT GO' KEYIN
         REF      OUTPUTGO          EQU'ED TO X'80'
         REF      INHIB             FLAG IN SCCOMFLG INHIBITING BANNER
         REF      S:CUN             CURRENT USER NUMBER
         REF      Y008              MASK
         SPACE    10
ASAVBIT  EQU      Y1
LASTBIT  EQU      Y2
DELBIT   EQU      Y4
LASTCHNK EQU      X'8000'
         PAGE
*
*CLOSE COOP OUTPUT FILES ROUTINE
* AND DELETE REMAINING NON-CONTROL INPUT FILES
*ENTERED VIA CAL TRAP FROM CCI
*(R5)=JIT ADDR
         PUSH     SR4               SAVE SUPER CLOSE EXIT
         LW,R0    J:USCDX           COOP TABLE THERE?
         BEZ      CCLOSXIT          NO-NOTHING TO DO
         LI,R1    SV:LSIZ
CCLOSE0  CI,R1    1                 'C1'
         BE       CCLOSE1B          YES: DON'T CLOSE
         LW,R3    *J:USCDX,R1
         CW,R3    Y2
         BAZ      CCLOSE1           NO CNTXT BLK FOR THIS STRM
         LW,D3    SCBESTDA,R3
         BEZ      CCLOSE2           NO FILE, BUT GO REL. CNTXT BLK
*
*        HAVE A STREAM TO CLOSE; SEE IF THERE WILL BE ANOTHER..
*
         LW,R4    R1
NXTSTR   BDR,R4   %+2
         B        CCLOSE2A          NOPE-SET LASTBIT IN CUR. CNTXT BLK
         CI,R4    1
         BE       NXTSTR            DON'T COUNT C1
         LW,R2    *J:USCDX,R4
         CW,R2    Y2
         BAZ      NXTSTR            NO CNTXT BLK FOR THIS STRM
         LW,D3    SCBESTDA,R2
         BEZ      NXTSTR            NO FILE FOR THIS CNTXT BLK
         B        CCLOSE2           FOUND ANOTHER STREAM WITH A FILE
*
*
CCLOSE1A EQU      %                 RETURN FROM COP05 (CLOSE 1 STREAM)
         PULL     2,R0
CCLOSE1B CI,R1    1                 LAST STREAM...
         BNE      CCLOSE1           --->NO.
         CI,R0    0                 ANY CLOSED YET...
         BE       CCLOSE1           --->YES.
         LC       J:JIT             IS IT BATCH...
         BCS,12   CCLOSE1           --->NO.
         AI,R1    1                   BATCH NEEDS A LAST STREAM,
         LW,R3    *J:USCDX,R1         SO SEND RBBAT A FAKE ONE.
         AND,R3   NB31TO0+30          (NOT-OPEN STREAM)
         B        CCLOSE2A          --->GO SEND FAKE STREAM TO RBBAT.
*
CCLOSE1  BDR,R1   CCLOSE0
*RELEASE SPARE BUFFERS OBTAINED
* ONES OBTAINED FOR WNDW #1 AND FOR C1 (CONTROL INPUT)STRM
*  HAVE TO BE RETAINED
*   NO ASSMTN AS TO IF C1 IS ALWAYS OPENED FIRST
*    C1'S BUDDY BUFFER,IF THERE,IS STILL USABLE
*
         LI,R2    SV:LSIZ           R2 = # OF STREAM.
RELCPG   EQU      %
         CI,R2    1
         BLE      CCLOSXIT          ---> DON'T RELEASE C1'S BUFFER.
         LW,R3    *J:USCDX,R2       R3=>C.B.
         LI,D3    0
         XW,D3    SCFBUF,R3         D3= BUFFER FOR THIS STREAM.
         BEZ      RELCPG2           ---> NONE.
         LW,D4    YFF                 GOT BUFFER.
         LW,R4    R2                  NOW LOOK FOR
         AI,R4    -1                  MATCHING BUFX
RELCPG1  EQU      %                   IN ALL YET-TO-BE-PROCESSED
         LW,R3    *J:USCDX,R4         STREAMS' BUFFERS.
         CS,D3    SCFBUF,R3           IF MATCH, DON'T FREE PAGE;
         BE       RELCPG2             IT WILL BE FREED LATER OR
         BDR,R4   RELCPG1             IS C1'S PAGE.
         PUSH     R2                  NO MATCH:
         LI,R5    0                 R5=0 TO FREE VP, PP, & SWAPGRAN.
         SLS,D3   -24               D3= BUFFER INDEX #.
         BAL,R2   T:RBUF              FREE THE PAGE.
         PULL     R2
RELCPG2  EQU      %
         AI,R2    -1                  GO ON TO OTHER STREAMS.
         B        RELCPG
CCLOSXIT EQU      %
         PULL     SR4
         DESTRUCT                   EXIT CCLOSE
*
*
CCLOSE2A LW,D2    LASTBIT
         STS,D2   SCDEVTYP,R3
         LI,R0    0                 FLAG GOT-A-STREAM.
*
*        SETUP FOR COP05 (CLOSE INDIVIDUAL STREAM)
*
CCLOSE2  LI,D3    0
         LW,D4    ASAVBIT
         STS,D3   SCDEVTYP,R3       CLEAR ASAVBIT
         LI,D4    INHIB
         STS,D3   SCCOMFLG,R3       CLEAR INHIB FLAG
         LW,SR3   R3
         LI,SR4   CCLOSE1A          COP05 EXIT ADDR
         PUSH     2,R0              SAVE STREAMINDEX & CLOSEFLAG.
*
*        FALL THROUGH TO CLOSE THIS STREAM
*
         PAGE
* COP05 ROUTINE CLOSES  A SINGLE LOGICAL STREAM.
*        ENTER WITH (SR3) = CNTXT BLK ADDR
*                   (SR4) = RETURN
*                   R5-R11 NON-VOLATILE
*        DELETE STREAM IF DELBIT SET IN SCDEVTYP OF CNTXT BLK
*        SAVE CNTXT BLK IF ASAVBIT SET  '     '     '     '
*        SET GFC=AOFL IF LAST BIT SET  '    '       '     '
*
*
COP05    EQU      %
         PUSH     7,R5
         LW,R3    SR3
         LW,D1    SCBESTDA,R3
         BNEZ     CLSSTRM           --->GOT A FILE TO CLOSE.
         CW,SR3   Y2                NO FILE. IS IT FAKE AOFL STREAM?
         BANZ     COP09             --->NO. JUST CLEAN STREAM.
         B        ADDOF             --->YES. DO FAKE FILE ADD FIRST.
CLSSTRM  EQU      %
*WAIT FOR CURRENT I/O,IF ANY,FOR THE STREAM TO COMPLETE
         LCFI,2   0
         PSM,0    TSTACK
         LW,6     3                 FAKE FOR IOSPIN
         BAL,SR4  IOSPIN
         LCFI,2   0
         PLM,0    TSTACK
         LW,SR4   SCDEVTYP,R3
         BLZ      CLSFILE           OUTPUT-PACKAGE LAST BLOCK
         MTW,0    SCCDA,R3          INPUT:  IS PART OF FILE LEFT
         BEZ      RELBUF            NO
         B        ADDOF             YES: GO DELETE IT
CLSFILE  EQU      %
         BAL,SR4  COPGSB            HAVE TO MAP COOP WNDW #2
         LW,R1    SCFBUF,R3
         LW,SR4   SCDEVTYP,R3       GET DEV TYP BACK
OCP%IN%CPV   EQU     0              *OCP IS NOT NOW A PRODUCT
         DO       OCP%IN%CPV        * IFF OCP IS A PRODUCT
         CW,SR4   Y0008             IS THIS THE OCP
         BANZ     CLSOCP            YEP
         FIN
         LW,R7    SCCOMFLG,R3
         CI,R7    8                   DO WE NEED A TRAILING BANNER..
         BAZ      COP05A            --->NO.
         BAL,SR4  COOPHDR             YES.  DO IT.
         LW,SR4   SCDEVTYP,R3         RESTORE SCDEVTYP.
COP05A   EQU      %
         LI,R7    INHIB
         CW,R7    SCCOMFLG,R3       IS INHIB SET (I.E. NOT LAST CHUNK)
         BANZ     COP05B            YEP - DON'T DO ANYTHING
         LW,R7    SCCOMID,R3        IF LAST CHUNK, SET LASTCHUNK FLAG
         BEZ      COP05B            NOT A COMODE STREAM
         LI,R7    LASTCHNK
         STS,R7   SCCOMID,R3
COP05B   EQU      %
         LW,R2    SCDBI,R3          DATA BYTE INDEX
         LI,R0    X'40'             EOD BLK CONTROL CODE
         CW,SR4   Y002              PUNCH DEVICE
         BAZ      COP05D
*                                   REAL PUNCH FILE....
*                                   PUNCH BLANK
         LW,R7    R1
         SLS,R7   2
         AW,R7    R2
         LI,12    5
         LI,R6    BA(BLNKREC)
         REF      Y04               CNTXT HASP BIT
         CW,SR4   Y04
         BAZ      %+3
         LI,12    8
         LI,6     BA(HSPSH)
         STB,12   7
         MBS,6    0
         AW,2     12
COP05D   EQU      %
         AI,R2    2                 POINT TO RCC
         STB,R0   *R1,R2            TO DATA BUFFER
         LI,R0    0                 SET NEXT DISC BLK ADDR TO ZERO
         STW,R0   SCDBI,R3          SIGNAL CALL FROM COP05A
         LW,R6    R3                FAKE DCB ADDR IN R6 FOR IOSPIN
         LI,11    ADDOF             SPECIAL EXIT FROM COP08A
         PUSH     11                TAKEN IF SCDBI=0
         LI,11    COP08A            END ACTION(IN COOP)
         B        COP20B
*
*
BLNKREC  DATA     X'00010601'       BC,RCC,SKIP   16,8,8
         DATA     0
HSPSH    DATA     X'00040601'
         DATA     X'81C14000'
         DO       OCP%IN%CPV        *  IFF OCP IS A PRODUCT
         PAGE
*
* WRITE TRAILER LABLE FOR OCP
*
CLSOCP   BAL,SR4  COPGSG            GET A GRANUEL
         LW,R1    SCFBUF,R3         R1 BUFFER ADDRESS
         LI,R6    0
         XW,R6    SCDBI,R3          ZAP BTD
         LI,D1    X'40'
         AI,R6    2
         STB,D1   *R1,R6            SET END OOF BLOCK
         LW,R6    R3
         LI,SR4   CLSOCP1           END ACTIION
         PUSH     SR4
         LI,SR4   COP08A
         B        COP20B            WRITE CURRENT GRAN.
*
CLSOCP1  PUSH     16,R0             SAVE ALL
         LW,R7    R3
         LW,R3    SCFBUF,R3         BUFFER ADDRESS
         LI,R1    X'0601'
         STW,R1   1,R3              SET TAPE MARK
         LW,R1    RCCCNTL
         STW,R1   2,R3              RCC FOR EOF
         AI,R3    3                 BUMP
         SLS,R3   2                 BUFFER TO BYTE ADDRESS
         LI,R1    80
         LI,R2    BA(OCPEOF)
         STB,R1   R3
         MBS,R2   0                 MOVE EOF IN
         LI,D1    -1
         LI,D2    -1
         LW,D4    SCGCO,R7          GRANULE COUNT
         AI,D4    -1                MINUS HDR/VOL
CLSOCP2  LI,D3    0
         DW,D3    TEN               DIVIDE
         SLD,D1   -8
         STB,D3   D1                PACK REMAINDER
         CI,D4    0                 ANYTHING LEFT
         BNE      CLSOCP2           YES
         CI,D2    X'F0'
         BAZ      %+3
         SLD,D1   -8                RIGHT JUSTIFY
         B        %-3
         LW,R4    R3
         AI,R4    -80+54
         SLS,R4   -2
         AWM,D1   0,R4              PUT IT IN
         AWM,D2   1,R4
         SLS,R3   -2                BUFFER TO WORDS
         LI,R1    X'0601'
*
         B        CLSOCP3           ***DORMANT CODE FOR NOW
*RPLCD INST 'STW,R1 0,R3'           *1 T.M. BETWEEN EOF AND EOV
         LW,D1    RCCCNTL           * 1 MORE 80 BYTE ANS LBL
         STW,D1   1,R3              * ... COMES NEXT.
         AI,R3    +2                * ADVANCE TO LBL DATA AREA
         LW,R4    R3                * ...REMEM DATA BYTE DISP...
         SLS,R3   +2                * WRD DISP TO BY DISP
         LI,D1    80                * ANS LBLS ARE 80B LONG.
         LI,R2    BA(OCPEOF)        *(FORMAT IS SAME AS...)
         STB,D1   R3                *
         MBS,R2   0                 * ...EOF/TM/( EOF ) ---
         LW,D1    OCPEOV            * 'EOV1'
         STW,D1   0,R4              * ...EOF/TM/ EOV ...
         SLS,R3   -2                * B TO W (NAV DBI)
*
CLSOCP3  EQU      %                 *
         STW,R1   0,R3              DOUBLE EOFS
         STW,R1   1,R3
         AI,R3    2
         SW,R3    SCFBUF,R7         NUMBER OF WORDS USED
         SLS,R3   2                 BYTES
         STW,R3   SCDBI,R7          =NEW DATA BYTE INDEX
         PULL     16,R0             REGS BACK
         LW,R1    SCFBUF,R3         SET R1 BACK TO NORMAL
         B        COP05A            GO
*
RCCCNTL  DATA     X'00500601'
TEN      DATA     10
OCPEOV   DATA     'EOV1'            * CHG EOF1 TO EOV1 ON TRAILER
*
         FIN
         PAGE
*
*                 THIS IS A CLOSE OF AN OUTPUT FILE
*
*
*        DO AOFNB FOR ONLINE ADD
*
*        R3=   CNTXT BLK ADDR.
*
*        LB,D3    *R3               SYMTAB INDEX TO R3 AND                ###
*        XW,R3    D3                CONTEXT BLOCK ADDR TO D3.             ###
*        STW,0    SCDA,3            CLEAR CURRENT D.A. IN SYMTAB          ###
*        BAL,11   ADDF              ADD OUTPUT FILE TO DIRECTORY          ###
*                                   THIS ELININATES CATCH-UP MODE         ###
*                                   ADDF STARTS OUTPUT SYMB               ###
*        AOF - ADD OUTPUT FILE
*
         REF      SNDDXSIZ
ADDOF    EQU      %                 FETCH A Q SLOT -- LEAVE
         LI,D1    SNDDXSIZ          AT LEAST ONE PER SYMB
         DISABLE                    FOR AOFP -- IF NOT ENOUGH
         CW,D1    BL:OFS            REG FOR NSYMF - RBBAT
         BLE      ADDOF01           WILL WAKE UP WHEN SLOTS
         ENABLE                     COME FREE.
         LI,R4    ADDOF+1           SGC:NCB DECREMENTS
         B        SGC:NCB
*
ADDOF01  EQU      %
         MTW,-1   BL:OFS            TAKE THE SLOT
         ENABLE
*
         LW,D1    SCDEVTYP,R3
         AND,D1   XFF
         SLS,D1   8                 * D1=0,DEVTYP,0   16,8,8
         LW,R4    SCMISC,R3
         LW,D2    SCBESTDA,R3
         CW,R3    Y2                IS THIS FAKE AOFL FILE?
         BAZ      ADDOF1            --->YES.
         LW,D3    SCDEVTYP,R3       NO.  INPUT OR OUTPUT?
         BLZ      ADDOF08           --->OUTPUT.
         LW,R1    SCCOMFLG,R3       INPUT.
         CI,R1    X'40'             IS IT SPILL?
         BANZ     ADDOF1            --->YES.
         LW,D2    DELBIT            NO. IT'S NCTL INPUT.
         STS,D2   SCDEVTYP,R3         SO DELETE THE REST OF STREAM
         LW,D2    SCCDA,R3            STARTING AT CURRENT POSN.
         B        ADDOF1
ADDOF08  EQU      %                 OUTPUT.
         LW,R1    SCCOMFLG,R3
         CI,R1    X'20'             IS IT FILL?
         BAZ      ADDOF1            --->NO.
         CW,D3    ASAVBIT           YES. WASE SAVE SPECIFIED?
         BANZ     ADDOF1            --->YES.
         OR,D3    DELBIT              NO. DELETE IT.
         STW,D3   SCDEVTYP,R3
ADDOF1   STB,R4   D2                * D2=COPIES,SDA  8,24
         LW,D3    Y00FF
         AND,D3   SCSVDGI,R3        * RBID FROM CNTXT BLK
         OR,D3    J:JIT+SYSID       * SYSID FROM JIT
         LW,R4    Y00FF
         AND,R4   J:JIT+PRT         * EXTRACT JIT USER PRIORITY
         SLS,R4   -20               * REPOSITION
         STB,R4   D3                * PRI,RBID,SYSID  8,8,16
         LW,R1    S:CUN
         LH,R1    UH:FLG2,R1        GET USER FLAGS
         CI,R1    OUTPUTGO          OUTPUT GO,ID  KEYIN FOR THIS GUY?
         BAZ      NOGO              NOPE
         LI,R1    INHIB
         CW,R1    SCCOMFLG,R3       IS THIS THE LAST(OR ONLY) PIECE
         BAZ      NOGO              YEP: NO NEED TO GO CONCURRENT
         MTW,0    SCCOMID,R3        WAS HE ALREADY IN COMODE
         BNEZ     NOGO              YEP - EVERYTHN OK
         LH,R1    SH:COMID          PICK UP NEXT COMID
         STW,R1   SCCOMID,R3        AND GIVE IT TO THIS GUY
         MTH,1    SH:COMID          INCR TO NEXT ID
         BNOV     NOGO
         LI,R1    1                 RESET TO 1 IF OVERFLOW
         STH,R1   SH:COMID
NOGO     EQU      %
         LW,R2    SCGCO,R3
         AI,R2    1
         SLS,R2   -1
         LW,R4    SCDEVTYP,R3
         CW,R3    Y2                IS THIS FAKE AOFL STREAM?
         BANZ     %+2               --->NO.
         AND,R4   NB31TO0+31        YES. MAKE SURE DELBIT OFF.
         LC       J:JIT             1,1,30 ON-LINE,GHO,SYSID
         BCS,12   AOF1              NOT BATCH
         AI,D1    AOF
         CW,R4    DELBIT            DELETE THIS FILE
         BANZ     AOFDEL            YES
         CW,R4    LASTBIT           LAST BATCH STREAM
         BAZ      AOF2              NO
         AI,D1    AOFL-AOF
         B        AOF2
AOF1     AI,D1    AOFNB
         CW,R4    DELBIT            DELETE THIS FILE
         BAZ      %+4
AOFDEL   LI,R4    X'12'             YES; SET PRI=X'12' TO TELL GHO
         STB,R4   D3                COM BUF
         B        AOF1BUF
AOF2     LI,R1    X'FF00'
         AND,R1   SCMISC,R3         JDE
         OR,R1    SCFORM,R3         FORM
         OR,R1    SCCOMID,R3        OR COMODE USER
         BNEZ     AOF2BUF           YES: GHOST NEEDS 2 QUEUE ENTRIES
AOF1BUF  EQU      %
         BAL,R4   SGCQ                  : CALL GHOST VIA Q :
         B        SGC:NCB           * HANG FOR NOW
*                                     ONLY IF NO BUFFERS
         B        RELBUF
AOF2BUF  LI,R1    X'FF00'
         LS,R1    SCMISC,R3         JDE
         SLS,R1   8
         OR,D1    R1                * D1=0,JDE,DEVTYP,GFC 8,8,8,8
         LW,D4    SCFORM,R3         *D4=FORM
         LI,R0    0                 * R0 WAS FOVLY, BUT OCP IS NO MORE.
         LW,R1    SCCOMID,R3        *  R1 = COMODE ID
         BEZ      GOQ2
         STB,R1   D1                D1=COMID(2),JDE,DEVTYP,GFC
         SLS,R1   -8
         STB,R1   D2                D2=COMID(1),SDA  (COPIES > 1 NOGOOD)
         OR,D1    Y008              BIT 0 OF JDE = COMODE FLAG
GOQ2     EQU      %
         BAL,R4   SGCQ2
         B        SGC:NCB           NO BUFFERS
RELBUF   EQU      %
         LI,D3    0
         STW,D3   SCBESTDA,R3       ZERO 1ST DISC ADDR
RELGRAN  LW,SR1   SCRPDA,R3         DISC GRAN TO RELEASE
         BEZ      COP09             NO
         BAL,SR3  COP%RSG           YES: DO IT
         BNEZ     COP09             RELEASE SUCCESSFUL
         BAL,0    ALLOREG           FAILED; WAIT TIL ALLYCAT READY
         B        RELGRAN           AND TRY AGAIN
*
COP09    LW,D3    ASAVBIT
         AND,D3   SCDEVTYP,R3
         BNEZ     COP04             ASAVE SET...SAVE CNTXT BLK
         LW,R3    0,R3
         AND,R3   XFF               SAVE LDEVX
         LI,SR3   0
         LW,SR4   Y2
         STS,SR3  *J:USCDX,R3       CNTXT BLK NO LONGER IN USE
*
*        FINISHED CLOSING THIS STREAM
*
COP04    PULL     7,R5
         B        *11
         PAGE
         DO       OCP%IN%CPV        *  IFF OCP IS A PRODUCT
         DEF      OCPHDR            HEADER FOR LABEL                    BCI00007
         DEF      OCPVOL            VOLUME FOR LABEL                    BCI00008
         DEF      OCPEOF            EOF FOR LABEL                       BCI00009
         PAGE                                                           BCI00586
         SPACE    5                                                     BCI00587
OCPHDR   TEXT     'HDR1      CPV          CPV 00010001',;               BCI00588
                  '000100             000000     CPV  ',;               BCI00589
                  '          '                                          BCI00590
OCPVOL   TEXT     'VOL1   CPV                         ',;               BCI00591
                  '           CPV                     ',;               BCI00592
                  '         1'                                          BCI00593
*        * * * * * FOLLOWING EOV1: ANS VOL ENDING OPTION 1
*                 IS PROVISIONALY USED UNTILL OPT 3 FIXED, I.E.
*                 VOLUME IS ENDED BEFORE FILE* * * * *
OCPEOF   TEXT     'EOV1      CPV          CPV 00010001',;               BCI00594
                  '000100             000000     CPV  ',;               BCI00595
                  '          '                                          BCI00596
*                                                                       BCI00597
         FIN
         END

