### Babylonian Multiplication

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.)

Contributed by: Florian Weimer
Contributed on: October 13, 1999
License: Public Domain

Back