Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/s-fatgen.adb @ 131:84e7813d76e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
4 -- -- 4 -- --
5 -- S Y S T E M . F A T _ G E N -- 5 -- S Y S T E M . F A T _ G E N --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 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- -- 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- -- 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- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
392 -- We treat Model as identical to Machine. This is true of IEEE and other 392 -- We treat Model as identical to Machine. This is true of IEEE and other
393 -- nice floating-point systems, but not necessarily true of all systems. 393 -- nice floating-point systems, but not necessarily true of all systems.
394 394
395 function Model (X : T) return T is 395 function Model (X : T) return T is
396 begin 396 begin
397 return Machine (X); 397 return T'Machine (X);
398 end Model; 398 end Model;
399 399
400 ---------- 400 ----------
401 -- Pred -- 401 -- Pred --
402 ---------- 402 ----------
413 413
414 -- Special treatment for most negative number 414 -- Special treatment for most negative number
415 415
416 elsif X = T'First then 416 elsif X = T'First then
417 417
418 -- If not generating infinities, we raise a constraint error 418 raise Constraint_Error with "Pred of largest negative number";
419
420 if T'Machine_Overflows then
421 raise Constraint_Error with "Pred of largest negative number";
422
423 -- Otherwise generate a negative infinity
424
425 else
426 return X / (X - X);
427 end if;
428 419
429 -- For infinities, return unchanged 420 -- For infinities, return unchanged
430 421
431 elsif X < T'First or else X > T'Last then 422 elsif X < T'First or else X > T'Last then
432 return X; 423 return X;
669 660
670 elsif X = T'Last then 661 elsif X = T'Last then
671 662
672 -- If not generating infinities, we raise a constraint error 663 -- If not generating infinities, we raise a constraint error
673 664
674 if T'Machine_Overflows then 665 raise Constraint_Error with "Succ of largest positive number";
675 raise Constraint_Error with "Succ of largest negative number";
676 666
677 -- Otherwise generate a positive infinity 667 -- Otherwise generate a positive infinity
678
679 else
680 return X / (X - X);
681 end if;
682 668
683 -- For infinities, return unchanged 669 -- For infinities, return unchanged
684 670
685 elsif X < T'First or else X > T'Last then 671 elsif X < T'First or else X > T'Last then
686 return X; 672 return X;
737 723
738 begin 724 begin
739 Result := abs X; 725 Result := abs X;
740 726
741 if Result >= Radix_To_M_Minus_1 then 727 if Result >= Radix_To_M_Minus_1 then
742 return Machine (X); 728 return T'Machine (X);
743 729
744 else 730 else
745 Result := Machine (Radix_To_M_Minus_1 + Result) - Radix_To_M_Minus_1; 731 Result :=
732 T'Machine (Radix_To_M_Minus_1 + Result) - Radix_To_M_Minus_1;
746 733
747 if Result > abs X then 734 if Result > abs X then
748 Result := Result - 1.0; 735 Result := Result - 1.0;
749 end if; 736 end if;
750 737