         PCC      0
******  GRANSUB  ******
         SPACE
*  REVISED FOR CP-V RELEASE A00...      CLIFF MELESON.
         SPACE    3
*RESIDENT GET/RELEASE GRANULE ROUTINES USED
*BY ALLOCAT AND FOR PRIVATE PACK LOGIC
         SPACE    6
         SYSTEM   SIG7FDP
MONPROC  SET      1
UTSPROC  SET      0
DISCBPROC SET     1
         SYSTEM   UTS
         SPACE    3
         DEF      GRANSUB
         REF      HGPTYPE
         REF      DCT22
         REF      DISCLIMS
         REF      HGPTEST
         REF      TIME,ERRLOG
         DEF      CMNGG
         DEF      DCTGG
         DEF      CMNRG
         DEF      CMNGNG
         DEF      CMNRNG
         DEF      FNDHGP
         SPACE    3
         REF      HGP
         REF      TSTACK
         REF      GRAVAIL,GRANMIN,GRANRESET
         REF      BUFLAGS
         REF      STARTHGP
         REF      SVHGPFLG
         REF      BT31TO0
         REF      MASKS
M3       EQU      MASKS+3
M4       EQU      MASKS+4
M5       EQU      MASKS+5
M15      EQU      MASKS+15
M24      EQU      MASKS+24
X2       EQU      BT31TO0+2
Y2       EQU      BT31TO0+30
Y8       EQU      BT31TO0+32
         REF      AGRAVAIL
GRANSUB  CSECT    1
         SPACE    6
*  SYMBOLIC REGISTERS
         SPACE    3
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
         SPACE
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         PAGE
*
*        INPUT FROM ALLYCAT:
*
*        R1-      STACK # ..... 0 = RAD BUFFER
*                         ..... 1 = PACK
*                         ..... 2 = SYMBIONTS
*                         ..... 3 = CYLINDER BUFFER
*
*        NOTE:    ALLYCAT HAS WHAT REGS HE WANTS BACK
*                 PUSHED AWAY...GRANSUB CAN WIPE OUT WHATEVER
*                 IT WANTS..
*
CMNGG    EQU      %
         STW,R1   SVHGPFLG          SAVE STACK #
         LB,2     FDADISP,1         AND FDA INDEX (PER OR PFA)
CMNGG1   STB,1    SVHGPFLG          SAVE CHAIN #
         AND,1    M3                SCRUB FLAG BITS
         LW,7     HGPTYPE,1         FIND DEVICES OF THIS TYPE
         BEZ      SETEMPTY1         NONE, TRY NEXT CHAIN
         STW,7    STARTHGP          SAVE FOR SEARCH LIMIT
CMNGG2   MTW,0    *2,7              IF EMPTY , DONT TRAP
         BLEZ     SETEMPTY
         B        GETBIT            GO GET A BIT
FDADISP  DATA     X'6060506'
         PAGE
DCTGG    EQU      %
         BAL,3    FNDHGP            FIND BITMAP FOR GIVEN DEVICE
         BEZ      GGERRET           NOT THERE, CANT DO IT
         LI,15    1                 ONE BIT TO GET
         B        CHKOK
CMNGNG   LI,R6    HGP               FIND LAST BIT MAP
         LW,R7    R6
         LW,R6    0,R7
         BNEZ     %-2
CHKOK    LI,R4    6
         CB,R0    *R7,R4            CHK FOR
         BNE      GTNXT
         LW,3     6,7               IS THERE ANY SPACE HERE
         BLEZ     GTNXT             NO..
         LI,5     X'FF'
         AND,5    1,7
         BNEZ     %+2               SET GRANS TO DECR COUNT/BIT
         LI,5     1                 NOT CYL.. 1 GRAN/BIT
         LW,14    15                SET GRANULE COUNT
         LI,4     0                 INITIALIZE BIT COUNT
         STW,4    STARTHGP          RESET # DEVICES
         LI,2     6
         BAL,6    GETFAL
         AW,3     8                 START AT END OF MAP
         LW,13    Y8                LAST BIT TO LOOK AT
         LI,6     32                # BITS PER WORD
         AI,3     -1                DECR POINTER
         MTW,0    0,3               FIND FIRST NONZERO WORD
         BNEZ     GNG3              AND START SEARCH THERE
         BDR,1    %-3
         STS,13   6,7               SET EMPTY BIT
         B        GTNXT
GNG3     SCS,13   1
GNG31    CW,13    0,3
         BANZ     GNG4              STILL HUMMING
         LW,14    15                LOST IT, START OVER
         LI,4     0                 RESET BIT COUNT
         STW,4    STARTHGP          RESET # DEVICES
         B        GNG5
GNG4     AI,4     1                 COUNT BITS
         SW,14    5                 COUNT GRANULES
         BLEZ     GNG10             GOTTEM
GNG5     BDR,6    GNG3
         AI,3     -1
         LI,6     32
         BDR,1    GNG3              TRY NEXT WORD
         CI,0     X'8B'             IF ALLOCATING CYLINDER, RETURN
         BNE      GTNXT             ANY USABLE PORTION AT START OF PACK
         CW,15    14                DID WE GET ANY AT THE START
         BEZ      GTNXT             NO..
         LW,8     1,7               GET TO PREV DEVICE
GNG6     AI,8     -X'10000'
         BAL,3    FNDHGP
         BEZ      GGERRET           NOT THERE
         LI,5     X'FF'             MUST BE CYL ALLOCATED TOO
         AND,5    1,7
         BEZ      GNG6
         MTW,0    2,7               IF DOWN, EMPTY OR NOT ALLOCATING,
         BLZ      GTNXT             SKIP THIS ONE
         BAL,6    GETFAL
         LB,6     DCT22,5           START WITH LAST BIT
         LW,13    DISCLIMS,6
         SLS,13   -1                CONVERT TO GRANULES
         MTW,1    STARTHGP          COUNT DEVICES
         DW,13    5                 GET LAST BIT# +1
         AI,13    -1
         AND,13   M5
         LCW,6    13                BIT# IN WORD
         LW,13    Y8,6              BIT MASK FOR LAST BIT
         LCW,6    6                 # BITS LEFT IN WORD -1
         AI,6     1
         STW,4    3,7               SAVE # BITS IN NEXT ONE
         AW,3     1                 START AT END OF BITMAP
         AI,3     -1
         B        GNG31             CONTINUE SEARCH
GNG10    SLS,1    5
         AI,6     -33
         AW,1     6
         LI,12    0                 SET UPP ZAP BITS
         SW,15    14                SET ACCURATE GRANULE COUNT
         LW,5     STARTHGP          GET DEVICE COUNT
         STW,7    STARTHGP          SAVE FIRST BITMAP ADDRESS
GNG11    STS,12   0,3
         SCS,13   -1
         BDR,4    GNG13
         AI,5     -1                IF MORE THAN ONE DEVICE
         BGEZ     GNG12             KEEP ZAPPING
         LW,7     STARTHGP          RESTORE STARTING DEVICE
         LW,5     0                 CALCULATE STACK#
         MI,5     (1+32)**10        FOR COUNTING
         LH,6     5
         AND,6    M3
         LCW,13   15                AND GRANULE COUNT
         B        DISKADDR
GNG12    XW,4     3,7               RESET, GET BIT COUNT FOR NEXT DEVICE
         LW,13    Y8                SET FIRST BIT TO ZAP
         LW,7     0,7               AND GO ON TO THE NEXT
         LW,3     6,7
         SLS,3    -16
         AW,3     7
         B        %+3
GNG13    BIR,6    GNG11
         AI,3     1
         LI,6     -32
         B        GNG11
         PAGE
*
*        MOVE TO NEXT HGP IF OKAY
*
GTNXT    LW,R8    R7                STEP DOWN TO PREV DEVICE
         LI,R7    HGP
         CW,R8    0,R7
         BE       CHKOK             GOT IT
         LW,R7    0,R7
         BNEZ     %-3
GGERRET  LI,SR1   0                 ERROR INDICATOR
GGRET    AI,R8    0                 SET CONDITIONS
         B        *SR4              GET OUT
         PAGE
*
*        R2 HAS EITHER A '5' OR A '6' IN IT
*
*        0        15                31
*        *---------------------------*
* WORD 0 *    HGP FORWARD LINK (WA)  *
*        *---------------------------*
* WORD 1 * DCTX   *  FLAGS   * NGC   *
*        *---------------------------*
* WORD 2 * FLINK IN TYPE CHAIN:      *
*        * (RAD,PACK,SYMB,CYL,MIXED) *
*        *---------------------------*
* WORD 3 *  LAST  * LAST PER/PFA     *
*        * BIT NO * DISPLACEMENT     *
*        *---------------------------*
* WORD 4 *  PER   *     PFA          *
*        * MAPWL  *    MAPWL         *
*        *---------------------------*
* WORD 5 * PER    * PER 1ST SECTOR   *
*        * MAPWD  *                  *
*        *---------------------------*
* WORD 6 * PFA    * PFA FIRST        *
*        * MAPWD  * SECTOR           *
*        *---------------------------*
*
*
GETFAL   LI,R1    3                 GET #
         AW,R1    R2                 OF WORDS
         LH,R1    *R7,R1              IN BIT MAP
         LW,8     1                 IN 8 AND 1
         LW,3     *7,2              GET MAP DISPLACEMENT
         SLS,3    -16
         AW,3     7                 MAP ADDRESS
         B        0,R6              RETURN
*
         PAGE
*
*        SINGLE BIT GET COMES HERE
*
GETBIT   EQU      %
*
*        R1:      CONTAINS MAPWL (IN WORDS)
*        R2:      CONTAINS PER/PFA POINTER
*        R3:      CONTAINS MAP WORD ADDRESS
*        R8:      CONTAINS MAPWL ALSO (IN WORDS)
*        R7:      CONTAINS HGP POINTER
*
*
         BAL,6    GETFAL            GET POINTERS
         INT,4    3,7               PICK UP LAST GETBIT VALUES
         SW,5     3                 MAKE DISP INTO MAP
         BLZ      GBIT0             OTHER TYPE OR HGP>10000
         SW,8     5                 MAY HAVE BEEN OTHER TYPE THOUGH
         BLE      GBIT0             SO CHECK IT FIRST
         LCW,6    4                 GET BIT MASK
         LW,13    Y8,6
         AW,3     5
         AI,4     -32               ADJUST 4
         B        GBIT3             AND FIND THE NEXT BIT
GBIT0    LW,13    Y8
         STW,13   3,7               SET FULL SEARCH FLAG
         LW,8     1                 RESTORE MAPWL
GBIT1    MTW,0    0,3               IS THERE ANY BIT HERE
         BEZ      GBIT4             NO, TRY THE NEXT ONE
GBIT2    LI,4     -32               YES, FIND IT
GBIT3    CW,13    0,3
         BANZ     GBIT5             FOUND IT
         SCS,13   -1
         BIR,4    GBIT3
GBIT4    AI,3     1
         BDR,8    GBIT1
         MTW,0    3,7               IF DISP SEARCH, TRY ONCE MORE
         BLZ      SETEMPTY          NO, REALLY IS
         BAL,6    GETFAL
         B        GBIT0
*
*
GBIT5    LI,12    0                 ZAP BIT
         STS,12   0,3
         AI,4     32                BIT# IN WORD
         SW,1     8                 WORD# IN MAP
         STH,4    3                 SAVE FOR NEXT GET
         STW,3    3,7
         SLS,1    5
         OR,1     4                 BIT# IN MAP
         LI,13    -1                SET 1 BITS GOTTEN
         LW,6     SVHGPFLG          RESTORE TYPE OF REQUEST
         MTB,-3   6                 IF CYLINDER, STAY HERE AS LONG AS POSSIBLE
         BEZ      %+3
         LW,8     2,7               FLINK AROUND DEVICES FOR SEEK OVERLAP
         STW,8    HGPTYPE,6
         BNEZ     DISKADDR          IF CYL, SET GRANULE COUNT
         LI,13    X'FF'
         AND,13   1,7
         LCW,13   13
DISKADDR EQU      %
         CI,6     2                 DONT COUNT IF SYMBIONT OR CYL
         BANZ     %+3
COUNTERS AWM,D2   GRANMIN
         AWM,D2   GRANRESET
         AWM,D2   AGRAVAIL,R6
         AWM,D2   GRAVAIL,R6
         LI,D2    0                 ASSUME NOT CYLINDER OR GNVAT
         SLS,1    1                 CONVERT TO SECTORS
         LW,SR1   *R7,R2            1ST SECTOR #
         LW,R3    1,R7              DON'T CLOBBER THE HGP
         LH,R6    R3                POINTER IN REGISTER 7
         STH,R13  R8                RESET MAPWD / LEAVE FIRST SECTOR
         CI,R3    X'8000'           IS HGP CYLINDER ORIENTIED
         BAZ      GGA               NO, GRANULE ORIENTED
         LI,D2    X'FF'             IF CYL LOAD NGC MASK TO GET
         AND,R13  R3                GRAN/CYL
         MW,R1    D2                FACTOR IT
GGA      AW,SR1   R1                SET LSH OF DISK ADDRESS
         STSECTA,SR1     SR1
         STDCTX,R6   SR1
         STB,D2   SR1               0 OR NGC
         AND,R0   M4                EXTRACT DEVICE TYPE
         B        GGRET             GET OUT
         PAGE
*
*
*
         SPACE
         PAGE
*
*        SET HGP EMPTY BIT
*
SETEMPTY EQU      %
         LW,9     Y8                EMPTY FLAG
         STS,9    *2,7              SET EMPTY FLAG
         LW,7     2,7               GET FLINK
         CW,7     STARTHGP          HAVE SEARCH WHOLE CHAIN
         BNE      CMNGG2            NO, TRY THIS ONE
SETEMPTY1 LB,1    SVHGPFLG          GET LAST CHAIN TRIED
         LB,1     NXTTYPE,1         FINISHED THAT ONE, TRY THE NEXT
         BEZ      GGERRET           NONE LEFT
         B        CMNGG1
NXTTYPE  DATA     X'04050C00',0,0,X'0D060000'
         PAGE
*
*        RELEASE BIT LOGIC
*
CMNRG    LI,15    1
CMNRNG   BAL,3    FNDHGP
         BEZ      GGERRET           NO TABLE
         LW,10    1,R7              GET AND HOLD FLAG IN R10
         CI,10    X'4000'           IS IT PRIVATE
         BANZ     GGERRET           THATS AN ERROR
CMNRELZ  LSECTA,R5 SR1
         BAL,R9   HGPTEST           INSURE VALIDITY OF POINTER
         LI,R4    0                 SET UP FOR ARITHMETIC
*
*        THE INTERESTED OBSERVER OF THESE
*        ROUTINES MAY HAVE NOTICED THAT WE
*        ALLOW THE SYMBIONT ROUTINES TO STEAL
*        PFA GRANULES WHEN THEY RUN OUT OF
*        PER, NOW WE HAVE TO FIGURE OUT IF
*        THEY ARE REALLY GIVING BACK A PER OR
*        A PFA DISC ADDRESS.
*
CMNRELZ1 LI,R2    5                 ASSUME PER FIRST
         LI,R6    9                 HWX TO PFA W/C
         LH,R6    *R7,R6            GET PFA WORD CNT
         BEZ      ALLPER            NO PFA, MUST BE ALL PER
*
*        OBSERVE THAT THIS DEVICE HAS PFA ON IT
*
         LI,R6    X'FFFF'           GET PFA FIRST SECTOR#
         AND,R6   6,R7
         BEZ      ALLPFA            DEVICE IS ALL PFA
*
*        OBSERVE THAT THIS DEVICE HAS BOTH PER AND PFA
*
         CW,R5    R6                IS ADDRESS IN PER
         BL       %+2               YES
ALLPFA   LI,R2    6                 DISC ADDRESS IS IN PFA AREA
ALLPER   INT,R3   *R7,R2            GET AREA FIRST SECTOR
         SW,R5    R3                GET RELATIVE ADDRESS
         BLZ      GGERRET           BAD DISC ADDRESS
         CI,10    X'8000'           IS HGP CYLINDER ALLOCATED
         BAZ      CMNRELB           NOPE
         LI,R6    X'FF'             GET
         AND,R6   1,R7               NGC
         DW,R4    R6                DIVIDE IT
         AI,R4    0
         BNEZ     GGERRET           NOT A CYLINDER
CMNRELB  DW,4     X2                DIVIDE BY NSG
         AI,R4    0
         BNEZ     GGERRET           NOT A GRANULE
         AW,R5    D4
         AI,R5    -1
         SLD,R4   27
         SCS,R5   5
         LCW,R3   R5
         INT,0    *7,2              GET MAP
         LW,5     0                 WORD DISPLACEMENT
         LI,R1    3
         AW,R1    R2                NOW GET
         LH,R1    *R7,R1            MAP WORD LENGTH
         CW,R4    R1
         BGE      GGERRET           WONT FIT
         AW,R5    R4                OFFSET + START
         LI,D2    1                 POSITION
         SCS,D2   -2,R3              BIT MASK
         CI,D2    0                 NEED TO ADJUST WORD POINTER
         BGZ      RELALL            NO
         AI,R5    1                 YES,BUMP TO NEXT HIGHER WORD
RELALL   LI,R3    6                 INDEX TO DEVICE TYPE
         LI,6     3                 CYL
         CI,10    X'8000'           IS HGP CYLINDER ALLOCATED
         BANZ     RELCYL            YEP, JUMP
         LI,6     2
         CI,2     5                 PER
         BE       RELCNT
         LB,6     *7,3
         AND,6    M4
         SLS,6    -3
RELCNT   AWM,15   GRANMIN
         AWM,15   GRANRESET
RELCYL   LH,R3    BUFLAGS,R6        GET OLD FLAGS
         AND,R3   M15               REMOVE EMPTY HGP BIT
         STH,R3   BUFLAGS,R6        AND RESTORE FLAGS
         AWM,R15  GRAVAIL,R6        ADJUST GRANULES AVAIL TABLE
         AWM,15   AGRAVAIL,6
RELALLO  LW,3     Y8                RESET EMPTY BIT
         MTW,0    2,7               UNLESS DEVICE IS DOWN
         BEZ      %+2
         STS,2    *2,7
         LW,R4    D4                INITIALIZE COUNTER
RELALL1  EQU      %
         SCS,D2   1                 NO, POSITION MASK
         BCR,8    RELALL4           WORD BOUNDARY CHECK
         AI,R5    -1                BACK UP ONE WORD
RELALL4  CW,D2    *R7,R5            IS THAT BIT ON NOW....
         BANZ     LOGDUAL           YES, THATS DUALL ALLOCATION
         STS,D2   *R7,R5            NOPE, SET BIT
NEXTREL  BDR,4    RELALL1           LOOP
RELALL5  CI,6     3                 IF CYLINDER, FORCE RESTART
         BNE      *11               OF BIT SEARCH
         STW,4    3,7
         B        *11
         PAGE
*
*
*        LOG DUAL ALLOCATION ERROR RECORD
LOGDUAL  LCI      0
         PSM,0    TSTACK            SAVE EM ALL
         LW,R9    TIME
         LW,R10   R8                DISC ADDRESS
         STH,R15  R11               #OF GRANS WE ARE RELEASING
         LW,R8    =X'24040001'      ERROR RECORD CODE/COUNT/FLAG
         LI,R6    8                 ADDRS OF ERROR MSG
         AW,R6    Y2                SET FLAG FOR ERHNDLR
         BAL,R5   ERRLOG            LOG MSG
         LCI      0
         PLM,0    TSTACK
         B        NEXTREL           CONTINUE ALONG
         PAGE
*
*        FIND HGP ADDRESS OF DISK ADDRESS IN R8
*
*        RETURNS WITH 7=HGP ADDRESS,5=DCT INDEX AND CC 'NOT EQUAL'
*        IF LEGITIMATE DCTX
*        OTHERWISE CC 'EQUAL'
*        CLOBBERS 6
*        BAL,3    FNDHGP
*
FNDHGP   LI,7     HGP
         LDCTX,5  8
         BEZ      0,3               NONE
         LI,6     5
         CB,5     *7,6
         BE       %+3
         LW,7     0,7
         BNEZ     %-3
         AI,7     0
         B        0,3
         END

