*COMDECK FA=WTH 
          CTEXT  FA=WTH - WRITE CODED LINE, -H- FORMAT
 WTH      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   FA=WTH 
  
  
**        FA=WTH - WRITE CODED LINE TO FILE, IN -H- FORMAT. 
* 
*                *FA=WTH* PARALLELS ITS KRONOS MODEL, *COMCWTH*.
*         LINE LENGTH IN WORDS MUST BE PROVIDED IN (B7) ON ENTRY. 
*         IF (B7) CONTAINS ZERO, NO TRANSFER WILL BE MADE.
* 
* 
*         ENTRY  (X2) = FIT ADDRESS 
*                (B1) = 1 
*                (B6) = LINE ADDRESS
*                (B7) = LINE LENGTH IN WORDS, OR ZERO - SEE ABOVE 
* 
*         EXIT   (X2) = FIT ADDRESS 
*                (B1) = 1 
* 
*         USES   X - 1, 3, 4, 6, 7
*                A - 1, 4 
*                B - 2, 7 
* 
*         CALLS  PUT
  
  
 FA=WTH   JP     *+4S15      ** ENTRY/EXIT ** 
          LE     B7,B0,FA=WTH IF NO LENGTH, NO TRANSFER 
  
*         TEST FOR NO TRAILING BLANKS 
  
          SA1    B6+B7
          MX4    48 
          SA1    A1-B1       FETCH LAST WORD
          BX4    -X4*X1 
          ZR     X4,WTH2     IF ZERO BYTE TERMINATION 
          SA4    WTHB        =1H
          IX1    X1-X4
          NZ     X1,WTH2     IF NO TRAILING BLANK WORDS 
  
*         DELETE TRAILING BLANK WORDS.
  
          SA1    B6+B7       PRESET (A1)
          SB7    B7+B1
  
 WTH1     SA1    A1-B1
          IX6    X1-X4
          SB7    B7-B1
          EQ     B7,B1,WTH2 
          ZR     X6,WTH1
  
*         DETERMINE LINE LENGTH (CHARACTERS). 
  
 WTH2     SB2    B7-B1
          SX6    B7 
          SA1    B6+B2       (X1) = LAST WORD OF LINE 
          IX7    X6+X6
          LX6    3
          SA4    WTHA        (X4) = CHARACTER BYTE MASK 
          IX7    X6+X7       (X7) = LINE LENGTH (CHARACTERS)
  
*         LOCATE AND COUNT LINE TERMINATING ZERO BYTES.  ADJUST LINE
*         LENGTH (IN CHARACTERS) ACCORDINGLY. 
  
          CX6    X1          MINUS ZERO PROTECT 
          MX3    -1 
          NZ     X6,WTH3     IF LAST WORD NOT NULL
          SA1    A1-1        (X1) = LAST NON-NULL WORD OF LINE
          SX7    X7-10D 
  
 WTH3     IX6    X1+X3       BORROW PROPAGATES LEFT THRU ALL ZERO BYTES 
          NO
          BX1    -X1*X6 
          SX3    B6          (X3) = LINE ADDRESS
          BX6    X4*X1       RETAIN *40* IN EACH NULL CHAR BYTE POSITION
          NO
          CX1    X6          (X1) = NR OF NULL CHARACTERS 
          IX4    X7-X1       (X4) = LINE LENGTH (NON-NULL CHARACTERS) 
          PUT    X2,X3,X4 
          JP     FA=WTH      EXIT 
  
 WTHA     DATA   40404040404040404040B
 WTHB     DATA   1H 
  
          IF     -DEF,QUAL$,2 
          QUAL   *
 FA=WTH   EQU    /FA=WTH/FA=WTH 
  
          IF     -ABS,FA=WTH,1
          ENTRY  FA=WTH 
  
          ENDX
