*DECK PUTDWA
          IDENT     PUT$WA
          COMMENT   CRM WA PUT ROUTINE
          LIST      C,F,X 
          TITLE     PUT$WA
          SST 
          B1=1
*#
*1CD  PUT$WA
*0D   PURPOSE 
*0        WRITE A SPECIFIED NUMBER OF WORDS FROM THE USER WORKING 
*         STORAGE AREA TO THE FILE AT A SPECIFIED WORD ADDRESS. 
*0D   CALL
*0                  SB6       RETURN-ADDRESS
*                   EQ        =XPUT$WA
*0D   PARAMETERS
*0        A0        FIT ADDRESS.
*         B1        1.
*         B6        RETURN ADDRESS. 
*         X0        COMM$WA-I/P (SEE COMM$WA FOR DEATILED FORMAT).
*         WSA       USER WORKING STORAGE ADDRESS. 
*         RL        NUMBER OF WORDS TO WRITE. 
*         EX        USER ERROR EXIT ADDRESS.
*         WA        WORD ADDRESS AT WHICH TO START WRITING. 
*0D   ACTION
*0        PUT$WA CALLS COMM$WA TO SEE HOW MUCH SPACE IS IN THE BUFFER 
*         THEN CALLS MOVE$RM TO MOVE THAT MANY CHARACTERS. PUT$WA CALLS 
*         COMM$WA AND MOVE$RM AS MANY TIMES AS NECESSARY TO MOVE RL 
*         CHARACTERS OR UNTIL AN ERROR OCCURS.
*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,OFF.RM,INC.RM,DEF.RM,SET.RM,RESTORE
*0D   NARRATIVE DESCRIPTION 
*#
 PUT$WA   CAP.RM                   FIRST TIME ONLY
          SET.FOJ   P,B3,PUT.WA 
          OFF.RM    SBF,=XRM$ABUF  ALLOCATE BUFFER,RETURN VIA B3
          F.RM      WSA,X6
          SET.RM    FIRST,X6       FIRST = WSA
          SA6       A7+B1          IN = WSA 
          SA6       A6+B1          OUT = WSA
          F.RM      RRL,X3
          NZ        X3,DIVIDE 
          F.RM      MRL,X3
 DIVIDE   BSS       0 
          SX7       52429 
          IX3       X3*X7 
          AX3       19               DIVIDE RRL BY 10 
          SET.RM    BFS,X3         BFS = RRL/10 
          IX3       X6+X3            RRL/10 + WSA 
          SX7       B1
          IX3       X3+X7          LIMIT = WSA + RRL/10 + 1 
          SET.RM    LIMIT,X3
          EQ        PUT.WA
 PUT.WA   SPACE     4,8 
          CAP.RM
 PUT.WA   BSS 
          SAVE
          DEF.RM    WA,1
          SET.RM    FP,0
          SET.RM    RL,0
*#
*          IF MRL=0, ANY RECORD LENGTH IS OK. 
* 
*     2.1  FIND RECORD LENGTH, IN WORDS.
*#
          MX5       0 
          F.RM      RT,B4 
          SB3       #FT#
          EQ        B3,B4,FRECS 
          F.RM      RRL,3 
          EQ        ALLRECS 
 FRECS    BSS       0 
          F.RM      FL,3
 ALLRECS  BSS       0 
          BX6       X3             SAVE RL
*#
*     2.2  FIND MRL, IN WORDS, FOR RL CHECK AGAINST MRL.
*#
          F.RM      MRL,3 
*#
*     2.3  IF RL .GT. MRL, THEN ISSUE 142B ERROR. 
*#
          ZR        X3,RLOK        IF MRL ZERO, ANY LENGTH OK 
          IX3       X3-X6          X6 IS RL, SAVED FROM 2.4A
          NG        X3,ERR142      IF RL GT MRL, ERROR
 RLOK     BSS       0 
*#
*     2.4  IF W TYPE RECORD, SET SIGN BIT OF X0; THIS INDICATES 
*          A PASS FOR BUILDING THE W CONTROL WORD.
*#
          MX0       0 
          SX3       B0
          SB3       #WT#
          NE        B3,B4,NOTW
          SX3       10
          MX0       1 
 NOTW     BSS       0 
          IX6       X6+X3 
          BX0       X0+X6 
*#
*     3.   INITIALIZE UWD (CURRENT ADDRESS IN WSA FOR MANY
*          PART MOVES). 
*#
 .MD      IFNE      #BETA#,0
          F.RM      WSAD,1
 .MD      ELSE
          F.RM      WSA,1 
 .MD      ENDIF 
          F.RM      LOP,3          PUT/P CODE 
          SET.RM    UWD,X1,,4 
          SET.RM    UCP,0 
*#
*     4.   SET UP INPUT WORD FOR A COMM$WA CALL.
*#
* 
*          B1 ALREADY 1; A0 ALREADY FIT.
*          X0, 00-23, 24-47 OK. 
*          SET LAST OPERATION.
* 
          SX4       #PU#
          MX5       1 
          IX3       X4-X3 
          LX5       57
          NZ        X3,LOPOK       JP ON LAST OP NOT PUT. 
          BX0       X0+X5          LAST OP WAS PUT, SET BIT IN X0.
 LOPOK    BSS       0 
          AX5       5                                                   T39A  46
          BX0       X0+X5                                               T39A  47
* 
*     THIS OPERATION NOT USED BY COMM.WA, BUT MAY BE ONE DAY
* 
 PUTLEWP  BSS       0 
*#
*     5.   ENTER LOOP TO WRITE OUT RECORD.
*#
          SB6       PUTRTRN 
          EQ        =XCOMM$WA 
 PUTRTRN  BSS       0 
 HURYBAK  BSS       0 
*#
*     5.1  IF ANY SPACE IS AVAILABLE (X0, 00-23 .NE. 0), MOVE 
*          IT FROM WSA TO BUFFER, ELSE GO TO 6. 
*#
          MX3       -24 
          BX3       -X3*X0
          ZR        X3,NOWDS
*#
*     5.2  IF W TYPE RECORDS, TREAT SPECIAL CASE OF CONTROL WORD MOVE.
*          GO TO 5.2B (FORWARD A BIT IN THE LISTING). 
*#
          NG        X0,WCWMUV 
* NOTE - THIS ASSUMES BUFFER .LE. 2**18 CHAR
*#
*     5.2A IF COMM$WA SPECIAL CASE, BRANCH AROUND MOVE$RM CODE (WE READ 
*          DIRECTLY INTO THE USER-S WSA) TO 5.4 
*#
          SB5       59-52 
          LX1       B5,X0 
          NG        X1,SCRET       JUMP IF SPEC CASE
          SX5       B3             DESTINATION ADDRESS
*         NOTE - THIS ASSUMES MOVE.RM DOES NOT USE A4 
          SA4       B3             SAVE OLD DES ADDR FOR WA CALC
          SB5       B0             DESTINATION CHAR 
          F.RM      UWD,X3         SOURCE ADDRESS 
 .MD      IFNE      #BETA#,0
          F.RM      WSAB,X4        1=LCM WSA, 0=SCM WSA 
          LX4       21
          BX3       X3+X4          INCLUDE LCM FLAG 
 .MD      ENDIF 
          SB4       X0
          SB3       B0             SOURCE CHAR
          SB6       MUVRT 
          EQ        =YMOVE$RM 
*#
*     5.3  UPDATE UWD POINTER 
*#
 MUVRT    BSS       0 
          SET.RM    UWD,X3         SAVE NEW SOURCE ADDRESS
          SB3       X5             SAVE NEW DESTINATION ADDRESS 
          ZR        X4,WAOK 
          SB3       B3+B1 
 WAOK     BSS       0 
          SB2       A4             RESTORE OLD DES ADDR 
 SCRET    BSS       0 
*#
*     5.4  UPDATE WA
*#
          SX3       B3-B2          NEW DES - OLD DES = WAINC
          INC.RM    WA,X3 
*#
*     5.6  UPDATE RL BY NUMBER OF CHARS MOVED 
*#
          MX1    36 
          BX3    -X1*X0 
          INC.RM    RL,X3 
 NOWDS    BSS       0 
*#
*     6.   CHECK IF ANY RESIDUE LEFT TO MOVE. IF NONE, EXIT. ELSE N.S.
*#
          MX3       12
          SB4       24
          MX5       36
          AX4       X0,B4 
          BX4       -X5*X4
          ZR        X4,EXITP
*#
*     7.   RESIDUE FOUND. CHECK REASONS, CONTINUE MOVING
*          IF POSSIBLE. 
* 
*     7.1  PLACE RESIDUE IN RL PART OF X0, ZERO RESIDUE 
*          PART.
*#
          BX0       X0*X3 
          IX0       X0+X4 
*#
*     7.2  IF EOI, GO TO ALLOCATE ROUTINE, WHICH WILL JUST
*          EXTEND THE FILE BY BUFFER SIZE-1.
*#
          LX3       B1,X0 
          NG        X3,EOIALOC
*#
*     7.3  IF EOS ENCOUNTERED, ROUND THE IN POINTER UP TO THE NEXT PRU
*          IF THAT DOES NOT CAUSE IN TO EXCEED LIMIT, THEN REENTER LOOP.
*          OTHERWISE, SIMPLY REENTER THE LOOP.
*#
          LX3       1 
          NG        X3,EOSFND 
*#
*     7.4  IO MUST HAVE JUST HIT BUFFER LIMIT. WE SET LOP IN X0 
*          TO WRITE, SO COMM$WA WILL GET RID OF THE STUFF IN
*          THE BUFFER AND CONTINUE WRITING INTO THE NEXT PRU. 
*#
          MX5       1 
          LX5       57
          BX0       X0+X5 
          EQ        PUTLEWP 
*#
*     8.0  WRITE AT EOI. FILE MUST BE EXTENDED FOR THIS PUT.
*          CALL FLSH$WA TO REWRITE EXISTING PRUS, OR WRITE NEW PRUS.
*#
 EOIALOC  BSS       0 
          F.RM      IN,B2 
          MX5       30
          BX4       -X5*X2         PRU(WA)
          LX2       30
          BX5       -X5*X2         PICK UP WA 
          SET.RM    CPRU,X4 
          LX2       30
          F.RM      EOIWA 
          F.RM      BFS,3,X3,-1 
          IX1       X1+X3 
          IX3       X5-X1 
          NG        X3,FLRTRN 
          SB6       FLRTRN
          EQ        =YFLSH$WA 
 FLRTRN   BSS       0 
          SX3       100B
          F.RM      EOIWA 
          IX3       X1+X3 
          AX3       6 
          SET.RM    CPRU,X3 
          F.RM      FIRST 
          F.RM      BFS,3,X2,-1 
          IX3       X2+X1 
          SET.RM    IN,X3 
*#
*         RE ENTER PUT LOOP TO OUTPUT REMAINING DATA
*#
          MX5       1 
          LX5       59
          BX0       -X5*X0
          EQ        PUTLEWP 
 EOSFND   MX5       1              *CLEAR THE EOS FLAG
          LX5       58             **IN THE COMM$WA 
          BX0       -X5*X0         **CONTROL WORD.
          F.RM      FIRST,5            *RETRIEVE FIRST INTO X5
          F.RM      IN,1               *RETRIEVE IN INTO X1 
          IX3       X1-X5 
          SX1       X3+100B        *ROUND UP IN TO THE NEXT PRU 
          AX1       6 
          LX1       6 
          IX1       X1+X5 
          F.RM      LIMIT,5        *IF THE CALCULATED BUFFER POINTER
          IX3       X1-X5          **IN EXCEEDS LIMIT,
          PL        X3,PUTLEWP     **DO NOT CHANGE IN.
          SET.RM    IN,X1,7,5 
          EQ        PUTLEWP 
*#
*     5.2B FORMULATE W CONTROL WORD AND PLACE IT IN THE I/O BUFFER
*          AT WA. 
*#
 WCWMUV   BSS       0 
          F.RM      RRL,X7         PICK UP RECORD LENGTH
          SB5       SETPAR
          EQ        =YCHWR$RM 
* 
*     FORGET ABOUT PREVIOUS RECORD SIZE, IT DOESNT MEAN MUCH ON 
*     A RANDOM FILE.
* 
 SETPAR   BSS       0 
          CX5       X7             IF NO. OF BITS IN X7 IS ODD, 
          MX3       1              NO NEED FOR A PARITY BIT, ELSE 
          LX5       59             STICK IT IN. 
          SX4       X7             SAVE RL IN X4 FOR A WHILE
          NG        X5,NOBIT
          BX7       X3+X7 
 NOBIT    BSS       0 
* 
          SA7       B3             STORE WCW AT CURRENT WA. 
*#
*     5.2D UP WA BY 1 TO ACCOUNT FOR WCW, PLACE TRUE RL (SAVED
*          IN X4) IN X0 REQUEST WORD AND CLEAR THE W PASS FLAG, THEN
*          SET LOP TO PUT AND RESTART PROCESS TO MOVE THE DATA. 
*#
          LX3       57
          INC.RM    WA,1
          ZR        X4,EXITP
          SX4       10
          LX3       51-56 
          BX0       X0+X3          SET THIS OP BIT TO PUT 
          LX3       59-51 
          BX0       -X3*X0         CLEAR WCW BIT
          IX0       X0-X4          REDUCE AVAILABLE BY WCW
          SB3       B3+B1          INCREMENT HERE 
          EQ        HURYBAK        SHORT CUT COMWA
*#
*     10.1  EXCESS DATA 
*#
 ERR142   BSS       0 
          S"ERRREG" 142B
          SET.RM    FP,#EOR#
          SET.RM    LOP,#PU#
          EQ        =YERR$RM
*#
*     11.  NORMAL EXIT
*#
 EXITP    BSS       0 
          SET.RM    LOP,#PU#
          SET.RM    FP,#EOR#
          RESTORE 
          JP        B6
          END 
