Commit aa206346 authored by Erik de Castro Lopo's avatar Erik de Castro Lopo Committed by Ben Gamari
Browse files

base: Implement bit casts between word and float types

Test Plan: Test on x86 and x86_64

Reviewers: duncan, trofi, simonmar, tibbe, hvr, austin, rwbarton,
bgamari

Reviewed By: duncan

Subscribers: Phyx, DemiMarie, rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3358
parent bb3712bf
......@@ -2830,8 +2830,9 @@ pseudoop "unsafeCoerce#"
* Casting {\tt Any} back to the real type
* Casting an unboxed type to another unboxed type of the same size
(but not coercions between floating-point and integral types)
* Casting an unboxed type to another unboxed type of the same size.
(Casting between floating-point and integral types does not work.
See the {\tt GHC.Float} module for functions to do work.)
* Casting between two types that have the same runtime representation. One case is when
the two types differ only in "phantom" type parameters, for example
......
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP
, GHCForeignImportPrim
, NoImplicitPrelude
, MagicHash
, UnboxedTuples
, UnliftedFFITypes
#-}
{-# LANGUAGE CApiFFI #-}
-- We believe we could deorphan this module, by moving lots of things
......@@ -21,11 +23,13 @@
-- Stability : internal
-- Portability : non-portable (GHC Extensions)
--
-- The types 'Float' and 'Double', and the classes 'Floating' and 'RealFloat'.
-- The types 'Float' and 'Double', the classes 'Floating' and 'RealFloat' and
-- casting between Word32 and Float and Word64 and Double.
--
-----------------------------------------------------------------------------
#include "ieee-flpt.h"
#include "MachDeps.h"
module GHC.Float
( module GHC.Float
......@@ -46,6 +50,7 @@ import GHC.Enum
import GHC.Show
import GHC.Num
import GHC.Real
import GHC.Word
import GHC.Arr
import GHC.Float.RealFracMethods
import GHC.Float.ConversionUtils
......@@ -1253,3 +1258,87 @@ exponents returned by decodeFloat.
-}
clamp :: Int -> Int -> Int
clamp bd k = max (-bd) (min bd k)
{-
Note [Casting from integral to floating point types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
To implement something like `reinterpret_cast` from C++ to go from a
floating-point type to an integral type one might niavely think that the
following should work:
cast :: Float -> Word32
cast (F# f#) = W32# (unsafeCoerce# f#)
Unfortunately that is not the case, because all the `unsafeCoerce#` does is tell
the compiler that the types have changed. When one does the above cast and
tries to operate on the resulting `Word32` the code generator will generate code
that performs an integer/word operation on a floating-point register, which
results in a compile error.
The correct way of implementing `reinterpret_cast` to implement a primpop, but
that requires a unique implementation for all supported archetectures. The next
best solution is to write the value from the source register to memory and then
read it from memory into the destination register and the best way to do that
is using CMM.
-}
-- | @'castWord32ToFloat' w@ does a bit-for-bit copy from an integral value
-- to a floating-point value.
--
-- @since 4.10.0.0
{-# INLINE castWord32ToFloat #-}
castWord32ToFloat :: Word32 -> Float
castWord32ToFloat (W32# w#) = F# (stgWord32ToFloat w#)
foreign import prim "stg_word32ToFloatzh"
stgWord32ToFloat :: Word# -> Float#
-- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value
-- to an integral value.
--
-- @since 4.10.0.0
{-# INLINE castFloatToWord32 #-}
castFloatToWord32 :: Float -> Word32
castFloatToWord32 (F# f#) = W32# (stgFloatToWord32 f#)
foreign import prim "stg_floatToWord32zh"
stgFloatToWord32 :: Float# -> Word#
-- | @'castWord64ToDouble' w@ does a bit-for-bit copy from an integral value
-- to a floating-point value.
--
-- @since 4.10.0.0
{-# INLINE castWord64ToDouble #-}
castWord64ToDouble :: Word64 -> Double
castWord64ToDouble (W64# w) = D# (stgWord64ToDouble w)
foreign import prim "stg_word64ToDoublezh"
#if WORD_SIZE_IN_BITS == 64
stgWord64ToDouble :: Word# -> Double#
#else
stgWord64ToDouble :: Word64# -> Double#
#endif
-- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value
-- to an integral value.
--
-- @since 4.10.0.0
{-# INLINE castDoubleToWord64 #-}
castDoubleToWord64 :: Double -> Word64
castDoubleToWord64 (D# d#) = W64# (stgDoubleToWord64 d#)
foreign import prim "stg_doubleToWord64zh"
#if WORD_SIZE_IN_BITS == 64
stgDoubleToWord64 :: Double# -> Word#
#else
stgDoubleToWord64 :: Double# -> Word64#
#endif
#include "Cmm.h"
#include "MachDeps.h"
#if WORD_SIZE_IN_BITS == 64
#define DOUBLE_SIZE_WDS 1
#else
#define DOUBLE_SIZE_WDS 2
#endif
stg_word64ToDoublezh(I64 w)
{
D_ d;
P_ ptr;
STK_CHK_GEN_N (DOUBLE_SIZE_WDS);
reserve DOUBLE_SIZE_WDS = ptr {
I64[ptr] = w;
d = D_[ptr];
}
return (d);
}
stg_doubleToWord64zh(D_ d)
{
I64 w;
P_ ptr;
STK_CHK_GEN_N (DOUBLE_SIZE_WDS);
reserve DOUBLE_SIZE_WDS = ptr {
D_[ptr] = d;
w = I64[ptr];
}
return (w);
}
stg_word32ToFloatzh(W_ w)
{
F_ f;
P_ ptr;
STK_CHK_GEN_N (1);
reserve 1 = ptr {
I32[ptr] = %lobits32(w);
f = F_[ptr];
}
return (f);
}
stg_floatToWord32zh(F_ f)
{
W_ w;
P_ ptr;
STK_CHK_GEN_N (1);
reserve 1 = ptr {
F_[ptr] = f;
w = TO_W_(I32[ptr]);
}
return (w);
}
......@@ -155,4 +155,6 @@ test('T9577', [ unless(arch('x86_64') or arch('i386'),skip),
when(opsys('darwin'), expect_broken(12937)),
when(opsys('mingw32'), expect_broken(12965)),
only_ways(['normal']) ], compile_and_run, [''])
test('T13425', normal, compile_and_run, ['-O'])
test('castFloatWord', normal, compile_and_run, ['-dcmm-lint'])
import Data.Bits
import GHC.Float
import GHC.Word
import Numeric
main :: IO ()
main = do
putStrLn "Float"
mapM_ print floats
putStrLn "\nDouble"
mapM_ print doubles
putStrLn "\nWord32"
mapM_ (printHex32 . castFloatToWord32) floats
putStrLn "\nWord64"
mapM_ (printHex64 . castDoubleToWord64) doubles
putStrLn "Done!"
floats :: [Float]
floats = map castWord32ToFloat $ 0 : map (2^) [ 0 .. 31 ]
doubles :: [Double]
doubles = map castWord64ToDouble $ 0 : map (2^) [ 0 .. 63 ]
printHex32 :: Word32 -> IO ()
printHex32 w = putStrLn $ "0x" ++ showHex (0xffffffff .&. w) ""
printHex64 :: Word64 -> IO ()
printHex64 w = putStrLn $ "0x" ++ showHex w ""
Float
0.0
1.0e-45
3.0e-45
6.0e-45
1.1e-44
2.2e-44
4.5e-44
9.0e-44
1.8e-43
3.59e-43
7.17e-43
1.435e-42
2.87e-42
5.74e-42
1.148e-41
2.2959e-41
4.5918e-41
9.1835e-41
1.83671e-40
3.67342e-40
7.34684e-40
1.469368e-39
2.938736e-39
5.877472e-39
1.1754944e-38
2.3509887e-38
9.403955e-38
1.5046328e-36
3.85186e-34
2.524355e-29
1.0842022e-19
2.0
-0.0
Double
0.0
5.0e-324
1.0e-323
2.0e-323
4.0e-323
8.0e-323
1.6e-322
3.16e-322
6.3e-322
1.265e-321
2.53e-321
5.06e-321
1.012e-320
2.0237e-320
4.0474e-320
8.095e-320
1.61895e-319
3.2379e-319
6.4758e-319
1.295163e-318
2.590327e-318
5.180654e-318
1.036131e-317
2.0722615e-317
4.144523e-317
8.289046e-317
1.6578092e-316
3.3156184e-316
6.63123685e-316
1.32624737e-315
2.65249474e-315
5.304989477e-315
1.0609978955e-314
2.121995791e-314
4.243991582e-314
8.487983164e-314
1.69759663277e-313
3.39519326554e-313
6.7903865311e-313
1.35807730622e-312
2.716154612436e-312
5.43230922487e-312
1.086461844974e-311
2.1729236899484e-311
4.345847379897e-311
8.691694759794e-311
1.73833895195875e-310
3.4766779039175e-310
6.953355807835e-310
1.390671161567e-309
2.781342323134e-309
5.562684646268003e-309
1.1125369292536007e-308
2.2250738585072014e-308
4.450147717014403e-308
1.7800590868057611e-307
2.848094538889218e-306
7.291122019556398e-304
4.778309726736481e-299
2.0522684006491881e-289
3.785766995733679e-270
1.2882297539194267e-231
1.4916681462400413e-154
2.0
-0.0
Word32
0x0
0x1
0x2
0x4
0x8
0x10
0x20
0x40
0x80
0x100
0x200
0x400
0x800
0x1000
0x2000
0x4000
0x8000
0x10000
0x20000
0x40000
0x80000
0x100000
0x200000
0x400000
0x800000
0x1000000
0x2000000
0x4000000
0x8000000
0x10000000
0x20000000
0x40000000
0x80000000
Word64
0x0
0x1
0x2
0x4
0x8
0x10
0x20
0x40
0x80
0x100
0x200
0x400
0x800
0x1000
0x2000
0x4000
0x8000
0x10000
0x20000
0x40000
0x80000
0x100000
0x200000
0x400000
0x800000
0x1000000
0x2000000
0x4000000
0x8000000
0x10000000
0x20000000
0x40000000
0x80000000
0x100000000
0x200000000
0x400000000
0x800000000
0x1000000000
0x2000000000
0x4000000000
0x8000000000
0x10000000000
0x20000000000
0x40000000000
0x80000000000
0x100000000000
0x200000000000
0x400000000000
0x800000000000
0x1000000000000
0x2000000000000
0x4000000000000
0x8000000000000
0x10000000000000
0x20000000000000
0x40000000000000
0x80000000000000
0x100000000000000
0x200000000000000
0x400000000000000
0x800000000000000
0x1000000000000000
0x2000000000000000
0x4000000000000000
0x8000000000000000
Done!
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment