*DECK GETDWA
          IDENT     GET$WA
          COMMENT   CRM WA GET ROUTINE
          LIST      C,F,X 
          TITLE     GET$WA
          SST 
          B1=1
          ENTRY     GET$WA
*#
*1CD  GET$WA
*0D   PURPOSE 
*0        RETURN A SPECIFIED NUMBER OF WORDS FROM THE FILE IN THE USER
*         WORKING STORAGE AREA. 
*0D   CALL
*0                  SB6       RETURN-ADDRESS
*                   EQ        =XGET$WA
*0D   PARAMETERS
*         A0        FIT ADDRESS.
*         B1        1.
*         B6        RETURN ADDRESS. 
*         X0        COMM$WA-I/P (SEE COMM$WA FOR DEATILED FORMAT).
*         WSA       ADDRESS OF USER WORKING STORAGE AREA. 
*         RL        NUMBER OF WORDS TO READ.
*         EX        USER ERROR EXIT ADDRESS.
*         WA        WORD ADDRESS AT WHICH TO START READING DATA.
*0D   ACTION
*0        LOAD RL, FLUSH BUFFER IF PREVIOUS OPERATION WAS A WRITE,
*         AND CALL COMM$WA TO SEE HOW MUCH DATA IS IN THE BUFFER. 
*         CALL MOVE$RM TO MOVE WHAT COMM$WA SAID WAS AVAILABLE. 
*         CALL COMM$WA AS MANY TIMES AS NECESSARY TO MOVE RL CHARACTERS 
*         OR UNTIL AN ERROR OCCURS.  IF WA=N*100+1 AND RL=M*100, ISSUE
*         CIO READ DIRECTLY TO USER WSA.
*0D   REGISTERS USED
*0        ALL EXCEPT A0,B1,B6 
*0D   OTHER CODE REQUIRED 
*0        PROGRAMS- ERR$RM,MOVE$RM,COMM$WA,CHWR$RM
*         MACROS-   CAP.RM,SAVE,F.RM,ON.RM,INC.RM,SET.RM
*                   DEF.RM,OFF.RM,RESTORE 
*0D   NARRATIVE DESCRIPTION 
*#
 GET$WA   CAP.RM                   INITIAL CODE 
          SET.FOJ   G,B3,GET.WA 
          OFF.RM    SBF,=XRM$ABUF  ALLOCATE BUFFER,RETURN VIA B3
          EQ        GET.WA
 GET.WA   SPACE     4,8 
          CAP.RM
 GET.WA   BSS 
          SAVE
          DEF.RM    WA,1
          SET.RM    FP,0
          SET.RM    RL,0
          F.RM      RT,B2 
          SB3       #WT#
*#
*     1.1  IF W TYPE, ASK COMM$WA FOR ONE WORD, AND SET X0
*          TO INDICATE A W CONTROL WORD PASS. 
*#
          NE        B3,B2,NOTW
          SX0       10
          MX3       1 
          IX0       X3+X0 
          EQ        RLOK
 NOTW     BSS       0 
*#
*     1.2  IF F TYPE, ASK FOR FL. 
*#
          F.RM      FL,3
          SB3       #FT#
          EQ        B3,B2,RLFIX 
          F.RM      RRL,3 
 RLFIX    BSS       0 
*#
*     1.3  AT THIS POINT RL IS IN X3.  SAVE IT AND CHECK IT 
*          AGAINST MRL. 
*#
          BX0       X3
          F.RM      MRL 
          IX2       X1-X3 
          PL        X2,RLOK 
          BX0       X1
          SET.RM    ERW,142B
 RLOK     BSS       0 
*#
*     1.4  NOW REQUIRED MOVE LENGTH IS IN X0. 
*#
*#
*     2.   SET UP INPUT TO COMM$WA
*0         A0 = FET 
*          B1 = 1 
*          X0, 0-23  = RL 
*          X0, 56 = LAST OPERATION
*#
          F.RM      LOP,1,X3,-#PU#
          NZ        X3,NOTPUT 
          MX4       1 
          LX4       57
          BX0       X0+X4 
*#
*     2.1  IF LOP WAS PUT AND THERE IS SOME DATA IN THE BUFFER, 
*          IT MUST BE FLUSHED BEFORE DOING THE READ.
*#
          F.RM      CPRU,1
          ZR        X1,NOTPUT 
          F.RM      IN,B2 
          SB6       FLSHRT
          EQ        =YFLSH$WA 
 FLSHRT   BSS       0 
          SET.RM    CPRU,0
          MX7       1 
          LX7       56+1
          BX0       -X7*X0         CLAER LOP PUT BIT
 NOTPUT   BSS       0 
*#
*     3.   INITIALIZE USER WORD POINTER TO FWA OF WSA.
*#
 .MD      IFNE      #BETA#,0
          F.RM      WSAD,3
 .MD      ELSE
          F.RM      WSA,3 
 .MD      ENDIF 
          SET.RM    UWD,X3
*#
*     4.   CALL COMM$WA TO SEE WHAT'S AVAILABLE.
*#
 GETLEWP  BSS       0 
          SB6       GETRTRN 
          EQ        =XCOMM$WA 
 GETRTRN  BSS       0 
*#
*     5.   IF ANY WORDS WERE AVAILABLE, MOVE THEM TO THE USERS
*          WORK AREA. ELSE GO TO  6.
*#
*     NOTE - THE FOLLOWING ASSUMES AVAILABLE IS LE (2**17)-1
*            BECAUSE THE MOVE ROUTINE MOVES B4 CHARACTERS 
*            HOWEVER, THE RIGHTMOST X0 FIELD IS A 24 BIT FIELD. 
          MX3       -24 
          BX3       -X3*X0
          ZR        X3,NODATA 
*#
*     5.0A IF W CONTROL WORD PASS, GO TO CODE TO EXTRACT RECORD LENGTH
*#
          NG        X0,WCWSTUF
          INC.RM    RL,X3 
          MX3       -24 
          BX3       -X3*X0
          INC.RM    PTL,X3
*#
*     5.0B IF COMM$WA SPECIAL CASE, WE BRANCH AROUND THE MOVE$RM CODE 
*          SINCE WE READ THE DATA DIRECTLY INTO THE USER-S WSA
*#
          SB5       59-52 
          LX1       B5,X0 
          NG        X1,SCRET       JUMP IF SPEC CASE
          SB4       X0             CHARACTER COUNT
          F.RM      UWD,5          DEST. ADDRESS
 .MD      IFNE      #BETA#,0
          F.RM      WSAB,X4        0=SCM WSA, 1=LCM WSA 
          LX4       21
          BX5       X5+X4          INCLUDE LCM FLAG 
 .MD      ENDIF 
          SB5       B0             DESTINATION CHAR 
          SX3       B3             SOURCE ADDRESS 
*         NOTE - THIS ASSUMES MOVE.RM DOES NOT USE A4 
          SA4       B3             SAVE OLD DES ADDR FOR WA CALC
          SB3       B0             SOURCE CHAR
          SB6       MUVRT 
          EQ        =YMOVE$RM 
*#
*     5.1  UPDATE USER WORD POINTER (UWD), WA AND RL. 
*#
 MUVRT    BSS       0 
          SB3       X3             RESET CURRENT ADDRESS
          ZR        X4,CUROK
          SB3       B3+B1          INCREMENT FOR PARTIAL WORD 
 CUROK    BSS       0 
          SB2       A4             RESTORE OLD DES ADDR 
          SET.RM    UWD,X5         RESET WSA ADDRESS
 SCRET    BSS       0 
          SX3       B3-B2          NEW DES - OLD DES = WAINC
          INC.RM    WA,X3 
* 
 NODATA   BSS       0 
*#
*     6.0  IF RESIDUE IS ZERO, RETURN. ELSE CHECK END CONDITIONS. 
*#
          MX5       24
          LX5       48
          BX4       X0*X5 
          SB4       B1+B1 
          NZ        X4,NOXIT
          MX2       1              TURN 
          LX2       54             OFF
          BX0       -X2*X0         INSUFFICIENT DATA FLAG 
          EQ        EXITG 
 NOXIT    BSS       0 
*          IF EOI GO TO  8, IF EOS, GO TO  9. ELSE NEXT STEP. 
          LX3       B1,X0          CHECK EOI
          LX2       B4,X0 
          AX4       24
          NG        X3,EOIEXIT
          NG        X2,EOSEXIT
*#
*     7.   NOT EOI OR EOS, MAKE ANOTHER ATTEMPT TO MOVE 
*         THE RESIDUE.
* 
*          PUT RESIDUE IN RL PART, AND ZERO RESIDUE PART OF X0. 
*          SET LOP INDICATOR TO GET.
* 
* 
*         SET INSUFFICIENT DATA FLAG IN CASE ATTEMPT FAILS. 
*#
          MX2       1 
          LX2       57
          BX0       -X2*X0
          MX5       12
          AX2       3 
          BX0       X5*X0 
          BX4       X2+X4 
          BX0       X0+X4                                               0002   7
          EQ        GETLEWP 
 EOIEXIT  BSS       0 
          SX2       #EOI# 
          F.RM      EOIWA,3 
          F.RM      WA
          IX3       X3-X1 
          SX6       120B            SET ERROR CODE FOR INVALID WA 
          NG        X3,ERRXIT 
*#
*     8.   END CONDITION WITH NONZERO RESIDUE.
*          IF RL=0, NO DATA WAS TRANSFERRED, GO TO
*          END OF DATA EXIT. ELSE, RETURN ISD ERROR.
*#
 DATEXIT  BSS       0 
          F.RM      RL,3
          SET.RM    LOP,#GE#
          ZR        X3,DATEXIT1 
          SET.RM    ERW,143B
          SET.RM    FP,#EOR#
          EQ        EXITG 
* 
 DATEXIT1 BSS       0 
          SET.RM    FP,X2 
          RESTORE 
          F.RM      DX,1
          ZR        X1,EXITD
* 
          SX6       02B            SET UP DATA EXIT.
          SX4       B6
          LX6       24
          BX6       X4+X6 
          LX6       30
          SA6       X1
          SB6       X1+B1 
 EXITD    BSS       0 
          JP        B6
*#
*     9.   EOS WITH NONZERO RESIDUE.
*#
 EOSEXIT  BSS       0 
          SA3       A0             *CHECK IF EOS OR EOP 
          SX2       #EOS# 
          LX3       59-3           *CHECK CIO STATUS CODE 
          PL        X3,DATEXIT
          SX2       #EOP#          *IF EOP, RESET X2 TO #EOP# 
          EQ        DATEXIT 
 EXITG    BSS       0 
          SET.RM    LOP,#GE#
*#
*          IF DATA ERROR - TAKE EXIT, ELSE RETURN TO USER 
*#
          SET.RM    FP,#EOR#
 EXITNR   BSS       0 
          F.RM      ERW,"ERRREG"
          ZR        "ERRREG",XIT
          SET.RM    ERW,0,7,1      ZERO ERW FOR NEXT GET (USE REG X7,X1)
 ERRXIT   BSS       0 
          EQ        =XERR$RM
 XIT      BSS       0 
          RESTORE 
          JP        B6
*#
* 
*     5.0B GET RL FROM WCW, CLEAR X0 W BIT. IF RL .NE. 0 AND IF NOT A 
*          DELETED RECORD, GO BACK TO MOVE DATA.
*#
 WCWSTUF  BSS       0 
          SET.RM   LOP,#GE#                                             T39A 242
          INC.RM    WA,1
          SA5       B3             PICK UP WCW
          CX2       X5
          LX2       59
          S"ERRREG" 130B
          PL        X2,ERRXIT      WCW PARITY ERROR 
          LX4       B1,X5          POSITION FLAG BIT
          PL        X4,NOTFLG 
          LX4       1              POSITION DELETE BIT
          SX2       #EOP# 
          PL        X4,DATEXIT1 
          SX2       #EOS# 
          EQ        DATEXIT1
 NOTFLG   BSS       0 
          LX4       1              POSITION DELETE BIT
          SX3       X5             PICK UP WORD COUNT 
          NG        X4,DELT 
          ZR        X3,EXITG
          NG        X3,ERRXIT      WORD COUNT .GT. 131071 
          IX4       X3+X3          WC*2 
          LX3       3              WC*8 
          IX3       X3+X4          CC 
          AX5       18+2           GET BIT COUNT AND START DIVISION BY 6
          MX4       60-4
          BX5       -X4*X5
          SX4       X5+B1          1
          IX5       X4+X4          2
          IX5       X5+X4          3
          LX4       3              8
          IX5       X5+X4          11 
          AX5       4              /16
*         ABOVE METHOD IS ACCURATE FOR MULT OF 6
          IX3       X3-X5          LESS UNUSED CHAR 
          EQ        RLFIX 
 DELT     BSS       0              IF RECORD DELETED
          INC.RM    WA,X3          UPDATE  WA 
          EQ        RLOK           TRY AGAIN
          END 
