COMCCKD 
COMMON
          CTEXT  COMCCKD - COPY K-DISPLAY TO FILE.
          SPACE  4
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   COMCCKD
 QUAL$    ENDIF 
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 COMCCKD  SPACE  4,10 
***       COMCCKD - COPY K-DISPLAY TO FILE. 
* 
*         J. D. HOLMBECK     84/01/15.
 EQUIV    SPACE  4,10 
**        GENERAL EQUIVILENCES. 
  
  
 CKDC$    IF     -DEF,CDKC$ 
 CKDC$    EQU    64          MAXIMUM NUMBER OF CHARACTERS PER LINE
 CKDC$    ENDIF 
 CKDI$    IF     -DEF,CKDI$  Y-COORDINATE INCREMENT FOR K-DISPLAY 
 CKDI$    EQU    15 
 CKDI$    ENDIF 
 CKDL$    IF     -DEF,CKDL$ 
 CKDL$    EQU    40          MAXIMUM NUMBER OF LINES PER DISPLAY
 CKDL$    ENDIF 
 CKDW$    EQU    CKDC$/10+1  NUMBER OF WORDS PER DISPLAY LINE 
 CKDY$    IF     -DEF,CKDY$  Y-COORDINATE OF K-DISPLAY
 CKDY$    EQU    7707B
 CKDY$    ENDIF 
 WORKING  SPACE  4,10 
**        WORKING STORAGE.
  
  
 SPS      BSS    1           SPACE PREFIX STATUS
 WSP      DATA   10H            WORD OF SPACES
 CKD      SPACE  4,25 
***       CKD - COPY K-DISPLAY TO FILE. 
* 
*         ENTRY  (B6) = FWA OF K-DISPLAY BUFFER.
*                ((B6)) - BIT 48 SET IF CODED FORMAT. 
*                (B7) .NE. 0 IF PREFIX EACH LINE BY 10 SPACES.
*                (X2) = FET ADDRESS.
*                CKDP$ - IF DEFINED, IGNORE PROGRAM FORMAT. 
*                CKDC$ = MAXIMUM NUMBER OF CHARACTERS PER LINE. 
*                        SET TO 64 IF NOT DEFINED.
*                CKDI$ = Y-COORDINATE INCREMENT FOR K-DISPLAY.  SET TO
*                        THE KDC DEFAULT 15 IF NO DEFINED.
*                CKDY$ = Y-COORDINATE OF K-DISPLAY.  SET TO KDC DEFAULT 
*                        7707B IF NOT DEFINED.
*                CKDL$ = MAXIMUM NUMBER OF LINES PER DISPLAY. 
*                        SET TO 40 IF NOT DEFINED.
*                CKDS$ - IF DEFINED, DO NOT SPACE FILL COLONS.
* 
*         EXIT   K-DISPLAY COPIED TO FET BUFFER.
* 
*         USES   A - 1, 2, 6. 
*                X - 1, 2, 6. 
* 
*         CALLS  CCK, CPK.
* 
*         XREF   COMCMAC, COMCMBS, COMCSFN, COMCWTH, COMCWTW, COMCZTB.
  
  
 CKD      SUBR               ENTRY/EXIT 
          SX6    B7          SAVE SPACE PREFIX STATUS 
          SA6    SPS
 CKDP$    IF     -DEF,CKDP$ 
          SA1    B6          CHECK FOR CODED FLAG 
          LX1    59-48
 CKDP$    ENDIF 
          SB6    B6+B1
 CKDP$    IF     -DEF,CKDP$ 
          NG     X1,CKD1     IF CODED FORMAT
          BX6    X2          SAVE FET ADDRESS 
          SA6    CKDA 
          RJ     CPK         COPY PROGRAM FORMAT K-DISPLAY TO FILE
          SA2    CKDA        GET FET ADDRESS
 CKDP$    ENDIF 
 CKD1     RJ     CCK         COPY CODED FORMAT K-DISPLAY TO FILE
          EQ     CKDX        RETURN 
  
 CKDA     BSS    1           FET ADDRESS
 CCK      SPACE  4,15 
**        CCK - COPY CODED FORMAT K-DISPLAY.
* 
*         ENTRY  (B6) = FWA OF K-DISPLAY BUFFER.
*                (X2) = FET ADDRESS.
* 
*         EXIT   K-DISPLAY IMAGE COPIED TO FET BUFFER.
* 
*         USES   A - 1, 6.
*                B - 6. 
*                X - 0, 1, 6. 
* 
*         CALLS  CWL. 
* 
*         MACROS WRITEH, WRITEW.
  
  
 CCK      SUBR               ENTRY/EXIT 
          SX6    B6          SAVE FWA OF K-DISPLAY
          SA6    CCKA 
 CCK1     SA1    CCKA        CHECK IF END OF DISPLAY
          SA1    X1 
          ZR     X1,CCKX     IF END OF DISPLAY
          MX0    12          CHECK IF POINTER 
          BX6    X0*X1
          BX6    X0-X1
          NZ     X6,CCK2     IF NOT POINTER 
          SX6    X1          RESET K-DISPLAY ADDRESS
          SA6    CCKA 
          EQ     CCK1        CHECK NEXT LINE
  
 CCK2     SA1    SPS
          ZR     X1,CCK3     IF NO WORD OF SPACES 
          WRITEW X2,WSP,1    INSERT A WORD OF SPACES
 CCK3     SA1    CCKA 
          SB6    X1 
          RJ     CWL         COUNT WORDS IN LINE
          SX6    B6+B7       RESET K-DISPLAY ADDRESS
          SA6    CCKA 
          WRITEH X2,B6,B7    COPY LINE TO FET BUFFER
          EQ     CCK1        CHECK NEXT LINE
  
 CCKA     BSS    1           K-DISPLAY ADDRESS
 CKDP$    IF     -DEF,CKDP$ 
 CPK      SPACE  4,15 
**        CPK - COPY PROGRAM FORMAT K-DISPLAY.
* 
*         ENTRY  (B6) = FWA OF K-DISPLAY BUFFER.
* 
*         EXIT   (B6) = FWA OF CODED FORMAT K-DISPLAY BUFFER. 
* 
*         USES   A - 1, 2, 3, 6.
*                B - 2, 3.
*                X - 0, 1, 2, 3, 4, 6, 7. 
* 
*         CALLS  MBS, SFN, ZTB. 
  
  
 CPK12    SB6    CPKA        SET BUFFER ADDRESS 
  
 CPK      SUBR               ENTRY/EXIT 
          SA1    WSP         SPACE FILL WORKING BUFFER
          BX6    X1 
          SB2    CPKA 
          SB3    CPKAE
 CPK1     GE     B2,B3,CPK2  IF END OF BUFFER 
          SA6    B2 
          SB2    B2+B1
          EQ     CPK1        CHECK NEXT WORD
  
 CPK2     SA1    B6          SET INITIAL K-DISPLAY ADDRESS
          SA2    CPKA        SET INITIAL WORKING BUFFER ADDRESS 
          SB2    59          SET INITIAL WORKING BUFFER BIT POSITION
 CPK3     ZR     X1,CPK6     IF END OF K-DISPLAY
          MX0    2           CHECK IF NORMAL CHARACTERS 
          BX6    X0*X1
          BX6    X0-X6
          ZR     X6,CPK4     IF SPECIAL CHARACTERS
          SB4    10*6        SET BIT COUNT
          SB3    59          SET UPPER BIT POSITION 
          RJ     MBS         MOVE BIT STRING
          EQ     CPK3        CHECK NEXT WORD
  
 CPK4     MX0    12          CHECK IF POINTER 
          BX6    X0*X1
          BX6    X0-X6
          NZ     X6,CPK5     IF NOT POINTER 
          SA1    X1          RESET K-DISPLAY ADDRESS
          EQ     CPK3        CHECK NEXT WORD
  
 CPK5     BX6    X0*X1       GET X-COORDINATE 
          LX6    12 
          SX6    X6-6000B 
          AX6    3           (X6) = CHARACTER POSITON 
          SX3    6
          IX6    X6*X3
          SX4    X6 
          SX3    60 
          IX3    X6/X3       (X3) = WORD POSITION IN LINE 
          SX7    60 
          IX6    X3*X7
          IX6    X4-X6
          IX6    X7-X6
          SB2    X6-1        (B2) = BIT POSITION IN WORD
          LX0    -12+60      GET Y-COORDINATE 
          BX6    X0*X1
          LX6    24 
          SX4    CKDY$
          IX6    X4-X6
          SX4    CKDI$
          IX6    X6/X4       (X6) = LINE NUMBER 
          SX4    CKDW$
          IX6    X6*X4
          IX6    X6+X3
          SA2    X6+CPKA     (A2) = NEW ADDRESS IN WORKING BUFFER 
          SB4    6*6         SET BIT COUNT
          SB3    35          SET UPPER BIT POSITION 
          RJ     MBS         MOVE BIT STRING
          EQ     CPK3        CHECK NEXT WORD
  
 CPK6     SA1    CPKA        CONVERT COLONS TO SPACES 
 CPK7     SB2    A1-CPKAE 
          PL     B2,CPK8     IF END OF BUFFER 
 CKDS$    IF     DEF,CKDS$
          RJ     SFN         SPACE FILL NAME
 CKDS$    ELSE
          RJ     ZTB         COVERT ZEROES TO BLANKS
 CKDS$    ENDIF 
          SA6    A1 
          SA1    A1+B1
          EQ     CPK7        CHECK NEXT WORD
  
 CPK8     SA1    CPKAE-1     CLEAR EXTRA SPACES 
          SA3    WSP
 CPK9     BX6    X3-X1
          NZ     X6,CPK10    IF NOT EXTRA SPACES
          SA6    A1 
          SA1    A1-B1
          EQ     CPK9        CHECK NEXT WORD
  
 CPK10    MX0    48          SET ENDS OF LINE IN BUFFER 
          SA1    CPKA+CKDW$-1 
 CPK11    SB2    A1-CPKAE 
          PL     B2,CPK12    IF END OF BUFFER 
          BX6    X0*X1
          SA6    A1 
          SA1    A1+CKDW$ 
          EQ     CPK11       CHECK NEXT WORD
  
 CPKA     BSS    CKDL$*CKDW$ WORKING BUFFER 
 CPKAE    CON    0           END OF WORKING BUFFER
 CKDP$    ENDIF 
 CWL      SPACE  4,10 
**        CWL - COUNT WORDS IN LINE.
* 
*         ENTRY  (B6) = FWA OF LINE.
* 
*         EXIT   (B7) = NUMBER OF WORDS IN LINE.
* 
*         USES   A - 1. 
*                X - 0, 1.
  
  
 CWL      SUBR               ENTRY/EXIT 
          MX0    -12
          SB7    B0 
 CWL1     SA1    B6+B7       CHECK FOR END OF LINE
          BX1    -X0*X1 
          SB7    B7+B1
          NZ     X1,CWL1     IF NOT END OF LINE 
          EQ     CWLX        RETURN 
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 CKD      EQU    /COMCCKD/CKD 
 QUAL$    ENDIF 
          ENDX
