--    GMPAda, binding to the Ada Language for the GNU MultiPrecision library.
--    Copyright (C) 2007-2022 Nicolas Boulenguez <nicolas.boulenguez@free.fr>
--
--    This program is free software: you can redistribute it and/or modify
--    it under the terms of the GNU General Public License as published by
--    the Free Software Foundation, either version 3 of the License, or
--    (at your option) any later version.
--
--    This program is distributed in the hope that it will be useful,
--    but WITHOUT ANY WARRANTY; without even the implied warranty of
--    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--    GNU General Public License for more details.
--
--    You should have received a copy of the GNU General Public License
--    along with this program.  If not, see <http://www.gnu.org/licenses/>.

with Interfaces.C.Pointers;
with Interfaces.C.Strings;

package body GMP.Binding is

   Bytes_Per_Limb : constant unsigned := unsigned (Mp_Bits_Per_Limb) / 8;

   procedure Read_Limb
     (Stream : access Ada.Streams.Root_Stream_Type'Class;
      Value  :    out Mp_Limb_T;
      Count  : in     unsigned := Bytes_Per_Limb - 1);
   procedure Write_4_Bytes
     (Stream : access Ada.Streams.Root_Stream_Type'Class;
      Value  : in     size_t);
   procedure Write_Limb
     (Stream : access Ada.Streams.Root_Stream_Type'Class;
      Value  : in     Mp_Limb_T;
      Count  : in     Natural := Positive (Bytes_Per_Limb) - 1);

   type Mp_Limb_T_Array is array (size_t range <>) of aliased Mp_Limb_T;
   package Limbs is new Pointers (size_t, Mp_Limb_T, Mp_Limb_T_Array, 0);

   pragma Inline (Read_Limb);
   procedure Read_Limb (Stream : access Ada.Streams.Root_Stream_Type'Class;
                        Value  :    out Mp_Limb_T;
                        Count  : in     unsigned := Bytes_Per_Limb - 1) is
   begin
      Value := 0;
      for I in reverse 0 .. Count loop
         Value := Value * 16#100# or Mp_Limb_T (unsigned_char'Input (Stream));
      end loop;
   end Read_Limb;

   pragma Inline (Write_4_Bytes);
   procedure Write_4_Bytes (Stream : access Ada.Streams.Root_Stream_Type'Class;
                            Value  : in     size_t) is
   begin
      for I in reverse 0 .. 3 loop
         unsigned_char'Write (Stream,
                              unsigned_char (Value / 16#100#**I and 16#FF#));
      end loop;
   end Write_4_Bytes;

   pragma Inline (Write_Limb);
   procedure Write_Limb (Stream : access Ada.Streams.Root_Stream_Type'Class;
                         Value  : in     Mp_Limb_T;
                         Count  : in     Natural
                           := Positive (Bytes_Per_Limb) - 1) is
   begin
      for I in reverse 0 .. Count loop
         unsigned_char'Write (Stream,
                              unsigned_char (Value / 16#100#**I and 16#FF#));
      end loop;
   end Write_Limb;

   procedure Read (Stream : access Ada.Streams.Root_Stream_Type'Class;
                   Item   :   out  Mpz_T)
   is
      use Limbs;
      Size     : unsigned := 0;
      Negative : Boolean;
      P        : Pointer;
   begin
      for I in 0 .. 3 loop
         Size := Size * 256 or unsigned (unsigned_char'Input (Stream));
      end loop;
      Negative := (Size and 2 ** (unsigned'Size - 1)) /= 0;
      if Negative then
         Size := -Size;
      end if;
      Mpz_Init2 (Item, 8 * unsigned_long (Size));
      --  Using C memory allocation is more portable.
      if Size = 0 then
         return;
      end if;
      Item (0).u_mp_size := int ((Size + Bytes_Per_Limb - 1) / Bytes_Per_Limb);
      pragma Assert (Item (0).u_mp_size <= Item (0).u_mp_alloc);
      P := Item (0).u_mp_d + ptrdiff_t (Item (0).u_mp_size) - 1;
      Read_Limb (Stream, P.all, (Size - 1) mod Bytes_Per_Limb);
      pragma Assert
        ((P.all and 16#FF# * 16#100#**Natural ((Size - 1) mod Bytes_Per_Limb))
         /= 0);
      while P /= Item (0).u_mp_d loop
         Decrement (P);
         Read_Limb (Stream, P.all);
      end loop;
      if Negative then
         pragma Warnings (Off,
            "writable actual for * overlaps with actual for *");
         Mpz_Neg (Item, Item);
         pragma Warnings (On,
            "writable actual for * overlaps with actual for *");
      end if;
   end Read;

   function Gmp_Version return String
   is
      Internal : Interfaces.C.Strings.chars_ptr
        with Import, Convention => C, External_Name => "__gmp_version";
   begin
      return Interfaces.C.Strings.Value (Internal);
   end Gmp_Version;

   procedure Write (Stream : access Ada.Streams.Root_Stream_Type'Class;
                    Item   : in     Mpz_T)
   is
      Limb_Size : constant size_t := Mpz_Size (Item);
      Size : size_t    := Limb_Size * size_t (Bytes_Per_Limb);
      Mask : Mp_Limb_T := 16#FF# * 16#100#**Natural (Bytes_Per_Limb - 1);
      L    : Mp_Limb_T;
   begin
      if Limb_Size = 0 then
         Write_4_Bytes (Stream, 0);
         return;
      end if;
      L := Mpz_Getlimbn (Item, Mp_Size_T (Limb_Size - 1));
      while (L and Mask) = 0 loop
         Mask := Mask / 16#100#;
         Size := Size - 1;
         pragma Assert (Mask /= 0);
      end loop;
      if Mpz_Sgn (Item) < 0 then
         Write_4_Bytes (Stream, -Size);
      else
         Write_4_Bytes (Stream, +Size);
      end if;
      Write_Limb (Stream, L, Natural (Size - 1) mod Natural (Bytes_Per_Limb));
      if Limb_Size = 1 then
         return;
      end if;
      --  Mp_size_t is unsigned, so 0 .. -1 is NOT an empty range.
      for N in reverse 0 .. Mp_Size_T (Limb_Size - 2) loop
         Write_Limb (Stream, Mpz_Getlimbn (Item, N));
      end loop;
   end Write;

end GMP.Binding;
