Mersenne: Fw: Binary to Decimal Conversion

[Milton Brown]

 

----- Original Message -----

From: Milton Brown

To: [EMAIL PROTECTED]

Cc: [EMAIL PROTECTED]

Sent: Saturday, April 03, 1999 11:51 AM

Subject: Binary to Decimal Conversion

Attached is a Pascal Program that will convert a Binary Number

of any length (currently 250 digits) to its Decimal Form. It does

this by a "Decimal Search" on the high order digits. This is similar

to a "Binary Search". If you want the executable program, just

e-mail me at [EMAIL PROTECTED].

 

                                        Milton L. Brown

PROGRAM Binary;

{   By  Milton L. Brown  3-15-1999

        [EMAIL PROTECTED]

    Converts  a Binary Number  of any length to  a Decimal Number
    -------------------------------------------------------------
    Uses a "Decimal Search" on high order digits, similar to
    a Binary Search.

    Example Output:

       Enter binary number here : 111010110111100110100010101

       1 2345 6789
}

LABEL line1, line2;

TYPE
     iarray = array[1..1000] of integer;
     MaxStg = string[250];

VAR st1, st2 : MaxStg;
    r1, q1, twos : integer;

VAR a, b, len1 : integer;
    i, j, k, out, carry, carry2 : integer;
    a1, b1, c1, d1, e1, binary, answer : iarray;
    log2 : real;
    binary_d, number_d, jj, kk, current : integer;

FUNCTION chardig( k : CHAR) : INTEGER;
   BEGIN chardig := ORD( k ) - 48  END;


PROCEDURE digit1( k : MaxStg; var a : iarray );
   VAR i: INTEGER; BEGIN
   FOR i:= 1 TO length(k) DO  a[length(k)-i+1] := chardig(k[i]) END;

PROCEDURE initial; BEGIN
   carry := 0; out := 0;
   FOR i:= 1 TO 1000 DO a1[i] := 0;
   FOR i:= 1 TO 1000 DO b1[i] := 0;
   FOR i:= 1 TO 1000 DO c1[i] := 0;
   FOR i:= 1 TO 1000 DO d1[i] := 0;
   FOR i:= 1 TO 1000 DO binary[i] := 0;
END;

procedure clear; BEGIN  FOR i:= 1 to 1000 DO answer[i] := 0; END;

PROCEDURE REMAIN(a1: iarray; var r1 : integer; var b1 : iarray); BEGIN
   r1 := 0;  j := 1;
   FOR i:= len1 DOWNTO 1 DO  BEGIN
       twos  := r1*10 + a1[i];
       q1    := trunc(twos/2);
       b1[i] := q1;
       r1    := twos - 2*q1;
   END;
END;

FUNCTION compare2(c1, binary : iarray):integer;
LABEL lend;
BEGIN
   FOR i:= (4*len1) downto 1 do     BEGIN
       if c1[i] > binary[i] then begin compare2 := 1; goto lend; end;
       if c1[i] < binary[i] then begin compare2 := -1; goto lend; end;
   END;
   compare2 := 0;
   lend :
END;

PROCEDURE convert2(a1:iarray;VAR c1:iarray);
VAR carry1, carry2, in1, out : INTEGER; BEGIN
   FOR k := 1 TO (4*len1) DO BEGIN
      remain(a1,r1,b1);
      c1[k] := r1;
      FOR i:= 1 TO len1 DO a1[i] := b1[i];
   END;
END;

BEGIN
   log2 := 0.3010299957;

   line1: initial;
   WRITE('Enter binary  number here : '); READLN(st1);

   binary_d := length(st1);
   number_d := trunc(log2*binary_d) + 1;
   writeln(binary_d,' ',number_d);

   digit1(st1,binary);

   clear;
   current := number_d;
   len1 := number_d;

   jj := number_d;
   len1 := jj;
   line2:
   FOR kk := 1 to 10 do BEGIN
      answer[jj] := kk;
      convert2(answer,c1);
      if compare2(c1,binary) = 1 then begin
         answer[jj] := kk-1;
         jj := jj-1;
         goto line2;
      END;
   END;

writeln(st1);
   FOR i:= len1 DOWNTO 1 DO BEGIN
      IF (i MOD 4) = 0 THEN write(' ');
      WRITE(answer[i]);
   END;writeln;

   GOTO line1;

END.