--
--	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 forall

--{{{  #options and #comments
#OPTION "E V"  -- no compiler libraries, no vector space
#COMMENT "T8 compiler library, V1.1 21/02/89"
#COMMENT "(c) Copyright INMOS Limited 1988"
--}}}

#PRAGMA TRANSLATE DLOGB "DLOGB%O"

#INCLUDE "realvals.inc"

--{{{  T8 and TA code the same; merged 20-June-90 SRH
REAL64 FUNCTION DLOGB (VAL REAL64 Y)

  #INCLUDE "endian.inc" -- 4-Sep-07

  REAL64 X :
  VALOF
    --{{{  VALS
    VAL DRealInf   IS #7FF00000 :
    VAL Bias       IS      1023 :
    --}}}
    VAL [2]INT Y RETYPES Y:
    [2]INT X.int RETYPES X:
    INT exp, frac :
    SEQ
      exp, frac := SHIFTLEFT (0, (Y [hi] << 1), DRealShift)
      IF
        ((Y [hi] << 1) \/ Y [lo]) = 0
          SEQ
            X.int [hi] := DRealInf \/ (MOSTNEG INT)   -- (-inf)
            X.int [lo] := 0
        exp <> DRealExp                 -- finite
          REAL64 X RETYPES X.int :
          X := REAL64 ROUND (exp - Bias)
        (frac = 0) AND (Y [lo] = 0)      -- inf
          SEQ
            X.int [hi] := DRealInf
            X.int [lo] := 0
        TRUE                            -- NaN
          X.int := Y
    RESULT X
:
--}}}


#IF (TARGET.BITS.PER.WORD = 16)

--{{{  #options and #comments
#OPTION "V"  -- no vector space
#COMMENT "T2 compiler library, V1.1 21/02/89"
#COMMENT "(c) Copyright INMOS Limited 1988"
--}}}

#PRAGMA TRANSLATE DLOGB "DLOGB%O"

#INCLUDE "realvals.inc"

--{{{  
REAL64 FUNCTION DLOGB (VAL REAL64 Y)

  -- Function version (10 Jun 87)

  REAL64 X :
  VALOF
    --{{{  VALS
    VAL Bias       IS      1023 :
    --}}}
    VAL [4]INT Y RETYPES Y:
    [4]INT X.int RETYPES X:
    INT exp, frac :
    SEQ
      exp, frac := SHIFTLEFT (0, (Y [3] << 1), DRealShift)
      IF
        (((Y[3] << 1) \/ Y[2]) \/ (Y[1] \/ Y[0])) = 0 -- Zero
          --{{{  - Inf
          SEQ
            X.int [3] := (DRealExp << 4) \/ (MOSTNEG INT)   -- (-inf)
            X.int [2] := 0
            X.int [1] := 0
            X.int [0] := 0
          --}}}
        exp <> DRealExp                         -- finite
          REAL64 X RETYPES X.int :
          X := REAL64 ROUND (exp - Bias)
        ((Y[0] \/ Y[1]) \/ (Y[2] \/ frac)) = 0  -- inf
          --{{{  + Inf
          SEQ
            X.int [3] := (DRealExp << 4)
            X.int [2] := 0
            X.int [1] := 0
            X.int [0] := 0
          --}}}
        TRUE                                    -- NaN
          X.int := Y
    RESULT X
:
--}}}

#ENDIF
