MONPROC  SET      1
ANSPROC  SET      1
DISCBPROC SET     2                                                     DISCB
         SYSTEM   UTS
         DEF      RDF
RDF      EQU      %
*
NUPRIV   EQU      0
         TITLE    '**** RDF ****'
         BOUND    8
         REF      M:XX
K16      EQU      X'16'
K18      EQU      X'18'
K2       EQU      X'2'
K20      EQU      X'20'
KF0      EQU      X'F0'
K400     EQU      X'400'
K7FFF    EQU      X'7FFF'
K7       EQU      X'7'
FPLIST0  EQU      0
BPLIST   EQU      1
K0       EQU      X'0'
K1       EQU      X'1'
K3       EQU      X'3'
K4       EQU      X'4'
K13      EQU      X'13'
K43      EQU      X'43'
K100     EQU      X'100'
KFFFF    EQU      X'FFFF'
K1FFFF   EQU      X'1FFFF'
KN1      EQU      -X'1'
KN2      EQU      -X'2'
KN3      EQU      -X'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
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         DEF     LOCKEYUB
         SPACE    3
         OPEN     WXBUFSIZ,XBUFSIZ
WXBUFSIZ EQU      X'200'
XBUFSIZ  EQU      X'800'
         PAGE
         SPACE    3
*
*  RANB COMMAND  (CONDITIONAL READ AHEAD NO BRANCH)
*
*        BCS,0    AF                NOP IF READ AHEAD INCLUDED
*        BCR,0    AF                BRANCH IF NOT INCLUDED
*
RANB     COM,1,7,4,3,17  AFA(1),X'68'+RAFLAG,0,AF(2),AF(1)
         SPACE    2
*
*  RABAL COMMAND  (CONDITIONAL READ AHEAD BRANCH AND LINK)
*
*        BAL,CF(2) AF               BAL IF READ AHEAD INCLUDED
*        BCS,0    AF                NOP IF NOT INCLUDED
*
RABAL    COM,1,7,1,1,1,1,3,17 ;
          AFA(1),X'69'+RAFLAG,;
          S:S((CF(2)&8)=0,RAFLAG),;
          S:S((CF(2)&4)=0,RAFLAG),;
          S:S((CF(2)&2)=0,RAFLAG),;
          S:S((CF(2)&1)=0,RAFLAG),;
          AF(2),AF(1)
         PAGE     RDF DEFS
         DEF      CLRBFUB
         DEF      CLRTRN
         DEF      COMKEY
         DEF      EOFMITST
         DEF      ESTABBUF
         DEF      GETBUFM
         DEF      GETCFU
         DEF      GETCMD
         DEF      GETSEC
         DEF      GSBUF
         DEF      GETDIR
         DEF      FNDKY
         DEF      FNDKYT
         DEF      ISEQUB
         DEF      KEYER1,KEYER2,KEYER3,KEYER4
         DEF      KEYTRAN
         DEF      SETLKEYUB
         DEF      TRNTST
         DEF      PRCRD1
         DEF      PULLFOUR
         DEF      REDSEC
         DEF      SETCMD,SETCMD1
         DEF      SETEOP,SETEOPW
         DEF      SETTRN
         DEF      SETUPUB
         DEF      WRTSEC
         DEF      PRDCRD11
         DEF      ISEQICR1
         DEF      INITARS
         DEF      TRANX
         DEF      SETBLK
         DEF      RESBLK
         DEF      FMCHKDA
         DEF      GETORG
         DEF      GETOVC
         DEF      GETRNDEV
         DEF      GETSNADR
         DEF      GETVDCTX
         DEF      GETVNO
         DEF      NXTVOL
         DEF      PRIVDCB
         DEF      PVQUEUE
         DEF      PVREADTP
         DEF      SETPVI
         DEF      SETVNO
         DEF      SETVNO1
         DEF      GETTBL
         DEF      DUALEA
         DEF      WRTSEC10
         DEF      WRTXEND
         DEF      PVQUEUE1
         DEF         INCREMENT%SECTOR                                   DISCB
         DEF      LOAD%SECTOR%ADDR                                      DISCB
         DEF      STORE%DCT%SR1                                         DISCB
         DEF      STORE%DCT%CDA                                         DISCB
         DEF      REDSEC8,1C0
         DEF      ERFILDA
         PAGE     RDF REFS
         REF      GETTYC
         REF      IOSPIN
         REF      MSREXIT
ISEQEXT  EQU      MSREXIT
         REF      MSR01EXIT
         REF      PULLEXIT,PULLEXIT1
         REF      T:STLPP,T:RSPPEA
         REF      T:XBUF
         REF      J:DCBLINK
         REF      JBFBFP
         REF      JXBUFVP
         REF      MAPBUFS
         REF      BADA#,ERFILDA#
         REF      UB:OV
         REF      J:JIT,UX:JIT
         REF      S:CUP
         REF      JX:CMAP,FPMC
         REF      SWXPV
         REF      PVERR
         REF      FDFLAGS
         REF      S:CUN
         REF      PUTSZBF,PUTSZBF1
         REF      SAVBLK
         REF      SETBTDZ,SETBTDQ
         REF      SETTYC
         REF      WRTELEND
         REF      Y001
         REF      Y02
         REF      Y08,Y04
         REF      Y0002
         REF      Y0004
         REF      Y0008
         REF      Y000C
         REF      M24
         REF      Y8
         REF      NEWQNW
         PAGE
         REF      Y004
         REF      Y002
         REF      Y06
         REF      HGP
         REF      PVCHKDA
         REF      AVRTBL,AVRTBLSIZ
         REF      AVRTBLNE
         REF      DCT23
         REF      Y2,YFF
         REF      BATAPE
         REF      QUEUE1
         REF      QUEUE
         REF      PUSHALL
         REF      MSRWRTX
         REF      M17
         REF      GETBTD
         REF      Y008
         REF      Y00FE
         DEF      TRUNC
         DEF      GETCBD
         DEF      SAVCBD
         DEF      GETBBUF
         DEF      CLRBBUF
         REF      RW3
         REF      RW1
         REF      RW2
         DEF      TRNS1
         DEF      UBLK
         DEF      CBB4
         DEF      CBB5
         DEF      BLKIN
         DEF      TRANSFERUB2
         DEF      COMKEYA
         DEF      COMKEYC
Y26      DATA     X'26000000'
Y006     DATA     X'00600000'
Y0014    DATA     X'00140000'
         DEF      Y0014
         REF      ACNTBL,ACNTBLM
         REF      DHHIT
         REF      YFC
         REF      JCMAP
         SREF     T:RAPURGD,T:RACHK,T:RACONSEC,T:RAMISRCH
         SREF     T:RADD
         REF      RAFLAG
         SPACE    3
PRCRD1   LI,R7    FPLIST0
*
*  ROUTINE TO POSITION SEQUENTIALLY IN A KEYED FILE.
*
PRCRD1UB EQU      %
         STW,R7   CDA,R6
         LW,D1    CDA,R6            SET DIRECTION
         SLS,D1   10
         LI,D2    K400
         STS,D1   DIR,R6
PRDCRD11 EQU      %
         PUSH     SR4               SAVE LINK
         LI,R2    HACMD             GIVES 0 FOR EOP
         LW,R3    Y000C             RESET
         STS,R2   EOP,R6             EOP
         LW,D4    KBUF,R6
         LH,R3    *R6,R2
         BEZ      PRCRD1UB1         BOF
         BAL,R0   LOCKEYUB          FIND KEY WHERE WE LEFT OFF
         B        PRCRD1UB2         DIDNT FIND--CAME TO BOF OR EOF
         LW,D2    Y02               CHK TRUNCATE
         CW,D2    TRN,R6
         BANZ     PRCRD1UB6         NO--GO TO NEXT KEY
*
*  ADJUST POSITIONING COUNT TO CONFORM TO A SET TRN FLAG.
         MTW,1    CDA,R6
         BAL,D2   GETDIR
         BAZ      %+2
         MTW,-2   CDA,R6
*
*  THIS IS THE MAIN POSITIONING LOOP.
PRCRD1UB4  EQU    %
PRCRD1UB6  EQU    %
         LW,R3    CMD,R6
         LH,R3    R3
         MTW,KN1  CDA,R6
         BLZ      PRCRD1UB10
         LI,R0    1A6               SET RETURN FOR FNDKYR
         BAL,D2   GETDIR            WHICH WAY
         BANZ     FNDKYR            REVERSE
*                                   LOOK FOR NEXT KEY
         BAL,SR4  1A7               FORWARD
1A6      RES      0
         B        PULLEXIT
         B        PRCRD1UB4
*
*  ABNORMAL SITUATION ENCOUNTERED IN FINDING STARTING PLACE.
PRCRD1UB2  EQU    %
         LI,3     X'60000'
         CW,3     TYC,R6
         BAZ      PRCRD1UB1         NOT END OF FILE
         BAL,D2   GETDIR            IF REVERSE DIRECTION, CAN POSITION
         BANZ     PRCRD1UB6
         B        PULLEXIT
*
*  STARTING POSITION IS BEGINNING OF FILE.
PRCRD1UB1  EQU    %
         LW,R1    CFU,R6
         LW,D1    FDA,R1
         BLEZ     PULLEXIT
         LI,D2    0
         BAL,R0   REDSECL           READ FDA GRANULE
         LI,R3    MIDIS
         LI,SR4   1A6               FORCE RETURN
         B        FNDKY             GET 1ST SIG KEY
         SPACE    3
*
*  GET MI OR DIRECTORY DISK ADDRESS FOR MOST RECENT POSITION.
GETCSA   LI,D2    GETCSAP1
*
*  GET CFU ADDRESS FROM DCB.
GETCFUD  EQU      %
*                                   GET CFU ADDRESS
GETCFU   EQU      %
         LI,R1    K1FFFF
         AND,R1   CFU,R6
         B        *D2
         DEF      GETCSA
GETCSAP1 LW,D2    DCBCDAM,R6
         CI,R1    FILCFU
         BG       *R0
GETCSAP2 RES      0
         LW,D2    CDAM,R1           SECTOR ADR OF CURRENT INDEX
         B        *R0
         SPACE    3
*  END OF SEQUENTIAL POSITIONING ROUTINE FOR KEYED FILES.
PRCRD1UB10 EQU    %
         LI,D1    0
         BAL,R0   SETTYC            RESET TYC
         PULL     1,R1
*
*  MOVE A KEY INTO THE DCB'S KEY BUFFER(KBUF).
KEYTRANM LW,R5    Y02
         STS,R5   TRN,R6            SET TRN
KEYTRAN  LW,R5    KBUF,R6
         SLS,R5   2                 BYTE ALIGN
         ANLZ,R4  3A0               SOURCE ADDRESS
         LB,R0    0,R4              KEY LENGTH
         AND,R0   M5                PLAY IT SAFE
         REF      M5
         AI,R0    1                 INCLUDE LENGTH BYTE
         STB,R0   R5                INSERT IT
         MBS,R4   0                 MOVE TO KEY BUFFER
         B        0,R1
*
*  SET DCB ENDING OPERATION(EOP) TO WRITE AND MARK THE
*  MI BUFFER AS UPDATED
SETEOPW  EQU      %
         LI,1     X'1FFFF'
         AND,1    CFU,R6
*  ****  ENTER HERE FROM WRTF *****
         LW,D2    Y002
         STS,D2   BFL,R6
         LW,D1    Y0008
SETEOP   EQU      %
         LW,D2    Y000C
         STS,D1   EOP,R6
         B        *R0
*
*  OPEN UP A TSTACK POSITION IN WHICH TO ACCUMULATE THE
*  ACTUAL RECORD SIZE(ARS) FOR BOTH READS AND WRITES. ALSO,
*  SET THE FIRST APPEARANCE OF KEY(FAK) FLAG ON.
INITARS  EQU      %
         LI,1     X'20000'          SET NLR
         OPEN NLR
NLR      EQU      16
         STS,1    NLR,R6
         CLOSE    NLR
         LI,R1    K0
         PUSH     1,R1
INITP4   RES      0
         LW,R2    TSTACK           *SAVE ADR OF 'ARS' RELATIVE TO
         AI,R2    -TSTACK           THE TSTACK IN DCB:ARS
         SLS,R2   17
         LI,R3    X'E0000'
         STS,R2   ARS,R6
         B        PUTSZBF1          SET BLK & QBUF
*
*  MOVE THE CONTENTS OF THE BLK, QBUF, & CDA FIELDS OF
*  THE DCB TO TSTACK DURING THE PROCESSING OF A REDSEC.
SETBLK   EQU      %
         LCI      K3
         LM,R3    BLK,R6
         PSM,R3   TSTACK
         B        *R0
*
         SPACE    3
KEYER1   EQU      %
         LI,SR3   K18               KEY OUT OF ORDER--WRITE
         B        MSR00EXIT
KEYER2   EQU      %
         LI,SR3   K16               NEWKEY OPTION ON EXISTING KEY
         B        MSR00EXIT
KEYER4   EQU      %
         LI,SR3   K13               NEWKEY OPTION NOT SPECIFIED WHEN
*                                   KEYDOESNT EXIST
*  THIS IS THE ROUTE TAKEN BY MANY FILE MANAGEMENT
*  ERROR & ABNORMAL SITUATIONS.
MSR00EXIT RES     0
         LI,R0    MSR01EXIT
         B        1A4+1
*
*  CHK THE STATE OF THE TRN BIT.  IF IT IS SET, WE ARE
*  REALLY POSITIONED ONE RECORD BEFORE THE POSITION OTHERWISE
*  INDICATED BY THE DCB.
TRNTST   EQU      %
         LW,R1    Y02
         CW,R1    TRN,R6
         B        *D2
*
*  CHK THE DIR BIT TO SEE IF WE ARE DOING A BACKWARDS OPERATION.
GETDIR   EQU      %
         LI,D1    K400
         CW,D1    DIR,R6
         B        *D2
         SPACE    3
*  ROUTINE TO COMPARE KEYS OR DIRECTORY ENTRIES.
COMKEY   EQU      %                 COMPARES KEY STATED IN USERS ADDRESS
*                                   WITH KEY IN KEY BUFFER
         LW,D2    KBUF,R6           MONITOR ADDRESS
         LI,R3    K0                MONITOR DIS
COMKEYA  EQU      %
         LW,D4    KAD,R6            USER   KEY
COMKEYC  EQU      %
         ANLZ,R5  1B1   CB *D2,R3
         B        1A3P1             DO THE COMPARE
1B1      CB,R5    *D2,R3          FOR ANALYSIS ABOVE
*
*  ROUTINE TO PUT THE NEXT 4 BYTES FROM THE MI OR DIRECTORY
*  INTO REGISTER D1.
PULLFOUR EQU      %
         LW,R2    R3
         SCS,R2   -2
         LM,D1    *D3,R2            GET DESIRED 4 BYTES
         AND,R2   YC
         REF      YC
         SCS,R2   5
         SCD,D1   0,R2          POSITION
         AI,R3    4
         B        *R0
BIR0     EQU      %-1
         SPACE    3
         REF      CLSSEG
LOCKY2M  LI,R0    LOCK5-1           SET RETURN
*
*  ROUTINE TO REESTABLISH A BUFFER IF IT HAS BEEN TRUNCATED.
ESTABBUF RES      0
         LI,R1    K1FFFF
         AND,R1   CFU,R6
         LW,D1    FDA,R1
         BLEZ     BIR0
         AI,R0    1
         LI,D3    BUFF2
         LI,SR3   BUF2MSK           BUF2X MASK
         AND,SR3  BUFX,R6
         BNEZ     BIR0
         STW,R0   J:BASE+1
         BAL,R0   GETCSAP1
         LW,D1    FDA,R1
         LW,R0    J:BASE+1
         AI,D2    0
         BEZ      REDSECL
         LW,D1    D2
*
*  ROUTINE TO READ AN MI OR DIRECTORY GRANULE.
REDSEC   EQU      %                 NO LINK CHECK ENTRY
         LW,D2    Y8                NO LINK CHECK FLAG
REDSECL  EQU      %                 LINK CHECK ENTRY. D2 = REQUESTING
         DEF      REDSECL           SECTOR ADR TO BE COMPARED WITH LINK
         OR,R0    Y04               RERESD COUNT
         PUSH     R0
         REF      ACNCFU
         BAL,R0   GETSEC
         AND,D1   M31
         REF      M31               TO SCRUB THE E BIT
         PULL     R0
DCDAM    EQU      ACNCFU+4          DUAL OF CDAM FOR DRCTRYS
RDA      EQU      ACNCFU+6          REQUESTED DISK ADDRESS
DRDA     EQU      ACNCFU+7
REDFLGS  EQU      ACNCFU+18         CTL FLAGS FOR DUAL READS
         PUSH     9,D1
DFDA     EQU      8                 DUAL FDA POSITION IN ACN & FIL
DBLINK   EQU      WXBUFSIZ-2
DFLINK   EQU      WXBUFSIZ-1
         CI,R1    FILCFU
         BG       RED8              NOT A DIRECTORY
         STW,D1   RDA
         LI,SR1   0
         STW,SR1  REDFLGS
         LW,R3    DCDAM    SAVE DUAL FOR CLRBFUB BELOW
         LI,SR3   X'100'
         CW,SR3   J:CLS             IS IT A FIT?
         BANZ     RED5
         AI,D2    0                 IS IT FDA READ
         BNE      RED2              NO
         MTW,1    REDFLGS           SET FLINKING FLAG
         LW,SR1   DFDA,R1           GET DU L OF FDA
         B        RED5
RED2     LI,SR1   BUF2MSK
         CW,SR1   BUFF2
         BE       RED6              EMPTY BUFFER
         CW,D1    BUFF2
         BNE      RED4              NOT BLINKING
         LW,SR1   BUFF2+DBLINK      DUAL BLINK
         B        RED5
RED4     CW,D1    BUFF2+FLINK
         BNE      RED6              NOT FLINKING
         LW,SR1   BUFF2+DFLINK
RED5     STW,SR1  DCDAM             SET DUAL
RED6     LW,SR1   DCDAM             SET DUAL
         STW,SR1  DRDA
RED8     RES      0
         ANLZ,R2  GETCSAP1          ASSUME NOT A DIRECTORY
         CI,R1    FILCFU
         BG       REDSEC3A          ASSUMPTION OK
         ANLZ,R2  GETCSAP2          IT'S A DIRECTORY
REDSEC3A CW,D1    0,R2              IS IT A REREAD
         BNE      %+4               NOPE
         LI,R1    -16               GIVE AN EXTRA REREAD
         MTB,1    *TSTACK,R1
         B        REDSEC6D          CHK THE BFR CONTENTS
         CI,R2    FILCFU+CDAM
         BG       %+2               NOT A DIRECTORY
         XW,R3    DCDAM             EXCHANGE DUALS
         BAL,R0   CLRBFUB           WRITE IF NECESSARY
         CI,R2    FILCFU+CDAM
         BG       %+2
         STW,R3   DCDAM             PUT DUAL BACK
         BAL,R0   GETSECP2          IF WE WROTE, GET A BFR
         STW,D1   0,R2              SET THE DISK ADDRESS
REDSEC8  RES      0
         LW,SR1   D1
         BAL,SR4  FMCHKDA
         BCR,15   REDSEC7+1         BAD DISK ADDRESS
         RANB     REDSEC8A          BR IF NO READ AHEAD
         BAL,R0   T:RACHK           CHECK FOR BUFFER READ AHEAD
         BCR,15   REDSEC6D          BR IF READ AHEAD
REDSEC8A EQU      %
         BAL,SR3  RWREX             NOTE SETBLK PUSH 3
         STW,SR3  *D3               ZAP WORD ZERO OF BUFFER
         LW,SR3   TYC,R6            SAVE TYC
         LW,SR2   Y00FE
         STS,SR1  TYC,R6            ZERO TYC
         BAL,SR4  PVQUEUE
         BAL,SR4  IOSPIN            WAIT ON READ
         BAL,R0   RESBLK            PULL 3
         LW,SR2   TYC,R6            SAVE TYC
         LW,SR4   Y00FE
         CS,SR3   TYC,R6            COMPARE PREV TYC
         BLE      %+2
         STS,SR3  TYC,R6            SAVE THE LATEST
         CW,SR2   Y0002             LATEST TYC MUST BE 1
         BANZ     REDSEC6D
*
*  GRANULE READ IS IN ERROR - TRY AGAIN
*
REDS9    RES      0
         LI,1     -16
         MTB,-1   *TSTACK,1         CHK RERESD COUNT
         BLEZ     REDSEC7           SOLID ERROR
         LW,R2    Y002
         CW,R2    MIUD,R6
         BANZ     REDSEC7           BAD UPDATED BUFFER
1C15     RES      0
         LW,R2    TSTACK
         LCI      3                 RESTORE D1,D3
         LM,D1    -8,R2
         B        REDSEC8
*
*  REPORT BAD FILE
*
REDSEC7  EQU      %
         LCI      15                SET LINK CHK
         STCF     R4                FOR DA OR LINK CHK
         LW,R1    TSTACK
         LI,R0    X'1FFFF'
         AND,R0   -4,R1
         CI,R0    MLSET01+1
         BNE      REDSEC7A
*  ERROR HAS OCCURRED WHILE MOVING DOWN FROM LEVEL 1 OF PYRAMID
         PULL     9,D1
         B        HILFAIL
*
REDSEC7A LI,R1    X'100'
         CW,R1    J:CLS
         BAZ      1C12              NOT A FIT
*
1C11     LW,R4    S:CUN
         LB,R4    UB:OV,R4          SAVE OVERLAY # FOR ERFILDA
         SPACE    3
**********  REPORT A 75 ERROR  **************
         LI,R0    CLSSEG            SEGMENT #
         LI,R2    BADA#             ENTRY POINT
         LI,R3    X'700'
         CW,R3    J:CLS             ARE WE TO RETURN HERE
         BAZ      T:OVER            NO
         BAL,SR4  T:OVERLAY         YES
         B        REDSEC1           RETURN TO CALLER
1C0      EQU      REDSEC7
         SPACE    2
*
1C12     RES      0
         DO       NUPRIV=0
         BAL,R0   PRIVDCB           CHK PRIVATE
         BANZ     1C11              BAD NEWS
         FIN
         BAL,D2   GETCFU
         CI,R1    FILCFU
         BG       1C11              NOT A DIRECTORY
         PUSH     R4
         LI,SR1   X'7E'             REPORT
         LW,SR3   CDAM,R1             I/O ERROR
         BAL,SR4  ERFILDA             75-7E
         PULL     R4
         LW,R2    TSTACK
         LC       R4
         BCS,15   1C14              BAD LINK
*  BAD DISK ADDRESS
         MTW,2    REDFLGS
1C14     LW,D1    DCDAM             DUAL
         BEZ      1CB               TO TRY FLINKING
         CW,D1    -8,R2
         BE       1C11              DUAL FAILURE
1C16     STW,D1   -8,R2             TRY DUAL PATH
         LI,R1    -16
         MTB,4    *TSTACK,R1        SET REREAD COUNT
         B        1C15
*
1CB      LI,SR4   1
         CW,SR4   REDFLGS
         BANZ     1C11              FAILURE WHILE FLINKING
         AWM,SR4  REDFLGS           SET FLINKING FLAG
         LW,SR4   DFDA,R1           DUAL OF FDA
         LW,D1    FDA,R1
1C18     STW,SR4  DCDAM             SET DUAL
         BNEZ     1C16
         B        1C11
         SPACE    3
*  LOG ERROR IN ERROR LOG
*
ERFILDA  EQU      %
         LW,R7    S:CUN
         LB,R7    UB:OV,R7          OVERLAY #
         LI,R2    CLSSEG
         LI,R0    ERFILDA#
         B        T:OVERLAY
         SPACE    2
         DEF      REDSEC1
*
*  SET UP THE DCB TO EFFECT A MI OR DIRECTORY GRANULE READ.
RWREX    EQU      %
         DEF      RWREX,RWREX1
         LI,R2    XBUFSIZ
         CI,D1    1
         BAZ      %+2               IT'S A GRANULE
         SLS,R2   -1
RWREX1   BAL,R0   SETBLK
         STW,D1   CDA,R6            SAVE DISK ADDRESS
*                                   SAVE SIZE AND BUFFER
         BAL,SR4  PUTSZBF
         BAL,D4   SETBTDZ
         LW,SR1   R6
         B        *SR3
         SPACE    3
REDSEC6D LW,R3    TSTACK
         LW,D3    -6,R3  REFRESH BUFFER ADDRESS
         LW,SR1   *D3
         BEZ      REDS2-1
         BAL,SR4  FMCHKDA
         BCS,15   %+2
         B        REDS9             BAD NEWS
         LI,2     1                 CHK FLINK
REDS2    LW,SR1   *D3,R2
         BEZ      EROC
         BAL,SR4  FMCHKDA
         BCS,15   EROC
         B        REDS9
Y3FFF    DATA     X'3FFF0000'
         DEF      Y3FFF
         PAGE     WRTSEC
*  ROUTINE TO CLEAR THE CONTENTS OF THE MI BUFFER.
*  BUFFER IS NOT CLEARED IF IT HAS NOT BEEN UPDATED.
WRTSEC   EQU      %                 D3 = BUFFER ADR
         LW,D2    Y002
         STS,D2   MIUD,R6           SET MIUD
CLRBFUB  EQU      %
         BAL,D2   GETCFUD           WRITE OUT CURRENT SECTOR
         PUSH     9,D1
         BAL,R0   GETCSAP1
         LW,D1    D2
         AND,D1   M24
         CI,R1    FILCFU            CHK 4 DIRECTORY
         BG       WRTSEC12          IT ISN'T
         LW,R0    Y002              CHK 4 UPDATES
         CW,R0    MIUD,R6
         BAZ      WRTSEC12          NONE
         DO       NUPRIV=0
         BAL,R0   PRIVDCB           CHK 4 PRIVATE
         BANZ     WRTSEC12          IT IS
*  ABOVE 2 LINES ARE REMOVED WHEN WE GET NEW PRIVATES
         FIN
DDA      EQU      DBLINK-1
         LW,SR1   BUFF2+DDA         GET DUAL DA
         LW,SR4   BUFF2             CHK FOR FDA
         BNEZ     %+2               NOT FDA
         LW,SR1   DFDA,R1           DUAL DA OF FDA
         STW,SR1  DCDAM             DA OF DUAL
         AI,SR1   0
         BLEZ     WRTSEC12          NONE
         BAL,SR4  FMCHKDA           IS IT VALID
         BCR,15   WRTSEC12          NO GOOD
         BAL,SR3  GETTBL            MUST WRITE DUAL - GET TABLE ENTRY
         STB,R3   D1                  FOR END-ACTION
WRTSEC12 RES      0
         LI,D3    BUFF2             BUFFER ADDRESS
         RABAL,R0 T:RADD            ADD TO READ AHEAD TABLES
         BCR,15   REDSEC1           ADDED SUCCESSFULLY
         LW,D4    Y002
         CW,D4    MIUD,R6           IS BUFFER UPDATED
         BAZ      REDSEC1           NO - GET OUT
         STS,D3   MIUD,R6           RESET BUFFER UPDATED BIT
WRTSEC10 EQU      %                 ENTER HERE FROM MUL
         LI,SR1   BUF2MSK
         AND,SR1  BUFX,R6
         BEZ      EROD              GOT 2 BE KIDDING
         LW,SR1   D1
         BAL,SR4  FMCHKDA           VERIFY DISC ADDRESS
         BCR,15   EROD              BAD NEWS
         BAL,SR3  RWREX
         OR,SR1   Y06               WRITE FUNCTION CODE
         LI,SR2   WRTXEND1          END-ACTION ADDRESS
         LW,SR3   QBUF,R6           VIRT BUFFER ADDR
         BAL,SR4  WRTAHED           WRITE AHEAD IF POSSIBLE
         B        WRTSEC11          WE DID
         LW,SR3   BUFX,R6           END ACTION INFO IS BUFFER
         SLS,SR3  -5                  INDEX RIGHT JUSTIFIED
         LB,SR4   D1                MOVE EA TBL INDEX FOR DUAL WRITE
         STB,SR4  SR3                 TO EA INFO WORD
         BAL,SR4  PVQUEUE1          WRITE MASTER
         LB,SR4   SR3
         BEZ      WRTSEC1A          NO DUAL WRITE
         LW,D1    DCDAM             DUAL DISC ADDRESS
         STW,D1   CDA,R6
         LW,SR1   R6                MOVE DCB ADDR FOR QUEUE
         OR,SR1   Y06
         BAL,SR4  PVQUEUE1          WRITE THE DUAL
WRTSEC1A LI,R5    FPMC              PUT FREE-PAGE-MAP-CONSTANT
         LI,R2    BUFF2**-9           IN WINDOW SLOT IN
         STORE,R5 JX:CMAP,R2          JX:CMAP
*
WRTSEC11 RES      0
         LI,SR4   BUF2MSK
         LI,SR3   0
         STS,SR3  BUFX,R6           RESET BFR INDEX
         BAL,R0   RESBLK
REDSEC1  RES      0
         PULL     9,D1
BUF2X    RES      0
         LI,D3    BUF2MSK           BUF2X MASK
         AND,D3   BUFX,R6
         BEZ      %+2
         LI,D3    BUFF2
         B        *R0
         SPACE    2
*
*  END ACTION ROUTINE FOR WRITE AHEAD VIA PVQUEUE1
*        R5 = USER #
*        R6 = BUFFER PHYSICAL WORD ADDRESS
*        SR3 = BUFFER INDEX (END ACTION INFO)
*        SR4 = LINK REGISTER
*
WRTXEND1 LB,R3    SR3
         BEZ      WRTXEND           THIS ISN'T A DUAL WRITE
         BAL,R0   DUALEA            DUAL - CHECK IF BOTH WRITES DONE
WRTXEND  AND,SR3  M5                MASK OFF 5 BIT INDEX
         AI,SR3   JXBUFVP-1         CONVERT TO CMAP INDEX
         DISABLE
         LOAD,R4  UX:JIT,R5
         SLS,R4   9                 PHYSICAL JIT ADDRESS
         LI,R2    JBFBFP            INDEX TO HEAD OF FREE CHAIN
         LB,SR2   *R4,R2            CURRENT FREE POOL HEAD
         STB,SR3  *R4,R2            NEW HEAD
         STB,SR2  *R6               STORE LINK IN PHYSICAL PAGE
         REF      ENBSR4
         B        ENBSR4
         SPACE    3
*
*  LOCATE A BIT INDEX INTO CELL FDFLAGS TO CONTROL DUAL WRITES.
*
*  FDFLAGS:
*        BITS 16-31 INDICATE WHETHER OR NOT AN ENTRY IS IN USE
*          (SET=AVAILABLE, RESET=IN USE).
*        BITS 0-15 ARE PARALLEL TO BITS 16-31.  THE BIT IS
*          INITIALLY SET.  WHEN AN I/O COMPLETES, IF THE BIT
*          IS SET IT IS RESET AND NOTHING IS DONE.  IF IT IS
*          RESET, THEN THIS IS THE SECOND I/O, SO THE ENTRY IS
*          MARKED AVAILABLE AND THE END-ACTION PROCESSING IS DONE.
*
GETTBL   EQU      %
         DISABLE
         LW,R4    FDFLAGS
         LI,R3    16
         CW,R4    BT31TO0,R3        FIND AN AVAILABLE ENTRY
         BANZ     GET5              FOUND ONE
         BDR,R3   %-2
         ENABLE
         B        GETTBL            TRY AGAIN
*
GET5     AND,R4   NB31TO0,R3        RESET AVAILABLE FLAG
         OR,R4    BT31TO0+16,R3     NO I/O HAS COMPLETED
         STW,R4   FDFLAGS
         ENABLE
         B        *SR3
         SPACE    3
*
*  AN I/O HAS COMPLETED.  IF IT IS NOT THE LAST, DO NOTHING.
*  OTHERWISE, PROCESS THE END-ACTION ROUTINE.
*
DUALEA   EQU      %
         DISABLE
         LW,R4    FDFLAGS
         CW,R4    BT31TO0+16,R3
         BAZ      DUAL5             IT IS THE LAST
         AND,R4   NB31TO0+16,R3     NOT LAST - RESET FLAG
         STW,R4   FDFLAGS
         ENABLE
         B        *SR4              RETURN TO IOQ
DUAL5    OR,R4    BT31TO0,R3        SET AVAILABLE FLAG
         STW,R4   FDFLAGS
         ENABLE
         B        *R0               RETURN TO PROCESS END-ACTION
         PAGE
*  ROUTINE TO CLEAR THE CONTENTS OF THE BLOCKING BUFFER.
CLRBBUF  EQU      %                 WRITE OUT BUFFER
         PUSH     8,D1
         LW,R1    Y004
         CW,R1    BFL,R6            CHK THE UPDATES FLAG
         BAZ      CBB5A
         LI,R0    2
         STS,R0   BFL,R6            CLR THE FLAG
         CW,R0    ASN,R6
         BANZ     CLRLBLT           IT'S LABEL TAPE
*                                   COMPUTE REMAINDER IF ANY IN BUFFER
         LI,D1    BUFSIZ
         BAL,R0   GETCBD
         BEZ      CBB2+1
         LW,D1    R3
         LW,R1    CFU,R6
         LI,R4    HACCBD
         AND,R3   L(X'7FC')
         STH,R3   *R1,R4
         LW,R0    BCDA,R6
         STW,R0   SREC,R1
CBB2     LI,R3    K0
         BAL,R0   SAVCBD
*  NOTE:  SAVCBD RETURNS WITH R2=0
         XW,R2    BCDA,R6
         AND,R2   M24               CLEAR DUAL-WRITE FLAG
         STW,R2   CDA,R6
         LI,SR3   BUFF1
         BAL,11   WRTAHED
         B        CBBWA             BUFFER WAS WRITTEN AHEAD
         LW,R2    D1
         LI,SR2   WRTXEND           END ACTION ADDRESS
CBB8     EQU      %
         LW,SR1   Y26
         LI,D3    BUFF1
         LW,SR3   BUFX,R6           END ACTION INFO = BUFFER INDEX
CBB3     EQU      %
         OR,SR2   Y8                SET FLAG TO UN-MAP BUFFER
         BAL,SR4  CLRB
CBB4     EQU      %
         BAL,D4   SETBTDZ
*
         OR,SR1   R6
         BAL,R0   SETBLK
         BAL,SR4  PUTSZBF
         LW,7     14
         BAL,11   PVQUEUE1
         BDR,SR2  CBB4A             DON'T UN-MAP BUFFER
         LI,R5    FPMC              PUT FREE-PAGE-MAP-CONSTANT
         LI,R2    BUFF1**-9           IN WINDOW
         STORE,R5 JX:CMAP,R2          SLOT IN JX:CMAP
*
CBB4A    EQU      %
         LI,R0    BLKINX
*
*  RESTORE THE CONTENTS OF THE BLK, QBUF, & CDA FIELDS
*  FROM WHERE THEY WERE SAVED IN TSTACK TO THE DCB.
RESBLK   PULL     3,R3
         STW,R3   BLK,R6
         STW,R5   CDA,R6
         LW,R5    M24
         STS,R4   QBUF,R6
         B       *R0
*
*
CBB5A    EQU      %
         LW,R1    Y001
         STS,R1   BFL,R6
CBB5     EQU      %
         LW,R1    Y008
         CW,R1    BFL,R6
         BAZ      %+2
         BAL,11   IOSPIN
         LI,SR3   BUF1MSK           BUF1X MASK
         AND,SR3  BUFX,R6
         BEZ      BLKINX            NO BUFFER
         LI,R1    TOPMSK            TOPX MASK
         AND,R1   BUFX,R6
         SLS,R1   -10
         CW,R1    SR3
         BE       CBB6              SAME - DON'T RELEASE
         LI,D3    BUFF1
         LI,R5    1
         BAL,R2   T:RBUF
CBBWA    RES      0
CBB6     EQU      %
         LI,SR4   BLKINX            RETURN
CLRB     LI,R1    BUF1MSK           BUF1X MASK
         B        CLR10             BUF1
*
*
CLRLBLT  EQU      %
*                                   WRITE LBLT BLOCK
         LW,R2    CMD,R6
         LH,R2    R2
         STW,R2   CMD,R6
         LI,SR2   WRTELEND
         B        CBB8
         PAGE     TRUNC
         DEF      TRNC
*
*  ROUTINES TO CLEAR AND RELEASE ALL BUFFERS IN A DCB.
TRNC     RES      0
*                                   TRUNCATE DCBS
         BAL,R1   PUSHALL
         LW,D2    ASN,R6
         CW,D2    Y002
         BAZ      MSRWRTX           NOT OPEN, IGNORE
         AND,D2   M4                GET ASN
         REF      M4
         CI,D2    2
         BG       MSRWRTX           DEVICE OR ANS TAPE
         LI,SR4   MSRWRTX
TRUNC    PUSH     SR4               SAVE RETURN
REDSEC9  BAL,R0   CLRBFUB           CLR BUF2
         LI,R0    BUF1MSK
         AND,R0   BUFX,R6
         BEZ      %+2               DON'T SET TBT BIT IF NO BUFFER
         BAL,R0   CLRBBUF           CLR BUF1
         LI,SR2   3
         LW,SR3   BUFX,R6
TRN1     LI,D3    X'1F'
         AND,D3   SR3
         BEZ      %+3
         LI,R5    1                 RELEASE TO FREE POOL
         BAL,R2   T:RBUF
         REF      T:RBUF
         SLS,SR3  -5
         BDR,SR2  TRN1
         SLS,SR3  15
         STW,SR3  BUFX,R6           RESET ALL BFR INDICES
         PULL     SR4
         B        IOSPIN
*
         DEF      OPERC
OPERC    PUSH     SR4
         LI,D1    0
         LW,D2    Y006
         STS,D1   BFL,R6            RESET UPDATED FLAGS
         B        REDSEC9
         DEF      Y006
         SPACE    3
*
*  ROUTINE TO GET CURRENT DISPLACEMENT IN THE BLOCKING BUFFER.
GETCBD   EQU      %
         LI,R3    X'E0000'
         AND,R3   CBD,R6
         SCS,R3   15
         B        *R0
         PAGE
         SPACE    2
*
*        WRITE AHEAD
*
*        IF A PHYSICAL PAGE IS AVAILABLE, THE CURRENT BUFFER
*        WILL BE WRITTEN TO THE SPECIFIED DISC ADDRESS, THE
*        NEW PHYSICAL PAGE WILL BE SUBSTITUTED IN THE USERS
*        MAP AND AN I/O REQUEST WILL BE QUEUED TO WRITE THE ORIGINAL
*        PHYSICAL PAGE. END-ACTION FROM THIS REQUEST WILL RELEASE
*        THE ORIGINAL PAGE.  EFFECTIVELY, THE USER'S I/O HAS
*
*        INPUT:
*              SR3(R10)=VIRTUAL BUFFER ADDRESS
*              SR4(R11)=RETURN ADDRESS
*                 NORMAL RETURN => WRITE AHEAD WAS PERFORMED
*                 SKIP RETURN => NO WRITE AHEAD
*              DCB:CDA=DISC ADDRESS TO BE WRITTEN
*
*        ALL REGISTERS PRESERVED
*
WRTAHED  EQU      %
         PUSH     16,11
         BAL,R11  PVQ20             SET UP PV INDICATORS..DCTX IN CDA
WAHPUB   BAL,SR4  T:STLPP           STEAL A PHYSICAL PAGE
         AI,3     0                 DID WE?
         BGZ      WAHOK             YES - DO IT
         PULL 15,12                 RESTORE REGS
         MTW,1    *TSTACK           EXIT SKIPPING
         B        WAPVQX            AFTER RESTORE CDA
WAHOK    RES      0
         LI,D3    X'1FFFF'
         AND,D3   SR3               VIRTUAL BUFFER ADDRESS
         PUSH     D3
         BAL,R2   T:XBUF            SWITCH PAGES IN THE MAP
         PULL     D3                T:XBUF DESTROYS SR3
         LI,R5    1
         BAL,R2   T:RBUF
         LW,R1    SR3               END-ACTION INFO IS BUFFER ADDRESS
         SLS,SR3  2                 BYTE ADDRESS
         LW,15    CDA,R6            GET DISK ADDRESS
         LB,12    15                DUAL WRITE FLAG
         STB,12   R1                PUT IN EA INFO WORD
WAHDUAL  LDCTX,12 15                GET DCT INDEX
         LI,R2    1
         AI,12    X'0A00'           NRT=10
         LW,13    S:CUP             CURRENT USER'S PRIORITY
         STB,13   12,2              INSERT PRIORITY
         STB,2    12                WRITE FCN CODE
         LW,13    SR3               BUFFER ADDRESS
         LI,14    BUFSIZ
         CI,15    1                 CHECK FOR FULL GRAN
         BAZ      %+2               YES
         SLS,14   -1
         LI,R0    WRTEA             END-ACTION ADDRESS
         PUSH     3,15              SAVE DISC ADDR AND EAI
         BAL,11   NEWQNW            QUEUE IT UP
         NOP                        DOWN RETURN   ****
         PULL     3,15
         LB,11    15                DUAL WRITE FLAG
         BEZ      WAHXIT            NOTHING MORE TO DO
         LW,15    DCDAM             DUAL DISC ADDRESS
         B        WAHDUAL           WRITE THE DUAL
*
WAHXIT   PULL     15,12
         B        WAPVQX            RESTORE DCB:CDA AND EXIT
         SPACE    3
WRTEA    EQU      %
         LB,R3    R14               DUAL WRITE FLAG
         BEZ      T:RSPPEA          NOT DUAL - RELEASE BUFFER
         AND,R14  M24               SCRUB INDEX BITS
         LI,R0    T:RSPPEA
         B        DUALEA            CHECK IF LAST WRITE
         SPACE    3
*  ROUTINE TO SET THE CURRENT DISPLACEMENT IN THE BLOCKING
*  BUFFER
SAVCBD   EQU      %
         LI,R2    K7FFF
         SCD,R2   -15
         STS,R2   CBD,R6
         B        *R0
         PAGE
AGER     SET      BUFX
*
*  ROUTINE TO GET AN MI BUFFER.
GETBUFM  EQU      %
GETSEC   EQU      %
         LI,R1    X'1FFFF'
         AND,R1   CFU,R6
GETSECP2 LI,D3    BUFF2
         LI,SR3   BUF2MSK           BUF2X MASK
         AND,SR3  BUFX,R6           DO WE HAVE 1
         BNEZ     *R0
         LW,SR4   Y002              RESET MIUD
         STS,SR3  MIUD,R6
         LI,R5    1F1               SET RETURN
         PUSH     10,D1
         B        GSBUF1
1F1      RES      0
         SLS,SR3  5
         LI,SR4   BUF2MSK
         STW,SR4  BUFF2             CLOBBER THE BLINK
GBUFX1   STS,SR3  BUFX,R6
GBUFX    EQU      %
         PULL     9,D1
         LI,D3    BUFF2
         CI,SR4   BUF2MSK
         BE       %+2
         LI,D3    BUFF1             RETURN WITH D3 SET TO BUF ADDR
         B        *R0
GSBUF    EQU      %
         PUSH     1,SR4
GSBUF1   EQU      %
         LI,D3    BUFF2
         BAL,R2   T:GBUF
         AI,SR3   0
         BNEZ     PULLEXIT
         LI,R3    16
         B        GTDCBM
KEYER3   LI,SR3   K43
         B        MSR00EXIT
GTDCB1   LW,R5    0,R5
         BEZ      GBB3
         BDR,R5   GTDCB
*
GBB3Q    BAL,R0   CLRBFUB           TRUNC BUF2 FOR THIS DCB
         REF      FILCFU
         LI,D4    BUF2MSK
         AND,D4   BUFX,R6
         BEZ      5B4AA
         LI,D3    0
         STS,D3   BUFX,R6
         LI,D3    BUFF2
         LI,R5    1
         BAL,R2   T:RBUF
         B        5B4AA
*
CLRMI    EQU      %
         LI,R1    BUF2MSK           BUF2X MASK
CLR10    EQU      %                 ENTRY POINT
         LI,R0    0
         STS,R0   BUFX,R6
         B        *SR4
         PAGE
*  ROUTINE TO GET A DATA BLOCKING BUFFER.
GETBBUF  EQU      %                 GET BLOCKING BUFFER
         LI,D3    BUFF1
         LI,SR3   BUF1MSK           BUF1X MASK
         AND,SR3  BUFX,R6           DO WE HAVE 1
         BNEZ     *R0               YUP
         PUSH     9,D1
GBB4     EQU      %
         LI,D3    BUFF1
         BAL,R2   T:GBUF
         REF      T:GBUF
         AI,SR3   0
         BNEZ     GBBOUT            GET OUT WITH BUFFER
*
GTDCBM1  LI,R3    -9
GTDCBM   LW,R5    J:DCBLINK
         AI,R5    -1
         LI,R7    M:XX
         LI,SR3   0                 ACTION DCB POINTER
         LI,R1    0
         AND,R6   M17
         LW,SR4   Y00FF8
         AND,SR4  AGER,R6
         B        GBB2
         SPACE    3
*  A DCB MUST SURRENDER ONE OF ITS BUFFERS.
GTDCB    AI,R5    2
         LB,R0    *R5
         BEZ      GTDCB1
         SLS,R0   -2
         AW,R5    R0
         LW,R7    1,R5
GBB2     LW,R0    FCD,R7
         CW,R0    Y002
         BAZ      GTDCB
         AND,R0   XF
         REF      XF
         AI,R0    KN2
         BGZ      GTDCB
         AI,SR3   0
         BNEZ     %+5               ACTION LOCATED ALREADY
         LW,R2    YFF
         CW,R2    FCN,R7
         BAZ      %+2               NO ACTION
         LW,SR3   R7
         CW,R6    R7
         BE       GTDCB             DON'T TRUNC SELF
         LW,R2    BUFX,R7
         CI,R2    X'7FFF'
         BAZ      GTDCB             YES WE HAVE NO BUFFERS
         AND,R2   Y00FF8            GET AGE
         CW,R2    SR4
         BG       %+2
         AW,R2    Y01
         SLS,R2   2
         AI,R1    0
         BEZ      %+3
         CW,R1    R2
         BLE      GTDCB
         LW,R1    R7
         AW,R1    R2
         B        GTDCB
Y00FF8   DATA     X'00FF8000'
GBB3     RES      0
         AI,R1    0
         BNEZ     GBB3A             FOUND A DCB WITH BUFFERS
         LW,R1    R6                DIDN'T - TRY OWN DCB
         BEZ      5B4C              NO DCB - CAME FROM GETSBUF
GBB3A    LI,D4    TOPMSK            TDA MASK
         AND,D4   BUFX,R1
         BEZ      5B4A
         LI,D3    BUF1MSK
         AND,D3   BUFX,R1
         SLS,D3   10
         CW,D3    D4
         BE       5B4A
         LI,D3    0
         STS,D3   BUFX,R1
         LI,R5    1                 FOR T:RBUF
         SLD,D3   22
         LW,9     3
         BAL,R2   T:RBUF
         LW,3     9
         B        5B4B
5B4A     RES      0
         LW,R2    R6
         LI,R7    X'1FFFF'
         CS,R6    R1
         BE       5B4C
         LS,R6    R1
         PUSH     2,R2
         BAL,R0   MAPBUFS           MAP BUF1 AND BUF2 FOR THIS DCB
         LI,D3    BUF1MSK
         AND,D3   BUFX,R6
         BEZ      GBB3Q
         BAL,R0   CLRBBUF
5B4AA    EQU      %
         BAL,SR4  IOSPIN            WAIT FOR WRITES TO COMPLETE
         LW,R6    TSTACK            RESTORE ORIGINAL DCB ADDRESS
         LW,R6    -1,R6
         BEZ      %+2
         BAL,R0   MAPBUFS           MAP BUFFERS FOR ORIGINAL DCB
         PULL     2,R2
5B4B     BDR,R3   GSBUF1            BR IF GETTING BUF2
         AI,R6    0
         BEZ      GBUFX             BACK TO MM
         B        GBB4
*
GBBOUT   LI,SR4   BUF1MSK
         B        GBUFX1
5B4C     RES      0
         XW,R6    SR3
         BNEZ     5B4E
         LI,R4    JBFBFP
         LB,R4    J:JIT,R4
         BNEZ     5B4F
         SCREECH  X'2E'             SCREECH .2E
5B4E     EQU      %
         BAL,SR4  IOSPIN            PARK AWHILE
5B4F     RES      0
         LW,R6    SR3               RESTORE DCB
         B        5B4B
         DEF      GETSBUF
         SPACE    2
*
*  TRUNC ANY DCB  -  CALLED BY MM
*
GETSBUF  RES      0
         PUSH     9,D1
         B        GTDCBM1
         PAGE     LOCCODEUB
*
         OR,R0    Y8                SET FOR LIMIT CHEKS ON SECTOR
*
*
*ROUTINE TO FIND A SPECIFIED KEY OR DIRECTORY ENTRY BY
*SEARCHING ON LEVEL ZERO.
LOCKEYUB EQU     %
LOCCODEUB  EQU    %
         LI,R3    0                 IN CASE IT'S NULL FILE
         LI,D1    K0
         LW,D2    Y00FE
         STS,D1   TYC,R6            RESET TYC
         LW,R1    CFU,R6
         LW,D2    FDA,R1            CHK
         BLEZ     SETCMD1            4 A NULL FILE
         AI,R0    1                 NON-EMPTY RETURN
         STW,R0   J:BASE
         LI,D3    BUF2MSK
         AND,D3   BUFX,R6
         BEZ      LOCKY2M           BUFFER WAS TRUNCATED
         LI,D3    BUFF2
LOCK5    RES      0
         LW,R0    J:BASE
         BLZ      LOCKY5
         LW,R2    CMD,R6            CURRENT DISPLACEMENT
         LH,R3    R2                 IN BUFFER
         AI,R3    -MIDIS            GET
         BLEZ     LOCKY7
         DW,R3    IMT,R6             TO
         MW,R3    IMT,R6              START
         AI,R3    MIDIS                OF MI ENTRY
LOCKY4   CH,R3    BUFF2+2           CURRENT
         BL       LOCKY6              ACTIVE AREA
         SW,R3    IMT,R6            BACK UP
         BGZ      LOCKY4
LOCKY7   RES      0
         LI,R3    MIDIS
LOCKY6   RES      0
         LB,R0    BUFF2,R3          IS IT SIGNIF?
         BEZ      LOCKY1            NOPE
         BAL,R1   SETUPH3+1         TO COMPARE KEYS
         BNE      LOCCODEUB8-1      NOT FOUND
HIT      RES      0
         LI,R1    X'1FFFF'
         AND,R1   CFU,R6
         CI,R1    FILCFU
         BLE      HIT1              NO DUPS IN DRCTRIES
         LW,R5    R3
         AW,R5    IMT,R6
         AI,R5    -3                FLAGS POSITION
         LB,R2    BUFF2,R5
         CI,R2    4                 CHK FAK
         BAZ      1B3               GO FIND FAK
HIT1     RES      0
         LCI      0                 SET CC TO =
         B        *J:BASE
*
LOCKY5   EQU      %
         LI,R3    MIDIS
         LB,SR4   BUFF2,R3          FIND NON-NULL KEY
         BNEZ     1B2               OK
         BAL,SR4  FNDKY             MOVE ON
         B        %+2               OFF THE END
         B        1B2               OK
         LI,D1    0                 RESET TYC
         BAL,R0   SETTYC
         BAL,R4   FNDKYT1           BACK UP TO EOF
         B        %+1
1B2      RES      0
         BAL,SR4  SETUPLT           CHK 1ST KEY
         BL       LOCCODEUB6        NOT IN
         BE       HIT               GOT IT
1BA      BAL,SR4  SETUPHT           CHK LST KEY IN SCTR
         BL       ITSIN             GOT THE SECTOR
         B        HIT-1
*
GETCMD   LI,R2    HACMD
         LH,R3    *R6,R2
         B        *R0
LOCKY1   EQU      %
         BAL,SR4  FNDKY             FIND NON-NULL KEY
         B        LOCCODEUB6
LOCCODEUB2  EQU   %
         BAL,R1   1A3M1             COMPARE
         BE       LOCCODEUB9
         BL       LOCCODEUB6
LOCCODEUB8  EQU   %                 USER KEY GREATER THAN M.I. KEY
         LW,R4    BUFF2             SAVE BLINK
         BAL,SR4  1A7               FIND NEXT KEY
         B        LOCK1             NO MORE KEYS IN FILE
         CW,R4    BUFF2             HAS BLINK CHANGED
         BE       LOCKY9            NO
         LW,R0    J:BASE            BRANCH IF
         BGEZ     LOCKY9             NOT SETUPUB
         BAL,SR4  SETUPLT           CHK 1ST
         BL       LOCCODEUB9        CAN'T FIND IT
         B        1BA-1
LOCKY9M  LI,R3    MIDIS             FIND 1ST KEY IN FILE
         BAL,SR4  FNDKY
         B        %+1
LOCKY9   RES      0
         BAL,R1   1A3M1             COMPARE
         BG       LOCCODEUB8        FOUND PROPER AREA
*
*
LOCCODEUB9  EQU   %
         B        *J:BASE           NORMAL EXIT
*
LOCK1    MTW,-1   J:BASE            SET RETURN BACK
         LI,R0    IOSEQUB1+1        CHK WRITE AT EOF
         CW,R0    *TSTACK
         BE       CLRTRNM1
         B        LOCK2
LOCCODEUB6  EQU   %
         LW,R4    BUFF2             SAVE BLINK
         BAL,R0   FNDKYR
         B        LOCKY9M
         CW,R4    BUFF2             HAS BLINK CHANGED
         BE       LOCCODEUB2        NO
         LW,R0    J:BASE            BRANCH IF
         BGEZ     LOCCODEUB2         NOT SETUPUB
         B        1B2
1A3M1    BAL,R0   GETCMD            MASTER X DISPL
*
*  GENERALIZED TEXTC STRING COMPARE ROUTINE.
1A3      ANLZ,R5  3A0  *D3,R3
1A3P1    ANLZ,R4  3A56 *D4
         LB,R0    0,R5              LENGTH
         AI,R5    1
         CB,R0    0,R4              CHK LNGTHS
         BE       3A57              SAME
         AND,R0   M7                REMOVE GARBAGE
         REF      M7
         DEF      1A3,1A91
         BNEZ     3A67
         LB,R0    0,R4
         STB,R0   R5
         CBS,R4   1
         BNE      0,R1
         CI,R1    HILFAILM          CHK 4 KEYVERIF
         BE       *SR4
         LB,R0    0,R5
         BEZ      0,R1
         LI,R4    BASCR
         AI,R0    1
         CB,R0    *R6,R4
         B        0,R1
3A67     RES      0
         CB,R0    0,R4              CHK AGAIN
         BE       3A57              OK THIS TIME
         BL       3A66
         LB,R0    0,R4              SHORTEST
         OR,R0    Y3                SET
3A66     EOR,R0   Y2                 CONDITIONS
         REF      Y3
         STB,R0   R5                COUNT CTRL
         CBS,R4   1                 CMPRE KEYS
         BNE      0,R1              CC OK
         LC       R0                SET RESLT
         B        0,R1              OUT
3A57     STB,R0   R5                COUNT CTRL
         CBS,R4   1                 GET RSLT
         B        0,R1              OUT
*
         PAGE     FNDKYR
1B3      LI,R0    LOCKY9-1          SET RETURN
*   FALL INTO FNDKYR
         SPACE    3
FNDKYR   EQU      %                 FIND NEXT ACTIVE KEY IN REVERSE
*                                   DIRECTION
*                                   D3 = M.I. ADDRESS
*                                   R3 = M.I. DISPLACEMENT
         PUSH     1,R0
         BAL,R4   FNDKYT1
         B        PULLEXIT
*                                   R3 IS POSITIONED AFTER ACTIVE ENTRY
*                                   GET TO BEG OF KEY
FNDKYR2  EQU      %
         BAL,R0   GETCMD
         LI,R2    %                 RETURN FOR 1A8
         CI,R3    MIDIS             AT BEG OF SECTOR
         BLE      1A8M
         LW,R5    R3
         SW,R3    IMT,R6
         BAL,R0   SETCMD1
         AI,R5    -3                GET TO FLAGS
         LI,R0    X'1FFFF'
         AND,R0   CFU,R6
         CI,0     ACNCFU
         BNE      %+2
         AI,R5    2
         LB,R5    BUFF2,R5
         CI,R5    4
         BAZ      FNDKYR2           NOT FIRST
         B        PULLEXIT1         FOUND KEY
*
*  FIND THE NEXT NON DELETED RECORD SEGMENT IN THE REVERSE
*  DIRECTION.  IT NEED NOT BE THE FIRST SEGMENT OF A RECORD.
FNDKYT   EQU      %
         LW,R4    R0                SET RETURN
FNDKYT1  EQU      %
         CI,R3    MIDIS
         BG       FNDKYT2
         BAL,R2   UPRDL0            COUNT READ
         LI,R2    FNDKYT2+1         RETURN
1A8M     LW,D1    BUFF2             GET
         BNEZ     1A8                BLINK
         LI,R3    K0
         LI,D1    K4
         BAL,R0   SETTYC            SET BOF
         LW,R0    R4                SET RETURN
         B        SETCMD1           SET CMD, TYC, & EXIT
FNDKYT2  EQU      %
         BAL,R0   SETCMD1
         SW,R3    IMT,R6
         LB,R2    BUFF2,R3
         BEZ      FNDKYT1
         B        1,R4
         DEF      1A8
1A8      BAL,R0   GETCSA
         OR,D2    Y8                CHK FLINK IN NXT SEC
         BAL,R0   REDSECL
         BAL,R0   CHKFD             CHECK IF FD GRANULE READ
         LH,R3    BUFF2+2           BUFFER END
         LW,R0    R2
         B        SETCMD1
UPRDL0   RES      0
         LI,R3    RDL0              R3=RDL0
         MTB,1    *R6,R3            UP COUNT
         BGZ      0,R2              OUT IF OK
         MTB,-1   *R6,R3            TOO MUCH
         B        0,R2              OUT
         SPACE    2
CHKFD    EQU      %
         LI,R1    X'1FFFF'
         AND,R1   CFU,R6            CFU ADDRESS
         CI,R1    FILCFU
         BNE      *R0
         LW,SR4   Y008              FILE DIRECTORY - SET BIT
         STS,SR4  FUN,R6              FOR AIR (T:RADD)
         B        *R0
         PAGE     FNDKY
*                                   R3 = MIDIS
         DEF      1A7
1A7      AW,R3    IMT,R6            PASS OVER A POSITION
         SPACE    3
*                                   D3 = SECTOR BUFFER ADR FOR M.I.
FNDKY    EQU      %                 FIND NON-NULL KEY BY LOOKING FWD
FNDKY1   EQU      %
         LI,2     HACMD             SET CMD
         STH,3    *6,2
         BAL,0    EOFMITST+3   AT END OF FILE?
         B        *SR4              YUP
FNDKY3   RES      0
*
         CH,R3    BUFF2+2           AT END OF SECTOR
         BGE      FNDKY2            YES
*                                   IS THIS A NULL KEY
         LW,R5    R3
         AW,R3    IMT,R6
         AI,R3    -3
         LI,R1    X'1FFFF'
         AND,R1   CFU,R6
         CI,R1    ACNCFU
         BNE      %+2
         AI,R3    2
         LB,R1    BUFF2,R3          FLAGS
         CI,R1    4
         BAZ      FNDKY1A           NOT FIRST
         LB,R1    BUFF2,R5          IS IT A NULL KEY
         BNEZ     FNDKY4            NO, DONE
FNDKY1A  EQU      %
         AI,R3    3
         B        FNDKY1
FNDKY2   EQU      %
         PUSH     SR4
         BAL,R2   UPRDL0            COUNT READ
         LI,R3    FNDKY5
         LW,D1    BUFF2+1           GET FLINK
         BEZ      PULLEXIT
1A91     RES      0
         BAL,R0   GETCSA
         BAL,R0   REDSECL           READ THE GRANULE
         BAL,R0   CHKFD             CHECK IF FD GRANULE READ
         LW,R0    R3
SETCMD   LI,R3    MIDIS
SETCMD1  LI,R2    HACMD
         STH,R3   *R6,R2
         B        *R0
FNDKY4   AI,SR4   1
         B        *SR4
FNDKY5   PULL     SR4
         B        FNDKY3
         SPACE    3
EOFMITST EQU      %                 SEE IF WERE AT END-OF FILE
*                                   R3 =CMD
         LW,R3    CMD,R6
         LH,R3    R3
         BEZ      EOFMITST1
*  ****  ENTER HERE FROM WRTF *****
         LW,R2    CFU,R6
         LW,D1    FDA,R2
         BLEZ     EOFMITST1         FILE IS EMPTY
         CI,R3    MIDIS
         BLE      PULLEXIT1+1
         AI,R3    KN3               GET TO EOF BYTE
         AND,R2   M17
         CI,R2    ACNCFU
         BNE      3A0               NOT ACCT DIR
         AI,3     2
         LB,2     *D3,R3            FLAG BITS
         CI,R0    WRTFEXT           IS IT ENTER IN WRTF
         REF      WRTFEXT,WRTFEX1
         BNE      %+6               IT ISN'T
         CI,R2    2                 CHK EOF
         BAZ      %+4               NOT EOF
         MTB,-2   *D3,R3            RESET EOF
         AI,R3    1                 SET POSITION
         B        WRTFEX1           GET BACK
         AI,R3    1                 SET POSITION
         B        3A0+2
3A0      RES      0
         LB,R2    *D3,R3
         AI,R3    K3
         CI,R2    K2                EOF BIT SET
         BAZ      PULLEXIT1+1
EOFMITST1 EQU     %
         LI,D1    K7
         B        SETTYC            SET TYC & EXIT
         PAGE     SETUPUB
*                                   SETUPUB LOCATES THE KEY SPECIFIED
*                                   BY THE USER OR THE CLOSEST THING
SETUPUB  EQU      %                 TO IT IF THE KEY CANT BE FOUND
         BAL,R0   1A4               RESET EOP
         LW,D2    Y00FE             RESET TYC
         STS,D1   TYC,R6
         LI,R3    RDL0
         STB,D1   *R6,R3            RESET RDL0
         LW,D4    KAD,R6
         LI,D3    BUF2MSK
         AND,D3   BUFX,R6
         BEZ      SETUP02           NONE IN, GO TO TOP
         LI,D3    BUFF2
         LW,R0    DATA1A5
         STW,R0   J:BASE            SET RETURN & DIRECT
*
*  FIRST CHECK TO SEE IF THE REQUESTED KEY IS IN THE
*  CURRENT BUFFER.
         BAL,SR4  SETUPHT           CHK UPPER BFR ENTRY
1E2      RES      0
         BG       1E1               CHK FOR EOF
         BE       HIT               LUCKY
         STW,R3   J:BASE+1          SAVE POSITION
         BAL,SR4  SETUPLT           CHK 1ST BFR ENTRY
         BL       SETUP02           GO TO TOP OF PYRAMID
         BE       HIT               ALMOST LUCKY
         LW,R3    J:BASE+1          RESTORE POSN
ITSIN    RES      0
         LI,R2    HACMD
         SW,R3    IMT,R6            BACK UP 1
         LB,R1    BUFF2,R3          IS IT SIGNIF?
         BEZ      ITSIN+1           NOPE
         BAL,R1   1A3               COMPARE THIS ENTRY
         BL       ITSIN+1           TRY NEXT 1
         STH,R3   *R6,R2            SAVE POSITION
         B        HIT-1
         SPACE    3
*  SPECIAL CASE FOR WRITE AT END OF FILE.
1E1      LW,D2    BUFF2+1           GET FLINK
         BNEZ     SETUP02           NOT EOF
         MTW,-1   J:BASE            SET FOR DIDN'T FIND
         AW,R3    IMT,R6            INSERT POSITION
         REF      IOSEQUB1
         LI,2     IOSEQUB1+1
         LI,R0    CLRTRNM1          SET RETURN
         CW,2     *TSTACK
         BE       SETCMD1           WRITE AT EOF
         LI,D1    7                 SET TYC=EOF
         BAL,R0   SETTYC
         LI,R0    LOCK3             RETURN
         B        SETCMD1
SETUP01  RES      0
*
*  WE MUST SEARCH ON LEVEL ZERO.
         BAL,R0   LOCCODEUB-1       LEVEL 0 SEARCH WITH LIMIT CHECK
1A5      RES      0
         B        PULLEXIT
*
         BNE      %+2               DIDN'T FIND IT
         MTW,1    *TSTACK           ADVANCE RETURN
*
         LW,R1    CFU,R6
         CW,R1    Y0014
         AND,R1   M17
         BAZ      %+3
         LW,R2    FIL1,R6
         BGEZ     NOCONGES
         CI,1     FILCFU
         BLE      NOCONGES
*   NOT A SCRATCH FILE
         LI,R2    RDL0+2
         LB,D4    *R6,R2            LRDL0
         LI,R2    RDL0
         CB,D4    *R6,R2            RDL0
         BG       NOCONGES
         LI,R5    X'FF'             SET SLIDES
         STS,R5   0,R1               TO MAX
         LI,D1    X'B'              SPECIAL TYC
         BAL,0    SETTYC
NOCONGES RES      0
         PULL     R1
         CI,R1    IOSEQUB1+1        CHK WRITE AT EOF
         BNE      KEYTRANM  SET TRN & PUT KEY IN KBUF
         B        IOSEQUB1+1        WRITE A NEW KEY
*
1A4      RES      0
         PUSH     1,SR4             LINK TO STACK
         LI,D1    0
         B        SETEOP            RESET EOP
DATA1A5  GEN,1,14,17  1,0,1A5+1
*
SETUP02  LW,R1    CFU,R6
         LW,D1    TDA,R1            DOES MULTI LEVEL EXIST
         BLEZ     SETUP01           NO
         BAL,0    CLRBBUF
*
*  START AT THE TOP OF THE UPPER LEVEL PYRAMID AND MOVE
*  DOWN TO FIND THE OPTIMUM GRANULE FROM LEVEL ZERO.
         BAL,R0   MLCHK             CHK TOP LEVEL & GO DOWN IF OK
         BG       MLSET1            WE MUST FLINK FORWARD FURIOUSLY
MLSETA   LW,R0    BUFF1             BLINK
         BEZ      HILFAIL3          BRANCH IF NONE
         LW,D1    BUFF1             GET BLINK
         BAL,R0   MLCHKV            TRY THIS TOP LEVEL SECTOR
         BL       MLSETA            STILL IN REVERSE
         B        MLSET5M1          GO DOWN PYRAMID
MLSET1   BAL,R2   MLSAV   SAVE LAST ENTRY IN BUFFER
         LW,D1    BUFF1+1           GET FLINK
         BEZ      MLSETB            BRANCH IF NONE
         BAL,R0   MLCHKV            TRY THIS TOP LEVEL SECTOR
         BG       MLSET1            NOT YET
         LI,D3    J:BASE
         LI,R3    0
         LI,R0    MLSET06
ISEQICR1 AW,R3    IMT,R6
         AI,R3    -13
         B        *R0
MLSAV    LW,R3    CMD,R6
         LH,R3    R3
         LI,R5    J:BASE+J:BASE+J:BASE+J:BASE
         ANLZ,R4  ID3R3
         LB,R0    0,R4
         AND,R0   M7                ZAP NON FAK BIT
         STB,R0   0,R5
         AI,R5    1
         STB,D1   R5
         AW,R3    D1
         MBS,R4   1
         B        0,R2
*
MLCHK    PUSH     1,R0              SAVE UNUSUAL RETURN
         LI,SR3   TOPMSK
         AND,SR3  BUFX,R6           DO WE HAVE THE TOP?
         BEZ      5B1
         SLS,SR3  -10
         LI,D3    BUFF1
         BAL,R2   T:MBUF
         REF      T:MBUF
         B        5B2-1
5B1      RES      0
         BAL,R0   REDSECB           READ A GRANULE
         B        HILFAIL1
         LI,SR3   X'1C00'           CHK 4 UPPER LVL
         AND,SR3  BUFF1+2
         BNEZ     %+5               OK
         LW,R1    CFU,R6
         STW,SR3  TDA,R1            ZAP THE TOP
         PULL     SR3               BALANCE STACK
         B        HILFAIL2
         LI,SR3   BUF1MSK
         AND,SR3  BUFX,R6
         SLS,SR3  10
         AWM,SR3  BUFX,R6
         LI,D3    BUFF1
5B2      RES      0
         PULL     1,SR3             RESTORE UNUSUAL RETURN
MLCHK01  LW,D4    KAD,R6            USER KEY
         LW,D1    IMT,R6
         AI,D1    -9                LENGTH OF ENTRY ON UPPER
         LH,R3    BUFF1+2           END OF BUFFER
         SW,R3    D1                  IN
*  FIRST SEE IF THE REQUESTED KEY IS WITHIN THE LIMITS OF
*  THE CURRENT UPPER LEVEL GRANULE.
         BAL,R1   SETUPH3+1         1ST LIMIT CHK
         BG       *SR3              FAILURE
         BE       MLSET05P          EXACT HIT
         LI,R3    MIDIS
         BAL,R1   SETUPH3+1         2ND LIMIT CHECK
         BL       *SR3              FAILURE
MLSET03  BE       MLSET05P          EXACT HIT
*  SET UP TO DO A BINARY SEARCH FOR THE REQUESTED KEY
*  IN THE CURRENT UPPER LEVEL GRANULE.
         LI,R2    4*(BUFF1)+1       BUFFER ADDRESS
         STW,R2   J:BASE            JIT TEMP
         REF      J:BASE
3A56     RES      0
         LB,R4    *D4               USER KEY LENGTH
         STB,R4   J:BASE            COUNT FOR CBS
         SLS,D4   2                 BYTE ADDRESS
         LI,D2    9                 BINARY SRCH COUNT
         LW,R1    D1                SAVE
         SLS,D1   8                 INITIAL SRCH INCREMENT
MLSET03A AW,R3    D1                MOVE AHEAD
         BDR,D2   MLSET03B          BRNCH IF NOT DONE
         AI,D2    0
         BEZ      MLSET03B+1
MLSET04  SW,R3    D1                BACK UP 1
         BAL,R0   SETCMD1           SAVE POSITION
MLSET5M1 OR,SR3   Y8                INDICATE BACKUP ACCOMPLISHED
MLSET05  RES      0
         BAL,R2   MLSAV             SAVE KEY
         AI,R3    -4                GET
MLSET06  BAL,R0   PULLFOUR           NEW DISK ADDRESS
         LI,R1    X'1800'            THE
         CW,R1    BUFF1+2           CHK THE LEVEL
         BAZ      MLSET00           BRANCH IF MOVING TO LEVEL 0
         BAL,R0   REDSECB           READ NEXT LOWER LEVEL GRANULE
         B        HILFAIL
         BAL,SR4  KEYVERIF          DID WE GET WHAT WAS EXPECTED
         LI,SR3   MLSET5M1          YUP - STAY IN THIS GRANULE
         B        MLCHK01           GO DOWN ANOTHER LEVEL
MLSET03B SLS,D1   -1                HALVE INCREMENT
         CH,R3    BUFF1+2           CHECK
         BL       MLSET03D           OVERSHOOT
MLSET03C SW,R3    D1                BACK UP
         BDR,D2   MLSET03B          BRNCH IF NOT DONE
         AI,D2    0
         BLZ      MLSET04+1         BRNCH IF DONE
MLSET03D LW,R5    R3                DESTINATION
         AW,R5    J:BASE             CONTROL
         LW,R4    D4                SOURCE
         CBS,R4   1                 COMPARE KEYS
         BG       MLSET03A          GO FORWARD
         BL       MLSET03C          BACK UP
         LW,D1    R1                RESTORE
         B        MLSET04+1
MLSET05P EQU      MLSET05
MLSETB   OR,SR3   Y8                FLAG BACKUP
         B        MLSET06-1         GET DISK ADDRESS
MLSET00  BAL,R0   GETCMD            GET POSITION
         LB,R0    SR3               BRANCH IF WE
         BNE      MLSET01            ALREADY HAVE BACKED UP
         LI,R0    X'80'             BRANCH IF
ID3R3    EQU      3A0
         CB,R0    BUFF1,R3           NOT POINTING TO A
         BAZ      MLSET01             CONTINUATION KEY ENTRY
         CI,R3    MIDIS             BRANCH IF
         BLE      MLSET01            AT START OF GRANULE
         LW,D1    IMT,R6
         AI,D1    -9                RESTORE ENTRY LENGTH
         B        MLSET04           BACK UP
MLSET01  RES      0
         BAL,R0   REDSEC            READ LEVEL 0 HALF GRANULE
         LI,SR4   SETUPUBZ          FORCE RETURN
KEYVERIF LI,R3    MIDIS             ASSURE
         LI,D4    J:BASE
         LW,D2    D3                      IS
         BAL,R1   COMKEYC
HILFAILM RES      0
         BE       *SR4              OK
HILFAIL  LW,SR3   D1
         LW,R1    CFU,R6
         LI,R3    X'FF'
         STS,R3   0,R1
         LI,SR1   7                 75-07
         BAL,SR4  ERFILDA           LOG THE ERROR
HILFAIL3 RES      0
         LW,R1    CFU,R6
HILFAIL2 RES      0
         LW,D1    FDA,R1
         LI,D2    0
         BAL,R0   REDSECL           BRING IN START OF LVL0
SETUPUBZ RES      0
         BAL,0    CLRBBUF
         LW,D4    KAD,R6            KEY
         B        SETUP01           GO TO LEVEL 0 SEARCH
HILFAIL1 PULL     SR3
         B        HILFAIL
*
*  ROUTINE TO COMPARE WITH 1ST ACTIVE KEY IN CURRENT GRANULE.
1B0      LB,R1    *D4,R4            FOR ANLZ
SETUPLT  LI,R3    MIDIS             FIRST KEY TEST
         LB,R2    BUFF2,R3          SIGNIFICANT
         BNEZ     SETUPH3            KEY TEST
         AW,R3    IMT,R6            NEXT ENTRY
         CH,R3    BUFF2+2           EMPTY SECTOR
         BL       SETUPLT+1           TEST
         LCI      1                 SIGNIFY
         B        *SR4               FAILURE
*
*  ROUTINE TO COMPARE WITH LAST ACTIVE KEY IN CURRENT GRANULE.
SETUPHT  LH,R3    BUFF2+2           LAST KEY
SETUPH2  SW,R3    IMT,R6              TEST
         CI,R3    MIDIS             EMPTY
         BL       SETUPH1            SECTOR TEST
         LB,R2    BUFF2,R3          SIGNIFICANT
         BEZ      SETUPH2            KEY TEST
SETUPH3  LW,R1    SR4               POSITION LINK
         LI,R2    HACMD             MARK PLACE
         STH,R3   *R6,R2
         B        1A3               TO COMPARE
SETUPH1  RES      0
         CI,SR4   1E2               IS IT SETUPUB?
         BE       SETUP02           YUP
         LCI      2                 SIGNIFY
         B        *SR4               FAILURE
*
MLCHKV   PUSH     1,R0              SAVE LINK
         LI,R0    5B3
*
*  ROUTINE TO READ AN UPPER LEVEL STRUCTURE GRANULE.
REDSECB  PUSH     1,R0              SAVE LINK
         LW,SR1   D1                VERIFY
         BAL,SR4  FMCHKDA            DISK ADDRESS
         BCR,15   PULLEXIT          BAD DISK ADDRESS
         BAL,R0   CLRBBUF           FREE THE DATA BUFFER
         BAL,R0   GETBBUF           GET A NEW DATA BUFFER
         STW,D1   BCDA,R6           BLITZ FOR TEST AT UBLK
         LI,R2    BUFSIZ            GRANULE SIZE
         BAL,SR3  RWREX1
         BAL,SR4  PVQUEUE           READ
         BAL,SR4  IOSPIN            WAIT FOR COMPLETION
         BAL,R0   RESBLK            RESTORE DCB
         LI,D3    BUFF1
         B        PULLEXIT1         RETURN
5B3      B        HILFAIL1
         B        5B2
         PAGE     SETLKEYUB
*                                   PUT LAST KEY INTO MASTER INDEX
*                                   FOR END OF FILE PURPOSES
*                                   LAST SECTOR MUST BE IN MEMORY
*                                   CMD POINTS TO EOF BYTE
SETLKEYUB  EQU    %
         STW,R0   J:BASE
LOCK2    LW,R3    CMD,R6
         LH,R3    R3                GETCMD
LOCK3    RES      0
         SW,R3    IMT,R6            BACK UP 1
         BAL,R1   KEYTRAN           PUT KEY IN KBUF
CLRTRNM1 RES      0
         LW,D2    J:BASE            SET RETURN
CLRTRN   LI,R0    K0                CLEAR
         B        SETTRN1            TRN BIT
         PAGE     TRANSFERUB
*                                   TRANSFER USERS RECORD FROM DEVICE
ISEQUB9  STW,7    CDA,R6            FOR 1 REC FRWD
         BAL,SR4  PRDCRD11
         BAL,R0   EOFMITST
         B        MSREXIT
ISEQUB3  LI,SR4   ISEQEXT
*                                   TO HIS AREA
TRANSFERUB  EQU   %
         LW,D1    Y0004
*
*  ROUTINES TO PROCESS DATA MOVES FOR BOTH READS & WRITES.
TRNS1    EQU      %
         PUSH     1,SR4
         LW,D2    Y000C             SET EOP
         STS,D1   EOP,R6
         BAL,SR4  INITARS
         LI,D3    BUFF2
         LI,R2    HACMD
         LW,R3    Y02               CLR TRN
         STS,R2   TRN,R6
TRANSFERUB3  EQU  %
*
         LI,R3    X'E0000'
         STS,R2   BLK,R6            RESET BLK
         LH,R3    *R6,R2            GET CMD
         RABAL,R0  T:RAMISRCH       TRY TO START A READ AHEAD
*
         BAL,D4   SETBTDQ
*
*                                   TRANSFER BLOCKED RECORD
         BAL,R0   ISEQICR1
         BAL,R0   PULLFOUR          GET SIZES
         LH,R7    D1                DISPLACEMENT
         INT,SR2  D1
         BAL,R0   PULLFOUR          D.A.
         STW,D1   CDA,R6
         LI,R2    HACMD
         STH,R3   *R6,R2
         BAL,R0   PULLFOUR          SIZE
         BAL,R0   CHKUPD            UPDATE MODE
         BEZ      %+2
         STH,SR2  D1
         LH,R2    D1
         BEZ      TRNS
         LW,SR1   CDA,R6            DABLK
         BAL,SR4  FMCHKDA           CHECK DISC ADR FOR VALIDITY
         BCS,15   DAOK              GO IF OK
         CH,R3    BUFF2+2
         BG       6B3
6A2      RES      0
         LI,SR1   1                 75-01
         BAL,R0   GETCSA
         LW,SR3   D2                CURR DA FOR ERRLOG
         BAL,SR4  ERFILDA           LOG IN ERRLOG
         LW,SR3   =X'02000075'
         B        MSR01EXIT         R5 DOES NOT CONTAIN JIT ADR
6B3      LI,R0    MSREXIT
         B        EOFMITST1
*
*  FINAL REDSEC CHECKS ARE MADE HERE.
EROC     LI,R2    2
         LW,R1    *D3,R2            SCR IN LOW BYTE
         LI,R4    BASCR
         CB,R1    *R6,R4
         BNE      1C4               PROBABLY BAD
         CI,R1    X'1C00'           CHK 4 UPPER LVL
         BANZ     1C4M1
         LH,R1    R1
         BLEZ     1C4M1
         CI,R1    XBUFSIZ
         BLE      1C6
1C4M1    LI,1     1                 FORCE BAD SCR
1C4      RES      0
         LI,R2    -16
         LB,R2    *TSTACK,R2        REREAD COUNT
         AI,R2    -4
         BGZ      REDS9  READ ONCE IF SCR DOESN'T MATCH
         LW,R0    J:CLS
         REF      J:CLS
         CI,R0    X'100'
         BANZ     1C5               IT'S FIT AT OPEN
         LW,0     Y002
         CW,0     FCD,R6
         BAZ      REDS91            NOT OPEN & NOT FIT
         LI,0     X'30'
         AND,0    ORG,R6
         CI,0     X'20'
         BNE      1C5               IT'S A FIT
REDS91   RES      0
         LI,0     DCBPRIVBIT
         CW,0     PRIV,R6
         BAZ      REDS9             IT'S NOT PRIVATE
         CI,1     X'FF'
         BANZ     REDS9             BAD SCR
         LB,0     *R6,R4            SCR
         LI,R2    2
         AWM,0    *D3,R2
         LW,1     Y002
         STS,1    BFL,6             FIX UP OLD FORM PRIV
1C6      LW,R3    -7,R3             LINK CHK INFO
         LI,R2    0
         SCD,R2   1
         CW,R2    R3
         BG       1C5               NO CHECK REQUESTED
         SCS,R3   -1
         CW,R3    *D3,R2
         BE       1C5               PASSED THE CHECK
         LI,R2    -16
         LB,R1    *TSTACK,R2
         AI,R1    -1
         BGZ      REDS9             TRY A RETRY
         LW,R1    CFU,R6
         LW,R2    0,R1
         CI,R2    X'8000'           CHK 4 SHARE
         BAZ      REDS9             IT'S A 75
         LW,R3    TSTACK
         AI,R3    -9
1C61     CI,R3    TSTACK+18
         BLE      REDS9             BAD NEWS
         CW,R3    1,R3              LOOK 4 PUSHALL
         BE       1C62              GOT IT
         BDR,R3   1C61              TRY AGAIN
*
1C62     LW,D1    -1,R3             LINK CHANGE COUNT
         LW,D2    YFF
         CI,R2    X'100'            LOOK 4 INPUT CFU
         BANZ     %+2
         LW,R1    SCFU,R1
         CS,D1    GAVAL,R1
         BE       REDS9             NO CHANGE
         LI,SR3   X'91827'          UPDATER FLAG
         CW,SR3   2,R3
         BE       REDS9             MAKE IT A 75-02
         LW,SR3   =X'02000015'      15-01 ABNORMAL
         B        MSR01EXIT
*
1C5      RES      0
         LI,0     0
         LI,R1    X'700'
         AND,1    J:CLS
         STS,0    J:CLS             RESET FIT INDICATOR
         CI,1     X'100'
         BANZ     REDSEC2           FIT - NO DUAL
         LI,1     X'1FFFF'
         AND,1    1,6               CFU
         LW,R2    TSTACK
         LW,R3    -6,R2             BUFFER LOC
         CI,R1    FILCFU
         BG       REDSEC2           NOT A DIRECTORY
         BNE      %+3               BRANCH IF ACNCFU
         LW,R0    BLINK,R3          SAVE THE
         STW,R0   FILCFU+16          BLINK FOR COMOPN
         DO       NUPRIV=0
         BAL,R0   PRIVDCB
         BANZ     1C20              NO DUALS FOR PRIVATES
         FIN
         LW,D1    -8,R2
         CW,D1    RDA
         BE       1C21              WE GOT WHAT WE WANTED
         CW,D1    DRDA
         BE       1C21              WE GOT IT'S DUAL
         LW,SR4   DFLINK,R3
         LW,D1    FLINK,R3
         B        1C18              FLINK AHEAD
1C21     LI,SR4   -2
         CW,SR4   REDFLGS           ANY BAD DISK ADDRESSES
         STS,SR4  REDFLGS
         BANZ     1C11              YUP, POST FOR CLEANUP
         CW,D1    DRDA              DID WE GET DUAL
         BNE      1C20              NOPE
         LW,SR4   Y002
         STS,SR4  MIUD,R6           TO WRITE BOTH PLACES
1C20     RES      0
         CI,1     ACNCFU
         BNE      REDSEC2           NOT ACN
         LI,R2    3                 GET 1ST ACCT IN GRANULE
         LW,R0    *D3,R2            1ST WD OF ACCT
         LI,R2    4
         LW,R1    *D3,R2            2ND WD OF ACCT
         SLD,R0   7                 DISCARD THE LENGTH
         LW,R2    ACNCFU+CDAM       DISC ADDRESS OF GRANULE
         LI,3     0
         B        REDSEC5           ENTER SEARCH
REDSEC3  CW,2     ACNTBL+3,3        CHK THIS ENTRY
         BE       REDSEC4           GOT A HIT
         AI,3     3                 NEXT ENTRTY
REDSEC5  CW,3     ACNTBL            CHK 4 END OF TBL
         BL       REDSEC3           NOT THE END
         CI,3     ACNTBLM           IS TABLE FULL
         BGE      REDSEC2           IT'S FULL
         MTW,3    ACNTBL            OPEN UP NEW ENTRY
REDSEC4  LCI      3                 REFRESH OLD ENTRY OR
         STM,0    ACNTBL+1,3         ENTER NEW ONE
REDSEC2  RES      0
         LI,1     -16
         LB,1     *TSTACK,1
         AI,1     -4
         BGEZ     REDSEC1           NO REREADS
         LI,11    REDSEC1
EROO     BAL,0    GETCSA
         LW,SR3   D2
EROA     LI,SR1   X'7F'             75-7F
EROA1    PUSH     11,SR4
         BAL,SR4  ERFILDA           REPORT 75 ERROR
         PULL     11,SR4
         B        *SR4
         SPACE    3
EROD     LI,SR1   2                 75-02
         LI,SR4   REDSEC1
         LW,SR3   D1                MOVE DISC ADDRESS
         B        EROA1             LOG IN ERRLOG, DON'T TELL USER
         PAGE
         SPACE    2
*  RESUME DATA TRANSFER ROUTINES FOR BOTH READS & WRITES.
TRNS     EQU      %
         LI,D3    BUFF2
         LW,R2    CMD,R6
         LH,R3    R2
         AI,R3    2
         LB,R2    BUFF2,R3
         BAL,R0   CHKUPD
         CI,R2    K1
         BAZ      UP2,R4
         LW,D1    RWS,R6
         BEZ      5A0
*
         LW,D1    BLK,R6
         AI,R4    0                 IS THIS WRITE
         BNEZ     UPDBLK            YES
         REF      UPDBLK
         AI,R3    K3                R3 NOW POINTS AT NEXT ENTRY IN MI
         SLS,D1   -19
BFRMWR   EQU      %
         DEF      BFRMWR
         AWM,D1   QBUF,R6
         CH,R3    BUFF2+2           CHK END OF SECTOR
         BL 4R1
         LW,D1    BUFF2+1           GET FLINK
         BEZ      UP3,4
         BAL,R3   1A91
         LB,D4    BUFF2,R3
         BNEZ     4R1
         AW,R3    IMT,R6            NEXT ENTRY
         LI,R0    BFRMWR+1
         B        SETCMD1
*
TRANSFERUB2 EQU   %                 SET LOST DATA COMPLETE
*
         BAL,R0   CHKUPD
         BNEZ     RW2
5A5      RES      0
         BAL,R4   GETTYC            TYC TO R3
          BDR,R3   TRANX
5A4      RES      0
         LI,D1    K2
         BAL,R0   SETTYC
*
*
TRANX    EQU      %
         PULL     R0                GET 'ARS' FROM TSTACK
         STW,R0   RWS,R6            SET DCB:RWS EQUAL TO 'ARS'
         SLS,R0   17
         LI,R1    X'E0000'
         STS,R0   ARS,R6            PUT 'ARS' IN DCB:ARS
         B        PULLEXIT
*                                   SEQUENTIAL FILES
5A0      BAL,0    CHKUPD
         BNEZ     RW2
         AI,3     3
5A2      BAL,0    SETCMD1
         CH,R3    BUFF2+2           CHK NAV
         BL       5A1
         LW,D1    BUFF2+1           GET FLINK
         BEZ      TRANX
         BAL,R3   1A91
5A1      LB,D4    BUFF2,R3
         BNEZ     5A3
         AW,R3    IMT,R6            NEXT ENTRY
         B        5A2
5A3      AW,R3    IMT,R6
         AI,R3    -5
         BAL,0    PULLFOUR
         CI,D1    X'400'
         BANZ     TRANX
         LH,0     D1
         BEZ      TRANX
         B        5A4
*
UP2      EQU      %
         BAZ      TRANX
         BAZ      RW1
UP3      B        TRANX
         B        RW4
         REF      RW4
4R1      BAL,R0   SETCMD1
         AW,R3    IMT,R6            ISEQICRUB+9
         AI,R3    -3                FLAGS
         LI,2     HACMD
         LB,D2    BUFF2,R3
         CI,D2    4
         BAZ      TRANSFERUB3
         BAL,0    CHKUPD
         B        UP3,4
CHKUPD   EQU      %
         LW,R4    EOP,R6
         SCS,R4   13
         AND,R4   X1
         B        *R0
         PAGE
DAOK     EQU      %
         LI,SR4   TRNS              ASSUME SIZES OK
         INT,R1   D1                FLAGS
         SLS,D1   1                 ALIGN
         LI,D2    X'E0000'          MASK
         STS,D1   BLK,R6            SET BLK
         LW,D1    RWS,R6
         SW,D1    R2
         BGEZ     TRNS2             SIZE IS OK
         LW,D1    RWS,R6
         SLS,D1   17                ALIGN
         STS,D1   BLK,R6            SET BLK BETTER
         LW,R2    RWS,R6            BETTER SIZE
         BEZ      TRANSFERUB2       NOTHING LEFT
         LI,SR4   TRANSFERUB2       TO GET OUT
         LI,D1    0
TRNS2    AWM,R2   *TSTACK           ARS ACCUMULATED IN STACK
         STW,D1   RWS,R6
         CI,SR2   BUFSIZ
         BGE      PVREADTP          UNBLOCKED
         LW,R0    SR4               SET RETURN
*    FALL INTO  UBLK
UBLK     EQU      %
*                                   DECIDE IF CORRECT BLOCK IS IN
*                                   MEMORY--IF SO,DO BYTE TRANSFER
*                                   O.W.,SET UP FOR END ACTION
*                                   R7 = INIT DISP IN BLK
*                                   R1 = SECTOR COUNT
*                                   R2 = VALID BYTES IN BLK
         PUSH     8,D1
         BAL,D4   SETBTDZ
         LW,R3    R7
         LI,D3    BUF1MSK
         LW,D1    CDA,R6
         AND,D3   BUFX,R6
         BEZ      UBLK4
         LI,D3    BUFF1
*
         LW,R0    Y008
         CW,R0    BFL,R6
         BAZ      %+2               NO I/O IN PROGRESS ON BUF1
         BAL,SR4  IOSPIN
*                                   IS THIS CORRECT BUFFER
         CW,D1    BCDA,R6           IS CORRECT BUFFER IN
         BE       BLKIN             YES GIVE HIM HIS RECORD
         BAL,R0   CLRBBUF           WRITE OUT THIS BUFFER--GET NEW ONE
         STW,D1   CDA,R6
UBLK4    EQU      %
         STW,D1   BCDA,R6
         BAL,R0   GETBBUF
         BAL,R0   CHKUPD            IS THIS A WRITE
         BNEZ     RW3               YES - GO READ DATA GRANULE
         RANB     UBLK4A            BR IF READ AHEAD NOT IMPLEMENTED
         BAL,R0   T:RACHK           CHECK FOR DESIRED BLOCK
         BCR,15   BLKIN             BR IF READ AHEAD
UBLK4A   EQU      %
         LW,SR2   R3
         BAL,D4   GETBTD
         LW,SR1   QBUF,R6
         STB,R4   SR1               SR1 = 8,24 BTD,USER BUF
         STH,R2   SR2               SR2 = 16,16 BLK,CBD
         REF      Q4AVL
GETQ4    ENABLE
         DISABLE
         LW,4     Q4AVL
         BEZ      GETQ4             WAIT FOR ONE
         LD,2     Q4AVL,4
         STW,2    Q4AVL
         ENABLE
         STD,SR1  Q4AVL,R4          SAVE INFO FOR RBLKEND
         LW,SR3   BUFX,R6           BUFFER INDEX BITS
         STH,R4   SR3               Q4AVL DW INDEX
         LI,SR1   0
         LI,SR2   RBLKEND           EA ADDRESS
         LI,R2    BUFSIZ
         LW,D1    RWS,R6            IS THIS THE LAST TRANSFER TO THE USER
         BLEZ     UBLK3             YES - DON'T RELEASE THE BUFFER
         LW,R1    TSTACK
         LW,R1    -2,R1             REFRESH R1
         CI,R1    K100              NO, IS RECORD CONTINUED IN NEXT BUFFER
         BANZ     CBB3              YES - RELEASE THE BUFFER
UBLK3    EQU      %                 SET BUFFER TO BUSY--DONT RELEASE
*                                   ON END-ACTION
         OR,SR3   Y8
         LW,R1    Y008
         STS,R1   BFL,R6
         B        CBB4
         PAGE
         SPACE    3
*
*  MOVE RECORD FROM BLOCKING BUFFER (BUF1) TO
*  USER'S BUFFER AT I/O END-ACTION
*
*  INPUT:
*        R5 = USER #
*        R6 = BUFFER PHYSICAL WORD ADDRESS
*        R8 = PHYSICAL DCB ADDRESS
*        R10 = END-ACTION INFORMATION WORD
*        R11 = LINK REGISTER
*
*  WARNING:  ALL OF THE ABOVE REGISTERS MUST BE PRESERVED
*
RBLKEND  EQU      %
         INT,R2   R10               Q4AVL DW INDEX
         LD,R14   Q4AVL,R2          R14 = BTD,USER VIRT ADDR (8,24)
*                                   R15 = BLK,CBD (16,16)
         DISABLE
         LW,R4    Q4AVL             CHAIN ENTRY
         STW,R2   Q4AVL               ONTO
         STD,R4   Q4AVL,R2              FREE CHAIN
         ENABLE
*
         LOAD,R9  UX:JIT,R5
         SLS,R9   9
         AI,R9    JCMAP             PHYSICAL ADDRESS OF MAP
*
         LI,R2    X'1FFFF'
         AND,R2   R14               USER'S VIRTUAL BUFFER ADDRESS
         SLD,R2   -9
         LW,R1    R2                SAVE CMAP INDEX
         LOAD,R2  *R9,R2            CONVERT PAGE # TO REAL
         SLD,R2   9                 R2 = PHYS USER BUFFER ADDRESS
*
         LB,R7    R14               R7 = BTD (BYTE DISPL INTO USER BUFFER)
         ANLZ,R13 RBLK5  *R2,R7     BA OF DESTINATION
*
         INT,R2   R15               R2 = # BYTES TO MOVE
*                                   R3 = CBD (BLOCKING BUFFER BYTE DISPL)
         ANLZ,R12 RBLK4  *R6,R3     BA OF SOURCE
*
         LI,R3    X'7FF'
         AND,R3   R13               BYTE OFFSET FROM PAGE BOUNDARY
         AW,R3    R2                ADD # BYTES TO MOVE
         AI,R3    -X'800'           R3 = # BYTES IN SECOND PAGE
         BLEZ     RBLK3             NO NEED TO BUST IT UP
*
         SW,R2    R3                # BYTES IN FIRST PAGE
         BAL,R4   RBLK6             MOVE IT
         LW,R2    R3                # BYTES IN SECOND PAGE
         AI,R1    1                 INCR TO NEXT VIRTUAL PAGE
         LOAD,R13 *R9,R1            CONVERT TO PHYSICAL PAGE
         SLS,R13  11                BA OF DESTINATION
*
RBLK3    BAL,R4   RBLK6             MOVE IT
         AI,R10   0
         BGEZ     WRTXEND           PUT BUFFER ON FREE FPOOL CHAIN
         LW,R9    Y008
         LW,R2    R8                DCB ADDRESS
         STS,R8   BFL,R2            RESET BUFFER BUSY FLAG
         B        *R11              DON'T RELEASE BUFFER
*
RBLK4    LB,0     *R6,R3            FOR ANLZ
RBLK5    LB,0     *R2,R7            FOR ANLZ
*
*  MOVE BYTE STRING
*
*  INPUT:
*        R2 = # BYTES
*        R12 = BA OF SOURCE
*        R13 = BA OF DESTINATION
*
RBLK6    AI,R2    -256
         BLZ      RBLK8             ONE MBS IS ENOUGH
RBLK7    OR,R13   YFC               COUNT = 252
         MBS,R12  0
         AI,R2    -252
         BGEZ     RBLK7
RBLK8    STB,R2   R13               FINAL MOVE COUNT
         MBS,R12  0
         B        0,R4
         SPACE    3
*
*  CORRECT DATA GRANULE IS IN CORE.  MOVE DATA INTO USER'S BUFFER.
*
BLKIN    EQU      %
         LW,D4    QBUF,R6
          LI,R1    BUFSIZ
         LW,R4    0,R6
         SLS,R4   -4                ALIGN BTD
         CI,R4    X'8000'           CHK EOP FOR WRITE
         AND,R4   M2                EXTRACT BTD
         REF      M2
         BAZ      BLKIN2
         LW,SR4   Y004
         STS,SR4  BBUD,R6           SET BUF1 UPDATED FLAG
         ANLZ,12  1B0    *D4,R4
         ANLZ,13  3A0    *D3,R3
         B        BLKIN2B
BLKIN2   EQU      %
         ANLZ,13  1B0    *D4,R4
         ANLZ,12  3A0    *D3,R3
BLKIN2B  RES      0
         SW,1     4
         CW,2     1
         BLE      %+2
         LW,2     1
         BAL,R4   RBLK6             MOVE IT
BLKINX   RES      0
         PULL     8,D1
         B        *R0
         PAGE
*  MAIN ENTRY POINT FOR ALL FILE READS
ISEQUB   EQU      %
*                                   BEFORE READING CLEAR OUT PREVIOUS
*                                   WRITE OPERATIONS
*
         LW,R2    CFU,R6
         LW,D2    Y01               SET READ
         STS,D2   0,R2               OCCURED FLAG
         REF      Y01
         LW,D2    ORG,6             CHK
         CI,D2    X'20'              ORGANIZATION
         BAZ      SEQ0              CONSECUTIVE
         CI,D2    X'10'
         BANZ     RWRAND            IT'S RANDOM
         LI,D4    K1FFFF            KEY SPECIFIED
         AND,D4   KAD,R6
         BNEZ     ISEQUB1           YES--GO FIND IT
         LI,7     X'400'            CHK DIRECTION
         AND,7    DIR,R6
         BEZ      ISEQUB9           GO FORWARD
*
*  READ REVERSE - ABORT ANY READ AHEAD IN PROGRESS
*
         RABAL,SR4  T:RAPURGD
         LI,R7    BPLIST            BACKSPACE
         BAL,SR4  PRCRD1UB
         BAL,R0   GETCMD
         BEZ      ISEQUB4
         BAL,SR4  TRANSFERUB        TRANSFER RECORD
         LI,D2    ISEQEXT
SETTRN   LW,R0    Y02
SETTRN1  LW,R1    Y02
         STS,R0   TRN,R6
         B       *D2
ISEQUB1  EQU      %                 FIND USERS KEY
         RABAL,SR4  T:RAPURGD       KEYED READ - ABORT ANY READ-AHEAD
         BAL,SR4  SETUPUB
         B        KEYER3            RETURN1--DIDNT FIND
         B        ISEQUB3           RETURN2--FOUND KEY
ISEQUB4  EQU      %
         LI,D1    K4
         LI,R0    MSREXIT           SET RETURN
         B        SETTYC
         TITLE    '**** FMCHKDA ****'
*        PURPOSE: TO CALL CHKDA FOR PUBLIC FILES; TO CALL PVCHKDA
*                 FOR PRIVATE FILES
*
*        INPUT:   SR1=PUBLIC OR PRIVATE DISC  ADR
*                 R6=DCB ADR
*
*        CALL:    BAL,SR4  FMCHKDA
*
*        OUTPUT:  CONDITION CODES SET TO ZERO,IF BAD DISC ADR
*                 CONDITION CODES SET TO NONZERO,IF DISC ADR OKAY
*
*        REGS:    ALL REGISTERS NONVOLATILE
*
FMCHKDA  EQU      %
         PUSH     5,2
         LW,4     PRIV,6
         CI,4     DCBPRIVBIT        CHECK FOR PRIVATE
         BANZ     FMDA20            YES
         REF      CHKDAQ
         BAL,6    CHKDAQ            CHECK IT
FMDA10   STCF     11                SAVE CC
         PULL     5,2               RESTORE REGS
         LCF      11                RESTORE CC
         B        *11               RETURN
FMDA20   LI,R2    BAVSND
         LB,R5    *R6,R2
         AW,5     FLP,R6
         LI,R2    K2
         LB,R2    *5,R2
         BEZ      FMDA25            ERROR - NO SIGNIFICANT ENTRIES
         LDCTX,R4 SR1               GET VOLUME NUMBER
         CW,R4    R2
         BLE      FMDA30            LEGAL VOL #
*
FMDA25   EQU      %
         LCI      0
         B        FMDA10            ERROR - BAD VOLUME NUMBER
FMDA30   LW,4     PAT,6             GET HGP ADDRESS
         LI,5     5                 POINT TO DCT
         LB,4     *4,5              GET DCT INDEX
         LI,6     FMDA10            SET RETURN
         B        PVCHKDA           AND WADE INTO PVCHKDA
         TITLE       '**** INCREMENT%SECTOR ****'                       DISCB
*                                                                       DISCB
*        PURPOSE:  TO INCREMENT THE RELEATIVE SECTOR # BY 2             DISCB
*                                                                       DISCB
*        INPUT:    DISC ADDRESS IN SR1                                  DISCB
*                                                                       DISCB
*        CALL:     BAL,R2      INCREMENT%SECTOR                         DISCB
*                                                                       DISCB
*        OUTPUT:   UPDATED DISC ADDRESS IN SR1                          DISCB
*                                                                       DISCB
*        REGS:     D2,D4 VOLATILE                                       DISCB
*                                                                       DISCB
*                                                                       DISCB
INCREMENT%SECTOR EQU %                                                  DISCB
         LSECTA,D4   SR1            GET SECTOR ADDRESS                  DISCB
         AI,D4       2              INCREMENT BY 2                      DISCB
         STSECTA,D4,D2 SR1          COMBINE DCTX + SECTOR ADDRESS       DISCB
         B           *R2            RETURN                              DISCB
         TITLE    '**** LOAD%SECTOR%ADDR ****'                          DISCB
*                                                                       DISCB
*        PURPOSE:   TO LOAD THE SECOR ADDRESS FROM D1 INTO R5           DISCB
*                                                                       DISCB
*        INPUT:   DISC ADDRESS IN D1                                    DISCB
*                                                                       DISCB
*        CALL:    BAL,R0      LOAD%SECTOR%ADDR                          DISCB
*                                                                       DISCB
*        OUTPUT:  17 BIT SECTOR ADDRESS IN R5                           DISCB
*                                                                       DISCB
*        REGS:    NONE DESTROYED                                        DISCB
*                                                                       DISCB
*                                                                       DISCB
LOAD%SECTOR%ADDR EQU  %                                                 DISCB
         LSECTA,R5  D1              LOAD SECTOR ADDRESS INTO R5         DISCB
         B        *R0               RETURN                              DISCB
*                                                                       DISCB
         TITLE    '**** STORE%DCT%CDA/SR1 ****'                         DISCB
*        PURPOSE: TO STORE A DCT INDEX/VOLUME # IS A DISC ADDRESS       DISCB
*                 THE TWO ENTRY POINTS TO THE TWO ROUTINES ARE:         DISCB
*                 STORE%DCT%SR1--STORE R3 IN SR1                        DISCB
*                 STORE%DCT%CDA--STORE R3 IN CDA OF DCB                 DISCB
*                                                                       DISCB
*        INPUT:   R3=DCT INDEX/VOLUME #                                 DISCB
*                 R6= DCB ADDRESS FOR STORE%DCT%CDA                     DISCB
*                                                                       DISCB
*        CALL:    BAL,R0                                                DISCB
*                                                                       DISCB
*        OUPUT:   NONE                                                  DISCB
*                                                                       DISCB
*        REGS:    NONE DESTROYED                                        DISCB
*                                                                       DISCB
STORE%DCT%SR1 EQU %                                                     DISCB
         STDCTX,R3  SR1             STORE DCT/VOL# IN SR1               DISCB
         B        *R0                                                   DISCB
*                                                                       DISCB
STORE%DCT%CDA EQU %                                                     DISCB
         STDCTX,R3  CDA,R6          STORE DCT/VOL # IN CDA OF DCB       DISCB
         B        *R0                                                   DISCB
         TITLE    '**** GETORG ****'
*        PURPOSE: TO TEST THE DCB'S  ORGANIZATION
*
*        INPUT:   R6=DCB ADR
*
*        CALL:    BAL,R0  GETORG
*
*        OUTPUT:  CONDITION CODES SET TO INDICATE THE ORGANIZATION
*                     IF CONSECUTIVE,CC SET TO 'BL'
*                     IF KEYED,CC SET TO 'BE'
*                     IF RANDOM,CC SET TO 'BG'
*
*        REGS:    R4 VOLATILE
*
GETORG   EQU      %
         LI,R4  X'30'
         AND,R4   ORG,R6
         CI,R4    K20
         B        *R0
         TITLE    '**** GETOVC ****'
*        PURPOSE: TO GET THE DCB'S OPEN VOLUME COUNT
*
*        INPUT:   R6=DCB ADR
*
*        CALL:    BAL,R0  GETOVC
*
*        OUTPUT:  R3=DCB:OVC
*                 CONDITION CODES SET TO INDICATE  THE VALUE OF R3
*
*        REGS:    ONLY R3 VOLATILE
*
GETOVC   EQU      %
         LW,R3    Y00FE
         AND,R3   OVC,R6
         SCS,R3   15
         B        *R0
         TITLE    '**** GETRNDEV ****'
*        PURPOSE: TO GET THE DEVICE TYPE SPECIFIED IN THE DCB
*
*        INPUT:   R6=DCB ADR
*
*        CALL:    BAL,R0   GETRNDEV
*
*        OUTPUT:  R3=DCB:RNDEV
*                 CONDITION CODES    SET TO INDICATE THE VALUE OF R3
*
*        REGS:    R3 VOLATILE
*
GETRNDEV EQU      %
         LI,R3    BARNDEV
         B        VNO20
         TITLE    '**** GETSNADR ****'
*        PURPOSE: TO CALCULATE THE ADDRESS OF THE PRIVATE VOLUME SERIAL
*                 NO. TABLE IN THE VLP AREA OF THE DCB AND TO RETURN
*                 THE NUMBER OF VOLUMES IN THE PRIVATE VOLUME SET
*
*        INPUT:   R6=DCB  ADR
*
*        CALL:    BAL,R0  GETSNADR
*
*        OUTPUT:  D2=ADR OF DCB PRIVATE VOLUME SERIAL NO. TABLE
*                 R2=THE NUMBER OF VOLUMES IN THE SERIAL NO. TABLE
*
*        REGS:    ONLY R2,D2 VOLATILE
*
GETSNADR EQU      %
         LI,R2    BAVSND
         LB,D2    *R6,R2
         AW,D2    FLP,R6
         LI,R2    K2
         LB,R2    *D2,R2
         B        *R0
         TITLE    '**** GETVDCTX ****'
*        PURPOSE: TO GET THE DCT INDEX OF THE CURRENT VOLUME IN A
*                 PRIVATE VOLUME SET
*
*        INPUT:   R6=DCB ADR
*
*        CALL:    BAL,R0  GETVDCTX
*
*        OUTPUT:  R3=DCB:VDCTX
*                 CONDITION CODES SET TO INDICATE THE VALUE OF R3
*
*        REGS:    ONLY R3 VOLATILE
*
GETVDCTX EQU      %
         LI,R3    BAVDCTX
         B        VNO20
         TITLE    '**** GETVNO ****      **** GETVNO1 ****'
*        PURPOSE: TO GET THE VOLUME NO. OF THE CURRENT VOLUME
*                 IN A PRIVATE VOLUME SET
*
*        INPUT:   R6=DCB ADR
*
*        CALL:    BAL,R0  GETVNO
*
*        OUTPUT:  R3=DCB:VNO
*                 CONDITION CODES SET TO INDICATE THE VALUE OF R3
*
*        REGS:    ONLY R3 VOLATILE
*
GETVNO   EQU      %
         LI,R3    BAVNO
VNO20    LB,R3    *R6,R3
         B        *R0
         TITLE    '**** NXTVOL ****'
*        PURPOSE: TO DETERMINE WHETHER THE NEXT VOLUME IN A PRIVATE
*                 VOLUME SET EXISTS
*
*        INPUT:   R6=DCB ADR
*
*        CALL:    BAL,SR4  NXTVOL
*
*        OUTPUT:  CONDITION CODES SET SUCH THAT:
*                     'BL' MEANS THE NEXT VOLUME  EXISTS
*                     'BE' MEANS THE NEXT VOLUME  DOES NOT EXIST
*                 R3=DCB:VNO
*                 R2=PRIVATE VOLUME SET SERIAL NO. COUNT
*                 D2=DCB  SERIAL NO. TABLE
*
*        REGS:    R2,R3,D2 VOLATILE
*
NXTVOL   EQU      %
         BAL,R0   GETVNO            R3=DCB:VNO
         BAL,R0   GETSNADR          D2=DCB:SNT, R2=SN COUNT
         CW,R3    R2
         BLE      *SR4
         BAL,SR4  PVERR             ERROR,DCB:VNO > NO OF VOLS IN SET
         TITLE    '**** PRIVDCB ****'
*        PURPOSE: TO DETERMINE,WHETHER THE DCB IS ASSIGNED TO A PUBLIC
*                 OR A PRIVATE  FILE
*
*        INPUT:   R6=DCB ADR
*
*        CALL:    BAL,R0  PRIVDCB
*
*        OUTPUT:  SR4='PRIV' WORD OF THE DCB
*                 CONDITION CODES SET SUCH THAT'BANZ'MEANS PRIVATE
*                     'BAZ' MEANS PUBLIC
*
*        REGS:    SR4 VOLATILE
*
PRIVDCB  EQU      %
         LW,SR4   PRIV,R6
         CI,SR4   DCBPRIVBIT
         B        *R0
         TITLE    '**** PVQUEUE ****    **** PVQUEUE1 ****'
*        PURPOSE: TO CONVERT A PRIVATE VOLUME DISC ADR TO A DEVICE DISC
*                 ADR,AND WHETHER PUBLIC OR PRIVATE, TO INCREMENT
*                 DCB:FCN AND TO  CALL  QUEUE/QUEUE1
*
*        INPUT:   R6=DCB ADR
*                 DCB:CDA=DISC ADR
*                 DCB:VNO POINTS TO THE CURRENT VOLUME,IF PRIVATE
*                         (NOT NECESSARILY THE VOLUME IN DCB:CDA)
*                 DCB:BUF=WORD ADR OF I/O BUFFER
*                 DCB:HBTD=BYTE DISPLACEMENT WITHIN I/O BUFFER
*                 DCB:BLK=NO.OF BYTES TO TRANSFER
*                 SR1(BYTE 0)=0-3 FOR READ;4-7 FOR WRITE
*                    (BYTES 1,2,3)= DCB ADR
*                 SR2=END ACTION ADR WITHIN IORT (ONLY FOR PVQUEUE1)
*                 SR3=END ACTION INFORMATION (ONLY FOR PVQUEUE1)
*
*        CALL:    BAL,SR4  PVQUEUE    OR    BAL,SR4  PVQUEUE1
*
*        OUTPUT:  DCB:CDA=UNCHANGED
*                 DCB:VNO,PAT,VDCTX POINT TO THE VOLUME IN DCB:CDA,
*                         IF PRIVATE
*                 DCB:FCN INCREMENTED
*
*        REGS:    VOLATILE  R0-R4,D1-D4
*                 NONVOLATILE  R5-SR3
*
PVQUEUE  EQU      %
         LI,R4    0                 CALL QUEUE
         B        PVQ10
PVQUEUE1 EQU      %
         LI,R4    2                 CALL QUEUE1
         B        PVQ10
*
PVREADTP RES      0
         LI,SR1   X'1FFFF'
         AND,SR1  R6                DCB ADDRESS FOR QUEUE
PVQ10    PUSH     SR4
         LI,R11   PVQ60             SET RETURN
PVQ20    RES      0                 SET UP DCTX IN CDA IF PRIVATE
         LW,R2    PRIV,R6
         CI,R2    DCBPRIVBIT
         BAZ      *R11              NOT PRIVATE, RETURN
         CI,R2    1                 IS THIS FILE IO
         BAZ      *R11              NO
         BAL,R0   GETVNO            GET CURRENT VNO
         LDCTX,R2 CDA,R6            GET REQUIREED VNO
         CW,R3    R2                ARE THEY THE SAME
         BE       PVQ50                         YES
         PUSH     7,R4                          NO,SWITCH TO THE
         BAL,R0   GETORG   R4=ORG                  REQUESTED VOLUME
         BGE      PVQ40
*                                   CONSECUTIVE PRIVATE FILE
         BAL,R0   SWXPV                *SWITCH FROM DCB:VNO TO THE
         B        PVQ45                 VOLUME REFERENCED IN DCB:CDA
PVQ40    EQU         %              KEYED OR RANDOM PRIVATE FILE        DISCB
         LW,R3    R2
         BAL,R0   SETVNO               *SET DCB:VNO,VDCTX,PAT TO POINT
         BAL,D4   SETPVI                TO THE VOLUME IN DCB:CDA
PVQ45    PULL     7,R4
PVQ50    BAL,R0   GETVDCTX          CONVERT DCB:CDA TO A DEVICE DISC ADR
         STDCTX,R3,S CDA,R6         R3=DCT INDEX                        DISCB
         B        *R11
PVQ60    RES      0
         LW,R2    Y01               YES, INCREMENT I/O
         AWM,R2   FCN,R6             OPERATION COUNT
         EXU      PVQEXU,R4         CALL QUEUE, QUEUE1
WAPVQX   RES      0
         BAL,R0   PRIVDCB          *PRIVATE FILE
         BAZ      PULLEXIT              NO
         BAL,R0   GETVNO                YES,RESTORE DCB:CDA
         STDCTX,R3,S CDA,R6         R3 = VOLUME NUMBER                  DISCB
PVQ80    B        PULLEXIT
*
PVQEXU   BAL,SR4  QUEUE             READ, NO END-ACTION
         BAL,SR4  QUEUEWR           WRITE, NO END-ACTION
         BAL,SR4  QUEUE1            READ, END-ACTION
*
QUEUEWR  OR,SR1   Y06               WRITE FUNCTION CODE
         B        QUEUE
         TITLE    '**** SETPVI ****   **** SETPVI10 ****'
*        PURPOSE: TO SET THE PRIVATE VOLUME INDICATORS IN THE DCB
*                 (DCB:PAT AND DCB:VDCTX) GIVEN THE VOLUME NO. OF A
*                 VOLUME THAT HAS ALREADY BEEN OPENED.
*
*        INPUT:   R6=DCB ADR
*                 DCB:VNO= VOLUME  NO.
*
*        CALL:    BAL,R15  SETPVI
*
*        OUTPUT:  DCB:PAT=ADR OF THE VOLUME'S ALLOCATION TABLE
*                 DCB:VDCTX= DCT INDEX OF THE DEVICE THAT THE VOLUME
*                            IS MOUNTED ON
*                 R2=VOLUME'S DCT INDEX
*                 R3=VOLUME NO
*                 R7=ADR OF THE VOLUME'S ALLOCATION TABLE
*                 D2=ADR OF DCB SERIAL NO TABLE
*
*        REGS     VOLATILE - R0,R2-R5,R7,SR4(SETPVI),D2
*                 NONVOLATILE - R1,R6,SR1-SR3,D1,D3
*
SETPVI   EQU      %
         BAL,R0   GETVNO            GET VNO IN R3
         BAL,R0   GETSNADR          POINT R13 TO SNS
         LI,R2    AVRTBLNE-AVRTBLSIZ SEARCH FOR REQUIRED SN
         LD,R4    AVRTBL+AVRTBLSIZ+AVRTBLSIZ-2,R2
         CW,R4    *R13,R3           IS THIS IT
         BE       %+3               YES
         BDR,R2   %-3               NO
         B        PVERR             NOT THERE
         AI,R2    AVRTBLSIZ+BATAPE-1  VOLUMES DCT INDEX
         BAL,R11  DHHIT             HAS IT BEEN OPENED BY THIS USER
         BAZ      PVERR             NO.
         LH,R7    DCT23,R2          HGP DISPLACEMENT
         AI,R7    HGP
         LI,R5    BAVDCTX           STUFF DCTX
         STB,R2   *R6,R5
         LW,R4    R7
         LI,R5    K1FFFF
         STS,R4   PAT,R6            R4=VOL'S  ALLOCATION TABLE ADR
         B        *D4
         TITLE    '**** SETVNO ****      **** SETVNO1 ****'
*        PURPOSE: TO SET DCB:VNO EQUAL TO EITHER (R3), IF SETVNO
*                 CALLED OR ONE, IF SETVNO1 CALLED
*
*        INPUT:   R6=DCB ADR
*                 R3=VOLUME  NO, IF  SETVNO CALLED
*
*        CALL:    BAL,R0   SETVNO    OR     BAL,R0  SETVNO1
*
*        OUTPUT:  R3=1,IF SETVNO1 CALLED
*                   =UNCHANGED,IF   SETVNO CALLED
*                 DCB:VNO=(R3)
*                 R2=BAVNO
*
*        REGS:    R2,R3 VOLATILE
*
SETVNO1  EQU      %
         LI,R3    1
SETVNO   EQU      %
         LI,R2    BAVNO
         STB,R3   *R6,R2
         B        *R0
         TITLE    'NEW CONSECUTIVE FILE PROCESSOR'
         DEF      SEQREAD
*
*  ROUTINE TO READ A CONSECUTIVE FILE GRANULE
SEQREAD  PUSH     4                 SAVE LINK
         PUSH     12
         BAL,0    PRIVDCB
         BAZ      SEQR1             PUBLIC
         STW,12   CDA,6
         BAL,R11  PVQ20             SWITCH VOLUMES IF NECESSARY
         BAL,R0   GETVNO            DID WE SUCCEED
         BEZ      MSR01EXIT         NO
SEQR1    RES      0
         BAL,0    GETBBUF           GET A BFR
         BAL,15   SETBTDZ           ZERO MON BYTE DISPL
         PULL     12
         LW,8     12                DISK ADDR
         BAL,11   FMCHKDA           CHECK IT
         BCR,15   SEQREAD1          BAD NEWS
         STW,12   BCDA,6            NEW DISK ADDR
         STW,12   CDA,6             FOR Q
         RANB     SEQR2             BR IF READ AHEAD NOT INCLUDED
         BAL,R0   T:RACHK           CHECK FOR READ AHEAD PAGE
         BCR,15   1F11              BR IF CORRECT ONE READ AHEAD
*
SEQR2    EQU      %
         LI,4     1F10              SET LINK
         LW,R0    TYC,R6            SAVE TYC
         LW,R5    Y00FE
         STS,R4   TYC,R6            ZERO TYC
         PUSH     8,12              BALANCE STACK
         REF      RW3A
* ****** IF YOU PUT THIS IN BPM, NOTE THAT THIS IS IN WRTF *****
         B        RW3A              READ GRANULE
1F10     EQU      %
         LW,R2    TYC,R6            SAVE TYC
         LW,R1    Y00FE
         CS,R0    TYC,R6            SAVE THE LARGEST OF THE
         BLE      %+2                 TWO TYC VALUES
         STS,R0   TYC,R6
         CW,R2    Y0002             TYC FOR LAST OPERATION MUST
         BAZ      SEQREAD1            BE A 1
1F11     EQU      %
         LW,8     MASKS+30
         REF      MASKS
         AND,8    BUFF1+2
         PULL     4
         AI,8     -3
         BLZ      SEQREAD1
         RABAL,R0 T:RACONSEC        TRY TO READ AHEAD NEXT BLOCK
         AI,8     3-WXBUFSIZ
         BLEZ     0,4
SEQREAD1 B        1C11
         SPACE    4
*  ROUTINE TO POSITION FORWARD IN A CONSECUTIVE FILE.
SEQFRD   BAL,0    GETCMD            CURENT POSN
         LI,1     5                 CHK
         CH,R3    BUFF1,1            FOR END
         BL       SEQFRD2           NOT YET
SEQFRD1  RES      0
         LW,D1    BUFF1+1           GET FLINK
         BEZ      SEQFRD4           END OF FILE
         OR,4     Y04               REREAD COUNT
         PUSH     4                 SAVE LINK
SEQFRD6  RES      0
         BAL,0    CLRBBUF           CLEAN UP IF NECESSARY
         BAL,4    SEQREAD           GET NXT GRAN
         XW,12    DCBCDAM,6         SET POSN
         CW,12    BUFF1             LINK CHK
         BE       SEQFRD5           OK
SEQFRD7  RES      0
         XW,12    DCBCDAM,6
         MTB,-1   *TSTACK           CHK REREAD COUNT
         BGZ      SEQFRD6           TRY AGAIN
         B        SEQREAD1          BAD NEWS
SEQFRD5  LW,8     BUFF1+1           CHK FLINK
         BEZ      %+3
         BAL,11   FMCHKDA
         BCR,15   SEQFRD7
         PULL     0                 GET LINK
****  INSERT SPEEDUP FOR LONG PRECORDS HERE
         LI,3     3                 1ST POSN
EROB     CW,0     Y04
         BGE      SETCMD1           NO REREADS
         LI,11    SETCMD1
         LW,SR3   DCBCDAM,6
         B        EROA
         SPACE    2
         SPACE    2
SEQFRD4  LW,1     CFU,6
         LW,0     TDA,1             TTL # OF RECORDS
         STW,0    W14,6             SET POSN
         LCW,0    W19,6             # TO POSN YET
         BGEZ     %+2               OK
         AWM,0    W19,6             ZAP IT
         LW,0     4                 PLACE LINK
         LI,3     WBUFS             END OF BFR
         B        SETCMD1
         SPACE    2
SEQFRD2  LW,0     BUFF1,3           CURR SEG CTL WD
         BLZ      SEQFRD3           UNBLOCKED - 1 WORD
         LH,0     0                 GET BYTE COUNT
         AI,0     3                 ROUND UP
         REF      XFFF
         AND,0    XFFF              REMOVE CTL BITS
         SLS,0    -2                WORD ALIGN
         AW,3     0                 MOVE AHEAD
SEQFRD3  AI,3     1                 PASS OVER CURRENT WORD
WBUFS    EQU      BUFSIZ**-2
         CI,3     WBUFS             CHK END OF GRAN
         BGE      SEQFRD1           GET NXT GRAN
         LW,0     4                 POSN LINK
         CH,3     BUFF1,1           RECHECK END
         BLE      SETCMD1           GET OUT
         B        SEQFRD1           NXT GRAN
         SPACE    4
*  ROUTINE TO POSITION BACKWARD IN A CONSECUTIVE FILE.
SEQBCK   BAL,0    GETCMD            CURRENT POSN
         LW,0     4                 POSN LINK
         OR,0     Y04               REREAD COUNT FOR EROB
         LI,1     5                 CHK END
         CH,3     BUFF1,1            OF GRAN
         BG       SEQBCK7           OFF THE END
SEQBCK1  CI,3     WBUFS             CHK AGAIN
         BL       SEQBCK2           STILL OK
         LI,3     WBUFS-1           LAST POSN
         B        SETCMD1           GET OUT
         SPACE    2
SEQBCK2  CI,3     3                 CHK FRONT
         BG       SEQBCK3           OK
SEQBCK4  LW,12    BUFF1             GET BLINK
         BEZ      SEQBCK6           BEG OF FILE
         OR,0     Y04               REREAD COUNT
SEQBCK9  RES      0
         PUSH     0                 SAVE LINK
         BAL,0    CLRBBUF           HOUSECLEANING
         BAL,4    SEQREAD           GET PREV GRAN
         PULL     0                 RETRIEVE LINK
         XW,12    DCBCDAM,6         SET POSN
         CW,12    BUFF1+1           LINK CHECK
         BNE      SEQBCK8           FAILED CHK
         LW,8     BUFF1             CHK BLINK
         BEZ      %+3
         BAL,11   FMCHKDA
         BCR,15   SEQBCK8           BAD NEWS
**** INSERT SPEEDUP FOR LONG PRECORDS HERE
         LI,1     5
SEQBCK7  LH,3     BUFF1,1           LAST POSN IN GRAN
         B        EROB              GET OUT
SEQBCK8  XW,12    DCBCDAM,6
         MTB,-1   0                 CHK REREAD COUNT
         BGZ      SEQBCK9           TRY AGAIN
         B        SEQREAD1          BAD NEWS
         SPACE    2
SEQBCK3  LW,2     BUFF1,3           CURR SEG CTL WD
         BGEZ     SEQBCK5           NOT UNBLOCKED
         AI,3     -1                BACK UP TO CTL
         B        SETCMD1           EXIT
         SPACE    2
SEQBCK5  AND,2    XFFF              GET LOC OF CTL WD
         LW,3     2                 POSITION
         CI,3     3                 CHK START
         BG       SETCMD1           OK
         BL       SEQBCK4
         LW,2     BUFF1             GET BLINK
         BNEZ     SETCMD1
         STW,2    W14,6             BOF
         STW,2    W19,6
         B        GETCMD            WE DON'T WANT FIT
         B        SEQBCK4           GET PREV GRAN
SEQBCK6  EQU      SEQREAD1          MUST BE AN ERROR
         PAGE
         DEF      SEQPOS
*
*  ROUTINE TO ESTABLISH THE CURRENT POSITION IN A
*  CONSECUTIVE FILE.  USED AT THE START OF MOST OPERATIONS.
SEQPOS   LI,1     0                 FOR ARS
         PUSH     2,0
         LW,D2    Y000C             D1 IS PRELOADED
         STS,D1   EOP,R6            SETEOP
         LI,D1    0                 RESET TYC
         LW,D2    Y00FE
         STS,D1   TYC,R6
         BAL,SR4  INITP4
SEQPOSD  LW,1     CFU,6
         LW,12    FDA,1             1ST GRAN OF FILE
         BEZ      1,7               EMPTY FILE RTN
         DEF      SEQPOSD
         PUSH     7                 FOR PULLEXIT
         LW,15    W19,6             # TO BE SKIPPED
         BEZ      SEQPA             NONE
         AW,15    W14,6             NEW POSITION
         LCW,13   W19,6
         BGZ      SEQPB             BACKUP
         SW,15    TDA,1             FINAL REC #
         LW,12    LDA,1             LAST GRAN
         LI,3     WBUFS             OFF END OF GRAN
         LW,2     TDA,1             LAST REC #
         CW,13    15                GET SHORT ROUTE
         B        SEQPC
         SPACE    3
SEQPB    LI,3     0                 FOR BOF
         CW,15    13                GET SHORT ROUTE
SEQPC    BGE      SEQPA             NORMAL ROUTE
         STW,2    W14,6             SET LAST REC # FOR EOF
         STW,12   DCBCDAM,6         SET GRAN ADDR
         STW,15   W19,6             # TO SKIP
         BAL,0    SETCMD1           SET GRAN DISPLACEMENT
SEQPA    RES      0
         LI,2     HACMD             GET
         LH,3     *6,2               CURRENT POSN
         BGZ      SEQPOS0           SKIP IF NOT BOF
         STW,3    W14,6             POINT TO BOF
         LW,12    FDA,1
         STW,12   DCBCDAM,6         SET CUR POSN TO BOF
         LI,3     3                 SET 1ST
         BAL,0    SETCMD1            POSITION
SEQPOS0  RES      0
         LW,12    BCDA,6            BFR CNTENTS
         BEZ      SEQPOS1-1         BRANCH IF NO BFR
         LI,14    BUFF1
         LI,0     BUF1MSK
         AND,0    BUFX,R6
         BEZ      SEQPOS1           AGAIN IF NO BFR
         LW,0     Y008              CHK FOR IO ACTION
         CW,0     BFL,6
         BAZ      %+2               NO ACTION
         BAL,11   IOSPIN            RUN IT DOWN
         CW,12    DCBCDAM,6         CHK IF RIGHT GRAN
         BE       SEQPOS2           OK
         BAL,0    CLRBBUF           HOUSECLEANING
SEQPOS1  LI,3     4                 REREAD COUNT
         LW,12    DCBCDAM,6         CURR GRAN ADDR
         BAL,4    SEQREAD           GET IT IN
         LW,8     BUFF1             CHK BLINK
         BEZ      %+3
         BAL,11   FMCHKDA
         BCR,15   SEQPOS7           NOT RIGHT
         LW,8     Y3FFF
         CW,8     BUFF1+2
         BANZ     SEQPOS7           IT'S NOT CONSEC
         LW,8     BUFF1+1           CHK FLINK
         BEZ      SEQPOS8
         BAL,11   FMCHKDA
         BCS,15   SEQPOS8           EET'S HOKAY
SEQPOS7  BDR,3    SEQPOS1+1         TRY REREAD
         B        SEQREAD1          IT BOMBED OUT
SEQPOS8  AI,3     -4
         BGEZ     %+2               NO REREADS
         BAL,11   EROO              LOG THE REREAD
         BAL,0    GETCMD            RESTORE POSITION
SEQPOS2 CI,3      WBUFS             CHK END OF BFR
         BL       SEQPOSA           OK
         BAL,4    SEQFRD            TRY TO MOVE AHEAD
         CI,3     WBUFS             CHK EOF
         BGE      SEQPOSP           IT IS
SEQPOSA  RES      0
         INT,0    BUFF1,3           CURR SEG CTL WD
         BANZ     SEQPOSP           IT'S ON
W19      EQU      19
         LW,0     W19,6             # OF RECORDS TO BE SKIPPED
         BGZ      SEQPOS3           FORWARD
         BEZ      SEQPOS4           NONE
W14      EQU      14
SEQPOS5  MTW,-1   W14,6             MOVE BACK 1
         BGEZ     %+3               CAN DO
         MTW,1    W14,6             BOF
         B        PULLEXIT          ALL THE WAY OUT
         MTW,1    W19,6             ADJUST COUNT
         BAL,4    SEQBCK            BACK UP A SEGMENT
         INT,0    BUFF1,3           CURR SEG CTL WD
         BCS,4    SEQPOSP           OK
         B        %-3               BACK UP ANOTHER
         SPACE    2
SEQPOS4  LI,0     X'400'            CHK
         CW,0     DIR,6              DIR
         BANZ     SEQPOS5           BACK
SEQPOS3  BAL,4    SEQFRD            FORGE AHEAD
         CI,3     WBUFS             CHECK EOF
         BGE      PULLEXIT          DONE
         INT,0    BUFF1,3           CURR SEG CTL WD
         BAZ      SEQPOS3           TRY AGAIN
SEQPOSP  LI,0     X'400'            CHK
         CW,0     DIR,6              DIR
         LW,0     W19,6             RECS TO BE SKIPPED
         BAZ      SEQPOS6           FORWARD
         AI,0     -1                BACKWARD
SEQPOS6  BE       PULLEXIT          ALL DONE
         BLZ      SEQPOS5           BACK UP
         MTW,-1   W19,6             WE'RE MOVING AHEAD 1
         MTW,1    W14,6             DITTO
         B        SEQPOS3           MOVE AHEAD
         PAGE
*  ROUTINE TO READ A RECORD FROM A CONSECUTIVE FILE.
         B        PVQUEUE           READ THE DATA
SEQ0     LI,0     MSREXIT           EXIT FOR TRANX
         LI,D1    X'40000'          EOP = READ
         BAL,7    SEQPOS            INIT & POSITION
         B        SEQ01             NOY EMPTY
SEQ00    RES      0
         BAL,0    1A4+1             PREVENT DELREC RESET EOP
         LI,0     TRANX             SET RETURN
         LI,D1    X'400'            CHK
         CW,D1    DIR,R6             DIRECTION
         BAZ      EOFMITST1         FORWARD
         LI,D1    4                 SET BOF
         B        SETTYC
         SPACE    4
SEQ01    LI,2     HACMD             GET
         LH,3     *6,2               CURRENT POSITION
         LI,0     X'400'            CHK
         CW,0     DIR,6              DIRECTION
         BAZ      SEQ02             FORWARD
         LI,0     0
         XW,0     W19,6             RESET POSN COUNT
         AI,0     -1
         BNE      SEQ00             HIT BOF
         LW,4     DCBCDAM,6         SAVE
         PUSH     2,3                CURRENT POSITION
         B        SEQ1              OK
         SPACE    2
SEQ02    LW,1     CFU,6
         LW,0     W14,6             CURRENT POSN
         CW,0     TDA,1
         BL       SEQ1              NOT AT EOF
         BGE      SEQ00             HIT EOF
         SPACE    3
SEQ5     INT,12   BUFF1,3
         BCR,2    SEQ7              END OF RECORD
SEQ8     BAL,4    SEQFRD            GO TO NXT SEG
SEQ12    RES      0
SEQ1     AW,14    3                 SEG CTL WD POSN
         CI,3     WBUFS             CHK FOR
         BGE      SEQE+1             UNEXPECTED EOF
         INT,12   *14               DISPERSE CTL WD
         BCR,8    SEQ3              BLOCKED SEGMENT
         SLS,13   16                GET
         SLD,12   -8                 DISK
         SLS,13   -8                  ADDRESS
         STW,13   CDA,6             FOR Q
         LW,8     13
         BAL,11   FMCHKDA
         BCR,15   6A2               BAD DISK ADDRESS 7501
         BAL,D4   SETBTDQ           MOVE UBTD TO HBTD
         AI,12    BUFSIZ-15         SEG LENGTH
         BAL,0    SEQ2              SET BLK & RWS
         LI,4     0                 READ FLAG
         LI,11    SEQ4              SET RETURN
         B        PVREADTP          READ THE DATA
         SPACE    4
SEQ2     LCW,4    12
         AWM,4    RWS,6             ADJUST RWS
         BGEZ     SAVBLK            SET BLK
         AW,12    RWS,6             CAN'T READ WHOLE SEG
         BGZ      SAVBLK            OK
         B        SEQ9              LOST DATA
         SPACE    4
SEQ3     LCW,13   12                ADJUST
         BNEZ     %+3
         LI,14    BUFF1             RESTORE BFR PNTR
         B        SEQ8              BACK CTL WD
         AWM,13   RWS,6             SIZE REMAINDER
         BGEZ     %+3
         AW,12    RWS,6             TOO MUCH
         BEZ      SEQ9              LOST DATA
*  THE CODE FROM HERE TO SEQ 4 WILL HAVE TO BE REPLACED
*  FOR BPM ON A SIGMA 5. YOU CAN USE RECTRAN AS FOLLOWS:
*    SOURCE BUFFER IS BUF1 IN DCB
*    SOURCE BTD IS IN REG3  INCREMENTED BY 1 AND LEFT SHIFTED 2
*    DESTINATION BUFFER IS QBUF IN DCB
*    DESTINATION BTD IS BTD IN DCB
         LI,13    X'7FFF'           MASK
         SLD,12   17
         STS,12   BLK,6             SET BLK FOR Q & IMAGE3
         SCS,12   15                WORD ALIGN
         AI,14    1                 1ST DATA BYTE POSN
         LW,15    QBUF,6            DEST BUFFER
         SLD,14   2                 ASSUMES FCN < 64
         LI,1     X'30'             MASK
         AND,1    BTD,6             BYTE DISPLACEMENT
         BEZ      %+3               SKIP IF NONE
         SLS,1    -4                ALIGN
         AW,15    1                 INSERT BTD
         AI,12    -256              IS 1 MOVE SUFFICIENT
         BLZ      SEQ32             YUP
SEQ31    OR,15    YFC               MOVE 252 BYTES
         MBS,14   0                 MOVE 'EM OUT
         AI,12    -252              ADJUST COUNT
         BGEZ     SEQ31             MOVE ANOTHER 255
SEQ32    STB,12   15                FINAL MOVE COUNT
         MBS,14   0                 MOVE FINAL BYTES
         REF      IMAGE3
SEQ4     LI,0     %+3               SET
         PUSH     0                  RETURN
         B        IMAGE3            ADJUST QBUF & ARS
         LI,14    BUFF1
         LI,2     HACMD             GET
         LH,3     *6,2               POSITION
         LW,12    RWS,6             REMAINDER
         BGZ      SEQ5              MORE TO GO
         BLZ      SEQ6              LOST DATA
         INT,12   BUFF1,3
         BCR,2    SEQ7              NO LOST DATA
SEQ9     RES      0
SEQ6     LI,D1    2                 SET LOST DATA
         BAL,0    SETTYC
         INT,12   BUFF1,3
SEQ7     BCS,8    SEQE              UNBLOCKED
         AI,12    3                 ROUND UP
         SLS,12   -2
         AW,3     12
SEQE     AI,3     1                 NXT CTL WD OR END OF BFR
         LI,0     X'400'            CHK DIRECTION
         CW,0     DIR,6
         BAZ      SEQR              FORWARD
         PULL     2,3               START OF RECORD POSN
         CW,4     DCBCDAM,6
         BE       %+3
         STW,4    DCBCDAM,6
         BAL,0    CLRBBUF
         LW,0     Y02               TO SET TRN
         B        SEQT
         SPACE    3
SEQR     MTW,1    W14,6             UP REC COUNT
SEQT     LW,1     Y02               SET OR RESET
         STS,0    TRN,6              TRN BIT
         STH,3    *6,2              SAVE POSITION IN CMD
         B        TRANX             TO GET OUT
         SPACE    3
         REF      RWRAND
         END

