[Git][ghc/ghc][master] PPC and X86: Portable printing of IEEE floats
Marge Bot
gitlab at gitlab.haskell.org
Wed Aug 26 14:42:36 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00
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 changed files:
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/Ppr.hs
- compiler/GHC/CmmToAsm/SPARC/Ppr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
Changes:
=====================================
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"
=====================================
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
=====================================
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
=====================================
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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcb10b6c69e388d8c6e777baf39920e2cc694501
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcb10b6c69e388d8c6e777baf39920e2cc694501
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200826/f7f58c75/attachment-0001.html>
More information about the ghc-commits
mailing list