         PCC      0
         TITLE    '**** GRANSUB ****'
*M*      GRANSUB  PUBLIC GRANULE BITMAP MANIPULATING LOGIC
DISCBPROC SET     2
BITS     SET      1
         SYSTEM   UTS
         PAGE
*        DEFS
         DEF      CMNGG             GET ONE GRANULE
         DEF      CMNGNG            GET N GRANULES
         DEF      CMNRG             RELEASE ONE GRANULE
         DEF      CMNRNG            RELEASE N GRANULES
         DEF      DCTGG             GET SECOND HALF OF DUAL PAIR
         DEF      FNDHGP            FIND HGP ADDR OF GRANULE
         PAGE
*        REFS
         REF      DCT22             INDEX INTO DISCLIMS
         REF      DISCLIMS          LAST SECTOR# +1 FOR GETN OVER BOUNDARY
         REF      ERRLOG            LOG BAD RELEASES
         REF      GRAVAIL           AVAILABLE GRANULE COUNTS
         REF      HGP               HEAD OF BITMAPS CHAIN
         REF      HGPTEST           HGP ADDRESS VALIDITY CHECK
         REF      HGPTYPE           HEADS OF TYPE CHAINS
         REF      J:BASE            TEMP STORAGE
         PAGE
*        TEMP     STORAGE
STARTHGP EQU      J:BASE+1
SVHGPFLG EQU      J:BASE+2
GRANSUB  DSECT    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
*F*      NAME: CMNGG
*F*      PURPOSE: ALLOCATE ONE GRANULE FOR INCORE BUFFER.
*
*        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+2        TRY NEXT IN CHAIN
         B        GETBIT            GO GET A BIT
FDADISP  DATA     X'6060506'
         PAGE
*F*      NAME: DCTGG
*F*      PURPOSE: ALLOCATE ONE GRANULE ON A SPECIFIC DEVICE.
DCTGG    EQU      %
         LI,15    1                 ONE BIT TO GET
         BIR,1    CHKOK             GET FROM END IF SAME DEVICE AS DUAL
         LI,2     6                 OTHER WISE DO ONE BIT GET
         LB,1     *7,2              FIRST GET CHAIN #
         CI,1     X'80'             CYL IS ALWAYS 3
         BANZ     CHKOK             AND COMES FROM THE END
         SLS,1    -3
         STW,1    SVHGPFLG          SAVE STACK #
         INT,3    6,7               CHECK IF MIXED DEVICE
         AI,3     0
         BEZ      %+2               NO
         AI,1     4                 YES, SET CHAIN #
         STW,7    HGPTYPE,1         SET HEAD OF CHAIN
         B        CMNGG1            ADN GO DO IT
         PAGE
*F*      NAME: CMNGNG
*F*      PURPOSE: ALLOCATE N GRANULES FOR RANDOM FILE.
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
         BNE      GNG7              GOT IT
         CW,8     HGP+1             IS IT STILL POSSIBLE
         BG       GNG6              TO FIND A PREV DEVICE
         B        GGERRET           NO.
GNG7     RES
         LI,5     X'FF'             MUST BE CYL ALLOCATED TOO
         AND,5    1,7
         BEZ      GNG6
         MTW,0    6,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
         LI,4     0                 CLEAR DEVICE COUNT
         BDR,3    GNG31             AND 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**13+1**10       FOR ACCOUNTING
         LH,6     5
         AND,6    M2
         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
         LB,3     SVHGPFLG          AND CHAIN #
         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,3
         BNEZ     DISKADDR          IF CYL, SET GRANULE COUNT
         LI,13    X'FF'
         AND,13   1,7
         LCW,13   13
DISKADDR EQU      %
         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,R3 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
*
*F*      NAME: CMNRG,CMNRNG
*F*      PURPOSE: RELEASE 1 OR N GRANULES TO BIT MAPS.
*
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     RELCNT            yep, count grans
         LI,6     2
         CI,2     5                 PER
         BE       RELCNT
         LB,6     *7,3
         AND,6    M4
         SLS,6    -3
RELCNT   RES
         AWM,R15  GRAVAIL,R6        ADJUST GRANULES AVAIL TABLE
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  PUSH
         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
         PULL
         B        NEXTREL           CONTINUE ALONG
         PAGE
*
*F*      NAME: FNDHGP
*F*      PURPOSE: FIND HGP ADDRESS FOR GDA.
*
*        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

