MONPROC  SET      1
DISCBPROC SET     1                                                     DISCB
         SYSTEM UTS
         PCC      0
         DEF      DLT
DLT      EQU      %
         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'
KN1      EQU      -X'1'
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      REL
         DEF      SPOOLUB
         DEF      DELF
         DEF      DELAA
         DEF      DELFWD
         DEF      DELETE
         DEF      DELSET
         REF      DOUBLEZERO
         REF      DOUBLEONE
         REF      EOFMITST
         REF      FNDKYT
         REF      GETCMD
         REF      GETCSA
         REF      GETFUN
         REF      GETSEC
         REF      MSREXIT
IOSEQX   EQU      MSREXIT
         REF      KEYER4
         REF      MSRRDWT
         REF      MSR01EXIT
         REF      PRCRD1
         REF      PULLEXIT,PULLEXIT1
         REF      PULLFOUR
         REF      RBG
         REF      SETCMD,SETCMD1
         REF      SETEOPW
         REF      SETTRN
         REF      SETUPUB
         REF      TRNTST
         REF      WRTSEC
         REF      Y0004
         REF      MSRWRTX
         REF      PUSHALL
         REF      CHKBIT0
         REF      FINDFIL1,CLRBFUB
         REF      PULLALLEXIT
         REF      Y002
         REF      GETBBUF
         REF      SETBLK
         REF      Y03
         REF      RESBLK
         REF      Y07
         REF      CLRBBUF
         REF      ISEQICR1
         REF      FMCHKDA,GETORG
         REF      GETVNO
         REF      PRIVDCB
         REF      SETPVI,SETVNO
         REF      RNVAT
         REF      RPVCYL
         REF      FNDHGP
         REF      RCYL
         REF      IOSPIN
         REF      PRDCRM,TMDCRM,J:JIT
         REF      SWXPV
         REF      J:CLS
         REF      ERFILDA
         REF      YFFFF,M16                                             DISCB
         REF      M17,M31
         REF      FILCFU
NFD      EQU      FILCFU+FILDISP+6
NFIT     EQU      NFD
NFSP     EQU      NFD+1
         TITLE    '**** DLT ****'
         SPACE    2
*
*  M:DELREC CAL
*
DELETE   EQU      %                 DELETE RECORD
         BAL,R1   PUSHALL
         BAL,D2   GETFUN
         CI,D1    K4
         BNE      MSRWRTX
         LI,D2    14
         CW,D2    ASN,R6
         BANZ     MSRWRTX           NOT A FILE
         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
         BAL,SR4  MSRRDWT
         BUMP     -2,R0
         B        PULLALLEXIT
*
*  RETURN HERE FROM IORT AFTER DECODING FPT
*
DELSET   EQU      %
         REF      SETUPWR,J:BASE
         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
         SPACE    4
*
*  DELETE CONSECUTIVE FILE RECORD
*
SEQ0     LI,12    X'80000'          SET WRITE OP BUT
         BAL,0    SETEOP             NO MIUD
         REF      SETEOP
         LW,0     Y02
         REF      Y02,SEQPOSD
         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,R7    BUFF1,R3          WIPE
         AND,7    NB31TO0+31         OUT
         STW,R7   BUFF1,R3            FAK
         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
         BE       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        DELRECUB2
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
         REF      REDSECL
         BAL,R0   SETCMD
         B        DELRECUB1
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
         EOR,R0   X2
         STB,R0   BUFF2,R3
         BAL,R0   SETEOPW
         B        DELX
DELRECUB5 EQU     %
         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      DELX              IGNORE DELETE OF AD OR FD
         FIN
         LW,11    Y8
         AWM,11   *TSTACK
         B        1A5
         REF      Y8
         SPACE    2
*
*  DELETING ENTIRE FILE DIRECTORY - MUST FIRST DELETE
*  ENTRY IN ACCOUNT DIRECTORY
*
         DO       0
DELFD    EQU      %
         LW,R0    NFD
         CW,R0    Y008              CHK 4 MASTER OF CYLINDER
         REF      Y008
         BANZ     DELX
         STW,R0   FILCFU+ACNDISP    FORCE FINDFIL1 TO READ AD
         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    AI,R3    -3
         MTB,3    BUFF2,R3
         AI,R3    3                 PREVENT DOUBLE RELEASE
         BAL,R0   PULLFOUR
         PUSH     15,R1
         BAL,R0   TOPDA
         LI,R0    DEL11-1
         CI,SR3   1
         BG       DEL14-1
         BE       DEL14
         BAL,R0   RELRBG
         LI,R0    DEL1
DEL14    PULL     15,R1
         B        *R0
*
DELF     EQU      %
         PUSH     1,SR4
         BAL,R0   SETFADR
         LW,D4    FILCFU+SREC
         LI,D2    X'30'
         CS,D2    ORG,R6
         BNE      DELO              BR IF NOT RANDOM FILE
         BAL,R0   SETFPOOL
         MTW,-1   NFIT
         DEF      DELO
DELO     EQU      %                 RELEASE FD ENTRY ON OPEN
         LW,D1    CDA,R6
         REF      FNESCR
         BAL,0    FNESCR
         STW,R3   FILCFU+CDAM
         LW,D2    FILCFU+16         EXPECTED BLINK
         BAL,R0   REDSECL
         B        DELF3
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
*
*
*
SETFADR  EQU      %
         LW,R1    CFU,R6
         LW,D4    CDAM,R1
         LI,R2    K0                CLEAR WRITE OP
         LW,R3    Y002
         STS,R2   MIUD,R6
         B        *R0
*
*
*
SETFPOOL EQU      %                 ENTER SECTOR INTO TABLE OF FREE
*                                   SECTORS
         PUSH     6,0
         LW,SR1   D4
         BAL,SR4  FMCHKDA
         BCR,15   1A6               BAD DISK ADDRESS
         LI,4     0
1A1      CW,4     ACNTBL            CHK END OF TABLE OF ACCTS
         BGE      1A2               NO HIT
         AI,4     3                 3 WDS PER ENTRY
         CW,D4    ACNTBL,4          CHK FOR HIIT
         BNE      1A1               NOT THIS TIME
         LW,3     ACNTBL            LAST ENTRY IN TABLE
         LCI      3
         LM,0     ACNTBL-2,3        MOVE FINAL ENTRY
         STM,0    ACNTBL-2,4         OVER RELEASED ENTRY
         MTW,-3   ACNTBL            ADJUST TABLE SIZE
1A2      LW,D1    D4
         BAL,0    TOPDA
         AI,SR3   0
         BNEZ     1A3               IT'S CYLINDER
         LW,SR1   D4
         BAL,0    RELRBG            RELEASE THE GRAN
1A6      RES      0
         PULL     6,0
         B        *R0
1A3      PULL     5,1
         LW,R4    ACNCFU+4          SAVE DUAL
         MTW,1    NFSP
         REF      ACNTBL
         LI,SR4   K0
         LW,D1    FSP,R1
*                                   NO FLP POOL
         BEZ      SETFP4
         LI,D2    0                 DISC ADR FROM CFU FSP. BLINK = 0.
SETFP3   EQU      %
         LI,R3    X'500'            DON'T CHECK SCR, DON'T REPORT
         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
         BAL,R0   WRTSEC
         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
         LW,SR4   CDAM,R1
*
SETFP4   LI,D1    0                 SET UP NEW GRANULE
         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     %+2
         STW,D4   FSP,R1
SETFPO   STW,R4   ACNCFU+4          RESTORE DUAL
         B        PULLEXIT
*
SETFPZ   EQU      %
         STW,R4   ACNCFU+4          RESTORE DUAL
         LW,SR3   CDAM,R1           BAD DISC ADDRESS
         LI,SR1   0                 SUB-CODE
         STW,SR1  FSP,R1
         BAL,SR4  ERFILDA           LOG THE ERROR
         LW,R1    CFU,R6
         B        PULLEXIT
         PAGE
         SPACE    2
*
*  DELETE FORWARD - CONSEC FILE
*
SEQ2     BAL,7    SEQPOSD           ESTABLISH POSITION
         B        %+2               NOT EMPTY
         B        DELX              ALREADY EMPTY
         LW,2     Y004              TO SET BBUD
         B        SEQ4
         SPACE    2
*
*  DELETE CONSECUTIVE FILE
*
SEQ3     EQU      %
         LW,3     FDA,1
         AND,3    M31               RESET EMPTY FILE BIT
         STW,3    FDA,1
*
         LI,3     0                 SET BOF
         STW,3    W19,6             NO SKIP
         BAL,0    SETCMD1
         BAL,7    SEQPOSD           FIND BOF
         B        %+2               NOT EMPTY FILE
         B        DELX              ALREDY EMPTY
         LW,1     CFU,6             GET 1ST
         LW,12    FDA,1              GRAN
         XW,12    DCBCDAM,6
         CW,12    DCBCDAM,6
         BE       %+2
         BAL,4    SEQREAD
         LI,3     3                 AND 1ST
         BAL,0    SETCMD1            POSITION
         LI,2     0                 TORESET BBUD
SEQ4     LW,3     Y004              MASK FOR BBUD
         STS,2    BBUD,6            SET OR RESET BBUD
         STW,2    W19,6
         PUSH     2
         BAL,0    GETCMD            SAVE
         LW,2     DCBCDAM,6          CURRENT POSITION
         LI,4     0                 FOR GRANULE RELEASE
         LW,5     CFU,6
         LI,1     0                 NO GRAN POOL
         XW,1     GAVAL,5
         PUSH     4,1
         LW,0     W19,6
         STW,3    W19,6             1ST GRAN FLAG
         BNEZ     SEQ5              NOT RELEASE
SEQ40    LW,D1    DCBCDAM,6         CURR GRAN
SEQ41    BAL,0    TOPDA             CHK WHAT KIND
         CI,SR3   1
         BL       SEQ42             GRAN NOT CYL
         BE       SEQ43             TOP OF CYL
         LW,14    *TSTACK
         BNEZ     SEQ5              NOT IN 1ST GRAN
         LW,1     CFU,6
         LW,14    GAVAL,1
         BNEZ     %+2               NOT 1ST GRAN IN CYL
         LW,14    D1                1ST GRAN REL'D & COUNT
         AW,14    Y01               UP COUNT
         REF      Y01
         STW,14   GAVAL,1
         B        SEQ5
         SPACE    3
SEQ43    LI,3     -3                SET NOT 1ST
         STW,3    *TSTACK,3          CYL FLAG
SEQ42    RES      0
         XW,D1    *TSTACK           GET LAST ONE
         LW,SR1   D1
         BAL,0    RELRBGD           DUMP IT
SEQ5     EQU      %
         LC       BUFF1+2
         BCR,8    SEQ8              NO UNBLOCKED SEGS
SEQ6     BAL,0    GETCMD
SEQ61    CI,3     BUFSIZ**-2        CHK END OF BFR
         BGE      SEQ8              OFF THE END
         LI,1     1
         CH,3     BUFF1+2,1         CHECK NAV
         BG       SEQ8              BEYOND LAST
         LW,0     BUFF1,3           SEG CONTROL WORD
         AI,3     1
         REF      M24
SEQ62    AI,0     0                 CHK UNBLOCKED
         BGEZ     SEQ7              NOT UNBLOCKED
         LW,D1    M24
         AND,D1   0                 DISK ADDR
         LI,0     SEQ41             SET RTN
         B        SETCMD1
SEQ7     INT,0    0
         AI,0     3                 ROUND UP THE BYTE COUNT
         SLS,0    -2
         AW,3     0                 NXT POSN
         B        SEQ61
         SPACE    4
SEQ8     EQU      %
         LW,2     BUFF1+FLINK       GET FLINK
         LI,3     -4
         LW,3     *TSTACK,3
         BNEZ     SEQ8A             BR IF NOT FULL RELEASE
         LW,1     CFU,6             MARCH FDA SO THAT RECOVERY
         STW,2    FDA,1               CAN CONTINUE WITH RELEASE
SEQ8A    XW,2     W19,6
         BEZ      SEQ81             NOT 1ST GRAN
         LI,12    0
         LW,3     2                 SEG CTL POSN
         STW,12   BUFF1+FLINK       RESET FLINK
         LW,1     BUFF1,2           SEG CONTROL WORD
         BGEZ     SEQ82             BLOCKED
         AI,3     -1                BACK UP
         STW,3    BUFF1,2           SET BACKSPACE CONTROL WD
         B        SEQ83
SEQ82    SLS,3    1                 HALFWORD ALIGN
         STH,12   BUFF1,3           ZAP OUT CTL AND SIZE
SEQ83    RES      0
         LW,3     Y8FFF             MASK
         LS,2     BUFF1+2           GET RECORD COUNT
         STW,2    BUFF1+2
         LW,12    W19,6             CHECK
         BEZ      SEQ9               EOF
         BAL,0    CLRBBUF           UPDATE LAST GRAN
SEQ81    LI,12    0
         XW,12    W19,6             GET FLINK
         BEZ      SEQ9              END OF FILE
         BAL,0    PRIVDCB
         BAZ      SEQ71
         LI,2     BAVNO
         LDCTX,0  12
         CB,0     *6,2
         BE       SEQ71             NO VOL SWITCH
         LW,8     *TSTACK
         STW,12   *TSTACK
         BAL,0    RELRBGD
         LW,8     *TSTACK
         BAL,0    RELRBGD
         LI,12    -1
         XW,12    *TSTACK
SEQ71    RES      0
         LI,3     3                 SET BEG OF GRAN
         BAL,0    SETCMD1
         BAL,4    SEQREAD           RAED NXT GRAN
         XW,12    DCBCDAM,6
         CW,12    BUFF1             LINK CHECK
         BE       SEQ40             OK
SEQ9     LW,SR1   *TSTACK           LAST GRAN TO REL
         BAL,0    RELRBGD
         PULL     4,1
         LW,5     CFU,6
         LW,0     W14,6
         MTW,0    *TSTACK
         BNEZ     SEQ92             NOT RELEASING FILE
         STW,0    FDA,5             RESET 1ST GRAN
         SD,2     2                 NOTHING LEFT
SEQ92    STW,0    TDA,5             # OF RECS LEFT
         STW,2    LDA,5             NEW EOF
         STW,2    DCBCDAM,6         NEW POSN
         PULL     0
         AI,1     0
         BLEZ     SEQ97             GRAN POOL IS OK
         LW,2     GAVAL,5           FIX
         BEZ      %+2                GRAN
         AND,1    YFF                 POOL
         AWM,1    GAVAL,5
         REF      YFF
SEQ97    AI,0     0
         BNEZ     %+2               NOT RELEASING FILE
         BAL,0    CLRBBUF           CHUCK THE BUFFER
SEQ91    LI,0     DELX              SET RTN
         B        SETCMD1
Y8FFF    DATA     X'8FFF0000'
         REF      SEQREAD,Y004
         PAGE
*
*
*        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.
*
*
*
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
         REF      MULSEG            REPLACING OB
         OVERLAY  MULSEG,1          RELEASE UPPER LEVELS
         LW,R1    CFU,R6
         LW,R3    Y2
         REF      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
         B        RELFILUB2
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
         REF      ACNCFU
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
*
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
         LW,SR1   D1               *DA IS AT TOP OF GRAN,RELEASE
         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    EQU      %                *END OF FILE'S MASTER INDEX
         LI,D1    0
         LW,D2    SCFU,R1
         AND,R1   M17
         CI,R1    FILCFU
         BLE      %+3
         STW,D1   LDA,R1            FILE
         STH,D1   D2
         STW,D2   SCFU,R1
         LW,D1    TDA,R1
         STW,D1   FDA,R1            ZAP FDA IF FULL RELEASE
         LI,D1    1                 SLIDES=1
         LI,D2    X'FF'
         STS,D1   0,R1
         LI,R3    K0
         STW,R3   TDA,R1
         BAL,R0   SETCMD1
*
*  RELEASE GRANULES IN FREE POOL
*
         LW,D1    FDA,R1
         AND,D1   M31
         XW,D1    FSP,R1
         BEZ      RELFILUB5
         LI,D2    0                 DISC ADR FROM FSP. BLINK SHOULD BE 0
REL6     EQU      %
         LI,R3    X'100'            DON'T CHECK SCR, RETURN
         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
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
         B        RGAIBBA
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
*
*  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
*                 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
         REF     PVQUEUE
         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      %
         PUSH     R6
         BAL,R3   FNDHGP                GET ADR OF DEVICE AT IN R7
         PULL     R6
         AI,R7    0
         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
         LI,D2    X'A00'
         CW,D2    0,R1              OUT,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
*
*  DELETE FORWARD
*
DELFWD   EQU      %
         PUSH     SR4
         LI,R4    X'20'
         CW,R4    ORG,6
         BAZ      SEQ2              CONSECUTIVE
         LW,D4    KBUF,R6
         REF      LOCKEYUB
         BAL,R0   LOCKEYUB          GET TO RIGHT KEY
         NOP
         BAL,R0   GETCMD
         BAL,D2   TRNTST
         BANZ     1B1
         BAL,SR4  1A7               SKIP OVER AN ENTRY
         REF      1A7
         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
         REF      FNDKY
         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 ****'
*        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
         LW,SR1   D1
         BAL,SR4  FMCHKDA
         BCR,15   TOP60             BAD ADDRESS,TREAT AS NOT TOP
         BAL,R0   PRIVDCB
         BAZ      TOP20
         LSECTA,R5,S D1             R5=SECTOR NO OF DISC ADR            DISCB
         BAL,R0   GETORG
         BGE      TOP10
         LDCTX,R4    D1             CONSECUTIVE FILE                    DISCB
         CI,R4       1              IS THE DISC ADR IN NVAT             DISCB
         BE       TOP10                         NO
         CI,5     30
         BGE      TOP10
         LW,R3    PAT,R6            HGP ADDRESS
         LW,R3    3,R3              # SECTORS/GRAN
         B        TOP55
TOP10    EQU      %                                                     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             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
*
         PAGE
*                                   GET SECTOR FROM FREE POOL
SPOOLUB  EQU      %
         MTW,-1   NFSP
         LW,R1    CFU,R6
         LW,D1    CDAM,R1
         LW,D2    ACNCFU+4          SAVE DUAL
         PUSH     3,SR4
         LW,D1    SR1
         LI,D2    0                 DISC ADR FROM GETGRAN. BLINK = 0
         BAL,SR4  FMCHKDA           IS IT ANY GOOD
         BCR,15   POSTBAD1          NO,FORGET FSP.
         LI,R3    X'500'            DON'T CHECK SCR, DON'T REPORT
         STS,R3   J:CLS               ERROR, RETURN HERE IF ERROR
         BAL,R0   REDSECL           READ SECTOR WITH LINK CHECK
         LW,R0    BUFF2
         BGEZ     DAREOK            NO ERROR
POSTBAD  EQU      %
POSTBAD1 EQU      %
         LW,SR3   CDAM,R1           BAD DA
         LI,SR1   0                 ERROR SUB-CODE
         BAL,SR4  ERFILDA
         LW,R1    CFU,R6            RESTORE CFU ADDRESS
         LI,D4    0
         STW,D4   FSP,R1            ZAP FREE POOL
         STW,D4   NFSP
         B        SPOOL21
DAREOK   EQU      %
         LH,R3    BUFF2+NAVX
         CI,R3    K3
         BLE      SPOOL1
         AI,R3    KN1
         LW,D4    BUFF2,R3
         MTH,KN1  BUFF2+NAVX        DECREMENT # REMAINING
         B        SPOOL3
SPOOL1   EQU      %
         LW,D4    CDAM,R1
*                                   SET TOP OF GRAN BIT
         LW,D2    CDAM,R1
         LW,D1    BUFF2+FLINK
         STW,D1   FSP,R1
         BEZ      SPOOL2
         LW,SR1   D1
         BAL,SR4  FMCHKDA           IS FLINK ANY GOOD
         BCR,15   POSTBAD1          NO, DELETE FSP
         LI,R3    X'500'            DON'T CHECK SCR, DON'T REPORT
         STS,R3   J:CLS               ERROR, RETURN HERE IF ERROR
         BAL,R0   REDSECL           READ SECTOR WITH LINK CHECK
         LW,R0    BUFF2
         BLZ      POSTBAD1          ERROR
REDOK    EQU      %
         LI,R0    K0
         STW,R0   BUFF2             ZAP BLINK
SPOOL3   EQU      %
         BAL,R0   WRTSEC
SPOOL2   EQU      %
         LW,SR1   D4
         BAL,SR4  FMCHKDA
         BCR,15   POSTBAD           BAD DISK ADDR
SPOOL21  RES      0
         PULL     2,D1
         STW,D2   ACNCFU+4          RESTORE DUAL
         LW,D2    FILCFU+16         EXPECTED BLINK
         BAL,R0   REDSECL
         LW,SR1   D4
         B        DELX
         END

