1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--                       S Y S T E M . E X N _ L L F                        --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2018, 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--  Note: the reason for treating exponents in the range 0 .. 4 specially is
33--  to ensure identical results to the static inline expansion in the case of
34--  a compile time known exponent in this range. The use of Float'Machine and
35--  Long_Float'Machine is to avoid unwanted extra precision in the results.
36
37--  Note that for a negative exponent in Left ** Right, we compute the result
38--  as:
39
40--     1.0 / (Left ** (-Right))
41
42--  Note that the case of Left being zero is not special, it will simply result
43--  in a division by zero at the end, yielding a correctly signed infinity, or
44--  possibly generating an overflow.
45
46--  Note on overflow: This coding assumes that the target generates infinities
47--  with standard IEEE semantics. If this is not the case, then the code
48--  for negative exponent may raise Constraint_Error. This follows the
49--  implementation permission given in RM 4.5.6(12).
50
51package body System.Exn_LLF is
52
53   subtype Negative is Integer range Integer'First .. -1;
54
55   function Exp
56     (Left  : Long_Long_Float;
57      Right : Natural) return Long_Long_Float;
58   --  Common routine used if Right is greater or equal to 5
59
60   ---------------
61   -- Exn_Float --
62   ---------------
63
64   function Exn_Float
65     (Left  : Float;
66      Right : Integer) return Float
67   is
68      Temp : Float;
69   begin
70      case Right is
71         when 0 =>
72            return 1.0;
73         when 1 =>
74            return Left;
75         when 2 =>
76            return Float'Machine (Left * Left);
77         when 3 =>
78            return Float'Machine (Left * Left * Left);
79         when 4 =>
80            Temp := Float'Machine (Left * Left);
81            return Float'Machine (Temp * Temp);
82         when Negative =>
83            return Float'Machine (1.0 / Exn_Float (Left, -Right));
84         when others =>
85            return
86              Float'Machine
87                (Float (Exp (Long_Long_Float (Left), Right)));
88      end case;
89   end Exn_Float;
90
91   --------------------
92   -- Exn_Long_Float --
93   --------------------
94
95   function Exn_Long_Float
96     (Left  : Long_Float;
97      Right : Integer) return Long_Float
98   is
99      Temp : Long_Float;
100   begin
101      case Right is
102         when 0 =>
103            return 1.0;
104         when 1 =>
105            return Left;
106         when 2 =>
107            return Long_Float'Machine (Left * Left);
108         when 3 =>
109            return Long_Float'Machine (Left * Left * Left);
110         when 4 =>
111            Temp := Long_Float'Machine (Left * Left);
112            return Long_Float'Machine (Temp * Temp);
113         when Negative =>
114            return Long_Float'Machine (1.0 / Exn_Long_Float (Left, -Right));
115         when others =>
116            return
117              Long_Float'Machine
118                (Long_Float (Exp (Long_Long_Float (Left), Right)));
119      end case;
120   end Exn_Long_Float;
121
122   -------------------------
123   -- Exn_Long_Long_Float --
124   -------------------------
125
126   function Exn_Long_Long_Float
127     (Left  : Long_Long_Float;
128      Right : Integer) return Long_Long_Float
129   is
130      Temp : Long_Long_Float;
131   begin
132      case Right is
133         when 0 =>
134            return 1.0;
135         when 1 =>
136            return Left;
137         when 2 =>
138            return Left * Left;
139         when 3 =>
140            return Left * Left * Left;
141         when 4 =>
142            Temp := Left * Left;
143            return Temp * Temp;
144         when Negative =>
145            return 1.0 / Exn_Long_Long_Float (Left, -Right);
146         when others =>
147            return Exp (Left, Right);
148      end case;
149   end Exn_Long_Long_Float;
150
151   ---------
152   -- Exp --
153   ---------
154
155   function Exp
156     (Left  : Long_Long_Float;
157      Right : Natural) return Long_Long_Float
158   is
159      Result : Long_Long_Float := 1.0;
160      Factor : Long_Long_Float := Left;
161      Exp    : Natural := Right;
162
163   begin
164      --  We use the standard logarithmic approach, Exp gets shifted right
165      --  testing successive low order bits and Factor is the value of the
166      --  base raised to the next power of 2. If the low order bit or Exp is
167      --  set, multiply the result by this factor.
168
169      loop
170         if Exp rem 2 /= 0 then
171            Result := Result * Factor;
172         end if;
173
174         Exp := Exp / 2;
175         exit when Exp = 0;
176         Factor := Factor * Factor;
177      end loop;
178
179      return Result;
180   end Exp;
181
182end System.Exn_LLF;
183