File : a-ngelfu-cert.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUNTIME COMPONENTS --
4 -- --
5 -- ADA.NUMERICS.GENERIC_ELEMENTARY_FUNCTIONS --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2012, 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 -- --
19 -- --
20 -- --
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 is the Cert specific version of a-ngelfu.adb
33
34 -- This body does not implement Ada.Numerics.Generic_Elementary_Functions as
35 -- defined by the standard. See the package specification for more details.
36
37 with Ada.Numerics.Elementary_Functions;
38 with Ada.Numerics.Long_Elementary_Functions;
39 with Ada.Numerics.Long_Long_Elementary_Functions;
40
41 use Ada.Numerics.Elementary_Functions;
42 use Ada.Numerics.Long_Elementary_Functions;
43 use Ada.Numerics.Long_Long_Elementary_Functions;
44
45 package body Ada.Numerics.Generic_Elementary_Functions is
46
47 subtype T is Float_Type'Base;
48
49 subtype F is Float;
50 subtype LF is Long_Float;
51 subtype LLF is Long_Long_Float;
52
53 Is_Float : constant Boolean :=
54 T'Machine_Mantissa = Float'Machine_Mantissa
55 and then Float (T'First) = Float'First
56 and then Float (T'Last) = Float'Last;
57
58 Is_Long_Float : constant Boolean :=
59 T'Machine_Mantissa = Long_Float'Machine_Mantissa
60 and then Long_Float (T'First) = Long_Float'First
61 and then Long_Float (T'Last) = Long_Float'Last;
62
63 Is_Long_Long_Float : constant Boolean :=
64 not (T'Machine_Mantissa = Long_Float'Machine_Mantissa)
65 and then T'Machine_Mantissa = Long_Long_Float'Machine_Mantissa
66 and then Long_Long_Float (T'First) = Long_Long_Float'First
67 and then Long_Long_Float (T'Last) = Long_Long_Float'Last;
68
69 ----------
70 -- "**" --
71 ----------
72
73 function "**" (Left, Right : Float_Type'Base) return Float_Type'Base is
74 begin
75 if Is_Float then
76 return T (F (Left) ** F (Right));
77
78 elsif Is_Long_Float then
79 return T (LF (Left) ** LF (Right));
80
81 elsif Is_Long_Long_Float then
82 return T (LLF (Left) ** LLF (Right));
83 end if;
84
85 raise Program_Error;
86 end "**";
87
88 ------------
89 -- Arccos --
90 ------------
91
92 -- Natural cycle
93
94 function Arccos (X : Float_Type'Base) return Float_Type'Base is
95
96 begin
97 if Is_Float then
98 return T (Arccos (F (X)));
99
100 elsif Is_Long_Float then
101 return T (Arccos (LF (X)));
102
103 elsif Is_Long_Long_Float then
104 return T (Arccos (LLF (X)));
105 end if;
106
107 raise Program_Error;
108 end Arccos;
109
110 -- Arbitrary cycle
111
112 function Arccos (X, Cycle : Float_Type'Base) return Float_Type'Base is
113 begin
114 if Is_Float then
115 return T (Arccos (F (X), F (Cycle)));
116
117 elsif Is_Long_Float then
118 return T (Arccos (LF (X), LF (Cycle)));
119
120 elsif Is_Long_Long_Float then
121 return T (Arccos (LLF (X), LLF (Cycle)));
122 end if;
123
124 raise Program_Error;
125 end Arccos;
126
127 ------------
128 -- Arccot --
129 ------------
130
131 -- Natural cycle
132
133 function Arccot
134 (X : Float_Type'Base;
135 Y : Float_Type'Base := 1.0)
136 return Float_Type'Base
137 is
138 begin
139 if Is_Float then
140 return T (Arccot (F (X), F (Y)));
141
142 elsif Is_Long_Float then
143 return T (Arccot (LF (X), LF (Y)));
144
145 elsif Is_Long_Long_Float then
146 return T (Arccot (LLF (X), LLF (Y)));
147 end if;
148
149 raise Program_Error;
150 end Arccot;
151
152 -- Arbitrary cycle
153
154 function Arccot
155 (X : Float_Type'Base;
156 Y : Float_Type'Base := 1.0;
157 Cycle : Float_Type'Base)
158 return Float_Type'Base
159 is
160 begin
161 if Is_Float then
162 return T (Arccot (F (X), F (Y), F (Cycle)));
163
164 elsif Is_Long_Float then
165 return T (Arccot (LF (X), LF (Y), LF (Cycle)));
166
167 elsif Is_Long_Long_Float then
168 return T (Arccot (LLF (X), LLF (Y), LLF (Cycle)));
169 end if;
170
171 raise Program_Error;
172 end Arccot;
173
174 ------------
175 -- Arcsin --
176 ------------
177
178 -- Natural cycle
179
180 function Arcsin (X : Float_Type'Base) return Float_Type'Base is
181 begin
182 if Is_Float then
183 return T (Arcsin (F (X)));
184
185 elsif Is_Long_Float then
186 return T (Arcsin (LF (X)));
187
188 elsif Is_Long_Long_Float then
189 return T (Arcsin (LLF (X)));
190 end if;
191
192 raise Program_Error;
193 end Arcsin;
194
195 -- Arbitrary cycle
196
197 function Arcsin (X, Cycle : Float_Type'Base) return Float_Type'Base is
198 begin
199 if Is_Float then
200 return T (Arcsin (F (X), F (Cycle)));
201
202 elsif Is_Long_Float then
203 return T (Arcsin (LF (X), LF (Cycle)));
204
205 elsif Is_Long_Long_Float then
206 return T (Arcsin (LLF (X), LLF (Cycle)));
207 end if;
208
209 raise Program_Error;
210 end Arcsin;
211
212 ------------
213 -- Arctan --
214 ------------
215
216 -- Natural cycle
217
218 function Arctan
219 (Y : Float_Type'Base;
220 X : Float_Type'Base := 1.0)
221 return Float_Type'Base
222 is
223 begin
224 if Is_Float then
225 return T (Arctan (F (Y), F (X)));
226
227 elsif Is_Long_Float then
228 return T (Arctan (LF (Y), LF (X)));
229
230 elsif Is_Long_Long_Float then
231 return T (Arctan (LLF (Y), LLF (X)));
232 end if;
233
234 raise Program_Error;
235 end Arctan;
236
237 -- Arbitrary cycle
238
239 function Arctan
240 (Y : Float_Type'Base;
241 X : Float_Type'Base := 1.0;
242 Cycle : Float_Type'Base)
243 return Float_Type'Base
244 is
245 begin
246 if Is_Float then
247 return T (Arctan (F (Y), F (X), F (Cycle)));
248
249 elsif Is_Long_Float then
250 return T (Arctan (LF (Y), LF (X), LF (Cycle)));
251
252 elsif Is_Long_Long_Float then
253 return T (Arctan (LLF (Y), LLF (X), LLF (Cycle)));
254 end if;
255
256 raise Program_Error;
257 end Arctan;
258
259 ---------
260 -- Cos --
261 ---------
262
263 -- Natural cycle
264
265 function Cos (X : Float_Type'Base) return Float_Type'Base is
266 begin
267 if Is_Float then
268 return T (Cos (F (X)));
269
270 elsif Is_Long_Float then
271 return T (Cos (LF (X)));
272
273 elsif Is_Long_Long_Float then
274 return T (Cos (LLF (X)));
275 end if;
276
277 raise Program_Error;
278 end Cos;
279
280 -- Arbitrary cycle
281
282 function Cos (X, Cycle : Float_Type'Base) return Float_Type'Base is
283 begin
284 if Is_Float then
285 return T (Cos (F (X), F (Cycle)));
286
287 elsif Is_Long_Float then
288 return T (Cos (LF (X), LF (Cycle)));
289
290 elsif Is_Long_Long_Float then
291 return T (Cos (LLF (X), LLF (Cycle)));
292 end if;
293
294 raise Program_Error;
295 end Cos;
296
297 ---------
298 -- Cot --
299 ---------
300
301 -- Natural cycle
302
303 function Cot (X : Float_Type'Base) return Float_Type'Base is
304 begin
305 if Is_Float then
306 return T (Cot (F (X)));
307
308 elsif Is_Long_Float then
309 return T (Cot (LF (X)));
310
311 elsif Is_Long_Long_Float then
312 return T (Cot (LLF (X)));
313 end if;
314
315 raise Program_Error;
316 end Cot;
317
318 -- Arbitrary cycle
319
320 function Cot (X, Cycle : Float_Type'Base) return Float_Type'Base is
321 begin
322 if Is_Float then
323 return T (Cot (F (X), F (Cycle)));
324
325 elsif Is_Long_Float then
326 return T (Cot (LF (X), LF (Cycle)));
327
328 elsif Is_Long_Long_Float then
329 return T (Cot (LLF (X), LLF (Cycle)));
330 end if;
331
332 raise Program_Error;
333 end Cot;
334
335 ---------
336 -- Exp --
337 ---------
338
339 function Exp (X : Float_Type'Base) return Float_Type'Base is
340 begin
341 if Is_Float then
342 return T (Exp (F (X)));
343
344 elsif Is_Long_Float then
345 return T (Exp (LF (X)));
346
347 elsif Is_Long_Long_Float then
348 return T (Exp (LLF (X)));
349 end if;
350
351 raise Program_Error;
352 end Exp;
353
354 ---------
355 -- Log --
356 ---------
357
358 -- Natural base
359
360 function Log (X : Float_Type'Base) return Float_Type'Base is
361 begin
362 if Is_Float then
363 return T (Log (F (X)));
364
365 elsif Is_Long_Float then
366 return T (Log (LF (X)));
367
368 elsif Is_Long_Long_Float then
369 return T (Log (LLF (X)));
370 end if;
371
372 raise Program_Error;
373 end Log;
374
375 -- Arbitrary base
376
377 function Log (X, Base : Float_Type'Base) return Float_Type'Base is
378 begin
379 if Is_Float then
380 return T (Log (F (X), F (Base)));
381
382 elsif Is_Long_Float then
383 return T (Log (LF (X), LF (Base)));
384
385 elsif Is_Long_Long_Float then
386 return T (Log (LLF (X), LLF (Base)));
387 end if;
388
389 raise Program_Error;
390 end Log;
391
392 ---------
393 -- Sin --
394 ---------
395
396 -- Natural cycle
397
398 function Sin (X : Float_Type'Base) return Float_Type'Base is
399 begin
400 if Is_Float then
401 return T (Sin (F (X)));
402
403 elsif Is_Long_Float then
404 return T (Sin (LF (X)));
405
406 elsif Is_Long_Long_Float then
407 return T (Sin (LLF (X)));
408 end if;
409
410 raise Program_Error;
411 end Sin;
412
413 -- Arbitrary cycle
414
415 function Sin (X, Cycle : Float_Type'Base) return Float_Type'Base is
416 begin
417 if Is_Float then
418 return T (Sin (F (X), F (Cycle)));
419
420 elsif Is_Long_Float then
421 return T (Sin (LF (X), LF (Cycle)));
422
423 elsif Is_Long_Long_Float then
424 return T (Sin (LLF (X), LLF (Cycle)));
425 end if;
426
427 raise Program_Error;
428 end Sin;
429
430 ----------
431 -- Sqrt --
432 ----------
433
434 function Sqrt (X : Float_Type'Base) return Float_Type'Base is
435 begin
436 if Is_Float then
437 return T (Sqrt (F (X)));
438
439 elsif Is_Long_Float then
440 return T (Sqrt (LF (X)));
441
442 elsif Is_Long_Long_Float then
443 return T (Sqrt (LLF (X)));
444 end if;
445
446 raise Program_Error;
447 end Sqrt;
448
449 ---------
450 -- Tan --
451 ---------
452
453 -- Natural cycle
454
455 function Tan (X : Float_Type'Base) return Float_Type'Base is
456 begin
457 if Is_Float then
458 return T (Tan (F (X)));
459
460 elsif Is_Long_Float then
461 return T (Tan (LF (X)));
462
463 elsif Is_Long_Long_Float then
464 return T (Tan (LLF (X)));
465 end if;
466
467 raise Program_Error;
468 end Tan;
469
470 -- Arbitrary cycle
471
472 function Tan (X, Cycle : Float_Type'Base) return Float_Type'Base is
473 begin
474 if Is_Float then
475 return T (Tan (F (X), F (Cycle)));
476
477 elsif Is_Long_Float then
478 return T (Tan (LF (X), LF (Cycle)));
479
480 elsif Is_Long_Long_Float then
481 return T (Tan (LLF (X), LLF (Cycle)));
482 end if;
483
484 raise Program_Error;
485 end Tan;
486
487 end Ada.Numerics.Generic_Elementary_Functions;