*DECK SKBLDSQ 
          IDENT     SKBL$SQ 
          COMMENT   CRM SQ BACKSPACE ROUTINE
          LIST      F,X,C 
          SST 
          B1=1
 SKBL$SQ  TITLE     SKBL$SQ 
*#
*1CD  SKBL$SQ 
*0D   PURPOSE 
*0        POSITION A FILE BACKWARD A NUMBER OF LOGICAL RECORDS
*0D   CALL
*0                  SKIPBL    FIT,COUNT,TYPE
*0D   PARAMETERS
*0        A0        FIT ADDRESS 
*         B1        1 
*         B6        RETURN ADDRESS
*         SKP       NUMBER OF RECORDS OR FILES TO SKIP
*         ST        TYPE OF SKIP TO BE PERFORMED (EOR,EOS,EOP,EOI)
*0D   ACTION
*0        THIS BACKSPACE ROUTINE POSITIONS A FILE BACKWARD TO A RECORD, 
*         SECTION, PARTITION, OR INFORMATION (BEGINNING OF) BOUNDARY
*         FOR RECORD TYPES F, W, AND Z.  IN VIEW OF THIS, SKBL$SQ IS
*         BROKEN DOWN INTO SEVERAL INDEPENDENT SECTIONS OF CODE,
*         EACH OF WHICH HAS ONE ENTRY, AS FEW EXITS AS POSSIBLE, AND
*         AS LITTLE COMMINGLING WITH EACH OTHER AS POSSIBLE.  THESE 
*         SECTIONS ARE
*0        INITIALIZATION - CHECKS FOR VALID BLOCK AND RECORD TYPE,
*                FLUSHES THE BUFFER FOR OUTPUT FILES, SKIPS TO
*                END OF RECORD FOR INPUT FILES, AND BRANCHES TO 
*                THE SECTION OF CODE APPROPRIATE TO THE SKIP TYPE.
*0        SKBL$EOR - DRIVER LOOP FOR BACKSPACING RECORDS. CALLS REPO$SQ 
*                IF THE BUFFER IS EMPTY OR ELSE SETS PIN TO IN, FIRST,
*                OR BLOCK BOUNDARY WHICH EVER IS CLOSEST. 
*                THEN LOOPS CALLING THE RECORD-TYPE HANDLER UNTIL THE 
*                SKIP COUNT REACHES ZERO. 
*0        SKBL$EOS - BACKSPACES SECTIONS FOR NON-S/L DEVICES (SECTIONS
*                ARE NOT DEFINED ON S/L DEVICES) RT"W BY BACKING UP 
*                LEVEL 0 RECORDS. 
*0        SKBL$EOP - BACKSPACES PARTITIONS RT"W BY BACKING UP LEVEL 17B 
*                RECORDS. 
*0        SKBL$WSP - BACKSPACES SECTIONS AND PARTITIONS RT=W BY 
*                BACKING UP 1 LOGICAL RECORD AT A TIME AND CHECKING 
*                FP FOR EOS OR EOP. 
*0        SKBL$EOI - BACKSPACES TO BEGINNING OF VOLUME BY ISSUING A 
*                REWIND.
*0        SKBL$F - F-RECORD PROCESSOR FOR BACKSPACING RECORDS.
*                DETERMINES RECORD LENGTH AND DECREMENTS OUT AND
*                BLOCK LENGTH. CALLS BK2RD1 TO READ ANOTHER PRU 
*                IF RECORD LENGTH EXCEEDS THE AMOUNT OF DATA IN THE 
*                BUFFER.
*0        SKBL$W - W-RECORD PROCESSOR FOR BACKSPACING RECORDS.
*                DETERMINES RECORD LENGTH OF LAST RECORD FROM FIT 
*                (PRL) AND DECREMENTS OUT AND BLOCK LENGTH. WHEN
*                BLOCK LENGTH REACHES 1 FOR I-BLOCKS, RESET BLOCK 
*                LENGTH AND DECREMENT OUT 1 MORE FOR I-BLOCK CONTROL
*                WORD. CALLS BK2RD1 TO READ ANOTHER PRU IF THE RECORD 
*                LENGTH EXCEEDS THE AMOUNT OF DATA IN THE BUFFER. 
*0        SKBL$Z - Z-RECORD PROCESSOR FOR BACKSPACING RECORDS.
*                SEARCHES BACKWARD THROUGH THE BUFFER CHECKING
*                EACH WORD FOR A ZERO-BYTE AND DECREMENTS OUT AND 
*                BLOCK LENGTH. CALLS BK2RD1 TO READ ANOTHER PRU 
*                WHEN THE ZERO-BYTE SEARCH LOOP EXHAUSTS THE DATA 
*                IN THE BUFFER
*0        REPO$SQ - PHYSICALLY BACKSPACES THE FILE TO ELIMINATE 
*                THE EFFECTS OF READ-AHEAD. POSITIONS TO BEGINNING
*                OF PRU CURRENTLY BEING PROCESSED (INDICATED BY 
*                OUT POINTER). IF OUT POINTER IS ON PRU BOUNDARY, 
*                REPOSITION TO BEGINNING OF PRU PREVIOUS TO OUT.
*                CALL BY SKBL$EOR OR BK2RD1 
*0        BK2RD1 - PHYSICALLY BACKSPACE THE FILE TWO PRU-S THEN 
*                READS FORWARD ONE PRU. CALLED BY THE RT PROCESSORS 
*                WHEN THEY RUN OUT OF DATA IN THE BUFFER. 
*0        SKBL$RES - RESETS CIRCULAR BUFFER AND FIT POINTERS WHEN 
*                AN END CONDITION IS ENCOUNTERED. SETS FET POINTERS 
*                TO FIRST AND ZEROS BLOCK NUMBER, BLOCK LENGTH, RECORD
*                NUMBER, ETC. 
*0        ADJPTRS - ADJUSTS CIRCULAR BUFFER POINTERS AND FIT FIELD
*                BFS TO 1 PRU FOR SYSTEM DEVICES AND TO BLOCK SIZE
*                FOR S/L DEVICES. THIS PREVENTS BK2RD1 FROM BACKSPACING 
*                20 PRU-S THEN READING 19.
*0        RESPTRS - RESTORES POINTERS MODIFIED BY ADJPTRS.
*0        CANTHNDL- OUTPUTS ERROR 403B FOR ILLEGAL BT/RT COMBINATIONS.
*0        DXIT -    TAKES A DATA EXIT.
*0        XIT -     NORMAL EXIT.
*0D   REGISTERS USED
*0        ALL 
*0D   OTHER CODE REQUIRED 
*0        MACROS- 
*         ROUTINES- FLSH$SQ, FLSH$S, SKFL$SQ
*0D   NARRATIVE DESCRIPTION 
*#
 SKBL$SQ  TITLE     INITIALIZATION
*#
*0D       INITIALIZATION: 
*         SAVE USER-S RETURN ADDRESS AND FETCH SKIP COUNT AND TYPE. 
*#
 SKBL$SQ  CAP.RM    TRANSIENT 
          SAVE                     SAVE USER-S RETURN ADDRESS 
          SET.RM    STM,0          SO GET/PUT WILL RECALCULATE SPACE
          F.RM      LOP 
          SX6       X1-#PU# 
          SB6       RETFLSH 
          ZR        X6,FLSH        FLUSH BUFFER IF LAST OP IS PUT 
RETFLSH   BSS       0 
          F.RM      SKP,X2
          F.RM      ST,X3 
*#
*         CHECK FOR VALID BT/RT COMBINATIONS. SKBL PROCESSES ONLY 
*         I/C BLOCKS AND F/W/Z RECORDS (S TYPE RECORDS ARE HANDLED
*         BY SKSB$SQ).
*#
          EK.SQ     CANTHNDL       IF BT=K/E
          F.RM      RT,B5 
          SB4       B5-#DT# 
          SB3       B5-#TT# 
          EQ        B4,B0,CANTHNDL BRANCH IF RT=D 
          SB4       B5-#UT# 
          EQ        B3,B0,CANTHNDL BRANCH IF RT=T 
          EQ        B4,B0,CANTHNDL BRANCH IF RT=U 
*#
*         CHECK SKIP COUNT AND SKIP TYPE.  IF SKIP COUNT IS ZERO AND
*         FILE POSITION IS SAME AS SKIP TYPE, JUST EXIT.  OTHERWISE 
*         SET SKIP COUNT TO 1.
*#
          F.RM      FP,5           KEEP IN X5 UNTIL FLSH
          NZ        X2,CHKLOP      BRANCH IF SKP COUNT " 0
          ZR        X5,SETSKP      FP=MID-RECORD
          IX7       X3-X5 
          SB4       X5             FP 
          ZR        X7,XIT
 SETSKP   BSS       0 
          SET.RM    SKP,1          MAKE ZERO SKIP COUNT SENSIBLE
*#
*         IF LAST OPERATION WAS PUT, FLUSH THE BUFFER.
*#
 CHKLOP   BSS       0 
          F.RM      LOP 
          SX6       X1-#OP# 
          ZR        X6,LOPEN       IF LAST OPERATION WAS OPENM
          SX6       X1-#PU# 
          ZR        X6,CHKTYPE     JUMP IF LOP=PUT
*#
*         IF FILE POSITION IS MID-RECORD, SKIP TO END OF RECORD.
*#
          NZ        X5,CHKTYPE     FP"MID-RECORD
          SET.RM    DEL,1 
          SET.RM    GPS,0 
          SET.RM    PRD,0 
          SET.RM    GSF,0 
          SB3       #SF#
          SB6       RTSKGT         RETURN ADDRESS 
          SA1       A0+36B
          BX0       X1             SET UP X0 FOR GETDSQ 
          EQ        =YSKGT$SQ      SKIP TO EOR
 FLSH     BSS       0 
          F.RM      RT,X1,-#ST# 
          NZ        X1,=YFLSH$SQ   FLUSH BUFFER 
          EQ        =YFLSH$S
  
RTSKGT    BSS       0 
          BX7       X0
          SA7       A0+36B         RESET WORD 36 OF THE FET 
          EQ        CHKTYPE 
  
 LOPEN    BSS       0 
          CLCD.SQ 
*#
*         CHECK SKIP TYPE AND BRANCH TO SECTION OF CODE TO PROCESS
*         THAT TYPE.
*#
 CHKTYPE  BSS       0 
          RCL.RM    A0,AUTO        RECALL FILE BEFORE DIDDLING CB PTRS
          F.RM      ST
          F.RM      RT,5
          SB2       X5-#WT# 
          SX2       X1-#EOI#
          ZR        X2,SKBL$EOI    TYPE IS EOI
          EQ        B2,B0,SETRTJ   RT=W--WILL NEED RTJ SET UP 
          SB3       X1-#EOS#
          SB4       X1-#EOP#
          EQ        B3,B0,SKBL$EOS TYPE IS EOS RT"W 
          EQ        B4,B0,SKBL$EOP TYPE IS EOP RT"W 
 SETRTJ   BSS       0        SET UP RTJ 
          SX7       X5-#FT# 
          SX4       SKBL$F
          ZR        X7,STRRTJ 
          SX4       SKBL$W
          EQ        B2,B0,STRRTJ
          SX4       SKBL$Z
 STRRTJ   BSS       0 
          SET.RM    RTJ,X4,,2 
          SX3       X1-#EOR#
          ZR        X3,SKBL$EOR    TYPE IS EOR
          EQ        SKBL$WSP TYPE IS EOS/EOP RT=W 
 SKBL$SQ  TITLE     SKBL$EOR
*#
*0        SKBL$EOR. 
*         IF THE BUFFER IS EMPTY -
*         FIRST CALL REPO$SQ TO MAKE THE PHYSICAL AND LOGICAL POSITION
*         AGREE (IN ENGLISH THIS MEANS TO NULLIFY THE EFFECT OF ANY 
*         READ-AHEAD - WHICH GET$SQ USUALLY DOES - BY PHYSICALLY
*         BACKSPACING THE FILE TO THE BEGINNING OF THE PRU WHICH
*         THE OUT POINTER POINTS TO). IF REPO$SQ ENCOUNTERED
*         END-OF-SECTION, BRANCH TO DXIT TO TAKE A DATA EXIT. 
*         IF REPO$SQ ENCOUNTERED END-OF-PARTITION, PHYSICALLY 
*         BACK OVER THE LEVEL 17B PRU THEN BRANCH TO DXIT TO TAKE 
*         A DATA EXIT.
*         ELSE -
*         SET PIN (USED TO INDICATE THE BOUNDARY OF DATA IN BUFFER
*         THAT CAN BE BACKED OVER) TO IN, FIRST OR OUT-BL/10 WHICH
*         EVER IS LARGEST BUT LESS THAN OUT.
*#
 SKBL$EOR BSS       0 
          SB6       EOR.CALL       RETURN ADDRESS 
          F.RM      IN,4
          F.RM      OUT,5 
          IX3       X5-X4          OUT - IN 
          ZR        X3,=XREPO$SQ   IF BUFFER EMPTY
          SX4       X4+B1          ALLOW FOR EMPTY WORD AT IN 
          IX3       X5-X4 
          PL        X3,USEIN       IF IN LESS THAN OUT
          F.RM      FIRST,4 
          IX3       X5-X4          OUT - FIRST
 USEIN    BSS       0 
          F.RM      BL,X2 
          SOL*10    X2,-
          SA1       TENTH 
          FX6       X2*X1          (BL+9)/10
          IX1       X6-X3 
          PL        X1,USEPIN 
          IX4       X5-X6          PIN = OUT - (BL+9)/10
 USEPIN   BSS       0 
          SET.RM    PIN,X4
          SB4       B0             SET NO BOUNDARY FLAG 
          SB2       -B1            SET REPO$SQ NOT DONE FLAG
*#
*         NOW CALL SKBL$<RT>, DECREMENTING THE SKIP COUNT BY 1
*         FOR EACH CALL UNTIL IT REACHES ZERO. IF THE RT ROUTINE
*         ENCOUNTERS AN END CONDITION, BRANCH TO DXIT TO TAKE A 
*         DATA EXIT. IF THE RT ROUTINE ENCOUNTERS BEGINNING-OF-VOLUME 
*         AND THE SKIP COUNT IS NOT SATISFIED, BRANCH TO DXIT TO
*         TAKE A DATA EXIT. 
*#
 EOR.CALL BSS       0 
          NE        B4,B0,EOR.DX   JUMP IF END CONDITION HIT
          SB4       B0             INITIALIZE RT ERROR RETURN 
          F.RM      RTJ,B5         ADR OF RT ROUTINE (SKBL$<RT>)
          SB6       EOR.RT         RETURN ADDRESS 
          JP        B5
 EOR.RT   BSS       0 
          NE        B4,B0,EOR.DX   RT ROUTINE HIT END CONDITION 
 RND      BSS       0 
          F.RM      RC,X1,-1
          NG        X1,NODECR      RC CANNOT BE NEGATIVE
          SET.RM    RC,X1 
NODECR    BSS       0 
          F.RM      SKP,X2,-1 
          SET.RM    SKP,X2
          NZ        X2,EOR.CALL    JUMP IF SKIP COUNT NOT SATISFIED 
*#
*         WHEN THE SKIP COUNT REACHES ZERO, SET THE FILE POSITION 
*         (FP) TO #EOR#, AND
*         CALL RESPTRS TO RESTORE THE CIRCULAR BUFFER POINTERS
*         TO THEIR ORIGINAL VALUE (DOESNT SET IN OR OUT). 
*#
          RJ        RESPTRS 
          SB4       #EOR#          FP 
          EQ        XIT 
 EOR.DX   BSS       0 
          RJ        RESPTRS 
          SB3       B4-#EOS#
          EQ        B3,B0,DXIT     GO TO DATA EXIT IF EOS HIT 
          F.RM      RT,X2,-#WT#    IF RT=W DONT BACK
          ZR        X2,DXIT 
          SYSY      44B,R          EOP-BACK OVER LEVEL 17 PRU 
          EQ        DXIT           GO TAKE DATA EXIT
 SKBL$SQ  TITLE     SKBL$EOS
*#
*0        SKBL$EOS. 
*         POSITION BACKWARD TO END-OF-SECTION.
*         IF S/L TAPE, SKIPPING SECTIONS IS ILLEGAL SINCE SECTIONS
*         ARE NOT DEFINED ON S/L TAPES - ISSUE ERROR MESSAGE. 
*#
 SKBL$EOS BSS       0 
          F.RM      SKP,X0         SKIP COUNT 
          ON.RM     SOL,ERR405
*#
*         BASICALLY ALL THAT NEEDS TO BE DONE IS TO BACK UP 
*         SKIP COUNT LEVEL ZERO RECORDS (SINCE RT=W IS HANDLED
*         SEPARATELY). HOWEVER IF THE FET C/S SHOWS 103XB FROM THE
*         LAST READ (I.E. EOI) IGNORE THE EOF STATUS SINCE NO 
*         PRU WAS READ FOR IT AND JUST ISSUE THE 640B. IF THE FET 
*         C/S SHOWS A 3X FROM THE LAST READ, BACK OVER THE LEVEL 17B
*         PRU, PUT FP=EOP IN B4, AND GO TO EOS.DX TO TAKE A DATA EXIT 
*         IF THE 640B RUNS INTO BOV (MACRO BOI.RM CHECKS THIS), GO
*         TO EOS.DX TO TAKE A DATA EXIT.
*#
          SA2       A0             GET FET C/S
          SX7       1030B          EOI/EOF MASK 
          BX2       X7*X2 
          IX1       X2-X7 
          ZR        X1,EOS.CIO     JUMP IF EOI HIT
          SX2       X2-30B
          NZ        X2,EOS.CIO     JUMP IF NO EOI/EOF 
          SYSY      44B,R          EOF IN BUFR-BACK OVER IT AND TAKE DX 
          SB4       #EOP#          FP 
          EQ        EOS.DX
 EOS.CIO  BSS       0 
          SYSY      640B,R,0
          BOI.RM    EOS.DX         JUMP IF BOV HIT
*#
*         NEXT CALL ADJPTRS TO MAKE CIRCULAR BUFFER 1 PRU LONG AND
*         ISSUE A CIO BACKSPACE PRU AND CIO READ TO SEE WHAT STOPPED
*         THE 640B. IF IT WAS A LEVEL 17B PRU, SET FP=EOP IN B4 AND 
*         GO TO EOS.DX TO TAKE A DATA EXIT. OTHERWISE CALL RESPTRS
*         TO RESET CIRCULAR BUFFER POINTERS, SET FP=EOS IN B4 AND 
*         CALL SKBL$RES TO RESET FIT FILEDS THEN GO TO XITA TO
*         RETURN TO USER. 
*#
          RJ        ADJPTRS        ADJUST CB POINTERS TO 1 PRU
          SYSY      44B,R          SEE WHAT STOPPED THE 640B
          BOI.RM    EOS.PTRS       JUMP IF BOI HIT-IT STOPPED THE 640B
          SYSY      10B,R          READ 1 PRU TO SEE IF IT IS LEVEL 17B 
          SA2       A0             GET FET C/S
          SX7       30B 
          BX2       X7*X2 
          SX2       X2-30B         IF C/S=3X, BACKED OVER EOF-
          NZ        X2,EOS.PTRS    JUMP IF 640 DIDNT BACK INTO EOF
          SB4       #EOP#          640 BACKED INTO EOF-TAKE DX
          EQ        EOS.DX
 EOS.PTRS BSS       0 
          RJ        RESPTRS        RESTORE CIRCULAR BUFFER POINTERS 
          SB5       XITA           RETURN ADDRESS 
          SB4       #EOS#          FP 
          EQ        =YSKBL$RES     RESET POINTERS 
 EOS.DX   BSS       0 
          RJ        RESPTRS 
          SB5       DXITA          RETURN ADDRESS 
          EQ        =YSKBL$RES     RESET POINTERS 
 ERR405   BSS       0 
          S"ERRREG" 405B           ILLEGAL SKIP TYPE OR TYPE NOT
          EQ        =YERR$RM         DEFINED ON DEVICE
 SKBL$SQ  TITLE     SKBL$EOP
*#
*0        SKBL$EOP. 
*         POSITION BACKWARD TO END-OF-PARTITION.
*         ALL THAT NEEDS TO BE DONE IS TO BACK UP SKIP COUNT LEVEL 17B
*         RECORDS (SINCE RT=W IS HANDLED SEPARATELY). THEN CALL 
*         SKBL$RES TO RESET FIT FIELDS AND SET FP IN B4. GO TO
*         DXITA TO TAKE A DATA EXIT IF BOV WAS HIT. OTHERWISE GO
*         TO XITA TO RETURN TO USER.
*#
 SKBL$EOP BSS       0 
          F.RM      SKP,X0
          SX6       17B            LEVEL NO.
          SYSY      640B,R,0,6
          SB5       DXITA          RETURN ADDRESS 
          BOI.RM    EOP.RSPT       JUMP IF BOV HIT
          SB4       #EOP#          FP 
          SB5       XITA           RETURN ADDRESS 
 EOP.RSPT BSS       0 
          EQ        =YSKBL$RES     RESET POINTERS 
 SKBL$SQ  TITLE     SKBL$WSP
*#
*0        SKBL$WSP. 
*         POSITION BACKWARD TO END-OF-SECTION OR PARTITION FOR
*         W-RECORDS.
*#
 SKBL$WSP BSS       0 
          SET.RM    PAE,0 
          SET.RM    RZSW,0         INITIALIZE FIRST TIME SWITCH 
          SB6       WSP.CALL       RETURN ADDRESS 
          EQ        =YREPO$SQ 
 WSP.CALL BSS       0 
          SB4       B0
          F.RM      RTJ,B5
          SB6       WSP.RT
          JP        B5
 WSP.RT   BSS       0 
          F.RM      ST,B5 
          SB3       B5-#EOS#
          EQ        B4,B5,WSP.RZSW
          SET.RM    RZSW,1
          EQ        B4,B0,WSP.CALL
          EQ        B3,B0,WSP.DX
          SB3       B4-#EOS#
          EQ        B3,B0,WSP.CALL IF TYPE=EOP AND EOS HIT
          EQ        WSP.DX
 WSP.RZSW BSS       0 
          ON.RM     RZSW,WSP.SKP
          SET.RM    RZSW,1
          EQ        WSP.CALL
 WSP.SKP  BSS       0 
          F.RM      SKP,X2,-1 
          SET.RM    SKP,X2
          NZ        X2,WSP.CALL 
          INC.RM    OUT,1          RESET POINTERS TO INDICATE AFTER EOX 
          SET.RM    PRL,1 
          SET.RM    PAE,1 
          RJ        RESPTRS 
          F.RM      ST,B4 
          EQ        XIT 
 WSP.DX   BSS       0 
          RJ        RESPTRS 
          EQ        DXIT
 SKBL$SQ  TITLE     SKBL$EOI
*#
*0        SKBL$EOI. 
*         POSITION BACKWARD TO BEGINNING-OF-INFORMATION.
*         ISSUE CIO REWIND, CALL SKBL$RES TO RESET FIT FIELDS, AND
*         GO TO XITA TO RETURN TO USER. 
*#
 SKBL$EOI BSS       0 
          RCL.RM    A0,AUTO 
          SYSY      50B 
          SB4       #BOV#          FP 
          SB5       XITA           RETURN ADDRESS 
          EQ        =YSKBL$RES     RESET POINTERS 
* CALL /REPODSQ/
*CALL /REPODSQ/ 
*#
*         NOW DIDDLE THE POINTERS. BASICALLY, ALL THE RT ROUTINES 
*         MUST TAKE DATA OUT OF THE BUFFER (IF YOU WILL) AND THUS 
*         MUST UPDATE THE OUT POINTER. THIS MEANS THE OUT POINTER 
*         IS NOW CORRECT FOR ANY SUCCEEDING GET OPERATION. WE TAKE
*         DATA OUT OF THE BUFFER STARTING AT THE OUT
*         POINTER.  SO WE SAVE THE IN POINTER FOR 
*         SUCCEEDING I/O OPERATIONS, SET OUT=FIRST+(NUMBER OF WORDS 
*         BETWEEN OUT AND PRU BOUNDARY AS CALCULATED BY REPO$SQ), 
*         SET PIN=FIRST+SOL (DON'T WANT THE S/L CONTROL WORD AS DATA),
*         AND FOR S/L DEVICES, SET BLP=ADDRESS OF NEXT S/L CONTROL
*         WORD. WE ARE NOW READY TO BACKSPACE WORD BY WORD IN A 
*         BACKWARD DIRECTION THROUGH THE BUFFER FROM OUT TO PIN.
*#
          F.RM      BT,X1,-#CT# 
          NZ        X1,RRD.PTRS 
          SX5       B2             SET BL TO DISTANCE TO BLOCK/PRU*10 
          IX7       X5+X5 
          LX5       3 
          IX5       X7+X5 
          SET.RM    BL,X5 
 RRD.PTRS BSS       0 
          SB4       B0
          SET.RM    OUT,X6
          F.RM      FIRST,B3
          SX2       X4+B3 
          SET.RM    PIN,X2
          ZR        X4,RRD.XIT     NOT S/L OR NO READ 
          SA2       B3             READ UP SLCW TO GET BLOCK LENGTH 
          SB5       X2+B1          ADD 1 FOR SLCW 
          SX6       B3+B5          GET ADDR OF NEXT SLCW
          SET.RM    BLP,X6
          JP        B6             RETURN 
* CALL /B2R1DSQ/
*CALL /B2R1DSQ/ 
          F.RM      IN,2
          F.RM      OUT,3 
          F.RM      BT,X1,-#IT#    BL RESET ONLY AT IBCW BT=I 
          F.RM      SOL,5,X5       IF S/L DEVICE
          SX6       X1+B4          OR AT SHORT PRU
          BX6       X6+X5 
          ZR        X6,BK2.REV
          SX6       40             BL MUST BE AT LEAST 40 FOR BT=I
          BX1       X1+X5          IF S/L DEVICE AND
          ZR        X1,BK2.SBL IF BT=I
          BUFSP     X,3,2,6        SET BL=LENGTH OF EACH PRU
          IX1       X6+X6 
          LX6       3 
          IX6       X1+X6 
 BK2.SBL  BSS       0 
          SET.RM    BL,X6 
 BK2.REV  BSS       0 
          SET.RM    OUT,X2
          JP        B6
 SKBL$SQ  TITLE     SKBL$F
*#
*0        SKBL$F. 
*         F-RECORD HANDLER FOR SKBL$SQ. 
*         LOAD FL AND CALCULATE THE AMOUNT OF DATA IN THE 
*         BUFFER. IF THE RECORD LENGTH IS LESS THAN OR EQUAL TO THE 
*         BUFFER AMOUNT, DECREMENT OUT AND BLOCK LENGTH BY RECORD 
*         LENGTH AND RETURN.  IF NOT, DECREMENT OUT, BLOCK LENGTH, AND
*         RECORD LENGTH BY THE BUFFER AMOUNT, CALL BK2RD1 TO PUT
*         MORE DATA IN THE BUFFER THEN GO BACK TO THE BUFFER AMOUNT 
*         CALCULATION CODE AND LOOP UNTIL THE RECORD LENGTH IS ZERO.
*#
 SKBL$F   BSS       0 
          F.RM      FL             RECORD LENGTH IN CHARS 
          BX0       X1
 F.BUFSP  BSS       0 
          F.RM      PIN,3 
          F.RM      OUT,4 
          F.RM      BL,2           BLOCK LENGTH 
          IX6       X4-X3          AMOUNT OF DATA IN BUFFER 
          IX1       X6+X6          CONVERT BUFFER AMT TO CHARS
          LX6       3 
          IX6       X1+X6 
          IX7       X6-X0          BUFSP-REC LEN
          PL        X7,F.DONE      JUMP IF RECORD IS ALL IN THE BUFFER
          IX2       X2-X6          DECREMENT BL 
          IX0       X0-X6          DECREMENT REC LEN
          SAVE                     SAVE B6
          SET.RM    BL,X2 
          SET.RM    OUT,X3         SET OUT FOR REPODSQ
          SB6       F.BK2          RETURN ADDRESS 
          EQ        =YBK2RD1
 F.BK2    BSS       0 
          RESTORE                  RESTORE B6 
          NE        B4,B0,F.XIT    JUMP IF END CONDITION HIT
          EQ        F.BUFSP 
 F.DONE   BSS       0 
          IX2       X2-X0          DECREMENT BL 
          SET.RM    BL,X2 
          SB5       F.CHRET        RETURN ADDRESS 
          BX7       X0             ARGUMENT INPUT IN X7 
          EQ        =YCHWR$RM 
 F.CHRET  BSS       0 
          SX7       X7             WORDS RETURNED IN X7 
          IX4       X4-X7          DECREMENT OUT
          SET.RM    OUT,X4
          JP        B6             RETURN 
 SKBL$SQ  TITLE     SKBL$W
*#
*0        SKBL$W. 
*         W-RECORD HANDLER FOR SKBL$SQ. 
*         LOAD PREVIOUS RECORD LENGTH (PRL) AND BLOCK LENGTH (BL) 
*         AND CALCULATE THE AMOUNT OF DATA IN THE BUFFER. 
*#
 SKBL$W.1 BSS       0 
          SET.RM    PRL,1          PRL MUST BE 1
 SKBL$W   BSS       0 
          F.RM      BL
          BX7       X1
          SB5       W.BL2WDS       RETURN ADDRESS 
          EQ        =YCHWR$RM 
 W.BL2WDS BSS       0 
          SX2       X7
          F.RM      PRL 
          NZ     X1,W.BL3WDS       PRL NON ZERO 
          F.RM   SOL,X1 
W.BL3WDS  BSS    0
          BX0       X1
 W.SPACE  BSS       0 
          F.RM      PIN,5 
          F.RM      OUT,4 
          F.RM      BCC 
          ZR        X1,W.BUFSP     IF BCC IS ZERO 
          SX4       X4+B1          ELSE, SET OUT TO NEXT WORD 
          SET.RM    BCC,0          CLEAR BCC
 W.BUFSP  BSS       0 
          IX6       X4-X5          AMT OF DATA IN BUFFER
          ZR        X6,TRYAG       IF BUFFER EMPTY
*#
*         NEXT CHECK TO SEE IF THIS RECORD SPANS A BLOCK BOUNDARY 
*         BECAUSE IF BT=I, THE I-BLOCK CONTROL WORD (IBCW) MUST BE
*         PASSED OVER. IF THE RECORD DOES SPAN THE BLOCK BOUNDARY 
*         (RRL>BL), CHECK THE AMOUNT OF DATA IN THE BUFFER. IF IT 
*         IS LESS THAN THE REMAINING DATA IN THE BLOCK, GO TO W.BK2.
*         ELSE DECREMENT RECORD LENGTH BY BLOCK LENGTH (BY BL+10 IF 
*         BT=I) AND OUT BY BLOCK LENGTH.  THEN GO BACK TO THE BUFFER
*         AMOUNT CLACULATION CODE.
*#
          F.RM      BT,1,B3,-#IT# 
          F.RM      SOL,X1         SLCW COUNTED IN BL BUT NOT REC LEN 
          IX7       X2-X0          BL-REC LEN 
          BX3       X2
          NE        B3,B0,W.NOTI   JUMP IF BT"I 
          SX7       X7-1           IBCW INCLUDED IN BL BUT NOT REC LEN
          SX3       X2-1
 W.NOTI   BSS       0 
          IX3       X3-X1 
          IX7       X7-X1          BL-SOL 
          PL        X7,W.CHKSP     JUMP IF REC FITS IN BLOCK
          IX7       X6-X3          BUFSP-BL-SOL 
          NG        X7,W.BK2       JUMP IF WHOLE BLOCK IS NOT IN BUFR 
          ZR        X7,W.BK2
          IX0       X0-X3          DECREMENT REC LEN BY BL-1
          IX4       X4-X2          DECREMENT OUT BY BL
          F.RM      MBL,2          EACH BLOCK IS MBL CHARS LONG 
          ZR        X1,W.NSOL 
          IX4       X4+X1          ADD BACK SOL 
          BX2       X3             FOR S/L USE OLD BL 
 W.NSOL   BSS       0 
          SET.RM    BL,X2          SAVE BL IN CHARACTERS
          BX3       X0                TRUNC DESTROYS X-REG CONTENTS 
          SET.RM    PRL,X3,7,1,TRUNC  SAVE PRL AROUND BK2RD1 CALL 
          SB5       W.MBLWDS       RETURN ADDRESS 
          BX7       X2
          EQ        =YCHWR$RM 
 W.MBLWDS BSS       0 
          SX2       X7
          EQ        W.BUFSP 
*#
*         IF THE RECORD DOES NOT SPAN A BLOCK BOUNDARY, CHECK TO SEE
*         IF THE COMPLETE RECORD IS IN THE BUFFER. IF NOT (BUFSP<RECLEN)
*         DECREMENT BLOCK LENGTH, RECORD LENGTH, AND OUT BY THE BUFFER
*         AMOUNT (BUFSP), CALL BK2RD1 TO PUT MORE DATA IN THE BUFFER, 
*         AND GO BACK TO THE BUFFER AMOUNT CLACULATION CODE. IF THE 
*         COMPLETE RECORD IS IN THE BUFFER, DECREMENT OUT AND BLOCK 
*         LENGTH BY THE RECORD LENGTH.
*#
 W.CHKSP  BSS       0 
          IX1       X6-X0          BUFSP-RL 
          PL        X1,W.WHOLE     JUMP IF COMPLETE RECORD IS IN BUFR 
 W.BK2    BSS       0 
          IX2       X2-X6          DECREMENT BL BY BUFSP
          IX0       X0-X6          DECREMENT REC LEN BY BUFSP 
          IX4       X4-X6          DECREMENT OUT BY BUFSP 
          BX3       X0             USE SCRATCH REGISTER 
          SET.RM    PRL,X3,7,1,TRUNC  SAVE PRL AROUND BK2RD1 CALL 
          IX7       X2+X2 
          LX2       3 
          IX2       X7+X2 
          SET.RM    BL,X2          SAVE BL AROUND BK2RD1 CALL 
 TRYAG    BSS       0 
          SET.RM    OUT,X4         SET OUT FOR REPODSQ
          SAVE
          SB6       W.BK2RET       RETURN ADDRESS 
          EQ        =YBK2RD1
 W.BK2RET BSS       0 
          RESTORE                  RESTORE RETURN ADDRESS (B6)
          SB5       #EOS# 
          EQ        B4,B5,SKBL$W.1 IF SHORT PRU 
          NE        B4,B0,W.XIT    JUMP IF END CONDITION HIT
          EQ        SKBL$W
 W.G2     BSS       0 
          F.RM      BT,X2,-#IT# 
          SB4       B0             FILE NO LONGER AT SHORT PRU
          NZ        X2,NOTI        IF BT"I
          SB5       X6
          EQ        B5,B1,OUTBLK   IF BL RECORD IS NOT IN BLOCK 
          SA2       A4-B1          PICK UP BL 
          MX1       60-18          GET 18-BIT BL (WDS) FROM IBCW
          BX2       -X1*X2
          EQ        INBLK 
 OUTBLK   BSS       0 
          SAVE
          SB6       W.B2X2
          BX0       X4
          EQ        =YBK2RD1       MUST PRESERVE X0 
 W.B2X2   BSS       0 
          RESTORE 
          F.RM      OUT,A2,-1      PICK UP WORD CONTAINING BL 
          BX4       X0             RESTORE WCW TO X4
 INBLK    BSS       0 
          F.RM      SOL,X1
          IX2       X2+X1          ADD SOL BIT FOR SLCW 
          IX3       X2+X2          *10
          LX2       3 
          IX3       X2+X3 
 NOTI     BSS       0 
          NZ        X3,BLOK        IF NOT ONLY WORD IN BLOCK
          F.RM      MBL,3          ELSE, RESET BL TO MBL
          SOL*10    X3,+
 BLOK     BSS       0 
          SET.RM    BL,X3          STORE BL IN CHAR 
          LX4       59-58          POSITION FLAG BIT
          PL        X4,SKBL$W      IF NOT FLAG RECORD 
          LX4       58-57          POSITION DELETE BIT
          SB4       #EOS# 
          NG        X4,W.XIT       IF EOS FLAG RECORD 
          SB4       #EOP#          ELSE, EOP FLAG RECORD
          EQ        W.XIT 
 ERR130   BSS       0 
          RJ        RESPTRS 
          SX6       130B
          EQ        =XERR$RM
 W.WHOLE  BSS       0 
          IX2       X2-X0          DECREMENT BL BY REC LEN
          F.RM      MBL,3 
          ZR        X2,W.SETBL     IF BLOCK EMPTY 
          BX3       X2
          IX7       X3+X3 
          LX3       3 
          IX3       X7+X3 
 W.SETBL  BSS       0 
          SET.RM    BL,X3 
          IX4       X4-X0          DECREMENT OUT BY RECLEN
          SET.RM    OUT,X4
*#
*         NOW LOAD W-CONTROL WORD (WCW) AND SET PREVIOUS RECORD LENGTH
*         EQUAL TO WCW PRL FIELD FOR NEXT OPERATION.
*#
          SA4       X4
          CX1       X4
          BX0       X4
          LX1       59
          AX0       24
          PL        X1,ERR130 
          SX0       X0
          NZ        X0,PRLOK
          SX0       B1             IF PRL=0 PREVIOUS RECORD MUST BE 1 
 PRLOK    BSS       0 
          SB5       X0             SAVE X0 AROUND SET.RM
          SET.RM    PRL,X0,7,1,TRUNC
          SX0       B5             RESTORE X0 
          LX1       X4,B1 
          NG        X1,W.G2        IF EOS OR EOP
          SB5       #EOS# 
          EQ        B4,B5,W.G2     IF AFTER SHORT PRU 
*#
*         NEXT CHECK FOR EOS OR EOP. IF SO, SET FILE POSITION 
*         AND RETURN TO CALLER. IF NOT, CHECK W-CONTONUATION BITS.
*         IF THEY EQUAL MID OR END PIECE OF A W-CONTINUATION RECORD,
*         EXTRACT PREVIOUS RECORD LENGTH FROM WCW AND GO BACK TO
*         W.SPACE AND GO THROUGH THE SKBL$W 
*         CODE AGAIN TO GET BACK TO START OF RECORD. DO THE SAME
*         THING IF THIS IS A DELETED RECORD.
*#
          LX4       59-57 
          NG        X4,W.SPACE     JUMP IF DELETED RECORD 
          LX4       57-43          CHECK W-CONT FOR MID OR END
          NG        X4,W.SPACE     JUMP IF W-CONT RECORD
          SET.RM    BCC,0                                               004060
          JP        B6             RETURN 
 SKBL$SQ  TITLE     SKBL$Z
*#
*0        SKBL$Z. 
*         Z-RECORD HANDLER FOR SKBL$SQ. 
*         BACK UP ONE USER LOGICAL RECORD BY SEARCHING BACKWARD FOR 
*         A LOW-ORDER ZERO-BYTE STARTING AT OUT-1.  FIRST CALCULATE THE 
*         AMOUNT OF DATA IN THE BUFFER USING PIN AND OUT. 
*#
 SKBL$Z   BSS       0 
          F.RM      BL,2           BLOCK LENGTH 
          F.RM      PIN,3 
          F.RM      OUT,4 
          MX0       48             ZERO-BYTE MASK 
          IX7       X4-X3          OUT-IN 
          SA1       X4             INITIALIZE A1
*#
*         NEXT, LOAD WORD AT OUT-1.  IF THE WORD CONTAINS A ZERO-BYTE,
*         RETURN TO CALLER (EOR). 
*#
          SX4       10
 Z.WORD   BSS       0 
          ZR        X7,Z.CKBFR     IF BUFFER EMPTY
          SX7       X7-1           DECREMENT BUFFER AMOUNT
          SA1       A1-B1          LOAD PREVIOUS WORD 
          IX2       X2-X4 
          BX1       -X0*X1
          NZ        X1,Z.WORD      BYTE NOT ZERO
*#
*         IF THE WORD DOES NOT HAVE A ZERO-BYTE, KEEP LOOPING UNTIL 
*         ONE IS FOUND OR UNTIL THE BUFFER AMOUNT IS EXHAUSTED. 
*         IF THE BUFFER IS EXHAUSTED CALL BK2RD1 TO PUT MORE DATA 
*         IN THE BUFFER AND GO BACK TO THE BUFFER AMOUNT CALC CODE. 
*         IF A ZERO-BYTE IS FOUND AND IT IS THE FIRST ONE, SET A FLAG 
*         AND LOOK FOR SECOND.  IF IT IS THE SECOND, THE RECORD IS
*         SKIPPED SO RETURN.
*#
          F.RM      RZSW,3,,,6     RZSW=1=1 0-BYTE FOUND ALREADY
          NG        X3,Z.DONE      JUMP IF SECOND 0-BYTE FOUND
          SET.RM    RZSW,1,6,3     1ST 0-BYTE - SET FLAG AND LOOK FOR 2 
          NZ        X7,Z.WORD      IF BUFFER NOT EMPTY
 Z.CKBFR  BSS       0 
          SET.RM    OUT,A1,,3      SET OUT FOR REPODSQ
 Z.CKBF2  BSS       0 
          SET.RM    BL,X2 
          SAVE                     SAVE RETURN ADDRESS
          SB6       Z.BK2RET       RETURN ADDRESS 
          EQ        =YBK2RD1
 Z.BK2RET BSS       0 
          RESTORE                  RESTORE RETURN ADDRESS 
          EQ        B4,B0,SKBL$Z   NO END CONDITION HIT BY BK2RD1 
          F.RM      RZSW,3,,,6     IF 1 0-BYTE NOT ALREADY FOUND, 
          PL        X3,Z.EXIT      THIS IS END CONDITION
          F.RM      MBL,2          INITIALIZE BL TO START OF BLOCK
          SOL*10    X2,+
          SB4       B0             OTHERWISE TREAT END CONDITION AS 
          SB2       B0             TELL BK2RD1 NOT TO SKIP BOUNDARY 
          F.RM      IN,3
          SET.RM    PIN,X3
          SET.RM    OUT,X3         SET BUFFER EMPTY 
          CLCD.SQ                  CLEAR CDS SO GET WONT TAKE DX
          EQ        Z.BL             2ND 0-BYTE 
 Z.DONE   BSS       0 
          SX3       A1+B1          INCREMENT PAST LAST REC-S ZERO BYTE
          SET.RM    OUT,X3
          SX7       10
          IX2       X2+X7          COUNT ZERO BYTE IN BL
 Z.BL     BSS       0 
          SET.RM    BL,X2 
          SET.RM    RZSW,0         INITIALIZE SWITCH FOR NEXT LOOP
 Z.EXIT   BSS       0 
          JP        B6
 SKBL$SQ  TITLE     SKBL$RES
*#
*0        SKBL$RES. 
*         RESET POINTERS AT END CONDITION.
*         TURN OFF PARITY FLAG, SET PIN = IN = OUT = FIRST, SET 
*         FILE POSITION, SET PAE=0, ZERO BLOCK NUMBER, RECORD 
*         NUMBER, AND BCC, AND INITIALIZE BLOCK LENGTH = MBL. 
*#
 SKBL$RES BSS       0 
 36B      PUT.IN    0 
          F.RM      FIRST,3 
          SET.RM    IN,X3          RESTORE IN AND 
          SA7       A7+B1          OUT POINTERS 
          SET.RM    PIN,X3,7,1          IF FILE IS TO BE REWOUND
          OFF.RM    SOL,NSBLP 
          SET.RM    BLP,X3
 NSBLP    BSS       0 
          SET.RM    BN,0,7,1
          SET.RM    RC,0,7,1
          SET.RM    FP,B4 
          SET.RM    BCC,0 
          F.RM      MBL,3          INITIALIZE BL
          SOL*10    X3,+
          SET.RM    BL,X3 
          CLCD.SQ 
          STO.REG 
          JP        B5
 SKBL$SQ  TITLE     ADJPTRS/RESPTRS 
*#
*0        ADJPTRS.
*         ADJUST CIRCULAR BUFFER SIZE TO 1 PRU FOR SYSTEM DEVICES 
*         AND TO 1 BLOCK FOR S/L DEVICES BY ADDING PRUSIZ+1 OR MBL/10+2 
*         TO FIRST AND SETTING LIMIT TO THAT VALUE.  ALSO SAVE THE
*         ORIGINAL BFS IN FIT SCRATCH FIELD BFST SO THAT RESPTRS
*         CAN RESET THE POINTERS WHEN CALLED. 
*#
 ADJPTRS  BSSZ      1 
          F.RM      PRUSIZ,1,X3,+B1 
          OFF.RM    SOL,ADJ.1ST    JUMP IF S/L TAPE 
          F.RM      MLRS,X3,+2
 ADJ.1ST  BSS       0 
          F.RM      FIRST,2 
          F.RM      BFS,4          SAVE ORIGINAL BFS
          SET.RM    IN,X2          IN=FIRST 
          SET.RM    OUT,X2         OUT=FIRST
          IX5       X2+X3          FIRST+PRUSIZE+1
          SET.RM    LIMIT,X5
          SET.RM    BFS,X3
          SET.RM    BFST,X4 
          OFF.RM    SOL,ADJPTRS 
          SET.RM    BLP,X2         BLP = FIRST
          EQ        ADJPTRS 
*#
*0        RESPTRS.
*         RESTORE CIRCULAR BUFFER SIZE TO ORIGINAL VALUE. 
*#
 RESPTRS  BSSZ      1 
          NG        B2,RESPTRS     IF REPO NOT CALLED 
          F.RM      FIRST          RESTORE CB POINTERS
          F.RM      BFST,2         RESTORE ORIGINAL BFS 
          IX3       X1+X2 
          SET.RM    LIMIT,X3
          SET.RM    BFS,X2
          EQ        RESPTRS 
 SKBL$SQ  TITLE     CANTHNDL/DXIT/XIT 
*#
*0        CANTHNDL. 
*         ILLEGAL BLOCK OR RECORD TYPE - OUTPUT ERROR MESSAGE 403B. 
*#
 CANTHNDL BSS       0 
          S"ERRREG" 403B
          EQ        =YERR$RM
          SPACE     3 
*#
*0        DXIT. 
*         TAKE DATA EXIT IF ANY. OTHERWISE GO TO XIT. 
*#
 DXIT     BSS       0 
          SET.RM    FP,B4 
          SB5       #EOS# 
          SET.RM    PAE,0 
          EQ        B4,B5,DXITA    IF EOS EXIT PIONTERS OK
          F.RM      RT,X6,-#WT# 
          SB5       DXITA          SET RETURN ADDRESS 
          SB3       #BOV# 
          EQ        B4,B3,SKBL$RES IF FP = BOV
          NZ        X6,SKBL$RES    IF RT"W
 DXITA    BSS       0 
          F.RM      DX,B5          ADDRESS OF DATA EXIT 
          EQ        B5,B0,XIT 
          SET.RM    LOP,#SB#
          RESTORE                  SIMULATE AN  RJ  DX   BY 
          SX7       B1             PUTTING AN EQ B6 IN DX 
          SX6       B6             AND JUMPING TO DX+1
          LX7       26
          BX7       X7+X6 
          LX7       30
          SA7       B5
          JP        B5+1
          SPACE     3 
*#
*0        XIT.
*         RESTORE RETURN ADDRESS AND RETURN TO CALLER.
*#
 XIT      BSS       0 
          SET.RM    PAE,0          CLEAR PAE
          SET.RM    FP,B4          SET FP 
 XITA     BSS       0 
          SET.RM    LOP,#SB#
          RESTORE 
 RRD.XIT  BSS       0 
 BK2.JPB6 BSS       0 
 F.XIT    BSS       0 
 W.XIT    BSS       0 
          JP        B6             RETURN TO CALLER 
          END 
