1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- ADA.NUMERICS.BIG_NUMBERS.BIG_INTEGERS --
9 -- Copyright (C) 2019, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada.Unchecked_Deallocation;
33 with Ada.Characters.Conversions; use Ada.Characters.Conversions;
35 with Interfaces; use Interfaces;
37 with System.Generic_Bignums;
39 package body Ada.Numerics.Big_Numbers.Big_Integers is
41 package Bignums is new
42 System.Generic_Bignums (Use_Secondary_Stack => False);
45 procedure Free is new Ada.Unchecked_Deallocation (Bignum_Data, Bignum);
47 function Get_Bignum (Arg : Big_Integer) return Bignum is
48 (if Arg.Value.C = System.Null_Address
49 then raise Constraint_Error with "invalid big integer"
50 else To_Bignum (Arg.Value.C));
51 -- Check for validity of Arg and return the Bignum value stored in Arg.
52 -- Raise Constraint_Error if Arg is uninitialized.
54 procedure Set_Bignum (Arg : out Big_Integer; Value : Bignum)
56 -- Set the Bignum value stored in Arg to Value
62 procedure Set_Bignum (Arg : out Big_Integer; Value : Bignum) is
64 Arg.Value.C := To_Address (Value);
71 function Is_Valid (Arg : Big_Integer) return Boolean is
72 (Arg.Value.C /= System.Null_Address);
78 function "=" (L, R : Big_Integer) return Boolean is
80 return Big_EQ (Get_Bignum (L), Get_Bignum (R));
87 function "<" (L, R : Big_Integer) return Boolean is
89 return Big_LT (Get_Bignum (L), Get_Bignum (R));
96 function "<=" (L, R : Big_Integer) return Boolean is
98 return Big_LE (Get_Bignum (L), Get_Bignum (R));
105 function ">" (L, R : Big_Integer) return Boolean is
107 return Big_GT (Get_Bignum (L), Get_Bignum (R));
114 function ">=" (L, R : Big_Integer) return Boolean is
116 return Big_GE (Get_Bignum (L), Get_Bignum (R));
123 function To_Big_Integer (Arg : Integer) return Big_Integer is
124 Result : Big_Integer;
126 Set_Bignum (Result, To_Bignum (Long_Long_Integer (Arg)));
134 function To_Integer (Arg : Big_Integer) return Integer is
136 return Integer (From_Bignum (Get_Bignum (Arg)));
139 ------------------------
140 -- Signed_Conversions --
141 ------------------------
143 package body Signed_Conversions is
149 function To_Big_Integer (Arg : Int) return Big_Integer is
150 Result : Big_Integer;
152 Set_Bignum (Result, To_Bignum (Long_Long_Integer (Arg)));
156 ----------------------
157 -- From_Big_Integer --
158 ----------------------
160 function From_Big_Integer (Arg : Big_Integer) return Int is
162 return Int (From_Bignum (Get_Bignum (Arg)));
163 end From_Big_Integer;
165 end Signed_Conversions;
167 --------------------------
168 -- Unsigned_Conversions --
169 --------------------------
171 package body Unsigned_Conversions is
177 function To_Big_Integer (Arg : Int) return Big_Integer is
178 Result : Big_Integer;
180 Set_Bignum (Result, To_Bignum (Unsigned_64 (Arg)));
184 ----------------------
185 -- From_Big_Integer --
186 ----------------------
188 function From_Big_Integer (Arg : Big_Integer) return Int is
190 return Int (From_Bignum (Get_Bignum (Arg)));
191 end From_Big_Integer;
193 end Unsigned_Conversions;
199 Hex_Chars : constant array (0 .. 15) of Character := "0123456789ABCDEF";
202 (Arg : Big_Integer; Width : Field := 0; Base : Number_Base := 10)
205 Big_Base : constant Big_Integer := To_Big_Integer (Integer (Base));
207 function Add_Base (S : String) return String;
208 -- Add base information if Base /= 10
210 function Leading_Padding
213 Char : Character := ' ') return String;
214 -- Return padding of Char concatenated with Str so that the resulting
215 -- string is at least Min_Length long.
217 function Image (Arg : Big_Integer) return String;
218 -- Return image of Arg, assuming Arg is positive.
220 function Image (N : Natural) return String;
221 -- Return image of N, with no leading space.
227 function Add_Base (S : String) return String is
232 return Image (Base) & "#" & S & "#";
240 function Image (N : Natural) return String is
241 S : constant String := Natural'Image (N);
243 return S (2 .. S'Last);
246 function Image (Arg : Big_Integer) return String is
248 if Arg < Big_Base then
249 return (1 => Hex_Chars (To_Integer (Arg)));
251 return Image (Arg / Big_Base)
252 & Hex_Chars (To_Integer (Arg rem Big_Base));
256 ---------------------
257 -- Leading_Padding --
258 ---------------------
260 function Leading_Padding
263 Char : Character := ' ') return String is
265 return (1 .. Integer'Max (Integer (Min_Length) - Str'Length, 0)
270 if Arg < To_Big_Integer (0) then
271 return Leading_Padding ("-" & Add_Base (Image (-Arg)), Width);
273 return Leading_Padding (" " & Add_Base (Image (Arg)), Width);
281 function From_String (Arg : String) return Big_Integer is
282 Result : Big_Integer;
284 -- ??? only support Long_Long_Integer, good enough for now
285 Set_Bignum (Result, To_Bignum (Long_Long_Integer'Value (Arg)));
294 (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
295 Arg : Big_Integer) is
297 Wide_Wide_String'Write (Stream, To_Wide_Wide_String (To_String (Arg)));
304 function "+" (L : Big_Integer) return Big_Integer is
305 Result : Big_Integer;
307 Set_Bignum (Result, new Bignum_Data'(Get_Bignum (L).all));
315 function "-" (L : Big_Integer) return Big_Integer is
316 Result : Big_Integer;
318 Set_Bignum (Result, Big_Neg (Get_Bignum (L)));
326 function "abs" (L : Big_Integer) return Big_Integer is
327 Result : Big_Integer;
329 Set_Bignum (Result, Big_Abs (Get_Bignum (L)));
337 function "+" (L, R : Big_Integer) return Big_Integer is
338 Result : Big_Integer;
340 Set_Bignum (Result, Big_Add (Get_Bignum (L), Get_Bignum (R)));
348 function "-" (L, R : Big_Integer) return Big_Integer is
349 Result : Big_Integer;
351 Set_Bignum (Result, Big_Sub (Get_Bignum (L), Get_Bignum (R)));
359 function "*" (L, R : Big_Integer) return Big_Integer is
360 Result : Big_Integer;
362 Set_Bignum (Result, Big_Mul (Get_Bignum (L), Get_Bignum (R)));
370 function "/" (L, R : Big_Integer) return Big_Integer is
371 Result : Big_Integer;
373 Set_Bignum (Result, Big_Div (Get_Bignum (L), Get_Bignum (R)));
381 function "mod" (L, R : Big_Integer) return Big_Integer is
382 Result : Big_Integer;
384 Set_Bignum (Result, Big_Mod (Get_Bignum (L), Get_Bignum (R)));
392 function "rem" (L, R : Big_Integer) return Big_Integer is
393 Result : Big_Integer;
395 Set_Bignum (Result, Big_Rem (Get_Bignum (L), Get_Bignum (R)));
403 function "**" (L : Big_Integer; R : Natural) return Big_Integer is
405 -- Explicitly check for validity before allocating Exp so that
406 -- the call to Get_Bignum below cannot raise an exception before
407 -- we get a chance to free Exp.
409 if not Is_Valid (L) then
410 raise Constraint_Error with "invalid big integer";
414 Exp : Bignum := To_Bignum (Long_Long_Integer (R));
415 Result : Big_Integer;
417 Set_Bignum (Result, Big_Exp (Get_Bignum (L), Exp));
427 function Min (L, R : Big_Integer) return Big_Integer is
428 (if L < R then L else R);
434 function Max (L, R : Big_Integer) return Big_Integer is
435 (if L > R then L else R);
437 -----------------------------
438 -- Greatest_Common_Divisor --
439 -----------------------------
441 function Greatest_Common_Divisor (L, R : Big_Integer) return Big_Positive is
442 function GCD (A, B : Big_Integer) return Big_Integer;
443 -- Recursive internal version
449 function GCD (A, B : Big_Integer) return Big_Integer is
451 if Is_Zero (Get_Bignum (B)) then
454 return GCD (B, A rem B);
459 return GCD (abs L, abs R);
460 end Greatest_Common_Divisor;
466 procedure Adjust (This : in out Controlled_Bignum) is
468 if This.C /= System.Null_Address then
469 This.C := To_Address (new Bignum_Data'(To_Bignum (This.C).all));
477 procedure Finalize (This : in out Controlled_Bignum) is
478 Tmp : Bignum := To_Bignum (This.C);
481 This.C := System.Null_Address;
484 end Ada.Numerics.Big_Numbers.Big_Integers;