*COMDECK  COMCWTH 
          CTEXT  COMCWTH - WRITE CODED LINE, -H- FORMAT.
 WTH      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCWTH
          BASE   D
*         COMMENT COPYRIGHT CONTROL DATA CORP. 1970.
 WTH      SPACE  4
***       WTH - WRITE CODED LINE, -H- FORMAT. 
*         G. R. MANSFIELD.  70/10/09. 
*         S. R. MCPHERSON.   74/09/30.
 WTH      SPACE  4
***              WTH TRANSFERS 1 CODED LINE IN -H- FORMAT FROM A
*         WORKING BUFFER TO A CIO BUFFER.  TRAILING SPACES ARE DELETED. 
*         IF THE BUFFER BECOMES SUFFICIENTLY FULL TO REQUIRE WRITING, 
*         WTH WILL PERFORM A *WRITE* FUNCTION UNLESS THE SYMBOL *WRIF$* 
*         IS DEFINED. IN THIS CASE, THE CIO FUNCTION THAT IS IN THE FET 
*         WILL BE RE-ISSUED.
*         IF THE BOCK TO BE WRITTEN TERMINATES WITH 6 BITS OF ZERO A
*         WORD CONTAINING A BLANK BYTE WILL BE APPENDED TO PRESERVE 
*         THE  *00*  CHARACTER AS A COLON.  IF THE LINE TERMINATES
*         ON AN END-OF-LINE IT WILL BE WRITTEN AS IS. 
* 
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*                (B6) = FWA WORKING BUFFER. 
*                (B7) = WORD COUNT OF WORKING BUFFER. 
*                IF (B7) = 0, NO TRANSFER WILL BE PERFORMED.
* 
*         EXIT   (X2) = ADDRESS OF FET FOR FILE.
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  DCB=, WTX=.
  
  
 +        EQ     WTH3 
  
 WTH=     PS                 ENTRY/EXIT 
          SA4    *-1
          ZR     B7,WTH=     IF WORKING BUFFER EMPTY
  
          IF     -DEF,B1=1,1
          SB1    1
  
*         DELETE TRAILING BLANK WORDS.
  
          SA3    WTHA        =1H
          SA1    B6+B7       PRESET (A1)
          SB7    B7+B1
 WTH1     SA1    A1-B1
          IX6    X1-X3
          SB7    B7-B1
          EQ     B7,B1,WTH2 
          ZR     X6,WTH1
 WTH2     SA1    X2+4        (B5) = LIMIT 
          SA3    X2+B1       (X3) = FIRST 
          SB5    X1 
  
*         INITIALIZE REGISTERS FOR TRANSFER.
  
 WTH3     SA1    A3+2        (B4) = OUT 
          SA2    A3+B1       (X2) = IN
          SB4    X1 
  
*         TRANSFER DATA FROM WORKING BUFFER TO CIRCULAR BUFFER. 
  
 WTH4     SB3    X2+1        (IN+1) 
          EQ     B3,B5,WTH9  IF (IN+1) = LIMIT
 WTH5     EQ     B3,B4,=XDCB= DUMP CIRCULAR BUFFER IF (IN+1) = OUT
          SA1    B6          READ WORD
          SB7    B7-B1       DECREMENT WORD COUNT 
          BX6    X1 
          SA6    X2          STORE WORD 
          SB6    B6+B1       ADVANCE WORKING BUFFER 
          SX2    B3          IN = (IN+1)
          GE     B7,B1,WTH4  LOOP TO LAST WORD
  
          MX1    -12         CHECK LAST BYTE
          BX7    -X1*X6 
          ZR     X7,WTX=     EXIT IF 0000 BYTE
          SB6    WTHB        PREPARE ZERO WORD
          SX7    X7-2R
          ZR     X7,WTH6     IF *  * BYTE 
          MX4    -6          SET CHARACTER MASK 
          BX4    -X4*X6      GET LAST CHARACTER OF WORD 
          NZ     X4,WTH4     IF LAST CHARACTER NOT  *00*
          SB6    WTHC        PRESERVE *00* CHARACTER WITH *  *
          JP     WTH4 
  
*         DELETE TRAILING SPACE BYTES.
  
 WTH6     MX4    -6          SINGLE CHARACTER MASK
          LX4    12 
          BX7    -X4*X6      GET RIGHT CHARACTER OF BYTE
          ZR     X7,WTH4     IF  *00*  CHARACTER ADD BLANK BYTE 
          SX2    2R          SET SPACE BYTE 
 WTH7     BX6    X1*X6       ZERO OUT SPACE BYTE
          LX1    12          CHECK NEXT BYTE
          LX2    12 
          BX7    -X1*X6      GET BYTE 
          LX4    12 
          BX7    X7-X2       CHECK FOR SPACE BYTE 
          NZ     X7,WTH8     IF NOT SPACE BYTE
          BX7    -X4*X6      CHECK CHARACTER BEFORE BYTE
          NZ     X7,WTH7     IF NOT  *00*  CHARACTER
 WTH8     SA6    A6 
          SX2    B3 
          EQ     =XWTX=      EXIT 
  
 WTH9     SB3    X3          (IN+1) = FIRST 
          EQ     WTH5 
  
 WTHA     DATA   1H 
 WTHB     CON    0
 WTHC     DATA   2L 
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 WTH=     EQU    /COMCWTH/WTH=
 QUAL$    ENDIF 
          ENDX
