--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/libgnat/a-nbnbin__gmp.adb	Thu Feb 13 11:34:05 2020 +0900
@@ -0,0 +1,730 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                  ADA.NUMERICS.BIG_NUMBERS.BIG_INTEGERS                   --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 2019, 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 is the GMP version of this package
+
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Interfaces.C;               use Interfaces.C;
+with Interfaces.C.Strings;       use Interfaces.C.Strings;
+with Ada.Characters.Conversions; use Ada.Characters.Conversions;
+with Ada.Characters.Handling;    use Ada.Characters.Handling;
+
+package body Ada.Numerics.Big_Numbers.Big_Integers is
+
+   use System;
+
+   pragma Linker_Options ("-lgmp");
+
+   type mpz_t is record
+      mp_alloc : Integer;
+      mp_size  : Integer;
+      mp_d     : System.Address;
+   end record;
+   pragma Convention (C, mpz_t);
+   type mpz_t_ptr is access all mpz_t;
+
+   function To_Mpz is new Ada.Unchecked_Conversion (System.Address, mpz_t_ptr);
+   function To_Address is new
+     Ada.Unchecked_Conversion (mpz_t_ptr, System.Address);
+
+   function Get_Mpz (Arg : Optional_Big_Integer) return mpz_t_ptr is
+     (To_Mpz (Arg.Value.C));
+   --  Return the mpz_t value stored in Arg
+
+   procedure Set_Mpz (Arg : in out Optional_Big_Integer; Value : mpz_t_ptr)
+     with Inline;
+   --  Set the mpz_t value stored in Arg to Value
+
+   procedure Allocate (This : in out Optional_Big_Integer) with Inline;
+   --  Allocate an Optional_Big_Integer, including the underlying mpz
+
+   procedure mpz_init_set (ROP : access mpz_t;  OP : access constant mpz_t);
+   pragma Import (C, mpz_init_set, "__gmpz_init_set");
+
+   procedure mpz_set (ROP : access mpz_t;  OP : access constant mpz_t);
+   pragma Import (C, mpz_set, "__gmpz_set");
+
+   function mpz_cmp (OP1, OP2 : access constant mpz_t) return Integer;
+   pragma Import (C, mpz_cmp, "__gmpz_cmp");
+
+   function mpz_cmp_ui
+     (OP1 : access constant mpz_t; OP2 : unsigned_long) return Integer;
+   pragma Import (C, mpz_cmp_ui, "__gmpz_cmp_ui");
+
+   procedure mpz_set_si (ROP : access mpz_t; OP : long);
+   pragma Import (C, mpz_set_si, "__gmpz_set_si");
+
+   procedure mpz_set_ui (ROP : access mpz_t; OP : unsigned_long);
+   pragma Import (C, mpz_set_ui, "__gmpz_set_ui");
+
+   function mpz_get_si (OP : access constant mpz_t) return long;
+   pragma Import (C, mpz_get_si, "__gmpz_get_si");
+
+   function mpz_get_ui (OP : access constant mpz_t) return unsigned_long;
+   pragma Import (C, mpz_get_ui, "__gmpz_get_ui");
+
+   procedure mpz_neg (ROP : access mpz_t;  OP : access constant mpz_t);
+   pragma Import (C, mpz_neg, "__gmpz_neg");
+
+   procedure mpz_sub (ROP : access mpz_t;  OP1, OP2 : access constant mpz_t);
+   pragma Import (C, mpz_sub, "__gmpz_sub");
+
+   -------------
+   -- Set_Mpz --
+   -------------
+
+   procedure Set_Mpz (Arg : in out Optional_Big_Integer; Value : mpz_t_ptr) is
+   begin
+      Arg.Value.C := To_Address (Value);
+   end Set_Mpz;
+
+   --------------
+   -- Is_Valid --
+   --------------
+
+   function Is_Valid (Arg : Optional_Big_Integer) return Boolean is
+     (Arg.Value.C /= System.Null_Address);
+
+   --------------------------
+   -- Invalid_Big_Integer --
+   --------------------------
+
+   function Invalid_Big_Integer return Optional_Big_Integer is
+     (Value => (Ada.Finalization.Controlled with C => System.Null_Address));
+
+   ---------
+   -- "=" --
+   ---------
+
+   function "=" (L, R : Big_Integer) return Boolean is
+   begin
+      return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) = 0;
+   end "=";
+
+   ---------
+   -- "<" --
+   ---------
+
+   function "<" (L, R : Big_Integer) return Boolean is
+   begin
+      return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) < 0;
+   end "<";
+
+   ----------
+   -- "<=" --
+   ----------
+
+   function "<=" (L, R : Big_Integer) return Boolean is
+   begin
+      return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) <= 0;
+   end "<=";
+
+   ---------
+   -- ">" --
+   ---------
+
+   function ">" (L, R : Big_Integer) return Boolean is
+   begin
+      return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) > 0;
+   end ">";
+
+   ----------
+   -- ">=" --
+   ----------
+
+   function ">=" (L, R : Big_Integer) return Boolean is
+   begin
+      return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) >= 0;
+   end ">=";
+
+   --------------------
+   -- To_Big_Integer --
+   --------------------
+
+   function To_Big_Integer (Arg : Integer) return Big_Integer is
+      Result : Optional_Big_Integer;
+   begin
+      Allocate (Result);
+      mpz_set_si (Get_Mpz (Result), long (Arg));
+      return Result;
+   end To_Big_Integer;
+
+   ----------------
+   -- To_Integer --
+   ----------------
+
+   function To_Integer (Arg : Big_Integer) return Integer is
+   begin
+      return Integer (mpz_get_si (Get_Mpz (Arg)));
+   end To_Integer;
+
+   ------------------------
+   -- Signed_Conversions --
+   ------------------------
+
+   package body Signed_Conversions is
+
+      --------------------
+      -- To_Big_Integer --
+      --------------------
+
+      function To_Big_Integer (Arg : Int) return Big_Integer is
+         Result : Optional_Big_Integer;
+      begin
+         Allocate (Result);
+         mpz_set_si (Get_Mpz (Result), long (Arg));
+         return Result;
+      end To_Big_Integer;
+
+      ----------------------
+      -- From_Big_Integer --
+      ----------------------
+
+      function From_Big_Integer (Arg : Big_Integer) return Int is
+      begin
+         return Int (mpz_get_si (Get_Mpz (Arg)));
+      end From_Big_Integer;
+
+   end Signed_Conversions;
+
+   --------------------------
+   -- Unsigned_Conversions --
+   --------------------------
+
+   package body Unsigned_Conversions is
+
+      --------------------
+      -- To_Big_Integer --
+      --------------------
+
+      function To_Big_Integer (Arg : Int) return Big_Integer is
+         Result : Optional_Big_Integer;
+      begin
+         Allocate (Result);
+         mpz_set_ui (Get_Mpz (Result), unsigned_long (Arg));
+         return Result;
+      end To_Big_Integer;
+
+      ----------------------
+      -- From_Big_Integer --
+      ----------------------
+
+      function From_Big_Integer (Arg : Big_Integer) return Int is
+      begin
+         return Int (mpz_get_ui (Get_Mpz (Arg)));
+      end From_Big_Integer;
+
+   end Unsigned_Conversions;
+
+   ---------------
+   -- To_String --
+   ---------------
+
+   function To_String
+     (Arg : Big_Integer; Width : Field := 0; Base : Number_Base := 10)
+      return String
+   is
+      function mpz_get_str
+        (STR  : System.Address;
+         BASE : Integer;
+         OP   : access constant mpz_t) return chars_ptr;
+      pragma Import (C, mpz_get_str, "__gmpz_get_str");
+
+      function mpz_sizeinbase
+         (this : access constant mpz_t; base : Integer) return size_t;
+      pragma Import (C, mpz_sizeinbase, "__gmpz_sizeinbase");
+
+      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 (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) & "#" & To_Upper (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;
+
+      ---------------------
+      -- 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;
+
+      Number_Digits : constant Integer :=
+        Integer (mpz_sizeinbase (Get_Mpz (Arg), Integer (abs Base)));
+
+      Buffer : aliased String (1 .. Number_Digits + 2);
+      --  The correct number to allocate is 2 more than Number_Digits in order
+      --  to handle a possible minus sign and the null-terminator.
+
+      Result : constant chars_ptr :=
+        mpz_get_str (Buffer'Address, Integer (Base), Get_Mpz (Arg));
+      S      : constant String := Value (Result);
+
+   begin
+      if S (1) = '-' then
+         return Leading_Padding ("-" & Add_Base (S (2 .. S'Last)), Width);
+      else
+         return Leading_Padding (" " & Add_Base (S), Width);
+      end if;
+   end To_String;
+
+   -----------------
+   -- From_String --
+   -----------------
+
+   function From_String (Arg : String) return Big_Integer is
+      function mpz_set_str
+        (this : access mpz_t;
+         str  : System.Address;
+         base : Integer := 10) return Integer;
+      pragma Import (C, mpz_set_str, "__gmpz_set_str");
+
+      Result : Optional_Big_Integer;
+      First  : Natural;
+      Last   : Natural;
+      Base   : Natural;
+
+   begin
+      Allocate (Result);
+
+      if Arg (Arg'Last) /= '#' then
+
+         --  Base 10 number
+
+         First := Arg'First;
+         Last  := Arg'Last;
+         Base  := 10;
+      else
+         --  Compute the xx base in a xx#yyyyy# number
+
+         if Arg'Length < 4 then
+            raise Constraint_Error;
+         end if;
+
+         First := 0;
+         Last  := Arg'Last - 1;
+
+         for J in Arg'First + 1 .. Last loop
+            if Arg (J) = '#' then
+               First := J;
+               exit;
+            end if;
+         end loop;
+
+         if First = 0 then
+            raise Constraint_Error;
+         end if;
+
+         Base  := Natural'Value (Arg (Arg'First .. First - 1));
+         First := First + 1;
+      end if;
+
+      declare
+         Str   : aliased String (1 .. Last - First + 2);
+         Index : Natural := 0;
+      begin
+         --  Strip underscores
+
+         for J in First .. Last loop
+            if Arg (J) /= '_' then
+               Index := Index + 1;
+               Str (Index) := Arg (J);
+            end if;
+         end loop;
+
+         Index := Index + 1;
+         Str (Index) := ASCII.NUL;
+
+         if mpz_set_str (Get_Mpz (Result), Str'Address, Base) /= 0 then
+            raise Constraint_Error;
+         end if;
+      end;
+
+      return Result;
+   end From_String;
+
+   ---------------
+   -- Put_Image --
+   ---------------
+
+   procedure Put_Image
+     (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+      Arg    : Big_Integer) is
+   begin
+      Wide_Wide_String'Write (Stream, To_Wide_Wide_String (To_String (Arg)));
+   end Put_Image;
+
+   ---------
+   -- "+" --
+   ---------
+
+   function "+" (L : Big_Integer) return Big_Integer is
+      Result : Optional_Big_Integer;
+   begin
+      Set_Mpz (Result, new mpz_t);
+      mpz_init_set (Get_Mpz (Result), Get_Mpz (L));
+      return Result;
+   end "+";
+
+   ---------
+   -- "-" --
+   ---------
+
+   function "-" (L : Big_Integer) return Big_Integer is
+      Result : Optional_Big_Integer;
+   begin
+      Allocate (Result);
+      mpz_neg (Get_Mpz (Result), Get_Mpz (L));
+      return Result;
+   end "-";
+
+   -----------
+   -- "abs" --
+   -----------
+
+   function "abs" (L : Big_Integer) return Big_Integer is
+      procedure mpz_abs (ROP : access mpz_t;  OP : access constant mpz_t);
+      pragma Import (C, mpz_abs, "__gmpz_abs");
+
+      Result : Optional_Big_Integer;
+   begin
+      Allocate (Result);
+      mpz_abs (Get_Mpz (Result), Get_Mpz (L));
+      return Result;
+   end "abs";
+
+   ---------
+   -- "+" --
+   ---------
+
+   function "+" (L, R : Big_Integer) return Big_Integer is
+      procedure mpz_add
+        (ROP : access mpz_t;  OP1, OP2 : access constant mpz_t);
+      pragma Import (C, mpz_add, "__gmpz_add");
+
+      Result : Optional_Big_Integer;
+
+   begin
+      Allocate (Result);
+      mpz_add (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
+      return Result;
+   end "+";
+
+   ---------
+   -- "-" --
+   ---------
+
+   function "-" (L, R : Big_Integer) return Big_Integer is
+      Result : Optional_Big_Integer;
+   begin
+      Allocate (Result);
+      mpz_sub (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
+      return Result;
+   end "-";
+
+   ---------
+   -- "*" --
+   ---------
+
+   function "*" (L, R : Big_Integer) return Big_Integer is
+      procedure mpz_mul
+        (ROP : access mpz_t;  OP1, OP2 : access constant mpz_t);
+      pragma Import (C, mpz_mul, "__gmpz_mul");
+
+      Result : Optional_Big_Integer;
+
+   begin
+      Allocate (Result);
+      mpz_mul (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
+      return Result;
+   end "*";
+
+   ---------
+   -- "/" --
+   ---------
+
+   function "/" (L, R : Big_Integer) return Big_Integer is
+      procedure mpz_tdiv_q (Q : access mpz_t;  N, D : access constant mpz_t);
+      pragma Import (C, mpz_tdiv_q, "__gmpz_tdiv_q");
+   begin
+      if mpz_cmp_ui (Get_Mpz (R), 0) = 0 then
+         raise Constraint_Error;
+      end if;
+
+      declare
+         Result : Optional_Big_Integer;
+      begin
+         Allocate (Result);
+         mpz_tdiv_q (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
+         return Result;
+      end;
+   end "/";
+
+   -----------
+   -- "mod" --
+   -----------
+
+   function "mod" (L, R : Big_Integer) return Big_Integer is
+      procedure mpz_mod (R : access mpz_t;  N, D : access constant mpz_t);
+      pragma Import (C, mpz_mod, "__gmpz_mod");
+      --  result is always non-negative
+
+      L_Negative, R_Negative : Boolean;
+
+   begin
+      if mpz_cmp_ui (Get_Mpz (R), 0) = 0 then
+         raise Constraint_Error;
+      end if;
+
+      declare
+         Result : Optional_Big_Integer;
+      begin
+         Allocate (Result);
+         L_Negative := mpz_cmp_ui (Get_Mpz (L), 0) < 0;
+         R_Negative := mpz_cmp_ui (Get_Mpz (R), 0) < 0;
+
+         if not (L_Negative or R_Negative) then
+            mpz_mod (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
+         else
+            --  The GMP library provides operators defined by C semantics, but
+            --  the semantics of Ada's mod operator are not the same as C's
+            --  when negative values are involved. We do the following to
+            --  implement the required Ada semantics.
+
+            declare
+               Temp_Left   : Big_Integer;
+               Temp_Right  : Big_Integer;
+               Temp_Result : Big_Integer;
+
+            begin
+               Allocate (Temp_Result);
+               Set_Mpz (Temp_Left, new mpz_t);
+               Set_Mpz (Temp_Right, new mpz_t);
+               mpz_init_set (Get_Mpz (Temp_Left), Get_Mpz (L));
+               mpz_init_set (Get_Mpz (Temp_Right), Get_Mpz (R));
+
+               if L_Negative then
+                  mpz_neg (Get_Mpz (Temp_Left), Get_Mpz (Temp_Left));
+               end if;
+
+               if R_Negative then
+                  mpz_neg (Get_Mpz (Temp_Right), Get_Mpz (Temp_Right));
+               end if;
+
+               --  now both Temp_Left and Temp_Right are nonnegative
+
+               mpz_mod (Get_Mpz (Temp_Result),
+                        Get_Mpz (Temp_Left),
+                        Get_Mpz (Temp_Right));
+
+               if mpz_cmp_ui (Get_Mpz (Temp_Result), 0) = 0 then
+                  --  if Temp_Result is zero we are done
+                  mpz_set (Get_Mpz (Result), Get_Mpz (Temp_Result));
+
+               elsif L_Negative then
+                  if R_Negative then
+                     mpz_neg (Get_Mpz (Result), Get_Mpz (Temp_Result));
+                  else -- L is negative but R is not
+                     mpz_sub (Get_Mpz (Result),
+                              Get_Mpz (Temp_Right),
+                              Get_Mpz (Temp_Result));
+                  end if;
+               else
+                  pragma Assert (R_Negative);
+                  mpz_sub (Get_Mpz (Result),
+                           Get_Mpz (Temp_Result),
+                           Get_Mpz (Temp_Right));
+               end if;
+            end;
+         end if;
+
+         return Result;
+      end;
+   end "mod";
+
+   -----------
+   -- "rem" --
+   -----------
+
+   function "rem" (L, R : Big_Integer) return Big_Integer is
+      procedure mpz_tdiv_r (R : access mpz_t;  N, D : access constant mpz_t);
+      pragma Import (C, mpz_tdiv_r, "__gmpz_tdiv_r");
+      --   R will have the same sign as N.
+
+   begin
+      if mpz_cmp_ui (Get_Mpz (R), 0) = 0 then
+         raise Constraint_Error;
+      end if;
+
+      declare
+         Result : Optional_Big_Integer;
+      begin
+         Allocate (Result);
+         mpz_tdiv_r (R => Get_Mpz (Result),
+                     N => Get_Mpz (L),
+                     D => Get_Mpz (R));
+         --  the result takes the sign of N, as required by the RM
+
+         return Result;
+      end;
+   end "rem";
+
+   ----------
+   -- "**" --
+   ----------
+
+   function "**" (L : Big_Integer; R : Natural) return Big_Integer is
+      procedure mpz_pow_ui (ROP : access mpz_t;
+                            BASE : access constant mpz_t;
+                            EXP : unsigned_long);
+      pragma Import (C, mpz_pow_ui, "__gmpz_pow_ui");
+
+      Result : Optional_Big_Integer;
+
+   begin
+      Allocate (Result);
+      mpz_pow_ui (Get_Mpz (Result), Get_Mpz (L), unsigned_long (R));
+      return Result;
+   end "**";
+
+   ---------
+   -- Min --
+   ---------
+
+   function Min (L, R : Big_Integer) return Big_Integer is
+     (if L < R then L else R);
+
+   ---------
+   -- Max --
+   ---------
+
+   function Max (L, R : Big_Integer) return Big_Integer is
+     (if L > R then L else R);
+
+   -----------------------------
+   -- Greatest_Common_Divisor --
+   -----------------------------
+
+   function Greatest_Common_Divisor (L, R : Big_Integer) return Big_Integer is
+      procedure mpz_gcd
+        (ROP : access mpz_t;  Op1, Op2 : access constant mpz_t);
+      pragma Import (C, mpz_gcd, "__gmpz_gcd");
+
+      Result : Optional_Big_Integer;
+
+   begin
+      Allocate (Result);
+      mpz_gcd (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
+      return Result;
+   end Greatest_Common_Divisor;
+
+   --------------
+   -- Allocate --
+   --------------
+
+   procedure Allocate (This : in out Optional_Big_Integer) is
+      procedure mpz_init (this : access mpz_t);
+      pragma Import (C, mpz_init, "__gmpz_init");
+   begin
+      Set_Mpz (This, new mpz_t);
+      mpz_init (Get_Mpz (This));
+   end Allocate;
+
+   ------------
+   -- Adjust --
+   ------------
+
+   procedure Adjust (This : in out Controlled_Bignum) is
+      Value : constant mpz_t_ptr := To_Mpz (This.C);
+   begin
+      if Value /= null then
+         This.C := To_Address (new mpz_t);
+         mpz_init_set (To_Mpz (This.C), Value);
+      end if;
+   end Adjust;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   procedure Finalize (This : in out Controlled_Bignum) is
+      procedure Free is new Ada.Unchecked_Deallocation (mpz_t, mpz_t_ptr);
+
+      procedure mpz_clear (this : access mpz_t);
+      pragma Import (C, mpz_clear, "__gmpz_clear");
+
+      Mpz : mpz_t_ptr;
+
+   begin
+      if This.C /= System.Null_Address then
+         Mpz := To_Mpz (This.C);
+         mpz_clear (Mpz);
+         Free (Mpz);
+         This.C := System.Null_Address;
+      end if;
+   end Finalize;
+
+end Ada.Numerics.Big_Numbers.Big_Integers;