MONPROC  SET      1
         SYSTEM   UTS
         PCC      0
         SPACE    2
         DEF      GERM
GERM     EQU      %
         PAGE
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     ROOT REFS
         DEF      INCGLOB
         REF      M6
         REF      SH:ROSUM
         REF      J:ASPIN,S:OSPIN,S:MBSF
         REF      S:BSPIN,S:GSPIN
         REF      J:JIT
         REF      SH:ROCU
         REF      SH:RGCU
         REF     SH:RGSUM
         REF      JB:CUR,JB:MAX
         REF      SH:RTOT,SH:RBCU
         REF      ENBSR4
         DEF      SPINS,CLEARHI,ASPIN,SETSPIN
         DEF      SSPIN
         DEF      CHKCUR
         DEF      USECHK2
         DEF      RSETSPIN
         DEF      GETTYP,DEALLTY,HOWALO
         DEF      DEALL
         REF      GETRAT
         REF      M7
         REF      PLX1SR4
         PAGE
*                 0=BIT POSITIONED
*                 4= TABLEX
*    DOES ANYONE  HAVE IT
SPINS    CW,0     S:BSPIN,4
         BANZ     *11               YES
         CW,0     S:OSPIN,4
         BANZ     *11
         CW,0     S:GSPIN,4
         B        *11
         SPACE    3
*                 CLEAR BIT AND SET J:ASPIN
*                 2=DCT
*                 1=RATX
CLEARHI RES    0
         LI,14    1                 SET FOR SETTING
         LB,0     JB:MAX,1
         AND,0    M7
         STB,0    JB:MAX,1
ASPIN   RES   0      14=0/1
         LW,4     2
         SCS,4   -5                 DCT
         LB,0     4
         SLS,0    -3
         AI,0     BT31TO0+1
         LW,15    *0                PICK UP BIT
         AI,14    0
         BEZ      %+2
         LW,14    15                SET
         STS,14   J:ASPIN,4
         B        *11
         SPACE 3
SETSPIN  RES      0
         LI,14    1
         PUSH     11
         BAL,11   ASPIN             14=1
         PULL     11
*        FALL     THROUGH
SSPIN    RES      0
         LI,0     S:BSPIN
         LC       J:JIT
         BCR,12   SETX1             B
         LI,0     S:OSPIN
         BCS,8    SETX1             O
         LI,0     S:GSPIN
SETX1    RES      0
         STS,14   *0,4              SET  GLOB
         B        *11
RSETSPIN LI,14    0
         B        SETSPIN+1
         PAGE
*        BAL,11   CHKCUR            INC CUR AND SET IN PROG
*        BL       CAN'T HAVE IT
CHKCUR   RES      0
         LC       JB:MAX,1
         BCS,8    *11               BEEN HERE BEFORE
         AI,11    1
         LB,0     JB:MAX,1
         CB,0     JB:CUR,1
         BLE      *11               CC2=0
         OR,0     X80
         STB,0    JB:MAX,1          SET  ALLOCATION IN PROGRESS
         MTB,1    JB:CUR,1
*
*
*                 COUNT MOUNTS FOR TAPES AND PACKS
         REF      SB:RTY,TB:FLGS
         REF,1    JB:PMTS,JB:TMTS
         STB,1    11
         LB,1     SB:RTY,1
         LC       TB:FLGS,1
         BCR,8    CC2
         BCS,4    JPACK
         LI,1     JB:TMTS
CCOUNT   MTB,1    0,1
CC2      LB,1     11
         B        *11
JPACK    LI,1     JB:PMTS
         B        CCOUNT
         PAGE
USECHK2  RES      0
         BAL,11   GETRAT
         BAL,11   SC31
         AI,9     2                 SET EXIT
         BAL,11   CHKCUR
         B        *9                BEEN HERE(ALLOCATED)
         BLE      2X                OVER
*                 ON LINE   OR   GHOST
         BAL,11   INCGLOB           INCREMENT  GLOBAL
         BAL,15   OVGL
         B        *9                OK
*FALL THROUGH
2X       AI,9     -2                OVER IN JIT
         B        *9
         SPACE    4
OVGL     AI,9     -1
         B        DEALJIT           CLEANUP
         SPACE 3
         DEF      DEPACK,DETAPE
DEPACK   LI,4     BARNDEV
         LB,4     *6,4
         B        DERES
DETAPE   BAL,11   GETTYP
DERES    BAL,11   GETRAT
         B        0,5
         LC       JB:MAX,1
         BCR,8    0,5               NOTHING TO UNDO
         BAL,15   DEALL1            GLOBAL
         BAL,15   DEALJIT
         B        0,5
         PAGE
*                 CHECK GLOBAL SUM
*        1=RATX
*          VOLATILE  0,8,11--
*                 BAL,11
*                 NG
*                 INCREMENT GLOBAL
INCGLOB  LC       J:JIT
         BCR,12   PLX1SR4           BATCH
         BCR,8    INCGLO1           GHOST
         LH,0     SH:ROSUM,1
         SH,0    SH:ROCU,1
         BLEZ     *11               OVER
         LI,0    SH:ROCU
INCGLO2  DISABLE
         LH,8     SH:RTOT,1
         SH,8     SH:RBCU,1
         SH,8     SH:ROCU,1
         SH,8     SH:RGCU,1
         BLEZ     ENBSR4            NO- OVER
         MTH,1    *0,1              ALLOCATE
         ENABLE
         STW,11   S:MBSF
         B        PLX1SR4           11+1
INCGLO1  RES      0                 GHOST
         LH,0     SH:RGSUM,1
         SH,0    SH:RGCU,1
         BLEZ     *11               OVER
         LI,0    SH:RGCU
         B        INCGLO2
         PAGE
GETTYP   RES      0
         LI,4     BADEVTP
         LB,4     *6,4
         AND,4    M6
         B        *11
         PAGE
DEALLTY  RES      0
         BAL,11   GETTYP            LOAD 4
DEALL    BAL,11   GETRAT            LOAD 1
         B        SC31              NO FIND
*        HAVE TYPE AND RATX
DEALL1   RES      0
         LC       J:JIT
         BCR,12   *15               BATCH   DONE
         LI,0     SH:RGCU
         BCR,8    %+2
         LI,0     SH:ROCU
         MTH,-1   *0,1              GLOBAL
         STW,15   S:MBSF    SET MBS FLAG
         B        *15
DEALJIT  LB,0     JB:MAX,1
         AI,0     -X'80'
         BLZ      *15
* IF 80 THEN CUR HAS BEEN INCREMENTED***
         STB,0    JB:MAX,1
         MTB,-1   JB:CUR,1          DEALL JIT
         B        *15
         PAGE
* FIND OUT HOW ALLOCATED AND CLEAR ALLOCATION BIT
*   15=BIT,4=SPINX
*   14=0   STS CLEAR
*EXIT WITH 0  CONTAINING WHO(BATCH,ON LINE OR GHOST)
HOWALO   LI,0     SH:RBCU
         CW,15    S:BSPIN,4
         BANZ     B1                B
         LI,0     SH:ROCU
         CW,15    S:OSPIN,4
         BANZ     O1                OL
         LI,0     SH:RGCU
         CW,15    S:GSPIN,4
         BAZ      *11               NOBODY????
         STS,14   S:GSPIN,4
O1       STS,14   S:OSPIN,4
B1       STS,14   S:BSPIN,4
         B        *11               0=WHO HAS IT
*
SC31     SCREECH  X'31'
         END

