MUL      EQU      %
         PCC      0
         DEF      MUL
UTSPROC  SET      1
MONPROC  SET      1
DISCBPROC SET     1                                                     DISCB
         SYSTEM   UTS
         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
         SPACE    2
         LW,R1    R0
         B        %+1,R1
*
         B        MULENT            BUILD MUL
         B        MULENT            RELEASE MUL
         B        OPV               OPEN PRIVATE VOLUME
         B        OPENDEV
         B        T:LDEV            LDEV CAL PROCESSOR
         B        CCLOSE            CLOSE COOP STREAMS
         B        COPOPNLD          FINISH COOP STREAM INITIALIZATION
         SPACE    4
MULENT   PUSH     SR4               SAVE RETURN ADDRESS
         LW,1     CFU,6
         AI,0     %+2
         B        *0
         B        MULMUL
         B        RELMUL
MULRET   EQU      %
MULRRET  EQU      %
         PULL     11
         B        *11
         PAGE
3RDWD    GEN,16,16 MIDIS,0
ALT3RDWD GEN,16,16 MIDIS+36,X'400'
         SPACE    3
         REF      OPV
         REF      Y002
         REF      RBG
         REF      GETBBUF
         REF      CLRBBUF
         REF      PULLEXIT,PULLEXIT1
         REF      YFFFF
         REF      M16
         REF      Y004
         REF      WRTSEC
         REF      REDSECL,GETCSA
         REF      ISEQICR1,Y8
         REF      RWREX,PVQUEUE,IOSPIN,RESBLK
         REF      PRIVDCB
         REF      FNDHGP
         REF      M24
         REF      FMCHKDA
         REF      GETSEC,SETTYC
         REF      T:LDEV,CCLOSE
         REF      COPOPNLD
         REF      ERFILDA
         REF      J:JIT
         REF      PRDCRM
         REF      J:CLS
         PAGE
BLINKUP  LW,D2    DCBCDAM,R6        FOR
         OR,D2    Y8                 FLINK CHK
FLINKUPP STW,D1   DCBCDAM,R6
FLINKUP  PUSH     9,D1
         LW,SR1   D1
         BAL,SR4  FMCHKDA           CHECK DISC ADR FOR VALIDITY
         BCR,15   LINKABRT
         BAL,SR3  RWREX
         BAL,SR4  PVQUEUE
         BAL,SR4  IOSPIN
         BAL,R0   RESBLK
         LW,R3    TSTACK
         LW,R1    -6,R3             BUFFER ADDRESS
         LW,R3    -7,R3
         BGEZ     %+3               FLINKING
         EOR,R3   Y8                RESET BLINKING
         AI,R1    1                 FOR FLINK
         CW,R3    0,R1
         BE       REDSEC1
         LW,R3    TSTACK
         LI,R1    READTOP3
         CW,R1    -4,R3
         BE       REDSEC1
LINKABRT LW,R3    TSTACK
         MTW,1    -4,R3
         LW,SR3   -8,R3
         LI,SR1   7                 75-07
         BAL,SR4  ERFILDA           LOG THE ERROR
*
REDSEC1  PULL     9,D1
         B        *R0
         PAGE
WRTABUF  BAL,SR4  GETDISK           GET NEXT GRANULE'S ADDRESS ON DISK
         LW,R1    CFU,R6
         STW,SR1  BUFF1+1           SET FLINK
         PUSH     SR1               SAVE NEW
         LW,D1    BCDA,R6           SAVE OLD FOR BLINK IN NEW
         BAL,R0   CLRBBUF           DUMP OLD TO DISK
         XW,D1    *TSTACK           GET NEW, SAVE OLD
         STW,D1   BCDA,R6           UPDATE DCB TO NEW
         BEZ      OUTAREL           OUT OF GRANULES
         BAL,R0   GETBBUF           REESTABLISH BUFFER
         PULL     D4                GET NEW BLINK
         BAL,R4   GETDISKI          UPDATE BUFFER GRABBER IF NECESSARY
         STW,D4   BUFF1             SET NEW BLINK
         LI,R2    0                 ASSUME NO MULTI LEVEL RESIDUE
         LC       *R1               CHK ASSUMPTION
         BCR,2    %+2               OK
         LI,R2    -2                BACK INTO STACK
         LW,D1    *TSTACK,R2        SET UP
         STW,D1   BUFF1+2            CONTROL 3RD WORD
         LW,D1    BCDA,R6           CHK
         B        MOVEAKEY
         PAGE
MUL2     LI,1     BASCR
         LB,R0    *R6,1
         AW,R0    3RDWD             INITIALIZE
         PUSH     R0                 CONTROL
         BAL,R0   GETSEC            GET AN MI BUFFER
         LCF      *R1
         BCR,2    MUL6              NO OBSOLETE STRUCTURE
         LW,D1    TDA,R1            GET TOP
         BNEZ     MUL3              OK
MUL101   RES      0
         PULL     R0                BALANCE STACK
         LCI      4
         STCF     *R1               RESET O BIT
         PAGE
MULMUL   RES      0
MULMUL2  LCF      *R1
         BCS,2    MUL2              OBSOLETE STRUCTURE EXISTS
         LI,R2    LSLIDES
         LB,R2    *R6,R2
         AI,R2    -X'FF'
         BEZ      MULRET            WORST BUY
         LI,R0    X'FC'
         AND,R0   0,R1
         BNEZ     MUL2              LEVEL 1 MUST BE CONSTRUCTED
         B        MULRET
         PAGE
MUL3     BAL,R0   READTOP1          READ TOP OF OBSOLETE PYRAMID
         B        MUL4              GOT IT
MUL3A    LW,R1    CFU,R6
         LI,R3    X'FF'
         STS,R3   0,R1              FORCE LEVEL 1
         LCF      *R1
         B        MUL101
MUL4     LW,D1    *D3               CHK BLINK
         BEZ      MUL5              IT'S THE START
         BAL,R0   BLINKUP           BACK UP
         B        MUL4              OK
         B        MUL3A             ABORT
MUL5     RES      0
         LW,SR4   DCBCDAM,R6        1ST GRAN TO BE REUSED
         PUSH     2,SR4
MUL6     RES      0
         LW,R3    FDA,R1            1ST
         STW,R3   TDA,R1             SECTOR
         PAGE
STRTALEV BAL,R0   CLRBBUF           FOR SUCCEEDING TIMES AROUND
         BAL,SR4  GETDISK           1ST GRANULE ON THIS LVL
         STW,SR1  BCDA,R6           SAVE DISK ADDRESS
         AI,SR1   0
         BNEZ     STRT1             WE GOT ONE
         SPACE    3
* OUT OF GRANULES
         LI,D1    X'1C00'
         CW,D1    *TSTACK
         BANZ     OUTA1             LVL 1 HAS BEEN BUILT
*  NO GRANULES AT ALL EXIST FOR THE HIGHER LEVELS
         LI,R0    0                 RESET THE
         STW,R0   TDA,R1             TOP OF PYRAMID
         LI,R0    OUT2CLSE+1        RETURN LINK
         LI,D1    X'C'
         B        SETTYC
         PAGE
STRT1    BAL,R0   GETBBUF           GET A BLKNG BFR
         BAL,R4   GETDISKI          UPDATE GRANULE GRABBER
         LI,D1    X'400'            UP-
         LI,R3    0                  DATE
         STW,R3   BUFF1             1ST BLINK IS ZERO
         LCF      *R1                 LEVEL
         BCR,2    %+2                  COUNTER
         LI,R3    -2
         AW,D1    *TSTACK,R3
         STW,D1   *TSTACK,R3
         STW,D1   BUFF1+2           INITIAL BFR CNTRL WD
         LI,R2    BASLIDES          SET
         LI,R0    1                  SLIDES
         STB,R0   *R1,R2              TO 1
SCC4     RES      0
         LW,D1    BCDA,R6           DISK ADDRESS
         XW,D1    TDA,R1            SET TOP TO 1ST OF THIS LEVEL
         LI,D2    0                 1ST BLINK IS 0
         LI,D3    BUFF2             INDEX BFR
         CW,D1    FDA,R1
         BE       5M0               READ LEVEL 0
5M3      BAL,R0   FLINKUPP          GET 1ST SEC OF PREV UPPER LVL
         B        MOVEAKEY
5M1      LCF      *R1               THROW
         BCR,2    MUL3A              AWAY
         PULL     2,R0                UPPER
         B        MUL3A                LEVELS
5M0      RES      0
         LI,R3    X'200'            SET 'RETURN HERE IF ERROR' FLAG
         STS,R3   J:CLS
         BAL,R0   REDSECL           GET 1ST SECTOR OF PREVIOUS LEVEL
         LI,D1    0
         LW,R4    BUFF2
         BLZ      MV3               ERROR
         BNEZ     MOVEAKEY          NOT FDA
         LW,R4    BUFF2+1
         B        MV2P1             SKIP FDA
         PAGE
MOVEAKEY LI,D4    BUFF2             SOURCE
         LI,D3    BUFF1             DESTINATION
         BAL,R7   COMP              IS THERE ROOM
         BGE      WRTABUF            NO ROOM
         LW,R7    Y004              SET
         STS,R7   BFL,R6             BUFFER UPDATED
         LI,R7    MIDIS
         LB,D1    BUFF2,R7          KEY LENGTH
         LW,R4    BUFF2+2           SKIP IF
         CI,R4    X'1C00'             NOT
         BANZ     MV1                  LEVEL 0
*  LEVEL 0
         AI,D1    0                 CHK ZAPPED
         BNEZ     MVA                 1ST KEY
         LW,D1    R1
         AI,D1    -1                DEFAULT KEY LENGTH
         AW,R7    R1                CHK
         AI,R7    1                  ZERO
         LB,R0    BUFF2,R7            BLDISP
         BEZ      MV1
         AI,R7    12
         CH,R7    BUFF2+2
         BGE      MV1               DON'T EMPTY SECTOR
         OR,R4    L(X'100')         INDICATE UPDATE
         LW,R1    Y002
         STS,R1   BFL,R6
         STW,R4   BUFF2+2
         LI,R3    MIDIS
SLIDE    LB,R5    BUFF2,R7
         STB,R5   BUFF2,R3          SLIDE UP
         AI,R7    1
         AI,R3    1
         CH,R7    BUFF2+2           CHK END OF SECTOR
         BL       SLIDE
         STH,R3   BUFF2+2
         B        MOVEAKEY          LOOP
*
MVA      RES      0
         LW,R7    R1
         AI,R7    MIDIS+10          FAK
         LB,R4    BUFF2,R7
         CI,R4    4                 SKIP IF
         BANZ     %+2                1ST APPEARANCE
         AI,D1    X'80'             NOT FIRST
MV1      STH,R5   BUFF1+2           UPDATE POSITION
         LI,R4    MIDIS
         B        %+2
         LB,D1    BUFF2,R4
         STB,D1   BUFF1,R3
         AI,R4    1
         AI,R3    1
         BDR,R1   %-4
         LW,SR4   DCBCDAM,R6        MOVE DISK ADDR
         LI,R1    4
         SCS,SR4  8
         STB,SR4  BUFF1,R3
         AI,R3    1
         BDR,R1   %-3
         LI,D3    BUFF2
         LW,R4    BUFF2+1           GET FLINK
         LI,R1    X'100'
         AND,R1   BUFF2+2
         BEZ      MV2               NOT UPDATED OR ADDED
         LI,R0    0
         STS,R0   BUFF2+2
         BAL,R0   WRTSEC            UPDATE DISK COPY
*
MV2      BAL,R0   GETSEC            GET A BUFF2
MV2P1    LW,D1    R4                DISC ADDR OF NEXT GRANULE
         BEZ      MV3               NO MORE
         BAL,R0   GETCSA
         LI,R0    X'1C00'
         CW,R0    BUFF2+2
         BAZ      5M0               LVL 0 READ
         B        5M3               UPPER LVL READ
*
MV3      LI,D4    BUFF1
         STW,D1   BUFF1+1           RESET FLINK
         LW,R3    BUFF1             SAVE BLINK
         LW,D4    BCDA,R6           FOR CHK IN RELEASE
         LW,R1    CFU,R6
         LB,R0    *R1
         CI,R0    X'80'
         BAZ      %+4
         AI,R0    -X'80'            RESET CC1
         OR,R0    SCC4              SET CC4
         STB,R0   *R1
         LI,R2    BASLIDES
         LB,R0    *R1,R2            HOW MANY SECTORS ON LEVEL JUST DONE
         CI,R0    3
         BG       STRTALEV          BUILD ANOTHER LEVEL
         BL       %+2               SKIP IF NOT 3
         STW,R3   TDA,R1            MIDDLE IS TOP
         LCF      *R1
         BCR,2    OUTAREL+1         NO RESIDUE
         LCI      14
         STCF     *R1               SET RETURN FROM RELEASE
         LW,D2    D4                POSITION
         PULL     D1
         AI,D1    0
         BNEZ     RELMUL4           RELEASE
         B        RELMUL51           RESIDUE
OUTAREL  LI,R2    BASLIDES
         LI,R0    0
         STB,R0   *R1,R2            RESET SLIDES
         BAL,R0   CLRBBUF           CLR THE FINAL BFR FINALLY AT LAST
OUTA1    RES      0
         LCF      *R1
         LCI      6                 SET CC3
OUT2CLSE STCF     *R1
         PULL     R0                CLEAN UP STACK
         B        MULRET            GET OUT
         PAGE
GETDISKI LW,R1    CFU,R6
         LC       *R1
         BCR,2    0,R4              NO RESIDUE LEFT
         LW,D2    D4                EXPECTED BLINK
         PULL     D1                NEXT SECTOR
         AI,D1    0                  ON CURRENT LEVEL
         BNEZ     GETDISKZ          STAY ON THIS LEVEL
         LW,D1    *TSTACK           GO DOWN A LEVEL
         LI,D2    0                 1ST SECTOR BLINK
         BAL,R0   FLINKUP
         B        5M4               OK
         LI,D1    0                 ABORT
         STW,D1   *TSTACK
         B        5M6
5M4      RES      0
         LI,R1    GETDISKY          FORCE RETURN
*
GET1ST   LI,R3    MIDIS             GET 1ST
         BAL,R0   ISEQICR1           DISK ADDRESS POSITION
         LI,R2    2
         LI,D1    X'1800'
         AND,D1   *D3,R2
         BEZ      GET1STB           BRANCH IF WE READ LEVEL 1
         LI,R2    4
GET1STA  LB,R0    *D3,R3
         SLS,D1   8
         OR,D1    R0                COLLECT DISK ADDRESS
         AI,R3    1
         BDR,R2   GET1STA
GET1STB  XW,D1    *TSTACK           SET POINTER TO NEXT LOWER LEVEL
         B        0,R1              RETURN
*
GETDISKZ  EQU       %
         BAL,R0   FLINKUP
         B        5M5               OK
         LI,D1    0                 ABORT
         B        5M6
5M5      RES      0
GETDISKY LI,R1    1
         LW,D1    *D3,R1            GET FLINK
5M6      RES      0
         PUSH     D1                NEXT SECTOR ON THIS LEVEL
         LW,R1    CFU,R6            RESTORE CFU POINTER
         B        0,R4              RETURN
         PAGE
GETDISK  RES      0
         LW,R1    CFU,R6
         LI,R2    BASLIDES
         MTB,1    *R1,R2            UPDATE COUNT OF GRANULES
         BGZ      %+2               SKIP IF OK
         MTB,-1   *R1,R2            TOO MUCH
         LCF      *R1               BRANCH IF
         BCR,2    GETDISK1           NO OBSOLETE RESIDUE
         LW,SR1   *TSTACK           BRANCH IF
         BNEZ     *SR4               THERE IS 1 ON THIS LVL
         LI,R2    -1                DOWN 1 LEVEL
         LW,SR1   *TSTACK,R2        GET
         BNEZ     *SR4               1ST GRANULE
         STCF     *R1               RESIDUE
         PULL     2,R0               EXHAUSTED
GETDISK1 RES      0
         DO       1
         LW,R2    TYC,R6            SAVE TYC
         BAL,R0   GETDGRAN          GET A GRANULE
         LW,R3    Y00FE             RESTORE ORIGINAL TYC -
         STS,R2   TYC,R6              GETDGRAN MAY CHANGE IT
         B        *SR4
         REF      GETDGRAN,Y00FE
         ELSE
         REF      GBG,INCREMENT%SECTOR,RCYL,RAD1ST,GETCFU
         REF      GCYL,GPVCYL,GETVNO1,GETSNADR,GETVNO
         REF      SETVNO,SETPVI
         REF      PUF,Y0038
         PUSH     15,SR2
GG10     BAL,R0   PRIVDCB
         BANZ     GPRIV
         LI,5     PRDCRM
         LI,3     TAB1
         BAL,D2   GETCFU
         LW,D2    CYL,R6
         MTW,0    RAD1ST            PREFER RAD SET
         BEZ      GG50              NO
         CI,D2    DCBCYLBIT         YES
         BAZ      ALLOC
         LI,3     TAB4
         B        ALLOC
GG50     CI,D2    DCBNOSEPBIT
         BAZ      GG60
         LI,4     BARNDEV
         LB,4     *6,4              GET DEVICE SPECIFIED
         CI,4     7                 RAD
         BE       ALLOC             YES, ALLOCATE
GG60     RES      0
         LI,3     TAB2              NO,  CHANGE TABLE
         CI,D2    DCBCYLBIT
         BAZ      ALLOC
GG90     LI,3     TAB3
*
* ALLOCATE EM - R3 = TABLE OF WHAT ORDER TO TRY
*               R5 = JIT OFFSET TO DO ACCOUNTING
*
ALLOC    LI,SR2   3
         BAL,D2   GETCFU
         B        0,R3
RETURN   AI,3     1
         BDR,SR2  %-3
ALOCX    LI,SR1   0
EXIT     PULL     15,SR2
         AND,SR1  M24               SET CC & CLEAR BAD BITS
         B        *SR4
*
GRAD     BAL,R2   CHKLIMS           SEE IF RAD AUTHORIZED
         MTW,0    J:JIT,R5          TEST USED IN CHKLIMS
         B        RETURN            LIMIT EXCEEDED                      DISCB
         LI,0     X'7'              CODE FOR GBG
         BAL,SR4  GBG
         BEZ      RETURN            DIDN'T GET, TRY ANOTHER
         B        ACCT
*
GPACK    LW,SR1   GAVAL,R1          ON PACK TRY GAVAL FIRST
         BNEZ     GPACK20           IS SOME, USE ONE
         BAL,R2   CHKLIMS           ISN'T, CHECK LIMITS
         MTW,0    J:JIT+1,R5
         B        RETURN            LIMIT EXCEEDED                      DISCB
         LI,0     X'B'              CODE FOR PACK
         BAL,SR4  GBG
         BEZ      RETURN
         B        ACCT1
GPACK20  EQU         %                                                  DISCB
         MTB,-1      SR1                                                DISCB
         BNEZ        SOME%LEFT                                          DISCB
         LI,SR1   0                                                     DISCB
         B        XCHNG%GAVAL                                           DISCB
SOME%LEFT EQU        %                                                  DISCB
         LI,R2       1                                                  DISCB
*                                   ASSUME 2 SECT/GRAN FOR PACK         DISCB
         MTH,2       SR1,R2         INCREMENT SECTOR BY 2               DISCB
         BNC         XCHNG%GAVAL    NO CARRY                            DISCB
         MTH,-2      SR1,R2         RESET SECTOR ADDRESS                DISCB
         BAL,R2      INCREMENT%SECTOR                                   DISCB
XCHNG%GAVAL EQU      %                                                  DISCB
         XW,SR1   GAVAL,R1
         B        EXIT
*
GTCYL    LW,SR1   GAVAL,R1          ON CYL, TRY GAVAL FIRST
         BNEZ     GPACK20           IS ONE, GO GET IT
         BAL,SR4  GCYL
         BEZ      RETURN            DIDN'T GET, RETURN
         LB,R1    SR1               GET # GRANULES GOTTEN               DISCB
         BAL,R2   CHKLIMS           TEST TO SEE IF ECEEDED LIMIT        DISCB
         CW,R1    J:JIT+1,R5        LIMIT TEST                          DISCB
         B        RETURN%CYL        LIMIT EXCEEDED                      DISCB
         LW,R1    CFU,R6
         STW,SR1  GAVAL,R1          GOT IT, STORE IN CFU
         LB,R2    SR1               GET # GRANULES
         AWM,R2   CLK,R6            ADD TO FILE SIZE
         LCW,R2   R2
         AWM,R2   J:JIT+1,R5        SUBTRACT FROM REMAINING
         B        GPACK20           GO INCR DISC ADDR
RETURN%CYL  EQU   %                 GIVE UP CYL WE JUST GOT BECAUSE WE EXCEED LI
         BAL,SR4  RCYL              RELEASE CYL                         DISCB
         B        RETURN            GET OUT                             DISCB
*
* FALL THROUGH TO DO ACCOUNTING
*
ACCT1    AI,5     1
ACCT     LB,R2    SR1               GET NO OF GRANULES
         BNEZ     %+2
         LI,2     1
         AWM,R2   CLK,R6            INCR FILE SIZE
         LCW,R2   R2
         AWM,R2   J:JIT,R5
         B        EXIT
*
GPRIV    LW,1     CFU,R6
         LW,SR1   GAVAL,R1          ANY IN CURRENT CYL
         BNEZ     GPACK20           YEP, USE ONE
GG130    BAL,SR4  GPVCYL            TRY TO GET ON CUR VOL
         BEZ      GPRIV20           CAN'T
GG135    BAL,R0   GETVNO1           GET CURRENT VOL NO.
         STDCTX,R3,S  SR1           AND SET IN DISC ADR
         LW,1     CFU,R6
         STW,SR1  GAVAL,R1          STORE IN CFU
         LB,2     SR1
         AWM,2    CLK,R6            INCREMENT FILE SIZE
         B        GPACK20           PICK ONE
GPRIV20  BAL,R0   GETVNO            ATTEMPT TO ALLOCATE
         BAL,R0   GETSNADR                  ON OTHER VOLUMES IN THE
         LW,D3    R3                        SET,STARTING WITH THE LAST
         LW,R3    R2
GG150    CW,R3    D3                        IS THIS THE CURRENT VOL
         BE       GG170                         YES,SKIP
         BAL,R0   SETVNO
         BAL,D4   SETPVI
         BAL,SR4  GPVCYL                IS A CYL AVAILABLE ON THIS VOL
         BNEZ     GG135                     YES
GG170    BDR,R3   GG150                     NO,TRY NEXT VOLUME
         B        ALOCX                     NONE AVAILABLE,EXIT
*
*
CHKLIMS  LW,D2    Y0038
         AND,D2   J:JIT+PUF         MONITOR GETS NO CHEX
         BEZ      2,R2              NORMAL RETURN                       DISCB
         EXU      0,R2              USE TEST PROVIDED
         BG       2,R2              NORMAL RETURN                       DISCB
         B        1,R2              LIMIT EXCEEDED DONT'T ALLOCATE      DISCB
*
TAB1     B        GRAD
TAB2     B        GPACK
         B        GTCYL
TAB4     B        GRAD
TAB3     B        GTCYL
         B        GPACK
         B        GRAD
         FIN
*
         PAGE
RELMUL   BAL,R0   GETSEC
         BAL,R0   READTOP           GET TOP
         B        %+2               GOT IT
         B        MULRRET           GIVE UP
         LW,D1    *D3
         BEZ      RELMUL6           BRANCH IF AT 1ST GRANULE IN A LEVEL
         LI,R2    1
         LW,D1    *D3,R2            SAVE
         PUSH     D1                 POSITION
         B        RELMUL2           ENTER BACKUP RELEASE LOOP
RELMUL1  BAL,R0   BLINKUP           BACK UP
         B        RELMUL2           OK
         PULL     D1                BALANCE STACK
         B        MULRRET           ABORT
RELMUL2  BAL,SR4  RB
         LW,D1    *D3               BLINK
         BNEZ     RELMUL1           RETREAT
         BAL,R1   GET1ST            FOR NEXT LEVEL DOWN
         LW,R1    CFU,R6            FOR
         LW,D2    TDA,R1             CHECK
         B        RELMUL4           ENTER FORWARD RELEASE LOOP
RELMUL3  LW,D2    DCBCDAM,R6        FOR CHK
RELMUL4  BAL,R0   FLINKUPP
         B        RELMUL5
         B        RELMUL51
RELMUL5  BAL,SR4  RB
         LW,R1    CFU,R6
         LI,R2    1
         LW,D1    *D3,R2            FORWARD
         BNEZ     RELMUL3            RELEASE LOOP
RELMUL51 LW,D1    *TSTACK           DROP DOWN A LEVEL
         BEZ      RELMUL8           NO MORE LEVELS
         LI,D2    0                 FIRST SECTOR BLINK
         BAL,R0   FLINKUPP
         B        RELMUL7
RELMUL8  PULL     D1                CLEAN UP STACK
         LCF      *R1
         BCR,8    MULRRET           NORMAL RELEASE EXIT
         B        OUTAREL
RELMUL6  PUSH     D1                OPEN A STACK POSITION
RELMUL7  BAL,R1   GET1ST            GET 1ST OF NEXT LOWER LEVEL
         LW,R1    CFU,R6            RESTORE CFU POINTER
         B        RELMUL5           RELEASE THIS LEVEL
         PAGE
RB       LW,D1    DCBCDAM,R6        D1=DISC ADR TO BE RELEASED
         PUSH     SR4
         BAL,R0   TOPDA      DETERMINE IF DA AT TOP OF GRAN OR CYL POOL
         PULL     SR4
         LW,SR1   DCBCDAM,R6        SR1=DISC ADR TO BE RELEASED
         CI,SR3   0          IS DA FROM TOP OF GRAN AND FROM GRAN POOL
         BE       RELRBG         YES,RELEASE GRANULE
*                                NO
         LCF      *R1        IS THE FILE BEING RELEASED
         BCS,8    RB1            NO,ADD DISK ADR TO HIGHER LEVEL INDEX
*                                   BLINK-FLINK CHAIN
*                                YES
         CI,SR3   1          IS DA FROM TOP OF CYL AND FROM CYL POOL
         BE       SGAIBB         YES,SAVE DA IN BB AND RELEASE LATER
         BNE      *SR4           NO,DONT SAVE DA
*
RB1      LCF      *R1
         LI,D3    BUFF1
         BCS,4    RB3               NOT 1ST BREAK
         BAL,R7   COMP              INSERT ROOM
         BGE      RB3               NO
         STH,R5   BUFF1+2           INSERT
         LI,R1    -1                 HI
         STB,R1   BUFF1,R3            KEY
         AI,R3    1
         CW,R3    R5
         BL       %-3
RB3      LW,R1    CFU,R6
         LCI      14
         STCF     *R1               SET 1ST BRK ACCOMPLISHED
         LW,D1    DCBCDAM,R6
         STW,D1   BUFF1+1           SET NEW FLINK
         LW,D2    BCDA,R6           FOR BLINK
         BAL,R0   CLRBBUF
         STW,D1   BCDA,R6
         BAL,R0   GETBBUF
         STW,D2   BUFF1             SET BLINK
         LI,R0    0
         STW,R0   BUFF1+1           ASSUME LAST
         LI,R2    2                 SET
         LI,R3    BASCR
         LB,R3    *R6,R3
         AW,R3    ALT3RDWD           CONTROL
         STW,R3   BUFF1+2            WORD
         LI,R0    -1
         AI,R2    1
         STW,R0   BUFF1,R2          INSERT HI KEY
         CI,R2    14
         BL       %-3
         LW,R3    Y004
         STS,R3   BFL,R6            SET BUFFER UPDATED
         LI,D3    BUFF2
         B        RELMUL5+1
*
*
COMP     RES      0
         LI,R2    BASCR             GET
         LB,R1    *R6,R2             KEY LENGTH +1
         LI,R2    NAV               CURRENT
         LH,R3    *D3,R2             POSITION
         LW,R5    R3                TENTATIVE
         AW,R5    R1                 NEW
         AI,R5    4                   POSITION
         CI,R5    BUFSIZ            CHK
         B        0,R7
         PAGE
*        PURPOSE: TO RELEASE A GRANULE FROM A PUBLIC FILE'S HIGHER
*                 LEVEL INDEX AND TO ADJUST THE ACCOUNTING
*
*        INPUT:   R6=DCB ADR
*                 SR1=DISC ADR OF GRAN TO BE RELEASED
*
*        CALL:    BAL,SR4  RELRBG
*
*        REGS:    ALL REGS NONVOLATILE
*
RELRBG   EQU      %
         AI,SR1   0
         BEZ      *SR4
         PUSH     16,R0
         BAL,SR4  RBG
         BEZ      RELRBGX
         MTW,-1   CLK,R6
         BAL,R3   FNDHGP
         LI,R3    X'3F00'           R3=TYPE OF DEVICE ON WHICH GRANULE
         AND,R3   1,R7                 RELEASED
         SLS,R3   -8-3              DC=0;  DP=1
         MTW,1    J:JIT+PRDCRM,R3   INCREMENT JIT REMAINING
RELRBGX  PULL     16,R0
         B        *SR4
         PAGE
*        PURPOSE: TO SAVE THE DISC ADR OF A GRANULE THAT IS AT THE TOP
*                 OF A CYLINDER AND THAT IS TO BE RELEASED FROM A
*                 FILE'S HIGHER LEVEL INDEX
*
*        INPUT:   R6=DCB ADR
*                 SR1=DISC ADR OF GRAN (AT TOP OF CYL) TO BE RELEASED
*                 DCB:BUF1=ADR OF BB WHERE DISK ADR TO BE SAVED
*                          (BB IS ALLOCATED AND INITIALIZED BY REL)
*
*        CALL:    BAL,SR4  SGAIBB
*
*        REGS:    R2,R3 VOLATILE
*
SGAIBB   EQU      %
         LI,R3    BUFF1
         LW,R2    0,R3
         STW,SR1  0,R2
         MTW,1    0,R3
         MTW,-1   1,R3
         BGZ      *SR4
         REF      PVERR,GETORG
         BAL,SR4  PVERR            *FILE HAS MORE THAN 15240 (508*30)
*                                   HIGHER LEVEL INDEX GRANULES
         PAGE
*        PURPOSE: TO DETERMINE WHETHER A PUBLIC OR PRIVATE DISC ADR
*                 IS ALLOCATED FROM A GRANULE OR CYLINDER  ALLOCATION
*                 POOL, AND FURTHUR, WHETHER THE DISC ADR IS ON A
*                 GRANULE/CYLINDER  BOUNDARY WITH RESPECT TO ITS
*                 ALLOCATION POOL
*
*        INPUT:   R6=DCB ADR
*                 D1=DISC ADR
*
*        CALL:    BAL,R0  TOPDA
*
*        OUTPUT:  SR3=0,DISC ADR FROM GRAN POOL AND ON GRAN BOUNDARY
*                    =1,DISC ADR FROM CYL  POOL AND ON CYL   BOUNDARY
*                    =2,DISC ADR FROM GRAN POOL BUT NOT ON GRAN BOUNDARY
*                    =3,DISC ADR FROM CYL  POOL BUT NOT ON CYL  BOUNDARY
*
*        REGS:    VOLATILE - R3,R4,R5,R7,SR1,SR3,SR4
*                 NONVOLATILE - R1,R2,R6,SR2,D1-D4
*
TOPDA    EQU      %
         PUSH     R0
         LI,SR3   0                 'DISC ADR FROM  GRAN POOL' FLAG
         BAL,R0   PRIVDCB
         BAZ      TOP20
         LSECTA,R5,S D1             R5 = SECTOR # OF DISC ADR           DISCB
         BAL,R0   GETORG
         BGE      TOP10
*                                   FOR CONSECUTIVE FILE                DISCB
         LDCTX,R4    D1             IS DISC ADR IN NVAT                 DISCB
         CI,R4       1                                                  DISCB
         BE       TOP10                         NO
         CI,5     30                IS IT IN NVAT
         BGE      TOP10                         NO
         LW,R3    PAT,R6            HGP ADDRESS
         LW,R3    3,R3              # SECT/GRAN
         B        TOP55
TOP10    EQU      %                                                     DISCB
         LW,R4    PAT,R6            GET HGP ADDRESS                     DISCB
         LI,R3    BAATNGC           GET BYTE INDEX OF NGC IN HGP        DISCB
         LB,R3    *R4,R3            GET # GRAN/CYL                      DISCB
         SLS,R3   1                 CONVERT TO # SECT/CYL               DISCB
         LI,SR3   1                 DISC ADR FROM CYL POOL FLAG
         B        TOP55
TOP20    PUSH     R6                PUBLIC FILE
         LW,SR1   D1
         BAL,R3   FNDHGP
         PULL     R6
         AI,R7    0                     R7=ADR OF ALLOCATION TABLE
         BEZ      TOP60                 (UNABLE TO LOCATE ALLOCATION TB)
         LW,R0    1,R7
         CI,R0    ATCYLBIT
         BANZ     TOP30
         LW,R3    3,R7                  DEVICE ALLOCATED BY GRANULE
         B        TOP40                     R3=NSG
TOP30    LI,R3    7
         LB,R3    *R7,R3                    R3=NGC
         MW,R3    3,R7                      R3=NGC*NSG=NSC
TOP35    LI,SR3   1                 'DISC ADR FROM CYL POOL' FLAG
TOP40    EQU         %                                                  DISCB
         LSECTA,R5,S D1                                                 DISCB
*                    THE FOLLOWING INT'S ASSUME PER + PFA ONLY          DISCB
*                    ARE 16 BITS IN THE HGP                             DISCB
         LW,R4    4,R7              GET # MAP WORDS OF PER AND PFA      DISCB
         CW,R4    M16               TEST FOR ANY PFA                    DISCB
         BAZ      TEST%PER            NO                                DISCB
         INT,SR4  6,R7              GET START OF PFA                    DISCB
         CW,R5    SR4               SEE IF IN PFA                       DISCB
         BGE      TOP50               YES                               DISCB
TEST%PER EQU      %                                                     DISCB
         CW,R4    YFFFF             TEST FOR ANY PER                    DISCB
         BAZ      TOP55             NO MUST BE IN PSA                   DISCB
         INT,SR4  5,R7              GET START OF PER                    DISCB
         CW,R5    SR4               SEE IF IN PER                       DISCB
TOP50    SW,R5    SR4                   YES,GET SECTOR NO FROM START
*                                           OF AREA
TOP55    LI,R4    0
         DW,R4    R3
         AI,R4    0                 IS THE DISC ADR ON A GRAN/CYL BOUND
         BEZ      PULLEXIT              YES,EXIT
TOP60    AI,SR3   2                     NO,SET 'NOT ON GRAN/CYL BOUND'
         B        PULLEXIT                 FLAG AND EXIT
*
         SPACE    3
READTOP  LW,D1    TDA,R1            TOP OF PYRAMID
         BEZ      MULRRET           NO PYRAMID
READTOP1 PUSH     R0                SAVE LINK
         LW,SR1   D1
         BAL,SR4  FMCHKDA           CHECK DISC ADR FOR VALIDITY
         BCR,15   READTOP2          GOOF
         LI,D2    0
         BAL,R0   FLINKUPP  READ TOP OF OBS PYRAMID
READTOP3 B        %+2               OK
         B        PULLEXIT1
         LI,R2    2
         LI,R3    X'1C00'
         CW,R3    *D3,R2
         BANZ     PULLEXIT          NORMAL RETURN
READTOP2 LW,SR3   D1
         LI,SR1   7                 75-07
         BAL,SR4  ERFILDA           LOG THE ERROR
         B        PULLEXIT1         ERROR RETURN
         REF      OPENDEV
         END      MUL

