--
--	Inmos Libraries
--	Copyright (C) 1988, 1989, 1990, 1991, 1993  Inmos Limited
--
--	This library is free software; you can redistribute it and/or
--	modify it under the terms of the GNU Lesser General Public
--	License as published by the Free Software Foundation; either
--	version 2 of the License, or (at your option) any later version.
--
--	This library is distributed in the hope that it will be useful,
--	but WITHOUT ANY WARRANTY; without even the implied warranty of
--	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--	Lesser General Public License for more details.
--
--	You should have received a copy of the GNU Lesser General Public
--	License along with this library; if not, write to the Free Software
--	Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
--

--** @module maths

#OPTION "V"  -- no vector space
#COMMENT "Floating point maths library, V1.1 27/03/90"
#COMMENT "(c) Copyright INMOS Limited 1988"
#INCLUDE "mathhdr.inc"

--* Single-precision power.
--
-- @param Base.r Base
-- @param Expn.r Exponent
-- @return Base.r raised to the power Expn.r
REAL32 FUNCTION POWER (VAL REAL32 Base.r, Expn.r)

  --{{{  history
  -- V1.0 1-Jul-88
  -- Added OPTION "V"; V1.1 27-Mar-90 SRH
  --}}}

  REAL32 Result :
  VALOF
    --{{{  definitions and variables
    -- Threshold for exp(x) = 1 is 2**(-ManBits-1), see C&W p63.
    VAL REAL64 Eps  RETYPES #3C90000000000000(INT64) :
    VAL REAL64 DInvLn2  RETYPES #3FF71547652B82FE(INT64) :
    VAL MaxLog IS   88.72(REAL64) :
    VAL MinLog IS -104.0(REAL64) : -- ln(smallest real)
    VAL BOOL ExpnNotFinite IS NOTFINITE (Expn.r) :
    VAL base.compared.with.zero IS IEEECOMPARE (Base.r, Zero) :
    VAL expn.compared.with.zero IS IEEECOMPARE (Expn.r, Zero) :
    VAL base.compared.with.one  IS IEEECOMPARE (Base.r, One) :
    VAL expn.compared.with.one  IS IEEECOMPARE (Expn.r, One) :
    --}}}
    SEQ
      IF
        --{{{  special cases
        --{{{  NaNs
        (base.compared.with.zero = is.nan) OR (expn.compared.with.zero = is.nan)
          -- incorporates precedence rule for NaNs
          Result := REAL32OP (Base.r, Add, Expn.r)
        --}}}
        --{{{  Base.r < Zero
        base.compared.with.zero = less.than
          Result := undefined.NaN
        --}}}
        --{{{  Base.r = Zero
        base.compared.with.zero = equal.to
          IF
            expn.compared.with.zero <= equal.to
              Result := undefined.NaN
            ExpnNotFinite
              Result := unstable.NaN
            TRUE
              Result := Base.r
        --}}}
        --{{{  Zero < Base.r < 1 and Expn.r = +/- Inf
        ExpnNotFinite AND (base.compared.with.one = less.than)
          IF
            expn.compared.with.zero = greater.than -- Expn.r = +Inf
              Result := Zero
            TRUE       -- Expn.r = -Inf
              Result := RInf
        --}}}
        --{{{  Base.r = 1
        base.compared.with.one = equal.to
          IF
            ExpnNotFinite
              Result := unstable.NaN
            TRUE
              Result := One
        --}}}
        --{{{  Base.r = Inf
        NOTFINITE (Base.r)
          IF
            expn.compared.with.one >= equal.to
              Result := RInf
            IEEECOMPARE (Expn.r, -One) <= equal.to
              Result := Zero
            TRUE
              Result := undefined.NaN
        --}}}
        --{{{  Expn.r = 1
        -- case Expn.r = 0 comes out exactly in any case
        expn.compared.with.one = equal.to
          Result := Base.r
        --}}}
        --{{{  Expn.r = +/- Inf
        ExpnNotFinite -- if true, must have 1 < Base.r < Inf
          IF
            expn.compared.with.zero = greater.than -- Expn.r = +Inf
              Result := RInf
            TRUE  -- case expn = -Inf
              Result := Zero
        --}}}
        --}}}
        TRUE
          REAL64 XWork, RWork :
          INT N1 :
          SEQ
            --{{{  take logarithm of base
            N1, XWork := DFLOATING.UNPACK (REAL64 Base.r)
            XWork := DDIVBY2 (XWork)  -- to map XWork into the range [0.5, 1.0)
            --{{{  Reduced Log
            VAL REAL64 C0 RETYPES #3FE6A09E667F3BCD(INT64) : -- SQRT(0.5)
            VAL A2 IS -7.8956112887491257267E-1(REAL64) :
            VAL A1 IS  1.6383943563021534222E+1(REAL64) :
            VAL A0 IS -6.4124943423745581147E+1(REAL64) :
            VAL B2 IS -3.5667977739034646171E+1(REAL64) :
            VAL B1 IS  3.1203222091924532844E+2(REAL64) :
            VAL B0 IS -7.6949932108494879777E+2(REAL64) :
            VAL DHalf IS 0.5(REAL64) :
            REAL64 Z :
            SEQ
              IF
                XWork > C0
                  SEQ
                    Z := ((XWork - DHalf) - DHalf) / ((XWork * DHalf) + DHalf)
                    N1 := N1 + 1              -- to ensure N1 corresponds
                TRUE
                  VAL REAL64 ZNum IS XWork - DHalf :
                  Z := ZNum / ((ZNum * DHalf) + DHalf)
              VAL W IS Z * Z :
              RWork := Z+(Z*(((((((A2*W)+A1)*W)+A0)*W)/(((((W+B2)*W)+B1)*W)+B0))))
            --}}}
            IF
              N1 = 0
                SKIP
              TRUE
                VAL RealN IS REAL64 ROUND N1 :
                RWork := (RWork + (RealN * DLn2))
            --}}}
            --{{{  multiply by exponent
            XWork := RWork * (REAL64 Expn.r)
            --}}}
            IF
              --{{{  under- and over- flow
              XWork > MaxLog  -- overflow
                Result := RInf
              XWork < MinLog  -- underflow
                SEQ
                  Result := Zero
              --}}}
              TRUE
                --{{{  exponentiate
                INT N :
                SEQ
                  N := INT ROUND (XWork * DInvLn2)
                  VAL RealN IS REAL64 ROUND N :
                  -- go into single-precision
                  VAL XWork IS REAL32 ROUND (XWork - (RealN * DLn2)) :
                  --{{{  single-precision version
                  --{{{  coefficients
                  VAL A0 IS 4.1602886268E-3(REAL32) :
                  VAL A1 IS 2.4999999950E-1(REAL32) :
                  VAL B0 IS 0.5(REAL32) :
                  VAL B1 IS 4.9987178778E-2(REAL32) :
                  --}}}
                  VAL Z   IS XWork * XWork :
                  VAL GPZ IS XWork * ((Z * A0) + A1) :
                  Result := SCALEB (B0 + (GPZ / ((B0 + (Z * B1)) - GPZ)), N + 1)
                  --}}}
                --}}}
    RESULT Result
:
