COMCWTA 
COMMON
          CTEXT  COMCWTA - WRITE CODED LINE FROM 6/12 STRING BUFFER.
 WTA      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCWTA
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 WTA      SPACE  4
***       WTA - WRITE CODED LINE FROM 6/12 STRING BUFFER. 
*         R. S. HORECK.      71/05/19.
*         S. R. MCPHERSON.   74/09/30.
*         A. F. SKJOLDEBRAND 84/08/09. ( ADAPTION FROM COMCWTS )
 WTA      SPACE  4
***              WTA TRANSFERS 1 CODED LINE FROM A 6/12 ASCII STRING
*         BUFFER TO A CIO BUFFER WITH TRAILING SPACE SUPPRESSION. 
*         CHARACTERS IN THE WORKING BUFFER ARE PACKED AND STORED IN 
*         THE CIRCULAR BUFFER.
*         IF THE BUFFER BECOMES SUFFICIENTLY FULL TO REQUIRE WRITING, 
*         WTA 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.
* 
*         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.
*                (B6) = WORD COUNT OF DATA WRITTEN. 
* 
*         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     WTA3        ENTRY FROM DCB= ON A WRITE REQUEST 
  
 WTA=     PS                 ENTRY/EXIT 
          SA4    WTA= 
          ZR     B7,WTA=     IF WORKING BUFFER EMPTY
  
          IF     -DEF,B1=1,1
          SB1    1
  
          SX6    0
          SA6    WTAB        CLEAR ESCAPE CODE FLAG 
          SA1    X2+4        (B5) = LIMIT 
          SB4    B6+B7
          SB5    X1 
          SX7    1R 
          SA1    B4-B1       READ LAST CHARACTER
          SB2    B1+B1       (2)
 WTA1     BX6    X1-X7       CHECK FOR BLANKS 
          SA1    A1-B1       DECREMENT CHARACTER POSITION 
          ZR     X6,WTA1     IF BLANK 
          SB7    A1+B2       (B7) = LWA + 1 
          LT     B6,B7,WTA2  IF NOT TO PAST START OF BUFFER 
          SB7    B6+B1
 WTA2     SA3    X2+1        (A3) = ADDRESS OF FIRST
          SX4    0           (X4) = WORD COUNT TRANSFERED TO BUFFER 
  
*         INITIALIZE REGISTERS FOR TRANSFER.
  
 WTA3     SA1    A3-B1       SAVE FET STATUS
          SA2    A3+B1       (X2) = IN
          BX6    X1 
          SA1    A2+B1       OUT
          SA6    WTAA 
          SB3    X2+B1       (B3) = IN+1
          SB4    X1 
          SX6    B4-B3       OUT - IN+1 
          PL     X6,WTA4     IF OUT \ IN+1
          SX6    B5-B3       LIMIT - IN+1 
 WTA4     SB4    X6          (B4) = FREE BUFFER SPACE 
          SX3    X2          (X3) = IN
          NZ     X6,WTA6     IF SPACE AVAILABLE 
  
*         PROCESS EXHAUSTED FREE BUFFER SPACE.
  
 WTA5     SA1    WTAA        GET FET STATUS 
          SA2    A3+B1       (A2) = ADDRESS OF IN 
          SB2    X1          (B2) = FET STATUS
          SX2    X3          (X2) = IN
          NE     B3,B5,=XDCB=  IF IN+1 " LIMIT
          SA1    A3          (X1) = FIRST 
          SX6    X1 
          SA1    A3-B1       FET+0
          SB2    X1          (B2) = FET STATUS
          SA1    A2+B1       OUT
          IX7    X1-X6       OUT - IN+1 
          SB3    X6          IN+1 = FIRST 
          ZR     X7,=XDCB=   IF IN+1 = OUT
          SB4    X7          (B4) = FREE BUFFER SPACE 
  
*         ASSEMBLE 6/12 ASCII BUFFER
  
 WTA6     SA1    WTAB        GET PREVIOUS ESCAPE CODE 
          SB2    6
          SA2    WTAC        GET POSITION MARKER
 WTA7     SX6    0+ 
          NZ     X1,WTA9     IF REMAINING ESCAPE CODE 
 WTA8     SA1    B6 
          EQ     B6,B7,WTA12 IF WORKING BUFFER EMPTY
          AX7    B2,X1
          SB6    B6+B1
          LX6    B2,X6
          ZR     X7,WTA9     IF NO ESCAPE CHARACTER 
          LX2    B2,X2
          NG     X2,WTA11    IF FULL WORD 
          LX6    B2,X6
 WTA9     BX6    X6+X1
          LX2    B2,X2
          PL     X2,WTA8     IF NOT YET FULL WORD 
          SX1    0+          CLEAR POSSIBLE ESCAPE CODE 
 WTA10    SB3    B3+B1       IN+1 = IN+1 + 1
          SB4    B4-B1       DECREMENT FREE BUFFER SPACE
          SA6    X3          STORE WORD 
          SX4    X4+B1       COUNT WORD 
          SX3    B3-B1       IN = IN+1
          NZ     B4,WTA7     LOOP TO LAST CHARACTER OF FULL BUFFER
          BX7    X1 
          SA7    WTAB        SAVE LAST ESCAPE CODE
          EQ     WTA5        CHECK BUFFER POINTERS
  
 WTA11    BX6    X6+X7
          MX7    -6 
          BX1    -X7*X1      REMOVE ESCAPE CODE 
          EQ     WTA10
  
*         PROCESS END OF LINE CONDITION 
  
 WTA12    LX7    B1,X2       SHIFT FOR BYTE POSITION
          NG     X2,WTA14    IF WORD BOUNDARY 
          NG     X7,WTA14    ON BYTE BOUNDARY 
          SX7    1R 
          LX2    6
          LX6    6
          BX6    X6+X7       MERGE BLANKS 
 WTA13    NG     X2,WTA15    IF WORD BOUNDARY 
          LX6    12 
          LX2    12 
          EQ     WTA13       IF NOT WORD BOUNDARY 
  
 WTA14    SA1    A1-B1       GET LAST CHARACTER PROCESSED 
          NZ     X1,WTA13    IF NOT ENDING COLON
          SX7    2R 
          LX2    12 
          LX6    12 
          BX6    X6+X7
          EQ     WTA13       ADD TWO BLANKS 
  
*         PROCESS LAST WORD 
  
 WTA15    SA2    A3+B1       SET (A2) = IN
          MX1    -12
          SX4    X4+B1       COUNT WORD 
          SA6    X3          STORE LAST WORD
          BX7    -X1*X6 
          SX2    B3          IN = IN+1
          SB6    X4          SET WORD COUNT TRANSFERRED 
          SA3    A3          (X3) = FIRST 
          ZR     X7,WTA17    IF VALID END OF LINE, EXIT 
          SB3    B3+B1       ADVANCE IN+1 
          SB4    B4-B1       DECREMENT FREE BUFFER SPACE
          MX1    -6 
          BX1    -X1*X7      GET LAST CHARACTER 
          SX3    X2+         (X3) = IN
          SB6    B7+         RESET CHARACTER POSITION 
          ZR     B4,WTA5     IF FREE SPACE EXHAUSTED
          SX6    B0+
          NZ     X1,WTA16    IF NOT *00* CHARACTER
          SX6    2R          PRESERVE *00* CHARACTER WITH *  *
 WTA16    LX6    48 
          SB6    X4+B1       RESET WORD COUNT 
          SA6    X2 
          SX2    B3          IN=IN+1
 WTA17    SA1    A2+B1       SET OUT
          SB4    X1 
          EQ     =XWTX=      EXIT 
  
  
 WTAA     CON    0           FET STATUS PRIOR TO READING OUT
 WTAB     CON    0           PREVIOUS ESCAPE CODE 
 WTAC     CON    60002000200020002000B  WORD AND BYTE POSITION FLAGS
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 WTA=     EQU    /COMCWTA/WTA=
 QUAL$    ENDIF 
          ENDX
