fix 32bit adjacent floats on 64bit unregisterized

upstream patch for https://ghc.haskell.org/trac/ghc/ticket/15853
This commit is contained in:
Jens Petersen 2019-03-04 14:00:41 +08:00
parent 81d7c8d8c4
commit 05e47a1520
2 changed files with 78 additions and 1 deletions

View File

@ -0,0 +1,69 @@
From 35a897782b6b0a252da7fdcf4921198ad4e1d96c Mon Sep 17 00:00:00 2001
From: James Clarke <jrtc27@jrtc27.com>
Date: Thu, 22 Nov 2018 11:55:17 -0500
Subject: [PATCH] UNREG: PprC: Add support for adjacent floats
When two 32-bit floats are adjacent for a 64-bit target, there is no
padding between them to force alignment, so we must combine their bit
representations into a single word.
Reviewers: bgamari, simonmar
Reviewed By: simonmar
Subscribers: rwbarton, carter
GHC Trac Issues: #15853
Differential Revision: https://phabricator.haskell.org/D5306
---
compiler/cmm/PprC.hs | 24 +++++++++++++++++++++++-
1 file changed, 23 insertions(+), 1 deletion(-)
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 17fef7fc97..6ebfd20291 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -512,9 +512,12 @@ pprLit1 other = pprLit other
pprStatics :: DynFlags -> [CmmStatic] -> [SDoc]
pprStatics _ [] = []
pprStatics dflags (CmmStaticLit (CmmFloat f W32) : rest)
- -- floats are padded to a word by padLitToWord, see #1852
+ -- odd numbers of floats are padded to a word by mkVirtHeapOffsetsWithPadding
| wORD_SIZE dflags == 8, CmmStaticLit (CmmInt 0 W32) : rest' <- rest
= pprLit1 (floatToWord dflags f) : pprStatics dflags rest'
+ -- adjacent floats aren't padded but combined into a single word
+ | wORD_SIZE dflags == 8, CmmStaticLit (CmmFloat g W32) : rest' <- rest
+ = pprLit1 (floatPairToWord dflags f g) : pprStatics dflags rest'
| wORD_SIZE dflags == 4
= pprLit1 (floatToWord dflags f) : pprStatics dflags rest
| otherwise
@@ -1270,6 +1273,25 @@ floatToWord dflags r
, wORDS_BIGENDIAN dflags = 32
| otherwise = 0
+floatPairToWord :: DynFlags -> Rational -> Rational -> CmmLit
+floatPairToWord dflags r1 r2
+ = runST (do
+ arr <- newArray_ ((0::Int),1)
+ writeArray arr 0 (fromRational r1)
+ writeArray arr 1 (fromRational r2)
+ arr' <- castFloatToWord32Array arr
+ w32_1 <- readArray arr' 0
+ w32_2 <- readArray arr' 1
+ return (pprWord32Pair w32_1 w32_2)
+ )
+ where pprWord32Pair w32_1 w32_2
+ | wORDS_BIGENDIAN dflags =
+ CmmInt ((shiftL i1 32) .|. i2) W64
+ | otherwise =
+ CmmInt ((shiftL i2 32) .|. i1) W64
+ where i1 = toInteger w32_1
+ i2 = toInteger w32_2
+
doubleToWords :: DynFlags -> Rational -> [CmmLit]
doubleToWords dflags r
= runST (do
--
2.19.2

View File

@ -39,7 +39,7 @@ Version: 8.4.4
# - release can only be reset if *all* library versions get bumped simultaneously
# (sometimes after a major release)
# - minor release numbers for a branch should be incremented monotonically
Release: 73%{?dist}
Release: 74%{?dist}
Summary: Glasgow Haskell Compiler
License: BSD and HaskellReport
@ -67,6 +67,9 @@ Patch12: ghc-armv7-VFPv3D16--NEON.patch
# for s390x
# https://ghc.haskell.org/trac/ghc/ticket/15689
Patch15: ghc-warnings.mk-CC-Wall.patch
# https://ghc.haskell.org/trac/ghc/ticket/15853
# https://phabricator.haskell.org/D5306 (in 8.8)
Patch17: https://gitlab.haskell.org/ghc/ghc/commit/35a897782b6b0a252da7fdcf4921198ad4e1d96c.patch
# revert 8.4.4 llvm changes
# https://ghc.haskell.org/trac/ghc/ticket/15780
@ -291,6 +294,7 @@ rm -r libffi-tarballs
%ifarch s390x
%patch15 -p1 -b .orig
%patch17 -p1 -b .orig
%endif
%ifarch armv7hl aarch64
@ -655,6 +659,10 @@ fi
%changelog
* Mon Mar 4 2019 Jens Petersen <petersen@redhat.com> - 8.4.4-74
- unregisterized: fix 32bit adjacent floats issue
(https://ghc.haskell.org/trac/ghc/ticket/15853)
* Sat Feb 16 2019 Jens Petersen <petersen@redhat.com> - 8.4.4-73
- update to GHC 8.4
- https://ghc.haskell.org/trac/ghc/blog/ghc-8.4.1-released