*COMDECK /PUTDW/
 PUT$W    TITLE     GET RL FOR RT=W PUT 
 FWRD.RM  DECMIC    "FWRD.RM"+100 
 PUT$W    CAP.RM
*#
*0        ENTRY PUT$W.
*         FETCH RECORD LENGTH (RRL) FROM FIT AND RETURN IT IN X3. 
*#
          F.RM      RRL,3 
          SX5       B1
          LX5       55
          JP        B5
PUT$WI    TITLE     WRITE W-CONTROL WORD FOR NEW W-RECORD 
 FWRD.RM  DECMIC   "FWRD.RM"-100
 PUT$WI   BSS       0 
*#
*0        ENTRY PUT$WI. 
*         ADJUST TO A WORD BOUNDARY AND GET ONE WORD IN THE CIRCULAR
*         BUFFER(GET1.SQ) FOR THE W-CONTROL WORD (WCW). 
*#
          F.RM      BCC                                             W 
          ZR        X1,WBNDRY                                       W 
          SX7       10
          SB3       B3+B1                                           W 
          IX3       X7-X1          INC BL BY UNUSED CHARS IN LAST WD
          INC.RM    BL,X3 
          SET.RM    BCC,0                                           W 
 WBNDRY   BSS       0                                               W 
          SET.RM    MVL,X2                                          W 
          GET1.SQ   OWM                                             W 
*#
*0        THE NEXT MAJOR SECTION OF CODE SETS UP REGISTERS FOR A CALL 
*         TO FORMWCW TO FORM AND STORE THE W-CONTROL WORD. X3 WILL
*         CONTAIN RECORD LENGTH,X2 THE W-CONTINUATION FLAGS, AND B2 
*         THE WCR FIT FIELD (ADDRESS OF CURRENT WCW IN THE BUFFER). 
*         IF MBL NE 0 
*            IF RRL NE 0
*               IF RECORD OR PART WILL FIT IN BLOCK 
*                  X3 = RRL - RL
*                  B2 = 0 
*                  X2 = 0 IF CRF = 0 ELSE = 3 
*               ELSE
*                  X3 = MBL - BL
*                  B2 = B3-1
*                  X2 = 1 IF CRF = 0 ELSE = 2 
*            ELSE 
*                  X3 = MBL - BL
*               B2 = B3-1 
*                  X2 = 1 IF CRF = 0 ELSE = 2 
*         ELSE
*            IF RRL NE 0
*               IF FP NE 0
*                  X3 = RRL 
*                  B2 = 0 
*                  X2 = 0 
*               ELSE
*                  X3 = MVL 
*                  B2 = 0 
*                  X2 = 3 
*            ELSE 
*               X3 = MVL
*               B2 = 0
*               X2 = 2 IF RL = 0
*                      ELSE X2 = 1 IF PARTIAL ELSE = 0
*         CALL WCALLWCW 
*#
          ON.RM     SOL,SOL1
          SET.RM    IN,B3-B1
 SOL1     BSS       0 
          F.RM      MVL,2          RESTORE X2 AS MVL
          F.RM      MBL,3 
          F.RM      RL,X6          RL SAVED IN X6 UNTIL WCNVRT
          F.RM      RRL,5 
          SB2       0 
          ZR        X3,ZMBL        IF MBL EQ 0
          F.RM      BL,4
          SOL*10    X4,-           BL - SOL*10
          IX3       X3-X4          MBL - BL - SOL*10
          ZR        X5,ZRRL1       IF RRL IS 0
          IX1       X5-X6          RRL - RL 
          IX2       X1-X3          (RRL-RL) - (MBL-BL-SOL*10) 
          PL        X2,ZRRL1       BLOCK WILL NOT CONTAIN RECORD
          BX3       X1             PUT (RRL-RL) IN WCW
          SX2       B0             WHOLE RECORD 
          OFF.RM    CRF,WCNVRT     IF THIS PIECE IS A WHOLE RECORD
          SX2       3              END PIECE
          EQ        WCNVRT
 ZRRL1    BSS       0 
          SB2       B3-B1          SET WCR TO PIN-1 
          SX2       B1             FIRST PIECE
          OFF.RM    CRF,WCNVRT     IF START OF RECORD 
          SX2       B1+B1          MIDDLE PIECE 
          EQ        WCNVRT
 ZMBL     BSS       0 
          ZR        X5,ZRRL2       IF RLL EQ 0
          F.RM      FP
          ZR        X1,TRMCW       END OF THE RECORD
          BX3       X5             PUT RRL IN WCW 
          SX2       B0             WHOLE RECORD 
          EQ        WCNVRT
TRMCW     BSS       0 
          BX3       X2             PUT MVL IN WCW 
          SX2       3              LAST PIECE 
          EQ        WCNVRT
 ZRRL2    BSS       0 
          BX3       X2             PUT MVL IN WCW 
          SX2       B1+B1          MIDDLE PIECE 
          NZ        X6,WCNVRT      IF NOT START OF RECORD 
          SX2       B1             FIRST PIECE
          ON.RM     PPT,WCNVRT     IF PARTIAL PUT 
ZRRL      BSS       0 
          SX3       B0             PUT 0 IN WCW 
          SX2       B0             WHOLE RECORD 
 WCNVRT   BSS       0 
          SB5       WCALLWCW
          EQ        CHWR           CONVERT TO WORDS AND UNUSED BITS 
*#
*0        WCALLWCW - CALL SUBROUTINE FORMWCW TO FORM AND STORE WCW, 
*                    RESET X2=MVL, AND BRANCH DIRECTLY TO PUT$SQ
*                    VIA   EQ =YCM. 
*#
 WCALLWCW BSS       0 
          SB5       WCWFR 
          EQ        FORMWCW 
 WCWFR    BSS 
          F.RM      MVL,2 
          OFF.RM    PPT,NOPPT 
          F.RM      PTL,X6
 NOPPT    BSS       0 
          ZR        X6,=YPTCM$SQ   IF START OF RECORD OR PARTIAL
          SET.RM    OWF,0 
          EQ        =YPTLP$SQ      IF BLOCK BOUNDARY
PUT$WT    TITLE  TERMINATE W-CONTINUATION RECORD PUT
 PUT$WT   BSS       0 
*#
*0        ENTRY PUT$WT. 
*         TERMINATE W-CONTINUATION RECORD. REWRITE LAST CONTROL WORD
*         WITH RECORD LENGTH=PIN-WCR-1. IF LAST CONTROL WORD WAS AN 
*         INITIAL PIECE, REWRITE CONTROL WORD WITH W-CONTINUATION 
*         FLAG=0 SINCE COMPLETE RECORD IS IN BLOCK. 
*         SAVE B6 STACK BECAUSE CODE JUMPS TO PUT$SQ SO STACK COULD 
*         OVERFLOW. 
*#
*     W-CONTINUATION CONCLUSION 
          BUFSP     B,2,3,2                                         WC
          SX2       X2-1           NO.USER WDS IN THIS BLOCK SO FAR 
          F.RM      BCC,X3                                          WC
          ZR        X3,ONBNDRY                                      WC
*     STUFF UBC IN                                                  WC
          SX2       X2+B1                                           WC
          SX1       X3-10                                           WC
          LX3       X1,B1          2(BCC-10)                        WC
          IX1       X1+X3          3(BCC-10)                        WC
          LX1       1+18           -6(10-BCC) IN POSITION           WC
          IX2       X2-X1          UBC                              WC
 ONBNDRY  BSS       0                                               WC
          SA3       B2             GET PREVIOUS RL FROM ORIGINAL WCW
          MX7       18
          LX7       41
          BX4       X7*X3 
          SB4       X2             SAVE X2 AROUND SET.RM
          SX2       X2+B1 
          SET.RM    PRL,X2,7,1,TRUNC
          SX2       B4             RESTORE X2 
          LX3       59-43          WAS LAST PIECE A MID-PIECE 
          MX1       0 
          PL        X3,ONEPIECE    NO-WHOLE RECORD IS IN BUFFER 
          MX1       2              END OF W-CONT RECORD 
          LX1       44
 ONEPIECE BSS       0 
          BX2       X2+X4          PRL + RL 
          BX2       X2+X1          W-CONCLUSION                     WC
          PRTY.SQ   2,7,1,B2
          SET.RM    WCR,0          PUTP TERM-RESET WCR
          EQ        =YPTIO$SQ 
FORMWCW   TITLE     FORM AND STORE W-CONTROL WORD 
 FORMWCW  BSS 
*#
*0        FORMWCW.  SUBROUTINE TO FORM AND STORE A W-CONTROL WORD.
*     OR TOGETHER PARITY BIT (59), W-CONTINUATION FLAG BITS (43-42) 
*     FROM X2, PREVIOUS RECORD LENGTH (41-24), UNUSED BIT COUNT (23-18) 
*     AND RECORD LENGTH (17-0) FROM X3.  SET FIT FIELD WCR TO THE 
*     BUFFER ADDRESS OF THE W-CONTROL WORD FOR W-CONTINUATION RECORDS 
*     AND TO ZERO FOR NON-CONTINUATION RECORDS.  STORE PREVIOUS RECORD
*     LENGTH = RL+1 FOR NEXT W-CONTROL WORD.  INCREMENT BL FOR EACH 
*     CONTROL WORD STORED IN THE BUFFER.
*#
          F.RM      PRL,X5
          LX2       42             POSITION W-CONT FLAG TO BITS 42-43 
          SX4       X3+B1 
          SET.RM    PRL,X4,7,1,TRUNC  CURRENT RL+1=PRL FOR NEXT RECORD
          IX2       X2+X3          W-CONT FLAG + (UBC+RL) 
          LX5       24
          BX3       X2+X5          PUT IN LENGTH OF LAST W-RECORD 
          SET.RM    WCR,B2         ADDRESS OF W-CONTINUATION CONTROL WD 
          PRTY.SQ   3,7,1          ADD PARITY BIT AND STORE IN BUFFER 
          SET.RM    CRF,1          SET CONT RECORD FLAG 
          JP        B5
PUT$WF    TITLE     FLUSH W-RECORD
 FL.B6    BSSZ      1 
 PUT$WF   BSS       0 
          STO.REG 
*** 
*#
*0        ENTRY PUT$WF. 
*         THIS SECTION IS CALLED BY FLSH$SQ WHEN RT=W TO WRITE A
*         ZERO-LENGTH DELETED RECORD SO BACKSPACE CAN BE PERFORMED. 
*#
* 
*  THIS SECTION WRITES A ZERO-LENGTH DELETED W-RECORD 
*    PREPARATORY TO ISSUING A WRITER. 
* 
*  IN THE CASE OF BT=I, THE ZERO-LENGTH W-RECORD IS PRECEEDED 
*    BY A 1-WORD DELETED W-RECORD WHICH CONTAINS THE LENGTH 
*    OF THE CURRENT I-BLOCK.
*  THESE RECORDS MUST BE THE LAST WORDS IN THE I-BLOCK.  IF THERE 
*    IS NOT ENOUGH ROOM IN THE BLOCK, A DELETED RECORD IS WRITTEN 
*    TO FILL THE BLOCK, AND THE TWO W-RECORDS WILL BE WRITTEN 
*    AS THE ONLY 4 WORDS OF THE NEXT I-BLOCK. 
* 
*** 
          SA1       A0+7           SAVE-RESTORE WORD IN FET 
          SX2       B6             EQUIVALENT 
          LX1       18               OF 
          BX6       X1+X2              A SAVE 
          SA6       FL.B6          SAVE B6 STACK
          MX6       0 
          SA6       A1             ZERO OUT FET+7 FOR REUSE BY PUT
          F.RM      WSA,X2         TEMP STORE WSA IN WSAS FOR AWHILE
          SET.RM    WSAS,X2 
          SET.RM    WSA,A0         LET WSA=FIT FOR A WHILE
*#
*         IF BLOCK TYPE = I, ATTEMPT TO WRITE A 1-WORD DELETED
*         RECORD CONTAINING LENGTH OF CURRENT I-BLOCK SO BACKSPACE
*         KNOWS WHERE THE BLOCK STARTS. IF THERE IS NOT ENOUGH
*         ROOM IN THE CURRENT BLOCK FOR THIS RECORD PLUS THE
*         ZERO-LENGTH DELETED RECORD REQUIRED FOR BACKSPACE, FILL 
*         THIS BLOCK WITH A DELETED RECORD. 
*#
          F.RM      BT,X1,-#IT# 
          NZ        X1,FLUSH4      BR IF BT"I 
          F.RM      BCC 
          ZR        X1,DONT.RND 
          SX7       10
          IX2       X7-X1          INC BL BY UNUSED CHARS IN LAST WD
          IX4       X4+X2 
          INC.RM    BL,X2 
          F.RM      PIN,2,B3
          BUFINC    B,3,1,2        INCREMENT PIN BY 1 ---> X1 
          SET.RM    PIN,X2
          SET.RM    BCC,0 
 DONT.RND BSS       0 
          F.RM      MBL 
          IX0       X1-X4          MBL-BL 
          ZR        X0,FLUSH3      BR IF MBL=BL (BLOCK BOUNDARY)
          SX2       X0-30          REDUCE BY 30 CHARACTERS
          PL        X2,FLUSH3       BR IF (MBL-BL)\3
*    NOT ENOUGH ROOM IN BLOCK, WRITE DELETED RECORD TO FILL BLOCK 
          SB6       FL.PUT1 
          SX3       X0-10          ALLOW FOR CONTROL WORD 
          EQ        CALLPUT 
*    SET DELETE BIT 
 FL.PUT1  BSS       0 
          F.RM      PIN,X6
          SX0       B1
          F.RM      RL,4
          AX4       3              12B (OR 00B) BECOMES 1 (OR 0)
          IX4       X4+X0          RL+1 (IN WORDS)
          SX5       5 
          BUFDEC    X,6,4,3 
          LX5       59-2
          SA4       X3             W-CONTROL WORD 
          BX6       X4-X5          EXCLUSIVE OR 
          SA6       A4
*#
*         NOW WRITE THE 1-WORD DELETED RECORD CONTAINING THE
*         LENGTH OF THE CURRENT I-BLOCK.
*#
 FLUSH3   BSS       0 
          SX3       10             1-WORD RECORD
          SB6       FL.PUT2 
          EQ        CALLPUT 
*    SET DELETE BIT 
 FL.PUT2  BSS       0 
          SX5       5 
          F.RM      PIN,X2
          LX5       59-2
          SX3       B1+B1          REWRITE WCW AND DATA WORD
          BUFDEC    X,2,3,4        ADDRESS OF WCW IN X4 
          SA3       X4
          BX6       X5-X3          PUT IN DELETE BIT AND PARITY BIT 
          SA6       X4             REWRITE WCW
          F.RM      BL,X3 
          SB5       FL.CHWR        RETURN ADDR
          EQ        CHWR           CONVERT TO WORDS AND UNUSED BITS 
 FL.CHWR  BSS       0 
          F.RM      SOL,X1,,6 
          IX7       X3-X1          DISCOUNT S/L CW
          SX5       B1
          BUFINC    X,4,5,5        GET BUFR ADR FOR DATA WORD 
          SA7       X5             REWRITE DATA WORD
*#
*         NEXT WRITE THE LAST WORD IN THE FILE - THE ZERO-LENGTH
*         DELETED W-RECORD. SET X4=BLOCK LENGTH AND RETURN DIRECTLY 
*         TO FLSH$SQ VIA   EQ =YPTFL$SQ . 
*#
 FLUSH4   BSS       0 
          SX3       B0
          SB6       FL.PUT3 
 CALLPUT  BSS 
          SET.RM    RRL,X3
          SET.RM    RL,0
          SET.RM    PPT,0 
          SET.RM    RTJP,PUT$W     SET RTJP FOR STATIC FCL
          EQ        =YPTGO$SQ 
*    SET PARITY,FLAG,DELETE BITS ACCORDING TO WEOP, WEOS OR NEITHER 
*      WEOP -> P+F, WEOS -> F+D, NEITHER -> P+D 
 FL.PUT3  BSS       0 
          F.RM      WSAS,X2        GET WSA FROM TEMP STORAGE..
          SET.RM    WSA,X2         RESTORE WSA TO ORIG ADDR 
          SA3       FL.B6          RELOAD B6 STACK
          F.RM      WEOX
          SX5       5 
          ZR        X1,FL.WX       BR IF NEITHER WEOS NOR WEOP
          SX1       X1-1
          SX5       3 
          ZR        X1,FL.WX       BR IF WEOS 
          SX5       6              WEOP 
 FL.WX    BSS       0 
          SB6       X3             RESTORE RETURN ADDRESS 
          BX6       X3
          AX6       18
          SA6       A0+7           REESTABLISH FET+7
          F.RM      PIN,B2
          LX5       59-2
          BUFDEC    B,2,1,2 
          SA3       X2
          BX6       X5-X3          SET BITS 
          SX2       B2
          SA6       A3
          PUT.IN
          F.RM      BL,4           NO. CHARS IN CURRENT BLOCK 
          SOL*10    X4,-           ALLOW FOR S/L CONTROL WORD 
          EQ        =YPTFL$SQ 
* END /PUTDW/ 
