*DECK DB$COCB 
          IDENT  DB$COCB
          TITLE  DB$COCB  --  CONVERT BINARY TO OCTAL, LEADING BLANKS 
          COMMENT  CONVERT BINARY TO OCTAL, LEADING BLANKS
*#
* *   DB$COCB -- CONVERT BINARY TO OCTAL         PAGE  1
* *              WITH LEADING BLANKS
* *   BOB MCALLESTER                             DATE  04/13/81 
* 
* DC  PURPOSE 
* 
*     CONVERT A BINARY NUMBER TO A DISPLAY CODED OCTAL NUMBER.
*     SUPPRESS LEADING ZEROS.  (FILL WITH BLANKS) 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
* 
*     FUNC DB$COCB(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  BLANKS.
*     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$COCB
  
DB$COCB   EQ   *+1S17        (X1) = LOCATION OF BINARY NUMBER 
          SA2    A1+1        (X2) = LOCATION OF LENGTH PARAMETER
          MX6    -3          (X6) = MASK FOR EXTRACTING THREE BITS
          SA2    X2          (X2) = LENGTH (CHARACTERS) 
          SA1    X1+         (X1) = BINARY NUMBER 
          IX3    X2+X2       (X3) = LENGTH *2 
          LX2    3           (X2) = LENGTH *8 
          MI     X1,COCB2    NEGATIVE NUMBERS ARE NOT CONVERTED 
          SB4    60 
          IX3    X3-X2       (X3) = NEGATIVE BIT LENGTH 
          SB2    X3+B4       (B2) = INITIAL SHIFT COUNT 
          SA4    COCBA       (X4) = INITIAL ASSEMBLY (BLANKS) 
          SB5    1R0-1R      BLANK TO ZERO CONVERSION CONSTANT
          SB3    6
          SPACE  3,10 
*         CONVERSION LOOP 
  
COCB1     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 
          SX3    X7+B5       ADD BLANK TO ZERO CONVERSION CONSTANT
          AX1    3           SHIFT OFF THE THREE BINARY BITS
          IX4    X4+X3       ADD DIGIT TO THE DISPLAY ASSEMBLY
          NZ     X1,COCB1    LOOP UNTIL ONLY ZEROS REMAIN 
  
*         POSITION THE RESULTING DISPLAY CODED NUMBER.
  
          LX4    -6 
          LX6    X4,B2
  
*         CHECK FOR OVERFLOW
  
          GE     B4,B2,DB$COCB  EXIT, RESULT IS WITHIN BOUNDS 
  
COCB2     BSS    0
          SA5    STARS
          BX6    X5          RETURN ASTERISKS 
          EQ     DB$COCB
  
COCBA     CON    1H 
STARS     CON    10H**********
  
          END 
