1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . F A T _ G E N --
9 -- Copyright (C) 1992-2014, 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 generic package provides a target independent implementation of the
33 -- floating-point attributes that denote functions. The implementations here
34 -- are portable, but very slow. The runtime contains a set of instantiations
35 -- of this package for all predefined floating-point types, and these should
36 -- be replaced by efficient assembly language code where possible.
41 package System
.Fat_Gen
is
44 subtype UI
is Integer;
45 -- The runtime representation of universal integer for the purposes of
46 -- this package is integer. The expander generates conversions for the
47 -- actual type used. For functions returning universal integer, there
48 -- is no problem, since the result always is in range of integer. For
49 -- input arguments, the expander has to do some special casing to deal
50 -- with the (very annoying) cases of out of range values. If we used
51 -- Long_Long_Integer to represent universal, then there would be no
52 -- problem, but the resulting inefficiency would be annoying.
54 function Adjacent
(X
, Towards
: T
) return T
;
56 function Ceiling
(X
: T
) return T
;
58 function Compose
(Fraction
: T
; Exponent
: UI
) return T
;
60 function Copy_Sign
(Value
, Sign
: T
) return T
;
62 function Exponent
(X
: T
) return UI
;
64 function Floor
(X
: T
) return T
;
66 function Fraction
(X
: T
) return T
;
68 function Leading_Part
(X
: T
; Radix_Digits
: UI
) return T
;
70 function Machine
(X
: T
) return T
;
72 function Machine_Rounding
(X
: T
) return T
;
74 function Model
(X
: T
) return T
;
76 function Pred
(X
: T
) return T
;
78 function Remainder
(X
, Y
: T
) return T
;
80 function Rounding
(X
: T
) return T
;
82 function Scaling
(X
: T
; Adjustment
: UI
) return T
;
84 function Succ
(X
: T
) return T
;
86 function Truncation
(X
: T
) return T
;
88 function Unbiased_Rounding
(X
: T
) return T
;
90 function Valid
(X
: not null access T
) return Boolean;
91 -- This function checks if the object of type T referenced by X is valid,
92 -- and returns True/False accordingly. The parameter is passed by reference
93 -- (access) here, as the object of type T may be an abnormal value that
94 -- cannot be passed in a floating-point register, and the whole point of
95 -- 'Valid is to prevent exceptions. Note that the object of type T must
96 -- have the natural alignment for type T.
98 type S
is new String (1 .. T
'Size / Character'Size);
99 type P
is access all S
with Storage_Size
=> 0;
100 -- Buffer and access types used to initialize temporaries for validity
101 -- checks, if the value to be checked has reverse scalar storage order, or
102 -- is not known to be properly aligned (for example it appears in a packed
103 -- record). In this case, we cannot call Valid since Valid assumes proper
104 -- full alignment. Instead, we copy the value to a temporary location using
105 -- type S (we cannot simply do a copy of a T value, because the value might
106 -- be invalid, in which case it might not be possible to copy it through a
107 -- floating point register).
110 pragma Inline
(Machine
);
111 pragma Inline
(Model
);
113 -- Note: previously the validity checking subprograms (Unaligned_Valid and
114 -- Valid) were also inlined, but this was changed since there were some
115 -- problems with this inlining in optimized mode, and in any case it seems
116 -- better to avoid this inlining (space and robustness considerations).