         TITLE    '**** ALLYCAT ****'
         PCC      0
*M*      ALLYCAT  NON-RESIDENT PUBLIC GRANULE ALLOCATION CODE
         SPACE    3
*P*      NAME:    ALLYCAT
*P*      PURPOSE: ALLYCAT TRANSFERS INFORMATION BETWEEN
*P*       RESIDENT AND NON-RESIDENT PUBLIC ALLOCATION DATA.
BITS     SET      1
DISCBPROC SET 1
         SYSTEM   UTS
         PAGE
*        DEFS
ALLYCAT  DSECT    1
         DEF      HGPTEST           TEST HGP ADDR VALIDITY
ALLOCHKS EQU      %-13              CHECKSUM IN LAST WORD OF DATA
ALLODSZ  EQU      %-12-HGP          DATA SIZE
         PAGE
*        REFS
         REF      ACNCFU            SAVED BY ALLOCAT
         REF      ACNFDA            WHERE TO SAVE ACNCFU
         REF      ADJSTCNT          TELL SWAPPER HOW TO ADJUST STACKS
         REF      ALLODIRA          SAVED BY ALLOCAT
         REF      ALLODDA           DUAL DATA COPY DISC ADDRESS
         REF      QUEUE             IO ROUNTINE FOR COPYING DATA
         REF      Y06               CODE FOR WRITING THROUGH QUEUE
         REF      IOSPIN            WAIT FOR READ TO FINISH
         REF      ALLOOUT           TELL SWAPPER TO OUTSWAP ALLOCAT
         REF      ALLYEND           TO CHECKSUM DATA AREA
         REF      BOTTOM            IN CORE STACK CONTROL
         REF      BUFLAGS           IN CORE STACK FLAGS
         REF      BUFMASK           IN CORE STACK CONTROL
         REF      CATBUF            IN CORE STACK ADDRESSES
         REF      CBAHD             HEAD OF ALLOCAT COMMUNICATIONS
         REF      CBFHD             HEAD OF COMMUNICATION BUFFERS
         REF      CMNGG             GET GRANULE
         REF      CMNGNG            GET GRANULES
         REF      CMNRG             RELEASE GRANULE
         REF      CMNRNG            RELEASE GRANULES
         REF      COMBUF            ADDRESS OF COMMUNICATION BUFFERS
         REF      DCTGG             GET GRANULE ON SPECIFIC DEVICE
         REF      DCT2              CHANNEL # FOR GET SEPARATED PAIR
         REF      DCT24             X80 IMPLIES NO ALLOCATION HERE
         REF      E:SL              SLEEP UNTIL NEEDED AGAIN
         REF      ERRLOG            LOG BAD ADDRESSES
         REF      FNDHGP            HGP ADDRESS/DCTX FOR SEPARATED PAIR
         REF      GBG               GET FROM STACK (SEP PAIR/QUIESCE)
         REF      GCYL              GET FROM STACK )SEP PAIR/QUIESCE)
         REF      GRANMIN           PURGE LIMIT
         REF      GRAVAIL           #GRANULES AVAILABLE
         REF      GSG               GET FROM STACK (QUIESCE)
         REF      HGP               ADDRESS OF BITMAPS
         REF      HGPSIZE           SIZE OF BITMAP AREA
         REF      HGPTYPE           HEADS OF TYPE CHAINS
         REF      HILEVEL           UPPER THRESHOLD FOR STACKS
         REF      J:BASE            TEMP STORAGE
         REF      JB:LMAP           RELEASE EXTRA PAGES
         REF      JBUPVP            RELEASE EXTRA PAGES
         REF      JH:DA             MOVE TO ORIGINAL LOCATION
         REF      JXBUFVP           RELEASE EXTRA PAGES
         REF      LFGUN             RECONSTRUCT COMPLETION
         REF      LOLEVEL           LOWER THRESHOLD FOR STACKS
         REF      M:ADRINCR         MOVE TO ORIGINAL LOCATION
         REF      M:GASLIM          MOVE TO ORIGINAL LOCATION
         REF      M:XX              TEMP STORAGE
         REF      MB:GAM6           MOVE TO ORIGINAL LOCATION
         REF      S:RBBRN           DONT ALLOCATE SYMBIONT BEFORE RBBAT
         REF      SAMSJIT           SAVE RBBAT JIT DA
         REF      SGB               SYMBIONT GRANULES BUSY
         REF      SYSACTL           SAVED BY ALLOCAT
         REF      T:GJOBSTRT        START PURGE
         REF      T:RBUF            RELEASE EXTRA PAGES
         REF      T:REG             SLEEP UNTIL NEEDED AGAIN
         REF      T:SGR             MOVE TO ORIGINAL LOCATION
         REF      TEMPBOT           TELL SWAPPER HOW TO ADJUST STACKS
         REF      TOP               IN CORE STACK CONTROL
         REF      U:MISC            SLEEP UNTIL NEEDED AGAIN
         REF      UB:PCT            MOVE TO ORIGINAL LOCATION
         REF      UB:PRIOB          BUMP FOR UNINTERRUPTED TIME
         REF      UB:SWAPI          MOVE TO ORIGINAL LOCATION
         REF      UH:AJIT           MOVE TO ORIGINAL LOCATION
         REF      UH:JIT            MOVE TO ORIGINAL LOCATION
         REF      WORDCNT           IN CORE STACK CONTROL
ALLYON   EQU      CBAHD
AGRAVAIL EQU      J:BASE+1
         PAGE
*  SYMBOLIC REGISTERS
         SPACE
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
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: ALLOINIT
*F*      PURPOSE: PREPARE ALLOCAT TO RUN FOLLOWING SYSTEM STARTUP.
*F*      DESCRIPTION: THE JIT IS MODIFIED SO THAT ALLOCATS DATA
*F*       IS SWAPPED OUT TO SECTOR 8 OF THE FIRST SWAP DEVICE.
*F*       PORTIONS OF RESIDENT DATA MODIFIED BY ALLYCAT
*F*       ARE NOT MADE ACCESSIBLE TO GRAN UNTIL ALLOCAT HAS
*F*       BEEN SWAPPED OUT.
*F*       UB:PRIOB IS BUMPED TO INSURE CONTINUOUS EXECUTION
         SPACE    3
         CAL1,6   SYS               GET MASTER MODE
         SPACE
         LI,R7    JBUPVP            *FREE ANY UNNEDED PAGES BELOW
1A1      LB,R10   JB:LMAP,R7        *(FLINK) ALLY START
         LW,R7    R10               BEFORE TRYING TO SWAP
         BEZ      1A2               BACK TO ORIGINAL SIZE
         SPACE
         LB,R10   JB:LMAP,R7
         LW,14    7
         AI,14    -JXBUFVP          SPARE BUFFER INDEX.
         LI,5     0
         BAL,2    T:RBUF       RELEASE IT..
         B        1A1
1A2      EQU      %
         SPACE
         LI,R4    2                 ALLOCAT'S NUMBER
         LB,R7    UB:PCT,R4
         LI,R14   2                 SECT 2 RESVD FOR AJIT
         LH,R15   UH:AJIT,R4        IF THERE IS ONE
         BEZ      NOAJ
         STH,R14  UH:AJIT,R4
         AI,R7    -1                DECR CT FOR AJIT PAGE
         B        RELIT
NOAJ     LH,R15   UH:JIT,R4         GET JIT SECT NUM TO REL
RELIT    AI,R7    -1                DECR CT FOR JIT PAGE
         LI,R14   4                 SECT 4 RESERVED FOR JIT
         STH,R14  UH:JIT,R4
         BAL,R11  T:SGR             REL A GROUP OF GRANS
         AI,R7    3
         SLS,R7   -2                GET # DISC ADDRESSES
         LI,R14   8                 CAT STARTS ON SECTOR 8
         LI,R6    0
         LH,R15   JH:DA,R6          PICK UP DAS
         BAL,R11  T:SGR
         STH,R14  JH:DA,R6          PUT BACK OLD ONES
         SPACE
         BAL,R13  INCR              NEXT DA
         AI,R6    1
         BDR,R7   %-5
         STB,R7   UB:SWAPI,R4
         MTB,-8   UB:PRIOB,R4       UPP OUR COMPUTE PRIO A BIT
         SPACE
         BAL,10   WAIT              WAIT FOR FIX TO RUN ONCE
         LCI      6
         LM,0     ACNFDA            GET FILE SYSTEM POINTERS
         AI,R0    0                 IF NOT THERE, FORGET IT
         BEZ      %+5
         STW,0    ACNCFU+1          FDA
         STW,1    ACNCFU+8          DFDA
         STD,2    ALLODIRA          NGAVAL/GAVAL
         STW,4    SYSACTL           :SYS FDA
         PAGE
         LI,11    ALLOCAT           RETURN FROM HGPCNT FIRST TIME IN
*
*F*      NAME: HGPCNT
*F*      PURPOSE: COUNT BITS IN THE BITMAPS, BUILD HGPTYPE CHAINS, SET
*F*       EMPTY BITS AND GRAVAIL
*
HGPCNT   EQU      %
         LW,13    Y8                EMPTY BIT
         LI,12    0                 FOR ZAPPING
         LI,R4    4                 THE GRANULES AVAILABLE
         STW,12   HGPTYPE-1,4       ZAP FAST PATH POINTERS TOO
         STW,12   HGPTYPE+2,4
         STW,12   AGRAVAIL-1,4      TABLES
         BDR,4    %-3
         LI,R7    HGP               START OFF LOOP
NEXTHGP  LW,R3    1,R7              GET MAP FLAGS
         STS,13   5,7               SET EMPTY BITS
         STS,13   6,7               FOR PFA AND PER
         STW,12   3,7               ZAP FAST PATH DISP
         CI,R3    X'4000'           IS THIS MAP A PUBLIC HGP
         BANZ     HGPLINK           NOPE...;PRIVATE
         LH,4     3                 IF DEVICE IS DOWN, SKIP IT
         LC       DCT24,4
         BCS,8    HGPLINK
         LI,14    1                 ONE GRAN/BIT UNLESS CYL
         CI,R3    X'8000'           IS CYLINDER ALLOCATED
         BAZ      NOTCYL            NOPE
         LI,9     3                 CYL SPOT
         LI,14    X'FF'             GET CYL SIZE
         AND,14   1,7
         BEZ      HGPSBLOWN         NO GOOD
         B        COUNTEM           GET INTO LOOP
NOTCYL   SLS,R3   -8                POSITION DEVICE TYPE
         AND,R3   M4                STRIP DOWN TO DEVICE TYPE
         CI,R3    X'07'             IS THIS A RAD HGP
         BNE      NOTRAD            NOPE
         LI,9     0                 RAD SPOT
         B        COUNTEM           DO IT
NOTRAD   CI,R3    X'0B'             IS IT A DISC PACK THEN
         BNE      HGPSBLOWN         HGPS ARE BLOWN AWAY
         LI,9     1                 POINT TO PACK SPOT
COUNTEM  LI,2     -32               SET UP CVA TABLE
         STW,14   M:XX+35,2         IN JIT
         BIR,2    %-1               IN CASE WE GET SWAPPED
         INT,2    4,7               GET WORD COUNTS  (MAX FFF)
         AI,2     0                 ANY PER ON THIS ONE
         BEZ      COUNTEM3          NO...CHECK PFA
         LW,4     5,7               GET PER MAP DETAILS
         LI,1     2
COUNTEM1 INT,4    4                 SHIFT MAP WORD DISP INTO PLACE
         LW,0     AGRAVAIL,1        GET CURRENT VALUE FOR EMPTY CHECK
COUNTEM2 LW,15    *R7,R4            GET A WORD
         BEZ      %+3               NONE HERE
         CVA,14   M:XX+3            ADD UP THE BITS
         AWM,14   AGRAVAIL,1        AND ACCUMULATE
         AI,R4    1
         BDR,2    COUNTEM2          NEXT WORD LOOP
         CW,0     AGRAVAIL,1        DID WE GET ANY GRANULES
         BE       COUNTEM3          NO
         LI,4     6                 ASSUME PFA
         CI,1     2
         BNE      %+2
         LI,4     5                 NO, WAS PER
         STS,12   *4,7              RESET EMPTY BIT IF WE GOT SOME
COUNTEM3 XW,2     3                 ANY PFA ON THIS DEVICE, OR WERE DONE
         BLEZ     HGPCHAIN          DONE, PUT IN A CHAIN, MAYBE
         LW,1     9                 GET SAVED PFA TYPE
         LW,4     6,7               GET PFA MAP DETAILS
         B        COUNTEM1
*
HGPCHAIN LW,3     4,7               IF SWAPPER ONLY, DONT CHAIN
         BEZ      HGPLINK
         CI,1     2                 CYL => ONLY PFA SO LINK IT
         BG       HGPCH2
         BDR,5    %+2               OTHERWISE, CHECK FOR DUAL PURPOSE
         AI,1     -4                STARTS AT 0, PUT IN O,1,OR 2
         AI,1     4                 DOESNT, PUT IN 4,5,OR 6
HGPCH2   LW,2     7                 ADD 7 TO CIRCULAR CHAIN HGPTYPE
         XW,7     HGPTYPE,1
         XW,2     2,7               OLD HEAD'S NEW FLINK IS NEW HEAD
         LW,7     HGPTYPE,1         NEW HEAD'S FLINK IS OLD HEAD'S OLD FLINK
         STW,2    2,7               (BOTH THE SAME IF OLD HEAD WAS 0)
*
HGPLINK  LW,R7    0,R7              STEP UP TO NEXT HGP
         BEZ      HGPDONE           HIT LAST ONE
         LI,R9    NEXTHGP           SET RETURN, FALL THRU CHK LINK
*
*
HGPTEST  CLM,R7   HGP:LIMS          IS ADDRESS WITHIN RANGE
         BCR,9    *9                YES,EXIT
*S*      SCREECH CODE: 89-00
*S*      REPORTED BY: ALLOCAT
*S*      MESSAGE: ALLYCAT'S HGP CHAIN CLOBBERED
*S*      REGISTERS: R7=INVALID HGP CHAIN ADDRESS
*S*                 R9=LINK REGISTER
*S*      TYPE: SCREECH
HGPSBLOWN  SCREECH   X'89'          NOPE
*
*
         BOUND    8
         DEF      HGP:LIMS          FOR GRANSUB
HGP:LIMS DATA     HGP
         DATA     HGP+HGPSIZE+2
HGPDONE  LCI      4
         LM,R0    AGRAVAIL          SET UP GRAVAIL FOR KEYIN
         STM,R0   GRAVAIL
         LI,3     7
         LW,2     HGPTYPE-1,3       ALLOCATE FROM FIRST TO LAST
         LW,2     2,2
         STW,2    HGPTYPE-1,3
         BDR,3    %-3
         B        *R11              RETURN TO INITIALIZATION
         SPACE    3
INCR     LI,R5    4
         AI,R14   2
         LB,15    MB:GAM6
         CS,14    M:GASLIM
         BLE      INCR1
         AW,R14   M:ADRINCR
INCR1    EQU      %
         BDR,R5   INCR+1
         B        *R13
         PAGE
ALLOCAT  EQU      %
         MTW,1    ALLYON            SET 'ON' FLAG
         LW,0     ACNCFU+1          SAVE FILE SYSTEM POINTERS
         LW,1     ACNCFU+8
         LD,2     ALLODIRA
         LW,4     SYSACTL
         LCI      5
         STM,0    ACNFDA
         PAGE
*
*F*      NAME: ENDYET
*F*      PURPOSE: RETRIEVE A MESSAGE FROM COMBUFS AND PROCESS IT.
*
ENDYET   STW,11   J:BASE            DATA MODIFIED ENTRY
ENDYET1  BAL,R7   GBUF              NOT MODIFIED ENTRY
         INT,R4   COMBUF,R1
         AND,R4   M8
         LW,R15   COMBUF+1,R1
         BAL,R10  COMVEC,R4
         B        ENDYET
         PAGE
*F*      NAME: QUIESCE
*F*      PURPOSE: EMPTY IN CORE BUFFERS INTO THE BITMAPS.
QUIESCE  BAL,R11  FCB               FREE COMM BUFFER
         LI,1     -4                EMPTY ALL BUFFERS
QE1      DISABLE
         MTH,0    WORDCNT+2,1       ANY LEFT HERE
         BEZ      QE2               NO, TO THE NEXT ONE
         PUSH     1                 SAVE INDEX
         LB,0     GT,1              GET DEVICE TYPE
         BAL,11   GG,1              GET ONE HERE
         BAL,11   CMNRG             RELEASE IT
         PULL     1
         B        QE1               TRY FOR MORE HERE
QE2      BIR,1    QE1               TO NEXT STACK
         B        ENDYET            TO NEXT REQUEST
         B        GBG
         B        GBG
         B        GSG
         B        GCYL
GG       DATA,1   7,11,0,0
GT       EQU      %
         PAGE
*F*      NAME: ADJBUFS
*F*      PURPOSE: ADJUST INCORE BUFFER LEVELS TO OPTIMUM VALUES.
ADJBUFS  EQU      %
SETINDEX LI,R1    4                 SET INDEX FOR # OF BUFS
         SPACE
NEXTBUF  ENABLE
         AI,R1    -1                DECREMENT INDEX
         BLZ      NOMORE            AND EXIT IF NO MORE BUFS
         CI,R1    2                 IF SYMBIONT, DONT ALLOCATE
         BNE      %+4               NLESS RBBAT SAYS ITS O.K.
         LI,R5    X'8000'
         MTW,0    S:RBBRN           SET EMPTY INSTEAD (STEAL PFA)
         BEZ      SETFLAG
         SPACE
         DISABLE
         LH,R0    BUFLAGS,R1        GET OLD FLAGS
         CI,R0    X'6001'           HAS SSS RUN/OR IN PROGRESS FLAG SET
         BANZ     NEXTBUF           NOT FOR THIS ONE YET
         AI,R0    1                 SET IN PROGRESS FLAG
         STH,R0   BUFLAGS,R1        AND SAVE IT
         LI,R0    0                 YES
         STH,R0   ADJSTCNT,R1       RESET COUNTER
         LH,R2    WORDCNT,R1        GET COUNT IN BUFFER
         BLZ      ALLYERROR         SOMEONE BLEW IT
         CH,2     LOLEVEL,1
         BLE      FILL              FILL IF LOW
         CH,2     HILEVEL,1
         BLE      AVG:ADJ           BUFFER IS OPTIMUM
         SH,2     LOLEVEL,1         CALCULATE # TO REMOVE
         LH,R3    BOTTOM,R1         GET BOTTOM DISP
         AW,R3    R2                MAKE TEMPBOT DISP
         AND,R3   BUFMASK,R1        LOOK FOR WRAPAROUND
         STH,R3   BOTTOM,R1         SET BOTTOM
         LH,R3    TEMPBOT,R1        START AT LOW END
         LW,R4    CATBUF,R1         GET LOC OF BUFFER
         ENABLE
EMPTY1   MTH,-1   ADJSTCNT,R1       DECREMENT WORD COUNT 1ST FOR TSTHGP
         LI,R8    0
         XW,R8    *R4,R3            RESET OLD / GET ONE OUT
         LW,R5    R8                REMEMBER IT IN R5
*
*  UPDATE POINTER AND WORD COUNT FIRST. THEN IF A CRASH
*  OCCURS BETWEEN RELEASING THE GRANULE AND UPDATING THE
*  POINTER... WE LOSE ONE GRANULE INSTEAD OF TRYING TO
*  RELEASE A RELEASED GRANULE LATER.
         SPACE
         AI,R3    1                 INCREMENT DISPLACEMENT
         AND,R3   BUFMASK,R1        LOOK FOR WRAPAROUND
         PUSH     5,1
         BAL,11   CMNRG             RELEASE A GRANULE/CYL ETC.
         PULL     5,1
         AI,R8    0                 RESET THE CC
         BNEZ     EMP3              CONTINUE IF WE GOT ONE
         BAL,R11  LOGERR            LOG AN ERROR
EMP3     EQU      %
         BDR,R2   EMPTY1            CONTINUE EMPTYING
         STW,11   J:BASE            SET DATA MODIFIED FLAG
         LI,R5    X'4000'           FLAG TO SHOW
SETFLAG  STH,R5   BUFLAGS,R1        SET NEW FLAG(S)
AVG:ADJ  EQU      NEXTBUF
         B        NEXTBUF           CONTINUE ALONG
         PAGE
*
*        FILL BUFFER TO OPTIMUM LEVEL
*
FILL     RES
         SH,2     HILEVEL,1         CALCULATE HOW MANY TO ADD
         LH,R3    BOTTOM,R1         MOVE TEMPBOT DOWN
         AW,3     2                 2 IS NEGATIVE
         AND,R3   BUFMASK,R1        LOOK FOR WRAPAROUND
         STH,R3   TEMPBOT,R1        NOW WE CAN ENABLE
         LW,R4    CATBUF,R1         GET LOC OF BUFFER
         ENABLE
         LH,3     BOTTOM,1          FILL DOWN FROM THE BOTTOM
FILL1    PUSH     4,1               SAVE REQUIRED REGS
         BAL,11   CMNGG
         PULL     4,1
         AI,R8    0                 RESET THE CC
         BNEZ     FILL2             GOT ONE
         LI,R5    X'A000'           EMPTY/JUST FILLED
         STH,R3   TEMPBOT,R1        TELL SWAPPER WHERE WE STOPPED
         B        SETFLAG           AND GIVE UP ON THIS ONE
FILL2    AI,R3    -1                BACK UP ONE FOR NEXT SPOT TO FILL
         AND,R3   BUFMASK,R1
         STW,R8   *R4,R3            PUT IT IN PLACE
         STW,11   J:BASE            SET DATA MODOFIED FLAG
         MTH,1    ADJSTCNT,R1       INCREMENT WORD COUNT
         BIR,2    FILL1             ADD ANOTHER ONE
         LI,R5    X'2000'           JUST FILLED FLAG
         B        SETFLAG           PUT IT IN AND CONTINUE
         PAGE
*
*F*      NAME: GETN
*F*      PURPOSE: ALLOCATE N CONTIGUOUS GRANULES.
GETN     EQU      %
         LB,R0    R15               DEV TYPE INTO REG 0
         AND,R15  M24               REMOVE GARBAGE FROM #
         PSW,R1   TSTACK            SAVE COMM BUF NUMBER
         AI,R0    X'80'             TRY CYL FIRST
         BAL,11   CMNGNG            GET THE GRANS OR CYLS
         BNE      %+3
         AND,R0   M4                THEN TRY GRAN DEVICES
         BAL,11   CMNGNG
         PLW,R1   TSTACK            RESTORE BUFFER NUMBER
         STW,R8   COMBUF+1,R1       PUT THE DA AWAY
         STW,15   COMBUF,1          SET # ALLOCATED
         AI,R8    0                 SET DATA MODIFIED IF WE GOT SOMTHING
         BEZ      ENDYET1
         B        ENDYET            LEAVE MSG SITTING WHERE IT IS
         PAGE
*
*F*      NAME: RELN
*F*      PURPOSE: RELEASE N CONTIGUOUS GRANULES OR CYLINDERS.
*
RELN     EQU      %
         LW,R8    R15               PUT # TO REL IN R 8
         AND,R8   M24               MASK OFF THE GARBAGE
         PUSH     R8                REMEMBER DISK ADDRS IN STACK
         LW,R15   COMBUF,R1         GET # TO RELEASE
         AND,R15  M16               REMOVE GARBAGE
         BAL,R11  FCB               RELEASE COMBUF ENTRY NOW
         BAL,11   CMNRNG
         PULL     R5                RESTORE D/A TO REG#5
         AI,R8    0                 RELEASE GO OK
         BNEZ     ENDYET            YES, GO ON
         BAL,R11  LOGERR            WAS NOT OK
         B        ENDYET            ALL DONE
         PAGE
*
*F*      NAME: GSBP
*F*      PURPOSE: ALLOCATE A SEPARATED PAIR FOR DIRECTORIES.
*
*
GSBP     EQU      %
         PUSH     1                 SAVE COMBUF ADDRESS
         LW,1     COMBUF+1,1        GET DEVICE TYPE FOR FIRST
         SLS,1    -24-3             AS STACK INDEX
         LW,9     GSBP3,1           GET PROPER DEV TYPE SEQUENCE
GSBP1    LI,11    GSBP2             SET RETURN FROM GET GRAN
         DISABLE                    DONT LET ANYBODY STEAL THE LAST STACK GRAN
         LH,0     WORDCNT,1         GET FROM STACK IF THERE'S ANY THERE
         BEZ      CMNGG             NONE, GET FROM BITMAP
         LB,0     GSBP4,1           SET DEVICE TYPE FOR GBG
         BDR,1    GCYL              GET CYL IF 1 WAS 3
         B        GBG
GSBP2    BNEZ     GSBP5             GOT ONE
         SLS,9    8                 TRY NEXT TYPE
         LB,1     9                 IF THERE IS PNE
         BDR,9    GSBP1
         B        GSBP5             NONE ANYWHERE..EXIT UNHAPPY
GSBP3    DATA,1   0,1,3,255         RAD -> PACK -> CYL -> GIVE UP
         DATA,1   1,0,3,255         PACK -> RAD -> CYL -> GIVE UP
GSBP4    DATA,1   7,11,0,X'8B'      DEVICE TYPES BY STACK #
GSBP5    LW,1     *TSTACK           GET COMBUF INDEX
         STW,8    COMBUF,1          SAVE FIRST ADDRESS
         BAL,11   HGPCNT            MAKE SURE EMPTY BITS ARE ACCURATE
         BAL,3    FNDHGP            GET HGP ADDRESS IN 7, DCTX IN 5
         BEZ      GSBP14            NONE ANYWHERE, GIVE UP
         LB,3     DCT2,5            CHANNEL #
         LI,8     0                 NOW SEARCH FOR A DEVICE FOR SECOND GRAN
*        ON PACK -> RAD -> OR CYL TYPE,
*        BUT DIFFERENT CHANNEL OR AT LEAST DIFFERENT DEVICE
         LW,0     =X'8B070B'
         LI,1     -1                INITIALIZE BEST HGP ADDRESS
GSBP6    LI,6     6                 DISP TO DEVICE TYPE
         LI,7     HGP               START OF HGPS
GSBP7    CB,0     *7,6              IS THIS THE RIGHT TYPE
         BNE      GSBP9             NO, TRY THE NEXT ONE
         MTW,0    6,7               IS THERE ANY PFA LEFT HERE
         BLEZ     GSBP9             NO...
         LW,4     1,7               GET DCT INDEX
         SLS,4    -16
         CB,3     DCT2,4            IS THIS THE SAME CHANNEL
         BNE      GSBP8             GOT A GOOD ONE
         OR,7     Y4                SET SAME CHANNEL FLAG
         LC       1                 AND CHECK PREVIOUS FLAGS
         BCR,4    GSBP9             THEY WERE BETTER
         CW,4     5                 IS THIS THE SAME DEVICE
         BNE      GSBP8             NO...TAKE IT
         BCR,8    GSBP9             YES.. BUT WEVE GOT A DIFFERENT ONE ALREADY
         OR,7     Y8                SET SAME DEVICE FLAG
GSBP8    STW,7    1                 UPDATE CURRENT BEST TRY
GSBP9    LW,7     0,7               HAVE WE SEARCHED THE WHOLE CHAIN
         BNEZ     GSBP7             NO, TRY THIS ONE
         CI,1     -1                DID WE GET ANYTHING
         BNE      GSBP10            YES...GET A GRANULE THERE
         SLS,0    -8                NO, TRY NEXT DEVICE TYPE
         AI,0     0                 IF THERE ARE ANYMORE
         BNEZ     GSBP6
         B        GSBP11            NONE..TRY STACKS
GSBP10   LI,7     X'1FFFF'          GET HGP ADDRESS FOR DESIRED DEVICE
         AND,7    1
         BAL,11   DCTGG             GET A GRAN BY DCT
GSBP11   BNEZ     GSBP14            GOT ONE
         LW,9     GSBP3+1           GET CHOICE SEQUENCE
GSBP12   LI,11    GSBP13
         LB,1     9                 NEXT TYPE
         DISABLE
         MTH,0    WORDCNT,1
         BEZ      GSBP13
         BDR,1    GCYL
         B        GBG
GSBP13   BNEZ     GSBP14            GOT ONE, FINALLY
         SLS,9    8
         BDR,9    GSBP12            TRY AGAIN
GSBP14   PLW,1    TSTACK            SAVE RESULTS IN COMBUF
         STW,8    COMBUF+1,1
         B        *10
         PAGE
*
*        THE STACK COUNT IS INVALID
*
*S*      SCREECH CODE: 87-00
*S*      REPORTED BY: ALLOCAT
*S*      MESSAGE: ALLOCATION BUFFER CONTAINS INVALID WORDCOUNT
*S*      REGISTERS: R2=INVALID COUNT (NEGATIVE)
*S*                 R1=BUFFER INDEX
ALLYERROR   SCREECH    X'87'
         PAGE
*
*        RELEASE BUFFER BACK TO FREE CHAIN
*
*
*
*
FCB      DISABLE
         LW,R3    R1                BUFFER INDEX IN R1
         AI,R3    COMBUF            CORE ADDRESS
         LB,R5    CBFHD             CURRENT FREE HEAD
         STB,R5   *R3               LINKED INTO FREE CHAIN
         STB,R1   CBFHD             LEAVE CURRENT AS NEW FREE HEAD
         ENABLE
         B        *R11
         PAGE
*
*F*      NAME: RELBUF
*F*      PURPOSE: RELEASE A LIST OF DISC ADDRESSES (IN PAGE OF MEMORY).
*
RELBUF   BAL,R11  FCB               FREE UP COMBUF
         STH,15   6                 GENERATE CVMCAL
         SLS,6    -7                WA PHYS PAGE
         MTB,7    6
         LI,7     CVMPAGE
         CAL1,8   6                 MAP INTO IT
         LW,7     CVMPAGE+1         # OF DISC ADDRESSES
RELBUF1  LI,8     0
         XW,8     CVMPAGE+3,7       GET/ZAP ADDRESS
         PUSH     7                 SAVE COUNTER
         BAL,11   CMNRG
         PULL     7
         BDR,7    RELBUF1
         STD,7    CVMPAGE
CVMPAGE  EQU      X'1FE00'          USE LAST VIRTUAL PAGE
         B        ENDYET
         PAGE
*F*      NAME: FILLPER
*F*      PURPOSE: RELEASE ALL ALLOCATED SYMBIONT SPACE.
         SPACE    3
FILLPER  EQU      %
         BAL,R11  FCB               GO AHEAD AND RELEASE BUFFER
         LI,R1    2                 SYMBIONT STACK POINTER
         DISABLE
         LI,R8    -1                RESET EM ALL
         LI,R7    HGP
FP1      LW,R6    4,R7              # OF PER WORDS
         LH,R6    R6
         BEZ      FP2               BRANCH IF NONE
         AI,R6    -1                DONT SET LAST WORD
*                                   MAY NOT BE
*                                   COMPLETELY FULL
         INT,4    5,7               START OF PER
         AW,4     7
         AI,4     -1
         STW,8    *4,6
         BDR,R6   %-1
FP2      LW,R7    0,R7
         BNEZ     FP1
         LI,R0    0                 RESET PER WORD
         LW,7     CATBUF,R1         ZAP THE BUFFER
         LH,6     BUFMASK,R1
         STW,R0   *7,6
         BDR,6    %-1
         STW,R0   0,7
         STH,R0   WORDCNT,R1
         STH,R0   TEMPBOT,R1
         STH,R0   ADJSTCNT,R1
         STH,R0   BUFLAGS,R1
         STH,R0   BOTTOM,R1
         STW,R0   SGB               #SYMB GRANS BUSY RESET
         STH,R0   TOP,R1            'TOP' TO 'BOTTOM'
         ENABLE
         BAL,R11  HGPCNT            RESTORE GRANULES AVAILABLE TABLES
         B        ENDYET            DO NEXT COMBUF
         PAGE
*  BRANCH VECTOR TABLES
         SPACE    3
COMVEC   B        GETN
         B        RELN
         B        GSBP
         B        ENDYET1
         B        RELBUF
         B        QUIESCE
         B        FILLPER
         B        ENDYET
         B        COUNTBITS
         PAGE
*
*        IF A COMBUF ENTRY CODE OF '08' IS PASSED, ALLYCAT
*        WILL COUNT UP THE BITS IN ALL OF THE HGPS AND SET
*        AGRAVAIL AND GRAVAIL UP. THE KEYIN 'DISP DISC'
*        SHOULD TRIGGER THIS FUNCTION.
*
COUNTBITS BAL,R11 FCB               GO AHEAD AND RELEASE BUFFER
          BAL,R11 HGPCNT            COUNT UP BITS
          B       ENDYET            DO NEXT BUFFER
         PAGE
*
*        GET NEXT ENTRY ON ALLYCAT'S CHAIN, TAKE ITS
*        FLINK AND LEAVE IT AS NEXT ON CHAIN
*
GBUF     DISABLE                    LEAVE US INTERACTIVE W/SYMBIONTS
         LB,R4    CBAHD             GET HEAD
         BEZ      ADJBUFS           NONE, START LOOKING AT D/A TABLES
         LW,R1    R4                RETURN IT IN R1
         AI,R4    COMBUF
         LB,R4    *R4               GET ITS FLINK
         STB,R4   CBAHD             LEAVE IT AS NEXT ONE
         ENABLE
         B        0,R7              AND EXIT
         PAGE
         SPACE    3
LOGERR   PUSH     7,R5              SAVE THE REGISTERS
         LI,R6    8                 ADDRESS OF ERR MSG
         AW,R6    Y2                SET FLAG FOR ERHNDLR
         LW,R8    =X'24040000'      ERR MSG CODE/COUNT
         LW,R10   R5                GET DISC ADDRESS IN ERROR
         LW,R11   ='ACAT'           FLAG FOR ERROR RECORD
         BAL,R5   ERRLOG            WRITE THE ENTRY
         PULL     7,R5              RESTORE THE REGISTERS
         B        *R11              AND RETURN
         PAGE
*  ALL BUFFERS HAVE BEEN ADJUSTED... THIS IS THE EXIT.
         SPACE    3
NOMORE   LW,0     GRAVAIL
         AW,0     GRAVAIL+1
         AW,0     GRAVAIL+3
         CW,0     GRANMIN
         BGE      NOPURGE
         LD,0     BACKUP
         BAL,10   T:GJOBSTRT
NOPURGE  LW,0     UB:SWAPI          GET SWAPI OF RBBAT
         LW,2     UH:JIT+1          AND JITDA
         STH,0    2
         INT,3    UH:AJIT+1         ALSO AJIT
         STD,2    SAMSJIT
         LI,10    ALLOCAT           RETURN FROM WAIT
WAIT     EQU      %
         LI,R0    X'7FFFF'
         STW,R0   U:MISC+2          AND RESTORE VALUE
         LI,R0    2
         STW,R0   ALLOOUT
         BAL,R6   CHKSUM            COMPUTE NEW CHECKSUM
         BAL,9    WRITEDUAL         MAKE COOPY
         LI,R6    E:SL
         BAL,11   T:REG             SLEEP FOR A BIT
         MTW,0    LFGUN             LET FIX RUN FIRST
         BLZ      %-2
         BAL,R6   CHKSUM            DO WE HAVE A GOOD COPY
         BE       *R10              YES, RETURN
         BAL,R9   READDUAL          NO, TRY THE BACKUP
         LI,R6    M:XX              WAIT FOR COMPLETION
         BAL,11   IOSPIN
         BAL,R6   CHKSUM
         BE       *R10              GOT A GOOD ONE
SC8910   RES
*S*      SCREECH CODE 89-10
*S*      REPORTED BY: ALLOCAT
*S*      MESSAGE: ALLOCAT DATA CHECKSUM ERROR
*S*      TYPE: SCREECH
         SCREECH  X'89',16
         SPACE
         SPACE    3
CHKSUM   EQU      %
         LI,R5    0                 CLEAR OLD, TEST AFTER
         LI,R2    HGP               CHECK THE CHAIN OF HEADERS
         LI,R3    ALLOCHKS
CHKLCHK  LW,R4    0,R2              CHEK END OF CHAIN
         BEZ      CHKLOK            ALL DONE
         CLR,R2   0,R2
         STW,R4   R2                FLINK
         BCR,1    CHKSERR           NO GOOD, TOO BIG
         BCS,8    CHKLCHK           MUST BE BETWEEN THIS ONE ANS THE END
         B        CHKSERR           BADDIE
CHKLOK   RES
         XW,R5    ALLOCHKS
         LI,R1    HGP               START OF DATA
         LI,R3    -1                MASK TO ADD ALL 32 WORDS
         LI,R4    ALLODSZ
         SLS,R4   -7                NUMBER OF 128 WORD BLOCKS TO CHECKSUM
KRD4     CVA,R2   0,R1              ADD UP 32 WORDS
         AWM,R2   ALLOCHKS
         CVA,R2   32,R1
         AWM,R2   ALLOCHKS
         CVA,R2   64,R1
         AWM,R2   ALLOCHKS
         CVA,R2   96,R1
         AWM,R2   ALLOCHKS
         AI,R1    128               POINT TO NEXT 128 WORD BLOCK
         BDR,R4   KRD4
         STW,R2   ALLOCHKS          LAST IS THE REAL TOTAL
CHKSERR  CW,R5    R2                CHECK WITH PREVIOUS
         B        *R6
         PAGE
WRITEDUAL LW,R8   Y06               SET WRITE CODE IN 8
         LI,R6    0                 CLEAR/TEST DATA MODIFIED FLAG
         XW,R6    J:BASE
         BEZ      *R9               NOTHING TO DO
         B        %+2
READDUAL LI,R8    0                 READ CODE
         AI,R8    M:XX              DCB FOR IO
         LW,R7    ALLODDA           DISC ADDRESS
         BLEZ     *R9               NOTHING TO DO
         LI,R6    HGP-X'2000'       ADDRESS OF FIRST PIECE LESS INCREMENT
         STW,R6   M:XX+7            SET IN DCB
         LI,R6    ALLODSZ           SIZE OF DATA
         BAL,11   %+1               SET RETURN FOR QUEUE FOR BIG PIECES
         STW,R7   M:XX+8            SET DISC ADDR IN DCB
         LW,R1    =X'1002000'       INCREMENT ADDR/FCN
         AWM,R1   M:XX+7
         AI,R6    -X'2000'          IS THIS THE LAST OIECE
         BGZ      %+3
         LW,11    R9                YES, RETURN TO CALLER
         SLS,R6   19                AND SET PROPER SIZE
         STW,R6   M:XX+6
         AI,R7    X'21'             INCREMENT DISC ADDRESS FOR NEXT PIECE
         B        QUEUE
*  DATA
         SPACE    3
SYS      GEN,8,24      8,0
         BOUND    8
BACKUP   TEXTC    'FILL'
         SPACE    3
         END      ALLYCAT

