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