*M*      MUL      MODULE TO BUILD OR RELEASE UPPER LEVEL OF KEYED FILE
         SPACE    2
MUL:     EQU      %
         PCC      0
         DEF      MUL:              FOR MODULE PATCHING
BITS     SET      1
UTSPROC  SET      1
MONPROC  SET      1
DISCBPROC SET     1                                                     DISCB
         SYSTEM   UTS
         TITLE    ' *****   MUL   **** '
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    2
*P*      NAME:    MUL
*P*
*P*      PURPOSE  TO BUILD OR RELEASE THE UPPER LEVEL
*P*               STRUCTURE OF A KEYED FILE.
         PAGE
         SPACE    2
*
*        DONT RUN MUL ON SLAVE CPU'S
*
         BLOCK                      BACK TO THE MASTER IF NECESSARY
         LW,R1    R0
         B        %+1,R1
*
         B        MULENT            BUILD MUL
         B        MULENT            RELEASE MUL
         DATA     0
         B        OPENDEV
         B        T:LDEV            LDEV CAL PROCESSOR
         B        CCLOSE            CLOSE COOP STREAMS
         B        COPOPNLD          FINISH COOP STREAM INITIALIZATION
         B        FITMOD            PERFORM FIT MODIFICATION
         DATA     0,0,0             EXTRA SPACE
         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      OPNSEG            SEG # OF OPEN OVERLAY
         REF      DOUBLEONE
         REF      NB31TO0
         REF      CLRBFUB           WRITE OUT BUFF2
         REF      FILCFU            CFU FOR FILE DIRECTORY
         REF      J:BASE            TEMP STORAGE
         REF      MAPBUFS           MAP FILE BUFFERS
         REF      JB:FBUL           LAST FILE BUFFER PAGE
         REF      JXBUFVP           1ST FILE BUFFER PAGE
         REF      DELAA             DELETE OLD NAME FROM FD
         REF      PVERR             PRIV VOLUME ERROR
         REF      RBG               RELEASE BACKGROUND GRANULE
         REF      GETBBUF           GET A BLOCKING(BUFF1) BFR
         REF      CLRBBUF           RELEASE A BLOCKING BFR
         REF      PULLEXIT          NORMAL STACK EXIT
         REF      PULLEXIT1         SKIPPING STACK EXIT
         REF      YFFFF             BITS 0-15
         REF      WRTSEC            WRITE THE MI(BUFF2) BFR
         REF      REDSECL           READ MI GRAN WITH LINK CHK
         REF      GETCSA            GET CURRENT MI DISK ADDR
         REF      ISEQICR1          PASS OVER KEY PART OF MI ENTRY
         REF      RWREX             SET UP FOR MI READ
         REF      PVQUEUE           GO TO IOQ CHKING FOR PRIV
*,*                                 TRANSLATION REQUIREMENT
         REF      IOSPIN            I/O RUNDOWN FOR A DCB
         REF      RESBLK            PART OF EXIT FROM MI READ
         REF      PRIVDCB           CHK FOR PRIVATE DCB
         REF      FNDHGP            FIND THE HGP FOR A DISK ADDRESS
         REF      FMCHKDA           VERIFY VALIDITY OF A DISK ADDR
         REF      GETSEC            GET A MI(BUFF2) BFR
         REF      SETTYC            SET THE TYC FIELD IN DCB
         REF      T:LDEV            FOR TRANSFER VECTOR
         REF      CCLOSE            CLOSE COOP STREAMS
         REF      COPOPNLD          COOP STREAM INIT
         REF      ERFILDA           REPORT A 75 ERROR
         REF      J:JIT             JOB INFO TABLE
         REF      PRDCRM            GRANULE AUTHORIZATION
         REF      J:CLS             SPECIAL FLAGS FOR READ ERRS
         REF      OPENDEV           OPEN A DEVICE DCB
         REF      SETVNO            SET VOLUME # IN DCB
         REF      SETPVI            SET VOLUME INFO IN DCB
         PAGE
*D*      NAME:    BLINKUP
*D*      ENTRY    FLINKUP
*D*      REGISTERS SAVES 0-4 & 12-15
*D*      CALL     R0 IS THE LINK
*D*      ENVIRONMENT MAPPED MASTER
*D*      DESCRIPTION  USED TO READ THE UPPER LEVEL GRANULES
*D*               WITH LINK CHECKING.
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,SR1   NAVX,R1           CHK THE SCR
         LI,R2    BASCR
         CB,SR1   *R6,R2
         BNE      LINKABRT          BRANCH IF NO GOOD
         LW,SR1   0,R1              CHK THE BLINK
         BEZ      %+3               SKIP IF NONE
         BAL,SR4  FMCHKDA
         BCR,15   LINKABRT          BAD NWS
         LW,SR1   1,R1              CHK THE FLINK
         BEZ      %+3               SKIP IF NONE
         BAL,SR4  FMCHKDA
         BCR,15   LINKABRT
         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
*E*      ERROR    75-07
*E*      DESCRIPTION  ERROR IN READING AN UPPER LEVEL GRAN
*E*               THIS SITUATION IS ERROR LOGGED BUT NOT
*E*               REPORTED TO THE USER
         LI,SR1   7                 75-07
         BAL,SR4  ERFILDA           LOG THE ERROR
*
REDSEC1  PULL     9,D1
         B        *R0
         PAGE
MUL2     LI,1     BASCR
         LB,R0    *R6,1
         AW,R0    3RDWD             INITIALIZE
         PUSH     R0                 CONTROL
         BAL,R0   GETSEC            GET AN MI BUFFER
         LW,D1    TDA,R1            GET TOP
         BNEZ     MUL3              OK
MUL101   RES      0
         LI,R0    X'43'             RESET THE
         STB,R0   *R1                O BIT
         B        MUL6
         PAGE
*F*      NAME:    MULMUL
*F*
*F*      PURPOSE  TO BUILD OR REBUILD THE UPPER LEVEL
*F*               STRUCTURE OF A KEYED FILE.
*F*      DESCRIPTION  READ EACH LEVEL TO BUILD THE NEXT
*F*               LEVEL ABOVE.
         SPACE    3
MULMUL   RES      0
         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
***               FALL INTO MUL3   ***
MUL3     BAL,R0   READTOP           READ TOP OF PYRAMID
         B        MUL4              GOT IT
MUL3A    LW,R1    CFU,R6
         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
         LI,SR4   X'A00'            CHK FOR CREATE
         CW,SR4   0,R1
         BANZ     CREATE
MUL51    RES      0
         LW,SR4   Y2                SET THE
         STS,SR4  0,R1               O BIT
         LW,SR4   DCBCDAM,R6        1ST GRAN TO BE REUSED
         PUSH     2,SR4
MUL6     RES      0
         LW,R3    FDA,R1            1ST
MUL6P1   STW,R3   TDA,R1             SECTOR
*
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     OUT1              SKIP IF 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          SET RETURN
         B        OUT1+1
OUT1A    PULL     R0                REMOVE EXTRA WORD FROM STACK
OUT1     LI,R0    OUTA1             SET RETURN
         LI,D1    X'C'
         B        SETTYC
         SPACE    2
CREATE   LI,SR4   X'8000'           IS IT A SEQUENTIAL
         CW,SR4   BUFF2+NAVX
         BANZ     MUL51             BRANCH IF IT IS
         LC       *R1               IS IT TURNED OFF
         BCS,2    MUL51             BRANCH IF REBUILD
         LI,D1    X'FF'             GET
         AND,D1   0,R1               CFU:SLIDES
         CI,D1    3
         BG       CRE1              BRANCH TO BUILD LVL 2
         BL       CRE2
         LW,D1    BUFF2+1           GET THE FLINK
         BNEZ     %+2               SKIP IF IT'S A DSK ADDR
CRE2     LW,D1    DCBCDAM,R6        USE FIRST FOR TDA
         STW,D1   TDA,R1            USE THE MIDDLE FOR THE TOP
         B        MULRET
*
CRE1     LI,D1    X'400'            MOVE LEVEL COUNTER
         AWM,D1   *TSTACK
         LW,R3    DCBCDAM,R6        1ST LVL 1 GRANULE
         B        MUL6P1
         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
         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
         LCF      *R1               THROW
         BCR,2    MUL3A              AWAY
         PULL     2,R0                UPPER
         B        MUL3A                LEVELS
         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      OUT1A             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
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
         LW,R2    BUFF2+2
         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
         CI,R2    X'1C00'           WHAT'S THE LEVEL
         BANZ     5M3               UPPER LVL READ
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
         LI,R2    0                 IT'S LEVEL ZERO
         B        MV2P1             SKIP FDA
*
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
         LI,R2    BASLIDES
         LB,R0    *R1,R2            HOW MANY SECTORS ON LEVEL JUST DONE
         CI,R0    3
         BG       STRTALEV          BUILD ANOTHER LEVEL
         BL       MV4               POSSIBLE ERROR
         STW,R3   TDA,R1            MIDDLE IS TOP
MV5      LC       *R1
         BCR,2    OUTAREL+1         NO RESIDUE
         LCI      10
         STCF     *R1               SET RETURN FROM RELEASE
         LW,D2    D4                POSITION
         PULL     D1
         AI,D1    0
         BNEZ     RELMUL4           RELEASE
         B        RELMUL51           RESIDUE
*
MV4      LW,R3    Y004
         CW,R3    BFL,R6
         BANZ     MV5               SOMETHING THERE - LET IT GO
*  DIDN'T PUT ANY ENTRIES IN TDA GRANULE - LOG AN ERROR AND GET OUT
         LW,SR3   BCDA,R6
         LI,SR1   7                 75-07
         BAL,SR4  ERFILDA
         LW,R1    CFU,R6
         LI,R3    0
         STW,R3   TDA,R1            ZAP TDA IN CFU
         LW,R3    0,R1
         AND,R3   NB31TO0+30        RESET O-BIT
         STW,R3   0,R1
         BAL,R0   CLRBBUF
         B        OUT2CLSE
*
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
         LI,R0    X'63'             SET ACTIVE, O, W, & R
         STB,R0   *R1
OUT2CLSE PULL     R0                CLEAN UP THE STACK
         B        MULRET            GET OUT
         PAGE
*D*      NAME:    GETDISKI
*D*      ENTRY    GET1ST
*D*      DESCRIPTION  USED TO REUSE ANY GRANULES LEFT FROM
*D*               AN OBSOLETE UPPER LEVEL STRUCTURE WHEN
*D*               REBUILDING A NEW UPPER LEVEL.
         SPACE    2
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
         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
         PAGE
*F*      NAME:    RELMUL
*F*
*F*      PRUPOSE  TO RELEASE THE GRANULES OF AN UPPER LEVEL
*F*               OF A KEYED FILE.
*F*
*F*      DESCRIPTION READ FROM TOP DOWN RELEASING ANY MASTERS
*F*               FOUND.
         SPACE    2
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
*D*      NAME:    RELRBG
*DO*
*D*
*        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
*FIN*
*
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
*D*      NAME:    SGAIBB
*DO*
*D*
*        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
*FIN*
*
SGAIBB   EQU      %
         LI,R3    BUFF1
         LW,R2    0,R3
         STW,SR1  0,R2
         MTW,1    0,R3
         MTW,-1   1,R3
         BGZ      *SR4
         BAL,SR4  PVERR            *FILE HAS MORE THAN 15240 (508*30)
*                                   HIGHER LEVEL INDEX GRANULES
         PAGE
*D*      NAME:    TOPDA
*DO*
*D*
*        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
*FIN*
*
TOPDA    EQU      %
         PUSH     R0
         LI,SR3   0                 'DISC ADR FROM  GRAN POOL' FLAG
         BAL,R0   PRIVDCB
         BAZ      TOP20
         LDCTX,R3 D1                GET VNO
         PUSH     3,13              SAVE REGS
         BAL,R0   SETVNO            SET PV INDICATORS
         BAL,D4   SETPVI
         PULL     3,13
         B        TOP30
TOP20    LW,SR1   D1                FIND HGP FOR PUBLIC D.A.
         BAL,R3   FNDHGP
         BEZ      TOP60             BAD DA
TOP30    LW,R3    3,R7              R3=NSG
         LI,R4    7                 CHECK CYL
         LB,R4    *R7,R4
         BEZ      %+3
         MW,R3    R4                R3=NSC
         LI,SR3   1                 CYL POOL FLAG
         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
         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
         PAGE
         SPACE    2
* PROCESS FIT MODIFICATION ON M:CLOSE CAL
         SPACE    2
         OPEN     WXBUFSIZ,TCFU
TCFU     EQU      X'0D'
WXBUFSIZ EQU      X'200'
VLPNAME  EQU      J:BASE+8
FPTVLP   EQU      J:BASE+9
FITADDR  EQU      J:BASE+10
FITVLPEND EQU     J:BASE+11
FITEND   EQU      J:BASE+6
NWFITST  EQU      WXBUFSIZ-80
FITCFU   EQU      FILCFU+4          FITCFU+CDAM = FILCFU+SREC
         SPACE    2
FITMOD   LW,R2    J:BASE+11         FOR PRIVATE FILES MOVE FDA AND
         STW,R2   J:BASE+7            PAX TO SAFE LOCATION.
         LW,R2    R4                POINTER TO FPT
         PUSH     SR4
         BAL,R0   CLRBBUF           INSURE THERE IS NO BUFF1
         LI,R0    0
         STW,R0   VLPNAME           NO FILE NAME IN VLP LIST
         LI,R5    6
         SLS,R3   1
         BEV      %+2
         AI,R2    1                 INCR BEYOND P WORDS IN FPT
         BDR,R5   %-3
         AI,R2    1
         STW,R2   FPTVLP            REMEMBER ADDR OF FIRST VLP
         BAL,R5   LOCCODEC
         B        CHNGER09          BAD FIT
         STW,R7   FITADDR           START OF FIT
         AW,R7    R3
         AND,D2   M8
         AW,R7    D2
         STW,R7   FITVLPEND         END OF USED SPACE IN FIT
*
         LW,R7    FITADDR
         AI,R7    X'47'
         STW,R7   FITEND            END OF FIT
*
         LI,D4    -10000            SET FOR 1ST PASS
*
FIT19    LI,R4    #CLSVLP
         STB,R4   FPTVLP            # OF UNMATCHED VLP CODES
*
FIT20    LI,R4    #CLSVLP           # LEGAL VLP CODES
         LB,D1    *R2               GET FPT VLP CODE
FIT22    CB,D1    CLSVLP,R4
         BE       FIT25
         BDR,R4   FIT22
FIT70    LW,SR3   =X'0200000A'      0A-01
         BIR,D4   NXTPASS+1         POSTPONE ERROR IF 1ST PASS
         B        FITERR
*E*  ERROR:        0A-01
*E*  DESCRIPTION:  ILLEGAL FPT VLP CODE IN M:CLOSE CAL
*
FITNXT   LW,D2    0,R2              GET CONTROL WORD
         CI,D2    X'10000'
         BANZ     NXTPASS           BR IF END OF VLPS
         AND,D2   M8                LENGTH OF VLP
         AW,R2    D2
         AI,R2    1
         MTB,-1   FPTVLP            ARE THERE ANY UNMATCHED?
         BGZ      FIT20              CONTINUE IF THERE ARE
         B        FIT70             BAD VLP
*
FIT25    BAL,R5   LOCCODEB          IS VLP ALREADY IN FIT
         B        FIT30             NO
*  VLP EXISTS IN FIT
         BDR,D4   FIT70             DUP VLP CODE IF 2ND PASS
*  REMOVE VLP FROM FIT
         AW,R7    R3
         AI,R7    -1                ADDR OF CONTROL WORD IN FIT
         AND,D2   M8
         AI,D2    1                 # WORDS TO REMOVE
         LW,R3    R7
         AW,R3    D2
FIT28    LW,D1    0,R3
         STW,D1   0,R7              MOVE REMAINING VLPS OVER THIS ONE
         AI,R3    1
         AI,R7    1
         CW,R3    FITVLPEND
         BL       FIT28
         LCW,D2   D2
         AWM,D2   FITVLPEND         ADJUST POINTER TO END OF FIT VLPS
         B        FIT37             MARK THE CHANGE
*
FIT30    BIR,D4   FITNXT            DO NOTHING IF 1ST PASS
*        VLP DOES NOT EXIST IN FIT
         CI,D1    1
         BE       FIT40             SPECIAL CASE FILE NAME
*  INSERT NEW VLP IN FIT
         LW,SR2   0,R2              CONTROL WORD FROM FPT
         SLS,SR2  -8
         AND,SR2  M8                # WORDS
         BEZ      FITNXT            NOTHING TO ADD
         AI,SR2   1                 # WORDS TO ADD
         LI,R5    0
         LW,SR3   =X'0400000A'
         LW,R4    FITVLPEND
         AW,R4    SR2               NEW END OF FIT
         CW,R4    FITEND
         BG       FITERR            NOT ENOUGH ROOM
*E*  ERROR:        0A-02
*E*  DESCRIPTION:  NOT ENOUGH ROOM IN FIT TO ADD VLP
         XW,R4    FITVLPEND
FIT34    AI,R4    -1
         AI,R5    -1
         LW,D2    0,R4
         STW,D2   *FITVLPEND,R5     MOVE DOWN FIT TO MAKE ROOM
         CW,R4    FITADDR
         BG       FIT34
         AI,SR2   -1                # WORDS OF VLP DATA
         LW,D2    0,R2              VLP CONTROL WORD FROM FPT
         AND,D2   =X'FF00FF00'      REMOVE STOP FLAG, # WORDS RESERVED
         OR,D2    SR2
         STW,D2   0,R4
         LW,R5    R2
FIT36    AD,R4    DOUBLEONE
         LW,SR1   0,R5
         STW,SR1  0,R4              MOVE IN NEW VLP
         BDR,SR2  FIT36
FIT37    LW,D2    Y002              MARK THE CHANGE
         STS,D2   MIUD,R6
         B        FITNXT
*
*  MAKE NEXT PASS
*
NXTPASS  BDR,D4   FIT50             DONE - CHECK FOR NAME CHANGE
         LW,R2    FPTVLP            START AT FRONT OF FPT AGAIN
         LI,D4    10000
         AND,R2   M24               SCRUB ANY REMAINING COUNT
         B        FIT19             MAKE 2ND PASS
*
*  PROCESS FILE NAME VLP
*
FIT40    LW,R7    R2
         AI,R7    1                 POINT TO VLP DATA WORD
         LW,D2    0,R2              VLP CONTROL WORD
         CI,D2    X'FF00'
         BAZ      FITNXT            NO WORDS IN VLP - IGNORE
         INT,SR2  FLD,R6
         AW,SR2   FLP,R6            ADDRESS OF DCB FILE NAME
         LB,D1    *SR2              TEXTC COUNT OF OLD NAME
         AI,D1    1
         LW,SR1   R7
         SLD,SR1  2
         STB,D1   SR2
         CBS,SR1  0                 COMPARE OLD AND NEW NAMES
         BE       FITNXT            NO CHANGE IF THE SAME
         XW,R7    VLPNAME           SAVE ADDRESS OF NEW NAME
         BEZ      FITNXT            CONTINUE IF NO DUP
         B        FIT70             IT'S A DUPLICATE
*
*  CHANGE FILE NAME
*
FIT50    LW,R0    VLPNAME
         BEZ      FIT60             NO NAME CHANGE
         LW,R0    JB:FBUL           THERE MUST BE
         AI,R0    -JXBUFVP-3         AT LEAST 3 FILE BUFFERS
         BLEZ     FIT70             BRANCH IF NOT
         LW,SR3   =X'1000000A'
*E*      ERROR:   0A-08
*E* DESCRIPTION:  ILLEGAL FILE NAME IN M:CLOSE FPT
         LH,R0    *VLPNAME
         CI,R0    X'0100'
         BLE      FITERR            NO LENGTH
         CI,R0    X'1FFF'
         BG       FITERR            TOO LONG
         BAL,R0   GETBBUF           GET A BUFF1
         LI,R1    512
         LW,D1    BUFF2-1,R1
         STW,D1   BUFF1-1,R1        MOVE BUFF2 (FIT) TO BUFF1
         BDR,R1   %-2
         LW,D1    FITCFU+CDAM
         STW,D1   BCDA,R6           SAVE FIT DISK ADDRESS
         LI,R2    0
         LI,R3    X'E0000'
         STS,R2   CBD,R6            FORCE WRITE OF ENTIRE BUF1
         LB,D1    J:BASE+7          FOR PRIVATE FILES SET UP
         AI,D1    3**7                J:BASE WITH
         SLS,D1   6                   FORMATTED PAX
         STW,D1   J:BASE+10
         LW,D1    J:BASE+7            AND FDA.
         STW,D1   J:BASE+11
         STB,R1   J:BASE+11         CLEAR OLD PAX AREA.
*
         BAL,R0   CLRBFUB           WRITE OUT THE FIT
*
         OVERLAY  OPNSEG,4          DO PART OF NAME CHANGE PROCESSING
         LW,R5    TCFU,R6
         LW,R5    SCFU,R5
         CI,R5    X'FFFF'           IS THERE ONE?
         BAZ      FIT51             SKIP IF NOT
         LW,D1    6,R5              REMAP THE
         BEZ      FIT51              BUFFERS IF NEEDED
         LI,D2    BUF1MSK
         STS,D1   BUFX,R6
         BAL,R0   MAPBUFS
FIT51    RES      0
         PULL     SR3               ERROR CODE
         AI,SR3   0
         BNEZ     FITERR            ERROR
         BAL,SR4  DELAA             DELETE IT
*
FIT60    B        PULLEXIT          DONE
*
CHNGER09 LW,SR3   =X'1200000A'      0A-09
FITERR   STW,SR3  J:CLS             SAVE THE ERROR CODE
         B        PULLEXIT          GET OUT
*
CLSVLP   DATA,1   0,1,3,5,6,X'14',X'15'    LEGAL VLP CODES
#CLSVLP  EQU      BA(%)-BA(CLSVLP)-1
         BOUND    4
         SPACE    2
LOCCODEC LI,D1    9                 FIND X'09' VLP
LOCCODEB LI,R7    BUFF2+WFNEMAX+5
         LW,R3    BUFF2+NAVX
         CI,R3    X'8000'
         BAZ      LOCCODE5          BR IF CONSEC
         AI,R7    NWFITST-4
         CI,R3    X'4000'
         BANZ     LOCCODE5          BR IF FULL GRANULE
         AI,R7    -(WXBUFSIZ/2)
*        FALL INTO LOCCODE5
LOCCODE5 LI,R3    0
LOCCODE1 LW,D2    *R7,R3            GET NEXT CONTROL WORD
         AI,R3    1                 POINT TO DATA WORD
         CB,D1    D2
         BE       1,R5              FOUND DESIRED VLP
         CI,D2    X'10000'
         BANZ     0,R5              BR IF NO MORE VLPS
         AND,D2   M8                # RESERVED WORDS IN THIS VLP
         AW,R3    D2
         B        LOCCODE1
         END

