COMCTIO 
COMMON
          CTEXT  COMCTIO - TEXT I/O ROUTINES. 
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 COMCTIO  SPACE  4,10 
***       COMCTIO - TEXT I/O. 
* 
*         COMCTIO PROVIDES ROUTINES TO PERFORM TEXT I/O FROM
*         COMPASS PROGRAMS.  TEXT IS ADDED TO A FILE IN CHARACTER 
*         INCREMENTS, INSTEAD OF IN WORD INCREMENTS.  NUMERIC DATA
*         ITEMS ARE CONVERTED TO EITHER LEFT OR RIGHT JUSTIFIED 
*         CHARACTERS.  NOS END OF LINE CONVENTIONS ARE INSURED. 
* 
*         NOTE   FET+5 IS USED BY THESE ROUTINES. 
 CTI      SPACE  4,15 
**        CTI - CONVERT TO DECIMAL DISPLAY CODE WITH LEADING ZERO.
*         SUPPRESSION.
* 
*         ENTRY  (X1) = NUMBER TO BE CONVERTED. 
* 
*         EXIT   (X3) = DECIMAL CONVERSION LEFT JUSTIFIED, BLANK FILLED 
*                (B6) = NUMBER OF CHARACTERS CONVERTED. 
* 
*         USES   A - 3, 4, 5. 
*                X - 1, 3, 4, 5, 6, 7.
*                B - 6. 
  
  
 CTI      SUBR               ENTRY/EXIT 
          SA4    CTIA        0.1P48+1 
          SA5    CTIB 
          PX1    X1 
          SB6    B0          CLEAR CHARACTER COUNT
          SA3    CTIC 
 CTI1     DX6    X1*X4       COMPUTE QUOTIENT 
          FX1    X1*X4
          UX7    X1          CHECK QUOTIENT 
          FX6    X6*X5       EXTRACT REMAINDER DIGIT
          SB6    B6+B1
          SX6    X6+1R0-1R   CONVERT DIGIT
          IX3    X6+X3
          LX3    -6          SHIFT ASSEMBLY 
          NZ     X7,CTI1     IF LOOP TO ZERO QUOTIENT 
          EQ     CTIX        RETURN 
  
 CTIA     CON    0.1P48+1 
 CTIB     CON    10.P 
 CTIC     CON    10H
 CTO      SPACE  4,15 
**        CTO - CONVERT TO OCTAL DISPLAY CODE WITH LEADING ZERO.
*         SUPPRESSION.
* 
*         ENTRY  (X1) = NUMBER TO BE CONVERTED. 
* 
*         EXIT   (X3) = OCTAL CONVERSION LEFT JUSTIFIED, BLANK FILLED.
*                (B6) = NUMBER OF CHARACTERS CONVERTED. 
* 
*         USES   A - 3. 
*                X - 1, 3, 4, 6.
*                B - 6. 
  
  
 CTO      SUBR               ENTRY/EXIT 
          SA3    CTIC 
          MX6    -3          (X2) = DIGIT MASK
          SB6    B0          CLEAR CHARACTER COUNT
 CTO1     BX4    -X6*X1      EXTRACT DIGIT
          SB6    B6+B1
          SX4    X4+1R0-1R   CONVERT DIGIT
          AX1    3           SHIFT OFF DIGIT
          IX3    X4+X3       ADD DIGIT TO ASSEMBLY
          LX3    -6 
          NZ     X1,CTO1     IF LOOP TO ZERO DIGIT
          EQ     CTOX        RETURN 
 WRC      SPACE  4,10 
**        WRC - WRITE CHARACTERS TO TEXT FILE.
* 
*         ENTRY  (X2) = TEXT FILE FET ADDRESS.
*                (X3) = FIRST WORD OF CHARACTERS TO WRITE.
*                (B6) = NUMBER OF CHARACTERS TO WRITE.
*                     = 0, IF TO WRITE TILL ZERO BYTE TERMINATOR. 
*                (A3) = ADDRESS OF FIRST WORD OF CHARACTERS, IF MORE
*                       THAN 10 CHARACTERS TO WRITE.
* 
*         USES   A - 1, 3, 4, 6, 7. 
*                X - 1, 3, 4, 5, 6, 7.
*                B - 2, 3, 4, 6, 7. 
  
  
 WRC8     SB5    X7+B6       ADVANCE CHARACTER COUNT IN BUFFER WORD 
          LT     B5,B4,WRC9  IF NOT INTO NEXT WORD
          SA6    B2 
          SB2    B2+B1       ADVANCE BUFFER ADDRESS 
          BX6    -X1*X3 
          SB5    B5-B4
          SB6    B6-B4
 WRC9     SA4    WRCC+B5     EXTRACT CHARACTERS TO STORE
          SX1    B6          UPDATE CHARACTER COUNT IN LAST BUFFER WORD 
          BX6    -X4*X6 
          SA6    B2          STORE LAST WORD
          SX6    B2          UPDATE IN
          IX7    X7+X1
          SA6    X2+2 
          SA7    X2+5 
  
 WRC=     SUBR               ENTRY/EXIT 
          SB4    10          (B4) = 10
          NZ     B6,WRC3     IF LINE LENGTH PRESENT 
          SA1    WRCA        40404040404040404040B
  
*         COMPUTE CHARACTER COUNT IN LINE.
  
          MX6    -6 
          BX7    -X6*X3 
          BX4    X3 
          ZR     X7,WRC2     IF SINGLE WORD 
          SB5    B1 
 WRC1     SA4    A3+B5
          SB6    B6+B4
          SB5    B5+B1
          BX7    -X6*X4 
 WRC2     NZ     X7,WRC1     IF NOT LAST WORD IN LINE 
          SX6    B1 
          IX6    X4-X6
          BX6    -X6+X4 
          BX6    X1*X6
          CX6    X6 
          SB6    X6+B6
  
*         TRANSFER CHARACTERS TO FILE BUFFER. 
  
 WRC3     SA4    X2+4 
          SA1    A4+B1       READ CHARACTER COUNT 
          SB7    X4          (B7) = LIMIT POINTER 
          BX7    X1          (X7) = FET + 5 
          SA4    WRCB+X7
          SA1    A4+B4       (X1) = WORD SPLITING MASK
          SB5    X4          (B5) = SHIFT COUNT FOR WORD
          SA4    X2+2 
          SB2    X4          (B2) = IN POINTER
          SA4    A4+B1
          SB3    X4          (B3) = OUT POINTER 
          SA4    B2          READ BUFFER WORD TO ADD CHARACTERS TO
          BX4    -X1*X4 
 WRC4     LX3    B5 
          BX6    X1*X3       EXTRACT LOWER CHARACTERS 
          BX6    X6+X4       MERGE WITH WORD IN BUFFER
          BX4    -X1*X3      EXTRACT CHARACTERS TO CARRY FORWARD
          LT     B6,B4,WRC8  IF PARTIAL WORD TO ADD TO BUFFER 
          SA6    B2 
          SB2    B2+B1
          SB6    B6-B4       DECREMENT CHARACTER COUNT
          SA3    A3+B1       READ NEXT WORD TO ADD
          EQ     B2,B7,WRC6  IF IN+1 = LIMIT - BUFFER WRAP
          NE     B2,B3,WRC4  IF IN+1 .NE. OUT - ROOM IN BUFFER
          SA1    X2 
          SX6    B2-B1       SET IN POINTER 
          LX1    59 
          SA6    X2+2 
          NG     X1,WRC7     IF BUFFER NOT BUSY 
          ZR     X1,WRC7     IF NULL FET
 WRC5     RECALL
          SA1    X2+3        REREAD POINTERS
          SB3    X1 
          SA1    X2+5 
          BX7    X1 
          SA1    WRCC+X7
          EQ     B2,B3,WRC7  IF NO ROOM IN BUFFER 
          EQ     WRC4        PROCESS NEXT WORD
  
 WRC6     SA1    X2+3        SET IN TO FIRST IF ROOM
          SB3    X1 
          SA1    X2+B1       FIRST
          SB2    X1 
          SA1    X2+5 
          BX7    X1 
          SA1    WRCC+X7
          NE     B2,B3,WRC4  IF OUT .NE. FIRST, SET IN TO FIRST 
 WRC7     WRITE  X2 
          EQ     WRC5        RECHECK POINTERS 
  
 WRCA     CON    40404040404040404040B
 WRCB     CON    0,54,48,42,36,30,24,18,12,6  SHIFT COUNT TABLE 
 WRCC     CON    -0          TABLE OF MASKS TO SPLIT WORD 
          CON    777777777777777777B,7777777777777777B,77777777777777B
          CON    777777777777B,7777777777B,77777777B,777777B,7777B,77B
 WRL      SPACE  4,10 
**        WRL - WRITE LINE TO FILE. 
* 
*         ENTRY  (X2) = FET ADDRESS.
* 
*         EXIT   LINE WRITTEN TO FILE.
* 
*         USES   A - 1, 3, 4, 6.
*                X - 1, 3, 4, 6.
*                B - 2. 
* 
*         MACROS WRITEW.
  
  
 WRL=     SUBR               ENTRY/EXIT 
          SA1    X2+2 
          SA3    X2+5 
          SX3    X3 
          LX3    -1 
          PL     X3,WRL1     IF EVEN CHARACTERS IN LAST WORD
          SA3    WRLA+X3
          SA4    X1          BLANK FILL TO EVEN CHARACTER 
          BX6    X4+X3
          SA6    A4 
          AX3    6
          NZ     X3,WRL1     IF WORD NOT COMPLETED
          WRITEW X2,A6,1
          SX1    =0 
  
 WRL1     WRITEW X2,X1,1     WRITE LAST WORD OF LINE TO BUFFER
          SA1    X2+5        CHECK FOR LINE LIMIT 
          UX1,B2 X1          (B2) = LINE COUNT
          SX6    X1          CLEAR CHARACTER COUNT
          BX1    X1-X6
          SB2    B2+B1
          PX6    X1,B2
          SA6    A1 
          EQ     WRL=        RETURN 
  
 WRLA     CON    55BS48,55BS36,55BS24,55BS12,1R 
          SPACE  4
          BASE   *
          ENDX
