111
|
1 ------------------------------------------------------------------------------
|
|
2 -- --
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
4 -- --
|
|
5 -- S Y S T E M . F A T _ G E N --
|
|
6 -- --
|
|
7 -- S p e c --
|
|
8 -- --
|
|
9 -- Copyright (C) 1992-2017, 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 -- 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.
|
|
37
|
|
38 generic
|
|
39 type T is digits <>;
|
|
40
|
|
41 package System.Fat_Gen is
|
|
42 pragma Pure;
|
|
43
|
|
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.
|
|
53
|
|
54 function Adjacent (X, Towards : T) return T;
|
|
55
|
|
56 function Ceiling (X : T) return T;
|
|
57
|
|
58 function Compose (Fraction : T; Exponent : UI) return T;
|
|
59
|
|
60 function Copy_Sign (Value, Sign : T) return T;
|
|
61
|
|
62 function Exponent (X : T) return UI;
|
|
63
|
|
64 function Floor (X : T) return T;
|
|
65
|
|
66 function Fraction (X : T) return T;
|
|
67
|
|
68 function Leading_Part (X : T; Radix_Digits : UI) return T;
|
|
69
|
|
70 function Machine (X : T) return T;
|
|
71
|
|
72 function Machine_Rounding (X : T) return T;
|
|
73
|
|
74 function Model (X : T) return T;
|
|
75
|
|
76 function Pred (X : T) return T;
|
|
77
|
|
78 function Remainder (X, Y : T) return T;
|
|
79
|
|
80 function Rounding (X : T) return T;
|
|
81
|
|
82 function Scaling (X : T; Adjustment : UI) return T;
|
|
83
|
|
84 function Succ (X : T) return T;
|
|
85
|
|
86 function Truncation (X : T) return T;
|
|
87
|
|
88 function Unbiased_Rounding (X : T) return T;
|
|
89
|
|
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.
|
|
97
|
|
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).
|
|
108
|
|
109 private
|
|
110 pragma Inline (Machine);
|
|
111 pragma Inline (Model);
|
|
112
|
|
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).
|
|
117
|
|
118 end System.Fat_Gen;
|