------------------------------------------------------------------------------ | |

-- -- | |

-- GNAT RUN-TIME COMPONENTS -- | |

-- -- | |

-- S Y S T E M . E X P O N R -- | |

-- -- | |

-- B o d y -- | |

-- -- | |

-- Copyright (C) 2021, Free Software Foundation, Inc. -- | |

-- -- | |

-- GNAT is free software; you can redistribute it and/or modify it under -- | |

-- terms of the GNU General Public License as published by the Free Soft- -- | |

-- ware Foundation; either version 3, or (at your option) any later ver- -- | |

-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |

-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |

-- or FITNESS FOR A PARTICULAR PURPOSE. -- | |

-- -- | |

-- As a special exception under Section 7 of GPL version 3, you are granted -- | |

-- additional permissions described in the GCC Runtime Library Exception, -- | |

-- version 3.1, as published by the Free Software Foundation. -- | |

-- -- | |

-- You should have received a copy of the GNU General Public License and -- | |

-- a copy of the GCC Runtime Library Exception along with this program; -- | |

-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |

-- <http://www.gnu.org/licenses/>. -- | |

-- -- | |

-- GNAT was originally developed by the GNAT team at New York University. -- | |

-- Extensive contributions were provided by Ada Core Technologies Inc. -- | |

-- -- | |

------------------------------------------------------------------------------ | |

-- Note that the reason for treating exponents in the range 0 .. 4 specially | |

-- is to ensure identical results with the static expansion in the case of a | |

-- compile-time known exponent in this range; similarly, the use 'Machine is | |

-- to avoid unwanted extra precision in the results. | |

-- For a negative exponent, we compute the result as per RM 4.5.6(11/3): | |

-- Left ** Right = 1.0 / (Left ** (-Right)) | |

-- Note that the case of Left being zero is not special, it will simply result | |

-- in a division by zero at the end, yielding a correctly signed infinity, or | |

-- possibly raising an overflow exception. | |

-- Note on overflow: this coding assumes that the target generates infinities | |

-- with standard IEEE semantics. If this is not the case, then the code for | |

-- negative exponents may raise Constraint_Error, which is in keeping with the | |

-- implementation permission given in RM 4.5.6(12). | |

with System.Double_Real; | |

function System.Exponr (Left : Num; Right : Integer) return Num is | |

package Double_Real is new System.Double_Real (Num); | |

use type Double_Real.Double_T; | |

subtype Double_T is Double_Real.Double_T; | |

-- The double floating-point type | |

subtype Safe_Negative is Integer range Integer'First + 1 .. -1; | |

-- The range of safe negative exponents | |

function Expon (Left : Num; Right : Natural) return Num; | |

-- Routine used if Right is greater than 4 | |

----------- | |

-- Expon -- | |

----------- | |

function Expon (Left : Num; Right : Natural) return Num is | |

Result : Double_T := Double_Real.To_Double (1.0); | |

Factor : Double_T := Double_Real.To_Double (Left); | |

Exp : Natural := Right; | |

begin | |

-- We use the standard logarithmic approach, Exp gets shifted right | |

-- testing successive low order bits and Factor is the value of the | |

-- base raised to the next power of 2. If the low order bit or Exp | |

-- is set, multiply the result by this factor. | |

loop | |

if Exp rem 2 /= 0 then | |

Result := Result * Factor; | |

exit when Exp = 1; | |

end if; | |

Exp := Exp / 2; | |

Factor := Double_Real.Sqr (Factor); | |

end loop; | |

return Double_Real.To_Single (Result); | |

end Expon; | |

begin | |

case Right is | |

when 0 => | |

return 1.0; | |

when 1 => | |

return Left; | |

when 2 => | |

return Num'Machine (Left * Left); | |

when 3 => | |

return Num'Machine (Left * Left * Left); | |

when 4 => | |

declare | |

Sqr : constant Num := Num'Machine (Left * Left); | |

begin | |

return Num'Machine (Sqr * Sqr); | |

end; | |

when Safe_Negative => | |

return Num'Machine (1.0 / Exponr (Left, -Right)); | |

when Integer'First => | |

return Num'Machine (1.0 / (Exponr (Left, Integer'Last) * Left)); | |

when others => | |

return Num'Machine (Expon (Left, Right)); | |

end case; | |

end System.Exponr; |