File : s-gcmain-ada.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUNTIME COMPONENTS --
4 -- --
5 -- S Y S T E M . G E N E R I C _ C _ M A T H _ I N T E R F A C E --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2015, 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 Ada Cert Math specific version of s-gcmain.adb.
33
34 -- The separate version is necessary, because this system does not provide
35 -- an implementation of tanh, among other hyperbolic functions. The run time
36 -- currently has no code to implement this function, so the only short term
37 -- option was to remove the hyperbolic functions.
38
39 with Ada.Numerics; use Ada.Numerics;
40
41 package body System.Generic_C_Math_Interface is
42
43 subtype T is Float_Type'Base;
44
45 -- The implementations of these functions start with a summary
46 -- of the Ada requirements for the following:
47 -- * Principal branch of multivalued functions
48 -- * Conditions for raising exceptions
49 -- * Prescribed function results
50 -- * Tightly approximated function results (strict mode only)
51
52 -- Implementation choices are explained after the summary for each
53 -- elementary function. Exceptions are raised either by checking the
54 -- arguments or the C function result. Prescribed results are satisfied by
55 -- referring to corresponding requirements in C, standard implementation
56 -- practice or by explicit special-casing in the code below.
57
58 -- If one of the arguments of a function is a NaN, the function will return
59 -- a NaN value or raise Argument_Error. Generally, for functions that
60 -- require Argument_Error to be raised for some arguments will also
61 -- raise Argument_Error for NaN arguments.
62
63 -- Many comparisons for special cases are inverted using "not" in order
64 -- to make sure the condition is false for NaN values, using the principle
65 -- that any comparison involving a NaN argument evaluates to false.
66
67 -- Principal branch:
68 -- Describes function result for cases where the mathematical
69 -- function is multivalued.
70
71 -- Exceptions:
72 -- Describes in what situations exceptions such as
73 -- Argument_Error and Constraint_Error must be raised.
74 -- In addition to these required exceptions, Constraint_Error
75 -- may also be raised instead of yielding an infinity value
76 -- for types T where T'Machine_Overflows is True.
77
78 -- Prescribed results:
79 -- Describes identities that must be satisfied.
80
81 -- Tightly approximated results:
82 -- Describes arguments for which the function result must
83 -- be in the model interval of the mathematical result.
84 -- This is required for strict mode.
85
86 -- Special values:
87 -- These are implementation-defined results arguments with
88 -- special values such as infinities (represented by +Inf and -Inf)
89 -- not-a-number values (written as NaN). Where consistent with the
90 -- Ada standard, the implementation satisfies the identities given
91 -- in Chapter F.9 of the C standard.
92
93 ----------
94 -- "**" --
95 ----------
96
97 -- Principle branch:
98 -- The result is nonnegative.
99
100 -- Required exceptions:
101 -- Argument_Error is raised when Left < 0.0, Left is a NaN
102 -- or when Left = 0.0 and Right = 0.0.
103 -- Constraint_Error is raised when Left = 0.0 and Right < 0.0.
104
105 -- Prescribed results:
106 -- (1) Left ** 0.0 = 1.0
107 -- (2) Left ** 1.0 = Left
108 -- (3) 0.0 ** Right = 0.0
109 -- (4) 1.0 ** Right = 1.0
110
111 -- The prescribed result (1) is satisfied by C_Pow.
112 -- Result (2) is not, and therefore is special-cased.
113 -- For case (3) this implementation always returns +0.0,
114 -- while C_Pow would return -0.0 when Left = -0.0 and Right a positive
115 -- odd integer. This would seem inconsistent with the required principle
116 -- branch, although it is debatable whether -0.0 is negative.
117 -- For case (4), C_Pow would return NaN, so a special case is required.
118
119 function "**" (Left, Right : Float_Type'Base) return Float_Type'Base is
120 begin
121 if Left <= 0.0 then
122 if not (Left = 0.0) or else not (Right /= 0.0) then
123 raise Argument_Error;
124
125 elsif not (Right >= 0.0) then
126 raise Constraint_Error;
127
128 else
129 -- Left = 0.0 and Right > 0.0
130
131 return 0.0;
132 end if;
133
134 elsif Right = 1.0 then
135 return Left;
136
137 elsif Left = 1.0 then
138 return 1.0;
139 end if;
140
141 return C_Pow (Left, Right);
142 end "**";
143
144 ------------
145 -- Arccos --
146 ------------
147
148 -- (Natural cycle)
149
150 -- Principal branch:
151 -- The result is in the quadrant containing the point (X, 1.0).
152 -- This quadrant is I or II; thus, the Arccos function ranges
153 -- from 0.0 to approximately Pi.
154
155 -- Exceptions:
156 -- Argument_Error is raised when abs (X) > 1.0
157
158 -- Tightly approximated results:
159 -- Arccos (0.0) = Pi / 2.0;
160 -- Arccos (1.0) = 0.0;
161
162 -- Since C mandates a NaN result for abs (X) > 1.0 and testing
163 -- for a NaN only requires a single test without calling the "abs"
164 -- function, the result is checked rather than the argument.
165
166 function Arccos (X : Float_Type'Base) return Float_Type'Base is
167 R : T;
168
169 begin
170 R := C_Acos (X);
171
172 if R /= R then
173 raise Argument_Error;
174 else
175 return R;
176 end if;
177 end Arccos;
178
179 -- (Arbitrary cycle)
180
181 -- Principal branch:
182 -- The result is in the quadrant containing the point (X, 1.0).
183 -- This quadrant is I or II; thus, the Arccos function ranges
184 -- from 0.0 to approximately Cycle / 2.0.
185
186 -- Exceptions:
187 -- Argument_Error is raised when abs (X) > 1.0 or when Cycle <= 0.0
188 -- or when either parameter is a NaN
189
190 -- Prescribed results:
191 -- Arccos (1.0) = 0.0
192
193 -- Tightly approximated results:
194 -- Arccos (0.0) = Cycle / 4.0
195
196 -- Since C mandates a NaN result for abs (X) > 1.0 and testing for a NaN
197 -- only requires a single test without calling the "abs" function, the
198 -- result is checked rather than the argument. The tightly approximated
199 -- result may not be obtained by dividing the C_Acos result by Pi, since
200 -- these are transcedental numbers.
201
202 function Arccos (X, Cycle : Float_Type'Base) return Float_Type'Base is
203 begin
204 if not (Cycle > 0.0) then
205 raise Argument_Error;
206
207 elsif not (abs X < 1.0) then
208 if X = 1.0 then
209 return 0.0;
210
211 elsif X = -1.0 then
212 return Cycle / 2.0;
213 end if;
214
215 raise Argument_Error;
216 end if;
217
218 if X = 0.0 then
219 return Cycle / 4.0;
220 end if;
221
222 return C_Acos (X) / (Pi / 2.0) * (Cycle / 4.0);
223 end Arccos;
224
225 -------------
226 -- Arccosh --
227 -------------
228
229 -- Principal branch:
230 -- The result is positive
231
232 -- Exceptions:
233 -- Argument_Error is raised when X < 1.0
234
235 -- Prescribed results:
236 -- Arccosh (1.0) = 0.0;
237
238 -- General description
239 -- TODO
240
241 function Arccosh (X : Float_Type'Base) return Float_Type'Base is
242 begin
243 if X < 1.0 then
244 raise Argument_Error;
245 else
246 return C_Acosh (X);
247 end if;
248 end Arccosh;
249
250 ------------
251 -- Arccot --
252 ------------
253
254 -- Natural cycle
255
256 -- Principal branch:
257 -- The results are in the quadrant containing the point (X, Y).
258 -- This may be any quadrant (I through IV) when the parameter Y is
259 -- specified, but it is restricted to quadrants I and II when that
260 -- parameter is omitted. Thus the range when that parameter is
261 -- specified is approximately -Pi to Pi; when omitted the range is
262 -- 0.0 to Pi.
263
264 -- Exceptions:
265 -- Argument_Error is raised when parameters X and Y both have the
266 -- value zero
267
268 -- Prescribed results:
269 -- Arccot (X, 0.0) = 0.0 when X > 0.0
270
271 function Arccot
272 (X : Float_Type'Base;
273 Y : Float_Type'Base := 1.0) return Float_Type'Base
274 is
275 begin
276 if X = 0.0 and then Y = 0.0 then
277 raise Argument_Error;
278 else
279
280 -- Just reverse arguments
281
282 return Arctan (Y, X);
283 end if;
284 end Arccot;
285
286 -- Arbitrary cycle
287
288 function Arccot
289 (X : Float_Type'Base;
290 Y : Float_Type'Base := 1.0;
291 Cycle : Float_Type'Base) return Float_Type'Base
292 is
293 begin
294 if X = 0.0 and then Y = 0.0 then
295 raise Argument_Error;
296
297 else
298 -- Just reverse arguments
299
300 return Arctan (Y, X, Cycle);
301 end if;
302 end Arccot;
303
304 -------------
305 -- Arccoth --
306 -------------
307
308 -- Exceptions:
309 -- Argument_Error is raised if abs (X) < 1.0
310 -- Constraint_Error is raised if X = +-1.0
311
312 function Arccoth (X : Float_Type'Base) return Float_Type'Base is
313 begin
314 if abs X <= 1.0 then
315 if abs X = 1.0 then
316 raise Constraint_Error;
317 else
318 raise Argument_Error;
319 end if;
320
321 elsif abs X > 2.0 then
322 return C_Atanh (1.0 / X);
323
324 else
325 -- 1.0 < abs X <= 2.0. One of X + 1.0 and X - 1.0 is exact, the
326 -- other has error 0 or Epsilon.
327
328 return 0.5 * (C_Log (abs (X + 1.0)) - C_Log (abs (X - 1.0)));
329 end if;
330 end Arccoth;
331
332 ------------
333 -- Arcsin --
334 ------------
335
336 -- (Natural cycle)
337
338 -- Principal branch:
339 -- The result of the Arcsin function is in the quadrant containing the
340 -- the point (1.0, X). This quadrant is I or IV; thus, the range of the
341 -- function is approximately -Pi/2.0 to Pi/2.0.
342
343 -- Exceptions:
344 -- Argument_Error is raised when abs X > 1.0 or X is a NaN
345
346 -- Prescribed results:
347 -- Arcsin (0.0) = 0.0
348
349 -- Tightly approximated results:
350 -- Arcsin (1.0) = Pi / 2.0
351 -- Arcsin (-1.0) = -Pi / 2.0
352
353 -- The prescribed result is guaranteed by C, but the tightly approximated
354 -- results are not.
355
356 function Arcsin (X : Float_Type'Base) return Float_Type'Base is
357 Y : constant T := abs X;
358
359 begin
360 if not (Y < 1.0) then
361 if X = 1.0 then
362 return Pi / 2.0;
363
364 elsif X = -1.0 then
365 return -Pi / 2.0;
366
367 else
368 raise Argument_Error;
369 end if;
370 end if;
371
372 return C_Asin (X);
373 end Arcsin;
374
375 -- (Arbitrary cycle)
376
377 -- Principal branch:
378 -- The result of the Arcsin function is in the quadrant containing the
379 -- the point (1.0, X). This quadrant is I or IV; thus, the range of the
380 -- function is approximately -Cycle/4.0 to Cycle/4.0.
381
382 -- Exceptions:
383 -- Argument_Error is raised when abs X > 1.0 or X is a NaN
384 -- or when Cycle <= 0.0 or Cycle is a NaN
385
386 -- Prescribed results:
387 -- Arcsin (0.0) = 0.0
388
389 -- Tightly approximated results:
390 -- Arcsin (1.0) = Cycle / 4.0
391 -- Arcsin (-1.0) = -Cycle / 4.0
392
393 -- The prescribed result is guaranteed by C, but the tightly approximated
394 -- results are not.
395
396 function Arcsin (X, Cycle : Float_Type'Base) return Float_Type'Base is
397 Y : constant T := abs X;
398
399 begin
400 if not (Cycle > 0.0) then
401 raise Argument_Error;
402
403 elsif not (Y < 1.0) then
404 if X = 1.0 then
405 return Cycle / 4.0;
406
407 elsif X = -1.0 then
408 return -Cycle / 4.0;
409
410 else
411 raise Argument_Error;
412 end if;
413 end if;
414
415 return C_Asin (X) / (Pi / 2.0) * (Cycle / 4.0);
416 end Arcsin;
417
418 -------------
419 -- Arcsinh --
420 -------------
421
422 -- Prescribed results:
423 -- Arcsinh (0.0) = 0.0
424
425 -- TODO - general description
426
427 function Arcsinh (X : Float_Type'Base) return Float_Type'Base is
428 (C_Asinh (X));
429
430 ------------
431 -- Arctan --
432 ------------
433
434 -- (Natural cycle)
435
436 -- Principal branch:
437 -- The results are in the quadrant containing the point (X, Y).
438 -- This may be any quadrant (I through IV) when the parameter X is
439 -- specified, but it is restricted to quadrants I and IV when that
440 -- parameter is omitted. Thus the range when that parameter is
441 -- specified is approximately -Pi to Pi; when omitted the range is
442 -- -Pi/2.0 to Pi/2.0.
443
444 -- Exceptions:
445 -- Argument_Error is raised when both X and Y have the value zero.
446
447 -- Prescribed results:
448 -- Arctan ( X, 0.0) = 0.0, when X > 0.0
449
450 -- Tightly approximated results:
451 -- Arctan (0.0, Y) = Pi/2.0, when Y > 0.0
452 -- Arctan (0.0, Y) = -Pi/2.0, when Y < 0.0
453 -- Arctan ( X, +0.0) = +Pi, when X < 0.0
454 -- Arctan ( X, -0.0) = -Pi, when X < 0.0
455
456 -- The prescribed result and tightly approximated results are all
457 -- guaranteed by C.
458
459 function Arctan
460 (Y : Float_Type'Base;
461 X : Float_Type'Base := 1.0) return Float_Type'Base
462 is
463 begin
464 if not (X /= 0.0) and then not (Y /= 0.0) then
465 raise Argument_Error;
466 end if;
467
468 return C_Atan2 (Y, X);
469 end Arctan;
470
471 -- (Arbitrary cycle)
472
473 -- Principal branch:
474 -- The results are in the quadrant containing the point (X, Y).
475 -- This may be any quadrant (I through IV) when the parameter X is
476 -- specified, but it is restricted to quadrants I and IV when that
477 -- parameter is omitted. Thus the range when that parameter is
478 -- specified is approximately -Cycle/2.0 to Cycle/2.0; when omitted
479 -- the range is -Cycle/4.0 to Cycle/4.0.
480
481 -- Exceptions:
482 -- Argument_Error is raised when both X and Y have the value zero,
483 -- or when Cycle <= 0.0 or Cycle is a NaN.
484
485 -- Prescribed results:
486 -- Arctan ( X, 0.0, Cycle) = 0.0, when X > 0.0
487
488 -- Tightly approximated results:
489 -- Arctan (0.0, Y, Cycle) = Cycle/4.0, when Y > 0.0
490 -- Arctan (0.0, Y, Cycle) = -Cycle/4.0, when Y < 0.0
491 -- Arctan ( X, +0.0, Cycle) = Cycle/2.0, when X < 0.0
492 -- Arctan ( X, -0.0, Cycle) = -Cycle/2.0, when X < 0.0
493
494 -- The prescribed result and tightly approximated results are all
495 -- guaranteed by C.
496
497 function Arctan
498 (Y : Float_Type'Base;
499 X : Float_Type'Base := 1.0;
500 Cycle : Float_Type'Base) return Float_Type'Base
501 is
502 begin
503 if not (Cycle > 0.0) then
504 raise Argument_Error;
505 end if;
506
507 if X = 0.0 then
508 if Y = 0.0 then
509 raise Argument_Error;
510
511 elsif Y > 0.0 then
512 return Cycle / 4.0;
513
514 elsif Y < 0.0 then
515 return -Cycle / 4.0;
516 end if;
517
518 -- Y is a NaN
519
520 elsif Y = 0.0 then
521 -- X /= 0
522
523 if X > 0.0 then
524 return 0.0;
525
526 elsif X < 0.0 then
527 return T'Copy_Sign (Cycle / 2.0, Y);
528 end if;
529
530 -- X is a NaN
531 end if;
532
533 return C_Atan2 (Y, X) * Cycle / (2.0 * Pi);
534 end Arctan;
535
536 -------------
537 -- Arctanh --
538 -------------
539
540 -- Exceptions:
541 -- Argument_Error is raised when abs (X) > 1.0
542 -- Constraint_Error is raised when X = +-1.0
543
544 -- Prescribed results:
545 -- Arctanh (0.0) = 0.0
546
547 -- TODO - general description
548
549 function Arctanh (X : Float_Type'Base) return Float_Type'Base is
550 begin
551 if not (abs (X) < 1.0) then
552 if abs (X) = 1.0 then
553 raise Constraint_Error;
554 else
555 raise Argument_Error;
556 end if;
557 else
558 return C_Atanh (X);
559 end if;
560 end Arctanh;
561
562 ---------
563 -- Cos --
564 ---------
565
566 -- (Natural cycle)
567
568 -- Prescribed results:
569 -- Cos (0.0) = 1.0
570
571 -- Special values:
572 -- Cos (X), where X is positive or negative infinity returns NaN value
573
574 -- The C_Cos function satisfies all requirements
575
576 function Cos (X : Float_Type'Base) return Float_Type'Base is
577 begin
578 return C_Cos (X);
579 end Cos;
580
581 -- (Arbitrary cycle)
582
583 -- Exceptions:
584 -- Argument_Error is raised when Cycle <= 0
585
586 -- Prescribed results:
587 -- Cos (X) = 0.0, when X is K * Cycle / 4.0 with odd integer K
588 -- Cos (X) = 1.0, when X is K * Cycle, with integer K
589 -- Cos (X) = -1.0, with X is K * Cycle / 2.0, with odd integer K
590
591 -- Special values:
592 -- Cos (X), where X is positive or negative infinity returns a
593 -- NaN value.
594
595 function Cos (X, Cycle : Float_Type'Base) return Float_Type'Base is
596 begin
597 -- Just reuse the code for Sin. The potential small
598 -- loss of speed is negligible with proper (front-end) inlining.
599
600 return -Sin (abs X - Cycle * 0.25, Cycle);
601 end Cos;
602
603 ----------
604 -- Cosh --
605 ----------
606
607 -- Prescribed results:
608 -- Cosh (0.0) = 1.0
609
610 -- Tightly approximated results:
611 -- TODO
612
613 -- TODO - general description
614
615 function Cosh (X : Float_Type'Base) return Float_Type'Base is
616 (C_Cosh (X));
617
618 ---------
619 -- Cot --
620 ---------
621
622 -- (natural cycle)
623
624 -- Exceptions:
625 -- Constraint_Error is raised when X = 0.0
626
627 -- As there is no cotangent function defined for C99, it is implemented
628 -- here in terms of the regular tangent function.
629
630 function Cot (X : Float_Type'Base) return Float_Type'Base is
631 begin
632 if not (X /= 0.0) then
633 raise Constraint_Error;
634 else
635 return 1.0 / C_Tan (X);
636 end if;
637 end Cot;
638
639 -- (arbitrary cycle)
640
641 -- Exceptions:
642 -- Argument_Error is raised when Cycle <= 0
643 -- Constraint_Error is raised when X = K * Cycle / 2.0, with integer K
644
645 -- Prescribed results:
646 -- Cot (X) = 0.0, when X is K * Cycle / 4.0 with odd integer K
647
648 -- Special values:
649 -- Cot (X), where X is positive or negative infinity returns NaN value
650
651 function Cot (X, Cycle : Float_Type'Base) return Float_Type'Base is
652 T, TA : Float_Type'Base;
653
654 begin
655 if not (Cycle > 0.0) then
656 raise Argument_Error;
657 end if;
658
659 T := Float_Type'Base'Remainder (X, Cycle) / Cycle;
660 TA := abs T;
661
662 if not (T /= 0.0 and then TA /= 0.5) then
663 raise Constraint_Error;
664 end if;
665
666 if TA = 0.25 then
667 return 0.0;
668 end if;
669
670 return 1.0 / C_Tan (T * 2.0 * Pi);
671 end Cot;
672
673 ----------
674 -- Coth --
675 ----------
676
677 -- Exceptions:
678 -- Argument_Error is raised when X = 0.
679
680 -- Tightly approximated results:
681 -- TODO
682
683 -- TODO - general description
684
685 function Coth (X : Float_Type'Base) return Float_Type'Base is
686 begin
687 if not (X /= 0.0) then
688 raise Argument_Error;
689 else
690 return 1.0 / C_Tanh (X);
691 end if;
692 end Coth;
693
694 ---------
695 -- Exp --
696 ---------
697
698 -- Prescribed results:
699 -- Exp (0.0) = 1.0
700
701 -- Special values:
702 -- Exp (X) = +0.0, for X is negative infinity
703 -- Exp (X) = X, for X is positive infinity
704 -- and Float_Type'Machine_Overflows = False
705
706 -- The C_Exp function satisfies all Ada requirements
707
708 function Exp (X : Float_Type'Base) return Float_Type'Base is
709 begin
710 return C_Exp (X);
711 end Exp;
712
713 ---------
714 -- Log --
715 ---------
716
717 -- (natural base)
718
719 -- Exceptions:
720 -- Argument is raised when X < 0.0
721 -- Constraint_Error is raised when X = 0.0
722
723 -- Prescribed results:
724 -- Log (1.0) = 0.0;
725
726 -- Special values:
727 -- Log (X) = X, for X is positive infinity
728
729 -- Apart from exceptions, the C_Log function satisfies all constraints
730
731 function Log (X : Float_Type'Base) return Float_Type'Base is
732 begin
733 if not (X > 0.0) then
734 if X < 0.0 then
735 raise Argument_Error;
736 end if;
737
738 raise Constraint_Error;
739 end if;
740
741 return C_Log (X);
742 end Log;
743
744 -- (arbitrary base)
745
746 -- Exceptions:
747 -- Argument is raised when X < 0.0, Base <= 0.0 or Base = 1.0
748 -- Constraint_Error is raised when X = 0.0
749
750 -- Prescribed results:
751 -- Log (1.0, Base) = 0.0
752
753 -- Special values:
754 -- Log (X, Base) = X, for X is positive infinity
755
756 -- Apart from exceptions, the C_Log function satisfies all constraints
757
758 function Log (X, Base : Float_Type'Base) return Float_Type'Base is
759 begin
760 -- Try to execute the common case of X > 0.0 and Base > 1.0 with
761 -- minimal checks.
762
763 if X <= 0.0 or else Base <= 1.0 then
764 if X < 0.0 or else Base <= 0.0 or else Base = 1.0 then
765 raise Argument_Error;
766 end if;
767
768 if X = 0.0 then
769 raise Constraint_Error;
770 end if;
771 end if;
772
773 return C_Log (X) / C_Log (Base);
774 end Log;
775
776 ---------
777 -- Sin --
778 ---------
779
780 -- (Natural cycle)
781
782 -- Prescribed results:
783 -- Sin (+0.0) = +0.0
784 -- Sin (-0.0) = -0.0
785
786 -- Special values:
787 -- Sin (X), where X is positive or negative infinity returns a
788 -- NaN value.
789
790 -- The C_Sin function satisfies all requirements
791
792 function Sin (X : Float_Type'Base) return Float_Type'Base is
793 begin
794 return C_Sin (X);
795 end Sin;
796
797 -- (Arbitrary cycle)
798
799 -- Exceptions:
800 -- Argument_Error is raised when Cycle <= 0
801
802 -- Prescribed results:
803 -- Sin (-0.0) = -0.0
804 -- Sin (+0.0) = +0.0
805 -- Sin (X) = 1.0, when X is K * Cycle + Cycle / 4.0, with integer K
806 -- Sin (X) = -1.0, with X is K * Cycle - Cycle / 4.0, with integer K
807
808 -- Special values:
809 -- Sin (X), where X is positive or negative infinity returns NaN value
810
811 function Sin (X, Cycle : Float_Type'Base) return Float_Type'Base is
812 T : Float_Type'Base;
813
814 begin
815 if not (Cycle > 0.0) then
816 raise Argument_Error;
817 end if;
818
819 T := Float_Type'Base'Remainder (X, Cycle);
820
821 -- The following reduction reduces the argument to the interval
822 -- [-0.5 Cycle, 0.5 * Cycle]. The entire reduction is exact.
823
824 if T > 0.25 * Cycle then
825 T := 0.5 * Cycle - T;
826
827 elsif T < -0.25 * Cycle then
828 T := -T - 0.5 * Cycle;
829 end if;
830
831 return C_Sin (T / Cycle * 2.0 * Pi);
832 end Sin;
833
834 ----------
835 -- Sinh --
836 ----------
837
838 -- Prescribed results:
839 -- Sinh (0.0) = 0.0
840
841 -- TODO - general description
842
843 function Sinh (X : Float_Type'Base) return Float_Type'Base is
844 (C_Sinh (X));
845
846 ----------
847 -- Sqrt --
848 ----------
849
850 -- Principle branch:
851 -- The result is nonnegative.
852
853 -- Exceptions:
854 -- Argument_Error is raised when X < 0.0
855
856 -- Prescribed results:
857 -- Sqrt (-0.0) = -0.0
858 -- Sqrt (+0.0) = +0.0
859 -- Sqrt (1.0) = 1.0
860
861 -- Special values:
862 -- Sqrt (X) = X, for X is positive infinity
863
864 -- C_Sqrt satisfies all requirements
865
866 function Sqrt (X : Float_Type'Base) return Float_Type'Base is
867 begin
868 if not (X >= 0.0) then
869 raise Argument_Error;
870 end if;
871
872 return C_Sqrt (X);
873 end Sqrt;
874
875 ---------
876 -- Tan --
877 ---------
878
879 -- (natural cycle)
880
881 -- Prescribed results:
882 -- Tan (-0.0) = -0.0
883 -- Tan (+0.0) = +0.0
884
885 -- Special values:
886 -- Tan (X) returns a NaN value, when X is positive or negative infinity
887
888 -- The C_Tan function satisfies all requirements
889
890 function Tan (X : Float_Type'Base) return Float_Type'Base is
891 begin
892 return C_Tan (X);
893 end Tan;
894
895 -- (arbitrary cycle)
896
897 -- Exceptions:
898 -- Argument_Error is raised for Cycle <= 0.0
899
900 -- Prescribed results:
901 -- Tan (-0.0, Cycle) = -0.0
902 -- Tan (+0.0, Cycle) = +0.0
903 -- Tan (X, Cycle) = 0, for X a multiple of Cycle / 2.0
904
905 -- Special values:
906 -- Tan (X, Cycle) returns a NaN value, when X is positive or
907 -- negative infinity
908
909 function Tan (X, Cycle : Float_Type'Base) return Float_Type'Base is
910 T : Float_Type'Base;
911 TA : Float_Type'Base;
912
913 begin
914 if not (Cycle > 0.0) then
915 raise Argument_Error;
916 end if;
917
918 T := Float_Type'Base'Remainder (X, Cycle) / Cycle;
919 TA := abs T;
920
921 -- The TA = 0.75 case is not needed because the remainder function
922 -- is defined so that it never returns a value greater than Cycle/2,
923 -- the value of TA will always be less than or equal to 0.5. Therefore,
924 -- the condition TA = 0.75 can never be true.
925
926 if TA = 0.25 then
927 raise Constraint_Error;
928 end if;
929
930 if TA = 0.5 then
931 return 0.0;
932 end if;
933
934 return C_Tan (T * 2.0 * Pi);
935 end Tan;
936
937 ----------
938 -- Tanh --
939 ----------
940
941 -- Principal branch:
942 -- The absolute value of the result is smaller than 1.0
943
944 -- Prescribed results:
945 -- Tanh (0.0) = 0.0
946
947 -- TODO - general description
948
949 function Tanh (X : Float_Type'Base) return Float_Type'Base is
950 (C_Tanh (X));
951
952 end System.Generic_C_Math_Interface;