[commit: ghc] master: fix Float/Double unreg cross-compilation (c42cdb7)

git at git.haskell.org git at git.haskell.org
Thu Mar 10 21:51:48 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c42cdb7f6dcfd519d9607ac9fa53f049b2922fb8/ghc

>---------------------------------------------------------------

commit c42cdb7f6dcfd519d9607ac9fa53f049b2922fb8
Author: Sergei Trofimovich <slyfox at gentoo.org>
Date:   Thu Mar 10 21:53:16 2016 +0000

    fix Float/Double unreg cross-compilation
    
    Looking at more failures on m68k (Trac #11395)
    I've noticed the arith001 and arith012 test failures.
    (--host=x86_64-linux --target=m68k-linux).
    
    The following example was enough to reproduce a problem:
    
        v :: Float
        v = 43
        main = print v
    
    m68k binaries printed '0.0' instead of '43.0'.
    
    The bug here is how we encode Floats and Double
    as Words with the same binary representation.
    
    Floats:
      Before the patch we just coerced Float to Int.
      That breaks when we cross-compile from
      64-bit LE to 32-bit BE.
    
      The patch fixes conversion by accounting for padding.
      when we extend 32-bit value to 64-bit value (LE and BE
      do it slightly differently).
    
    Doubles:
      Before the patch Doubles were coerced to a pair of Ints
      (not correct as x86_64 can hold Double in one Int) and
      then trucated this pair of Ints to pair of Word32.
    
      The patch fixes conversion by always decomposing in
      Word32 and accounting for host endianness (newly
      introduced hostBE)  and target endianness (wORDS_BIGENDIAN).
    
    I've tested this patch on Double and Float conversion on
        --host=x86_64-linux --target=m68k-linux
    crosscompiler. It fixes 10 tests related to printing Floats
    and Doubles.
    
    Thanks to Bertram Felgenhauer who poined out this probem.
    
    Signed-off-by: Sergei Trofimovich <siarheit at google.com>
    
    Test Plan: checked some examples manually, fixed 10 tests in test suite
    
    Reviewers: int-e, austin, bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1990
    
    GHC Trac Issues: #11395


>---------------------------------------------------------------

c42cdb7f6dcfd519d9607ac9fa53f049b2922fb8
 compiler/cmm/PprC.hs | 79 ++++++++++++++++++++++++++++++++--------------------
 1 file changed, 49 insertions(+), 30 deletions(-)

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 673ac2d..4bb256a 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -504,7 +504,7 @@ pprLit1 other = pprLit other
 pprStatics :: DynFlags -> [CmmStatic] -> [SDoc]
 pprStatics _ [] = []
 pprStatics dflags (CmmStaticLit (CmmFloat f W32) : rest)
-  -- floats are padded to a word, see #1852
+  -- floats are padded to a word by padLitToWord, see #1852
   | wORD_SIZE dflags == 8, CmmStaticLit (CmmInt 0 W32) : rest' <- rest
   = pprLit1 (floatToWord dflags f) : pprStatics dflags rest'
   | wORD_SIZE dflags == 4
@@ -516,6 +516,7 @@ pprStatics dflags (CmmStaticLit (CmmFloat f W32) : rest)
           ppr' _other           = text "bad static!"
 pprStatics dflags (CmmStaticLit (CmmFloat f W64) : rest)
   = map pprLit1 (doubleToWords dflags f) ++ pprStatics dflags rest
+
 pprStatics dflags (CmmStaticLit (CmmInt i W64) : rest)
   | wordWidth dflags == W32
   = if wORDS_BIGENDIAN dflags
@@ -1176,54 +1177,72 @@ pprStringInCStyle s = doubleQuotes (text (concatMap charToC s))
 -- Initialising static objects with floating-point numbers.  We can't
 -- just emit the floating point number, because C will cast it to an int
 -- by rounding it.  We want the actual bit-representation of the float.
+--
+-- Consider a concrete C example:
+--    double d = 2.5e-10;
+--    float f  = 2.5e-10f;
+--
+--    int * i2 = &d;      printf ("i2: %08X %08X\n", i2[0], i2[1]);
+--    long long * l = &d; printf (" l: %016llX\n",   l[0]);
+--    int * i = &f;       printf (" i: %08X\n",      i[0]);
+-- Result on 64-bit LE (x86_64):
+--     i2: E826D695 3DF12E0B
+--      l: 3DF12E0BE826D695
+--      i: 2F89705F
+-- Result on 32-bit BE (m68k):
+--     i2: 3DF12E0B E826D695
+--      l: 3DF12E0BE826D695
+--      i: 2F89705F
+--
+-- The trick here is to notice that binary representation does not
+-- change much: only Word32 values get swapped on LE hosts / targets.
 
 -- This is a hack to turn the floating point numbers into ints that we
 -- can safely initialise to static locations.
 
-big_doubles :: DynFlags -> Bool
-big_doubles dflags
-  | widthInBytes W64 == 2 * wORD_SIZE dflags = True
-  | widthInBytes W64 == wORD_SIZE dflags     = False
-  | otherwise = panic "big_doubles"
-
-castFloatToIntArray :: STUArray s Int Float -> ST s (STUArray s Int Int)
-castFloatToIntArray = U.castSTUArray
+castFloatToWord32Array :: STUArray s Int Float -> ST s (STUArray s Int Word32)
+castFloatToWord32Array = U.castSTUArray
 
-castDoubleToIntArray :: STUArray s Int Double -> ST s (STUArray s Int Int)
-castDoubleToIntArray = U.castSTUArray
+castDoubleToWord64Array :: STUArray s Int Double -> ST s (STUArray s Int Word64)
+castDoubleToWord64Array = U.castSTUArray
 
--- floats are always 1 word
 floatToWord :: DynFlags -> Rational -> CmmLit
 floatToWord dflags r
   = runST (do
         arr <- newArray_ ((0::Int),0)
         writeArray arr 0 (fromRational r)
-        arr' <- castFloatToIntArray arr
-        i <- readArray arr' 0
-        return (CmmInt (toInteger i) (wordWidth dflags))
+        arr' <- castFloatToWord32Array arr
+        w32 <- readArray arr' 0
+        return (CmmInt (toInteger w32 `shiftL` wo) (wordWidth dflags))
     )
+    where wo | wordWidth dflags == W64
+             , wORDS_BIGENDIAN dflags    = 32
+             | otherwise                 = 0
 
 doubleToWords :: DynFlags -> Rational -> [CmmLit]
 doubleToWords dflags r
-  | big_doubles dflags                  -- doubles are 2 words
   = runST (do
         arr <- newArray_ ((0::Int),1)
         writeArray arr 0 (fromRational r)
-        arr' <- castDoubleToIntArray arr
-        i1 <- readArray arr' 0
-        i2 <- readArray arr' 1
-        return [ CmmInt (toInteger i1) (wordWidth dflags)
-               , CmmInt (toInteger i2) (wordWidth dflags)
-               ]
-    )
-  | otherwise                           -- doubles are 1 word
-  = runST (do
-        arr <- newArray_ ((0::Int),0)
-        writeArray arr 0 (fromRational r)
-        arr' <- castDoubleToIntArray arr
-        i <- readArray arr' 0
-        return [ CmmInt (toInteger i) (wordWidth dflags) ]
+        arr' <- castDoubleToWord64Array arr
+        w64 <- readArray arr' 0
+        return (pprWord64 w64)
     )
+    where targetWidth = wordWidth dflags
+          targetBE    = wORDS_BIGENDIAN dflags
+          pprWord64 w64
+              | targetWidth == W64 =
+                  [ CmmInt (toInteger w64) targetWidth ]
+              | targetWidth == W32 =
+                  [ CmmInt (toInteger targetW1) targetWidth
+                  , CmmInt (toInteger targetW2) targetWidth
+                  ]
+              | otherwise = panic "doubleToWords.pprWord64"
+              where (targetW1, targetW2)
+                        | targetBE  = (wHi, wLo)
+                        | otherwise = (wLo, wHi)
+                    wHi = w64 `shiftR` 32
+                    wLo = w64 .&. 0xFFFFffff
 
 -- ---------------------------------------------------------------------------
 -- Utils



More information about the ghc-commits mailing list