Vovanium
/
VSSL
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* factored out naked big number arithmetic code

This commit is contained in:
Vovanium 2023-07-13 01:32:14 +03:00
parent 7fd311cc3f
commit 0df23e1112
5 changed files with 104 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
source/library/vssl-extensible_arithmetic.adb Normal file
View File

@ -0,0 +1,17 @@
package body VSSL.Extensible_Arithmetic is
procedure Multiply (
CO,
M : out Limb;
A,
B : in Limb;
CI : in Limb := 0)
is
P : Product;
begin
P := Product (A) * Product (B) + Product (CI);
M := Limb (P and (2**Limb_Size - 1));
CO := Limb (Shift_Right (P, Limb_Size));
end Multiply;
end VSSL.Extensible_Arithmetic;

30
source/library/vssl-extensible_arithmetic.ads Normal file
View File

@ -0,0 +1,30 @@
--
-- Basic arbitrary precision arithmeric building blocks.
-- 32 bit (with use of 64 bit intemediate type) portable implementation
--
with Interfaces;
use Interfaces;
package VSSL.Extensible_Arithmetic with Pure is
Limb_Size : constant := 32;
subtype Limb is Unsigned_32;
Minus_One_Limb : constant Limb := Limb'Last;
function Is_Negative (X : Limb) return Boolean is
((X and 2**(Limb_Size - 1)) /= 0);
procedure Multiply (
CO, -- Product carry out (higher part)
M : out Limb; -- Product (lower part)
A,
B : in Limb; -- Multiplicands
CI : in Limb := 0); -- Carry In (added to product)
private
subtype Product is Unsigned_32;
end VSSL.Extensible_Arithmetic;

66
source/library/vssl-integers-big.adb
View File

@ -1,20 +1,10 @@
package body VSSL.Integers.Big is
subtype Chunk_Product is Unsigned_64;
procedure Chunk_Mul_Add (H, L : out Chunk_Type; A, B, C : in Chunk_Type) is
P : Chunk_Product;
begin
P := Chunk_Product (A) * Chunk_Product (B) + Chunk_Product (C);
L := Chunk_Type (P and (2**Chunk_Bits - 1));
H := Chunk_Type (Shift_Right (P, Chunk_Bits));
end Chunk_Mul_Add;
function Digits_to_Bits (N : Natural) return Natural is (N * 3 + (N + 2) / 3);
-- ceiling (N * log_2 (10)) approximation giving ~ 1% error
function With_Bits (N : Positive) return Big_Integer is
(0 .. N / Chunk_Bits + 1 => 0);
(0 .. N / Limb_Size + 1 => 0);
function With_Digits (N : Positive) return Big_Integer is
(With_Bits (Digits_to_Bits (N)));
@ -23,7 +13,7 @@ package body VSSL.Integers.Big is
Is_Neg : Boolean := False;
DN : Natural := 0;
Based : Boolean := False;
Radix : Chunk_Type := 10;
Radix : Limb := 10;
begin
-- First pass: detecting negative, radix and number of digits
for J in S'Range loop
@ -42,11 +32,11 @@ package body VSSL.Integers.Big is
end loop;
return R : Big_Integer := With_Digits (DN) do
declare
procedure Next_Digit (X : in Chunk_Type) is
C : Chunk_Type := X;
procedure Next_Digit (X : in Limb) is
C : Limb := X;
begin
for J in R'Range loop
Chunk_Mul_Add (C, R (J), R (J), Radix, C);
Multiply (C, R (J), R (J), Radix, C);
end loop;
end Next_Digit;
begin
@ -74,34 +64,34 @@ package body VSSL.Integers.Big is
function To_Big (X : Value) return Big_Integer is
T : Value := X;
begin
if Chunk_Type'Modulus < Value'Last then -- wish it be compile-time check
if Limb'Modulus < Value'Last then -- wish it be compile-time check
return R : Big_Integer := With_Bits (Value'Size) do
for J in R'Range loop
R (J) := Chunk_Type (T mod Chunk_Type'Modulus);
T := (T - Value (R (J))) / Chunk_Type'Modulus;
R (J) := Limb (T mod Limb'Modulus);
T := (T - Value (R (J))) / Limb'Modulus;
end loop;
end return;
else
return (0 => Chunk_Type (X));
return (0 => Limb (X));
end if;
end To_Big;
end Signed_Conversions;
function Fit_First (X : Big_Integer) return Chunk_Index'Base is
function Fit_First (X : Big_Integer) return Limb_Index'Base is
begin
for J in X'Range loop
if X (J) /= 0 then
return J;
end if;
end loop;
return Chunk_Index'Base'Last;
return Limb_Index'Base'Last;
end Fit_First;
function Fit_Last (X : Big_Integer) return Chunk_Index'Base is
function Fit_Last (X : Big_Integer) return Limb_Index'Base is
begin
if Is_Negative (X) then
for J in reverse X'Range loop
if X (J) /= Minus_One_Chunk then
if X (J) /= Minus_One_Limb then
if (X (J) and 2**Sign_Bit) /= 0 then -- negative, can be used as last
return J;
else
@ -116,11 +106,11 @@ package body VSSL.Integers.Big is
return J;
end if;
end loop;
return Chunk_Index'Base'First;
return Limb_Index'Base'First;
end if;
end Fit_Last;
function Is_Fit (X : Big_Integer; First, Last : Chunk_Index'Base) return Boolean is
function Is_Fit (X : Big_Integer; First, Last : Limb_Index'Base) return Boolean is
(Fit_First (X) >= First and then Fit_Last (X) <= Last);
function Is_Fit (X, Y : Big_Integer) return Boolean is
@ -130,21 +120,21 @@ package body VSSL.Integers.Big is
(for all J of X => J = 0);
function Is_Negative (X : Big_Integer) return Boolean is
(X'Last >= X'First and then (X (X'Last) and 2**Sign_Bit) /= 0);
(X'Last >= X'First and then Is_Negative (X (X'Last)));
function "=" (X, Y : Big_Integer) return Boolean is
FX : constant Chunk_Index'Base := Fit_First (X);
LX : constant Chunk_Index'Base := Fit_Last (X);
FY : constant Chunk_Index'Base := Fit_First (Y);
LY : constant Chunk_Index'Base := Fit_Last (Y);
FX : constant Limb_Index'Base := Fit_First (X);
LX : constant Limb_Index'Base := Fit_Last (X);
FY : constant Limb_Index'Base := Fit_First (Y);
LY : constant Limb_Index'Base := Fit_Last (Y);
begin
return FX = FY and then LX = LY and then
X (FX .. LX) = Y (FY .. LY);
end "=";
procedure Set (T : out Big_Integer; Y : in Big_Integer) is
FY : constant Chunk_Index'Base := Fit_First (Y);
LY : constant Chunk_Index'Base := Fit_Last (Y);
FY : constant Limb_Index'Base := Fit_First (Y);
LY : constant Limb_Index'Base := Fit_Last (Y);
begin
if FY < T'First or else LY > T'Last then
raise Constraint_Error with "Value does not fit in target";
@ -152,16 +142,16 @@ package body VSSL.Integers.Big is
if FY > LY then -- zero
T := (others => 0);
else
T (T'First .. FY - 1) := (others => (if Is_Negative (Y) then Minus_One_Chunk else 0));
T (T'First .. FY - 1) := (others => (if Is_Negative (Y) then Minus_One_Limb else 0));
T (FY .. LY) := Y (FY .. LY);
T (FY + 1 .. T'Last) := (others => 0);
end if;
end Set;
procedure Add (T : in out Big_Integer; X : in Big_Integer) is
FX : constant Chunk_Index'Base := Fit_First (X);
LX : constant Chunk_Index'Base := Fit_Last (X);
Carry : Chunk_Type := 0;
FX : constant Limb_Index'Base := Fit_First (X);
LX : constant Limb_Index'Base := Fit_Last (X);
Carry : Limb := 0;
begin
if FX < T'First or LX > T'Last then
raise Constraint_Error with "Result of addition does not fit in target";
@ -181,10 +171,10 @@ package body VSSL.Integers.Big is
end Add;
procedure Negate (T : in out Big_Integer) is
L : Chunk_Index'Base := Fit_Last (T);
L : Limb_Index'Base := Fit_Last (T);
begin
if L in T'Range then -- not zero
if L = T'Last and then T (L) = 2**(Chunk_Bits - 1) then -- corner case
if L = T'Last and then T (L) = 2**(Limb_Size - 1) then -- corner case
raise Constraint_Error with "Result of negation does not fit in target";
end if;
T (L) := -T (L);

21
source/library/vssl-integers-big.ads
View File

@ -3,6 +3,10 @@
-- Contrary to Ada 202x Big Number implementation they don't use memory allocation
--
with Interfaces;
use Interfaces;
with VSSL.Extensible_Arithmetic;
use VSSL.Extensible_Arithmetic;
package VSSL.Integers.Big with Pure is
@ -48,27 +52,20 @@ package VSSL.Integers.Big with Pure is
-- Inplace variant of negation
private
use Interfaces;
Chunk_Bits : constant := 32;
Sign_Bit : constant := Limb_Size - 1;
subtype Chunk_Type is Unsigned_32;
subtype Limb_Index is Natural;
Sign_Bit : constant := Chunk_Bits - 1;
type Big_Integer is array (Limb_Index range <>) of Limb;
Minus_One_Chunk : constant Chunk_Type := Chunk_Type'Last;
subtype Chunk_Index is Natural;
type Big_Integer is array (Chunk_Index range <>) of Chunk_Type;
-- This type represent integer split into `Chunk_Bits` bit wide chunks
-- This type represent integer split into `Limb_Size` bit wide parts
-- with last element is in two's complement form so that its msb indicates sign
Zero : constant Big_Integer := (1 .. 0 => <>);
One : constant Big_Integer := (0 => 1);
Two : constant Big_Integer := (0 => 2);
Ten : constant Big_Integer := (0 => 10);
Minus_One : constant Big_Integer := (0 => Minus_One_Chunk);
Minus_One : constant Big_Integer := (0 => Minus_One_Limb);
end VSSL.Integers.Big;

20
source/test/vssl-integers-big-test.adb
View File

@ -1,8 +1,28 @@
with AUnit.Assertions;
use AUnit.Assertions;
with AUnit.Simple_Test_Cases;
use AUnit.Simple_Test_Cases;
package body VSSL.Integers.Big.Test is
Prefix : constant String := "VSSL.Integers.Big.";
type Representation_Test is new Test_Case with null record;
overriding function Name (T : Representation_Test) return AUnit.Message_String;
overriding procedure Run_Test (T : in out Representation_Test);
function Name (T : Representation_Test) return AUnit.Message_String is
(AUnit.Format (Prefix & "<Representation> test"));
procedure Run_Test (T : in out Representation_Test) is
begin
null;
end Run_Test;
function Suite return Access_Test_Suite is
R : Access_Test_Suite := new Test_Suite;
begin
R.Add_Test (new Representation_Test);
return R;
end;