         PCC      0
         TITLE    '**** GRAN ****'
*M*      GRAN     RESIDENT PUBLIC GRANULE ALLOCATION CODE
         DEF      GRAN:             FOR PATCHING
GRAN:    RES
BITS     SET      1
DISCBPROC SET     1
         SYSTEM   UTS
         PAGE
*        DEFS
         DEF      ALLOQ             SEND MESSAGE TO ALLOCAT
         DEF      ALLOREG           QUEUE CURRENT USER FOR ALLOCAT
         DEF      ALLODDA           DUAL D.A. FOR ALLOCAT DATA
         DEF      DSCCVT            CONVERT GDA TO SEEK ADDRESS
         DEF      FNDHGP            GET HGP ADDRESS GIVEN GDA
         DEF      GBG               PULL GDA FROM PACK/RAD BUFFER
         DEF      GCYL              PULL GDA FROM CYL BUFFER
         DEF      GNBG              GET PUBLIC RANDOM FILE
         DEF      GSBP              GET DIRECTORY PAIR
         DEF      GSG               PULL GDA FROM SYMBIONT BUFFER
         DEF      RBG               PUT GDA IN PACK/RAD BUFFER
         DEF      RCYL              PUT GDA IN CYL BUFFER
         DEF      RNBG              RELEASE RANDOM FILE
         DEF      RNCYL             RELEASE RANDOM FILE
         DEF      RSG               PUT GDA IN SYMBIONT BUFFER
         PAGE
*        REFS
         REF      BOTTOM            ALLYCATS BOTTOM
         REF      BUFLAGS           EMPTY FLAG
         REF      BUFMASK           FOR WRAPAROUND
         REF      CATBUF            BUFFER ADDRESS
         REF      CBAHD             COMBUF CHAIN
         REF      CBFHD             COMBUF CHAIN
         REF      CHKDAQ            CHECK GDA
         REF      COMBUF            COMBUF ADDRESS
         REF      CYL%SHFT          POSITION CYL IN SEEK FORMAT
         REF      DCTSIZ            MAX DEVICE #
         REF      DCT22             INDEX INTO TABLES
         REF      DCT23             HGP DISPLACEMENT
         REF      DISCLIMS          MAX SECTOR #
         REF      E:QFAC            QUEUE FOR ALLOCAT EVENT
         REF      ERRLOG            LOG BAD GDAS
         REF      HGP               HGP BASE ADDRESS
         REF      HITHRSH           CALL ALLOCAT IF TOO FULL
         REF      J:JIT             DONT QUEUE UNMAPPED CALLERS
         REF      LOTHRSH           CALL ALLOCAT IF TOO EMPTY
         REF      NSPC              CALCULATE CYL# FOR SEEK
         REF      NSPT              CALCULATE TRACK# FOR SEEK
         REF      S:CUN             IDENTIFY CALLER IN COMBUF
         REF      SEC%SHFT          POSITION SECTOR IN SEEK FORMAT
         REF      SGB               COUNT SYMBIONT GRANULES BUSY
         REF      SGL               MAX SYMBIONT PFA THEFT
         REF      T:ABORTM          ABORT TOO BIG LOCKED REALTIME JOB
         REF      T:GJOBSTRT        WAKE UP ALLOCAT
         REF      T:REG             QUEUE CORRENT USER
         REF      TEMPBOT           BOTTOM OF BUFFER
         REF      TIME              TO LOG ERRORS
         REF      TOP               TOP OF BUFFER
         REF      TRK%SHFT          POSITION TRACK IN SEEK FORMAT
         REF      UH:FLG2           LOCKED IN CORE FLAG
         REF      WORDCNT           # ENTRIES IN BUFFER
         REF      SH:STEAL          IF NOT ZERO, ALLOWS PFA STEALING
         PAGE
*        SREFS
         SREF     RTSIZE            CHECK THAT ALLOCAT CAN BE SWAPPED IN
FLG:LIC  EQU      X'800'            UH:FLG2 MASK: LOCKED IN CORE
ALLODDA  DATA     0                 ALLOCAT DUAL D.A. ..NEG => NO COPY
RTERR    DATA     X'070000B8'       ABORT CODE: DEADLY EMBRACE
*                                               POSSIBILITY EXISTS
         PAGE
*
*        REGISTER ASSIGNMENTS
*
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: GSG,RSG,GBG,RBG,GCYL,RCYL
*F*      PURPOSE: Enter or remove one word from incore allocation buffer.
RSG      LI,R2    1                 SET RELEASE FLAG
         B        GSG1
GSG      LI,R2    0                 SET GET FLAG
         LW,R0    =X'8B0B0700'      PER,RAD,PACK,CYL
         LI,1     1
         MTH,0    SH:STEAL,1        IS PFA STEALING ALLOWED AT ALL
*        BEZ      GSG1              NO.(REMOVE '*' WHEN SH:STEAL...
*                                   IS HANDLED BY RECOVERY.
         LW,R1    SGB
         CW,R1    SGL               #BUSY VS #LEFT
         BL       %+2
GSG1     LI,R0    0                 NO MORE PFA SWALLOWING
         LI,R1    2
         AW,R2    Y2                SET SYMBIONT CALLING SWITCH
         B        GR0
GCYL     LI,R2    0
GCYL1    LI,R0    0
         LI,R1    3
         B        GR0
RCYL     RES
RBG      LI,R2    1                 RELEASE FLAG
         BAL,R3   FNDHGP            GET HGP ADDRESS
         BEZ      *R11              ERROR RETURN
         LW,R0    1,7               GET DEV TYPE OUT OF IT
         STB,R0   R8                SET CYLINDER SIZE TOO
         SLS,R0   -8
         B        GBG1
GBG      LI,R2    0                 GET FLAG
GBG1     LW,R1    R0                GET DEVICE TYPE INTO 1
         AND,R1   M4                MASK
         SLS,R1   -3                R1 EQUAL STACK #
         CI,R0    X'80'             IF CYLINDER, USE ITS STACK
         BAZ      %+2
         LI,R1    3
GR0      PUSH     6,R2              MUST PRESERVE THESE MINIMUM
         BAL,R7   GETREL            GO DO OPERATION
         PULL     6,R2
         CI,R2    1                 WAS THIS A RELEASE
         BANZ     GETOUT1           YEP, CLEAR OUT
         AI,R8    0                 RESET...
         BNEZ     GETOUT            NO
         SLS,R0   -8                NEXT DEVICE TYPE...
         CI,R0    0
         BNE      GBG1
GETOUT   AND,R0   M4
GETOUT1  AI,R8    0                 SET CC'S
         B        *11
         PAGE
*
*        LOG A BAD DISC ADDRESS ERROR RECORD
*
RELERR   LW,R1    =X'24040000'      SET UP ERROR LOG
         LW,R2    TIME              MSG FORMAT
         LW,R3    R8                DISC ADDRESS
         LW,R4    R11               CALLER'S ADDRESS
         LI,R6    R1                LOCATION OF MSG
         LI,R5    RELX              EXIT RETURN POINT
         B        ERRLOG            LOG THE ERROR
         PAGE
*
*        IF 'RELEASE' CALL CHKDAQ TO EXAMINE THE DISC ADDRESS.
*        IF ITS BAD, RECORD AN ERROR LOG MSG AND RETURN TO
*        THE CALLER. IF A GET GO TO 'GETGRAN'
*
GETREL   CI,R2    1                 DO A GET OR RELEASE
         BAZ      GETGRAN           GET IF ZERO
         CI,R8    0                 IGNORE IF D.A. IS 0
         BE       0,R7
         CI,R8    1                 IGNORE IF ODD
         BANZ     0,R7              SECTOR
         BAL,R6   CHKDAQ            AND CHECK D.A.
         BEZ      RELERR            SOFTWARE CHECK IF BAD
*
*        RELEASE
*
         DISABLE
         LH,4     TOP,1
         CH,4     TEMPBOT,1
         BNE      ROOM
         LH,R5    WORDCNT,R1        GET COUNT IN BUFFER
         BEZ      ROOM              ROOM IF BUF EMPTY
         LW,R0    J:JIT             IS THIS A USER EVENT
         BNEZ     NORELROM          YES - GO ON INTO COMBUFS W/DA
*
*        SINCE THIS IS A SYMBIONT CALLING - ONLY PUT D/A
*        INTO COMBUFS IF THERE IS A FREE CHAIN PRESENT RIGHT NOW
*
         LB,R0    CBFHD             IS THERE A FREE CHAIN PRESENT
         BNEZ     SYMBREL           YES, PUT D/A AWAY IN COMM. BUFS
RELX     LI,R8    0                 IF ALL ELSE FAILS
         ENABLE
         B        0,R7              GET OUT
         PAGE
*
*        NO ROOM IN BUFFER TO RELEASE A DISC
*        ADDRESS, PUT D/A IN COMBUF.
*
SYMBREL  MTW,-1   SGB               DECREMENT BUSY COUNT FOR SYMBIONTS
NORELROM EQU      %
         LW,R3    R8                DISC ADDRESS TO R3
         LI,R2    X'10001'          COMM. TYPE TO R2
         B        QUEMSG
         PAGE
*
*        GOT ROOM IN BUFFER TO PLACE A RELEASED
*        DISC ADDRESS.
*
ROOM     EQU      %
         LW,R6    CATBUF,R1         GET ADDRESS OF TABLE
         STW,R8   *R6,R4            PUT AWAY DISC ADDRESS
         AI,R4    1                 INCREMENT TO NEXT SLOT IN TABLE
         AND,R4   BUFMASK,R1        LOOK FOR WRAP-AROUND
         STH,R4   TOP,R1            AND SAVE
         MTH,1    WORDCNT,R1        BUMP COUNT NOW IN BUFFER
         ENABLE
         B        CHKTHRSH          CHECK THRESHOLDS
         PAGE
*
*        GET A GRANULE, IF WE CAN'T--CALL THE CAT
*        AND REG THE USER. IF IT IS A SYMBIONT REQUEST
*        TELL THEM THERE IS NONE.
*
GETGRAN  EQU      %
         DISABLE
         LH,R4    TEMPBOT,1         DONT USE ONES THAT ALLYCAT WILL TAKE
         SH,R4    BOTTOM,1
         AND,R4   BUFMASK,1
         SH,R4    WORDCNT,1
         BLZ      GETONE
         MTW,0    J:JIT             IS THIS A MONITOR CALL
         BEZ      RELX              YES,RETURN
         MTH,0    BUFLAGS,1         NOT MONITOR IS HGP EMPTY
         BLZ      RELX              YES, EXIT
REG4CAT  LI,R4    GETGRAN           CANT SWITCH - LETS REG HIM...
         B        REGUSER           AND TRY AT A LATER TIME
GETONE   LH,R4    TOP,R1            GET INDEX OF NEXT TO GET
         AI,R4    -1                OK, DECREMENT INDEX TO BUFFER
         AND,R4   BUFMASK,R1        LOOK FOR WRAPAROUND
         STH,R4   TOP,R1
         MTH,-1   WORDCNT,R1        UPDATE WORD COUNT
         AW,R4    CATBUF,R1         GET CORE ADDRESS OF SLOT
         LI,R8    0                 NOW RESET
         XW,R8    0,R4              AND GET THE CONTENTS OF THE SLOT
         ENABLE
*                 *
*        *        *        *
*         *       *       *
*          *      *      *
*           *     *     *
*            *    *    *
*             *   *   *
*              *  *  *
*               * * *
*                 *
         PAGE
*
*        IF THIS WAS A SYMBIONT OPERATION, MAINTAIN
*        COUNTERS 'SGB' UP OR DOWN.
*
*
CHKTHRSH EQU      %
         LC       R2                CHECK FOR SYMBIONTS
         BCR,2    CHKTHRSH1         NOT SYMBIONT PASS...
         EXU      RQLDGAS,R2        MANIPULATE CELLS UP/DOWN
CHKTHRSH1 EQU     %
         LH,R2    WORDCNT,R1        GET CURRENT LEVEL IN BUFFER
         CH,R2    HITHRSH,R1        COMPARE TO HIGH
         BGE      THRESH            NEEDS TO COME DOWN
         CH,R2    LOTHRSH,R1        COMPARE TO LOW
         BG       0,R7              RIGHT ON
         LH,R5    BUFLAGS,R1        CHECK FLAG
         BLZ      0,R7
         B        THRESH            CALL THE CAT
RQLDGAS  MTW,+1   SGB               ON A GET RING UP ONE BUSY
         MTW,-1   SGB               ON A REL RING DOWN ONE LESS BUSY
         PAGE
*
*F*      NAME: GNBG
*F*      PURPOSE: Call ALLOCAT to allocate a random file.
*
GNBG     PUSH     8,R0
         LI,R2    0                 SET FLAG FOR 'N' GRANULES GET
GETN     AW,R2    S:CUN             PUT USER # INTO FLAG CELL
         LW,R3    R15               GET COUNT IN R3
         BAL,8    GETN0             GO GET EM
         BAL,0    %+1
         LW,8     1,1               DISC ADDRESS COMES BACK IN W 1 OF BUFFER
         LW,15    0,1
         B        *0
GETN0    EQU      %
         STB,R0   R3                PUT IN DEV TYPE
         BAL,R7   QUEMSG            PUT MSG AWAY
         BAL,R7   RTCHK             CHECK FOR POSSIBLE DEADLY EMBRACE
         BAL,R4   REGUSER1
         CD,R2    *R0               WAIT FOR REPLY FROM ALLYCAT
         BE       REGUSER           KICK HIM TIL HE DOES SOMETHING
         LW,R1    R0                COMBUF ADDRS TO R0
         EXU      *8                GET THE RESPONSE
         BAL,R5   RALLOQ            FREE THE BUFFER
GETN1    PULL     8,R0              RESTORE WORK AREA
         AI,R8    0                 SET CC'S
         B        *R11              AND EXIT
         PAGE
*
*F*      NAME: RNBG,RNCYL
*F*      PURPOSE: Call ALLOCAT to release a random file.
*
RNCYL    EQU      %
RNBG     PUSH     8,R0
         LI,R2    X'10000'          FLAG TO RELEASE 'N' GRANS
         AW,R2    R15               PUT # TO RELEASE IN R2
         STW,R8   R3                PUT DISC ADDRESS INTO R3
         BAL,R7   QUEMSG            PUT MSG AWAY
         B        GETN1             AND GET OUT OF HERE
         PAGE
*
*F*      NAME: GSBP
*F*      PURPOSE: Call ALLOCAT to allocate a directory granule pair.
*
GSBP     EQU      %
         PUSH     8,0               SAVE REGS
         LI,2     X'20000'          GSBP CODE FOR ALLOCAT
         BAL,8    GETN0             GO GET EM
         LD,8     *1                GET RESPONSE
         PAGE
*
*        BLOCK THIS USER UNTIL ALLYCAT HAS RUN
*
REGUSER  EQU      %
         PUSH     R7                SAVE...
         BAL,R7   RTCHK             CHECK FOR POSSIBLE DEADLY EMBRACE
         BAL,R7   THRESH            START THE GHOST NOW
         PULL     R7                RESTORE...
REGUSER1 EQU      %                 ENTRY FOR NO GJOBSTART
         PUSH     R11               SAVE R11
         LI,R6    E:QFAC            SET EVENT CODE
         BAL,R11  T:REG             REPORT EVENT/GIVE UP
         PULL     R11               RESTORE R11
         B        0,R4
         PAGE
*
*        GET A COMBUF AND PLACE MSG IN IT FOR ALLYCAT, R2/R3
*        HAVE MESSAGE TO GO INTO COMMUNICATION BUFFER
*
*        NOTE:    R0 RETURNS MSG ADDRESS (IN COMBUF)
*
QUEMSG   DISABLE
         LB,R0    CBFHD             GET HEAD OF FREE BUFFERS
         BNEZ     ALLOQWB
         ENABLE
         MTW,0    J:JIT             IF MONITOR, GIVE UP
         BEZ      0,7
         BAL,R4   REGUSER           BLOCK THE USER
         B        QUEMSG            LOOP UNTIL ONE GOES FREE
ALLOQWB  LW,R5    R0                MOVE FREE HEAD INDEX TO R5
         AI,R5    COMBUF            CALCULATE CORE ADDRESS OF FREE
         LB,R5    *R5               GET NEXT IN THE FREE CHAIN
         STB,R5   CBFHD             MAKE IT THE CURRENT FREE
         LB,R5    CBAHD             GET NEXT ON ALLYCATS CHAIN
         STB,R0   CBAHD             PUT OURS INTO ALLY'S CHAIN
         AI,R0    COMBUF            MAKE OURS A CORE ADDRESS
         STB,R5   R2                PUT IN LINK INTO MSG
         STD,R2   *R0               AND STORE MSG INTO COMBUF
         ENABLE
THRESH   EQU      %
         PUSH     14,R7
         LD,R0    TALLOCAT
         BAL,10   T:GJOBSTRT
         PULL     14,R7
         B        0,R7
         BOUND    8
TALLOCAT TEXTC    'ALLOCAT'
         PAGE
*
*        RELEASE COMM BUFF ADDRESS IN R1
*
RALLOQ   EQU      %                 RELEASE COM BUF
         DISABLE
         LB,2     CBFHD             FREE HEAD
         STB,2    *1                HEAD TO THIS BUF
         AI,1     -COMBUF
         STB,1    CBFHD             THIS BUF TO HEAD
         ENABLE
         B        0,R5
*
*
*
RTCHK    EQU      %                 BAL ON R7 TO CHECK FOR POSSIBLE
*                                   DEADLY EMBRACE...R6 DESTROYED
         LW,R6    S:CUN
         LH,R6    UH:FLG2,R6
         CI,R6    FLG:LIC           IS USER 'LOCKED'? (REAL-TIME)
         BAZ      0,R7              NO
         PUSH     9,R15             SAVE VULNERABLE REGISTERS
         LI,R4    2                 ALLY'S USER #
         BAL,R6   RTSIZE            GET ALLY'S SIZE
         BCR,1    RTCHKX            IF HE WILL FIT IN AVAILABLE CORE
*E*      ERROR: B8-07
*E*      DESCRIPTION: Locked-in-core user calling ALLOCAT which wont fit.
         LW,R14   RTERR
         B        T:ABORTM          ABORT REAL-TIME USER
RTCHKX   PULL     9,R15             RESTORE VULNERABLE REGISTERS
         B        0,R7              RETURN
         PAGE
*
*F*      NAME: ALLOREG
*F*      PURPOSE: Queue user until next ALLOCAT swapout.
*
ALLOREG  EQU      %
         PUSH     16,R0
         BAL,R7   RTCHK             CHECK FOR POSSIBLE DEADLY EMBRACE
         BAL,R7   THRESH
         LI,R6    E:QFAC
         BAL,R11  T:REG
         PULL     16,R0
         B        *R0
*
*F*      NAME: ALLOQ
*F*      PURPOSE: Send a message to ALLOCAT.
*
ALLOQ    EQU      %
         PUSH     7,R0
         LD,R2    R14               MOVE MSG BACK
         BAL,R7   QUEMSG            ENQUEUE THIS MSG
         PULL     7,R0
         B        0,R4              AND EXIT TO CALLER
*
*        ABOVE ARE EXTERNAL USAGE ROUTINES - - DONT CHANGE
*
         PAGE
*F*      NAME: DSCCVT
*F*      PURPOSE: Convert GDA to seek address.
*K*      GDA = generalized disc address (DCTX + sector number).
*****************************************************************
*
*        DSCCVT
*
*                 THIS ROUTINE WILL CONVERT A INTERNAL DISC ADDRESS
*                 TO A SEEK ADDRESS
*
*        ENTRY POINT:               DSCCVT
*
*        CALLING SEQUENCE:          BAL,R11  DSCCVT
*
*        INPUT:                     R8 = INTERNAL DISC ADDRESS
*
*        OUTPUT:                    R8 = SEEK ADDRESS
*                                   CC = 0 ERROR
*                                   CC NOT = 0  OK
*
*        REGISTERS DESTROYED:       R6,R7,R8,R9
*
****************************************************************
*
*
DSCCVT   EQU      %
         LDCTX,R7  R8               GET DCT INDEX
         BLEZ     CONVERT%ERR       ZERO OR NEGATIVE ERROR
         CI,R7    DCTSIZ            CHECK FOR VALID DCT INDEX
         BG       CONVERT%ERR       INVALID
         LB,R6    DCT22,R7          DISC SUB-TYPE
         BEZ      CONVERT%ERR       INVALID
         LSECTA,R9  R8              GET SECTOR ADDRESS
         CW,R9    DISCLIMS,R6       TEST FOR MAX ON DEVICE
         BL       CONVERT
*
CONVERT%ERR EQU   %
         LCI      0                 SET ERROR RETURN
         B        *11               RETURN
*
CONVERT   EQU       %
          LI,R8     0
          DW,R8     NSPC,R6             REL.SEC./SEC.PER CYL.
          LW,R7     R9                  R7=CLY. NO.
*                                       R8=REMAINDER
          LW,R9     R8                  REMAINDER=<TRACKS&SECTORS>
          LI,R8     0
          DW,R8     NSPT,R6
*                                       R8=SECTOR NO.
*                                       R9=TRACK NO.
          EXU,0     CYL%SHFT,R6         PERFORM CYL. SHIFT
          EXU,0     TRK%SHFT,R6         PERFORM TRK. SHIFT
          EXU,0     SEC%SHFT,R6         PERFORM SECTOR SHIFT
*
*         COMBINE CYL-TRACK-SECTOR TO FORM A SEEK ADDRESS
*
          OR,R8     R7
          OR,R8     R9                  REEL SEEK ADR TO R8
          LCI       3
          B         *R11                RETURN
         PAGE
*F*      NAME: FNDHGP
*F*      PURPOSE: Find HGP address given GDA.
*        RETURNS ADDRESS IN R7
*        LINK R3
*        SETS CC VIA LW,7     7 BEFORE EXITING
*        USES R5,R6
         SPACE    3
FNDHGP   EQU      %
         LDCTX,R7 R8                DCT INDEX TO R7
         CI,7     DCTSIZ
         BLE      %+2
         LI,7     1                 MAKE IT A TTY
         MTB,0    DCT22,R7          CHECK FOR A DISC DEVICE
         BEZ      0,R3              ERROR
         LH,R7    DCT23,R7          HGP DISPLACEMENT
         AI,R7    HGP               CORE ADDRESS
         B        0,R3              EXIT
         END

