COMCRDA 
COMMON
          CTEXT  COMCRDA - READ CODED LINE TO 6/12 STRING BUFFER. 
 RDA      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCRDA
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 RDA      SPACE  4
***       RDA - READ CODED LINE TO 6/12 ASCII STRING BUFFER.
*         R. S. HORECK.      71/05/19.
*         S. R. MCPHERSON.   74/09/30.
*         A. F. SKJOLDEBRAND 84/08/09. ( ADAPTION FROM COMCRDS )
 RDA      SPACE  4
***              RDA READS 1 CODED LINE FROM A CIO BUFFER TO A WORKING
*         BUFFER, ONE 6 OR 12 BIT CHARACTER/WORD. 
*         WORDS IN THE CIRCULAR BUFFER ARE UNPACKED AND STORED 1
*         CHARACTER/WORD IN THE WORKING BUFFER UNTIL END OF LINE
*         (0000) BYTE IS DETECTED.  IF THE CODED LINE TERMINATES BEFORE 
*         THE WORKING BUFFER IS FILLED, THE WORKING BUFFER IS PADDED
*         WITH SPACE CODES UNLESS UPON ENTRY THE COMPLEMENT OF THE
*         WORD COUNT OF THE WORKING BUFFER IS USED.  IN THIS CASE,
*         THE REMAINDER OF THE WORKING BUFFER IS NOT SPACE FILLED.
*         IF THE CODED LINE EXCEEDS THE SIZE OF THE 
*         WORKING BUFFER THE EXCESS CHARACTERS ARE IGNORED. 
* 
* 
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*                (B6) = FWA WORKING BUFFER. 
*                (B7) = WORD COUNT OF WORKING BUFFER. 
*                       IF (B7) .LT.  0, IT IS THE COMPLEMENT OF THE
*                       BUFFER LENGTH AND THE STRING BUFFER WILL
*                       NOT BE SPACE FILLED.
* 
*         EXIT   (X1) = 0 FOR TRANSFER COMPLETE.
*                (X1) = -1 IF EOF DETECTED ON FILE. 
*                (X1) = -2 IF EOI DETECTED ON FILE. 
*                (X1) = (B6) IF EOR WAS DETECTED ON FILE BEFORE 
*                             TRANSFER WAS COMPLETED. 
*                (B6) = ADDRESS PLUS ONE OF LAST CHARACTER FROM CODED 
*                             LINE IN WORKING BUFFER. 
*                (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  LCB=, RDX=.
  
  
 +        EQ     RDA2        ENTRY FROM LCB= ON A CONTINUATION READ 
  
*         SPACE FILL REMAINDER OF BUFFER. 
  
 RDA18    EQ     B6,B7,RDA=  IF WORKING BUFFER FULL 
          SX6    1R          * *
          SX4    B7-B6       (X4) = COUNT OF WORDA REMAINING IN BUFFER
          MX3    59          (X3) = -1
          SA6    B6          INITIALIZE (A6)
          SB2    X4 
          LX7    X6          (X7) = * * 
          EQ     B2,B1,RDA=  IF ONLY 1 WORD REMAINING 
          BX2    -X3*X4      (X2) = 0 IF EVEN WORD COUNT
          AX4    1           COUNT/2
          NZ     X2,RDA19    IF ODD WORD COUNT
          SA6    A6+B1       STORE NEXT WORD
          IX4    X4+X3       DECREMENT LOOP COUNT 
          SX2    A3-B1       RESET FET ADDRESS
          ZR     X4,RDA=     IF WORD COUNT = 2
  
 RDA19    IX4    X4+X3       DECREMENT LOOP COUNT 
          SA7    A6+1 
          SA6    A7+B1
          NZ     X4,RDA19    LOOP TO END OF BUFFER
          SX2    A3-1        RESET FET ADDRESS
          EQ     RDA=        EXIT 
  
 +        EQ     RDA2        ENTRY FROM LCB= ON A CONTINUATION READ 
  
 RDA=     PS                 ENTRY/EXIT 
          SA4    RDA18       SET RETURN ADDRESS 
  
          IF     -DEF,B1=1,1
          SB1    1
  
          SA1    X2+4        (B5) = LIMIT 
          PL     B7,RDA1     IF BUFFER TO BE SPACE FILLED 
          SA4    RDA=        SKIP SPACE FILLING THE BUFFER
          SB7    -B7
 RDA1     SA3    X2+B1       (X3) = FIRST, (A3) = ADDRESS OF FIRST
          SB7    B6+B7       (B7) = LWA+1 
          SX7    0
          SX4    B6          (X4) = FWA WORKING STORAGE 
          SB5    X1 
          SA7    RDAA        CLEAR ESCAPE CODE
  
*         INITIALIZE REGISTERS FOR TRANSFER.
  
 RDA2     SA1    A3+B1       IN 
          SA2    A1+B1       (B4) = OUT 
          SB4    X2 
          IX6    X1-X2       IN - OUT 
          SX1    B5          LIMIT
          PL     X6,RDA3     IF IN \ OUT
          IX6    X1-X2       LIMIT - OUT
 RDA3     ZR     X6,=XLCB=   IF NO FREE BUFFER SPACE
          MX2    -6          (X2) = CHARACTER MASK
          SB3    X6          (B3) = FREE BUFFER SPACE 
  
  
 RDA4     NE     B4,B5,RDA5  IF OUT .NE. LIMIT
          SA1    A3 
          SB4    X1          OUT = FIRST
 RDA5     SX6    B4          RESET OUT
          SA6    A2 
          ZR     B3,RDA2     IF FREE BUFFER SPACE EXHAUSTED 
  
*         READ WORD FROM BUFFER.
  
          SA1    RDAA 
          BX7    X1          (X7) = PREVIOUS ESCAPE CODE
          SA1    B4 
          SB4    B4+B1
          EQ     B7,B6,RDA15 IF MAXIMUM CHARACTERS PROCESSED
          SB2    B0+         INITIALIZE CHARACTER COUNT 
          NG     X1,RDA6     IF POSSIBLY 10 SEMI-COLONS 
          ZR     X1,RDA13    IF ZERO WORD SKIP UNPACKING
  
*         UNPACK WORD TO WORKING BUFFER 
  
 RDA6     LX1    6
          SB2    B2+B1       BUMP CHARACTER COUNT 
          BX6    -X2*X1      PICK UP CHARACTER
          BX1    X2*X1       ERASE CHARACTER
          LX7    6
          BX6    X7+X6
          NZ     X7,RDA7     IF ESCAPE CODE PRESENT 
          SX7    X6-76B 
          ZR     X7,RDA8     IF ESCAPE 76 IS PRESENT
          SX7    X6-74B 
          ZR     X7,RDA8     IF ESCAPE 74 IS PRESENT
 RDA7     SA6    B6+
          SB6    B6+1 
          EQ     B6,B7,RDA15 IF MAXIMUM CHARACTERS PROCESSED
          SX6    0           CLEAR ESCAPE CHARACTER 
 RDA8     BX7    X6          USE NEW ESCAPE CODE
          NZ     X1,RDA6     IF MORE CHARACTERS IN THIS WORD
          SA7    RDAA        SAVE ESCAPE CODE FOR NEXT WORD 
          SX6    B2-9 
          EQ     RDA10
  
 RDA9     SA6    B6 
          SB6    B6+B1
          EQ     B6,B7,RDA15 IF MAXIMUM CHARACTERS PROCESSED
          NZ     X1,RDA6     IF MORE CHARACTERS THIS WORD 
          SX6    B2-9 
 RDA10    SB2    B0          RESET CHARACTER COUNT
          SB3    B3-B1       DECREMENT FREE BUFFER SPACE
          NG     X6,RDA15    IF END OF LINE 
          ZR     B3,RDA12    IF FREE BUFFER SPACE EXHAUSTED 
          SA1    B4          GET NEXT WORD TO BE UNPACKED 
          SB4    B4+B1
          NG     X1,RDA11    IF POSSIBLY 10 SEMI-COLONS 
          ZR     X1,RDA15    IF ZERO WORD, END OF LINE
 RDA11    NZ     X6,RDA6     IF WORD COMPLETLY PROCESSED
          EQ     RDA9        PROCESS LAST CHARACTER 
  
 RDA12    NZ     X6,RDA4     IF LAST CHARACTER PROCESSED
          SA6    B6          PROCESS LAST CHARACTER 
          SB6    B6+B1
          EQ     RDA4 
  
 RDA13    SB2    X4 
          NE     B6,B2,RDA14 IF AT LEAST 1 CHARACTER IN WORKING BUFFER
          SX6    1R          ASSURE 1 BLANK IN STRING BUFFER
          SB6    B2+B1
          SA6    B2 
 RDA14    SA1    B6-B1       CHECK LAST CHARACTER IN BUFFER 
          NZ     X1,RDA15    IF NOT BEGINNING OF END OF LINE
          SB6    B6-1        ERASE CHARACTER
  
*         SEARCH FOR END OF LINE
  
 RDA15    SA1    B4-1        READ LAST WORD PROCESSED 
          MX7    -12
          BX7    -X7*X1      CHECK FOR END OF LINE
          SB3    B3-1        DECREMENT FREE BUFFER SPACE
          NZ     X7,RDA4     IF END OF LINE NOT FOUND 
          NE     B4,B5,RDA16 IF OUT .NE. LIMIT
          SB4    X3+         OUT .EQ. FIRST 
 RDA16    SA1    A3+B1       RESET IN 
          SB2    X4          FWA WORKING BUFFER 
          SB3    X1+         (B3) = IN
          GE     B6,B2,=XRDX= 
          SB6    B2+
          EQ     =XRDX=      EXIT 
  
 RDAA     DATA   0           ESCAPE CODE TEMPORARY STORAGE
  
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 RDA=     EQU    /COMCRDA/RDA=
 QUAL$    ENDIF 
          ENDX
