*M*      RDF      READ FILE MODULE, HAS MANY FILE PROCESSING ROUTINES
MONPROC  SET      1
ANSPROC  SET      1
BITS     SET      1
DISCBPROC SET     2                                                     DISCB
         SYSTEM   UTS
         PCC      0
RDF:     EQU      %
*
NUPRIV   EQU      0
         SPACE    2
*P*      NAME:    RDF
*P*      PURPOSE  TO PERFORM THE PROCESSING FOR FILE READS
*P*               OF CONSECUTIVE AND KEYED FILES, TOGETHER
*P*               WITH MANY OF THE SUBROUTINES USED BY
*P*               OTHER FILE MANAGEMENT MODULES.
         TITLE    '**** RDF ****'
         BOUND    8
K16      EQU      X'16'
K18      EQU      X'18'
K2       EQU      X'2'
K20      EQU      X'20'
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'
K1FFFF   EQU      X'1FFFF'
KN1      EQU      -X'1'
KN2      EQU      -X'2'
ENCRYPT  EQU      16                DCB LOC FOR ENCRYPT KEY ADDRESS
         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
         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
S:S      FNAME
         PROC
         PEND     AF(AF(1)+2)
         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      RDF:              FOR MODULE PATCHING
         DEF      LOCKEYUB          LOCATE KEY IN MASTER INDEX
         DEF      1A3               COMPARE TEXTC STRINGS
         DEF      1A91              READ FORWARD IN MI
         DEF      SEQPOSD           POSITION CONSEC FILE
         DEF      CLRBFUB           CLEAR MI(BUFF2) BFR
         DEF      RESBLK            RESTORE DCB BLK, CDA, QBUF
         DEF      CLRTRN            CLEAR THE TRN BIT IN DCB
         DEF      COMKEY            COMPARE KEYS OR FILE NAMES
         DEF      EOFMITST          CHECK FOR END OF FILE
*,*                                 OR DIRECTORY
         DEF      ESTABBUF          ESTABLISH THE MI(BUFF2) BFR
         DEF      GETBUFM           GET A MI BFR FROM THE POOL
         DEF      GETCMD            LOCATE PSITION IN MI BFR
         DEF      GETCFU            LOAD THE CFU POINTER
         DEF      GETSEC            GET A MI BFR FROM THE POOL
         DEF      GSBUF             GET A BFR FOR LBL TAPE
         DEF      GETDIR            CHK THE DIRECTION BIT IN DCB
         DEF      FNDKY             FIND A MI ENTRY MOVING FRWD
         DEF      FNDKYT            FIND A MI ENTRY MOVING BKWD
         DEF      ISEQUB            ALL READ CALS ENTER HERE
         DEF      KEYER1            KEY OUT OF ORDER(ABN 18)
         DEF      KEYER2            NEWKEY ON EXIST KEY(ABN 16)
         DEF      KEYER3            READ KEY NOT FOUND(ER 43)
         DEF      KEYER4            NEWKEY NOT SPEC'D WHEN
*,*                                 KEY DOESN'T EXIST(ABN 13)
         DEF      KEYTRAN           MOVE A STRING TO KBUF
         DEF      SETLKEYUB         SET EOF CONDITIONS
         DEF      TRNTST            CHK THE TRNCATE BIT IN DCB
         DEF      PRCRD1            MOVE BACK 1 RECORD
         DEF      PULLFOUR          GET NXT 4 BYTES FROM MI BFR
         DEF      REDSEC            READ AN MI W/O LINK CHK
         DEF      SETCMD            SET MI POSN TO BEG OF GRAN
         DEF      SETCMD1           SET MI POSN AS SPEC'D
         DEF      SETEOP            SET THE DCB END OPER'N FIELD
         DEF      SETEOPW           SET END OPN TO WRITE & MARK
*,*                                 BUFFER UPDATED
         DEF      SETTRN            SET THE DCB TRNCATE BIT
         DEF      SETUPUB           FIND A SPECIFIED ENTRY IN
*,*                                 THE MI OR DIRECTORY
         DEF      WRTSEC            WRITE THE MI(BUFF2) BFR
         DEF      PRDCRD11          SEQUENTIAL PROCESSING ENTRY
         DEF      ISEQICR1          PASS OVER KEY INFO IN MI
         DEF      INITARS           SET UP FOR READ & WRITE
*,*                                 TO GET ACTUAL RECORD SIZE
         DEF      TRANX             EXIT FOR FILE RDS & WRTS
         DEF      SETBLK            SET UP FOR MI READ
         DEF      FMCHKDA           VERIFY DISK ADDR VALIDITY
         DEF      GETORG            GET THE FILES ORGANIZATION
         DEF      GETOVC            GET OPEN VOLUME COUNT FOR PRIVS
         DEF      GETSNADR          FIND SN ENTRY IN VLP
         DEF      GETVDCTX          GET DCT INDEX OF PRIV VOL
         DEF      GETVNO            GET CURRENT VOL # FOR PRIVS
         DEF      NXTVOL            CHK IF ANOTHER VOL EXISTS
         DEF      PRIVDCB           CHK FOR PRIVATE DCB
         DEF      PVQUEUE           FILE ENTRY TO IOQ
*,*      CONVERTS PRIV DISK ADDRESSES TO DCTX & REL SEC #
         DEF      PVREADTP          INNER ENTRY TO PVQUEUE
         DEF      SETPVI            SET PRIV VOL INDICATORS
         DEF      SETVNO            GET CURRENT VOL #
         DEF      SETVNO1           ALTERNATE GET CURR VOL #
         DEF      GETTBL            GET CTL POSN FOR DUAL WRITE
         DEF      DUALEA            END ACTION FOR DUAL WRITE
         DEF      WRTSEC10          INNER ENTRY TO WRTSEC
         DEF      WRTXEND           END ACTION FOR WRITE
         DEF      PVQUEUE1          FILE MGT CALL TO QUEUE1
         DEF      INCREMENT%SECTOR  CHANGE A DISK ADDR TO NXT GRAN
         DEF      LOAD%SECTOR%ADDR  GET THE SECTOR PART OF A DSK ADDR
         DEF      STORE%DCT%SR1     SET UP DCT INDEX IN DSK ADDR
         DEF      REDSEC8           SPECIAL REDSEC ENTRY FOR WRTF
         DEF      1C0               A 75 ERROR IS OCCURING
         DEF      ERFILDA           REPORT A 75 ERROR
         DEF      TRUNC             TRUNCATE THE BFRS FROM A DCB
         DEF      GETCBD            GET POSN IN BLKNG(BUFF1) BFR
         DEF      SAVCBD            SAVE POSN IN BLKNG BFR
         DEF      GETBBUF           GET A BLKNG(BUFF1) BFR
         DEF      CLRBBUF           CLEAR THE BLKNG(BUFF1) BFR
         DEF      TRNS1             INNER ENTRY TO REWRITE LOGIC
         DEF      UBLK              CHK FOR CORRECT DATA GRANULE
         DEF      CBB4              INNER ENTRY TO CLRBBUF
         DEF      CBB5              INNER ENTRY TO CLRBBUF
         DEF      BLKIN             MOVE BLOCKED DATA ROUTINE
         DEF      TRANSFERUB2       SET LOST DATA INTO TYC
         DEF      COMKEYA           COMPARE KEYS
         DEF      COMKEYC           COMPARE TEXTC STRINGS
         DEF      Y0014             BITS 11 & 13
         DEF      GETCSA            GET CURR MI DISK ADDR
         DEF      REDSECL           READ MI WITH LINK CHK
         DEF      REDSECB           READ UPPER LEVEL MI
         DEF      RWREX             SET UP FOR MI READ
         DEF      RWREX1            INNER ENTRY TO RWREX
         DEF      REDSEC1           EXIT FROM MI READ
         DEF      Y3FFF             BITS 2-15
         DEF      TRNC              TO PROCESS M:TRUNC CAL
         DEF      Y006              BITS 9 & 10
         DEF      GETSBUF           GET A FILE BFR FOR NON FILE USE
         DEF      1A7               FIND A MI ENTRY MOVING FRWD
         DEF      1A8               FIND A MI ENTRY MOVING BACKWARDS
*
*        DEFS FOR SIGMA 5 BRANCH LOCATIONS
*
         SPACE    1
         DEF      3A67              * CBS SUBSTITUTE
         DEF      S5KTRAN           * MBS OF < 32 BYTES
         DEF      RBLK6             * PAGE-SIZED MBS'S
         DEF      BFRMWR            PROCESS MULTI-SEGMENT RECORD
         DEF      SEQREAD           READ A CONSEC FILE GRAN
         DEF      SEQPOS            SET UP TO PROCESS CONSEC FILE
         PAGE     RDF REFS
         REF      GETTYC            GET TYPE OF COMPLETE
         REF      IOSPIN            RUNDOWN THE I/O ON A DCB
         REF      MSREXIT           GENERAL CAL EXIT
ISEQEXT  EQU      MSREXIT
         REF      MSR01EXIT         GNRL ERR/ABN EXIT PATH
         REF      PULLEXIT          NORMAL STACK RETURN
         REF      PULLEXIT1         SKIPPING STACK RETURN
         REF      T:STLPP           STEAL A PHYSICAL PAGE
         REF      T:RSPPEA          RELEASE A WRITE AHEAD BFR
         REF      T:XBUF            EXCHANGE BFR PAGES
         REF      J:DCBLINK         JIT PTR TO DCB'S
         REF      JBFBFP            HEAD OF FREE PAGE CHAIN
         REF      JXBUFVP           JIT CMAP POSITION
         REF      MAPBUFS           MAP THE BUFFERS
         REF      BADA#             OVERLAY TO 75 PROCESSOR
         REF      ERFILDA#          OVERLAY TO 75 REPORTER
         REF      UB:OV             CURRENT OVERLAY USAGE
         REF      J:JIT             JOB INFO TABLE
         REF      UX:JIT            JIT CTL FOR DUAL WRITE
         REF      S:CUP             CURRENT USER'S PRIORITY
         REF      JX:CMAP           MAP CTL ENTRIES IN JIT
         REF      FPMC              FREE PAGE INDICATOR
         REF      SWXPV             SWITCH PRIV VOLS
         REF      PVERR             PRIV VOL ERROR
         REF      PVERR0            LIKEWISE BUT DON'T ATTEMPT CLOSE.
         REF      FDFLAGS           DUAL WRITE CTL FLAGS
         REF      S:CUN             CURRENT USER #
         REF      PUTSZBF           SET UP DCB FOR I/O
         REF      PUTSZBF1          SET UP DCB FOR I/O
         REF      SAVBLK            SET THE BLK FIELD IN DCB
         REF      SETTYC            SET TYPE OF COMPLETE IN DCB
         REF      SETBTDZ           RESET BYTE DISPLACEMENT
         REF      SETBTDQ           SET BYTE DISPLACEMENT
         REF      WRTELEND          TAPE END ACTION
         REF      C:TRUNC           # BUFFERS TRUNCATED
         REF      Y3
         REF      YC
         REF      M:XX              DCB IN JIT FOR TRUNC
         REF      BGRCFU            FIRST USER CFU
         REF      J:CLS             CHECK SPECIAL REDSEC FLAGS
         REF      IMAGE3            SET DCB:ARS AT END OF READ/WRITE
         REF      Y000C             BITS 12 & 13
         REF      NEWQNW            NEW QUEUE WITH NO WAIT
         REF      Y06               BITS 5 & 6
         REF      NB31TO0           TABLE NBITS
         REF      HGP               HEAD OF GRANULE POOL
         REF      PVCHKDA           VERIFY VALIDITY OF PRIVATE
*,*                                 DISK ADDRESS
         REF      AVRTBL            VOL CTL INFO TBL
         REF      AVRTBLSIZ         SIZE OF THE AVR TABLE
         REF      AVRTBLNE          OFFSET TO VOLS IN AVRTBL
         REF      DCT23             TYPE OF DEVICE
         REF      DCT3              DEVICE PARTITIONED?
         REF      YFF               BITS 0-7
         REF      BATAPE            OFFSET TO TAPE ENTRY IN AVR
         REF      QUEUE1            I/O ROUTINE
         REF      QUEUE             I/O ROUTINE
         REF      PUSHALL           SET STACK MARKER
         REF      MSRWRTX           GENERAL CAL EXIT
         REF      GETBTD            GET BYTE DISPLACEMENT
         REF      Y00FE             BITS 8-14
         REF      RW3               REWRITE ROUTINE
         REF      RW2               REWRITE ROUTINE
         REF      RW1               REWRITE ROUTINE
         REF      ACNTBL            LOCATOR TABLE FOR ACCT DRCTRY
         REF      ACNTBLM           SIZE OF ACNTBL
         REF      DHHIT             HAS VOL BEEN OPENED BY USER
         REF      YFC               BITS 0-5
         REF      JCMAP             MAP CTL INFO IN JIT
         SREF     T:RAPURGD         ABORT READ AHEAD
         SREF     T:RACHK           SEE IF GRAN WAS READ AHEAD
         SREF     T:RACONSEC        CONSEC FILE READ AHEAD
         SREF     T:RAMISRCH        KEYED FILE READ AHEAD
         SREF     T:RADD            ADD TO READ AHEAD TABLES
         SREF     RAFLAG            NON-ZERO IF READ-AHEAD PRESENT
         REF      CLSSEG            OVERLAY WITH CLS MODULE
         REF      ACNCFU            THE ACCOUNT CFU
         REF      ENBSR4            ENABLE & B *SR4
         REF      T:RBUF            RELEASE A BFR TO FREE POOL
         REF      FILCFU            THE FILE CFU
         REF      T:GBUF            GET A BUFFER
         REF      J:BASE            SCRATCH STORAGE IN JIT
         REF      UPDBLK            REWRITE ROUTINE
         REF      Q4AVL             CTL TBL FOR BLKNG BFR READ
         REF      CHKDAQ            CHK A PUBLIC DISK ADDR
         REF      RW3A              READ INTO A BLKING BFR
         REF      RWRAND            PROCESS RD/WRT FOR RANDOMS
         REF      IOQ8              USED TO CALC # IOQ ENTRIES
         REF      IOQ9              USED TO CALC # IOQ ENTRIES
         REF      CURBQ             # IOQ ENTRIES IN USE
         REF      T:OVER            TO CLSSEG
         REF      T:OVERLAY         TO CLSSEG AND BACK
         REF      SYSACTL           FDA OF :SYS FILE DIRECTORY
         REF      J:FDDA            FDA OF USER'S FILE DIRECTORY
         REF      IOSEQUB1          FOR CHECK IF THIS IS A WRITE
         REF      T:MBUF            MAP IN A POOL BUFFER
         REF      RW4               ENTER NEW KEY SEGMENT
         REF      TYCODE            XLATE TYC TO ERR/ABN
         SPACE    3
Y26      DATA     X'26000000'
Y006     DATA     X'00600000'
Y0014    DATA     X'00140000'
FITCFU   EQU      FILCFU+4          FITCFU+CDAM = FILCFU+SREC
         SPACE    3
*F*      NAME:    PRDCRD11
*F*      PURPOSE  TO POSITION SEQUENTIALLY IN A KEYED FILE.
         SPACE    2
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
*D*      NAME:    PRDCRD11
*D*      REGISTERS  ALL VOLATILE
*D*      CALL     SR4 IS THE LINK, POSITION COUNT IS IN THE
*D*               CDA WORD IN THE DCB, AND THE DIRECTION IS
*D*               IN THE DIR BIT IN THE DCB.
*D*      INTERFACE  FNDKY,FNDKYR,LOCKEYUB
*D*      ENVIRONMENT  MAPPED MASTER
*D*      DESCRIPTION  FIND PREVIOUS LOCATION IN MI VIA CALL
*D*               TO LOCKEYUB, THEN POSITION THE SPECIFIED
*D*               # OF RECORDS VIA FNDKY OR FNDKYR.
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
*D*      NAME:    GETCSA
*D*      ENTRY:   GETCFU
*D*      REGISTERS  R1 & D2 ARE VOLATILE
*D*      CALL  D2 IS LINK FOR GETCFU, R0 IS LINK FOR GETCSA
*D*      OUTPUT   R1 HAS CFU POINTER, D2 HAS DISK ADDRESS
*
*  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
GETCSAP1 LW,D2    DCBCDAM,R6
         CI,R1    BGRCFU-1          EXIT IF NOT ACNCFU, FILCFU, FITCFU
         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
*D*      NAME:    KEYTRAN
*D*      REGISTERS  R0-R5 ARE VOLATILE
*D*      CALL     R1 IS LINK, D4 HAS POINTER TO KEY
*D*      DESCRIPTION  KEY IS MOVED TO THE KBUF ENTRY IN DCB
         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
         AI,R0    1                 INCLUDE LENGTH BYTE
         STB,R0   R5                INSERT IT
S5KTRAN  MBS,R4   0
         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
*
*D*      NAME:    INITARS
*D*      REGISTERS  R1-R3 ARE VOLATILE
*D*      CALL     SR4 IS THE LINK
*D*      DESCRIPTION
*DO*
*D*
*  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.
*FIN*
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
*
*D*      NAME:    SETBLK
*D*      REGISTERS  R3-R5 ARE VOLATILE
*D*      CALL     R0 IS THE LINK
*D*      DESCRIPTION
*DO*
*D*
*  MOVE THE CONTENTS OF THE BLK, QBUF, & CDA FIELDS OF
*  THE DCB TO TSTACK DURING THE PROCESSING OF A REDSEC.
*FIN*
SETBLK   EQU      %
         LCI      K3
         LM,R3    BLK,R6
         PSM,R3   TSTACK
         B        *R0
*
         SPACE    3
KEYER1   LI,SR3   K18               KEY OUT OF ORDER - WRITE
         B        MSR00EXIT
*E*  ERROR:        18-00
*E*
*E*  DESCRIPTION:  ATTEMPT TO WRITE KEYS OUT OF ORDER FOR DCB
*E*                SPECIFYING 'KEYED,SEQUENTIAL,OUT'
*
KEYER2   LI,SR3   K16               NEWKEY OPTION ON EXISTING KEY
         B        MSR00EXIT
*E*  ERROR:        16-00
*E*
*E*  DESCRIPTION:  ATTEMPT TO WRITE A KEY THAT ALREADY EXISTS WHEN
*E*                THE NEWKEY OPTION WAS SPECIFIED
*
KEYER3   LI,SR3   K43               NO SUCH KEY
         B        MSR00EXIT
*E*  ERROR:        43-00
*E*
*E*  DESCRIPTION:  ATTEMPT TO READ A KEY THAT DOES NOT EXIST
*
KEYER4   LI,SR3   K13               NO SUCH KEY, NEWKEY NOT SPECIFIED
*E*  ERROR:        13-00
*E*
*E*  DESCRIPTION:  A KEYED WRITE WAS ATTEMPTED, BUT THE KEY DID NOT
*E*                EXIST AND NEWKEY WAS NOT SPECIFIED
*
*  THIS IS THE ROUTE TAKEN BY MANY FILE MANAGEMENT
*  ERROR & ABNORMAL SITUATIONS.
MSR00EXIT RES     0
         LI,R0    MSR01EXIT
         B        1A4+1
*
*D*      NAME:    TRNTST
*D*      REGISTERS  R1 IS VOLATILE
*D*      CALL     D2 IS THE LINK
*D*      DESCRIPTION
*DO*
*D*
*  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.
*FIN*
TRNTST   EQU      %
         LW,R1    Y02
         CW,R1    TRN,R6
         B        *D2
*
*D*      NAME:    GETDIR
*D*      REGISTERS  D1 IS VOLATILE
*D*      CALL     D2 IS THE LINK
*D*      DESCRIPTION
*DO*
*D*
*  CHK THE DIR BIT TO SEE IF WE ARE DOING A BACKWARDS OPERATION.
*FIN*
GETDIR   EQU      %
         LI,D1    K400
         CW,D1    DIR,R6
         B        *D2
         SPACE    3
*D*      NAME:    COMKEY
*D*      ENTRY:   COMKEYA
*D*      ENTRY:   COMKEYC
*D*      REGISTERS  R0-R5, D2 & D4 ARE VOLATILE
*D*      CALL     R1 IS THE LINK
*D*      DESCRIPTION
*DO*
*D*
*  ROUTINE TO COMPARE KEYS OR DIRECTORY ENTRIES.
*FIN*
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
*
*D*      NAME:    PULLFOUR
*D*      REGISTERS  R2,D1 & D2 ARE VOLATILE
*D*      CALL     R0 IS LINK, MI POSITION IN R3
*D*      OUTPUT   R3 ADVANCED TO NEXT FIELD OF MI ENTRY
*D*      DESCRIPTION
*DO*
*D*
*  ROUTINE TO PUT THE NEXT 4 BYTES FROM THE MI OR DIRECTORY
*  INTO REGISTER D1.
*FIN*
PULLFOUR EQU      %
         LW,R2    R3
         SCS,R2   -2
         LM,D1    *D3,R2            GET DESIRED 4 BYTES
         AND,R2   YC
         SCS,R2   5
         SCD,D1   0,R2          POSITION
         AI,R3    4
         B        *R0
BIR0     EQU      %-1
         SPACE    3
LOCKY2M  LI,R0    LOCK5-1           SET RETURN
*
*D*      NAME:    ESTABBUF
*D*      REGISTERS  R2,R4 & D4 SAVED.
*D*      CALL     R0 IS THE LINK
*D*      INTERFACE  FALLS INTO THE REDSEC ROUTINE IF BFR WAS TRUNCD.
*D*      ENVIRONMENT  MASTER MAPPED
*D*      DATA     DCB & CFU
*D*      DESCRIPTION  TESTS TO SEE IF AN MI(BUFF2) BFR IS
*D*               ACTIVE, IF NOT, GET A BFR AND READ IN THE
*D*               MOST RECENTLY ACCESSED GRANULE.
*  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
         SPACE    2
*D*      NAME:    REDSEC
*D*      ENTRY:   REDSECL
*D*      REGISTERS  SAVES D1-D4 & R1-R4
*D*      CALL     R0 IS THE LINK
*D*      INTERFACE  IOQ
*D*      ENVIRONMENT  MASTER MAPPED
*D*      DESCRIPTION  READ IN AN MI OR DIRECTORY GRANULE
*D*               REDSECL PERFORMS A LINK CHECK, REDSEC ONLY
*D*               CHECKS SCR AND GRANULE FORMAT.
*
*  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
         OR,R0    Y04               RERESD COUNT
         PUSH     R0
         BAL,R0   GETSEC
         AND,D1   M31
         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
         AND,R1   M17
         BEZ      REDSEC8           BR IF TEST FILE OPEN
         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
         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    BGRCFU-1
         BG       REDSEC3A          ASSUMPTION OK
         ANLZ,R2  GETCSAP2          IT'S A DIRECTORY
REDSEC3A CI,R1    FITCFU
         BE       REDSEC3C          NO REREAD IF FITCFU
         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
RED8M    LW,R0    Y002              CHK FOR BUFF2 UPDATED
         CW,R0    MIUD,R6
         BAZ      RED8M1            IT'S NOT
         BANZ     RED8M6            IT IS
REDSEC3C CI,R2    FILCFU+CDAM
         BG       RED8M             BR IF NOT A DRCTRY
         XW,R3    DCDAM             EXCHANGE DUALS
RED8M6   RES      0
         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
RED8M1   RES      0
         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    GOBL2             IS IT A MULTI
         BNE      GOBL3             BRANCH IF NOT
         PULL     11,SR3            BALANCE STACK
         B        HILFAIL
GOBL3    RES      0
         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
1C0      EQU      1C11
         LB,R4    UB:OV,R4          SAVE OVERLAY # FOR ERFILDA
         SPACE    3
**********  REPORT A 75 ERROR  **************
         LI,R0    BADA#             ENTRY POINT
         LI,R2    CLSSEG            SEGMENT #
         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
         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     1C30              FAILURE WHILE FLINKING
         AWM,SR4  REDFLGS           SET FLINKING FLAG
         CI,R1    FILCFU
         BGE      %+3               SKIP IF NOT ACCT DRCTRY
         LI,SR4   0                 ZAP THE
         STW,SR4  ACNTBL             ACCT DRCTRY ACCELERATOR TBL
         LW,SR4   DFDA,R1           DUAL OF FDA
         LW,D1    FDA,R1
1C18     STW,SR4  DCDAM             SET DUAL
         BNEZ     1C16
         B        1C11
         SPACE    2
1C30     LI,SR4   0
         LW,D1    -8,R2             DA TO READ
         CW,D1    J:FDDA            IS IT FDA OF LOGON ACCT
         BNE      1C31              BR IF NOT
         STW,SR4  J:FDDA            BLITZ THE POINTER
         B        1C32
*
1C31     CW,D1    SYSACTL           IS IT FDA OF :SYS
         BNE      1C11              REPORT A 75
         STW,SR4  SYSACTL           BLITZ THE POINTER
1C32     LI,SR4   X'100'            SPECIAL FLAG
         STS,SR4  J:CLS
         B        REDSEC1           RETURN TO OPEN
         SPACE    3
*  LOG ERROR IN ERROR LOG
*D*      NAME:    ERFILDA
*D*      REGISTERS  ALL VOLATILE
*D*      DESCRIPTION  REPORT A 75 ERROR
*
ERFILDA  EQU      %
         LW,R7    S:CUN
         LB,R7    UB:OV,R7          OVERLAY #
         LI,R2    CLSSEG
         LI,R0    ERFILDA#
         B        T:OVERLAY
         SPACE    2
*
*  SET UP THE DCB TO EFFECT A MI OR DIRECTORY GRANULE READ.
RWREX    EQU      %
         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'
         PAGE     WRTSEC
*D*      NAME:    WRTSEC
*D*      ENTRY:   CLRBFUB
*D*      REGISTERS  SAVE D1,D3,D4, & R0-R4
*D*      CALL     R0 IS THE LINK
*D*      DESCRIPTION
*DO*
*D*
*  ROUTINE TO CLEAR THE CONTENTS OF THE MI BUFFER.
*  BUFFER IS NOT CLEARED IF IT HAS NOT BEEN UPDATED.
*FIN*
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
         LI,D2    BUF2MSK
         AND,D2   BUFX,R6
         BEZ      REDSEC1           NO BUFFER - EXIT
         BAL,R0   GETCSAP1
         LW,D1    D2
         AND,D1   M24
         LI,R3    5                 FLAG FOR NO DUAL
         CI,R1    FILCFU            CHK 4 DIRECTORY
         BG       WRTSEC15          IT ISN'T
         LW,R0    Y002              CHK 4 UPDATES
         CW,R0    MIUD,R6
         BAZ      WRTSEC12          NONE
         BAL,R0   PRIVDCB           CHK 4 PRIVATE
         BANZ     WRTSEC12          IT IS
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
         LI,R3    0                 FLAG FOR DUAL PRESENT
WRTSEC12 RES      0
         LI,D3    BUFF2             BUFFER ADDRESS
         RABAL,R0 T:RADD            ADD TO READ AHEAD TABLES
         BCR,15   WRTSEC18          ADDED SUCCESSFULLY - RELEASE BUFFER
WRTSEC15 LI,D3    BUFF2
         LW,D4    Y002
         CW,D4    MIUD,R6           IS BUFFER UPDATED
         BAZ      WRTSEC18          NO - RELEASE BUFFER AND GET OUT
         STS,D3   MIUD,R6           RESET BUFFER UPDATED BIT
         BDR,R3   WRTSEC10          BR IF NO DUAL
         BAL,SR3  GETTBL            GET DUAL END-ACTION TABLE ENTRY
         STB,R3   D1
WRTSEC10 EQU      %                 ENTER HERE FROM MUL
         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 BAL,R0   RESBLK
         B        WRTSEC20
WRTSEC18 LI,R5    1                 RELEASE TO FREE POOL
         BAL,R2   T:RBUF
WRTSEC20 LI,SR4   BUF2MSK
         LI,SR3   0
         STS,SR3  BUFX,R6           RESET BFR INDEX
REDSEC1  RES      0
         PULL     9,D1
         LI,D3    BUFF2
         B        *R0
         SPACE    2
*
*D*      NAME:    WRTXEND
*D*      ENVIRONMENT                MASTER UNMAPPED
*D*      DESCRIPTION
*DO*
*D*
*  END ACTION ROUTINE FOR WRITE AHEAD VIA PVQUEUE1
*        R5 = USER #
*        R6 = BUFFER PHYSICAL WORD ADDRESS
*        SR3 = BUFFER INDEX (END ACTION INFO)
*        SR4 = LINK REGISTER
*FIN*
*
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
         B        ENBSR4
         SPACE    3
*
*D*      NAME:    GETTBL
*D*      DESCRIPTION
*DO*
*D*
*  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.
*FIN*
*
GETTBL   EQU      %
********************************************************************
         BLOCK                      MAKE SURE WE ARE ON MASTER CPU
********************************************************************
         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
*
*D*      NAME:    DUALEA
*D*      ENVIRONMENT  MASTER UNMAPPED
*D*      DESCRIPTION
*DO*
*D*
*  AN I/O HAS COMPLETED.  IF IT IS NOT THE LAST, DO NOTHING.
*  OTHERWISE, PROCESS THE END-ACTION ROUTINE.
*FIN*
*
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
*D*      NAME:    CLRBBUF
*D*      ENTRY:   CBB4
*D*      ENTRY:   CBB5
*D*      REGISTERS  D1-D4, R1-R3 SAVED
*D*      CALL     R0 IS THE LINK
*D*      ENVIRONMENT  MAPPED MASTER
*D*      DESCRIPTION  CLEAR THE BLOCKING(BUFF1) BFR
*  ROUTINE TO CLEAR THE CONTENTS OF THE BLOCKING BUFFER.
CLRBBUF  EQU      %                 WRITE OUT BUFFER
         PUSH     8,D1
         LW,R1    Y004
         CW,R1    BBUD,R6           CHECK IF UPDATED
         BAZ      CBB5A             NO
         LI,R0    2
         STS,R0   BBUD,R6           RESET UPDATED 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
*
*D*      NAME:    RESBLK
*D*      REGISTERS  R3-R5 ARE VOLATILE
*D*      CALL     R0 IS THE LINK
*D*      DESCRIPTION
*DO*
*D*
*  RESTORE THE CONTENTS OF THE BLK, QBUF, & CDA FIELDS
*  FROM WHERE THEY WERE SAVED IN TSTACK TO THE DCB.
*FIN*
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
         LI,R0    0
         STS,R0   BUFX,R6           ZAP DCB BUFFER POINTER
         B        *SR4
*
*
CLRLBLT  EQU      %
*                                   WRITE LBLT BLOCK
         INT,R2   CMD,R6            SET PREV BLK SIZE (PBD)
         LI,R3    X'FFFF'           BUT RETAIN CURRENT POSITION(CMD)
         STS,R2   CMD,R6
         LW,SR2   Y001              SET TRUNCATED BIT SO WRITE WILL
         STS,SR2  BFL,R6            USE SAME BUFFER (NO LITTLE ONES PLS)
         LI,SR2   WRTELEND
         B        CBB8
         PAGE     TRUNC
*
*F*      NAME:    TRNC
*F*      PURPOSE  TO PROCESS THE M:TRUNC CAL
*  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
         CI,D2    2
         BG       MSRWRTX           DEVICE OR ANS TAPE
         LI,SR4   MSRWRTX
*D*      NAME:    TRUNC
*D*      CALL     SR4 IS THE LINK
*D*      DESCRIPTION  TRUNCATE THE BUFFERS FROM A DCB
TRUNC    PUSH     SR4               SAVE RETURN
         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
         SLS,SR3  -5
         BDR,SR2  TRN1
         SLS,SR3  15
         STW,SR3  BUFX,R6           RESET ALL BFR INDICES
         PULL     SR4
         B        IOSPIN
         SPACE    3
*
*D*      NAME:    GETCBD
*D*      REGISTERS  R3 CONTAINS THE RESULT
*D*      CALL     R0 IS THE LINK
*D*      DESCRIPTION
*DO*
*D*
*  ROUTINE TO GET CURRENT DISPLACEMENT IN THE BLOCKING BUFFER.
*FIN*
GETCBD   EQU      %
         LI,R3    X'E0000'
         AND,R3   CBD,R6
         SCS,R3   15
         B        *R0
         PAGE
         SPACE    2
*
*F*      NAME:    WRTAHED
*F*      PURPOSE  TO WRITE A GRANULE DETACHED FROM USER
*F*      DESCRIPTION
*DO*
*F*
*        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
*FIN*
*
WRTAHED  EQU      %
         PUSH     16,11
********************************************************************
         BLOCK                      GO TO MASTER CPU
********************************************************************
         BAL,R11  PVQ20             SET UP PV INDICATORS..DCTX IN CDA
         LI,R11   IOQ9-IOQ8         # IOQ ENTRIES
         SLS,R11  -1
         SW,R11   CURBQ             MINUS # CURRENTLY IN USE
         BLZ      WAHX1             DON'T DO IT - MORE THAN 1/2 IN USE
         LH,SR4   TSTACK+1          GET # WORDS LEFT ON STACK.
         CI,SR4   7                 NEED SEVEN TO WRITE.
         BL       WAHX1
         BAL,SR4  T:STLPP           STEAL A PHYSICAL PAGE
         AI,3     0                 DID WE?
         BGZ      WAHOK             YES - DO IT
WAHX1    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
         AND,15   M24
         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
*D*      NAME:    SAVCBD
*D*      REGISTERS  R2,R3 VOLATILE
*D*      CALL     R0 IS THE LINK
*D*      DESCRIPTION
*DO*
*D*
*  ROUTINE TO SET THE CURRENT DISPLACEMENT IN THE BLOCKING
*  BUFFER
*FIN*
SAVCBD   EQU      %
         LI,R2    K7FFF
         SCD,R2   -15
         STS,R2   CBD,R6
         B        *R0
         PAGE
AGER     SET      BUFX
*
*D*      NAME:    GETBUFM
*D*      ENTRY:   GETSEC
*D*      REGISTERS  R1-R4, D1-D4 SAVED
*D*      CALL     R0 IS THE LINK
*D*      DESCRIPTION  GET AN MI(BUFF2) BFR.
*  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
*
GTDCB1   LW,R5    0,R5
         BEZ      GBB3
         BDR,R5   GTDCB
*
GBB3Q    BAL,R0   CLRBFUB           TRUNC BUF2 FOR THIS DCB
         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
         PAGE
*D*      NAME:    GETBBUF
*D*      REGISTERS  R1-R4, D1-D4 SAVED
*D*      CALL     R0 IS THE LINK
*D*      DESCRIPTION  GET A BLOCKING(BUFF1) BFR.
*  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
         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
         BC       GBB3              BR IF J:DCBLINK WAS ZERO
         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   M4
         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
         MTW,1    C:TRUNC           COUNT # TRUNCS
         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
*S*  SCREECH CODE:    2E-00
*S*
*S*  REMARKS:      THE FREE FPOOL BUFFER CHAIN IS EMPTY, NO MORE
*S*                BUFFERS MAY BE ALLOCATED, AND NO DCB CAN BE
*S*                TRUNCATED TO OBTAIN A BUFFER.
         SCREECH  X'2E'             SCREECH .2E
5B4E     EQU      %
         BAL,SR4  IOSPIN            PARK AWHILE
5B4F     RES      0
         LW,R6    SR3               RESTORE DCB
         B        5B4B
         SPACE    2
*
*D*      NAME:    GETSBUF
*D*      REGISTERS  R1-R4, D1-D4 SAVED
*D*      CALL     R0 IS THE LINK
*D*      DESCRIPTION  GET A FILE BFR FOR OTHER USE
*DO*
*D*
*  TRUNC ANY DCB  -  CALLED BY MM
*FIN*
*
GETSBUF  RES      0
         PUSH     9,D1
         B        GTDCBM1
         PAGE     LOCCODEUB
*
         OR,R0    Y8                SET FOR LIMIT CHEKS ON SECTOR
*
*
*D*      NAME:    LOCKEYUB
*D*      REGISTERS  ALL REGISTERS VOLATILE
*D*      CALL     R0 IS LINK, FOUND RETURN SKIPPS
*D*      DESCRIPTION
*DO*
*D*
*ROUTINE TO FIND A SPECIFIED KEY OR DIRECTORY ENTRY BY
*SEARCHING ON LEVEL ZERO.
*FIN*
         SPACE    2
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
HITM1    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
         BAL,R0   GETCMD            FNDKY CLOBBERS R3
         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        HITM1
*
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
LOCK9M   B        LOCK8             SET LESS AND GET OUT
         BAL,R1   1A3M1             CHECK THE RELATION
         BLE      *J:BASE           OK, GET OUT
         BAL,SR4  1A7               MOVE TO INCOMPLETE ENTRY
*        THE FILE HAS BEEN DAMAGED; A SEGMENT EXISTS WHICH IS NOT
*        THE FIRST AND THERE IS NO 1ST.
         B        %+1
LOCK8    LCI      1                 SET LESS THAN
         B        *J:BASE
1A3M1    BAL,R0   GETCMD            MASTER X DISPL
*
*D*      NAME:    1A3
*D*      REGISTERS  R0,R4,R5 VOLATILE
*D*      CALL     R0 IS THE LINK, ONE STRING POINTED TO
*D*               BY D4 & THE OTHER BY D3,R3
*D*      DESCRIPTION  GENERALIZED TEXTC STRING COMPARATOR
*  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
         BNEZ     3A67
         LB,R0    0,R4
         STB,R0   R5
         CBS,R4   1
         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
         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    LOCK9M            SET RETURN
*   FALL INTO FNDKYR
         SPACE    3
*D*      NAME:    FNDKYR
*D*      REGISTERS                  ALL VOLATILE
*D*      CALL     R0 IS THE LINK
*D*      DESCRIPTION  FIND THE NEXT ACTIVE KEY MOVING REVERSE.
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
*
*D*      NAME:    FNDKYT
*D*      REGISTERS  ALL VOLATILE
*D*      CALL     R0 IS THE LINK
*D*      DESCRIPTION
*DO*
*D*
*  FIND THE NEXT NON DELETED RECORD SEGMENT IN THE REVERSE
*  DIRECTION.  IT NEED NOT BE THE FIRST SEGMENT OF A RECORD.
*FIN*
FNDKYT   EQU      %
         LW,R4    R0                SET RETURN
FNDKYT1  EQU      %
         CI,R3    MIDIS
         BG       FNDKYT2
         BAL,R2   UPRDL0            COUNT READ
         LI,R2    FNDKYT1           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
*
1A8      BAL,R0   GETCSA
         OR,D2    Y8                CHK FLINK IN NXT SEC
         BAL,R0   REDSECL
         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
         PAGE     FNDKY
*                                   R3 = MIDIS
*D*      NAME:    1A7               ADVANCING ENTRY
*D*      ENTRY:   FNDKY             NON-ADVANCING ENTRY
*D*      REGISTERS  ALL VOLATILE
*D*      CALL     SR4 IS THE LINK
*D*      DESCRIPTION  FIND A KEY ENTRY MOVING FORWARD AS NECESSARY
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
*
         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
         LW,R0    R3
*D*      NAME:    SETCMD            SET POSITION AT BEGINNING OF MI
*D*      ENTRY:   SETCMD1           SET TO SPECIFIED POSITION
*D*      REGISTERS  R2 VOLATILE
*D*      CALL     R0 IS THE LINK RESULT IN R3
*D*      DESCRIPTION SET THE POSITION IN THE MI(BUFF2) BFR
SETCMD   LI,R3    MIDIS
SETCMD1  LI,R2    HACMD
         STH,R3   *R6,R2
         B        *R0
FNDKY4   AI,SR4   1
         B        *SR4
FNDKY5   PULL     SR4
         B        FNDKY1
         SPACE    3
*D*      NAME:    EOFMITST
*D*      REGISTERS  ALL REGISTERS VOLATILE
*D*      CALL     R0 IS LINK, SKIP EXIT IF NOT EOF
*D*      DESCRIPTION  CHK FOR END OF FILE
EOFMITST EQU      %                 SEE IF WERE AT END-OF FILE
*                                   R3 =CMD
         LW,R3    CMD,R6
         LH,R3    R3
         BEZ      EOFMITST1
*  ****  ENTER HERE FROM WRTF *****
         LI,R2    NAV               CHK FOR
         CH,R3    *D3,R2             LOGICAL END OF GRANULE
         BL       %+4               SKIP IF NOT OFF THE END
         LI,R2    FLINK             IS THERE
         LW,D1    *D3,R2             ANOTHER GRANULE
         BEZ      EOFMITST1         IF NOT, MUST BE END OF THE ROAD
         LW,R2    CFU,R6
         LW,D1    FDA,R2
         BLEZ     EOFMITST1         FILE IS EMPTY
         CI,R3    MIDIS
         BLE      PULLEXIT1+1
         AND,R2   M17
         CI,R2    ACNCFU
         BE       PULLEXIT1+1       NO END IF ACCT DRCTRY
         AI,R3    -3                GET TO FLAGS BYTE
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
*D*      NAME:    SETUPUB
*D*      REGISTERS  ALL REGISTERS ARE VOLATILE
*D*      CALL     SR4 IS LINK, SKIPPING RETURN FOR NO BOF OR EOF
*D*      INTERFACE  LOCCODEUB
*D*      DESCRIPTION
*DO*
*D*
*                                   SETUPUB LOCATES THE KEY SPECIFIED
*                                   BY THE USER OR THE CLOSEST THING
*FIN*
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
ITSINM2  BE       HIT               ALMOST LUCKY
         LW,R3    J:BASE+1          RESTORE POSN
ITSIN    RES      0
         LI,R2    HACMD
         CI,R3    MIDIS
         BLE      1C11              75 ERROR IF REACH BEGINNING
         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        HITM1
         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
         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
*
MLSETAM  RES      0
         BG       MLSET1            WE MUST FLINK FORWARD FURIOUSLY
MLSETA   LW,D1    BUFF1             BLINK
         BEZ      HILFAIL3          BRANCH IF NONE
         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
*
SETUP02  STCF     SR3               SAVE CC
         LW,R1    CFU,R6
         LW,D1    TDA,R1            DOES MULTI-LEVEL EXIST
         BLEZ     SETUP01           BRANCH IF NOT
         PUSH     SR3               SAVE ENTRY CONDITIONS
         BAL,R0   CLRBBUF           DUMP THE BLKNG BFR
*
*  START AT THE TOP OF THE UPPER LEVEL PYRAMID AND MOVE
*  DOWN TO FIND THE OPTIMUM GRANULE FROM LEVEL ZERO.
*
         LI,SR3   TOPMSK
         AND,SR3  BUFX,R6           DO WE HAVE THE TOP?
         BEZ      5B1
         SLS,SR3  -10
         LI,D3    BUFF1
         BAL,R2   T:MBUF
         B        5B2M1
5B1      RES      0
         BAL,R0   REDSECB           READ A GRANULE
         B        HILFAIL1
         LW,R1    CFU,R6
         LI,SR3   X'1C00'           CHK 4 UPPER LVL
         AND,SR3  BUFF1+2
         BNEZ     5B11              BRANCH IF OK
         STW,SR3  TDA,R1            ZAP THE TOP
         PULL     SR3               BALANCE STACK
         B        HILFAIL2
5B11     CW,SR4   Y004              IS BUFFER UPDATED
         BE       5B2M1             NO TDA SAVE IF UPDATED
         LI,SR3   X'8000'           WHAT KIND OF UPPER IS IT
         CW,SR3   BUFF1+NAVX
         BANZ     5B2M1             BRANCH IF NOT STANDARD
         LI,SR3   BUF1MSK
         AND,SR3  BUFX,R6
         SLS,SR3  10
         AWM,SR3  BUFX,R6
5B2M1    LI,D3    BUFF1
         LW,D4    KAD,R6            USER KEY
         PULL     SR4               GET ENTRY CONDITIONS
         LI,SR3   MLSETAM           SET UNUSUAL RETURN
         LI,R4    X'8000'           WHAT KIND OF UPPER IS IT?
         CW,R4    BUFF1+NAVX
         BAZ      MLCHK01           BRANCH IF STANDARD UPPER LEVEL
         LH,R4    BUFF1+NAVX        # OF DISK ADDRESSES IN TABLE
         LH,R5    BUFF1+NAVX        DITTO
         AI,R5    1
         SLS,R5   -1                HALVE IT, NO REMAINDER
         LC       SR4               HOW DID WE ENTER
         BEZ      GOBLIND           BRANCH IF NO LVL 0 IN BFR
         LW,R1    DCBCDAM,R6        CURRENT GRANULE ADDRESS
         LD,D1    BUFF1             BLINK & FLINK
         LD,SR1   R4
GOUP1    CW,R1    BUFF1+NAVX,R4     IS IT A HIT
         BE       GOAHD             GO AHEAD
         CLR,D1   BUFF1+NAVX,R4     TRY TEST AGAIN
         BE       GOAHD             HIT ON BLINK
         BCR,12   GOAHD             HIT ON FLINK
         BDR,R4   GOUP1             TRY AGAIN
         LH,R4    BUFF1+NAVX
         B        GOBLIND
*
GOBL0    LI,R4    1                 USE THE 1ST ENTRY
GOBL1    PUSH     2,R4              SAVE CONTROL
         LW,D1    BUFF1+NAVX,R4     NEXT LEVEL 0 GRANULE TO READ
         BAL,R0   REDSEC            READ IT IN
GOBL2    PULL     2,SR1             RESTORE CONTROL
         SLS,SR2  -1                HALVE THE ADDER
GOAHD    LW,SR4   DATA1A5           SET
         STW,SR4  J:BASE             RETURN
         CI,SR2   1                 ARE WE DONE
         BL       SETUPUBZ          BRANCH IF WE'RE DONE
         BAL,SR4  SETUPHT           CHK THE UPPER
         BG       GOAHD1            BRANCH IF OFF THE END
         BE       HIT               VERY LUCKY
         STW,R3   J:BASE+1          SAVE POSITION
         BAL,SR4  SETUPLT           CHK THE LOWER
         BGE      ITSINM2
         LD,R4    SR1
GOBLIND  LW,D1    R4                CURRENT POSITION
         SW,R4    R5                TENTATIVE NEW POSITION
         BGZ      GOBL1             SKIP IF NOT OFF THE END
         BDR,D1   GOBL0             SKIP IF NOT THE 1ST
         B        SETUPUBZ          ENTER LINEAR SEARCH
*
GOAHD1   LD,R4    SR1
         LW,D1    R4                CURRENT POSITION
         AW,R4    R5                MOVE AHEAD
         CH,R4    BUFF1+NAVX        ARE WE OFF THE END OF THE TABLE
         BL       GOBL1             BRANCH IF OK
         LH,R4    BUFF1+NAVX        USE THE LAST
         CH,D1    BUFF1+NAVX        WERE WE HERE BEFORE?
         BGE      SETUPUBZ          GO TO LINEAR IF WE WERE
         B        GOBL1             CONTINUE BINARY SEARCH
         SPACE    2
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
         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
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
         LI,SR1   7                 75-07
         BAL,SR4  ERFILDA           LOG THE ERROR
         LW,R1    CFU,R6
         LI,R3    X'FF'
         STS,R3   0,R1
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
         LW,R0    BUFF1+NAVX        MUST HAVE SCR IN LO BYTE
         LI,R2    BASCR
         CB,R0    *R6,R2            CHK IT OUT
         BE       1D1               SKIP IF OK
         CI,R0    X'FF'             IS THERE A BAD ONE
         BANZ     1D2               ERROR IF THERE IS
         CI,R0    X'1C00'           IS IT AN UPPER
         BAZ      1D2               ERROR IF NOT
         LI,R0    DCBPRIVBIT        IS IT
         CW,R0    PRIV,R6            PRIVATE
         BAZ      1D2               ERROR IF NOT
         LW,SR4   Y004              MARK AN
         STS,SR4  BBUD,R6            UPDATE
         LB,R0    *R6,R2            GET THE REAL SCR
         AWM,R0   BUFF1+NAVX        STUFF IT IN
1D1      RES      0
         LI,D3    BUFF1
         B        PULLEXIT1         RETURN
1D2      LW,D1    BCDA,R6           LOAD DISK ADDR FOR ERFILDA
         B        PULLEXIT
*
5B3      B        HILFAIL1
         LI,SR3   X'1C00'           CHK FOR UPPER LVL
         CW,SR3   BUFF1+NAVX
         BANZ     5B2               IT'S OK
         B        HILFAIL1          BAD NEWS
         PAGE     SETLKEYUB
*D*      NAME:    SETLKEYUB
*D*      REGISTERS  R0-R5 & D2-D3 VOLATILE
*D*      CALL     R0 IS THE LINK
*D*      DESCRIPTION
*DO*
*D*
*                                   PUT LAST KEY INTO MASTER INDEX
*                                   FOR END OF FILE PURPOSES
*                                   LAST SECTOR MUST BE IN MEMORY
*                                   CMD POINTS TO EOF BYTE
*FIN*
         SPACE    2
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
*
*F*      NAME     TRNS1
*F*      PURPOSE  TO PROCESS DATA MOVES FOR BOTH READS & WRITES
*  ROUTINES TO PROCESS DATA MOVES FOR BOTH READS & WRITES.
TRNS1    EQU      %
         LI,SR3   0                 FOR ENCRYPTION SEED FOR MULTI-
*                                    SEGMENT RECORDS
         PUSH     2,SR3
         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
         BLEZ     1C6A              SKIP IF NOT REREAD
         LI,R0    X'1FFFF'
         AND,R0   CFU,R6
         LI,R1    1                 FORCE BAD SCR
         CI,R0    BGRCFU
         BL       REDS9             READ ONCE IF SCR NO MATCH
         B        1C6B
1C6A     RES      0
         LW,R0    J:CLS
         CI,R0    X'100'
         BANZ     1C5               IT'S FIT AT OPEN
1C6B     LW,R0    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
*E*  ERROR:        15-01
*E*
*E*  DESCRIPTION:  LINK CHECK FAILURE IN SHARED UPDATE KEYED FILE.
*E*                ISSUE CAL AGAIN.
*
1C5      LW,R1    =X'FE00007F'
         AND,R1   J:CLS             MASK OFF FLAGS
         XW,R1    J:CLS             RESET FLAGS
         CI,R1    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
         LW,R3    ACNCFU+4          DUAL
         LI,R4    0
         B        REDSEC5           ENTER SEARCH
REDSEC3  CW,R2    ACNTBL+3,R4       CHK THIS ENTRY
         BE       REDSEC4           GOT A HIT
         AI,R4    4                 NEXT ENTRY
REDSEC5  CW,R4    ACNTBL            CHK 4 END OF TABLE
         BL       REDSEC3           NOT THE END
         CI,R4    ACNTBLM           IS TABLE FULL
         BGE      REDSEC2           IT'S FULL
         MTW,4    ACNTBL            OPEN UP NEW ENTRY
REDSEC4  LCI      4                 REFRESH OLD ENTRY
         STM,R0   ACNTBL+1,R4         OR 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
         AI,R3    K3                R3 NOW POINTS AT NEXT ENTRY IN MI
         SLS,D1   -19
BFRMWR   EQU      %
         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
         BAL,R4   GETTYC            TYC TO R3
         LB,R3    TYCODE,R3         IS IT AN ERR/ABN
         BNEZ     TRANX             SKIP IF IT IS
         LI,D1    K2
         BAL,R0   SETTYC
*
*
*D*      NAME:    TRANX
*D*      REGISTERS  R0,R1 VOLATILE
*D*      CALL     DIRECT BRANCH
*D*      DESCRIPTION  GENERAL EXIT FOR ALL READ & WRITE CALS
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        TRANSFERUB2       SET LOST DATA
*
UP2      EQU      %
         BAZ      TRANX
         BAZ      RW1
UP3      B        TRANX
         B        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
         BL       TRNS3             BLOCKED
         LI,R0    X'1FFFF'
         AND,R0   ENCRYPT,R6        UNBLOCKED - TREAT LIKE BLOCKED
         BEZ      PVREADTP            IF NEED TO DECRYPT
TRNS3    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      UBLK4B            NO I/O IN PROGRESS ON BUF1
*
         BAL,SR4  IOSPIN
*
UBLK4B   CW,D1    BCDA,R6           IS THE CORRECT BUFFER ALREADY 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   LI,SR1   X'1FFFF'          IS
         AND,SR1  ENCRYPT,R6         ENCRYPTION
         BNEZ     RW3                 SPECIFIED
         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
******************************
         BLOCK                      FORCE TO MASTER CPU
******************************
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
*
*D*      NAME:    RBLKEND
*D*      DESCRIPTION
*DO*
*D*
*  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
*FIN*
*
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
         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
         LI,R7    X'1FFFF'          IS ENCRYPTION
         AND,R7   ENCRYPT,R6         SPECIFIED
         BEZ      1G1               SKIP IF NOT
         LI,R4    X'E'              MAKE SURE
         AND,R4   ASN,R6             IT'S A FILE
         BEZ      1G3               BRANCH IF IT IS
1G1      RES      0
         BAL,R4   RBLK6             MOVE IT
BLKINX   RES      0
         PULL     8,D1
         B        *R0
         SPACE    3
1G3      LW,R5    ARS,R6            GET SLOT IN TSTACK
         SLS,R5   -17
         LW,R4    TSTACK-2,R5       IS THIS A CONTINUATION
         BNEZ     1G31              SKIP IF SO
         LW,R4    KBUF,R6           KEY LOCATION
         LW,R4    0,R4              GET 1ST 2
         SLS,R4   -16                CHARACTERS
         EOR,R4   0,R7              USER CONTRIBUTION
         OR,R4    X1                MAKE IT ODD
1G31     LW,SR4   R2                GET BUFFER SIZE
         AI,SR4   3                  IN
         SLS,SR4  -2                  WORDS
         LW,R0    R3                GET BUFFER ADDRESS
         SLS,R0   -2
         AI,R0    BUFF1
         LW,R3    R4                INITIAL SEED
         LI,R7    X'40000'          CHK FOR READ OR WRITE
         CW,R7    EOP,R6
         BAZ      1G4               SKIP IF WRITE
         BAL,R4   CONCR1R           DECRYPT
1G4      BAL,R4   RBLK6             MOVE 'EM OUT
         BAL,R4   CONCR1R           ENCRYPT
         B        BLKINX            TO GET OUT
         PAGE
*F*      NAME:    ISEQUB
*F*      PURPOSE  ENTRY POINT FOR ALL FILE READS
*  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
         CW,D2    0,R2              IS ALREADY SETUP
         BANZ     ISEQUB0           YES
*-----------------------------------*
         BLOCK
*-----------------------------------*
         STS,D2   0,R2               OCCURED FLAG
ISEQUB0  EQU      %
         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,R7    X'400'            CHECK DIRECTION
         AND,R7   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
*D*      NAME:    SETTRN            SET THE TRN BIT
*D*      ENTRY:   SETTRN1           RESET TRN BIT
*D*      REGISTERS  R0,R1 VOLATILE
*D*      CALL     D2 IS THE LINK
*D*      DESCRIPTION  SET OR RESET THE TRN BIT IN THE DCB
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 ****'
*D*      NAME:    FMCHKDA
*DO*
*D*
*        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
*FIN*
*
FMCHKDA  EQU      %
         PUSH     5,R2
         LW,R4    PRIV,R6
         CI,R4    DCBPRIVBIT        CHECK FOR PRIVATE
         BANZ     FMDA20            YES
         BAL,R6   CHKDAQ            CHECK IT
FMDA10   STCF     SR4               SAVE CC
         PULL     5,R2              RESTORE REGS
         LCF      SR4               RESTORE CC
         B        *SR4              RETURN
FMDA20   LI,R2    BAVSND
         LB,R5    *R6,R2
         AW,R5    FLP,R6
         LI,R2    K2
         LDCTX,R3 SR1               GET VOLUME NUMBER
         BEZ      FMDA25            CANT BE ZERO
         CB,R3    *R5,R2            IS IT SMALL ENOUGH
         BLE      FMDA30            LEGAL VOL #
*
FMDA25   EQU      %
         LCI      0
         B        FMDA10            ERROR - BAD VOLUME NUMBER
FMDA30   RES
         LI,R4    BAVNO             IS THIS THE ONE WE'VE GOT
         CB,R3    *R6,R4
         BE       FMDA35            YES, GO CHECK SECTOR#
         LI,R5    K20               NO, GET THE RIGHT ONE IF POSSIBLE
         CW,R5    ORG,R6            I.E., IF NOT CONSEC FILE
         BAZ      FMDA35            OTHERWISE, HOPE THIS ONE WORKS
         STB,R3   *R6,R4            SET VNO
         PUSH     10,R7             SAVE REGS
         BAL,D4   SETPVI            FIND DEVICE
         PULL     10,R7
FMDA35   RES
         LI,R2    BAVDCTX           GET DEVICE # FROM DCB
         LB,R4    *R6,R2
         LI,R6    FMDA10            SET RETURN
         B        PVCHKDA           AND WADE INTO PVCHKDA
         TITLE       '**** INCREMENT%SECTOR ****'                       DISCB
*D*      NAME:    INCREMENT%SECTOR
*DO*
*D*
*                                                                       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
*FIN*
*                                                                       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
*D*      NAME:    LOAD%SECTOR%ADDR
*DO*
*D*
*        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
*FIN*
*                                                                       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
*D*      NAME:    STORE%DCT%SR1
*DO*
*D*
*        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
*                                                                       DISCB
*        CALL:    BAL,R0                                                DISCB
*                                                                       DISCB
*        OUPUT:   NONE                                                  DISCB
*                                                                       DISCB
*        REGS:    NONE DESTROYED                                        DISCB
*FIN*
*                                                                       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 ****'
*D*      NAME:    GETORG
*DO*
*D*
*        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
*FIN*
*
GETORG   EQU      %
         LI,R4  X'30'
         AND,R4   ORG,R6
         CI,R4    K20
         B        *R0
         TITLE    '**** GETOVC ****'
*D*      NAME:    GETSNADR
*DO*
*D*
*        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
*FIN*
*
GETOVC   EQU      %
         LW,R3    Y00FE
         AND,R3   OVC,R6
         SCS,R3   15
         B        *R0
         TITLE    '**** GETSNADR ****'
*D*      NAME     GETSNADR
*DO*
*D*
*        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
*FIN*
*
GETSNADR EQU      %
         LI,R2    BAVSND
         LB,D2    *R6,R2
         AW,D2    FLP,R6
         LI,R2    K2
         LB,R2    *D2,R2
         B        *R0
         TITLE    '**** GETVDCTX ****'
*D*      NAME:    GETVDCTX
*DO*
*D*
*        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
*FIN*
*
GETVDCTX EQU      %
         LI,R3    BAVDCTX
         B        VNO20
         TITLE    '**** GETVNO ****      **** GETVNO1 ****'
*D*      NAME:    GETVNO
*DO*
*D*
*        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
*FIN*
*
GETVNO   EQU      %
         LI,R3    BAVNO
VNO20    LB,R3    *R6,R3
         B        *R0
         TITLE    '**** NXTVOL ****'
*D*      NAME:    NXTVOL
*DO*
*D*
*        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
*FIN*
*
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 ****'
*D*      NAME:    PRIVDCB
*DO*
*D*
*        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
*FIN*
*
PRIVDCB  EQU      %
         LW,SR4   PRIV,R6
         CI,SR4   DCBPRIVBIT
         B        *R0
         TITLE    '**** PVQUEUE ****    **** PVQUEUE1 ****'
*D*      NAME:    PVQUEUE
*D*      ENTRY:   PVQUEUE1
*D*      ENTRY:   PVREADTP
*DO*
*D*
*        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
*FIN*
*
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
         LDCTX,R3 CDA,R6            GET REQUIRED VNO
         LI,R2    BAVNO             IS IT THE ONE WE HAVE
         CB,R3    *R6,R2
         BE       PVQ50                         YES
         PUSH     8,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
         BAL,R0   GETVNO            DID WE MAKE IT
         BNEZ     PVQ45             YES.. RETURN
         B        MSR01EXIT         NO.. GET OUT IF WE CAN
PVQ40    EQU         %              KEYED OR RANDOM PRIVATE FILE        DISCB
         BAL,R0   SETVNO               *SET DCB:VNO,VDCTX,PAT TO POINT
         BAL,D4   SETPVI                TO THE VOLUME IN DCB:CDA
PVQ45    PULL     8,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
*********************************************************************
         BLOCK                      UPDATE FCN ON MASTER
*********************************************************************
         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 ****'
*D*      NAME:    SETPVI
*DO*
*D*
*        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
*   SET HIGH ORDER BIT IF CALL FROM CLOSEPV SO CLOSEPV ISN'T
*   CALLED BACK DUE TO PRIVATE VOLUME LOGIC INCONSISTENCY.
*
*        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
*FIN*
*
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        SPVIERR           NOT THERE.
         AI,R2    AVRTBLSIZ+BATAPE-1  VOLUMES DCT INDEX
         LC       DCT3,R2           IGNORE IF PARTITIONED
         BCR,2    %+3                 DRIVE.
         AI,R2    1-AVRTBLSIZ-BATAPE GET BACK IX.
         B        %-6
         BAL,R11  DHHIT             HAS IT BEEN OPENED BY THIS USER
         BAZ      SPVIERR           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
SPVIERR  AI,D4    0                 IF CLOSEPV CALL,
         BLZ      PVERR0              SUA NOW.
         B        PVERR             ELSE TRY TO CLOSE VOLUMES.
         TITLE    '**** SETVNO ****      **** SETVNO1 ****'
*D*      NAME:    SETVNO
*D*      ENTRY:   SETVNO1
*DO*
*D*
*        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
*FIN*
*
SETVNO1  EQU      %
         LI,R3    1
SETVNO   EQU      %
         LI,R2    BAVNO
         STB,R3   *R6,R2
         B        *R0
         TITLE    'NEW CONSECUTIVE FILE PROCESSOR'
*D*      NAME:    SEQREAD
*D*      REGISTERS R12 SAVED
*D*      CALL     R4 IS LINK, R12 HAS DISK ADDRESS
*D*      DESCRIPTION  ROUTINE TO READ A CONSECUTIVE FILE
*D*               GRANULE AFTER CHECKING FOR POSSIBLE
*D*               VOLUME SWITCH REQUIREMENT
*  ROUTINE TO READ A CONSECUTIVE FILE GRANULE
SEQREAD  PUSH     R4                SAVE LINK
         PUSH     D1
         PUSH     R3
         STW,D1   CDA,R6
         BAL,R11  PVQ20             SWITCH VOLUMES IF NECESSARY
         PULL     R3
         BAL,R0   GETBBUF           GET A BFR
         BAL,D4   SETBTDZ           ZERO MON BYTE DISPL
         PULL     D1
         LW,SR1   D1                DISK ADDR
         BAL,11   FMCHKDA           CHECK IT
         BCR,15   SEQREAD1          BAD NEWS
         STW,D1   BCDA,R6           NEW DISK ADDR
         STW,D1   CDA,R6            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,R4    1F10              SET LINK
         LW,R0    TYC,R6            SAVE TYC
         LW,R5    Y00FE
         STS,R4   TYC,R6            ZERO TYC
         PUSH     8,D1              BALANCE STACK
* ****** 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,SR1   MASKS+30
         AND,SR1  BUFF1+2
         PULL     R4
         AI,SR1   -3
         BLZ      SEQREAD1
         RABAL,R0 T:RACONSEC        TRY TO READ AHEAD NEXT BLOCK
         AI,SR1   3-WXBUFSIZ
         BLEZ     0,R4
SEQREAD1 B        1C11
         SPACE    2
*  ROUTINE TO POSITION FORWARD IN A CONSECUTIVE FILE.
SEQFRD   BAL,0    GETCMD            CURENT POSN
         LI,R1    5                 CHK
         CH,R3    BUFF1,R1           FOR END
         BL       SEQFRD2           NOT YET
SEQFRD1  RES      0
         LW,D1    BUFF1+1           GET FLINK
         BEZ      SEQFRD4           END OF FILE
         OR,R4    Y04               REREAD COUNT
         PUSH     R4                SAVE LINK
SEQFRD6  RES      0
         BAL,R0   CLRBBUF           CLEAN UP IF NECESSARY
         BAL,R4   SEQREAD           GET NXT GRAN
         XW,D1    DCBCDAM,R6        SET POSN
         CW,D1    BUFF1             LINK CHK
         BE       SEQFRD5           OK
SEQFRD7  RES      0
         XW,D1    DCBCDAM,R6
         MTB,-1   *TSTACK           CHK REREAD COUNT
         BGZ      SEQFRD6           TRY AGAIN
         B        SEQREAD1          BAD NEWS
SEQFRD5  LW,SR1   BUFF1+1           CHK FLINK
         BEZ      %+3
         BAL,SR4  FMCHKDA
         BCR,15   SEQFRD7
         PULL     0                 GET LINK
****  INSERT SPEEDUP FOR LONG PRECORDS HERE
         LI,R3    3                 1ST POSN
EROB     CW,0     Y04
         BGE      SETCMD1           NO REREADS
         LI,SR4   SETCMD1
         LW,SR3   DCBCDAM,R6
         B        EROA
         SPACE    2
         SPACE    2
SEQFRD4  LW,R1    CFU,R6
         LW,R0    TDA,R1            TTL # OF RECORDS
         STW,R0   W14,R6            SET POSN
         LCW,R0   W19,R6            # TO POSN YET
         BGEZ     %+2               OK
         AWM,R0   W19,R6            ZAP IT
         LW,R0    R4                PLACE LINK
         LI,R3    WBUFS             END OF BFR
         B        SETCMD1
         SPACE    2
SEQFRD2  LW,R0    BUFF1,R3          CURR SEG CTL WD
         BLZ      SEQFRD3           UNBLOCKED - 1 WORD
         LH,R0    R0                GET BYTE COUNT
         AI,R0    3                 ROUND UP
         AND,R0   M12               REMOVE CTL BITS
         SLS,R0   -2                WORD ALIGN
         AW,R3    R0                MOVE AHEAD
SEQFRD3  AI,R3    1                 PASS OVER CURRENT WORD
WBUFS    EQU      BUFSIZ**-2
         CI,R3    WBUFS             CHK END OF GRAN
         BGE      SEQFRD1           GET NXT GRAN
         LW,R0    R4                POSN LINK
         CH,R3    BUFF1,R1          RECHECK END
         BLE      SETCMD1           GET OUT
         B        SEQFRD1           NXT GRAN
         SPACE    4
*  ROUTINE TO POSITION BACKWARD IN A CONSECUTIVE FILE.
SEQBCK   BAL,R0   GETCMD            CURRENT POSN
         LW,R0    4                 POSN LINK
         OR,R0    Y04               REREAD COUNT FOR EROB
         LI,R1    5                 CHK END
         CH,R3    BUFF1,R1           OF GRAN
         BG       SEQBCK7           OFF THE END
         CI,R3    WBUFS             CHK AGAIN
         BL       SEQBCK2           STILL OK
         LI,R3    WBUFS-1           LAST POSN
         B        SETCMD1           GET OUT
         SPACE    2
SEQBCK2  CI,R3    3                 CHK FRONT
         BG       SEQBCK3           OK
SEQBCK4  LW,D1    BUFF1             GET BLINK
         BEZ      SEQBCK6           BEG OF FILE
         OR,R0    Y04               REREAD COUNT
SEQBCK9  RES      0
         PUSH     R0                SAVE LINK
         BAL,R0   CLRBBUF           HOUSECLEANING
         BAL,R4   SEQREAD           GET PREV GRAN
         PULL     R0                RETRIEVE LINK
         XW,D1    DCBCDAM,R6        SET POSN
         CW,D1    BUFF1+1           LINK CHECK
         BNE      SEQBCK8           FAILED CHK
         LW,SR1   BUFF1             CHK BLINK
         BEZ      %+3
         BAL,SR4  FMCHKDA
         BCR,15   SEQBCK8           BAD NEWS
**** INSERT SPEEDUP FOR LONG PRECORDS HERE
         LI,R1    5
SEQBCK7  LH,R3    BUFF1,R1          LAST POSN IN GRAN
         B        EROB              GET OUT
SEQBCK8  XW,D1    DCBCDAM,R6
         MTB,-1   R0                CHK REREAD COUNT
         BGZ      SEQBCK9           TRY AGAIN
         B        SEQREAD1          BAD NEWS
         SPACE    2
SEQBCK3  LW,R2    BUFF1,R3          CURR SEG CTL WD
         BGEZ     SEQBCK5           NOT UNBLOCKED
         AI,R3    -1                BACK UP TO CTL
         B        SETCMD1           EXIT
         SPACE    2
SEQBCK5  AND,R2   M12               GET LOC OF CTL WD
         LW,R3    2                 POSITION
         CI,R3    3                 CHK START
         BG       SETCMD1           OK
         BL       SEQBCK4
         LW,R2    BUFF1             GET BLINK
         BNEZ     SETCMD1
         STW,R2   W14,R6            BOF
         STW,R2   W19,R6
         PULL     R0                GET ALL THE WAY OUT
         B        GETCMD            WE DON'T WANT FIT
SEQBCK6  EQU      SEQREAD1          MUST BE AN ERROR
         PAGE
*F*      NAME:    SEQPOS
*F*      PURPOSE  TO ESTABLISH THE POSITION IN A CONSECUTIVE
*F*               FILE PRIOR TO PROCESSING OF A DATA TRANSFER
*F*               OPERATION ON THE FILE
         SPACE    2
*D*      NAME:    SEQPOS
*D*      REGISTERS  AL REGISTERS VOLATILE
*D*      CALL     R7 IS LINK, SKIPPING EXIT FOR EMPTY FILE
*D*      DESCRIPTION
*DO*
*D*
*
*  ROUTINE TO ESTABLISH THE CURRENT POSITION IN A
*  CONSECUTIVE FILE.  USED AT THE START OF MOST OPERATIONS.
*FIN*
SEQPOS   LI,R1    0                 FOR ARS
         LI,D4    0                 FOR ENCRYPTION SEED FOR MULTI-
*                                    SEGMENT RECORDS
         PUSH     3,D4
         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,R1    CFU,6
         LW,D1    FDA,R1            1ST GRAN OF FILE
         BEZ      1,R7              EMPTY FILE RTN
         PUSH     R7                FOR PULLEXIT
         LW,D4    W19,R6            # TO BE SKIPPED
         BEZ      SEQPA             NONE
         AW,D4    W14,R6            NEW POSITION
         LCW,D2   W19,R6
         BGZ      SEQPB             BACKUP
         SW,D4    TDA,R1            FINAL REC #
         LW,D1    LDA,R1            LAST GRAN
         LI,R3    WBUFS             OFF END OF GRAN
         LW,R2    TDA,R1            LAST REC #
         CW,D2    D4                GET SHORT ROUTE
         B        SEQPC
         SPACE    3
SEQPB    LI,R3    0                 FOR BOF
         CW,D4    13                GET SHORT ROUTE
SEQPC    BGE      SEQPA             NORMAL ROUTE
         STW,R2   W14,R6            SET LAST REC # FOR EOF
         STW,D1   DCBCDAM,R6        SET GRAN ADDR
         STW,D4   W19,R6            # TO SKIP
         BAL,R0   SETCMD1           SET GRAN DISPLACEMENT
SEQPA    RES      0
         LI,R2    HACMD             GET
         LH,R3    *R6,R2             CURRENT POSN
         BGZ      SEQPOS0           SKIP IF NOT BOF
         STW,R3   W14,R6            POINT TO BOF
         LW,D1    FDA,1
         STW,D1   DCBCDAM,R6        SET CUR POSN TO BOF
         LI,R3    3                 SET 1ST
         BAL,0    SETCMD1            POSITION
SEQPOS0  RES      0
         LW,D1    BCDA,R6           BFR CNTENTS
         BEZ      SEQPOS1-1         BRANCH IF NO BFR
         LI,D3    BUFF1
         LI,R0    BUF1MSK
         AND,R0   BUFX,R6
         BEZ      SEQPOS1           AGAIN IF NO BFR
         LW,R0    Y008              CHK FOR IO ACTION
         CW,R0    BFL,R6
         BAZ      SEQPOS1A          NO I/O IN PROGRESS
         BAL,SR4  IOSPIN
*
SEQPOS1A CW,D1    DCBCDAM,R6        CHECK IF RIGHT GRANULE
         BE       SEQPOS2           OK
         BAL,R0   CLRBBUF           HOUSECLEANING
SEQPOS1  LI,R3    4                 REREAD COUNT
         LW,D1    DCBCDAM,R6        CURR GRAN ADDR
         BAL,R4   SEQREAD           GET IT IN
         LW,SR1   BUFF1             CHK BLINK
         BEZ      %+3
         BAL,SR4  FMCHKDA
         BCR,15   SEQPOS7           NOT RIGHT
         LW,SR1   Y3FFF
         CW,SR1   BUFF1+2
         BANZ     SEQPOS7           IT'S NOT CONSEC
         LW,SR1   BUFF1+1           CHK FLINK
         BEZ      SEQPOS8
         BAL,SR4  FMCHKDA
         BCS,15   SEQPOS8           EET'S HOKAY
SEQPOS7  BDR,R3   SEQPOS1+1         TRY REREAD
         B        SEQREAD1          IT BOMBED OUT
SEQPOS8  AI,R3    -4
         BGEZ     %+2               NO REREADS
         BAL,SR4  EROO              LOG THE REREAD
         BAL,R0   GETCMD            RESTORE POSITION
SEQPOS2 CI,R3     WBUFS             CHK END OF BFR
         BL       SEQPOSA           OK
         BAL,R4   SEQFRD            TRY TO MOVE AHEAD
         CI,R3    WBUFS             CHK EOF
         BGE      SEQPOSP           IT IS
SEQPOSA  RES      0
         INT,R0   BUFF1,R3          CURR SEG CTL WD
         BANZ     SEQPOSP           IT'S ON
W19      EQU      19
         LW,R0    W19,R6            # OF RECORDS TO BE SKIPPED
         BGZ      SEQPOS3           FORWARD
         BEZ      SEQPOS4           NONE
W14      EQU      14
SEQPOS5  MTW,-1   W14,R6            MOVE BACK 1
         BGEZ     %+3               CAN DO
         MTW,1    W14,R6            BOF
         B        PULLEXIT          ALL THE WAY OUT
         MTW,1    W19,R6            ADJUST COUNT
         BAL,R4   SEQBCK            BACK UP A SEGMENT
         INT,R0   BUFF1,R3          CURR SEG CTL WD
         BCS,4    SEQPOSP           OK
         B        %-3               BACK UP ANOTHER
         SPACE    2
SEQPOS4  LI,R0    X'400'            CHK
         CW,R0    DIR,R6             DIR
         BANZ     SEQPOS5           BACK
SEQPOS3  BAL,R4   SEQFRD            FORGE AHEAD
         CI,R3    WBUFS             CHECK EOF
         BGE      PULLEXIT          DONE
         INT,R0   BUFF1,R3          CURR SEG CTL WD
         BAZ      SEQPOS3           TRY AGAIN
SEQPOSP  LI,R0    X'400'            CHK
         CW,R0    DIR,R6             DIR
         LW,R0    W19,R6            RECS TO BE SKIPPED
         BAZ      SEQPOS6           FORWARD
         AI,R0    -1                BACKWARD
SEQPOS6  BE       PULLEXIT          ALL DONE
         BLZ      SEQPOS5           BACK UP
         MTW,-1   W19,R6            WE'RE MOVING AHEAD 1
         MTW,1    W14,R6            DITTO
         B        SEQPOS3           MOVE AHEAD
         PAGE
*  ROUTINE TO READ A RECORD FROM A CONSECUTIVE FILE.
SEQ0     LI,R0    MSREXIT           EXIT FOR TRANX
         LI,D1    X'40000'          EOP = READ
         BAL,R7   SEQPOS            INIT & POSITION
         B        SEQ01             NOY EMPTY
SEQ00    RES      0
         BAL,R0   1A4+1             PREVENT DELREC RESET EOP
         LI,R0    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,R2    HACMD             GET
         LH,R3    *R6,R2             CURRENT POSITION
         LI,R0    X'400'            CHK
         CW,R0    DIR,R6             DIRECTION
         BAZ      SEQ02             FORWARD
         LI,R0    0
         XW,R0    W19,R6            RESET POSN COUNT
         AI,R0    -1
         BNE      SEQ00             HIT BOF
         LW,R4    DCBCDAM,R6        SAVE
         PUSH     2,R3               CURRENT POSITION
         B        SEQ1              OK
         SPACE    2
SEQ02    LW,R1    CFU,R6
         LW,R0    W14,R6            CURRENT POSN
         CW,R0    TDA,R1
         BL       SEQ1              NOT AT EOF
         BGE      SEQ00             HIT EOF
         SPACE    3
SEQ5     INT,D1   BUFF1,R3
         BCR,R2   SEQ7              END OF RECORD
SEQ8     BAL,R4   SEQFRD            GO TO NXT SEG
SEQ1     AW,D3    R3                SEG CTL WD POSN
         CI,R3    WBUFS             CHK FOR
         BGE      SEQE+1             UNEXPECTED EOF
         INT,D1   *D3               DISPERSE CTL WD
         BCR,8    SEQ3              BLOCKED SEGMENT
         SLS,D2   16                GET
         SLD,D1   -8                 DISK
         SLS,D2   -8                  ADDRESS
         STW,D2   CDA,R6            FOR Q
         LW,SR1   D2
         BAL,SR4  FMCHKDA
         BCR,R15  6A2               BAD DISK ADDRESS 7501
         BAL,D4   SETBTDQ           MOVE UBTD TO HBTD
         AI,D1    BUFSIZ-15         SEG LENGTH
         BAL,R0   SEQ2              SET BLK & RWS
         LI,R4    0                 READ FLAG
         LI,SR4   SEQ4              SET RETURN
         B        PVREADTP          READ THE DATA
         SPACE    4
SEQ2     LCW,R4   D1
         AWM,R4   RWS,R6            ADJUST RWS
         BGEZ     SAVBLK            SET BLK
         AW,D1    RWS,R6            CAN'T READ WHOLE SEG
         BGZ      SAVBLK            OK
         B        SEQ9              LOST DATA
         SPACE    4
SEQ3     LCW,D2   D1                ADJUST
         BNEZ     %+3
         LI,D3    BUFF1             RESTORE BFR PNTR
         B        SEQ8              BACK CTL WD
         AWM,D2   RWS,R6            SIZE REMAINDER
         BGEZ     %+3
         AW,D1    RWS,R6            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,D2    X'7FFF'           MASK
         SLD,D1   17
         STS,D1   BLK,R6            SET BLK FOR Q & IMAGE3
         SCS,D1   15                WORD ALIGN
         AI,D3    1                 1ST DATA BYTE POSN
         LI,R7    X'1FFFF'          IS ENCRYPTION
         AND,R7   ENCRYPT,R6         SPECIFIED
         BEZ      SEQ33C            BRANCH IF NOT
         LW,SR4   D1                GET
         AI,SR4   3                  SIZE
         SLS,SR4  -2                  IN WORDS
         LW,R0    D3                BUFFER ADDRESS
         LW,R5    ARS,R6            GET SLOT IN TSTACK
         SLS,R5   -17
         LW,R3    TSTACK-2,R5       USE PREVIOUS ENTRY
         BNEZ     1G32               IF IT'S A CONTINUATION
         LI,R3    X'ABCDE'          GENERATE SEED
         EOR,R3   0,R7               FOR RANDOM NUMBERS
         OR,R3    X1                MAKE IT ODD
1G32     BAL,R4   CONCR1R           GO DECRYPT
SEQ33C   RES      0
         LW,D4    QBUF,R6           DEST BUFFER
         SLD,D3   2                 ASSUMES FCN < 64
         LI,R1    X'30'             MASK
         AND,R1   BTD,R6            BYTE DISPLACEMENT
         BEZ      %+3               SKIP IF NONE
         SLS,R1   -4                ALIGN
         AW,D4    R1                INSERT BTD
         AI,D1    -256              IS 1 MOVE SUFFICIENT
         BLZ      SEQ32             YUP
SEQ31    OR,D4    YFC               MOVE 252 BYTES
         MBS,D3   0                 MOVE 'EM OUT
         AI,D1    -252              ADJUST COUNT
         BGEZ     SEQ31             MOVE ANOTHER 255
SEQ32    STB,D1   D4                FINAL MOVE COUNT
         MBS,D3   0                 MOVE FINAL BYTES
         SPACE    3
*F*      NAME:    CONCR1
*F*      PURPOSE: TO PROVIDE DATA ENCRYPTION FOR THR DATA
*F*               OF KEYED AND CONSECUTIVE FILES.
         AI,R7    0                 IS ENCRYPTION SPECIFIED
         BEZ      SEQ4              SKIP, IF NOT
         LI,R4    SEQ4              SET RETURN
CONCR1R  LW,R7    R0                BUFFER ADDRESS
         LW,SR2   R3                RANDOM # SEED
         LW,SR3   SR4               BUFFER SIZE
         SPACE    3
         DEF      CONCR1
*D*      NAME:    CONCR1
*D*      REGISTERS  SR2=RANDOM # SEED, R7=BUFFER ADDRESS IN BUFF1,
*D*               SR1=WORKING REGISTER, SR3=BUFFER SIZE, R4=LINK.
*D*      CALL     R4 IS THE LINK.
*D*      DESCRIPTION  SUCCEEDING WORDS IN THE MONITOR BUFFER ARE
*D*               EOR'ED WITH SUCCEEDING ENTRIES IN A SEQUENCE OF
*D*               PSEUDO-RANDOM NUMBERS. TO MAKE THE ENCRYPTION MORE
*D*               SECURE, BEEF UP THE PROCEDURE AT THIS POINT SUCH
*D*               AS IS DONE IN THE DO BELOW.
CONCR1   MI,SR2   65539             NEXT RANDOM #
         LW,SR1   0,R7              NEXT WORD IN BUFFER
         EOR,SR1  SR2               SMASH
         DO       0
         MI,SR2   65539             GIVE IT A DOUBLE DOSE
         EOR,SR1  SR2                SO DECODE OF 1 WORD DOESN'T GIVE
         FIN                          UP THE REMAINING CONTENTS.
         STW,SR1  0,R7               STORE THE SMASH
         AI,R7    1                 NEXT WORD POSITION
         BDR,SR3  CONCR1            LOOP ALONG
         STW,SR2  TSTACK-2,R5       SAVE FOR CONTINUATION
         B        0,R4              ALL DONE
         SPACE    3
SEQ4     LI,R0    %+3               SET
         PUSH     R0                 RETURN
         B        IMAGE3            ADJUST QBUF & ARS
         LI,D3    BUFF1
         LI,R2    HACMD             GET
         LH,R3    *R6,R2             POSITION
         LW,D1    RWS,R6            REMAINDER
         BGZ      SEQ5              MORE TO GO
         BLZ      SEQ6              LOST DATA
         INT,D1   BUFF1,R3
         BCR,2    SEQ7              NO LOST DATA
SEQ9     RES      0
SEQ6     LW,R4    TYC,R6            GET THE
         SCS,R4   15                 TYPE OF
         AND,R4   M7                  COMPLETION
         LB,R4    TYCODE,R4         IS IT AN ERR/ABN
         BNEZ     SEQ61             SKIP IF IT IS
         LI,D1    2                 SET LOST DATA
         BAL,R0   SETTYC
SEQ61    INT,D1   BUFF1,R3
SEQ7     BCS,8    SEQE              UNBLOCKED
         AI,D1    3                 ROUND UP
         SLS,D1   -2
         AW,R3    D1
SEQE     AI,R3    1                 NXT CTL WD OR END OF BFR
         LI,R0    X'400'            CHK DIRECTION
         CW,R0    DIR,R6
         BAZ      SEQR              FORWARD
         PULL     2,R3              START OF RECORD POSN
         CW,R4    DCBCDAM,R6
         BE       %+3
         STW,R4   DCBCDAM,R6
         BAL,R0   CLRBBUF
         LW,R0    Y02               TO SET TRN
         B        SEQT
         SPACE    3
SEQR     MTW,1    W14,R6            UP REC COUNT
SEQT     LW,R1    Y02               SET OR RESET
         STS,R0   TRN,R6             TRN BIT
         STH,R3   *R6,R2            SAVE POSITION IN CMD
         B        TRANX             TO GET OUT
         TITLE    '************  RDF  ***********'
         SPACE    3
         END

