*
*
*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
*,*
*,*                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
R11      EQU      11
R12      EQU      12
R8       EQU      8
*
         REF      AIFJE             FOR SPILL/FILL JCL
         REF      PRIOGFC            FOR FILL JCL PRIO CHANGE
         REF      SCFFORM           SPILL/FILL FLAGS
         REF      NXTSID             FILL JCL AND NCCTL
         REF      BL:IFS            WHEN ADDING JCL BACK
         DEF      SPFIP:            40 HEX WORDS IN OVERLAY
         REF      SNDDX             SPILL/FILL NCTL
         REF      STB:TYP           SPILL/FILL NCTL
         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      SCRCO             DISP TO RECORD COUNT   23178-F00
         REF      SCMISC
         REF      SCFPC
         REF      SCFORM
         REF      SCRPDA
         REF      SCSVDGI
         REF      RSG               *NOT COP%RSG           30284-F00
         REF      Y0008
         REF      COPGSG
*                 *REMOVED REF TO ALLOREG                  30284-F00
         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    SCCOMFLG,R3
         CI,D1    X'60'             SPILL-FILL CLOSING
         BANZ     COPSP             DIVERT FROM NORMAL
         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        ADDOFNF           --->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
         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'
         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
*
ADDOFNF  EQU      %                   (IF FAKE ADD, ENTER HERE).
         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,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.
         AND,D2   NB31TO0+1         MAKE ADDRESS EVEN      30284-F00
         B        ADDOF1
ADDOF08  EQU      %                 OUTPUT.
         MTW,0    SCRCO,R3          ANY RECORDS FOR OUTPUT 23178-F00
         BNEZ     ADDOF1             YES, DON'T DELETE     23178-F00
         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
         LW,D3    SCCOMFLG,R3       DO WE HAVE PRIORITY TO DO
         CI,D3    X'60'             SPILL FILL STUFF
         BAZ      RELBUF2            NOPE, NOTHING TRICKY
         LI,R4    SCSVDGI+SCSVDGI+SCSVDGI+SCSVDGI
         LB,D3    *R3,R4
         CI,D3    X'F0'
         BAZ      COPFIL5           YES, JUST A NICE TOUCH
RELBUF2  EQU      %
RELGRAN  LW,SR1   SCRPDA,R3         DISC GRAN TO RELEASE
         BEZ      COP09             NO
*C*
*********************************************************
*
         BLOCK                                             30284-F00
*
*********************************************************
*C*
*C*      MAKE SURE MASTER CPU DOES THE GRANULE RELASE
*C*
         BAL,SR4  RSG               RELEASE GRANULE        30284-F00
*
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
*C*
*C*      THE NEXT SECTION OF CODE IS FOR CLOSING
*C*       STREAMS USED BY SPILL FILL CALLERS
*C*        IT DETERMINES FROM THE CONTEXT BLOCK
*C*         WHAT IT'S SUPPOSED TO DO. IT IS
*C*      RESPONSIBLE FOR HANDING BACK INFO
*C*       IN USERS SR1 ABOUT THE CONCLUSION OF THE
*C*        OPERATION. THIS IS HEX CONTENTS OF
*C*         BL:IFS OR BL:OFS APPROPRIATE TO
*C*          REQUESTED OPERATION. IF NEW SYSID
*C*           IS ASSIGNED, IT IS ALSO PASSED BACK
*C*      THIS MODULE WORKS CLOSELY WITH RBBATM AND
*C*        OPNLD TO KEEP THE NUMBER OF SLOTS CORRECT
*C*          AND TO KEEP THE UNIQUNESS OF THE BATCH
*C*            ID'S INTACT.
*C*      SINCE MODULE OPNLD HAS DETERMINED THE SECURITY
*C*       CHECKS. PRIVILEDGE AND BL:IFS, BL:OFS AVAIL-
*C*        ABILITY, AND HAS THE INFO NEEDED TO GIVE
*C*         TO RBBAT SAFELY IN THE CONTEXT BLOCK FOR
*C*           THE STREAM, ALL THAT'S LEFT IS TO BUILD
*C*             THE RBBAT COMMUNICATION BUFFERS IF
*C*              REQUIRED.
*
         PAGE
COPSP    EQU      %
         CI,D1    X'40'             IS IT FILL
         BANZ     COPFIL            YES, NO  QUESTION FILL IT
COPSP01  CW,D1    ASAVBIT           NOW WHAT ELSE CAN HAPPEN
         BAZ      RELBUF             ALL DONE NOW GET OUT
         LW,D3    SCSVDGI,R3        PRIO,RBID,SYSID 8,8,16
         LB,R5    D3                SWITCHER BYTE
         CI,R5    X'F0'               SPILLING JCL
         BAZ      COPSP2               NO, GET INFILE
COPSP1   LI,R7    BL:OFS            NEED ONE OF THES NOW
         BAL,R6   GETSLOT            WAIT TIL ITS READY
         B        COPSP3               THEN RETURN OUTPUT
COPSP2   LI,R7    BL:IFS            IF JCL USE ONE OF THESE
         BAL,R6   GETSLOT
COPSP3   LW,D2    SCBESTDA,R3       FILE STARTING ADDRESS
         LW,D4    SCFORM,R3         ALWAYS NEED THIS WORD
         LB,R5    D3                NEED THIS AGAIN
         CI,R5    X'F0'              NOW IS IT JCL
         BAZ      COPSP4              YES, A BIT DIFFERENT
         LW,R2    SCFPC,R3          FLAGS,X,DEVTYP 8,16,8
         LB,R0    R2
         STB,R0   R0                FLAGS,0,FLAGS 8,16,8
         LW,R8    SCMISC,R3          NUMBER OF COPIES
         STB,R8   D2                COPIES,DA 8,24
         LI,D1    X'FF'
         AND,D1   R2                SET DEVICE
         SLS,D1   8
         AI,D1    AOFNB             AND RBBAT FUNCTION
         LW,R2    SCFFORM,R3        GET GRANULE COUNT
         SLS,R2   -16
         CI,R5    X'22'             IS IT NCCTL
         BE       COPSP5            DIFFERENT TYPE OF COM REQUEST
         CI,R5    X'21'             IS PRIORITY OK
         BGE      %+2                YES, LEAVE IT BE
         AI,R5    -X'11'            DROP IT OTHERWISE
         STB,R5   D3                PRIO,RBID,SYSID 8,8,16
COPSP3A  BAL,R6   DELCHK            IN CASE THIS IS ALL FOR NOUGHT
         B        GOQ2
COPSP4   LI,R8    X'80'             SET RBBAT FLAG
         STB,R8   D2                FLAG,DA 8,24
         LW,R8    SCCOMFLG,R3       WHICH FLAG TO SET
         CI,R8    X'40'             IF FILL SET 77XX
         BANZ     %+3                IF SPILL SET
         LI,R8    X'66'
         B        %+2
         LI,R8    X'77'
         STB,R8   D3                FOR OPERATOR FLAG
         LW,R2    SCSVDGI,R3        IN CASE I GET RBBAT TO LOOK
         LI,D1    AIFJE             SET REQUEST
         LI,R5    1
         STH,R2   D3,R5             PUT IN GOOD SYSID
         BAL,R6   DELCHK            IN CASE THIS IS FOR HOUGHT
         B        AOF1BUF           NOW TELL THE RBBAT
COPSP5   CW,D3    L(X'00FF0000')    CHECK FRO REMOTE
         BANZ     COPSP3A           AGAIN A BIT DIFFERENT
         LI,5     X'FF'
         AND,R5   SCFPC,R3          GET DEVICE TYPE
         LI,6     SNDDXSIZ
         CB,R5    STB:TYP,R6        SEARCH IT OUT
         BE       COPSP6            FOUND IT
         BDR,R6   %-2                UNTIL WE DO
         LI,R5    X'12'               THE USER TRIED TO
         STB,R5   D3                   I'M SURE I SHOULD HAVE
         B        AOF1BUF               HAVE FOUND IT
COPSP6   EQU      %
         LB,R5    SNDDX,R6
         LI,R7    3
         STB,R7   D1,7              SET RBBAT FUNCTION
         AI,7     -1
         STB,R5   D1,R7             STORE DCTX
         AI,R7    -1
         STB,R6   D1,R7             STUFF SYMBX
         LI,7     0
         STB,R7   D1                CLEAR IT
COPSP51  LI,R7    X'80'              END OF FILE BIT
         STB,R7   D2
         LW,R5    SCFFORM,R3        GET NUMBER OF GRANULES
         SLS,R5   -16               THAT RBBAT TOLD US IN A WAY
         AI,R5    1
         SLS,R5   -1                THAT RBBAT UNDERSTANDS
         STW,R5   R2
         LW,D3    SCSVDGI,R3        NEED THE REAL HONEST SYSID
         STH,D3   R2                FOR RBBAT
         LW,D3    SCFORM,R3         AND THE FORM NAME
         BAL,R6   DELCHK            IN CASE THIS IS FOR NAUGHT
         B        AOF1BUF            NOW TELL THE RBBAT
COPFIL   EQU      %
         PUSH     0,R0
         LW,6     3                 FAKE FOR IOSPIN
         BAL,SR4  IOSPIN            JUST IN CASE STILL WRITING
         PULL     0,R0
         LW,D3    SCSVDGI,R3        PRIO,RBID,SYSID 8,8,16
         LB,R5    D3                SWITCHER
         CI,R5    X'F0'             JCL
         BAZ      COPFIL4            YES, NEW SYSID
         CI,R5    X'22'
         BNE      COPSP1            SAME AS SPILL NOW
COPFIL4  BAL,R11  NXTSID            NEED A NEW ONE OF THESE
         LI,R4    SCSVDGI+SCSVDGI+1
         STH,R12  *R3,R4            STUFF IN CONTEXT BLOCK
         LI,R4    -30+1              USERS SR1
         STH,R12  *TSTACK,R4          IN TSTACK
         CI,R5    X'22'             IS IT NCCTL
         BE       COPSP1             SAME AS SPILL NOW
         B        COPSP2              ALSO FOR JCL NOW.
GETSLOT  LI,R5    SGC:NCB           IF WE HAVE TO WAIT
         LI,R4    GETSLOT+1          SGC:NCB DECREMENTS
         LI,R8    SNDDXSIZ
         DISABLE
         CW,R8    *R7               CHECK IT
         BLE      %+3                 OK CAN USE IT
         ENABLE
         B        *R5               GO WAIT A BIT
         MTW,-1   *R7                TAKE IT
         LW,R8    *R7                 GET NEW VALUE
         ENABLE
         LI,R7    -30
         STH,R8   *TSTACK,R7        TELL USER
         B        *R6                THEN ADD IT TO RBBAT
COPFIL5  EQU      %
         LW,D2    SCSVDGI,R3        GET SYSID THIS GUY
         LI,D1    X'FF'
         AND,D1   SCFPC,R3          GET DEVICE TYPE
         STB,D1   D2                TYPE,RBID,SYSID 8,8,16
         LW,D3    SCSVDGI,R3
         SLS,D3   -24               NEW PRIORITY
         LI,D1    PRIOGFC
         BAL,R4   SGCQ              FIX IT UP FOR JCL
         B        SGC:NCB            IN CASE WE WAIT
         B        RELBUF2           AND GO AWAY
DELCHK   LI,5     SCFFORM+SCFFORM+SCFFORM+SCFFORM
         LB,R4    *R3,R5            MODE CHANGE ON US
         CI,R4    X'50'             FROM SAVE TO DELETE
         BNE      *R6                NOPE, NOTHING NEW
         LI,R4    X'12'             CHANGEE TO DELETE PRIO
         STB,R4   D3                 THAT WE ADD TO RBBAT
         LI,R4    X'40'               RESOLVE AMBIGUITY
         STB,R4   *R3,R5               IN CONTEXT BLOCK NOW
         B        *R6                    AND BYE BYE FILE
         BOUND    8
SPFIP:   EQU      %                 JUST IN CASE
         DO1      X'10'             SINCE THERE IS ROOM HERE
         DATA     0                 ANYWAY.
         END

