gcc/ada/libgnat/s-bignum.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                       S Y S T E M . B I G N U M S                        --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2012-2024, Free Software Foundation, Inc.         --
  10 --                                                                          --
  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.                                     --
  17 --                                                                          --
  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.               --
  21 --                                                                          --
  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/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with System.Generic_Bignums;
  33 with System.Secondary_Stack;  use System.Secondary_Stack;
  34 with System.Shared_Bignums;   use System.Shared_Bignums;
  35 with System.Storage_Elements; use System.Storage_Elements;
  36
  37 package body System.Bignums is
  38
  39    function Allocate_Bignum (D : Digit_Vector; Neg : Boolean) return Bignum;
  40    --  Allocate Bignum value with the given contents
  41
  42    procedure Free_Bignum (X : in out Bignum) is null;
  43    --  No op when using the secondary stack
  44
  45    function To_Bignum (X : aliased in out Bignum) return Bignum is (X);
  46
  47    ---------------------
  48    -- Allocate_Bignum --
  49    ---------------------
  50
  51    function Allocate_Bignum (D : Digit_Vector; Neg : Boolean) return Bignum is
  52       Addr : aliased Address;
  53    begin
  54       --  Note: The approach used here is designed to avoid strict aliasing
  55       --  warnings that appeared previously using unchecked conversion.
  56
  57       SS_Allocate (Addr, Storage_Offset (4 + 4 * D'Length));
  58
  59       declare
  60          B : Bignum;
  61          for B'Address use Addr'Address;
  62          pragma Import (Ada, B);
  63
  64          BD : Bignum_Data (D'Length);
  65          for BD'Address use Addr;
  66          pragma Import (Ada, BD);
  67
  68          --  Expose a writable view of discriminant BD.Len so that we can
  69          --  initialize it. We need to use the exact layout of the record
  70          --  to ensure that the Length field has 24 bits as expected.
  71
  72          type Bignum_Data_Header is record
  73             Len : Length;
  74             Neg : Boolean;
  75          end record;
  76
  77          for Bignum_Data_Header use record
  78             Len at 0 range 0 .. 23;
  79             Neg at 3 range 0 .. 7;
  80          end record;
  81
  82          BDH : Bignum_Data_Header;
  83          for BDH'Address use BD'Address;
  84          pragma Import (Ada, BDH);
  85
  86          pragma Assert (BDH.Len'Size = BD.Len'Size);
  87
  88       begin
  89          BDH.Len := D'Length;
  90          BDH.Neg := Neg;
  91          B.D := D;
  92          return B;
  93       end;
  94    end Allocate_Bignum;
  95
  96    package Sec_Stack_Bignums is new System.Generic_Bignums
  97      (Bignum, Allocate_Bignum, Free_Bignum, To_Bignum);
  98
  99    function Big_Add (X, Y : Bignum) return Bignum
 100      renames Sec_Stack_Bignums.Big_Add;
 101
 102    function Big_Sub (X, Y : Bignum) return Bignum
 103      renames Sec_Stack_Bignums.Big_Sub;
 104
 105    function Big_Mul (X, Y : Bignum) return Bignum
 106      renames Sec_Stack_Bignums.Big_Mul;
 107
 108    function Big_Div (X, Y : Bignum) return Bignum
 109      renames Sec_Stack_Bignums.Big_Div;
 110
 111    function Big_Exp (X, Y : Bignum) return Bignum
 112      renames Sec_Stack_Bignums.Big_Exp;
 113
 114    function Big_Mod (X, Y : Bignum) return Bignum
 115      renames Sec_Stack_Bignums.Big_Mod;
 116
 117    function Big_Rem (X, Y : Bignum) return Bignum
 118      renames Sec_Stack_Bignums.Big_Rem;
 119
 120    function Big_Neg (X : Bignum) return Bignum
 121      renames Sec_Stack_Bignums.Big_Neg;
 122
 123    function Big_Abs (X : Bignum) return Bignum
 124      renames Sec_Stack_Bignums.Big_Abs;
 125
 126    function Big_EQ  (X, Y : Bignum) return Boolean
 127      renames Sec_Stack_Bignums.Big_EQ;
 128    function Big_NE  (X, Y : Bignum) return Boolean
 129      renames Sec_Stack_Bignums.Big_NE;
 130    function Big_GE  (X, Y : Bignum) return Boolean
 131      renames Sec_Stack_Bignums.Big_GE;
 132    function Big_LE  (X, Y : Bignum) return Boolean
 133      renames Sec_Stack_Bignums.Big_LE;
 134    function Big_GT  (X, Y : Bignum) return Boolean
 135      renames Sec_Stack_Bignums.Big_GT;
 136    function Big_LT  (X, Y : Bignum) return Boolean
 137      renames Sec_Stack_Bignums.Big_LT;
 138
 139    function Bignum_In_LLI_Range (X : Bignum) return Boolean
 140      renames Sec_Stack_Bignums.Bignum_In_LLI_Range;
 141
 142    function To_Bignum (X : Long_Long_Integer) return Bignum
 143      renames Sec_Stack_Bignums.To_Bignum;
 144
 145    function From_Bignum (X : Bignum) return Long_Long_Integer
 146      renames Sec_Stack_Bignums.From_Bignum;
 147
 148 end System.Bignums;