*M*      DLT      THE DELETE RECORD & RELEASE FILE MODULE.
MONPROC  SET      1
BITS     SET      1
DISCBPROC SET     1                                                     DISCB
         SYSTEM UTS
         PCC      0
DLT:     EQU      %
         SPACE    3
*P*      NAME:    DLT
*P*      PURPOSE  TO DELETE RECORDS, RELEASE FILES, & DELETE
*P*               NAMES FROM DIRECTORIES.
         PAGE
         BOUND    8
K2       EQU      2
K0       EQU      X'0'
K1       EQU      X'1'
K3       EQU      X'3'
K4       EQU      X'4'
K5       EQU      X'5'
K15      EQU      X'15'
K1FFFF   EQU      X'1FFFF'
KN3      EQU      -X'3'
         SPACE    3
         OPEN     WXBUFSIZ,XBUFSIZ
WXBUFSIZ EQU      X'200'
XBUFSIZ  EQU      X'800'
         PAGE
         SPACE    2
RELBUF   EQU      BUFF1
REL:NAV  EQU      RELBUF
REL:CNT  EQU      RELBUF+1
REL:NDA  EQU      RELBUF+2
REL:FDA  EQU      RELBUF+3
         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
         SPACE    4
W14      EQU      14
W19      EQU      19
         PAGE
         DEF      DLT:              MODULE NAME FOR PATCHING
         DEF      REL               RELEASE FILE GRANULES
         DEF      DELF              DELETE A FILE
         DEF      DELAA             DELETE FILE OR ACCT NAME
         DEF      DELFWD            DELETE ALL RECORDS BEYOND CURR POSN
         DEF      DELETE            M:DELREC CAL ENTRY
         DEF      DELSET            RETURN FROM IORT FOR M:DELREC
         DEF      DELO              RELEASE FILE DRCTRY ENTRY
         SPACE    3
         REF      DOUBLEZERO        DBLWD OF ZEROS
         REF      DOUBLEONE         DBLWD 1,1
         REF      EOFMITST          END OF FILE(DRCTRY) TEST
         REF      FNDKYT            FIND NXT REC SEG MVNG BACK
         REF      GETCMD            GET POSN IN MI(BUFF2) BFR
         REF      GETCSA            GET DISK ADDR OF CURR MI GRAN
         REF      GETFUN            GET FUN FROM DCB
         REF      GETSEC            GET A MI(BUFF2) BFR
         REF      MSREXIT           NORMAL CAL EXIT PATH
IOSEQX   EQU      MSREXIT
         REF      KEYER4            ABNORMAL 13
         REF      MSRRDWT           CAL SETUP IN IORT
         REF      MSR01EXIT         ERROR EXIT FROM CAL PATH
         REF      PRCRD1            FIND PREVIOUS POSN IN MI
         REF      PULLEXIT          NORMAL STACK EXIT
         REF      PULLFOUR          GET NXT 4 BYTES FROM MI
         REF      RBG               RELEASE BACKGROUND GRANULE
         REF      SETCMD            SET MI POSN TO BEG OF GRAN
         REF      SETCMD1           SET MI POSN AS SPECIFIED
         REF      SETEOPW           SET EOP TO WRITE & MRK BFR UPDATED
         REF      SETTRN            SET THE TRN BIT IN DCB
         REF      SETUPUB           FIND A SPECIFIED KEY
         REF      TRNTST            TEST THE TRN BIT IN DCB
         REF      WRTSEC            WRITE THE MI(BUFF2) BFR
         REF      MSRWRTX           NORMAL CAL EXIT PATH
         REF      PUSHALL           SET STACK MARKER
         REF      CHKBIT0           GET 1ST ENTRY IN FPT
         REF      PULLALLEXIT       FIND STACK MRKER & EXIT
         REF      GETBBUF           GET A BLKNG(BUFF1) BFR
         REF      SETBLK            SAVE DCB INFO IN STACK
         REF      Y03               BITS 6&7
         REF      RESBLK            RETRIEVE DCB INFO FROM STK
         REF      Y07               BITS 5-7
         REF      CLRBBUF           CLEAR THE BLKNG(BUFF1) BFR
         REF      CLRBFUB           CLR THE MI(BUFF2) BUFFER
         REF      YC                JOB FILE DISP FLAG
         REF      ISEQICR1          PASS OVER KEY INFO IN ENTRY
         REF      FMCHKDA           VERIFY VALIDITY OF DSK ADDR
         REF      GETORG            GET THE ORGANIZATION FROM DCB
         REF      GETVNO            GET VOLUME # FROM DCB
         REF      PRIVDCB           TEST THE PRIV BIT IN DCB
         REF      SETPVI            SET PRIV VOL INDICATORS
         REF      SETVNO            SET THE VOLUME #
         REF      RNVAT             RELEASE GRANULE FRM NXT VOL
         REF      RPVCYL            RELEASE PRIV VOL CYLINDER
         REF      FNDHGP            FIND THE HEAD OF GRAN POOL
         REF      RCYL              RELEASE PUBLIC CYLINDER
         REF      IOSPIN            RUNDOWN THE I/O ON A DCB
         REF      PRDCRM            PERM GRAN ACCTG CELL IN JIT
         REF      TMDCRM            TEMP GRAN ACCTG CELL IN JIT
         REF      J:JIT             JOB INFO TABLE
         REF      SWXPV             SWITCH PRIV VOLUME
         REF      J:CLS             READ ERROR CTL CELL IN JIT
         REF      ERFILDA           REPORT A 75 ERROR
         REF      YFFFF             BITS 0-15
         REF      SETUPWR           SET UP FOR SHARED KEYED WRITE
         REF      J:BASE            TEMP STORAGE DURING FILE RELEASE
         REF      REDSECL           READ MI OR DIRECTORY WITH LINK CHECK
         REF      FNESCR            SET UP SCR AND IMT FOR FILE DIR
         REF      ACNTBL            TABLE OF ACCOUNT DIR DISK ADDRS
         REF      ACNCFU            CFU FOR ACCOUNT DIRECTORY
         REF      PVQUEUE           READ DISK
         REF      LOCKEYUB          FIND LAST KEY ACCESSED
         REF      FILCFU            THE FILE CFU
         REF      SETEOP            SET ENDING OPERATION IN DCB
         REF      SEQPOSD           FIND POSN IN CONSEC FILE
         REF      YFF               BITS 0-7
         REF      SEQREAD           READ A CONSEC FILE GRANULE
         REF      MULSEG            OVERLAY WITH THE MUL MODULE
         REF      1A7               MOVE FORWARD IN MI
         REF      FNDKY             FIND ENTRY IN MI
         REF      NB31TO0           TABLE CONSTANTS
CYLFLG   EQU      FILCFU+FILDISP+6
         TITLE    '**** DLT ****'
         SPACE    2
*F*      NAME:    DELETE
*F*      PURPOSE  TO PROCESS M:DELREC CALS.
*
*D*      NAME:    DELETE
*D*      REGISTERS  NORMAL CAL SETUP AND SAVE PRECEEDS
*D*      CALL     DIRECT BRANCH THROUGH T:OV
*D*      ENVIRONMENT  MAPPED MASTER
*D*      DESCRIPTION  DELETES A RECORD FROM A FILE. IF KEYED,
*D*               ZAP THE KEY LENGTH BYTE(S) FOR THE RECORD
*D*               SEGMENT(S) OR SLIDE UP OVER THE ENTRIES IN THE
*D*               MI IF NOT MASTER OF A DATA GRAN OR 1ST IN
*D*               GRANULE. FOR CONSECUTIVE, ERASE THE FAK BIT.
         SPACE    2
*  M:DELREC CAL
*
DELETE   EQU      %                 DELETE RECORD
         BAL,R1   PUSHALL
         LI,SR4   14
         CW,SR4   ASN,R6
         BANZ     MSRWRTX           NOT A FILE
         BAL,D2   GETFUN
         CI,D1    1
         BANZ     DELER             M:DELREC NOT ALLOWED FOR INPUT DCBS
         BAL,R2   CHKBIT0
         B        %+1
         AND,D2   D1
         LW,D1    0,R7
         SLS,D1   -4
         PUSH     2,D1
         LW,R7    TSTACK
         AI,R7 -2             NEW PLIST, FAKING OUT RDF
******   PULLALLEXIT WILL BALANCE STACK   *******
         LI,SR4   PULLALLEXIT       SET RETURN
         B        MSRRDWT           DECODE FPT
*
*D*      NAME:    DELSET
*D*      DESCRIPTION  RETURN HERE FROM IORT AFTER DECODING THE
*D*               FPT.
         SPACE    2
*  RETURN HERE FROM IORT AFTER DECODING FPT
*
DELSET   EQU      %
         BAL,R4   SETUPWR           SET UP FOR SHARED WRITE
         B        MSRWRTX           IT'S RANDOM
         LI,D4    K1FFFF
         AND,D4   KAD,R6
         BNEZ     DELSET1
         LW,D2    Y0004
         CW,D2    EOP,R6
         BAZ      DELER
*
         LI,D2    X'20'
         CW,D2    ORG,6
         BAZ      SEQ0              CONSECUTIVE
         BAL,D2   SETTRN            DELETE KEY PREV READ
         BAL,SR4  PRCRD1
DELSET2  EQU      %
         BAL,11   DEL
         B        IOSEQX
DELSET1  EQU      %
         BAL,SR4  SETUPUB
         B        KEYER4            DELETE DELETED KEY
         B        DELSET2
DELER    EQU      %
         LI,SR3   K15
         B        MSR01EXIT
*E*  ERROR:        15-00
*E*  DESCRIPTION:  ILLEGAL M:DELREC OPERATION.
         SPACE    4
*
*  DELETE CONSECUTIVE FILE RECORD
*
SEQ0     LI,12    X'80000'          SET WRITE OP BUT
         BAL,0    SETEOP             NO MIUD
         LW,0     Y02
         CW,0     TRN,6             CHK FOR READ BACKWARDS
         BANZ     %+2               YUP
         MTW,-1   W19,6             TO BACK UP 1
         BAL,7    SEQPOSD           FIND THE SPOT
         B        %+2               FILE NOT EMPTY
         B        DELER             EMTY FILE
         LW,7     Y004
         STS,7    BFL,6             REGISTER UPDATE
         LW,R1    Y4                WIPE OUT
         STS,R0   BUFF1,R3           THE FAK BIT
         LW,1     CFU,6
         MTW,-1   TDA,1             1 LESS REC IN FILE
         B        IOSEQX            GET OUT
         PAGE     DELRECUB
         SPACE    2
*
*  DELETE KEY FROM KEYED FILE OR DIRECTORY
*
DEL      EQU      %
         PUSH     1,SR4
         BAL,R0   GETSEC
         BAL,R0   GETCMD
DELRECUB1 EQU     %
         BAL,R0   SETEOPW
         LB,R4    BUFF2,R3
         BEZ      DEL12+1
         LI,R2    K0                CLEAR FIRST BYTE TO SIGNAL NULL
         STB,R2   BUFF2,R3            KEY
         AW,R4    R3
         AW,R3    IMT,R6
         AI,R3    -13               ISEQICR1
         AI,R4    1
         CW,R4    R3
         BGE      DEL12
         STB,R2   BUFF2,R4          ZAP UNUSED KEY POSITIONS
         B        %-4
DEL12    RES      0
         BAL,R0   GETCMD
         BAL,R0   ISEQICR1
         BAL,R0   PULLFOUR
         CI,D1    X'F0000'
         BANZ     DELF31            NOT CONTROL KEY
         CI,D1    BUFSIZ-15
         BGE      DEL13             FULL GRANULE
         BAL,R0   PULLFOUR
         AI,D1    0
         BEZ      DEL1
         AI,R3    K5
DEL11    RES      0
         BAL,R0   SETCMD1
         BAL,R0   EOFMITST          AT END OF FILE
         B        DELREC2A          YES
DELRECUB4  EQU    %
         CI,R2    K1                IS THIS RECORD CONTINUED
         BAZ      DELX
         CH,R3    BUFF2+NAVX
         BL       DELRECUB1
         LW,D1    BUFF2+FLINK       PICK UP FLINK
         BAL,R0   GETCSA
         BAL,R0   REDSECL           READ SECTOR WITH LINK CHECK
         BAL,R0   SETCMD
         B        DELRECUB1
*
DELREC2A AI,R3    -3
         LB,R0    BUFF2,R3
         AND,R0   NB31TO0+2         RESET EOF FLAG ON THIS KEY
         STB,R0   BUFF2,R3
         AI,R3    3                 POINT BACK TO NEXT KEY
DELRECUB2 EQU     %
*                                   SET UP NEW END OF FILE
         BAL,R0   FNDKYT            FIND NOW NULL ENTRY--EVEN IF MORE
*                                   THAN ONE SECTOR MUST BE SEARCHED
         B        DELRECUB5         BOF RETURN
*                                   SET EOF BIT
         BAL,R0   GETCMD
         AI,R3    KN3
         LB,R0    BUFF2,R3
         OR,R0    X2                SET THE EOF BIT
         STB,R0   BUFF2,R3
         BAL,R0   SETEOPW
         B        DELX
DELRECUB5 EQU     %
         LW,11    Y8
         LI,1     X'1FFFF'
         AND,1    CFU,R6
         CI,1     FILCFU
         DO       0
         BE       DELFD             DELETE ENTIRE FILE DIRECTORY
         BL       DELX              IGNORE DELETE ACCOUNT DIR
         ELSE
         BLE      DELDIR            ENTIRE DIRECTORY DELETED
         FIN
         STS,11   *TSTACK
         B        1A5
         SPACE    2
DELDIR   STS,11   FDA,R1            SET EMPTY FLAG
         MTB,1    CYLFLG            SET FILCFU CHANGED FLAG
         B        DELX              GET OUT
         SPACE    2
*
*  DELETING ENTIRE FILE DIRECTORY - MUST FIRST DELETE
*  ENTRY IN ACCOUNT DIRECTORY
*
         DO       0
DELFD    EQU      %
         LW,R0    CYLFLG
         CW,R0    Y008              CHK 4 MASTER OF CYLINDER
         BANZ     DELX
         STW,R0   FILCFU+ACNDISP    FORCE FINDFIL1 TO READ AD
         REF      FINDFIL1          LOCATE ENTRY IN ACCT DRCTRY
         BAL,R0   FINDFIL1          FIND ACCOUNT IN AD
         B        DELFD5            DIDN'T FIND
         STW,R0   FILCFU+ACNDISP    ACCOUNT NO LONGER EXISTS
         AI,R3    -13
         LI,R2    HACMD
         STH,R3   *R6,R2            POINT CMD TO START OF KEY
         BAL,SR4  DELAA             DELETE THE ENTRY
         BAL,R0   CLRBFUB           RE-WRITE AD GRANULE
*
DELFD5   RES      0
         BAL,R0   FNESCR            RESTORE SCR
         B        1A5               GO DELETE FD GRANULES
         FIN
         SPACE    2
DELX     EQU      %
         PULL     1,SR4
         CI,SR4   X'8000'
         BGE      *SR4
         DESTRUCT                   RELEASE OVERLAY
*
DEL13    RES
         BAL,R0   PULLFOUR
         PUSH     15,R1
         BAL,R0   TOPDA
         LI,R0    DEL11-1
         CI,SR3   1
         BG       DEL14-1
         BE       DEL14
         LI,SR4   10
         LW,R3    TSTACK
         LW,R3    -12,R3            RESTORE MI POSITION
         AI,R3    2
         AI,R3    -1                ZAP THE
         STB,SR3  BUFF2,R3           DISK
         BDR,SR4  %-2                 ADDRESS
         BAL,R0   RELRBG
         LI,R0    DEL1
DEL14    PULL     15,R1
         B        *R0
*
*D*      NAME:    DELF
*D*      DESCRIPTION  RELEASE A FILE & ITS FIT AS REQUIRED.
DELF     EQU      %
         PUSH     1,SR4
         BAL,R0   CLRBFUB
         BAL,R0   FNESCR            GET RID OF FITCFU
         LI,R1    FILCFU
         LW,D4    FILCFU+SREC
         LI,D2    X'30'
         CS,D2    ORG,R6
         BNE      DELO              BR IF NOT RANDOM FILE
         BAL,R0   SETFPOOL
*D*      NAME:    DELO
*D*      DESCRIPTION  REMOVE A FILE NAME FROM THE FILE DRCTRY
DELO     EQU      %                 RELEASE FD ENTRY ON OPEN
         BAL,R0   CLRBFUB
         LW,D1    CDA,R6
         BAL,0    FNESCR
         STW,R3   FILCFU+CDAM
         LW,D2    FILCFU+16         EXPECTED BLINK
         BAL,R0   REDSECL
         B        DELF3
*D*      NAME:    DELAA
*D*      DESCRIPTION  DELETE FILE NAME OR ACCOUNT NUMBER
DELAA    EQU      %
         PUSH     1,SR4
DELF3    EQU      %
         BAL,R0   SETEOPW
         BAL,R0   GETCMD            DELETE FILE NAME OR ACCOUNT NO
         BAL,R0   ISEQICR1
         AI,R3    4
DELF31   EQU      %
         AI,R3    K4
*                                   FALL THROUGH TO DEL1
         PAGE
DEL1     EQU      %
         AI,R3    K2
         LW,R2    R3
         LW,R3    CMD,R6
         LH,R3    R3                GETCMD
         LI,R1    X'1FFFF'
         AND,R1   CFU,R6            GETCFU
         CI,R1    FILCFU
         BGE      DEL15
*  ACCOUNT DIRECTORY NEW FORMAT
         AI,R2    2
         LB,SR4   BUFF2,R2          FLAG BITS
         AI,R2    1                 MOVE TO NEXT ENTRY
         B        DEL16
*
DEL15    LB,SR4   BUFF2,R2          FLAG BITS
         AI,R2    3                 MOVE TO NEXT ENTRY
DEL16    RES      0
         CI,R3    MIDIS
         BNE      DEL3
         CI,R1    FILCFU
         BLE      DEL3
         LW,R3    R2
         B        DEL11
*                                   SLIDE UP NULL ENTRY
DEL31    LB,R0    BUFF2,R2
         STB,R0   BUFF2,R3
         AD,R2    DOUBLEONE
DEL3     CH,R2    BUFF2+NAVX
         BL       DEL31
*                                   RESET NAV
         STH,R3   BUFF2+NAVX
         CI,R3    MIDIS
         BG       %+2               NOT EMPTY
******  INSERT CODE TO WAKE UP THE GHOST  ******
         STW,R3   BUFF2+NAVX+1      BLITZ 1ST ENTRY
         BAL,R0   GETCMD
         CI,SR4   K2
         BANZ     DELRECUB2
         LW,R2    SR4
         B        DELRECUB4
*
SETFPOOL EQU      %                 ENTER SECTOR INTO TABLE OF FREE
*                                   SECTORS
         PUSH     6,0
         LW,SR1   D4
         BAL,SR4  FMCHKDA
         BCR,15   1A6               BAD DISK ADDRESS
         LW,D1    D4
         BAL,0    TOPDA
         AI,SR3   0
         BEZ      1A8               IT'S NOT CYLINDR
         BAL,R0   PRIVDCB
         BANZ     1A3               BR IF PRIVATE
         CI,SR3   2
         BANZ     1A3               BR IF NOT 1ST IN CYL
1A8      RES      0
         BAL,0    RELRBG            RELEASE THE GRAN
1A6      RES      0
         PULL     6,0
         B        *R0
1A3      PULL     5,1
         LW,R4    ACNCFU+4          SAVE DUAL
         LI,D2    0                 SET BLINK=0 FOR REDSEC OR SETFP4
         LW,D1    FSP,R1
*                                   NO FLP POOL
         BEZ      SETFP4
SETFP3   EQU      %
*E*  ERROR:        75-00
*E*  DESCRIPTION:  ERROR IN FREE-SECTOR POOL.  THE FREE-SECTOR POOL
*E*                IS DISCARDED.  THE USER SEES NO ERROR.
         LW,R3    =X'800100'        75-00 IF ERR, DON'T CHK SCR
         STS,R3   J:CLS               ERROR, RETURN IF ERROR
         BAL,R0   REDSECL
         LW,R3    BUFF2
         BLZ      SETFPZ            ERROR
         LH,R2    BUFF2+NAVX        ANY ROOM
         CI,R2    WXBUFSIZ
         BGE      SETFP2
         STW,D4   BUFF2,R2          ADD DISC ADDRESS
         MTH,1    BUFF2+NAVX        INCREMENT NAV
         B        SETFPO
SETFP2   EQU      %
         LW,D2    CDAM,R1
         LW,D1    BUFF2+FLINK       PICK UP FLINK
         BNEZ     SETFP3
         STW,D4   BUFF2+FLINK       SET UP NEW FORWARD LINK
         BAL,R0   WRTSEC
SETFP4   RES                        SET UP NEW GRANULE
         BAL,R0   GETSEC            RESTORE BUFFER
         LW,SR4   D2                NEW BLINK
         LI,D1    0                 NEW FLINK
         LI,R2    BASCR
         LB,D2    *R6,R2
         AI,D2    X'30000'
         LCI      K3
         STM,SR4  BUFF2             PUT IN NEW HEADER INFO
         STW,D4   CDAM,R1
         AI,SR4   0
         BNEZ     SETFPO
         MTB,1    CYLFLG            SET FILCFU INFO UPDATED
         STW,D4   FSP,R1
SETFPO   BAL,R0   WRTSEC            WRITE OUT BUFFER
SETFPZ   STW,R4   ACNCFU+4          RESTORE DUAL
         B        PULLEXIT
         PAGE
         SPACE    2
*
*  DELETE FORWARD - CONSEC FILE
*
SEQ2     BAL,R7   SEQPOSD           ESTABLISH POSITION
         B        %+2               NOT EMPTY
         B        DELX              ALREADY EMPTY
         LW,R2    Y004              TO SET BBUD
         B        SEQ4
         SPACE    2
*
*  DELETE CONSECUTIVE FILE
*
SEQ3     EQU      %
         LW,R3    FDA,R1
         AND,R3   M31               RESET EMPTY FILE BIT
         STW,R3   FDA,R1
*
         LI,R3    0                 SET BOF
         STW,R3   W19,R6            NO SKIP
         BAL,R0   SETCMD1
         BAL,R7   SEQPOSD           FIND BOF
         B        %+2               NOT EMPTY FILE
         B        DELX              ALREDY EMPTY
         LW,R1    CFU,R6            GET 1ST
         LW,D1    FDA,1              GRAN
         XW,D1    DCBCDAM,R6
         CW,D1    DCBCDAM,R6
         BE       %+2
         BAL,R4   SEQREAD
         LI,R3    3                 AND 1ST
         BAL,R0   SETCMD1            POSITION
         LI,R2    0                 TORESET BBUD
SEQ4     LW,R3    Y004              MASK FOR BBUD
         STS,R2   BBUD,R6           SET OR RESET BBUD
         STW,R2   W19,R6
         PUSH     R2
         BAL,R0   GETCMD            SAVE
         LW,R2    DCBCDAM,R6         CURRENT POSITION
         LI,R4    0                 FOR GRANULE RELEASE
         LW,R5    CFU,R6
         LI,R1    0                 NO GRAN POOL
         XW,R1    GAVAL,R5
         PUSH     4,R1
         LW,R0    W19,R6
         STW,R3   W19,R6            1ST GRAN FLAG
         BNEZ     SEQ5              NOT RELEASE
SEQ40    LW,D1    DCBCDAM,R6        CURR GRAN
SEQ41    BAL,R0   TOPDA             CHK WHAT KIND
         CI,SR3   1
         BL       SEQ42             GRAN NOT CYL
         BE       SEQ43             TOP OF CYL
         LW,D3    *TSTACK
         BNEZ     SEQ5              NOT IN 1ST GRAN
         LW,R1    CFU,R6
         LW,D3    GAVAL,1
         BNEZ     %+2               NOT 1ST GRAN IN CYL
         LW,D3    D1                1ST GRAN REL'D & COUNT
         AW,D3    Y01               UP COUNT
         STW,D3   GAVAL,1
         B        SEQ5
         SPACE    3
SEQ43    LI,R3    -3                SET NOT 1ST
         STW,R3   *TSTACK,R3         CYL FLAG
SEQ42    RES      0
         XW,D1    *TSTACK           GET LAST ONE
         LW,SR1   D1
         BAL,R0   RELRBGD           DUMP IT
SEQ5     EQU      %
         LC       BUFF1+2
         BCR,8    SEQ8              NO UNBLOCKED SEGS
         BAL,R0   GETCMD
SEQ61    CI,R3    BUFSIZ**-2        CHK END OF BFR
         BGE      SEQ8              OFF THE END
         LI,R1    1
         CH,R3    BUFF1+2,R1        CHECK NAV
         BG       SEQ8              BEYOND LAST
         LW,R0    BUFF1,R3          SEG CONTROL WORD
         AI,R3    1
         AI,R0    0                 CHK UNBLOCKED
         BGEZ     SEQ7              NOT UNBLOCKED
         LW,D1    M24
         AND,D1   0                 DISK ADDR
         LI,R0    SEQ41             SET RTN
         B        SETCMD1
SEQ7     INT,R0   0
         AI,R0    3                 ROUND UP THE BYTE COUNT
         SLS,R0   -2
         AW,R3    0                 NXT POSN
         B        SEQ61
         SPACE    4
SEQ8     EQU      %
         LW,R2    BUFF1+FLINK       GET FLINK
         LI,R3    -4
         LW,R3    *TSTACK,R3
         BNEZ     SEQ8A             BR IF NOT FULL RELEASE
         LW,R1    CFU,R6            MARCH FDA SO THAT RECOVERY
         STW,R2   FDA,R1              CAN CONTINUE WITH RELEASE
SEQ8A    XW,R2    W19,R6
         BEZ      SEQ81             NOT 1ST GRAN
         LI,D1    0
         LW,R3    R2                SEG CTL POSN
         STW,D1   BUFF1+FLINK       RESET FLINK
         LW,R1    BUFF1,R2          SEG CONTROL WORD
         BGEZ     SEQ82             BLOCKED
         AI,R3    -1                BACK UP
         STW,R3   BUFF1,R2          SET BACKSPACE CONTROL WD
         LC       R1
         BCR,1    SEQ83             PREV SEQ NOT BACKSPACE CONTROL
         AI,R2    -1                END OF GRANULE IS PREV CNTL WD
         B        SEQ83
SEQ82    SLS,R3   1                 HALFWORD ALIGN
         STH,D1   BUFF1,R3          ZAP OUT CTL AND SIZE
SEQ83    RES      0
         LW,R3    Y8FFF             MASK
         LS,R2    BUFF1+2           GET RECORD COUNT
         STW,R2   BUFF1+2
         LW,D1    W19,R6            CHECK
         BEZ      SEQ9               EOF
         BAL,R0   CLRBBUF           UPDATE LAST GRAN
SEQ81    LI,D1    0
         XW,D1    W19,R6            GET FLINK
         BEZ      SEQ9              END OF FILE
         BAL,R0   PRIVDCB
         BAZ      SEQ71
         LI,R2    BAVNO
         LDCTX,R0 D1
         CB,R0    *R6,R2
         BE       SEQ71             NO VOL SWITCH
         LW,SR1   *TSTACK
         STW,D1   *TSTACK
         BAL,R0   RELRBGD
         LW,SR1   *TSTACK
         BAL,R0   RELRBGD
         LI,D1    -1
         XW,D1    *TSTACK
SEQ71    RES      0
         LI,R3    3                 SET BEG OF GRAN
         BAL,R0   SETCMD1
         BAL,R4   SEQREAD           RAED NXT GRAN
         XW,D1    DCBCDAM,R6
         CW,D1    BUFF1             LINK CHECK
         BE       SEQ40             OK
SEQ9     LW,SR1   *TSTACK           LAST GRAN TO REL
         BAL,R0   RELRBGD
         PULL     4,R1
         LW,R5    CFU,R6
         LW,R0    W14,R6
         MTW,0    *TSTACK
         BNEZ     SEQ92             NOT RELEASING FILE
         STW,R0   FDA,R5            RESET 1ST GRAN
         SD,R2    R2                NOTHING LEFT
SEQ92    STW,R0   TDA,R5            # OF RECS LEFT
         STW,R2   LDA,R5            NEW EOF
         STW,R2   DCBCDAM,R6        NEW POSN
         PULL     R0
         AI,R1    0
         BLEZ     SEQ97             GRAN POOL IS OK
         LW,R2    GAVAL,R5          FIX
         BEZ      %+2                GRAN
         AND,R1   YFF                 POOL
         AWM,R1   GAVAL,R5
SEQ97    AI,R0    0
         BNEZ     %+2               NOT RELEASING FILE
         BAL,R0   CLRBBUF           CHUCK THE BUFFER
         LI,R0    DELX              SET RTN
         B        SETCMD1
Y8FFF    DATA     X'8FFF0000'
         PAGE
*
*
*D*      NAME:    REL
*D*      DESCRIPTION
*DO*
*D*
*        RELEASE FILE GRANULES
*
*    FORMAT OF RELBUF (BUFFER OF DISC ADDRESSES TO BE RELEASED):
*
*  WORD
*   0    REL:NAV  ADDRESS OF NEXT AVAILABLE WORD IN BUFFER.
*                   CHANGED TO DISC ADDRESS OF BLOCK WHEN WRITTEN.
*   1    REL:CNT  # WORDS AVAILABLE.  CHANGED TO # WORDS USED WHEN
*                   BLOCK WRITTEN.
*   2    REL:NDA  DISC ADDRESS OF NEXT BLOCK IN CHAIN.
*   3    REL:FDA  DISC ADDRESS OF FIRST BLOCK IN CHAIN.
*   4             FIRST DISC ADDRESS TO BE RELEASED.
*   5             SECOND DISC ADDRESS TO BE RELEASED
*
*    NOTE:  SOME OF THE DISC ADDRESSES MAY BE ZERO.
*FIN*
*
*
*
REL      EQU      %
         PUSH     1,SR4
1A5      RES      0
         LI,R1    X'1FFFF'
         AND,R1   CFU,R6            CFU ADDRESS
         LI,0     X'20'
         CW,0     ORG,6
         BANZ     REL1A
         CI,R1    FILCFU
         BG       SEQ3              NEW CONSECUTIVE
REL1A    RES      0
         BAL,R0   CLRBBUF
         BAL,R0   GETSEC
         LW,D1    FDA,R1            IS THIS FILE ALREADY RELEASED
         AND,D1   M31
         BEZ      DELX
*                 GET  BB  AND  INITIALIZE
         BAL,0    GETBBUF
         LI,R2    RELBUF+4
         STW,R2   REL:NAV           NEXT AVAILABLE SLOT
         LI,D3    508
         STW,D3   REL:CNT           # AVAILABLE SLOTS
         LI,D3    0
         STW,D3   REL:NDA           DISC ADDR OF NEXT BLOCK
         STW,D3   REL:FDA           DISC ADDR OF FIRST BLOCK
         LC       *R1                FOR
         BCR,2    NOMULTI             NO MULTI-LEVEL
         OVERLAY  MULSEG,1          RELEASE UPPER LEVELS
         LW,R1    CFU,R6
         LW,R3    Y2
         LI,R2    0
         STS,R2   0,R1              RESET O-BIT IN CFU
NOMULTI  RES      0
         LI,D2    0                 FOR LINK CHECK
         STW,D2   SREC,R1
         STW,D2   GAVAL,R1
         STW,D2   TDA,R1
         B        %+2
RELFILUB3 BAL,R0  GETCSA
         LW,D1    FDA,R1            DISC ADDR TO READ
         BEZ      REL30             DONE
         LI,R3    X'200'            RETURN HERE IF ERROR
         STS,R3   J:CLS
         BAL,R0   REDSECL
         LW,R3    BUFF2
         BLZ      REL30             ERROR
         LW,R0    BUFF2+FLINK
         STW,R0   FDA,R1
         LW,R0    BUFF2+NAVX
         STW,R0   J:BASE+5
         BAL,R0   GETCSA
         LW,R3    *TSTACK
         BGZ      REL29             FULL RELEASE
         LI,R4    X'8000'
         CW,R4    BUFF2+NAVX
         BAZ      REL29             NO FIT HERE
         OR,D2    Y8                MARK EMPTY
         STW,D2   TDA,R1
         LI,R3    MIDIS
         STH,R3   BUFF2+NAVX        FIX UP 1ST GRAN AS EMPTY
         LD,R2    DOUBLEZERO
         STD,R2   BUFF2
         LW,R3    Y002              NARK THE UPDATE
         STS,R3   MIUD,R6
RELFILUB2 EQU     %
         LI,R3    MIDIS
RELFILUB4   EQU   %
         CH,R3    J:BASE+5
         BGE      RELFILUB3         BR IF DONE
         BAL,R0   ISEQICR1
         BAL,R0   PULLFOUR
         CI,R1    FILCFU
         BLE      REL9
         CI,D1    X'F0000'
         BAZ      REL9              DISPL = 0, RELEASE GRANULE
         AI,R3    9
         B        RELFILUB4
REL29    RES      0
         LW,D1    D2
         BAL,R0   TOPDA             CHECK FOR GRAN/CYL BOUNDARY
         LI,R0    RELFI             RETURN FROM SGAIBB/RELRBG
         CI,SR3   1
         BE       SGAIBB            CYL MASTER - TABLE IT
         BL       RELRBG            GRANULE - RELEASE IT
RELFI    CW,D1    ACNCFU+4          CHK DUAL
         BE       RELFILUB2         DONE
         LI,R1    X'1FFFF'
         AND,R1   CFU,R6
         CI,R1    FILCFU
         BG       RELFILUB2         NOT A DIRECTORY
         LW,D2    ACNCFU+4
         B        REL29
*
REL9     EQU      %
         BAL,R0   PULLFOUR          GET GRANULE ADDRESS
         PUSH     1,R3              SAVE DISPLACEMENT
         BAL,R0   TOPDA            *DETERMINE WHETHER DISC ADR AT TOP
*                                   OF GRANULE/CYLINDER
         CI,SR3   K1
         BG       REL9B             DISC ADR NOT TOP OF GRAN/CYL
         BE       REL9A
         BAL,R0   RELRBG
         B        REL9B
REL9A    BAL,R0   SGAIBB           *DISC ADR AT TOP OF CYL,SAVE AND
*                                   RELEASE LATER
REL9B    BAL,R0   GETSEC
         PULL     1,R3
         AI,R3    K5
         B        RELFILUB4
*
REL30    LI,R3    0
         BAL,R0   SETCMD1           ZERO CMD
         AND,R1   M17
         LI,D1    0
         XW,D1    TDA,R1            NEW FDA
         STW,D1   FDA,R1
         CI,R1    FILCFU
         BLE      RELFSP            BR IF DIRECTORY
         LI,R4    X'FFFF'
         AND,R4   SCFU,R1
         STW,R4   SCFU,R1           ZERO CCBD
         BEZ      REL38             NO SECONDARY CFU
         LI,R3    X'8000'
         CW,R3    0,R1
         BAZ      REL38             NOT SHARED
         STW,D1   FDA,R4            PUT NEW FDA IN INPUT CFU
         AND,D1   M31               REMOVE EMPTY FILE BIT
         STW,D1   LDA,R4            NEW LDA IN INPUT CFU
         LI,R3    0
         STW,R3   TDA,R4            ZERO TDA IN INPUT CFU
REL38    AND,D1   M31
         STW,D1   LDA,R1            NEW LDA IN ORIGINAL CFU
         LI,D1    1
         LI,D2    X'FF'
         STS,D1   0,R1              SET SLIDES=1
         B        RELFILUB5
*
*        RELEASE GRANULES IN FREE SECTOR POOL
*
RELFSP   EQU      %
         DO       0
         LI,D1    0
         XW,D1    FSP,R1
         BEZ      RELFILUB5
         LI,D2    0                 DISC ADR FROM FSP. BLINK SHOULD BE 0
REL6     EQU      %
         LW,R3    =X'800100'        75-00 IF ERROR, DON'T CHK SCR, RET
         STS,R3   J:CLS               HERE IF ERROR
         BAL,R0   REDSECL
         LW,R3    BUFF2
         BLZ      RELFILUB5         ERROR
         BAL,R0   GETCSA
         LW,D1    D2
         BAL,R0   TOPDA             IS DISC ADR AT TOP OF GRAN/CYL
         CI,SR3   K2
         BGE      REL1                  NO,DONT SAVE
         BAL,R0   SGAIBB                YES,SAVE IN BB AND RELEASE LATER
REL1     EQU      %
         LI,R3    K3
REL2     EQU      %
         CH,R3    BUFF2+NAVX
         BGE      REL4
         LW,D1    BUFF2,R3
         PUSH     R3
         BAL,R0   TOPDA             IS DISC ADR AT TOP OF GRAN/CYL
         PULL     R3
         CI,SR3   K2
         BGE      REL5                  NO,DONT SAVE
         BAL,R0   SGAIBB                YES,SAVE IN BB AND RELEASE LATER
REL5     AI,R3    1
         B        REL2
REL4     EQU      %
         BAL,R0   GETCSA
         LW,D1    BUFF2+FLINK       PICK UP FLINK
         BNEZ     REL6
         FIN
RELFILUB5 EQU     %
         BAL,R0   SETBLK            SAVE DCB INFO
         LW,SR3   REL:NDA           NEXT BLOCK IN CHAIN
         BEZ      RGAIBB1           THIS IS ONLY BLOCK
         LW,SR1   REL:FDA           DISC ADDR OF FIRST BLOCK
         LW,SR2   Y8                SET BIT TO FORCE REL:NDA NEGATIVE
         STS,SR2  RELBUF+4            TO INDICATE LAST BUFFER
         BAL,R0   SGABB             WRITE LAST BB
*
*  READ NEXT BLOCK
*
RGAIBBA  STW,SR1  CDA,6
         LW,7     Y03               READ
         BAL,SR2  SGADIO
         LW,SR3   CDA,R6            LAST DISC ADDRESS READ
         CW,SR3   REL:NAV           SHOULD BE IN BUFFER
         BE       RGAIBB4           OK
RELERR   LI,SR1   2                 REPORT 75-02 (NOT TO USER)
         BAL,SR4  ERFILDA
         B        RGAIBBO           EXIT
RGAIBBO  EQU      %
         BAL,R0   CLRBBUF           RELEASE THE BUFFER
         BAL,R0   RESBLK            RESTORE DCB
         B        DELX
RGAIBB1  RES      0
         LW,D1    REL:CNT           # REMAINING SLOTS
         CI,D1    508
         BE       RGAIBBO           NO BLK NO INFO
         STW,SR3  CDA,6             SR3-NDA = 0
         BAL,SR2  SGASET            SET POINTER AND COUNT
         STW,SR3  REL:NAV           0 = DISC ADDR THIS BLOCK
RGAIBB4  RES      0
         LCW,R7   REL:CNT           - # SLOTS USED
         BGZ      RELERR            BAD COUNT
         CI,R7    -508
         BL       RELERR            BAD COUNT
RGAIBB3  EQU      %
         LI,R3    RELBUF+4
         AW,R3    REL:CNT           POINT PAST LAST DISC ADDR
         LW,SR1   *R3,R7            SR1=ADR OF GRAN/CYL TO BE RELEASED
         PUSH     R7
         BAL,R0   RELRBG
         PULL     R7
         BIR,R7   RGAIBB3
         LW,SR1   REL:NAV           DISC ADDR OF CURRENT BLOCK
         BEZ      RGAIBBO           DONE - WAS NEVER WRITTEN
         BAL,R0   RELRBG            RELEASE IT
         LW,SR1   REL:NDA           DISC ADDR OF NEXT BLOCK
         BGZ      RGAIBBA           MORE TO GO
         BAL,R0   RELRBG            NO MORE - RELEASE LAST DA
         B        RGAIBBO           EXIT
*                 DCB:BUF1=BUFFER ADR
*                 R7 =FUN ,R6 =DCB
SGADIO1  GEN,15,17 2048,0
SGADIO   RES      0
         LI,13    X'E0000'
         LW,12    SGADIO1
         STS,12   6,R6              BLK
         LI,8     X'1FFFF'
         AND,8    6                 DCB
         OR,8     7                 FUN
         LI,D1    RELBUF            BUFFER ADDRESS
         LI,D2    K1FFFF
         STS,D1   QBUF,R6
         BAL,SR4  PVQUEUE
         BAL,11   IOSPIN
         B        *SR2
SGASET   RES      0
         LI,R4    508
         SW,R4    REL:CNT
         STW,R4   REL:CNT           # SLOTS USED
*
         LI,R4    RELBUF+4
         STW,R4   REL:NAV           NEXT AVAIL SLOT
         B        *SR2
         SPACE    2
*
*        USES REGS; R0-R5,R7,SR1,SR4,D1,D2,D4
*
RELRBG   EQU      %                 COUNT PERM AND TEMP  DISK SPACE
RELRBGD  EQU      %
         CI,SR1   -1
         BAZ      *R0               ZERO DISC ADDRESS - EXIT
         BE       *R0               SPECIAL DA FOR PRIV PACK - EXIT
         PUSH     1,R0
         BAL,R0   PRIVDCB
         BAZ      RELRBG7
         BAL,R0   GETORG            PRIVATE DISC ADR
         BL       RELRBG4
         LDCTX,R3 SR1                     TO POINT TO VOL OF            DISCB
         BAL,R0   SETVNO                           DISC ADR TO BE
         BAL,D4   SETPVI                           RELEASED
         B        RELRBG6                          TABLE IN R7
*
RELRBG4  LSECTA,5 8                 LOAD SECTOR ADDRESS
         CI,5     60                IF LESS THAN 60, IS NVAT
         BGE      RELRBG5           NOPE
         BAL,R0   GETVNO
         BEZ      PULLEXIT          VOL NOT MOUNTED, EXIT
         LDCTX,R0    SR1                                                DISCB
         AI,R3    1
         CW,R3       R0                                                 DISCB
         BNE      PULLEXIT                      ERROR,DA FROM NVAT ON
*                                                     DIFFERENT VOLUME
         MTW,-1   CLK,R6
         BAL,SR4  RNVAT                            RELEASE GRANULE
         B        PULLEXIT
RELRBG5  BAL,R0   GETVNO
         BEZ      PULLEXIT                      VOL NOT MOUNTED, EXIT
         LDCTX,R0    SR1                                                DISCB
         CW,R3       R0                                                 DISCB
         BE       RELRBG6                      YES
*                                               NO,SWITCH FROM CURRENT
*                                                  VOLUME TO VOL IN DA
         PUSH     D1
         LW,R3    R0
         BAL,R0   SWXPV             SWITCH TO THE NEXT VOLUME
         PULL     D1
         BAL,R0   GETBBUF          *GET ANOTHER BLOCKING BUFFER
         BAL,R0   GETVNO                        WAS THE VOLUME MOUNTED
         BEZ      PULLEXIT                          NO,EXIT
RELRBG6  BAL,SR4  RPVCYL                RELEASE CYLINDER FROM PRIV VOL
         LW,R0    PAT,R6            GET ALLOCATION TABLE                DISCB
         LI,R4    BAATNGC           GET INDEX TO # GRAN/CYL             DISCB
         LB,R4    *R0,R4            GET # GRAN/CYL                      DISCB
         LCW,R0   R4                MAKE NEGATIVE                       DISCB
RELRBG12 LW,R1    CFU,R6
         LI,R4    X'8000'           CHK 4 SHARED
         CW,R4    0,R1
         BAZ      %+4               NOPE
         LW,R4    SCFU,R1
         AWM,R0   SREC,R4
         B        PULLEXIT
         AWM,0    CLK,6
         B        PULLEXIT
*
*  RELEASE PUBLIC DISC ADDRESSES
*
RELRBG7  EQU      %
         BAL,R3   FNDHGP                GET ADR OF DEVICE AT IN R7
         BEZ      PULLEXIT
         LW,R0    1,R7
         CI,R0    ATCYLBIT              IS THE DEVICE ALLOCATED BY CYL
         BANZ     RELRBG9
         BAL,SR4  RBG                       NO,RELEASE GRANULE
         BEZ      PULLEXIT          ERROR
         LI,R5    1                            R5=NO OF GRAN RELEASED
         B        RELRBG11
RELRBG9  BAL,SR4  RCYL                      YES,RELEASE CYLINDER
         BEZ      PULLEXIT          ERROR
         LI,R5    7
         LB,R5    *R7,R5                        R5=NO OF GRAN RELEASED
RELRBG11 LI,R3    X'3F00'
         AND,R3   1,R7
         SLS,R3   -8-3              DC=0,DP=1
*                                   R5=NO. OF GRAN RELEASED
         LW,R1    CFU,R6
         LW,SR4   YC                CHK FOR JOB FILE
         CS,SR4   FIL1,R6
         BE       RELRBG1-1         BRANCH IF IT'S A JOBBER
         LW,D2    Y001              FOR OUTIN
         CW,D2    FUN,R6            OUTIN MAY BE TEMP
         BAZ      RELRBG1           IN,INOUT USE PERM
         MTW,0    FIL1,R6           DCB PERM
         BLZ      RELRBG1           YEP, GIVE TO PERM
         AI,R3    TMDCRM-PRDCRM
RELRBG1  AI,R3    PRDCRM
         AND,1    M17
         CI,1     FILCFU
         BLE      PULLEXIT
         AWM,R5   J:JIT,R3
         LCW,0    R5
         B        RELRBG12
*
         PAGE
         SPACE    2
*
*D*      NAME:    DELFWD
*D*      REGISTERS  ALL VOLATILE
*D*      CALL     VIA T:OV
*D*      DESCRIPTION  DELETE ALL RECORDS FORWARD OF THE
*D*      ESTABLISHED POSITION IN A KEYED OR CONSECUTIVE FILE.
*  DELETE FORWARD
*
DELFWD   EQU      %
         PUSH     SR4
         LI,R4    X'20'
         CW,R4    ORG,6
         BAZ      SEQ2              CONSECUTIVE
         LW,D4    KBUF,R6
         BAL,R0   LOCKEYUB          GET TO RIGHT KEY
         NOP
         BAL,R0   GETCMD
         BAL,D2   TRNTST
         BANZ     1B1
         BAL,SR4  1A7               SKIP OVER AN ENTRY
         NOP
         BAL,R0   GETCMD
1B1      RES      0
         CI,R3    MIDIS
         BNE      DELFWD2
DELFWD1  BAL,11   DEL               DELETE A KEY
         LW,R1    CFU,R6
         LW,R1    FDA,R1
         BLEZ     DELX              DONE IF FILE GONE
         BAL,R0   GETCMD
DELFWD2  EQU      %
         AI,R3    -3
         LB,R0    BUFF2,R3
         CI,R0    2
         BANZ     DELX              OR AT EOF
         AI,R3    3
         CH,R3    BUFF2+NAVX        AT END OF BLOCK
         BL       DELFWD1           NO
         BAL,SR4  FNDKY             GET NEXT SECTOR
         B        DELX
         B        DELFWD1
         PAGE
*                 SAVE GRANULE ADDRESS OF 1ST SECTOR FOR
*                 EACH MASTER INDEX IN BB
*
SGAIBB   RES      0
         PUSH     4,R0
         LW,R2    REL:CNT           # AVAILABLE SLOTS
         BNEZ     %+2
         BAL,R0   SGABB             NO ROOM - WRITE OUT BLOCK
         LW,R2    REL:NAV           NEXT AVAILABLE SLOT
         STW,D1   0,R2              PUT AWAY DISC ADDRESS
         MTW,1    REL:NAV           POINT TO NEXT SLOT
         MTW,-1   REL:CNT           DECREMENT COUNT
         PULL     4,R0
         B        *R0
*                                   NEED TO WRITE  BB
SGABB    EQU      %
         PUSH     0,R0              SAVE ALL REGISTERS
         BAL,0    SETBLK            DCB IN R6;SAVE BLK-QBUF-CDA
         LI,R0    0
         LI,SR1   0
         XW,SR1   RELBUF+4          PICK UP ANY OLD DISC ADDRESS
         XW,SR1   REL:NDA           IT BECOMES ADDRESS OF NEXT BLOCK
         BNEZ     SGABB1
*  WRITING FIRST BLOCK
         LI,R0    0
         LI,SR1   0
         XW,SR1   RELBUF+5          PICK UP ANOTHER DISC ADDR
         STW,SR1  REL:FDA           THIS ONE BECOMES FDA
SGABB1   STW,SR1  CDA,6             SET DISC ADDRESS - CDA
         BAL,SR2  SGASET            SET COUNT & POINTER
         STW,SR1  REL:NAV           STORE DISC ADDR OF THIS BLOCK
         LW,7     Y07
         BAL,SR2  SGADIO            WRITE BB
         LI,R2    RELBUF+4
         STW,R2   REL:NAV           SET UP NEXT AVAILABLE SLOT
         BAL,0    RESBLK            RESTORE DCB
         PULL     0,R0
         B        *R0
         TITLE    '**** TOPDA ****'
*D*      NAME:    TOPDA
*D*      DESCRIPTION
*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
         LW,SR1   D1
         BAL,SR4  FMCHKDA
         BCR,15   TOP60             BAD ADDRESS,TREAT AS NOT TOP
         BAL,R0   PRIVDCB
         BAZ      TOP20
         LDCTX,R3 D1                GET VNO FOR NONCONSEC FILES
         LSECTA,R5,S D1             R5=SECTOR NO OF DISC ADR            DISCB
         BAL,R0   GETORG
         BL       TOP05             CONSECUTIVE FILE
         PUSH     6,D2
         BAL,R0   SETVNO            KEYED..SET PV INDICATORS
         BAL,D4   SETPVI            TO THIS VOL.
         PULL     6,D2
         B        TOP30
*
*
TOP05    CI,R3    1                 IS D.A. IN NVAT
         BE       TOP10             NO..NO NVAT ON VOL. 1
         LI,R3    2                 SET NSG FOR NVAT
         CI,R5    60
         BL       TOP55             IS IN NVAT
TOP10    RES
         LW,R7    PAT,R6            GET HGP ADR--SHOULD BE SET UP ALREADY
         B        TOP30             GO GET NSC
TOP20    RES                        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             GET REL SECTOR #                    DISCB
*                                   THE FOLLOWING INTERPRETS ASSUME     DISCB
*                                   16 BIT RELATIVE SECTOR # IN 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
         BL       TOP55              NO--MUST BE IN PSA                 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   K2                    NO,SET 'NOT ON GRAN/CYL BOUND'
         B        PULLEXIT                 FLAG AND EXIT
*
         END

