         DEF      SUPCLS
SUPCLS   EQU      %
*                 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      JCO2VPA
         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      Y05
         REF      Y1,Y2,Y4
         REF      LDEVCNT,DBMAX,COPPGS
         REF      DBPOOL
         REF      X1FFFF
         REF      T:RBUF
         SPACE    10
ASAVBIT  EQU      Y1
LASTBIT  EQU      Y2
DELBIT   EQU      Y4
         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,R1    J:USCDX           COOP TABLE THERE
         BEZ      CCLOSXIT          NO-NOTHING TO DO
         LI,R1    SV:LSIZ
CCLOSE0  CI,R1    1                 'C1'
         BE       CCLOSE1           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 PULL     R1                RETURN FROM COP05(CLOSE 1 STREAM)
*
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,R1    0                 FOR C1 STRM DATA BUFFER PROTECTION
         LW,R3    J:USCDX
         MTW,0    LDEVCNT,R3        IF C1 IN USE,LDEVCNT=1
         BEZ      RELCPG
         LW,R1    1,R3              CNTXT BLK FOR C1
         LW,R1    SCFBUF,R1
         STW,R1   R2
         LB,R1    R1                NOW HAVE THE SPARE BUFFER INDEX
         AND,R2   X1FFFF            PROTECT C1 AND
         CI,R2    JCO2VPA           KEEP C1'S BUDDY BUFFER
         BNE      %+1               BUDDY BUFFER HAS THE OPPOSITE
         OR,R1    X20
RELCPG   EQU      %
         LI,R2    1
RELCPG1  EQU      %
         AI,R3    DBPOOL            PT TO FREE DATA BUFFER POOL
         LB,D3    *R3,R2
         BEZ      CCLOSXIT          THIS I THE END
         LI,R5    0
         STB,R5   *R3,R2            SLOTS HAVE TO BE CLEARED
         CW,D3    R1
         BE       C1SBUD            BOUND C1'S BUDDY
         AI,R3    -DBPOOL           PT BACK TO CB0
         CW,D3    X20
         BANZ     RELCPG2           IT IS ONLY THE UPPER HALF
         PUSH     3,R1
         BAL,R2   T:RBUF            TO RELEASE VP,PP & SWAPGRN(5=0)
         PULL     3,R1
         MTW,-1   COPPGS,R3         DECRMNT COOP PAGE COUNT
RELCPG2  MTW,-1   DBMAX,R3          DECRMNT COOP BUFF ALLOCATED
         AI,R2    1
         B        RELCPG1
C1SBUD   LI,R5    1
         STB,D3   *R3,R5            HAS TO PUT IN 1ST SLOT
         AI,R2    1
         B        RELCPG1+1
CCLOSXIT EQU      %
         PULL     SR4
         DESTRUCT                   EXIT CCLOSE
*
*
CCLOSE2A LW,D2    LASTBIT
         STS,D2   SCDEVTYP,R3
*
*        SETUP FOR COP05 (CLOSE INDIVIDUAL STREAM)
*
CCLOSE2  LI,D3    0
         LW,D4    ASAVBIT
         STS,D3   SCDEVTYP,R3       CLEAR ASAVBIT
         LW,SR3   R3
         LI,SR4   CCLOSE1A          COP05 EXIT ADDR
         PUSH     R1                SAVE CURRENT STREAM INDEX
*
*        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
         BEZ      COP09             NO FILE TO CLOSE
*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
         CW,SR4   Y0008             IS THIS THE OCP
         BANZ     CLSOCP            YEP
COP05A   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'
         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
*
         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
         MTW,0    SCDEVTYP,R3
         BLZ      ADDOF1            OUTPUT
         LW,D2    DELBIT            NON-CONTROL INPUT...
         STS,D2   SCDEVTYP,R3       DELETE REST OF STREAM
         LW,D2    SCCDA,R3          STARTING WITH CUR DA
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,R2    SCGCO,R3
         AI,R2    1
         SLS,R2   -1
         LW,R4    SCDEVTYP,R3
         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    SCFPC,R3          OR FPC
         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
         LW,R0    SCFPC,R3          * R0=FOVLY
         BAL,R4   SGCQ2
         B        SGC:NCB           NO BUFFERS
RELBUF   EQU      %
         LI,D3    0
         STW,D3   SCBESTDA,R3       ZERO 1ST DISC ADDR
         LW,D3    SCFBUF,R3
         BEZ      %+2
         BAL,SR4  RCBUFF            RELEASE TO FREE POOL IN CB0
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
         LI,R5    LDEVCNT
         MTW,-1   *J:USCDX,R5       DECR. NO STREAMS IN USE
*
*        FINISHED CLOSING THIS STREAM
*
COP04    PULL     7,R5
         B        *11
         PAGE
*RELEASE THE FREED DATA BUFFER TO THE FREE DATA BUFFER POOL
*  MAINTAINED IN CB0 AS DBPOOL
*        BAL,SR4  RCBUFF
*        INPUT : (D3)=SPARE BUFFER INDX,ADD OF WNDW#2/PLUS 256
*  REG. 3 NON-VOLATILE
*
RCBUFF   EQU      %
         LB,SR1   D3                GET SPARE BUFFER INDEX
         AND,D3   X1FFFF            GET ADDRESS
         CI,D3    JCO2VPA           IS IT LOWER HALF
         BE       %+2
         OR,SR1   X20               FLIP TO UPPER HALF
         LW,R5    J:USCDX
         AI,R5    DBPOOL
         LI,R2    1
RCBUFF1  LB,R0    *R5,R2
         BEZ      RCBUFF2           FREE SLOT FOUND
         AI,R2    1
         CI,R2    SV:LSIZ
         BLE      RCBUFF1
         SCREECH  X'2D',4           NO FREE SLOT TO PUT FREED BUFFERR
RCBUFF2  STB,SR1  *R5,R2            INTO FREE POOL
         B        *SR4
         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
         END

