1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . D O U B L E _ R E A L --
9 -- Copyright (C) 2021-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 -- This package contains routines for supporting floating-point computations
33 -- in double precision, i.e. using a second number to estimate the error due
34 -- to rounding and more generally performing computations with twice as many
35 -- bits of mantissa. It is based on the Double-Double library available at
36 -- https://www.davidhbailey.com/dhbsoftware written by David H.Bailey et al.
40 type Num
is digits <>;
42 package System
.Double_Real
is
45 type Double_T
is record
49 function To_Double
(N
: Num
) return Double_T
is ((Hi
=> N
, Lo
=> 0.0));
50 -- Convert a single to a double real
52 function To_Single
(D
: Double_T
) return Num
is (D
.Hi
);
53 -- Convert a double to a single real
55 function Quick_Two_Sum
(A
, B
: Num
) return Double_T
56 with Pre
=> A
= 0.0 or else abs (A
) >= abs (B
);
57 -- Compute A + B and its rounding error exactly, but assume |A| >= |B|
59 function Two_Sum
(A
, B
: Num
) return Double_T
;
60 -- Compute A + B and its rounding error exactly
62 function Two_Diff
(A
, B
: Num
) return Double_T
;
63 -- Compute A - B and its rounding error exactly
65 function Two_Prod
(A
, B
: Num
) return Double_T
;
66 -- Compute A * B and its rounding error exactly
68 function Two_Sqr
(A
: Num
) return Double_T
;
69 -- Compute A * A and its rounding error exactly
71 function "+" (A
: Double_T
; B
: Num
) return Double_T
;
72 function "-" (A
: Double_T
; B
: Num
) return Double_T
;
73 function "*" (A
: Double_T
; B
: Num
) return Double_T
;
74 function "/" (A
: Double_T
; B
: Num
) return Double_T
76 -- Mixed precision arithmetic operations
78 function "+" (A
, B
: Double_T
) return Double_T
;
79 function "-" (A
, B
: Double_T
) return Double_T
;
80 function "*" (A
, B
: Double_T
) return Double_T
;
81 function "/" (A
, B
: Double_T
) return Double_T
82 with Pre
=> B
.Hi
/= 0.0;
83 -- Double precision arithmetic operations
85 function Sqr
(A
: Double_T
) return Double_T
;
86 -- Faster version of A * A
88 function "=" (A
: Double_T
; B
: Num
) return Boolean is
89 (A
.Hi
= B
and then A
.Lo
= 0.0);
90 function "<" (A
: Double_T
; B
: Num
) return Boolean is
91 (A
.Hi
< B
or else (A
.Hi
= B
and then A
.Lo
< 0.0));
92 function "<=" (A
: Double_T
; B
: Num
) return Boolean is
93 (A
.Hi
< B
or else (A
.Hi
= B
and then A
.Lo
<= 0.0));
94 function ">" (A
: Double_T
; B
: Num
) return Boolean is
95 (A
.Hi
> B
or else (A
.Hi
= B
and then A
.Lo
> 0.0));
96 function ">=" (A
: Double_T
; B
: Num
) return Boolean is
97 (A
.Hi
> B
or else (A
.Hi
= B
and then A
.Lo
>= 0.0));
98 -- Mixed precision comparisons
100 function "=" (A
, B
: Double_T
) return Boolean is
101 (A
.Hi
= B
.Hi
and then A
.Lo
= B
.Lo
);
102 function "<" (A
, B
: Double_T
) return Boolean is
103 (A
.Hi
< B
.Hi
or else (A
.Hi
= B
.Hi
and then A
.Lo
< B
.Lo
));
104 function "<=" (A
, B
: Double_T
) return Boolean is
105 (A
.Hi
< B
.Hi
or else (A
.Hi
= B
.Hi
and then A
.Lo
<= B
.Lo
));
106 function ">" (A
, B
: Double_T
) return Boolean is
107 (A
.Hi
> B
.Hi
or else (A
.Hi
= B
.Hi
and then A
.Lo
> B
.Lo
));
108 function ">=" (A
, B
: Double_T
) return Boolean is
109 (A
.Hi
> B
.Hi
or else (A
.Hi
= B
.Hi
and then A
.Lo
>= B
.Lo
));
110 -- Double precision comparisons
114 function From_Unsigned
(U
: Uns
) return Double_T
;
115 -- Convert Uns to Double_T
119 function To_Unsigned
(D
: Double_T
) return Uns
120 with Pre
=> D
>= 0.0;
121 -- Convert Double_T to Uns with truncation
123 end System
.Double_Real
;