COMCWTO 
COMMON
          CTEXT  COMCWTO - WRITE ONE WORD.
 WTO      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCWTO
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 WTO      SPACE  4
***       WTO - WRITE ONE WORD. 
*         D. A. CAHALANDER.  70/10/09.
 WTO      SPACE  4
***              WTO WRITES 1 WORD TO A CIO BUFFER FROM (X6). 
*         IF THE BUFFER BECOMES SUFFICIENTLY FULL TO REQUIRE WRITING, 
*         WTO 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  (A1) = ADDRESS OF IN POINTER.
*                (X1) = IN. 
*                (X6) = WORD TO WRITE.
* 
*         EXIT   (X2) = ADDRESS OF FET OF FILE. 
* 
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 1. 
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  NONE.
  
  
 WTO1     SA6    X1          STORE WORD 
          SX2    A1-2 
          SA7    A1          UPDATE IN
  
 WTO=     PS                 ENTRY/EXIT 
 WTO2     BSS    0
  
          IF     -DEF,B1=1,1
          SB1    1
  
          SA2    A1-2        READ FET+0 
          SA3    A1+B1       READ OUT 
          SX7    X1+B1       IN+1 
          IX4    X7-X3       IN+1 - OUT 
          NG     X4,WTO1     IF NO WRAP AROUND
          SA3    A3+B1       READ LIMIT 
          ZR     X4,WTO3     IF BUFFER FULL 
          SX3    X3 
          IX4    X7-X3       IN+1 - LIMIT 
          SA3    A1-B1       READ FIRST 
          NZ     X4,WTO1     IF IN+1 .NE. LIMIT 
          SX7    X3          IN+1 = FIRST 
          SA3    A1+B1       READ OUT 
          IX4    X7-X3
          NZ     X4,WTO1     IF IN+1 .NE. OUT 
  
*         DUMP CIRCULAR BUFFER. 
  
 WTO3     BX1    X2 
          BX4    X6          SAVE WORD
          LX1    59-0 
          SX2    A2 
          NG     X1,WTO5     IF NOT BUSY
          ZR     X1,WTO5     IF BLANK FET 
          RECALL X2 
 WTO4     SA1    X2+2        READ IN
          BX6    X4 
          EQ     WTO2        CONTINUE WRITE 
 WRIF$    IF     DEF,WRIF$
 WTO5     SA1    X2          RE-ISSUE CURRENT WRITE FUNCTION
          SX6    774B 
          BX7    X6*X1
          RJ     =XCIO= 
 WRIF$    ELSE   1
 WTO5     WRITE  X2 
          EQ     WTO4        CONTINUE WRITE 
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 WTO=     EQU    /COMCWTO/WTO=
 QUAL$    ENDIF 
          ENDX
