{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.LongDouble.X87_128
-- Copyright   :  (C) 2018 Claude Heiland-Allen
-- License     :  BSD3
-- Maintainer  :  Claude Heiland-Allen <claude@mathr.co.uk>
-- Stability   :  experimental
-- Portability :  non-portable (assumes x87 with sizeof(long double) == 16)
--
-- This module contains a LongDouble type that can be used if you need that
-- extra precision or range from the x87 FPU extended precision type.
-- It has 15bit signed exponent (compared to 11bit signed exponent for Double)
-- and 64bit mantissa (compared to 53bit mantissa for Double).
--
-- Performance is likely to be poor, as the instances are implemented using
-- FFI with Ptr LongDouble, copying to and from memory around each operation.
-- If you need to bind to functions taking/returning long double you need to
-- write wrapper functions expecting pointers to long double instead, as GHC
-- does not expose a CLDouble FFI type.
-- See <https://ghc.haskell.org/trac/ghc/ticket/3353>.
--
-- Most code should import Numeric.LongDouble instead, unless a specific ABI
-- is needed.  This module is for x87 with sizeof(long double) == 16.
module Numeric.LongDouble.X87_128
  ( 
  -- * long double data type
    LongDouble(..)
  -- * RealFrac alternatives
  , truncate'
  , round'
  , ceiling'
  , floor'
  -- * Conversions
  , fromDouble
  , toDouble
  , fromInt
  , toInt
  ) where

import Data.Bits (bit, testBit, (.&.), shiftL, shiftR)
import Data.Ratio ((%), numerator, denominator)
import Data.Word (Word64)
import Foreign (Ptr, castPtr, with, alloca)
import Foreign.C.Types (CIntMax(..), CInt(..), CDouble(..))
import Foreign.Storable (Storable(..))
import Numeric (showFloat, readFloat, readSigned)
import System.IO.Unsafe (unsafePerformIO)
import GHC.Exts (Int(..))
import GHC.Integer.Logarithms (integerLog2#)

-- | The long double type on x86_64: 80bits of x87 FPU data in 128bits of space.
data LongDouble = LD !Word64 !Word64

instance Storable LongDouble where
  sizeOf :: LongDouble -> Int
sizeOf _ = 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a. Storable a => a -> Int
sizeOf (0 :: Word64)
  alignment :: LongDouble -> Int
alignment _ = Word64 -> Int
forall a. Storable a => a -> Int
alignment (0 :: Word64)
  peek :: Ptr LongDouble -> IO LongDouble
peek p :: Ptr LongDouble
p = do
    let q :: Ptr Word64
        q :: Ptr Word64
q = Ptr LongDouble -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr LongDouble
p
    Word64
a <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
q 0
    Word64
b <- Ptr Word64 -> Int -> IO Word64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word64
q 1
    LongDouble -> IO LongDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (LongDouble -> IO LongDouble) -> LongDouble -> IO LongDouble
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> LongDouble
LD Word64
a Word64
b
  poke :: Ptr LongDouble -> LongDouble -> IO ()
poke p :: Ptr LongDouble
p (LD a :: Word64
a b :: Word64
b) = do
    let q :: Ptr Word64
        q :: Ptr Word64
q = Ptr LongDouble -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr LongDouble
p
    Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
q 0 Word64
a
    Ptr Word64 -> Int -> Word64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word64
q 1 Word64
b

#include "X87.hs"