*DECK DB$CDEB 
          IDENT  DB$CDEB
          TITLE  DB$CDEB  --  CONVERT BINARY TO DECIMAL, LEADING BLANKS 
          COMMENT  CONVERT BINARY TO DECIMAL, LEADING BLANK 
*#
* *   DB$CDEB -- CONVERT BINARY TO DECIMAL       PAGE  1
* *              WITH LEADING BLANKS. 
* *   BOB MCALLESTER                             DATE  04/13/81 
* 
* DC  PURPOSE 
* 
*     CONVERT A BINARY NUMBER TO A DISPLAY CODED DECIMAL NUMBER.
*     SUPPRESS LEADING ZEROS.  (FILL WITH BLANKS) 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
* 
*     FUNC DB$CDEB(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 DECIMAL VALUE IS RETURNED AS A FUNCTION VALUE (X6). 
*     IF THE CONVERTED DECIMAL VALUE 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 'BINARY' IS NEGATIVE, THE OUTPUT IS THE ABSOLUTE VALUE 
*     PREFIXED BY A MINUS SIGN.  THE MINUS SIGN IS COUNTED AS A 
*     SIGNIFICANT CHARACTER IN THE OUTPUT STRING. 
* 
*     IF THE NUMBER OF SIGNIFICANT CHARACTERS EXCEEDS 'LENGTH', 
*     THEN A STRING OF TEN ASTERISKS IS RETURNED. 
*#
  
  
*     THE CONVERSION ROUTINE IS TAKEN FROM THE COMPASS COMMON DECK
*     COMCCDD.
          SPACE  5,10 
          ENTRY  DB$CDEB
  
DB$CDEB   EQ   *+1S17 
          SB1    1
          SA2    A1+B1       (X2) = LOCATION OF LENGTH PARAMETER
          SA2    X2          (X2) = LENGTH (CHARACTERS) 
          SB5    1R0-1R      (B5) = CONVERSION CONSTANT 
          SA1    X1          (X1) = BINARY NUMBER 
          SB6    B1 
          PL     X1,CDEB0 
          BX1    -X1         CONVERT TO POSITIVE NUMBER 
          SB6    -B6         FLAG THE NEGATIVE
  
CDEB0     BSS    0
          PX1    X1 
          IX3    X2+X2       (X3) = LENGTH *2 
          SB4    60 
          LX2    3           (X2) = LENGTH *8 
          IX3    X3-X2       (X3) = NEGATIVE BIT LENGTH 
          SA2    CDEBA       (X2) = .1P48+1 
          SB2    X3+B4       (B2) = INITIAL SHIFT COUNT 
          SA3    A2+B1       (X3) = 10.P
          SA4    A3+B1       (X4) = INITIAL ASSEMBLY
          SB3    6
          SPACE  3,10 
*         CONVERSION LOOP 
  
CDEB1     DX6    X1*X2       COMPUTE QUOTIENT (FRACTIONAL PART) 
          FX1    X1*X2                        (INTEGER PART)
          LX4    -6          SHIFT ASSEMBLY 
          UX7    X1          CHECK QUOTIENT 
          FX6    X6*X3       EXTRACT REMAINDER DIGIT
          SB2    B2+B3       ADJUST SHIFT COUNT 
          SX6    X6+B5       CLEAR EXPONENT AND ADD CONVERSION CONSTANT 
          IX4    X6+X4       ADD DIGIT TO ASSEMBLY
          NZ     X7,CDEB1    LOOP TIL QUOTIENT IS ZERO
  
*         INSERT A MINUS SIGN IF THE NUMBER WAS NEGATIVE. 
  
          PL     B6,CDEB2 
          SX6    1R--1R 
          LX4    -6 
          IX4    X4+X6       INSERT THE MINUS SIGN
          SB2    B2+6 
CDEB2     BSS    0
  
*         POSITION THE RESULTING DECIMAL NUMBER.
  
          LX4    -6 
          LX6    X4,B2
  
*         CHECK FOR OVERFLOW
  
          GE     B4,B2,DB$CDEB  EXIT, RESULT IS WITHIN BOUNDS 
  
          SA5    STARS
          BX6    X5          RETURN ASTERISKS 
          EQ     DB$CDEB
  
CDEBA     CON    0.1P48+1 
          CON    10.P 
          CON    1H 
STARS     CON    10H**********
  
          END 
