AdaPower Logged in as Guest
Ada Tools and Resources    Ada 95 Reference Manual
Ada Source Code Treasury
Bindings and Packages
Ada FAQ  Back
Babylonian Multiplication (Florian Weimer)

 ```with Ada.Text_IO; procedure Mult is generic Width : Positive; package Ints is Overflow : exception; type Bit is new Natural range 0 .. 1; type Bit_Index is new Natural range 0 .. Width - 1; type Int is array (Bit_Index) of Bit; -- LSB is at 0. Zero : constant Int := (others => 0); One : constant Int := (0 => 1, others => 0); function "+" (Left, Right : Int) return Int; function "*" (Left, Right : Int) return Int; function To_Natural (X : Int) return Natural; function To_Int (X : Natural) return Int; end; package body Ints is function "+" (Left, Right : Int) return Int is type Bit_And_Carry is record B, C : Bit; -- Result bit and new carry. end record; Bit_Adder : array (Bit, Bit, Bit) of Bit_And_Carry := (0 => (0 => (0 => (0,0), 1 => (1,0)), 1 => (0 => (1,0), 1 => (0,1))), 1 => (0 => (0 => (1,0), 1 => (0,1)), 1 => (0 => (0,1), 1 => (1,1)))); Carry : Bit := 0; X : Int; begin for Pos in Bit_Index loop declare Result : Bit_And_Carry := Bit_Adder (Carry, Left (Pos), Right (Pos)); begin X (Pos) := Result.B; Carry := Result.C; end; end loop; if Carry /= 0 then raise Overflow; else return X; end if; end "+"; procedure Double (X : in out Int) is begin X := X + X; end Double; function "*" (Left, Right : Int) return Int is Pos_Value : Int := Left; -- Multiple of Left coressponding to the current bit position in -- Left. X : Int := Zero; -- Temporary result. MSB_Set : Boolean := False; -- Most significant bit in Pos_Value is set, no more set -- bits in Right allowed. begin for Pos in Bit_Index loop if Right (Pos) /= 0 then if MSB_Set then raise Overflow; end if; X := X + Pos_Value; end if; if Pos_Value (Bit_Index'Last) = 1 then MSB_Set := True; else Double (Pos_Value); end if; end loop; return X; end "*"; function To_Natural (X : Int) return Natural is Position_Value : Natural := 1; Result : Natural := 0; begin for Pos in Bit_Index loop if X (Pos) /= 0 then Result := Result + Position_Value; end if; if Pos /= Bit_Index'Last then Position_Value := Position_Value * 2; end if; end loop; return Result; end To_Natural; function To_Int (X : Natural) return Int is Y : Natural := X; Position_Value : Int := One; Result : Int := Zero; begin for Pos in Bit_Index loop if Y mod 2 /= 0 then Result := Result + Position_Value; end if; if Pos /= Bit_Index'Last then Double (Position_Value); Y := Y / 2; end if; end loop; return Result; end To_Int; end Ints; package I is new Ints (8); use I; begin Ada.Text_IO.Put_Line (Natural'Image (To_Natural (To_Int (0) * To_Int (0)))); Ada.Text_IO.Put_Line (Natural'Image (To_Natural (To_Int (0) * To_Int (1)))); Ada.Text_IO.Put_Line (Natural'Image (To_Natural (To_Int (1) * To_Int (0)))); Ada.Text_IO.Put_Line (Natural'Image (To_Natural (To_Int (1) * To_Int (1)))); Ada.Text_IO.Put_Line (Natural'Image (To_Natural (To_Int (21) * To_Int (11)))); Ada.Text_IO.Put_Line (Natural'Image (To_Natural (To_Int (51) * To_Int (5)))); Ada.Text_IO.Put_Line (Natural'Image (To_Natural (To_Int (21) * To_Int (13)))); end Mult; (Note that this is neither fully tested nor very efficient, but you'll get the idea. Extending it to 32 bits is trivial except for the To_Natural and To_Int functions.) ``` (c) 1998-2004 All Rights Reserved David Botton 