COMCCHD 
COMMON
          CTEXT  COMCCHD - CONSTANT TO HEX DISPLAY CODE CONVERSION. 
 COMCCHD  SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCCHD
  
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 COMCCHD  SPACE  4,10 
***       CHD - CONSTANT TO HEXADECIMAL DISPLAY CODE CONVERSION.
*         P. D. FARRELL.     76/04/07.
 COMCCHD  SPACE  4,10 
***              CHD CONVERTS UP TO 10 DIGITS (40 BITS) TO HEXADECIMAL
*         DISPLAY CODE WITH LEADING ZERO SUPPRESSION.  CONVERSION 
*         CONTAINS SPACE FILL AND IS RIGHT AND LEFT JUSTIFIED.
* 
*         ENTRY  (X1) = QUANTITY TO BE CONVERTED. 
* 
*         EXIT   (X6) = HEXADECIMAL CONVERSION, RIGHT JUSTIFIED.
*                (X4) = HEXADECIMAL CONVERSION, LEFT JUSTIFIED. 
*                (B2) = 6*COUNT OF DIGITS CONVERTED.
* 
*         USES   A - 4. 
*                X - 1, 2, 3, 4, 6. 
*                B - 2, 3, 4. 
  
  
 CHD      PS                 ENTRY/EXIT 
          MX2    -40D        CLEAR INVALID BITS 
          SA4    CHDA        (X4) = 10H 
          BX1    -X2*X1 
          SB3    6           (B3) = ASSEMBLY SHIFT
          SX2    17B         (X2) = HEX DIGIT MASK
          SB2    B0+         (B2) = JUSTIFICATION SHIFT COUNT 
          SB4    1R0-1R      (B4) = 0-9 CONVERSION
 CHD1     BX6    X2*X1       EXTRACT DIGIT
          LX4    -6          SHIFT ASSEMBLY 
          SX3    X6-0#A      CHECK DIGIT
          NG     X3,CHD2     IF .LT. #A 
          SX6    X3+1RA-1R0  BIAS FOR A-F CONVERSION
 CHD2     SX3    X6+B4       CONVERT DIGIT
          IX4    X4+X3       ADD TO ASSEMBLY
          AX1    4           SHIFT OFF DIGIT
          SB2    B2+B3       INCREMENT JUSTIFICATION SHIFT
          NZ     X1,CHD1     LOOP TO ZERO DIGIT 
          LX4    -6          LEFT JUSTIFY ASSEMBLY
          LX6    X4,B2       RIGHT JUSTIFY ASSEMBLY 
          EQ     CHD         RETURN 
  
 CHDA     CON    1H          ASSEMBLY MASK
 COMCCHD  SPACE  4,5
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 CHD      EQU    /COMCCHD/CHD 
 QUAL$    ENDIF 
          ENDX
