PPC and X86: Portable printing of IEEE floats

GNU as and the AIX assembler support floating point literals.
SPARC seems to have support too but I cannot test on SPARC.
Curiously, `doubleToBytes` is also used in the LLVM backend.

To avoid endianness issues when cross-compiling float and double literals
are printed as C-style floating point values. The assembler then takes
care of memory layout and endianness.

This was brought up in #18431 by @hsyl20.

4 files changed, 34 insertions, 43 deletions

diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index 259159aa44..601714cf84 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -237,9 +237,8 @@ pprImm (ImmInteger i) = integer i
 pprImm (ImmCLbl l)    = ppr l
 pprImm (ImmIndex l i) = ppr l <> char '+' <> int i
 pprImm (ImmLit s)     = s
-
-pprImm (ImmFloat _)  = text "naughty float immediate"
-pprImm (ImmDouble _) = text "naughty double immediate"
+pprImm (ImmFloat f)   = float $ fromRational f
+pprImm (ImmDouble d)  = double $ fromRational d
 
 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
@@ -337,13 +336,8 @@ pprDataItem platform lit
                     <> int (fromIntegral (fromIntegral x :: Word32))]
 
 
-        ppr_item FF32 (CmmFloat r _)
-           = let bs = floatToBytes (fromRational r)
-             in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
-
-        ppr_item FF64 (CmmFloat r _)
-           = let bs = doubleToBytes (fromRational r)
-             in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
+        ppr_item FF32 _ = [text "\t.float\t" <> pprImm imm]
+        ppr_item FF64 _ = [text "\t.double\t" <> pprImm imm]
 
         ppr_item _ _
                 = panic "PPC.Ppr.pprDataItem: no match"
diff --git a/compiler/GHC/CmmToAsm/Ppr.hs b/compiler/GHC/CmmToAsm/Ppr.hs
index cec114e499..085c2d8867 100644
--- a/compiler/GHC/CmmToAsm/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/Ppr.hs
@@ -9,9 +9,6 @@
 -----------------------------------------------------------------------------
 
 module GHC.CmmToAsm.Ppr (
-        castFloatToWord8Array,
-        castDoubleToWord8Array,
-        floatToBytes,
         doubleToBytes,
         pprASCII,
         pprString,
@@ -44,13 +41,13 @@ import qualified Data.ByteString as BS
 import GHC.Exts
 import GHC.Word
 
-
-
 -- -----------------------------------------------------------------------------
 -- Converting floating-point literals to integrals for printing
 
-castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
-castFloatToWord8Array = U.castSTUArray
+-- ToDo: this code is currently shared between SPARC and LLVM.
+--       Similar functions for (single precision) floats are
+--       present in the SPARC backend only. We need to fix both
+--       LLVM and SPARC.
 
 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
 castDoubleToWord8Array = U.castSTUArray
@@ -63,19 +60,6 @@ castDoubleToWord8Array = U.castSTUArray
 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
 -- could they be merged?
 
-floatToBytes :: Float -> [Int]
-floatToBytes f
-   = runST (do
-        arr <- newArray_ ((0::Int),3)
-        writeArray arr 0 f
-        arr <- castFloatToWord8Array arr
-        i0 <- readArray arr 0
-        i1 <- readArray arr 1
-        i2 <- readArray arr 2
-        i3 <- readArray arr 3
-        return (map fromIntegral [i0,i1,i2,i3])
-     )
-
 doubleToBytes :: Double -> [Int]
 doubleToBytes d
    = runST (do
diff --git a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
index 9d6acd16f8..1c4e9f51b7 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
@@ -25,6 +25,12 @@ where
 
 import GHC.Prelude
 
+import Data.Word
+import qualified Data.Array.Unsafe as U ( castSTUArray )
+import Data.Array.ST
+
+import Control.Monad.ST
+
 import GHC.CmmToAsm.SPARC.Regs
 import GHC.CmmToAsm.SPARC.Instr
 import GHC.CmmToAsm.SPARC.Cond
@@ -369,6 +375,22 @@ pprDataItem platform lit
         ppr_item II64  _        = [text "\t.quad\t" <> pprImm imm]
         ppr_item _ _            = panic "SPARC.Ppr.pprDataItem: no match"
 
+floatToBytes :: Float -> [Int]
+floatToBytes f
+   = runST (do
+        arr <- newArray_ ((0::Int),3)
+        writeArray arr 0 f
+        arr <- castFloatToWord8Array arr
+        i0 <- readArray arr 0
+        i1 <- readArray arr 1
+        i2 <- readArray arr 2
+        i3 <- readArray arr 3
+        return (map fromIntegral [i0,i1,i2,i3])
+     )
+
+castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
+castFloatToWord8Array = U.castSTUArray
+
 
 -- | Pretty print an instruction.
 pprInstr :: Instr -> SDoc
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index b5fb852512..22a8e66f2f 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -423,9 +423,8 @@ pprImm (ImmInteger i) = integer i
 pprImm (ImmCLbl l)    = ppr l
 pprImm (ImmIndex l i) = ppr l <> char '+' <> int i
 pprImm (ImmLit s)     = s
-
-pprImm (ImmFloat _)  = text "naughty float immediate"
-pprImm (ImmDouble _) = text "naughty double immediate"
+pprImm (ImmFloat f)   = float $ fromRational f
+pprImm (ImmDouble d)  = double $ fromRational d
 
 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
@@ -514,13 +513,8 @@ pprDataItem config lit
         ppr_item II16  _ = [text "\t.word\t" <> pprImm imm]
         ppr_item II32  _ = [text "\t.long\t" <> pprImm imm]
 
-        ppr_item FF32  (CmmFloat r _)
-           = let bs = floatToBytes (fromRational r)
-             in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
-
-        ppr_item FF64 (CmmFloat r _)
-           = let bs = doubleToBytes (fromRational r)
-             in  map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
+        ppr_item FF32 _ = [text "\t.float\t" <> pprImm imm]
+        ppr_item FF64 _ = [text "\t.double\t" <> pprImm imm]
 
         ppr_item II64 _
             = case platformOS platform of
@@ -558,9 +552,6 @@ pprDataItem config lit
                   _ ->
                       [text "\t.quad\t" <> pprImm imm]
 
-        ppr_item _ _
-                = panic "X86.Ppr.ppr_item: no match"
-
 
 asmComment :: SDoc -> SDoc
 asmComment c = whenPprDebug $ text "# " <> c