*DECK DB$COCT 
          IDENT  DB$COCT
          TITLE  DB$COCT  --  CONVERT BINARY TO OCTAL, LEADING ZEROS
          COMMENT  CONVERT BINARY TO OCTAL, LEADING ZEROS 
*#
* *   DB$COCT -- CONVERT BINARY TO OCTAL         PAGE  1
* *              WITH LEADING ZEROS.
* *   BOB MCALLESTER                             DATE  04/13/81 
* 
* DC  PURPOSE 
* 
*     CONVERT A BINARY NUMBER TO A DISPLAY CODED OCTAL NUMBER.
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
* 
*     FUNC DB$COCT(BINARY,LENGTH) C(10);
* 
*     BINARY                 A NUMBER IN INTEGER FORMAT.
* 
*     LENGTH                 THE NUMBER OF CHARACTERS IN THE FIELD THAT 
*                            IS TO RECEIVE THE DISPLAY CODED OUTPUT.
*                            LENGTH MUST BE GREATER THAN ZERO AND 
*                            NO GREATER THAN TEN. 
* 
* DC  EXIT CONDITIONS 
* 
*     THE DISLAY CODED OCTAL IS RETURNED AS A FUNCTION VALUE (X6).
*     IF THE CONVERTED OCTAL DISPLAY EXCEEDS 'LENGTH' DIGITS, 
*     THEN ASTERISKS ARE RETURNED.
* 
* DC  CALLING ROUTINES
* 
*     THIS IS A UTILITY PROCEDURE THAT IS CALLED BY MANY ROUTINES.
* 
* DC  CALLED ROUTINES 
* 
*     NONE
* 
* DC  DESCRIPTION 
* 
*     THE OUTPUT IS A TEN CHARACTER STRING. 
*     THE CONVERTED DISPLAY CODED NUMBER IS CONTAINED, RIGHT JUSTIFIED, 
*     IN THE LEFT MOST 'LENGTH' CHARACTERS OF THAT STRING.
* 
*     ALL INSIGNIFICANT CHARACTER POSITIONS CONTAIN ZEROS.
*     THIS INCLUDES THE LEADING POSITIONS AND THE REMAINDER OF THE TEN
*     CHARACTERS BEYOND THE FIRST 'LENGTH' CHARACTERS.
* 
*     IF THE NUMBER OF SIGNIFICANT CHARACTERS EXCEEDS 'LENGTH', 
*     THEN A STRING OF TEN ASTERISKS IS RETURNED. 
* 
*     ASTERISKS ARE ALSO RETURNED IF 'BINARY' IS NEGATIVE.
*#
  
  
*     THE CONVERSION ROUTINE IS TAKEN FROM THE COMPASS COMMON DECK
*     COMCCOD.
          SPACE  5,10 
          ENTRY  DB$COCT
  
DB$COCT   EQ   *+1S17        (X1) = LOCATION OF BINARY NUMBER 
          SA2    A1+1        (X2) = LOCATION OF LENGTH PARAMETER
          SA1    X1          (X1) = BINARY NUMBER 
          MX6    -3          (X6) = MASK FOR EXTRACTING THREE BITS
          SA2    X2+         (X2) = LENGTH (CHARACTERS) 
          MI     X1,COCT2    NEGATIVE NUMBERS ARE NOT CONVERTED 
          IX3    X2+X2       (X3) = LENGTH *2 
          LX2    3           (X2) = LENGTH *8 
          SB4    60 
          IX3    X3-X2       (X3) = NEGATIVE BIT LENGTH 
          SB2    X3+B4       (B2) = INITIAL SHIFT COUNT 
          SA4    COCTA       (X4) = INITIAL ASSEMBLY (ZEROS)
          SB3    6
          SPACE  3,10 
*         CONVERSION LOOP 
  
COCT1     BSS    0
          BX7    -X6*X1      EXTRACT THREE BITS FROM THE BINARY NUMBER
          LX4    -6          SHIFT THE OCTAL ASSEMBLY WORD
          SB2    B2+B3       ADJUST THE SHIFT COUNT 
          AX1    3           SHIFT OFF THE THREE BINARY BITS
          IX4    X4+X7       ADD DIGIT TO THE DISPLAY ASSEMBLY
          NZ     X1,COCT1    LOOP UNTIL ONLY ZEROS REMAIN 
  
*         POSITION THE RESULTING DISPLAY CODED NUMBER.
  
          LX4    -6 
          LX6    X4,B2
  
*         CHECK FOR OVERFLOW
  
          GE     B4,B2,DB$COCT  EXIT, RESULT IS WITHIN BOUNDS 
  
COCT2     BSS    0
          SA5    STARS
          BX6    X5          RETURN ASTERISKS 
          EQ     DB$COCT
  
COCTA     CON    10H0000000000
STARS     CON    10H**********
  
          END 
