Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/urealp.ads @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ------------------------------------------------------------------------------ | |
2 -- -- | |
3 -- GNAT COMPILER COMPONENTS -- | |
4 -- -- | |
5 -- U R E A L P -- | |
6 -- -- | |
7 -- S p e c -- | |
8 -- -- | |
9 -- Copyright (C) 1992-2013, 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 -- Support for universal real arithmetic | |
33 | |
34 with Types; use Types; | |
35 with Uintp; use Uintp; | |
36 | |
37 package Urealp is | |
38 | |
39 --------------------------------------- | |
40 -- Representation of Universal Reals -- | |
41 --------------------------------------- | |
42 | |
43 -- A universal real value is represented by a single value (which is | |
44 -- an index into an internal table). These values are not hashed, so | |
45 -- the equality operator should not be used on Ureal values (instead | |
46 -- use the UR_Eq function). | |
47 | |
48 -- A Ureal value represents an arbitrary precision universal real value, | |
49 -- stored internally using four components: | |
50 | |
51 -- the numerator (Uint, always non-negative) | |
52 -- the denominator (Uint, always non-zero, always positive if base = 0) | |
53 -- a real base (Nat, either zero, or in the range 2 .. 16) | |
54 -- a sign flag (Boolean), set if negative | |
55 | |
56 -- Negative numbers are represented by the sign flag being True. | |
57 | |
58 -- If the base is zero, then the absolute value of the Ureal is simply | |
59 -- numerator/denominator, where denominator is positive. If the base is | |
60 -- non-zero, then the absolute value is numerator / (base ** denominator). | |
61 -- In that case, since base is positive, (base ** denominator) is also | |
62 -- positive, even when denominator is negative or null. | |
63 | |
64 -- A normalized Ureal value has base = 0, and numerator/denominator | |
65 -- reduced to lowest terms, with zero itself being represented as 0/1. | |
66 -- This is a canonical format, so that for normalized Ureal values it | |
67 -- is the case that two equal values always have the same denominator | |
68 -- and numerator values. | |
69 | |
70 -- Note: a value of minus zero is legitimate, and the operations in | |
71 -- Urealp preserve the handling of signed zeroes in accordance with | |
72 -- the rules of IEEE P754 ("IEEE floating point"). | |
73 | |
74 ------------------------------ | |
75 -- Types for Urealp Package -- | |
76 ------------------------------ | |
77 | |
78 type Ureal is private; | |
79 -- Type used for representation of universal reals | |
80 | |
81 No_Ureal : constant Ureal; | |
82 -- Constant used to indicate missing or unset Ureal value | |
83 | |
84 --------------------- | |
85 -- Ureal Constants -- | |
86 --------------------- | |
87 | |
88 function Ureal_0 return Ureal; | |
89 -- Returns value 0.0 | |
90 | |
91 function Ureal_M_0 return Ureal; | |
92 -- Returns value -0.0 | |
93 | |
94 function Ureal_Tenth return Ureal; | |
95 -- Returns value 0.1 | |
96 | |
97 function Ureal_Half return Ureal; | |
98 -- Returns value 0.5 | |
99 | |
100 function Ureal_1 return Ureal; | |
101 -- Returns value 1.0 | |
102 | |
103 function Ureal_2 return Ureal; | |
104 -- Returns value 2.0 | |
105 | |
106 function Ureal_10 return Ureal; | |
107 -- Returns value 10.0 | |
108 | |
109 function Ureal_100 return Ureal; | |
110 -- Returns value 100.0 | |
111 | |
112 function Ureal_2_80 return Ureal; | |
113 -- Returns value 2.0 ** 80 | |
114 | |
115 function Ureal_2_M_80 return Ureal; | |
116 -- Returns value 2.0 ** (-80) | |
117 | |
118 function Ureal_2_128 return Ureal; | |
119 -- Returns value 2.0 ** 128 | |
120 | |
121 function Ureal_2_M_128 return Ureal; | |
122 -- Returns value 2.0 ** (-128) | |
123 | |
124 function Ureal_10_36 return Ureal; | |
125 -- Returns value 10.0 ** 36 | |
126 | |
127 function Ureal_M_10_36 return Ureal; | |
128 -- Returns value -10.0 ** 36 | |
129 | |
130 ----------------- | |
131 -- Subprograms -- | |
132 ----------------- | |
133 | |
134 procedure Initialize; | |
135 -- Initialize Ureal tables. Note that Initialize must not be called if | |
136 -- Tree_Read is used. Note also that there is no Lock routine in this | |
137 -- unit. These tables are among the few tables that can be expanded | |
138 -- during Gigi processing. | |
139 | |
140 procedure Tree_Read; | |
141 -- Initializes internal tables from current tree file using the relevant | |
142 -- Table.Tree_Read routines. Note that Initialize should not be called if | |
143 -- Tree_Read is used. Tree_Read includes all necessary initialization. | |
144 | |
145 procedure Tree_Write; | |
146 -- Writes out internal tables to current tree file using the relevant | |
147 -- Table.Tree_Write routines. | |
148 | |
149 function Rbase (Real : Ureal) return Nat; | |
150 -- Return the base of the universal real | |
151 | |
152 function Denominator (Real : Ureal) return Uint; | |
153 -- Return the denominator of the universal real | |
154 | |
155 function Numerator (Real : Ureal) return Uint; | |
156 -- Return the numerator of the universal real | |
157 | |
158 function Norm_Den (Real : Ureal) return Uint; | |
159 -- Return the denominator of the universal real after a normalization | |
160 | |
161 function Norm_Num (Real : Ureal) return Uint; | |
162 -- Return the numerator of the universal real after a normalization | |
163 | |
164 function UR_From_Uint (UI : Uint) return Ureal; | |
165 -- Returns real corresponding to universal integer value | |
166 | |
167 function UR_To_Uint (Real : Ureal) return Uint; | |
168 -- Return integer value obtained by accurate rounding of real value. | |
169 -- The rounding of values half way between two integers is away from | |
170 -- zero, as required by normal Ada 95 rounding semantics. | |
171 | |
172 function UR_Trunc (Real : Ureal) return Uint; | |
173 -- Return integer value obtained by a truncation of real towards zero | |
174 | |
175 function UR_Ceiling (Real : Ureal) return Uint; | |
176 -- Return value of smallest integer not less than the given value | |
177 | |
178 function UR_Floor (Real : Ureal) return Uint; | |
179 -- Return value of smallest integer not greater than the given value | |
180 | |
181 -- Conversion table for above four functions | |
182 | |
183 -- Input To_Uint Trunc Ceiling Floor | |
184 -- 1.0 1 1 1 1 | |
185 -- 1.2 1 1 2 1 | |
186 -- 1.5 2 1 2 1 | |
187 -- 1.7 2 1 2 1 | |
188 -- 2.0 2 2 2 2 | |
189 -- -1.0 -1 -1 -1 -1 | |
190 -- -1.2 -1 -1 -1 -2 | |
191 -- -1.5 -2 -1 -1 -2 | |
192 -- -1.7 -2 -1 -1 -2 | |
193 -- -2.0 -2 -2 -2 -2 | |
194 | |
195 function UR_From_Components | |
196 (Num : Uint; | |
197 Den : Uint; | |
198 Rbase : Nat := 0; | |
199 Negative : Boolean := False) | |
200 return Ureal; | |
201 -- Builds real value from given numerator, denominator and base. The | |
202 -- value is negative if Negative is set to true, and otherwise is | |
203 -- non-negative. | |
204 | |
205 function UR_Add (Left : Ureal; Right : Ureal) return Ureal; | |
206 function UR_Add (Left : Ureal; Right : Uint) return Ureal; | |
207 function UR_Add (Left : Uint; Right : Ureal) return Ureal; | |
208 -- Returns real sum of operands | |
209 | |
210 function UR_Div (Left : Ureal; Right : Ureal) return Ureal; | |
211 function UR_Div (Left : Uint; Right : Ureal) return Ureal; | |
212 function UR_Div (Left : Ureal; Right : Uint) return Ureal; | |
213 -- Returns real quotient of operands. Fatal error if Right is zero | |
214 | |
215 function UR_Mul (Left : Ureal; Right : Ureal) return Ureal; | |
216 function UR_Mul (Left : Uint; Right : Ureal) return Ureal; | |
217 function UR_Mul (Left : Ureal; Right : Uint) return Ureal; | |
218 -- Returns real product of operands | |
219 | |
220 function UR_Sub (Left : Ureal; Right : Ureal) return Ureal; | |
221 function UR_Sub (Left : Uint; Right : Ureal) return Ureal; | |
222 function UR_Sub (Left : Ureal; Right : Uint) return Ureal; | |
223 -- Returns real difference of operands | |
224 | |
225 function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal; | |
226 -- Returns result of raising Ureal to Uint power. | |
227 -- Fatal error if Left is 0 and Right is negative. | |
228 | |
229 function UR_Abs (Real : Ureal) return Ureal; | |
230 -- Returns abs function of real | |
231 | |
232 function UR_Negate (Real : Ureal) return Ureal; | |
233 -- Returns negative of real | |
234 | |
235 function UR_Eq (Left, Right : Ureal) return Boolean; | |
236 -- Compares reals for equality | |
237 | |
238 function UR_Max (Left, Right : Ureal) return Ureal; | |
239 -- Returns the maximum of two reals | |
240 | |
241 function UR_Min (Left, Right : Ureal) return Ureal; | |
242 -- Returns the minimum of two reals | |
243 | |
244 function UR_Ne (Left, Right : Ureal) return Boolean; | |
245 -- Compares reals for inequality | |
246 | |
247 function UR_Lt (Left, Right : Ureal) return Boolean; | |
248 -- Compares reals for less than | |
249 | |
250 function UR_Le (Left, Right : Ureal) return Boolean; | |
251 -- Compares reals for less than or equal | |
252 | |
253 function UR_Gt (Left, Right : Ureal) return Boolean; | |
254 -- Compares reals for greater than | |
255 | |
256 function UR_Ge (Left, Right : Ureal) return Boolean; | |
257 -- Compares reals for greater than or equal | |
258 | |
259 function UR_Is_Zero (Real : Ureal) return Boolean; | |
260 -- Tests if real value is zero | |
261 | |
262 function UR_Is_Negative (Real : Ureal) return Boolean; | |
263 -- Tests if real value is negative, note that negative zero gives true | |
264 | |
265 function UR_Is_Positive (Real : Ureal) return Boolean; | |
266 -- Test if real value is greater than zero | |
267 | |
268 procedure UR_Write (Real : Ureal; Brackets : Boolean := False); | |
269 -- Writes value of Real to standard output. Used for debugging and | |
270 -- tree/source output, and also for -gnatR representation output. If the | |
271 -- result is easily representable as a standard Ada literal, it will be | |
272 -- given that way, but as a result of evaluation of static expressions, it | |
273 -- is possible to generate constants (e.g. 1/13) which have no such | |
274 -- representation. In such cases (and in cases where it is too much work to | |
275 -- figure out the Ada literal), the string that is output is of the form | |
276 -- of some expression such as integer/integer, or integer*integer**integer. | |
277 -- In the case where an expression is output, if Brackets is set to True, | |
278 -- the expression is surrounded by square brackets. | |
279 | |
280 procedure pr (Real : Ureal); | |
281 pragma Export (Ada, pr); | |
282 -- Writes value of Real to standard output with a terminating line return, | |
283 -- using UR_Write as described above. This is for use from the debugger. | |
284 | |
285 ------------------------ | |
286 -- Operator Renamings -- | |
287 ------------------------ | |
288 | |
289 function "+" (Left : Ureal; Right : Ureal) return Ureal renames UR_Add; | |
290 function "+" (Left : Uint; Right : Ureal) return Ureal renames UR_Add; | |
291 function "+" (Left : Ureal; Right : Uint) return Ureal renames UR_Add; | |
292 | |
293 function "/" (Left : Ureal; Right : Ureal) return Ureal renames UR_Div; | |
294 function "/" (Left : Uint; Right : Ureal) return Ureal renames UR_Div; | |
295 function "/" (Left : Ureal; Right : Uint) return Ureal renames UR_Div; | |
296 | |
297 function "*" (Left : Ureal; Right : Ureal) return Ureal renames UR_Mul; | |
298 function "*" (Left : Uint; Right : Ureal) return Ureal renames UR_Mul; | |
299 function "*" (Left : Ureal; Right : Uint) return Ureal renames UR_Mul; | |
300 | |
301 function "-" (Left : Ureal; Right : Ureal) return Ureal renames UR_Sub; | |
302 function "-" (Left : Uint; Right : Ureal) return Ureal renames UR_Sub; | |
303 function "-" (Left : Ureal; Right : Uint) return Ureal renames UR_Sub; | |
304 | |
305 function "**" (Real : Ureal; N : Uint) return Ureal | |
306 renames UR_Exponentiate; | |
307 | |
308 function "abs" (Real : Ureal) return Ureal renames UR_Abs; | |
309 | |
310 function "-" (Real : Ureal) return Ureal renames UR_Negate; | |
311 | |
312 function "=" (Left, Right : Ureal) return Boolean renames UR_Eq; | |
313 | |
314 function "<" (Left, Right : Ureal) return Boolean renames UR_Lt; | |
315 | |
316 function "<=" (Left, Right : Ureal) return Boolean renames UR_Le; | |
317 | |
318 function ">=" (Left, Right : Ureal) return Boolean renames UR_Ge; | |
319 | |
320 function ">" (Left, Right : Ureal) return Boolean renames UR_Gt; | |
321 | |
322 ----------------------------- | |
323 -- Mark/Release Processing -- | |
324 ----------------------------- | |
325 | |
326 -- The space used by Ureal data is not automatically reclaimed. However, | |
327 -- a mark-release regime is implemented which allows storage to be | |
328 -- released back to a previously noted mark. This is used for example | |
329 -- when doing comparisons, where only intermediate results get stored | |
330 -- that do not need to be saved for future use. | |
331 | |
332 type Save_Mark is private; | |
333 | |
334 function Mark return Save_Mark; | |
335 -- Note mark point for future release | |
336 | |
337 procedure Release (M : Save_Mark); | |
338 -- Release storage allocated since mark was noted | |
339 | |
340 ------------------------------------ | |
341 -- Representation of Ureal Values -- | |
342 ------------------------------------ | |
343 | |
344 private | |
345 | |
346 type Ureal is new Int range Ureal_Low_Bound .. Ureal_High_Bound; | |
347 for Ureal'Size use 32; | |
348 | |
349 No_Ureal : constant Ureal := Ureal'First; | |
350 | |
351 type Save_Mark is new Int; | |
352 | |
353 pragma Inline (Denominator); | |
354 pragma Inline (Mark); | |
355 pragma Inline (Norm_Num); | |
356 pragma Inline (Norm_Den); | |
357 pragma Inline (Numerator); | |
358 pragma Inline (Rbase); | |
359 pragma Inline (Release); | |
360 pragma Inline (Ureal_0); | |
361 pragma Inline (Ureal_M_0); | |
362 pragma Inline (Ureal_Tenth); | |
363 pragma Inline (Ureal_Half); | |
364 pragma Inline (Ureal_1); | |
365 pragma Inline (Ureal_2); | |
366 pragma Inline (Ureal_10); | |
367 pragma Inline (UR_From_Components); | |
368 | |
369 end Urealp; |