*COMDECK /GETDSQ/ 
*#
*1CD  GET$SQ
*0D   PURPOSE 
*0        RETRIEVE A RECORD FROM A FILE AND DELIVER IT TO THE USER
*         WORKING STORAGE AREA. 
*0D   CALL
*                   SB6       RETURN-ADDRESS
*                   EQ        =XGET$SQ
*0D   PARAMETERS
*0        A0        FIT ADDRESS.
*         B1        1.
*         B6        RETURN ADDRESS. 
*         WSA       FWA OF USER WORKING STORAGE AREA (WHERE TO PUT DATA)
*         RL        RECORD LENGTH (GET).
*         PTL       PARTIAL TRANSFER LENGTH (GETP). 
*         DX        USER END-OF-DATA ADDRESS. 
*         GPS       GETP SKIP BIT (IF = 1 SKIP TO NEXT RECORD BEFORE
*                   GETTING DATA).
*0D   ACTION
*0        CHECK FOR READ AFTER WRITE, AND PROCESS ANY ERROR CODES 
*         PRESENT IN THE FET.  IF THIS IS FIRST CALL FOR FILE, LOAD THE 
*         BT AND RT ROUTINES IF NOT LOADED AND ALLOCATE THE BUFFER IF 
*         NEEDED. 
*         GET THEN CALCULATES THE NUMBER OF CHARACTERS IN THE CIRCULAR
*         BUFFER FROM THE CURRENT *OUT* POINTER TO EITHER *IN*, *BLP*,
*         *ERE*, *ERP*, *BL*=*MBL*, 
*         OR *LIMIT*, WHICHEVER WILL BE ENCOUNTERED FIRST.  IF THAT 
*         NUMBER IS ZERO, GO HANDLE WHAT WAS BUMPED INTO ANDRECALCULATE.
*         THEN CALL THE APPROPRIATE RECORD-TYPE HANDLER TO MOVE THE 
*         AVAILABLE CHARACTERS TO THE USERS *WSA*, BRANCH TO THE LOCA-
*         TION *GTMR$SQ*, IF NEEDED, TO MAKE MORE DATA AVAILABLE (BY
*         UPDATING *OUT* FROM *LIMIT* TO *FIRST*, BY ISSUING A CIO
*         CALL, OR BY PROCESSING THE START OF A NEW BLOCK), RE-CALCULATE
*         THE NUMBER OF CHARACTERS NOW IN THE BUFFER, AND CONTINUE AS 
*         DESCRIBED ABOVE UNTIL ALL THE REQUESTED DATA HAS BEEN MOVED.
*         UPON EXIT, GET TRIES TO KEEP THE I/O GOING BY ISSUEING A CIO
*         CALL, IF APPROPRIATE. 
*0        *RMA.LIM* IS JUMPED TO WHEN THE CURRENT BUFFER POSITION (B3)
*         IS EQUAL TO LIMIT. SO WE SET IT (B3) TO FIRST, ZERO THE 
*         BUFFER CHARACTER COUNTER (BCC) AND BRANCH BACK TO *RMANRD1* 
*         TO RE-DETERMINE THE AMOUNT OF DATA IN THE BUFFER. 
*0        *RMA.GMD* IS JUMPED TO WHEN IT IS NECESSARY TO READ MORE DATA 
*         IN ORDER TO GET TO THE END OF THE BLOCK.  WE UPDATE THE *OUT* 
*         POINTER TO B3 AND WAIT FOR THE *IN* POINTER TO MOVE. IF THE 
*         LAST I/O OPERATION BECOMES COMPLETE BEFORE THE *IN* POINTER 
*         MOVES, CHECK FOR ERRORS; BRANCH TO *ERR$RM* TO PROCESS THE
*         ERRORS AND RETURN TO *ERRXIT* TO PROCESS THE USER ERROR EXIT. 
*         IF NO ERRORS BUT END-OF-VOLUME IS SET, BRANCH TO *TJEOV* TO 
*         HANDLE THAT; OTHERWISE FIRE UP ANOTHER READ AND BRANCH BACK 
*         TO THE *IN* MONITORING CODE.
*         WHEN THE *IN* POINTER FINALLY MOVES, CHECK THE BLOCK POINTER
*         (BLP). IF *BLP* EQUALS THE CURRENT BUFFER POSITION, BRANCH
*         BACK TO *AMAC* TO RE-DETERMINE THE AMOUNT OF DATA IN THE
*         BUFFER. IF *BLP* IS NOT EQUAL TO THE CURRENT BUFFER POSITION
*         AND THIS IS A SCOPE DEVICE, BRANCH TO *BTRT$SQ* TO DO 
*         BLOCK-TYPE-PECULIAR PROCESSING. OTHERWISE, CHECK FOR ERRORS,
*         PROCESS THE S/L DEVICE CONTROL WORD, AND BRANCH TO *BTRT$SQ*
*         TO DO THE BLOCK-TYPE-PECULIAR PROCESSING. 
*0        *RMA.GNB* IS JUMP TO WHEN THE CURRENT BUFFER POSITION (B3)
*         IS EQUAL TO THE BLOCK POINTER (BLP) AND IT IS NECESSARY TO
*         START PROCESSING THE NEXT BLOCK. IF IT IS A SCOPE DEVICE, WE
*         TO *BTRT$SQ* TO DO THE BLOCK-TYPE-PECULIAR PROCESSING. IF 
*         IF IT IS AN S/L DEVICE AND THE INSUFFICIENT DATA FLAG IS ON 
*         FOR BT=K OR BT=E, GO PROCESS CONDITION. OTHERWISE, IF THE 
*         BUFFER IS NOT EMPTY, PROCESS THE S/L CONTROL WORD AND BRANCH
*         TO *BTRT.SQ* TO DO THE BLOCK-TYPE-PECULIAR PROCESSING. IF 
*         THE BUFFER IS EMPTY, THE EOF BIT IS SET IN THE FET, AND THE 
*         FIT END-OF-SECTION BIT IS SET, BRANCH TO *DXITA* TO PROCESS 
*         THE USER END-OF-DATA EXIT. IF THE BUFFER IS EMPTY, THE FIT
*         END-OF-SECTION BIT IS SET, BUT THE FET EOF BIT IS NOT SET,
*         BRANCH TO *RMA.GMD* SECTION TO ISSUE ANOTHER READ. IF THE 
*         BUFFER IS EMPTY AND THE FIT END-OF-SECTION BIT IS NOT ON
*         PERFORM THE ABOVE LOGIC WITH THE FIT POSITION-AFTER-END BIT.
*0        *RMA$ERR* (*RPAR$SQ*) IS THE READ PARITY ERROR PROCESSOR
*         AND IS BRANCHED TO FROM THE *AMAC* SECTION. FIRST WE CLEAR
*         THE FET ERROR STATUS BITS 10-13 AND THE FIT ERROR POINTER 
*         (ERP). NEXT, WE DO THE PROCESSING INDICATED BY THE FIT ERROR
*         OPTION FIELD (EO).
*         IF EO = TERMINATE, WE SET X6 WITH ERROR 137B (FATAL) AND
*         BRANCH TO *ERR$RM*. 
*         IF EO= ACCEPT, WE BRANCH BACK TO *AMAC* TO RE-DETERMINE 
*         THE AMOUNT OF DATA IN THE BUFFER (IF BT=C WE FIRST SET
*         *BLP*=*IN*).
*         IF EO = DROP ERRONEOUS DATA, WE MUST CHECK THE BLOCK TYPE.
*         FO BT=E AND BT=K, WE BRANCH TO *ERR$RM* TO O/P TRIVIAL ERROR
*         137B (AFTER FIRST ISSUING A CIO SKIPF TO SKIP TO END OF 
*         SCOPE LOGICAL RECORD FOR SCOPE DEVICES).
*         FOR BT=C AND RT"R OR RT"Z, WE SET X6 WITH ERROR 137B (FATAL)
*         AND BRANCH TO *ERROR$RM*. FOR BT=C AND RT=R OR RT=Z, WE BRANCH
*         TO *RSPT$SQ* TO RESET BUFFER POINTERS AND THEN BRANCH TO
*         *AMAC* TO RE-DETERMINE THE AMOUNT OF DATA IN THE BUFFER.
*         FOR BT=I, WE RESET *IN*=*OUT* AND ISSUE ANOTHER READ. REPEAT
*         IF ANOTHER PARITY ERROR OR DEVICE CAPACITY EXCEEDED ERROR 
*         OCCURS. FOR ANY OTHER ERROR, SET ERROR CODE 137B (FATAL)
*         AND BRANCH TO *ERR$RM*. IF NO ERRORS OCCUR BUT *IN* DIDNT 
*         MOVE, BRANCH TO *ERR$RM* TO ISSUE FATAL ERROR 137B. OTHERWISE,
*         UPDATE *OUT* *BLP*, *CNB* AND BRANCH BACK TO THE MAIN 
*         PROCESSING STREAM.
*0D   REGISTERS USED
*         A127,B23456,X01234567 
*0D   OTHER CODE
*0        PROGRAMS- CLSV$SQ, RSPT$SQ, ERR$RM, (Z$SQ/W$SQ/R$SQ/DT$SQ/
*                   FSU$SQ) 
*         MACROS-   COM.6RM, ISTO.RM, FATERR, SET.RM, SETS.RM, SAVE,
*                   F.RM, RCLF, CLCD.SQ, ON.RM, INC.RM, RESTORE, DEC.RM,
*                   BUFSP, OFF.RM, SYSY, RCL, BUFINC, RACLR 
*0D   DETAILED COMMENTS 
*#
 GERR.SQ  MACRO     N,T 
          SX6       N 
          T,GERR
          IFC       LT, N + ,1
#_N_#     SET       1 
 GERR.SQ  ENDM
          TITLE  GET
************************************************************************
*#
*0    INITIALIZATION
*0        THE CONTROLLER ENTERS AT GET$SQ THE FIRST TIME.  THE CODE AT
*         THAT POINT WILL SET FOJG SO THAT SUBSEQUENT CALLS WILL ENTER
*         AT GET.SQ.  OTHER INITIALIZATION CODE INCLUDES LOADING A
*         RT AND BT ROUTINE, SETTING RTJG AND BTJG, LOADING GET$FU IF 
*         NEEDED, AND ALLOCATING A BUFFER IF NEEDED.
*#
 P        ERRNZ     GET$SQ-RTABL-#PGPLSZ# PASSLOC TABLE MOVED 
 RTABL    BSS 
 #.C#     MICRO     2-#PLAO#,,/,/ 
          ECHO      1,CAP=(W,FU,R,Z,DT,DT,EK,FU"#.C#"),NTRY=("#.C#"W,F,R
,,Z,D,T,K,U)
          VFD       42D/0LGET$CAP,18D/=YGET$NTRY
          DATA      0 
 FU       EQU       RTABL+1 
 EK       EQU       RTABL+6 
  
 21B      IS.IN     5 
 GET$SQ   CAP.RM
          F.RM      RT,B4 
          NONEOF    B4,(#WT#,#DT#,#TT#),ENDRT 
          SA2       FU+#PLAO# 
          RJ        =XRM$BLD
 ENDRT    BSS 
          F.RM      RT,A2,+RTABL+#PLAO# 
          RJ        =XRM$BLD       LOAD RT ROUTINE
          SET.RM    RTJG,B5        ADDR OF RT CODE
          CI.SQ     LDBT
          SA2       EK+#PLAO# 
          RJ        =XRM$BLD       LOAD BT ROUTINE
 LDBT     SET.FOJ   G,B4,GET.SQ 
          NZ        B3,=XRM$ABUF   ALLOCATE BUFFER, RETURN VIA B3 
          SB3       B4
          EQ        =XRM$ABUF      ALLOCATE BUFFER, RETURN TO GET.SQ
  
          CAP.RM
 GET.SQ   BSS 
 36B      PUT.IN    0 
*#
*     GET AND GETP ENTER AT THE SAME PLACE (PRD FLAG IN FIT IS SET
*     FOR GETP).  BOTH CAN HAVE WSA AND DX SPECIFIED WHILE THE SECOND 
*     ARGUMENT IS EITHER RL OR PTL.  A FEW THINGS ARE CHECKED AND 
*     INITIALIZED (GSF=1 MEANS GET, RSI"1 AND DEL=0 MEANS 
*     TRANSFER DATA). 
*#
          F.RM      RSI 
          SX6       113B           SET GET AFTER READS ERROR
          NG        X1,=XERR$RM 
          SB3       #GE#           LAST OP FOR GET
          SET.RM    GSF,1          SET GET FLAG 
          SET.RM    DEL,0          ZERO DEL FLAG
          F.RM      FP
          ZR        X1,SKGT$SQ     IF IN MIDDLE OF RECORD DONT CLEAR RL 
          SET.RM    RL,0
*#
*         THEN IT IS TIME TO LET SKIPFL COME IN (AT *SKGT$SQ*) AND CHECK
*     SOME MORE THINGS.  NOW PATHS DIFFER DEPENDING 
*     ON WHETHER WE ARE AT THE BEGINNING OF A RECORD (FP"0).  GO TO 
*     AINI$SQ IF YOU ARE AT THE BEGINNING OF A
*     RECORD (SEE LATER COMMENTS).
*#
 SKGT$SQ  BSS       0 
          SAVE
          F.RM      LOP,B2
          EQ        B2,B3,CHKPE 
          SB4       B2-#GE#-#SF#
          SB4       -B4 
          EQ        B4,B3,SETLOP
          F.RM      WPN,2 
          GERR.SQ   116B,(NG X2)   READ AFTER WRITE 
          ON.RM     PRD,SETLOP     ZERO GPS FOR NOT GETP
          SET.RM    GPS,0 
 SETLOP   BSS       0 
          SET.RM    LOP,B3
 CHKPE    BSS       0 
          F.RM      RT,2,X2,-#UT# 
          NZ        X2,NOTU 
          SET.RM    GPS,0          IGNORE SKIP REQUEST IF RT=U
 NOTU     BSS       0 
          SET.RM    GEN,0          CLEAR ERROR INDICATOR
          OFF.RM    IPF,GCNT$SQ    IF NO PARITY ERROR IN THIS BLOCK 
          F.RM      OUT,B3         WHEN LAST ERROR RECORD IS PROCESSED
          F.RM      ERE,B4           OUT = ERE
          NE        B3,B4,PERR
          SET.RM    IPF,0          CLEAR INTERNAL PARITY ERROR FLAG 
          SET.RM    ERE,0          CLEAR END-POINTER OF ERROR BLOCK 
          SET.RM    SPR,0          READ-AHEAD IS RESUMED
          EQ        GCNT$SQ 
PERR      BSS       0 
          SET.RM    GEN,137B       READ PARITY ERROR
          SET.RM    PEF,1 
 GCNT$SQ  BSS       0 
          F.RM      FEC,X1,-4 
          NZ        X1,NPE
          F.RM      IN,A1 
          SB4       NPE            (RETURN FROM SKIP) 
          F.RM      ECD,3,X3,-24B 
          ZR        X3,SKIP 
          SX3       X1
          SET.RM    ERP,X3         SET ERROR POINTER TO (IN)
 NPE      BSS       0 
 .MD      IFEQ      #BETA#,0
          F.RM      WSA,3 
 .MD      ELSE
          F.RM      WSAD,3
 .MD      ENDIF 
          SET.RM    UWD,X3         INITIALIZE USER WORD POINTER TO WSA
          SET.RM    UCP,0          ZERO USER CHAR POS 
          F.RM      FP,B2 
          SB3       #EOI# 
          GERR.SQ   100B,(EQ B2,B3) READ AFTER EOI
          SET.RM    ISD,0 
          F.RM      RTJG,B6 
          NZ        B2,=XAINI$SQ   IF AFTER EOR, GO INITIALIZE
*#
*         BUT IF IN THE MIDDLE OF A RECORD, DO A VARIETY OF THINGS
*     DEPENDING ON RT=Z AND PRD.
*#
          SET.RM    ISD,1                                               0016   6
          F.RM      OUT,B3         PICK UP OUT POINTER
          F.RM      RRL            PICK UP RECORD LENGTH REQUESTED
          F.RM      RPTL,4
          F.RM      RL,3           PICK UP CHARACTERS ALREADY MOVED 
          IX1       X1-X3          REDUCE RL BY CHAR MOVED
          F.RM      PRD,3 
          PL        X3,SETDEL      IF NOT PARTIAL, GO SKIP TO EOR 
          F.RM      GPS,3 
          NG        X3,SETDEL      IF GETP SKIP, GO SKIP TP EOR 
          IX3       X4-X1 
          SX2       B0
          NG        X3,USEPTL      IF PTL<REQ, GO MOVE REC
          BX2       X3
          BX4       X1             ELSE,SUBSTITUTE REQ FOR PTL
          NZ        X1,USEPTL      JUMP IF RL"RCC (NOT EOR) 
          F.RM      CRF,3          RL=RCC, IF CRF=0 WE ARE AT EOR 
          NG        X3,=XAMAC$SQ   ELSE, WE ONLY FINISHED A WCR PIECE 
 USEPTL   BSS       0 
          F.RM      RT,3,X3,-#ZT# 
          ZR        X3,=XAMAC$SQ
          SB6       =YRMU1$SQ 
          EQ        =XAMAC$SQ      GO MOVE RECORD 
          SPACE     1 
 SETDEL   BSS       0 
          BX4       X1             SETMOVE COUNT TP REMAINING 
          SET.RM    DEL,1          SET DEL FLAG 
          F.RM      RT,3,X3,-#ZT# 
          ZR        X3,=XAMAC$SQ
          SB6       =YRMU0$SQ      ELSE, SET RETURN TO MOVE 
          EQ        =XAMAC$SQ 
* CALL AMAC AND THEN WORK ON APPROPRIATE RECORD TYPE
 AMAC$SQ  TITLE     GET AS MUCH AS CONVENIENT 
*#
*         AMAC  STANDS FOR "AS MUCH AS CONVENIENT".  IT REFERS TO THE 
*     CHUNK OF CODE FROM AMAC$SQ THROUGH AJPB6.  AUXILIARY CHUNKS OF
*     CODE INCLUDE RMA.GMD, AND RMA.GNB, WHICH ARE DESCRIBED
*     BELOW.  THE PURPOSE OF AMAC IS TO FIND OUT HOW MUCH DATA IS 
*     IMMEDIATELY (AND CONTIGUOUSLY) AVAILABLE IN THE BUFFER. 
*     THE AMOUNT OF SPACE FROM START OF BLOCK TO NEXT BOUNDARY IS 
*     KEPT IN FIELD STM OF THE FIT. 
*         FIRST  BL IS COMPARED TO BL. IF NOT EQUAL THEN EXIT.
*     IF EQUAL THEN A BOUNDARY HAS BEEN HIT AND A NEW STM MUST BE 
*     CALCULATED. THE CODE AND STATUS IS CHECKED FOR PARITY ERROR 
*     AND APPROPRIATE POINTERS ARE SET. THEN A NEW STM IS CALCULATED
*     BASED ON STOPPING AT THE NEXT BOUNDARY THAT WILL BE ENCOUNTERED.
*     THE BOUNDARIES ARE: 
*         LIMIT     END OF THE BUFFER 
*         ERP       START OF PHYSICAL BLOCK CONTAINING PARITY ERROR 
*         ERE       END   OF PHYSICAL BLOCK CONTAINING PARITY ERROR 
*         IN        END   OF DATA IN BUFFER 
*         BLP       NEXT S-TAPE CONTROL WORD
*         BL=MBL    END OF BLOCK
* 
*         AINI$SQ  INITIALIZES THINGS FOR THE RECORD. B3 IS SET TO OUT
*     AND WILL BE MAINTAINED AS A POINTER TO CURRENT POSITION IN BUFFER.
*     FILE POSITION IS SET TO ZERO TO INDICATE MID-RECORD.
*     IF BT=K/E, GET$K IS ENTERED ELSE AMAC$SQ IS ENTERED 
*0    INPUT - AMAC$SQ 
*         B3        WHERE WE ARE IN THE BUFFER
*0    OUTPUT
*         B3        WHERE WE ARE IN THE BUFFER
*         X2        NUMBER OF AVAILABLE CHARACTERS
*0    UNCHANGED 
*         B6     RETURN ADDRESS 
*         B1,A0,B7
*         X4     PRESERVED FOR GET$FU 
*#
* INITIAL ENTRY POINT FOR AMAC
 AINI$SQ  BSS       0 
          F.RM      OUT,B3
          SET.RM    FP,0
          EK.SQ     =YGET$K 
  
* COMMON POINT
 AMAC$SQ  BSS       0 
          F.RM      STM,X2         STOP MOVE WHEN BL=STM
          F.RM      BL,X3 
          IX7       X3-X2 
          IX2       X2-X3          AMOUNT AVAILABLE 
          MI        X7,AJPB6       IF SOME AVAILABLE
  
 GTMR$SQ  BSS                      GET MORE 
          F.RM      FEC,X1,-4 
          ZR        X1,RPE
          SX1       X1-10B
          NZ        X1,RMANRD1     IF NOT PARITY, SKIO
 RPE      BSS       0 
          OFF.RM    IPF,RPE1       READ ANOTHER PARITY ERROR BLOCK
*                                  WHILE PROC A PARITY ERROR BLOCK
          SET.RM    SPR,1          SUPPRESS READ-AHEAD
RPE1      BSS       0 
          F.RM      IN,A1 
          SX1       X1
          SB4       RMANRD1        (RETURN FROM SKIP) 
          F.RM      ECD,3,X3,-24B 
          ZR        X3,SKIP 
          SET.RM    ERP,X1,,3      SET ERROR POINTER TO (IN)
          SET.RM    ERE,A1,,3      SET ERROR END TO IN
 RMANRD1  BSS       0 
  
          F.RM      LIMIT,B4
          NE        B3,B4,NOTLIM
          F.RM      FIRST,B3       FIRST -> HERE
 NOTLIM   BSS 
  
 #EREP#   MICRO     1,,/0,27D,36D,24D,1,1/  PARITY ERR PTRS        G
 EREP     COMPOSED  ERE,18,ERP,18 
          F.RM      EREP,X2 
          ZR        X2,NOERP       IF BOTH ERE AND ERP ARE ZERO 
          LX2       -18 
          SB2       X2             ERE
          LT        B2,B3,NOERE 
          EQ        B3,B2,ERRE     IF HIT ERE 
          SB4       B2
NOERE     BSS       0 
          LX2       18
          SB2       X2             ERP
          LT        B2,B3,NOERP 
          GT        B2,B4,NOERP 
          EQ        B3,B2,RMA$ERR   IF HIT ERP
          SB4       B2
 NOERP    BSS       0 
  
          F.RM      IN,B2 
          LT        B2,B3,NOTIN 
          EQ        B3,B2,RMA.GMD  IF HIT IN, GET MORE DATA 
          GT        B2,B4,NOTIN 
          SB4       B2+0
 NOTIN    BSS 
  
*     TIMES 10
          SX1       B4-B3 
          IX2       X1+X1 
          LX1       3 
          IX2       X1+X2 
          F.RM      BCC 
          IX2       X2-X1 
          F.RM      BLP,B2
          OFF.RM    SOL,TESTBL     IF SCOPE 
          EQ        B3,B2,RMA.GNB  IF HIT BLP, GET NEXT BLOCK 
          BUFSP     B,3,2,3 
          SB5       B3+X3          ALLOWS FOR BLP=FIRST 
          GT        B5,B4,NOTEOB
          SB4       B2             USE BLP
*     TIMES 10
          IX2       X3+X3 
          LX3       3 
          IX2       X3+X2 
          F.RM      BCC 
          IX2       X2-X1 
*     IF YOU ARE STOPPING AT THE END OF A BLOCK THAT DOES NOT END 
*     ON A WORD BOUNDRY, THEN SUBTRACT OFF  EBC  AND SET  ISD  TO 
*     INDICATE THE POSSIBILITY OF INSUFFICIENT DATA.
          F.RM      EBC,X3
          IX2       X2-X3          CHARACTERS AVAILABLE 
          NZ        X2,NOTEOB 
          SB3       B4
          SET.RM    BCC,0 
          EQ        RMA.GNB 
  
 TESTBL   BSS 
          F.RM      MBL,3 
          ZR        X3,NOTEOB      MBL=0, NO BLOCK LENGTH CHECK 
          F.RM      BL
          IX1       X3-X1 
          IX3       X1-X2 
          PL        X3,NOTEOB      IF MBL-BL .GE. STOPAT, USE STOPAT
          OFF.RM    SOL,BLSC
          SX7       10
          IX3       X3+X7          ALLOW FOR S/L CW 
          PL        X3,NOTEOB      AND TEST AGAIN 
          IX1       X1+X7 
 BLSC     BSS 
          ZR        X1,RMA.GNB
          BX2       X1             USE MBL - BL 
 NOTEOB   BSS       0 
  
*     HERE IS SOME CODE THAT IS ALMOST USELESS.  IT INSURES THAT THE
*     AMOUNT TO MOVE IS LESS THAN 2**17.  IT WAS OPTIMIZED FOR SPACE. 
*     TWO CASES:             N<2**16   N\2**16
          MX7       -16 
          BX1       X7*X2       0      [N/2**16]"0
          BX7       -X7*X2      N      0@MOD(N,2**16)<2**16 
          AX1       8           0      2**8@[N/2**16]/2**8@2**16
          IX2       X1+X7       N      2**8 @ X2 < 2**17
  
          F.RM      BL,X3 
          IX3       X3+X2 
          SET.RM    STM,X3,,,CHOP  BL+AVAIL 
  
 AJPB6    BSS       0 
          SET.RM    ISD,1 
          JP        B6             GO TO RT ROUTINE 
 RMA.GMD  TITLE  GET MORE DATA
*#
*0        GMD STANDS FOR GET MORE DATA. CONTROL COMES HERE WHEN B3
*     (OUT) REACHES IN. THEREFORE IT"S TIME TO GET MORE DATA IN THE 
*     BUFFER. IF THE FILE IS BUSY, RECALL OF COUNT=1 IS USED TO WAIT
*     FOR IN TO MOVE. IF THE FILE IS NOT BUSY, CODE AND STATUS IS 
*     CHECKED FOR ERRORS, END OF VOLUME, END OF FILE, END OF RECORD,
*     OR END OF INFORMATION AND THE PROPER PROCEDURE EXECUTED IF FOUND. 
*     IF NONE FOUND, ISSUE CIO READ/READNS AND LOOP BACK TO WAIT FOR
*     IN TO MOVE. 
*#
*     ENTRY POINT FOR HERE=IN - GET (READ) MORE DATA
 RMA.GMD  BSS       0 
          SET.RM    OUT,B3
          F.RM      BCC,X2
          ZR        X2,SCWAIT 
          BUFINC    B,3,1,2                                             0022   6
          SET.RM    OUT,X2                                              0022   7
          SB3       X2                                                  0022   8
          SET.RM    BCC,0          GET ONTO WORD BOUNDRY
          EQ        SCWAIT
          SPACE     1 
LOOPRCL   BSS       0 
          RCL.RM    1,COUNT 
 SCWAIT   BSS       0 
          SA2       A0
          F.RM      IN,B2 
          NE        B2,B3,GTMR$SQ  WHEN IN MOVES
          LX2       59-0
          PL        X2,LOOPRCL     IF FILE STILL BUSY 
*     CHECK FOR ABNORMAL CONDITIONS 
          SA1       A0
          SX2       34000B         SET ERROR MASK TO AVOID EOI/EOR
          SB5       ERRXIT
          BX3       X2*X1 
          SX2       X3-10000B 
          ZR        X3,NOERR       IF NO ERROR, SKIP
          GERR.SQ   720B,(ZR X2)   DEVICE CAPACITY EXCEEDED 
          SX2       X2-4000B
          ZR        X2,NOERR       IF PARITY AND DCE,JUMP 
          SX2       X2+10000B 
          GERR.SQ   721B,(NZ X2)   OTHER SCOPE ERROR
 NOERR    BSS       0 
          ON.RM     SOL,SOLBLP
          SA1       A0             -- SCOPE --
          SX3       010B           SCOPE READ CODE
          LX1       59-4
          PL        X1,ZEROPAE
*     2X OR 3X IN FET STATUS
          OFF.RM    PAE,ISD        GO HANDLE I.S.D. OR DATA EXIT
          OFF.RM    ESF,ZEROPAE 
          F.RM      MBL,2 
          SET.RM    BL,X2 
 ZEROPAE  BSS       0 
          SET.RM    PAE,0          OR READ AFTER EOS/EOF
*     1X WITH EMPTY BUFFER
          SA1       A0
          LX1       49
          NG        X1,TJEOV       ALWAYS CHECK FOR END OF VOLUME 
          SYSY      X3             ------- READ 
          EQ        SCWAIT
          SPACE     1 
*     TAKE CARE OF INSUFFICIENT DATA, S-RECORDS, DATA EXIT. 
 ISD      BSS       0 
          ON.RM     ISD,INSUF 
          OFF.RM    ESF,KEEOF                                           0043   6
          F.RM      MBL,2 
          SET.RM    BL,X2 
          EQ        DXITA                                               0043   8
          SPACE     1 
 KEEOF    BSS       0 
          F.RM      RB,2
          SET.RM    KRN,X2
          SA1       A0
          LX1       59-3
          NG        X1,DXITA       EOF ON K/E 
          SET.RM    PAE,1 
          EQ        SCBLK 
          SPACE     1 
 INSUF    BSS       0 
          F.RM      RL,X3 
          ON.RM     SOL,CKRCCMNR   C-BLOCKS ON SCOPE DEVICES CAN HAVE 
          F.RM      BT,X1,-#CT#    9 CHARS PADDING SINCE THEY MUST BE ON
          NZ        X1,CKRCCMNR    WORD BOUNDARIES.  MORE THAN 9 CHARS
          SX7       X3-10          IS INSUF DATA. 
          PL        X7,DO143
 CKRCCMNR BSS       0 
          F.RM      RT,X1 
          SX1       X1-#FT#        FOR F-TYPE RECORD
          NZ        X1,CHKMNR 
          OFF.RM    SOL,CHKBL      AND NOT S/L TAPE 
CHKMNR    BSS       0              REGARDLESS MNR VALUE 
          F.RM      MNR 
          IX7       X3-X1          RCC-MNR
          PL        X7,DO143
CHKBL     BSS       0              DATA EXIT IF EOS FLAG SET
          F.RM      BL             BLOCK LENGTH 
          IX2       X3-X1          IF THE NUMBER OF CHARS = RL
          SOL*10    X2,+           DECREMENT BY SOL CW IF THERE 
          ZR        X2,DO143       THEN INSUFFICIENT DATA.......
* RCC<MNR (PADDING) 
 GPAD$SQ  BSS       0 
          SET.RM    RL,0
          ON.RM     ESF,DXITA 
          INC.RM    RQS,X3         (BY RCC) 
          SET.RM    PTL,0 
          OFF.RM    SOL,KEEOF 
          SET.RM    PAE,1 
          SET.RM    FP,#EOR#
          EQ        GCNT$SQ 
          SPACE     1 
 DO143    BSS       0 
          SET.RM    KRN,0          CLEAR BEFORE NEW BLOCK 
          ON.RM     DEL,GEEXIT
          SET.RM    RRL,X3
          F.RM      GEN 
          NZ        X1,GEEXIT           ERROR ALREADY SET 
          SET.RM    GEN,143B
          EQ        GEEXIT
          SPACE     1 
 SKIP     BSS       0 
          SB2       X1                                                  0013  12
          SET.RM    IN,X1,,3
          SX1       B1+B1          2B 
          SA2       A0
          BX7       X1-X2 
          SA7       A2
          SYSY      120B,R
          SX3       B1
          SX4       B0
          SYSY      44B,R,3,4 
          SET.RM    PAE,1 
          F.RM      MBL,X3
*         COMPARE PRUSIZE TO BFS (OPEN CHANGED PRUSIZ)
          F.RM      BFS,4 
          F.RM      PRUSIZ,3
          IX3       X3-X4          PRUSIZE-BFS
          PL        X3,BFSERR      PRUSIZE\BFS
          JP        B4
          SPACE     1 
 BFSERR   SX6       354B           INSUF BFR SPACE ERROR
          EQ        =XERR$RM
 RMA.GNB  TITLE  GET NEXT BLOCK 
*#
*0        GNB STANDS FOR GET NEXT BLOCK. CONTROL COMES HERE FOR B3
*     (OUT) = BLP FOR S/L DEVICES OR FOR BL=MBL FOR PRU DEVICES.
*         FOR S/L DEVICES, THE CONTROL WORD IS PROCESSED AND A NEW
*     BLP IS SET, BL IS SET TO 10 FOR CONTROL WORD, B3 IS INCREMENTED 
*     PAST THE CONTROL WORD, AND THEN AMAC IS ENTERED FOR BT=K/E. 
*#
* ENTRY POINT FOR HERE=BLP
 RMA.GNB  BSS       0              GET NEXT BLOCK 
          OFF.RM    SOL,SCBLK 
          F.RM      LIMIT,B2
          NE        B3,B2,STOUT 
          F.RM      FIRST,B3
 STOUT    BSS       0 
          SET.RM    OUT,B3
 SOLBLP   BSS       0 
          CI.SQ      SICOK
          ON.RM     ISD,ISD 
 SICOK    BSS       0 
          F.RM      IN,B2 
          NE        B2,B3,SOLNORD  IF BUFFER NOT EMPTY
          SA2       A0
          LX2    59-0 
          NG     X2,NOTBUSY  IF FILE HAS COMPLETED
          RCL.RM 1,COUNT     WAIT AND LOOP UNTIL COMPLETE 
          EQ     SICOK       OR DATA AVAILABLE
 NOTBUSY  LX2    60+0-9 
          NG        X2,DXITA       EOI-TAKE DATA EXIT 
          LX2       9-3            EOF BIT TO BIT 59
          F.RM      PAE 
          BX2       -X1*X2
          NG        X2,DXITA       CS = EOF AND PAE OFF 
          SX3       260B           S/L TAPE READ CODE 
          SET.RM    BLP,B3
          EQ        ZEROPAE 
          SPACE     1 
 SOLNORD  BSS       0 
          SET.RM    PAE,0 
*     SET EBC AND BLP 
          SA1       B3             S/L CONTROL WORD 
          SB5       X1+B1          HOW FAR TO NEXT CONTROL WORD 
          MX3       30
          SX7       43691          1/6
          BX1       -X3*X1         EXTRACT UNUSED BIT COUNT 
          IX3       X7*X1 
          AX3       18+24          DIVIDE BY 6
          SET.RM    EBC,X3
          SET.RM    BL,10,,3       RESET BL 
          BUFINC    B,3,5,2 
          SB4       X2
          BUFINC    B,3,1,2 
          SB3       X2
          SET.RM    BLP,B4
 SCBLK    BSS       0 
* CALL THE APPROPRIATE BLOCK HANDLER,RETURN AT RMAMAC 
          EK.SQ     GTMR$SQ 
*#
*0        BT=C                                                           PBTRSDO
*                IF THE FILE IS ON A SCOPE DEVICE AND *OUT* IS EQUAL
*                TO *LIMIT* THE FILE IS UNBLOCKED AND WE BRANCH TO
*                *ANBL$SQ* IN *GET$SQ* AFTER SETING *OUT* EQUAL TO
*                *FIRST*.  ELSE SET THE BLOCK 
*                POINTER (BLP) TO *OUT+MBL* (SINCE EACH C-BLOCK IS       PBTRSDO
*                EXACTLY *MBL* WORDS).  BRANCH TO *ANBL$SQ* IN *GET$SQ*.
*0        BT=I                                                           PBTRSDO
*                IF THE FILE IS ON A SCOPE DEVICE, SET THE BLOCK POINTER PBTRSDO
*                (BLP) TO *OUT+MBL* (SINCE EACH I-BLOCK IS EXACTLY *MBL*
*                WORDS) AND INCREMENT *OUT* BY ONE TO ACCOUNT FOR 
*                THE I-BLOCK CONTROL WORD. IF THE CHECKSUM BIT (58) IS   PBTRSDO
*                ON, THE WORD AFTER THE I-BLOCK CONTROL WORD CONTAINS    PBTRSDO
*                THE CHECKSUM SO INCREMENT *OUT* BY 1 TO GET PAST IT.    PBTRSDO
*                BRANCH TO *ANBL$SQ* IN *GET$SQ*. 
*#
          SX3       10
          ON.RM     SOL,SORL                                             SEPT2
          SA1       A0+4
          SB4       X1
          BX3       0              BL=0 
          NE        B4,B3,SORL     IF MBL .NE. 0 (OUT"LIMIT) ITS BLOCKED
          SA1       A0+B1 
          SB3       X1
          EQ        SBL 
          SPACE     1 
 SORL     BSS       0                                                    SEPT2
          NE.RM     BT,#IT#,SBL,B4 JUMP IF BT=C 
          ZR        X2,GTMR$SQ     IF NO CHARACTERS AVAILABLE 
          SX3       X3+10          ALLOW FOR I BLOCK CW 
          BUFINC    B,3,1,6        POSITION OVER ICW
          SB3       X6
 SBL      BSS       0 
          SET.RM    BL,X3 
  
 ANBL$SQ  BSS       0 
          INC.RM    BN,1
          SET.RM    BCC,0 
          EQ        GTMR$SQ 
 RMA.ERR  TITLE  READ ERROR 
*#
*0       CONTROL COMES TO RMA$ERR WHEN B3=ERP, MEANING THAT THE PHYSICAL
*     BLOCK OR PRU THAT CONTAINS A PARITY ERROR HAS BEEN REACHED. 
*     THE ROUTINE RPE$SQ IS LOADED AND EXECUTED TO HANDLE THE PARITY
*     ERROR.
*0        ERRE IS ENTERED WHEN B3=ERE, MEANING THE END OF THE 
*     PARITY ERROR BLOCK HAS BEEN REACHED. ERE AND IPF (INTERNAL
*     PARITY FLAG) ARE CLEARED SO NO MORE RECORDS ARE FLAGGED AS
*     PARITY RECORDS. 
*#
 RMA$ERR  STO.REG 
          LGO.RM    PLRPE          GO TO RPE$SQ 
  
 PLRPE    FAKEPL    =XRPE$SQ       STATIC- FORCE LOAD, DYN- ADDR
  
          IS.IN 
ERRE      BSS       0 
          SET.RM    ERE,0 
          SET.RM    IPF,0 
          EQ        GTMR$SQ 
*#
*0        CONTROL COMES TO TJEOV WHEN IN=OUT AND THE EOV FLAG IS SET IN 
*     THE CODE AND STATUS. CRITICAL REGISTERS ARE SAVED AND CLSV$SQ 
*     IS LOADED AND EXECUTED. REGISTERS ARE RESTORED AND GET-MORE-DATA
*     IS CALLED.
*#
 TJEOV    BSS       0 
          MX1       42
          BX7       X"XREG.RM"
          BX4       -X1*X4
          SA7       A0+"FWRD.RM"
          LX4       24
          MX7       36
          BX7       -X7*X5
          BX7       X7+X4 
          SX1       B6
          LX7       18
          BX4       X7+X1 
          SET.RM    STASH,X4
          OFF.RM    SOL,SCEOV                                           0007   8
          F.RM      RB,X4,-1                                            0028  13
          NG        X4,SCEOV
          SET.RM    KRN,X4                                              0007  10
 SCEOV    BSS       0                                                   0007  11
          CLSV$SQ   GET 
          F.RM      STASH,4        RESET POINTERS FOR RMU1
          SB6       X4
          AX4       18
          MX5       36
          BX5       -X5*X4
          AX4       24
          SA1       A0+"FWRD.RM"
          BX"XREG.RM" X1                                                000160
          F.RM      OUT,B3
          SET.RM    FP,0
          EQ        SCWAIT         GO BACK AND READ 
          TITLE  DATA EXIT + ERROR EXIT 
 ERRXIT   BSS       0                                                   000760
          F.RM      EX,B2          ERROR EXIT 
          EQ        RJSIM          SIMULATE RJ
          SPACE     1 
 DXITA    BSS       0 
          SET.RM    STM,0 
          SET.RM    KRN,0          CLEAR BEFORE NEXT BLOCK
          SA1       A0
          MX2       60-4
          LX1       59-13          RIGHT-JUSTIFY LEVEL NO.
          BX2       -X2*X1
          SET.RM    LVL,X2,,3 
          SX2       #EOI# 
          LX1       13-9           EOI BIT
          NG        X1,DXIT 
          LX1       9-3            EOF BIT
          SX2       #EOF# 
          NG        X1,DXIT 
          SX3       10B 
          EQ.RM     RT,#WT#,ZEROPAE 
          SX2       #EOS# 
 DXIT     SET.RM    PAE,1 
 DXIT$SQ  BSS       0 
          SET.RM    FP,X2 
          F.RM      DX,B2          DATA EXIT
          F.RM      SKP 
          BX6       X1             (X6 SET HERE FOR SKBL$SQ)
          SET.RM    RL,0
          SET.RM    PTL,0 
 RJSIM    BSS       0              SIMULATE RJ
          SA1       A0+7
          SB6       X1
          AX1       18
          ZR        X1,POPPED 
          SB6       X1
 POPPED   MX7       0 
          SA7       A1             ZERO STACK 
          F.RM      LIMIT,B4
          NE        B4,B3,STOROUT  IS OUT=LIMIT.... 
          F.RM      FIRST,B3       YES.. SET OUT=FIRST
 STOROUT  BSS       0              NO.. SET OUT=(B3)
          SET.RM    OUT,B3
          EQ        B0,B2,RTURN 
          ON.RM     SBF,RTURN 
          SX2       40B            ELSE,
          SX7       B6             PUT EQ TO B6 9+NDX 
          LX2       21
          BX7       X7+X2 
          LX7       30
          SA7       B2
          BX7       X"XREG.RM"
          SA7       A0+"FWRD.RM"
          JP        B2+1           GO TO DX 
*#
*         NOW WE ARE
*     LOOKING AT HOW GET$SQ SHUTS DOWN.  FIRST, FILE POSITION HINGES
*         ON RL VERSUS RRL:  IF EQUAL, FP=EOR AND THE RECORD COUNT IS 
*     INCREMENTED.  IF DEL WAS SET DURING A GET, START OVER BECAUSE 
*     THERE IS STUFF TO SKIP OVER.  IF THERE WERE ANY ERRORS (LIKE
*     EXCESS/INSUFFICIENT DATA) NOW IS THE TIME TO SIGNAL THEM (I. E.,
*     AFTER THE RECORD HAS BEEN COMPLETELY PASSED OVER).
*#
 GXIT$SQ  BSS       0 
          ON.RM     DEL,GEEXIT
          F.RM      RRL,X3
          F.RM      RL,X1 
          IX4       X3-X1          SET REQUEST TO RRL-RL
          NZ        X4,NOTEOR 
          F.RM      CRF 
          NG        X1,NOTEOR 
 GEEXIT   BSS       0 
          INC.RM    RC,1           ELSE,ADD ONE TO RECORD COUNT 
          SET.RM    FP,#EOR#       FILE POS = END-OF-RECORD 
 NOTEOR   BSS       0 
          F.RM      LIMIT,B2
          LT        B3,B2,OUTOK    IF OUT = LIMIT,
          F.RM      FIRST,B3       SET OUT TO FIRST 
 OUTOK    BSS       0              ELSE.
          SET.RM    OUT,B3         SAVE OUT POINTER 
          F.RM      DEL,3          PICK UP DELETE FLAG
          F.RM      GSF            PICK UP GET/SKIP FLAG
          BX1       X1*X3          AND FLAGE
          NG        X1,CONTRD1     IF BOTH SET START OVER 
          RESTORE 
          F.RM      GEN,X6
          NZ        X6,GERR 
*#
*     AND NOW WE SHOULD THINK ABOUT KEEPING THE I/O GOING 
*0D   HOW THE DECISION IS MADE TO READ AHEAD. 
*     IF ANY OF THE FOLLOWING CHECKS FAIL, READ-AHEAD WILL NOT BE 
*     PERFORMED:  
* 
*#
          SA2       A0             RELOAD X2 WITH FET+0 
*#
*         CHECK FOR THE FILE BEING NOT BUSY 
*#
          LX2       59
          PL        X2,RTURN
*#
*         CHECK SURPRESS READ AHEAD FLAG
*#
          F.RM      SPR 
          NG        X1,RTURN
          F.RM      IN,3
          SX4       B3-B1          OUT-1 (TO CATCH EMPTY BUFFER)
          BUFSP     X,3,4,3 
*#
*         THREE-FOURTH EMPTY BUFFER NEEDED TO MAKE CIO CALL 
*#
          ON.RM     TAPE,CKMBL
          F.RM      BFS 
          IX5       X1-X3          BFS - EMPTY = FULL 
          AX1       2              BFS/4
          IX5       X1-X5          BFS/4 - FULL 
          NG        X5,RTURN       IF MORE THAN 1/4 FULL
*#
*         CHECK TO SEE IF THERE IS ENOUGH SPACE IN BUFFER 
*#
 CKMBL    BSS 
          F.RM      MBL,X4
          BX1       X3             SAVE EMPTY COUNT IN X3 
          LX1       1              EMPTY * 2
          IX4       X4-X1 
          LX1       2              *8 
          IX1       X4-X1          MBL - 10*EMPTY 
          PL        X1,RTURN
*#
*         GET DEVICE TYPE, SET FUNCTION CODE, CHECK EOR(SCOPE)
*#
          LX2       1              REPOSITION FET+0 
*#
*         CHECK RA+1
*#
          SA1       B1
          NZ        X1,RTURN
          OFF.RM    SOL,RGSCOP
          SX5       260B           SET FOR READN
          MX7       0              SET KEEP I/O ACTIVE FLAG 
          EQ        SYSRD 
          SPACE     1 
 RGSCOP   BSS       0 
          LX2       59-4           POSITION EOR BIT 
          NG        X2,RTURN       IF EOR, RETURN 
          LX2       1+4 
          SX5       010B           ELSE, SET FOR READ 
          SX7       X3-101B        SHOULD BE ENOUGH SPACE FOR 1 PRU 
 SYSRD    BSS       0 
*#
*         CHECK EOF, EOV, ERRORS
*#
          SX1       36000B         SET ERROR MASK 
          BX3       X1*X2 
          NZ        X3,RTURN       IF ERROR, RETURN 
          SX1       30B            SET EOF MASK 
          BX3       X1*X2 
          LX2       49             POSITION EOV BIT 
          BX3       X3-X1 
          ZR        X3,RTURN       IF EOF, RETURN 
          NG        X2,RTURN       IF EOV, RETURN 
*#
*     FINALLY, WE KNOW A READ AHEAD WILL BE EASY AND PRODUCTIVE, SO 
*     DO IT.   ALSO, TRUNCATE BL IF IT IS APPROACHING OVERFLOW. 
*#
          NG        X7,RTURN       DO NOT CALL CIO, NOT ENOUGH SPACE
          SYSY      X5
 RTURN    BSS       0 
          F.RM      BL
          MX7       60-22 
          BX7       X7*X1          GET BITS 22/23 OF FILES BL 
          ZR        X7,RFWRD       NO BL OVERFLOW 
          SA5       DECRT 
          IX4       X1-X5 
          SET.RM    BL,X4          RESET BL 
          F.RM      STM 
          IX4       X1-X5          DECREMENT STM BY SAME AMOUNT 
          SET.RM    STM,X4
          EQ        RTURN          CHECK BL FIELD IS NOW OK 
  
RFWRD     BSS       0 
          BX7       X"XREG.RM"
          SA7       A0+"FWRD.RM"
          JP        B6
DECRT     VFD       36/0,24/17753200B 
          SPACE     1 
 CONTRD1  BSS       0 
          SET.RM    DEL,0 
          SET.RM    GPS,0 
          SET.RM    RL,0
          EQ        GCNT$SQ 
  
          IS.IN 
 GERR     STO.REG 
          EQ        =XERR$RM
* END /GETDSQ/
