s-scaval$(objext) \
s-secsta$(objext) \
s-sequio$(objext) \
+ s-shabig$(objext) \
s-shasto$(objext) \
s-soflin$(objext) \
s-soliin$(objext) \
with Interfaces; use Interfaces;
with System.Generic_Bignums;
+with System.Shared_Bignums; use System.Shared_Bignums;
package body Ada.Numerics.Big_Numbers.Big_Integers is
- package Bignums is new
- System.Generic_Bignums (Use_Secondary_Stack => False);
- use Bignums, System;
+ function Allocate_Bignum (D : Digit_Vector; Neg : Boolean) return Bignum;
+ -- Allocate Bignum value with the given contents
+
+ procedure Free_Bignum (X : in out Bignum);
+ -- Free memory associated with X
+
+ function To_Bignum (X : aliased in out Bignum) return Bignum is (X);
procedure Free is new Ada.Unchecked_Deallocation (Bignum_Data, Bignum);
+ ---------------------
+ -- Allocate_Bignum --
+ ---------------------
+
+ function Allocate_Bignum (D : Digit_Vector; Neg : Boolean) return Bignum is
+ begin
+ return new Bignum_Data'(D'Length, Neg, D);
+ end Allocate_Bignum;
+
+ -----------------
+ -- Free_Bignum --
+ -----------------
+
+ procedure Free_Bignum (X : in out Bignum) is
+ begin
+ Free (X);
+ end Free_Bignum;
+
+ package Bignums is new System.Generic_Bignums
+ (Bignum, Allocate_Bignum, Free_Bignum, To_Bignum);
+
+ use Bignums, System;
+
function Get_Bignum (Arg : Big_Integer) return Bignum is
(if Arg.Value.C = System.Null_Address
then raise Constraint_Error with "invalid big integer"
-- To_String --
---------------
- Hex_Chars : constant array (0 .. 15) of Character := "0123456789ABCDEF";
-
function To_String
(Arg : Valid_Big_Integer; Width : Field := 0; Base : Number_Base := 10)
- return String
- is
- Big_Base : constant Big_Integer := To_Big_Integer (Integer (Base));
-
- function Add_Base (S : String) return String;
- -- Add base information if Base /= 10
-
- function Leading_Padding
- (Str : String;
- Min_Length : Field;
- Char : Character := ' ') return String;
- -- Return padding of Char concatenated with Str so that the resulting
- -- string is at least Min_Length long.
-
- function Image (Arg : Big_Integer) return String;
- -- Return image of Arg, assuming Arg is positive.
-
- function Image (N : Natural) return String;
- -- Return image of N, with no leading space.
-
- --------------
- -- Add_Base --
- --------------
-
- function Add_Base (S : String) return String is
- begin
- if Base = 10 then
- return S;
- else
- return Image (Base) & "#" & S & "#";
- end if;
- end Add_Base;
-
- -----------
- -- Image --
- -----------
-
- function Image (N : Natural) return String is
- S : constant String := Natural'Image (N);
- begin
- return S (2 .. S'Last);
- end Image;
-
- function Image (Arg : Big_Integer) return String is
- begin
- if Arg < Big_Base then
- return (1 => Hex_Chars (To_Integer (Arg)));
- else
- return Image (Arg / Big_Base)
- & Hex_Chars (To_Integer (Arg rem Big_Base));
- end if;
- end Image;
-
- ---------------------
- -- Leading_Padding --
- ---------------------
-
- function Leading_Padding
- (Str : String;
- Min_Length : Field;
- Char : Character := ' ') return String is
- begin
- return (1 .. Integer'Max (Integer (Min_Length) - Str'Length, 0)
- => Char) & Str;
- end Leading_Padding;
-
+ return String is
begin
- if Arg < To_Big_Integer (0) then
- return Leading_Padding ("-" & Add_Base (Image (-Arg)), Width);
- else
- return Leading_Padding (" " & Add_Base (Image (Arg)), Width);
- end if;
+ return To_String (Get_Bignum (Arg), Natural (Width), Positive (Base));
end To_String;
-----------------
---------------
procedure Normalize (Arg : in out Big_Real) is
+ Zero : constant Big_Integer := To_Big_Integer (0);
begin
- if Arg.Den < To_Big_Integer (0) then
+ if Arg.Den < Zero then
Arg.Num := -Arg.Num;
Arg.Den := -Arg.Den;
end if;
- declare
- GCD : constant Big_Integer :=
- Greatest_Common_Divisor (Arg.Num, Arg.Den);
- begin
- Arg.Num := Arg.Num / GCD;
- Arg.Den := Arg.Den / GCD;
- end;
+ if Arg.Num = Zero then
+ Arg.Den := To_Big_Integer (1);
+ else
+ declare
+ GCD : constant Big_Integer :=
+ Greatest_Common_Divisor (Arg.Num, Arg.Den);
+ begin
+ Arg.Num := Arg.Num / GCD;
+ Arg.Den := Arg.Den / GCD;
+ end;
+ end if;
end Normalize;
end Ada.Numerics.Big_Numbers.Big_Reals;
-- --
------------------------------------------------------------------------------
-with System.Generic_Bignums;
with Ada.Unchecked_Conversion;
+with System.Generic_Bignums;
+with System.Secondary_Stack; use System.Secondary_Stack;
+with System.Shared_Bignums; use System.Shared_Bignums;
+with System.Storage_Elements; use System.Storage_Elements;
package body System.Bignums is
- package Sec_Stack_Bignums is new
- System.Generic_Bignums (Use_Secondary_Stack => True);
- use Sec_Stack_Bignums;
+ function Allocate_Bignum (D : Digit_Vector; Neg : Boolean) return Bignum;
+ -- Allocate Bignum value with the given contents
+
+ procedure Free_Bignum (X : in out Bignum) is null;
+ -- No op when using the secondary stack
+
+ function To_Bignum (X : aliased in out Bignum) return Bignum is (X);
+
+ ---------------------
+ -- Allocate_Bignum --
+ ---------------------
+
+ function Allocate_Bignum (D : Digit_Vector; Neg : Boolean) return Bignum is
+ Addr : aliased Address;
+ begin
+ -- Note: The approach used here is designed to avoid strict aliasing
+ -- warnings that appeared previously using unchecked conversion.
+
+ SS_Allocate (Addr, Storage_Offset (4 + 4 * D'Length));
+
+ declare
+ B : Bignum;
+ for B'Address use Addr'Address;
+ pragma Import (Ada, B);
+
+ BD : Bignum_Data (D'Length);
+ for BD'Address use Addr;
+ pragma Import (Ada, BD);
+
+ -- Expose a writable view of discriminant BD.Len so that we can
+ -- initialize it. We need to use the exact layout of the record
+ -- to ensure that the Length field has 24 bits as expected.
+
+ type Bignum_Data_Header is record
+ Len : Length;
+ Neg : Boolean;
+ end record;
+
+ for Bignum_Data_Header use record
+ Len at 0 range 0 .. 23;
+ Neg at 3 range 0 .. 7;
+ end record;
+
+ BDH : Bignum_Data_Header;
+ for BDH'Address use BD'Address;
+ pragma Import (Ada, BDH);
+
+ pragma Assert (BDH.Len'Size = BD.Len'Size);
- function "+" is new Ada.Unchecked_Conversion
- (Bignum, Sec_Stack_Bignums.Bignum);
+ begin
+ BDH.Len := D'Length;
+ BDH.Neg := Neg;
+ B.D := D;
+ return B;
+ end;
+ end Allocate_Bignum;
- function "-" is new Ada.Unchecked_Conversion
- (Sec_Stack_Bignums.Bignum, Bignum);
+ package Sec_Stack_Bignums is new System.Generic_Bignums
+ (Bignum, Allocate_Bignum, Free_Bignum, To_Bignum);
- function Big_Add (X, Y : Bignum) return Bignum is
- (-Sec_Stack_Bignums.Big_Add (+X, +Y));
+ function Big_Add (X, Y : Bignum) return Bignum
+ renames Sec_Stack_Bignums.Big_Add;
- function Big_Sub (X, Y : Bignum) return Bignum is
- (-Sec_Stack_Bignums.Big_Sub (+X, +Y));
+ function Big_Sub (X, Y : Bignum) return Bignum
+ renames Sec_Stack_Bignums.Big_Sub;
- function Big_Mul (X, Y : Bignum) return Bignum is
- (-Sec_Stack_Bignums.Big_Mul (+X, +Y));
+ function Big_Mul (X, Y : Bignum) return Bignum
+ renames Sec_Stack_Bignums.Big_Mul;
- function Big_Div (X, Y : Bignum) return Bignum is
- (-Sec_Stack_Bignums.Big_Div (+X, +Y));
+ function Big_Div (X, Y : Bignum) return Bignum
+ renames Sec_Stack_Bignums.Big_Div;
- function Big_Exp (X, Y : Bignum) return Bignum is
- (-Sec_Stack_Bignums.Big_Exp (+X, +Y));
+ function Big_Exp (X, Y : Bignum) return Bignum
+ renames Sec_Stack_Bignums.Big_Exp;
- function Big_Mod (X, Y : Bignum) return Bignum is
- (-Sec_Stack_Bignums.Big_Mod (+X, +Y));
+ function Big_Mod (X, Y : Bignum) return Bignum
+ renames Sec_Stack_Bignums.Big_Mod;
- function Big_Rem (X, Y : Bignum) return Bignum is
- (-Sec_Stack_Bignums.Big_Rem (+X, +Y));
+ function Big_Rem (X, Y : Bignum) return Bignum
+ renames Sec_Stack_Bignums.Big_Rem;
- function Big_Neg (X : Bignum) return Bignum is
- (-Sec_Stack_Bignums.Big_Neg (+X));
+ function Big_Neg (X : Bignum) return Bignum
+ renames Sec_Stack_Bignums.Big_Neg;
- function Big_Abs (X : Bignum) return Bignum is
- (-Sec_Stack_Bignums.Big_Abs (+X));
+ function Big_Abs (X : Bignum) return Bignum
+ renames Sec_Stack_Bignums.Big_Abs;
- function Big_EQ (X, Y : Bignum) return Boolean is
- (Sec_Stack_Bignums.Big_EQ (+X, +Y));
- function Big_NE (X, Y : Bignum) return Boolean is
- (Sec_Stack_Bignums.Big_NE (+X, +Y));
- function Big_GE (X, Y : Bignum) return Boolean is
- (Sec_Stack_Bignums.Big_GE (+X, +Y));
- function Big_LE (X, Y : Bignum) return Boolean is
- (Sec_Stack_Bignums.Big_LE (+X, +Y));
- function Big_GT (X, Y : Bignum) return Boolean is
- (Sec_Stack_Bignums.Big_GT (+X, +Y));
- function Big_LT (X, Y : Bignum) return Boolean is
- (Sec_Stack_Bignums.Big_LT (+X, +Y));
+ function Big_EQ (X, Y : Bignum) return Boolean
+ renames Sec_Stack_Bignums.Big_EQ;
+ function Big_NE (X, Y : Bignum) return Boolean
+ renames Sec_Stack_Bignums.Big_NE;
+ function Big_GE (X, Y : Bignum) return Boolean
+ renames Sec_Stack_Bignums.Big_GE;
+ function Big_LE (X, Y : Bignum) return Boolean
+ renames Sec_Stack_Bignums.Big_LE;
+ function Big_GT (X, Y : Bignum) return Boolean
+ renames Sec_Stack_Bignums.Big_GT;
+ function Big_LT (X, Y : Bignum) return Boolean
+ renames Sec_Stack_Bignums.Big_LT;
- function Bignum_In_LLI_Range (X : Bignum) return Boolean is
- (Sec_Stack_Bignums.Bignum_In_LLI_Range (+X));
+ function Bignum_In_LLI_Range (X : Bignum) return Boolean
+ renames Sec_Stack_Bignums.Bignum_In_LLI_Range;
- function To_Bignum (X : Long_Long_Integer) return Bignum is
- (-Sec_Stack_Bignums.To_Bignum (X));
+ function To_Bignum (X : Long_Long_Integer) return Bignum
+ renames Sec_Stack_Bignums.To_Bignum;
- function From_Bignum (X : Bignum) return Long_Long_Integer is
- (Sec_Stack_Bignums.From_Bignum (+X));
+ function From_Bignum (X : Bignum) return Long_Long_Integer
+ renames Sec_Stack_Bignums.From_Bignum;
end System.Bignums;
-- Note that we cannot use a straight instantiation of System.Generic_Bignums
-- because the rtsfind mechanism is not ready to handle instantiations.
+with System.Shared_Bignums;
+
package System.Bignums is
pragma Preelaborate;
- type Bignum is private;
+ subtype Bignum is System.Shared_Bignums.Bignum;
function Big_Add (X, Y : Bignum) return Bignum; -- "+"
function Big_Sub (X, Y : Bignum) return Bignum; -- "-"
private
- type Bignum is new System.Address;
-
pragma Inline (Big_Add);
pragma Inline (Big_Sub);
pragma Inline (Big_Mul);
-- This package provides arbitrary precision signed integer arithmetic.
-with System; use System;
-with System.Secondary_Stack; use System.Secondary_Stack;
-with System.Storage_Elements; use System.Storage_Elements;
-
package body System.Generic_Bignums is
use Interfaces;
-- So that operations on Unsigned_32/Unsigned_64 are available
+ use Shared_Bignums;
+
type DD is mod Base ** 2;
-- Double length digit used for intermediate computations
function Add
(X, Y : Digit_Vector;
X_Neg : Boolean;
- Y_Neg : Boolean) return Bignum
+ Y_Neg : Boolean) return Big_Integer
with
Pre => X'First = 1 and then Y'First = 1;
-- This procedure adds two signed numbers returning the Sum, it is used
-- for both addition and subtraction. The value computed is X + Y, with
-- X_Neg and Y_Neg giving the signs of the operands.
- function Allocate_Bignum (Len : Length) return Bignum with
- Post => Allocate_Bignum'Result.Len = Len;
- -- Allocate Bignum value of indicated length on secondary stack. On return
- -- the Neg and D fields are left uninitialized.
-
type Compare_Result is (LT, EQ, GT);
-- Indicates result of comparison in following call
procedure Div_Rem
(X, Y : Bignum;
- Quotient : out Bignum;
- Remainder : out Bignum;
+ Quotient : out Big_Integer;
+ Remainder : out Big_Integer;
Discard_Quotient : Boolean := False;
Discard_Remainder : Boolean := False);
-- Returns the Quotient and Remainder from dividing abs (X) by abs (Y). The
-- Quotient is undefined on return, and if Discard_Remainder is True, then
-- Remainder is undefined on return. Service routine for Big_Div/Rem/Mod.
- procedure Free_Bignum (X : Bignum) is null;
- -- Called to free a Bignum value used in intermediate computations. In
- -- this implementation using the secondary stack, it does nothing at all,
- -- because we rely on Mark/Release, but it may be of use for some
- -- alternative implementation.
-
function Normalize
(X : Digit_Vector;
- Neg : Boolean := False) return Bignum;
- -- Given a digit vector and sign, allocate and construct a Bignum value.
- -- Note that X may have leading zeroes which must be removed, and if the
- -- result is zero, the sign is forced positive.
+ Neg : Boolean := False) return Big_Integer;
+ -- Given a digit vector and sign, allocate and construct a big integer
+ -- value. Note that X may have leading zeroes which must be removed, and if
+ -- the result is zero, the sign is forced positive.
+
+ function "**" (X : Bignum; Y : SD) return Big_Integer;
+ -- Exponentiation routine where we know right operand is one word
---------
-- Add --
function Add
(X, Y : Digit_Vector;
X_Neg : Boolean;
- Y_Neg : Boolean) return Bignum
+ Y_Neg : Boolean) return Big_Integer
is
begin
-- If signs are the same, we are doing an addition, it is convenient to
end if;
end Add;
- ---------------------
- -- Allocate_Bignum --
- ---------------------
-
- function Allocate_Bignum (Len : Length) return Bignum is
- Addr : Address;
-
- begin
- -- Allocation on the heap
-
- if not Use_Secondary_Stack then
- declare
- B : Bignum;
- begin
- B := new Bignum_Data'(Len, False, (others => 0));
- return B;
- end;
-
- -- Allocation on the secondary stack
-
- else
- -- Note: The approach used here is designed to avoid strict aliasing
- -- warnings that appeared previously using unchecked conversion.
-
- SS_Allocate (Addr, Storage_Offset (4 + 4 * Len));
-
- declare
- B : Bignum;
- for B'Address use Addr'Address;
- pragma Import (Ada, B);
-
- BD : Bignum_Data (Len);
- for BD'Address use Addr;
- pragma Import (Ada, BD);
-
- -- Expose a writable view of discriminant BD.Len so that we can
- -- initialize it. We need to use the exact layout of the record
- -- to ensure that the Length field has 24 bits as expected.
-
- type Bignum_Data_Header is record
- Len : Length;
- Neg : Boolean;
- end record;
-
- for Bignum_Data_Header use record
- Len at 0 range 0 .. 23;
- Neg at 3 range 0 .. 7;
- end record;
-
- BDH : Bignum_Data_Header;
- for BDH'Address use BD'Address;
- pragma Import (Ada, BDH);
-
- pragma Assert (BDH.Len'Size = BD.Len'Size);
-
- begin
- BDH.Len := Len;
- return B;
- end;
- end if;
- end Allocate_Bignum;
-
-------------
-- Big_Abs --
-------------
- function Big_Abs (X : Bignum) return Bignum is
+ function Big_Abs (X : Bignum) return Big_Integer is
begin
return Normalize (X.D);
end Big_Abs;
-- Big_Add --
-------------
- function Big_Add (X, Y : Bignum) return Bignum is
+ function Big_Add (X, Y : Bignum) return Big_Integer is
begin
return Add (X.D, Y.D, X.Neg, Y.Neg);
end Big_Add;
-- 13 -5 -2 -13 -5 2
-- 14 -5 -2 -14 -5 2
- function Big_Div (X, Y : Bignum) return Bignum is
- Q, R : Bignum;
+ function Big_Div (X, Y : Bignum) return Big_Integer is
+ Q, R : aliased Big_Integer;
begin
Div_Rem (X, Y, Q, R, Discard_Remainder => True);
- Q.Neg := Q.Len > 0 and then (X.Neg xor Y.Neg);
+ To_Bignum (Q).Neg := To_Bignum (Q).Len > 0 and then (X.Neg xor Y.Neg);
return Q;
end Big_Div;
- -------------
- -- Big_Exp --
- -------------
-
- function Big_Exp (X, Y : Bignum) return Bignum is
-
- function "**" (X : Bignum; Y : SD) return Bignum;
- -- Internal routine where we know right operand is one word
-
- ----------
- -- "**" --
- ----------
+ ----------
+ -- "**" --
+ ----------
- function "**" (X : Bignum; Y : SD) return Bignum is
- begin
- case Y is
+ function "**" (X : Bignum; Y : SD) return Big_Integer is
+ begin
+ case Y is
- -- X ** 0 is 1
+ -- X ** 0 is 1
- when 0 =>
- return Normalize (One_Data);
+ when 0 =>
+ return Normalize (One_Data);
- -- X ** 1 is X
+ -- X ** 1 is X
- when 1 =>
- return Normalize (X.D);
+ when 1 =>
+ return Normalize (X.D);
- -- X ** 2 is X * X
+ -- X ** 2 is X * X
- when 2 =>
- return Big_Mul (X, X);
+ when 2 =>
+ return Big_Mul (X, X);
- -- For X greater than 2, use the recursion
+ -- For X greater than 2, use the recursion
- -- X even, X ** Y = (X ** (Y/2)) ** 2;
- -- X odd, X ** Y = (X ** (Y/2)) ** 2 * X;
+ -- X even, X ** Y = (X ** (Y/2)) ** 2;
+ -- X odd, X ** Y = (X ** (Y/2)) ** 2 * X;
- when others =>
- declare
- XY2 : constant Bignum := X ** (Y / 2);
- XY2S : constant Bignum := Big_Mul (XY2, XY2);
- Res : Bignum;
-
- begin
- Free_Bignum (XY2);
-
- -- Raise storage error if intermediate value is getting too
- -- large, which we arbitrarily define as 200 words for now.
-
- if XY2S.Len > 200 then
- Free_Bignum (XY2S);
- raise Storage_Error with
- "exponentiation result is too large";
- end if;
+ when others =>
+ declare
+ XY2 : aliased Big_Integer := X ** (Y / 2);
+ XY2S : aliased Big_Integer :=
+ Big_Mul (To_Bignum (XY2), To_Bignum (XY2));
+ Res : Big_Integer;
- -- Otherwise take care of even/odd cases
+ begin
+ Free_Big_Integer (XY2);
+
+ -- Raise storage error if intermediate value is getting too
+ -- large, which we arbitrarily define as 200 words for now.
+ -- ??? Consider putting a limit instead in a wrapper of
+ -- Allocate_Big_Integer and update all calls to
+ -- Allocate_Big_Integer to call this wrapper, to catch all such
+ -- cases.
+
+ if To_Bignum (XY2S).Len > 200 then
+ Free_Big_Integer (XY2S);
+ raise Storage_Error with
+ "exponentiation result is too large";
+ end if;
- if (Y and 1) = 0 then
- return XY2S;
+ -- Otherwise take care of even/odd cases
- else
- Res := Big_Mul (XY2S, X);
- Free_Bignum (XY2S);
- return Res;
- end if;
- end;
- end case;
- end "**";
+ if (Y and 1) = 0 then
+ return XY2S;
+ else
+ Res := Big_Mul (To_Bignum (XY2S), X);
+ Free_Big_Integer (XY2S);
+ return Res;
+ end if;
+ end;
+ end case;
+ end "**";
- -- Start of processing for Big_Exp
+ -------------
+ -- Big_Exp --
+ -------------
+ function Big_Exp (X, Y : Bignum) return Big_Integer is
begin
-- Error if right operand negative
end if;
end Big_Exp;
+ -------------
+ -- Big_And --
+ -------------
+
+ function Big_And (X, Y : Bignum) return Big_Integer is
+ begin
+ if X.Len > Y.Len then
+ return Big_And (X => Y, Y => X);
+ end if;
+
+ -- X is the smallest integer
+
+ declare
+ Result : Digit_Vector (1 .. X.Len);
+ Diff : constant Length := Y.Len - X.Len;
+ begin
+ for J in 1 .. X.Len loop
+ Result (J) := X.D (J) and Y.D (J + Diff);
+ end loop;
+
+ return Normalize (Result, X.Neg and Y.Neg);
+ end;
+ end Big_And;
+
+ ------------
+ -- Big_Or --
+ ------------
+
+ function Big_Or (X, Y : Bignum) return Big_Integer is
+ begin
+ if X.Len < Y.Len then
+ return Big_Or (X => Y, Y => X);
+ end if;
+
+ -- X is the largest integer
+
+ declare
+ Result : Digit_Vector (1 .. X.Len);
+ Index : Length;
+ Diff : constant Length := X.Len - Y.Len;
+
+ begin
+ Index := 1;
+
+ while Index <= Diff loop
+ Result (Index) := X.D (Index);
+ Index := Index + 1;
+ end loop;
+
+ for J in 1 .. Y.Len loop
+ Result (Index) := X.D (Index) or Y.D (J);
+ Index := Index + 1;
+ end loop;
+
+ return Normalize (Result, X.Neg or Y.Neg);
+ end;
+ end Big_Or;
+
+ --------------------
+ -- Big_Shift_Left --
+ --------------------
+
+ function Big_Shift_Left (X : Bignum; Amount : Natural) return Big_Integer is
+ begin
+ if X.Neg then
+ raise Constraint_Error;
+ elsif Amount = 0 then
+ return Allocate_Big_Integer (X.D, False);
+ end if;
+
+ declare
+ Shift : constant Natural := Amount rem SD'Size;
+ Result : Digit_Vector (0 .. X.Len + Amount / SD'Size);
+ Carry : SD := 0;
+
+ begin
+ for J in X.Len + 1 .. Result'Last loop
+ Result (J) := 0;
+ end loop;
+
+ for J in reverse 1 .. X.Len loop
+ Result (J) := Shift_Left (X.D (J), Shift) or Carry;
+ Carry := Shift_Right (X.D (J), SD'Size - Shift);
+ end loop;
+
+ Result (0) := Carry;
+ return Normalize (Result, False);
+ end;
+ end Big_Shift_Left;
+
+ ---------------------
+ -- Big_Shift_Right --
+ ---------------------
+
+ function Big_Shift_Right
+ (X : Bignum; Amount : Natural) return Big_Integer is
+ begin
+ if X.Neg then
+ raise Constraint_Error;
+ elsif Amount = 0 then
+ return Allocate_Big_Integer (X.D, False);
+ end if;
+
+ declare
+ Shift : constant Natural := Amount rem SD'Size;
+ Result : Digit_Vector (1 .. X.Len - Amount / SD'Size);
+ Carry : SD := 0;
+
+ begin
+ for J in 1 .. Result'Last - 1 loop
+ Result (J) := Shift_Right (X.D (J), Shift) or Carry;
+ Carry := Shift_Left (X.D (J), SD'Size - Shift);
+ end loop;
+
+ Result (Result'Last) :=
+ Shift_Right (X.D (Result'Last), Shift) or Carry;
+
+ return Normalize (Result, False);
+ end;
+ end Big_Shift_Right;
+
------------
-- Big_EQ --
------------
-- 13 -5 -2 3 -13 -5 -3 -3
-- 14 -5 -1 4 -14 -5 -4 -4
- function Big_Mod (X, Y : Bignum) return Bignum is
- Q, R : Bignum;
+ function Big_Mod (X, Y : Bignum) return Big_Integer is
+ Q, R : aliased Big_Integer;
begin
-- If signs are same, result is same as Rem
-- Zero result is unchanged
- if R.Len = 0 then
+ if To_Bignum (R).Len = 0 then
return R;
-- Otherwise adjust result
else
declare
- T1 : constant Bignum := Big_Sub (Y, R);
+ T1 : aliased Big_Integer := Big_Sub (Y, To_Bignum (R));
begin
- T1.Neg := Y.Neg;
- Free_Bignum (R);
+ To_Bignum (T1).Neg := Y.Neg;
+ Free_Big_Integer (R);
return T1;
end;
end if;
-- Big_Mul --
-------------
- function Big_Mul (X, Y : Bignum) return Bignum is
+ function Big_Mul (X, Y : Bignum) return Big_Integer is
Result : Digit_Vector (1 .. X.Len + Y.Len) := (others => 0);
-- Accumulate result (max length of result is sum of operand lengths)
-- Big_Neg --
-------------
- function Big_Neg (X : Bignum) return Bignum is
+ function Big_Neg (X : Bignum) return Big_Integer is
begin
return Normalize (X.D, not X.Neg);
end Big_Neg;
-- 13 -5 3 -13 -5 -3
-- 14 -5 4 -14 -5 -4
- function Big_Rem (X, Y : Bignum) return Bignum is
- Q, R : Bignum;
+ function Big_Rem (X, Y : Bignum) return Big_Integer is
+ Q, R : aliased Big_Integer;
begin
Div_Rem (X, Y, Q, R, Discard_Quotient => True);
- R.Neg := R.Len > 0 and then X.Neg;
+ To_Bignum (R).Neg := To_Bignum (R).Len > 0 and then X.Neg;
return R;
end Big_Rem;
-- Big_Sub --
-------------
- function Big_Sub (X, Y : Bignum) return Bignum is
+ function Big_Sub (X, Y : Bignum) return Big_Integer is
begin
-- If right operand zero, return left operand (avoiding sharing)
procedure Div_Rem
(X, Y : Bignum;
- Quotient : out Bignum;
- Remainder : out Bignum;
+ Quotient : out Big_Integer;
+ Remainder : out Big_Integer;
Discard_Quotient : Boolean := False;
- Discard_Remainder : Boolean := False)
- is
+ Discard_Remainder : Boolean := False) is
begin
-- Error if division by zero
-- If X < Y then quotient is zero and remainder is X
if Compare (X.D, Y.D, False, False) = LT then
- Remainder := Normalize (X.D);
- Quotient := Normalize (Zero_Data);
+ if not Discard_Quotient then
+ Quotient := Normalize (Zero_Data);
+ end if;
+
+ if not Discard_Remainder then
+ Remainder := Normalize (X.D);
+ end if;
+
return;
-- If both X and Y are less than 2**63-1, we can use Long_Long_Integer
A : constant LLI := abs (From_Bignum (X));
B : constant LLI := abs (From_Bignum (Y));
begin
- Quotient := To_Bignum (A / B);
- Remainder := To_Bignum (A rem B);
+ if not Discard_Quotient then
+ Quotient := To_Bignum (A / B);
+ end if;
+
+ if not Discard_Remainder then
+ Remainder := To_Bignum (A rem B);
+ end if;
+
return;
end;
ND := ND rem Div;
end loop;
- Quotient := Normalize (Result);
- Remdr (1) := SD (ND);
- Remainder := Normalize (Remdr);
+ if not Discard_Quotient then
+ Quotient := Normalize (Result);
+ end if;
+
+ if not Discard_Remainder then
+ Remdr (1) := SD (ND);
+ Remainder := Normalize (Remdr);
+ end if;
+
return;
end;
end if;
if not Discard_Remainder then
declare
Remdr : DD;
-
begin
Remdr := 0;
+
for K in 1 .. n loop
Remdr := Base * Remdr + DD (u (m + K));
r (K) := SD (Remdr / d);
function Normalize
(X : Digit_Vector;
- Neg : Boolean := False) return Bignum
+ Neg : Boolean := False) return Big_Integer
is
- B : Bignum;
J : Length;
begin
J := J + 1;
end loop;
- B := Allocate_Bignum (X'Last - J + 1);
- B.Neg := B.Len > 0 and then Neg;
- B.D := X (J .. X'Last);
- return B;
+ return Allocate_Big_Integer (X (J .. X'Last), J <= X'Last and then Neg);
end Normalize;
---------------
-- To_Bignum --
---------------
- function To_Bignum (X : Long_Long_Integer) return Bignum is
- R : Bignum;
-
+ function To_Bignum (X : Long_Long_Integer) return Big_Integer is
begin
if X = 0 then
- R := Allocate_Bignum (0);
+ return Allocate_Big_Integer ((1 .. 0 => <>), False);
-- One word result
elsif X in -(2 ** 32 - 1) .. +(2 ** 32 - 1) then
- R := Allocate_Bignum (1);
- R.D (1) := SD (abs (X));
+ return Allocate_Big_Integer ((1 => SD (abs X)), X < 0);
-- Largest negative number annoyance
elsif X = Long_Long_Integer'First then
- R := Allocate_Bignum (2);
- R.D (1) := 2 ** 31;
- R.D (2) := 0;
+ return Allocate_Big_Integer ((2 ** 31, 0), True);
- -- Normal two word case
+ -- Other negative numbers
+ elsif X < 0 then
+ return Allocate_Big_Integer
+ ((SD ((-X) / Base), SD ((-X) mod Base)), True);
+
+ -- Positive numbers
else
- R := Allocate_Bignum (2);
- R.D (2) := SD (abs (X) mod Base);
- R.D (1) := SD (abs (X) / Base);
+ return Allocate_Big_Integer ((SD (X / Base), SD (X mod Base)), False);
end if;
-
- R.Neg := X < 0;
- return R;
end To_Bignum;
- function To_Bignum (X : Unsigned_64) return Bignum is
- R : Bignum;
-
+ function To_Bignum (X : Unsigned_64) return Big_Integer is
begin
if X = 0 then
- R := Allocate_Bignum (0);
+ return Allocate_Big_Integer ((1 .. 0 => <>), False);
-- One word result
elsif X < 2 ** 32 then
- R := Allocate_Bignum (1);
- R.D (1) := SD (X);
+ return Allocate_Big_Integer ((1 => SD (X)), False);
-- Two word result
else
- R := Allocate_Bignum (2);
- R.D (2) := SD (X mod Base);
- R.D (1) := SD (X / Base);
+ return Allocate_Big_Integer ((SD (X / Base), SD (X mod Base)), False);
end if;
-
- R.Neg := False;
- return R;
end To_Bignum;
+ ---------------
+ -- To_String --
+ ---------------
+
+ Hex_Chars : constant array (0 .. 15) of Character := "0123456789ABCDEF";
+
+ function To_String
+ (X : Bignum; Width : Natural := 0; Base : Positive := 10) return String
+ is
+ Big_Base : aliased Bignum_Data := (1, False, (1 => SD (Base)));
+
+ function Add_Base (S : String) return String;
+ -- Add base information if Base /= 10
+
+ function Leading_Padding
+ (Str : String;
+ Min_Length : Natural;
+ Char : Character := ' ') return String;
+ -- Return padding of Char concatenated with Str so that the resulting
+ -- string is at least Min_Length long.
+
+ function Image (Arg : Bignum) return String;
+ -- Return image of Arg, assuming Arg is positive.
+
+ function Image (N : Natural) return String;
+ -- Return image of N, with no leading space.
+
+ --------------
+ -- Add_Base --
+ --------------
+
+ function Add_Base (S : String) return String is
+ begin
+ if Base = 10 then
+ return S;
+ else
+ return Image (Base) & "#" & S & "#";
+ end if;
+ end Add_Base;
+
+ -----------
+ -- Image --
+ -----------
+
+ function Image (N : Natural) return String is
+ S : constant String := Natural'Image (N);
+ begin
+ return S (2 .. S'Last);
+ end Image;
+
+ function Image (Arg : Bignum) return String is
+ begin
+ if Big_LT (Arg, Big_Base'Unchecked_Access) then
+ return (1 => Hex_Chars (Natural (From_Bignum (Arg))));
+ else
+ declare
+ Div : aliased Big_Integer;
+ Remain : aliased Big_Integer;
+ R : Natural;
+
+ begin
+ Div_Rem (Arg, Big_Base'Unchecked_Access, Div, Remain);
+ R := Natural (From_Bignum (To_Bignum (Remain)));
+ Free_Big_Integer (Remain);
+
+ return S : constant String :=
+ Image (To_Bignum (Div)) & Hex_Chars (R)
+ do
+ Free_Big_Integer (Div);
+ end return;
+ end;
+ end if;
+ end Image;
+
+ ---------------------
+ -- Leading_Padding --
+ ---------------------
+
+ function Leading_Padding
+ (Str : String;
+ Min_Length : Natural;
+ Char : Character := ' ') return String is
+ begin
+ return (1 .. Integer'Max (Integer (Min_Length) - Str'Length, 0)
+ => Char) & Str;
+ end Leading_Padding;
+
+ Zero : aliased Bignum_Data := (0, False, D => Zero_Data);
+
+ begin
+ if Big_LT (X, Zero'Unchecked_Access) then
+ declare
+ X_Pos : aliased Bignum_Data := (X.Len, not X.Neg, X.D);
+ begin
+ return Leading_Padding
+ ("-" & Add_Base (Image (X_Pos'Unchecked_Access)), Width);
+ end;
+ else
+ return Leading_Padding (" " & Add_Base (Image (X)), Width);
+ end if;
+ end To_String;
+
-------------
-- Is_Zero --
-------------
-- and can be used either built into the compiler via System.Bignums or to
-- implement a default version of Ada.Numerics.Big_Numbers.Big_Integers.
--- If Use_Secondary_Stack is True then all Bignum values are allocated on the
--- secondary stack. If False, the heap is used and the caller is responsible
--- for memory management.
-
-with Ada.Unchecked_Conversion;
with Interfaces;
+with System.Shared_Bignums;
generic
- Use_Secondary_Stack : Boolean;
-package System.Generic_Bignums is
- pragma Preelaborate;
-
- pragma Assert (Long_Long_Integer'Size = 64);
- -- This package assumes that Long_Long_Integer size is 64 bit (i.e. that it
- -- has a range of -2**63 to 2**63-1). The front end ensures that the mode
- -- ELIMINATED is not allowed for overflow checking if this is not the case.
-
- subtype Length is Natural range 0 .. 2 ** 23 - 1;
- -- Represent number of words in Digit_Vector
-
- Base : constant := 2 ** 32;
- -- Digit vectors use this base
-
- subtype SD is Interfaces.Unsigned_32;
- -- Single length digit
+ type Big_Integer is private;
- type Digit_Vector is array (Length range <>) of SD;
- -- Represent digits of a number (most significant digit first)
+ with function Allocate_Big_Integer
+ (D : Shared_Bignums.Digit_Vector; Neg : Boolean) return Big_Integer;
+ -- Allocate Bignum value with the given contents
- type Bignum_Data (Len : Length) is record
- Neg : Boolean;
- -- Set if value is negative, never set for zero
+ with procedure Free_Big_Integer (X : in out Big_Integer);
+ -- Free the memory associated with X
- D : Digit_Vector (1 .. Len);
- -- Digits of number, most significant first, represented in base
- -- 2**Base. No leading zeroes are stored, and the value of zero is
- -- represented using an empty vector for D.
- end record;
+ with function To_Bignum
+ (X : aliased in out Big_Integer) return Shared_Bignums.Bignum;
+ -- Convert the given Big_Integer to a Bignum
- for Bignum_Data use record
- Len at 0 range 0 .. 23;
- Neg at 3 range 0 .. 7;
- end record;
+package System.Generic_Bignums is
+ pragma Preelaborate;
- type Bignum is access all Bignum_Data;
- -- This is the type that is used externally. Possibly this could be a
- -- private type, but we leave the structure exposed for now. For one
- -- thing it helps with debugging. Note that this package never shares
- -- an allocated Bignum value, so for example for X + 0, a copy of X is
- -- returned, not X itself.
+ subtype Bignum is Shared_Bignums.Bignum;
- function To_Bignum is new Ada.Unchecked_Conversion (System.Address, Bignum);
- function To_Address is new
- Ada.Unchecked_Conversion (Bignum, System.Address);
+ -- Note that this package never shares an allocated Big_Integer value, so
+ -- so for example for X + 0, a copy of X is returned, not X itself.
-- Note: none of the subprograms in this package modify the Bignum_Data
-- records referenced by Bignum arguments of mode IN.
- function Big_Add (X, Y : Bignum) return Bignum; -- "+"
- function Big_Sub (X, Y : Bignum) return Bignum; -- "-"
- function Big_Mul (X, Y : Bignum) return Bignum; -- "*"
- function Big_Div (X, Y : Bignum) return Bignum; -- "/"
- function Big_Exp (X, Y : Bignum) return Bignum; -- "**"
- function Big_Mod (X, Y : Bignum) return Bignum; -- "mod"
- function Big_Rem (X, Y : Bignum) return Bignum; -- "rem"
- function Big_Neg (X : Bignum) return Bignum; -- "-"
- function Big_Abs (X : Bignum) return Bignum; -- "abs"
+ function Big_Add (X, Y : Bignum) return Big_Integer; -- "+"
+ function Big_Sub (X, Y : Bignum) return Big_Integer; -- "-"
+ function Big_Mul (X, Y : Bignum) return Big_Integer; -- "*"
+ function Big_Div (X, Y : Bignum) return Big_Integer; -- "/"
+ function Big_Exp (X, Y : Bignum) return Big_Integer; -- "**"
+ function Big_Mod (X, Y : Bignum) return Big_Integer; -- "mod"
+ function Big_Rem (X, Y : Bignum) return Big_Integer; -- "rem"
+ function Big_Neg (X : Bignum) return Big_Integer; -- "-"
+ function Big_Abs (X : Bignum) return Big_Integer; -- "abs"
-- Perform indicated arithmetic operation on bignum values. No exception
-- raised except for Div/Mod/Rem by 0 which raises Constraint_Error with
-- an appropriate message.
+ function Big_And (X, Y : Bignum) return Big_Integer; -- "and"
+ function Big_Or (X, Y : Bignum) return Big_Integer; -- "or"
+ -- Perform indicated bitwise operation on big num values.
+ -- The negative flags of X and Y are also combined.
+
+ function Big_Shift_Left (X : Bignum; Amount : Natural) return Big_Integer;
+ function Big_Shift_Right (X : Bignum; Amount : Natural) return Big_Integer;
+ -- Perform indicated bitwise operation on big num values.
+ -- Constraint_Error is raised if X is negative.
+
function Big_EQ (X, Y : Bignum) return Boolean; -- "="
function Big_NE (X, Y : Bignum) return Boolean; -- "/="
function Big_GE (X, Y : Bignum) return Boolean; -- ">="
-- Returns True if the Bignum value is in the range of Long_Long_Integer,
-- so that a call to From_Bignum is guaranteed not to raise an exception.
- function To_Bignum (X : Long_Long_Integer) return Bignum;
- -- Convert Long_Long_Integer to Bignum. No exception can be raised for any
- -- input argument.
+ function To_Bignum (X : Long_Long_Integer) return Big_Integer;
+ -- Convert Long_Long_Integer to a big integer. No exception can be raised
+ -- for any input argument.
- function To_Bignum (X : Interfaces.Unsigned_64) return Bignum;
- -- Convert Unsigned_64 to Bignum. No exception can be raised for any
+ function To_Bignum (X : Interfaces.Unsigned_64) return Big_Integer;
+ -- Convert Unsigned_64 to a big integer. No exception can be raised for any
-- input argument.
function From_Bignum (X : Bignum) return Long_Long_Integer;
-- Convert Bignum to Long_Long_Integer. Constraint_Error raised with
-- appropriate message if value is out of range of Long_Long_Integer.
+ function To_String
+ (X : Bignum; Width : Natural := 0; Base : Positive := 10)
+ return String;
+ -- Return the image of X, based on the given Width and Base, as defined
+ -- in the RM for Ada.Text_IO. Base should really be in the range 2 .. 16.
+
function Is_Zero (X : Bignum) return Boolean;
-- Return True if X = 0
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . S H A R E D _ B I G N U M S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2012-2020, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides declarations shared across all instantiations of
+-- System.Generic_Bignums.
+
+with Ada.Unchecked_Conversion;
+with Interfaces;
+
+package System.Shared_Bignums is
+ pragma Preelaborate;
+
+ pragma Assert (Long_Long_Integer'Size = 64);
+ -- This package assumes that Long_Long_Integer size is 64 bit (i.e. that it
+ -- has a range of -2**63 to 2**63-1). The front end ensures that the mode
+ -- ELIMINATED is not allowed for overflow checking if this is not the case.
+
+ subtype Length is Natural range 0 .. 2 ** 23 - 1;
+ -- Represent number of words in Digit_Vector
+
+ Base : constant := 2 ** 32;
+ -- Digit vectors use this base
+
+ subtype SD is Interfaces.Unsigned_32;
+ -- Single length digit
+
+ type Digit_Vector is array (Length range <>) of SD;
+ -- Represent digits of a number (most significant digit first)
+
+ type Bignum_Data (Len : Length) is record
+ Neg : Boolean;
+ -- Set if value is negative, never set for zero
+
+ D : Digit_Vector (1 .. Len);
+ -- Digits of number, most significant first, represented in base
+ -- 2**Base. No leading zeroes are stored, and the value of zero is
+ -- represented using an empty vector for D.
+ end record;
+
+ for Bignum_Data use record
+ Len at 0 range 0 .. 23;
+ Neg at 3 range 0 .. 7;
+ end record;
+
+ type Bignum is access all Bignum_Data;
+
+ function To_Bignum is new Ada.Unchecked_Conversion (System.Address, Bignum);
+
+ function To_Address is new
+ Ada.Unchecked_Conversion (Bignum, System.Address);
+
+end System.Shared_Bignums;
projects / gcc.git / commitdiff