1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . B I G N U M S --
9 -- Copyright (C) 2012-2023, 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 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
;
37 package body System
.Bignums
is
39 function Allocate_Bignum
(D
: Digit_Vector
; Neg
: Boolean) return Bignum
;
40 -- Allocate Bignum value with the given contents
42 procedure Free_Bignum
(X
: in out Bignum
) is null;
43 -- No op when using the secondary stack
45 function To_Bignum
(X
: aliased in out Bignum
) return Bignum
is (X
);
51 function Allocate_Bignum
(D
: Digit_Vector
; Neg
: Boolean) return Bignum
is
52 Addr
: aliased Address
;
54 -- Note: The approach used here is designed to avoid strict aliasing
55 -- warnings that appeared previously using unchecked conversion.
57 SS_Allocate
(Addr
, Storage_Offset
(4 + 4 * D
'Length));
61 for B
'Address use Addr
'Address;
62 pragma Import
(Ada
, B
);
64 BD
: Bignum_Data
(D
'Length);
65 for BD
'Address use Addr
;
66 pragma Import
(Ada
, BD
);
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.
72 type Bignum_Data_Header
is record
77 for Bignum_Data_Header
use record
78 Len
at 0 range 0 .. 23;
79 Neg
at 3 range 0 .. 7;
82 BDH
: Bignum_Data_Header
;
83 for BDH
'Address use BD
'Address;
84 pragma Import
(Ada
, BDH
);
86 pragma Assert
(BDH
.Len
'Size = BD
.Len
'Size);
96 package Sec_Stack_Bignums
is new System
.Generic_Bignums
97 (Bignum
, Allocate_Bignum
, Free_Bignum
, To_Bignum
);
99 function Big_Add
(X
, Y
: Bignum
) return Bignum
100 renames Sec_Stack_Bignums
.Big_Add
;
102 function Big_Sub
(X
, Y
: Bignum
) return Bignum
103 renames Sec_Stack_Bignums
.Big_Sub
;
105 function Big_Mul
(X
, Y
: Bignum
) return Bignum
106 renames Sec_Stack_Bignums
.Big_Mul
;
108 function Big_Div
(X
, Y
: Bignum
) return Bignum
109 renames Sec_Stack_Bignums
.Big_Div
;
111 function Big_Exp
(X
, Y
: Bignum
) return Bignum
112 renames Sec_Stack_Bignums
.Big_Exp
;
114 function Big_Mod
(X
, Y
: Bignum
) return Bignum
115 renames Sec_Stack_Bignums
.Big_Mod
;
117 function Big_Rem
(X
, Y
: Bignum
) return Bignum
118 renames Sec_Stack_Bignums
.Big_Rem
;
120 function Big_Neg
(X
: Bignum
) return Bignum
121 renames Sec_Stack_Bignums
.Big_Neg
;
123 function Big_Abs
(X
: Bignum
) return Bignum
124 renames Sec_Stack_Bignums
.Big_Abs
;
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
;
139 function Bignum_In_LLI_Range
(X
: Bignum
) return Boolean
140 renames Sec_Stack_Bignums
.Bignum_In_LLI_Range
;
142 function To_Bignum
(X
: Long_Long_Integer) return Bignum
143 renames Sec_Stack_Bignums
.To_Bignum
;
145 function From_Bignum
(X
: Bignum
) return Long_Long_Integer
146 renames Sec_Stack_Bignums
.From_Bignum
;