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