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