Hello community,
here is the log from the commit of package ghc for openSUSE:Factory checked in
at 2017-01-18 21:43:49
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc (Old)
and /work/SRC/openSUSE:Factory/.ghc.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc"
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc/ghc.changes 2016-10-19 13:14:34.000000000
+0200
+++ /work/SRC/openSUSE:Factory/.ghc.new/ghc.changes 2017-01-18
21:43:51.571161516 +0100
@@ -1,0 +2,6 @@
+Fri Dec 16 08:45:26 UTC 2016 - peter.tromm...@ohm-hochschule.de
+
+- add D2844.patch
+ * fix issues with parallel builds
+
+-------------------------------------------------------------------
New:
----
D2844.patch
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc.spec ++++++
--- /var/tmp/diff_new_pack.XCiEkX/_old 2017-01-18 21:43:52.463035366 +0100
+++ /var/tmp/diff_new_pack.XCiEkX/_new 2017-01-18 21:43:52.471034235 +0100
@@ -67,6 +67,8 @@
Requires: ghc-libraries = %{version}-%{release}
Source:
http://haskell.org/ghc/dist/%{version}/%{name}-%{version}-src.tar.xz
Source1: ghc-rpmlintrc
+# PATCH-FIX-UPSTREAM D2844.patch peter.tromm...@ohm-hochschule.de -- Use full
range of machine word in UniqSupply. Fixes issues with parallel builds.
Backport of upstream patch. See Haskell Trac #12899.
+Patch1: D2844.patch
# PATCH-FIX-UPSTREAM D2495.patch peter.tromm...@ohm-hochschule.de -- Add
missing memory barrier on mutable variables. See
https://ghc.haskell.org/trac/ghc/ticket/12469 for details. Backport of upstream
fix for ghc 8.0.2.
Patch27: D2495.patch
# PATCH-FIX_UPSTREAM 0001-StgCmmPrim-Add-missing-write-barrier.patch
peter.tromm...@ohm-hochschule.de -- Add missing write barrier on mutable arrays.
@@ -161,6 +163,7 @@
%prep
%setup -q
+%patch1 -p1
%patch27 -p1
%patch28 -p1
%patch29 -p1
++++++ D2844.patch ++++++
Index: ghc-8.0.1/compiler/Unique.h
===================================================================
--- /dev/null
+++ ghc-8.0.1/compiler/Unique.h
@@ -0,0 +1,3 @@
+#include "../includes/MachDeps.h"
+
+#define UNIQUE_BITS (WORD_SIZE_IN_BITS - 8)
Index: ghc-8.0.1/compiler/basicTypes/UniqSupply.hs
===================================================================
--- ghc-8.0.1.orig/compiler/basicTypes/UniqSupply.hs
+++ ghc-8.0.1/compiler/basicTypes/UniqSupply.hs
@@ -3,7 +3,7 @@
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}
-{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE CPP, UnboxedTuples #-}
module UniqSupply (
-- * Main data type
@@ -38,6 +38,8 @@ import Control.Monad
import Data.Bits
import Data.Char
+#include "Unique.h"
+
{-
************************************************************************
* *
@@ -73,7 +75,7 @@ takeUniqFromSupply :: UniqSupply -> (Uni
-- ^ Obtain the 'Unique' from this particular 'UniqSupply', and a new supply
mkSplitUniqSupply c
- = case ord c `shiftL` 24 of
+ = case ord c `shiftL` UNIQUE_BITS of
mask -> let
-- here comes THE MAGIC:
Index: ghc-8.0.1/compiler/basicTypes/Unique.hs
===================================================================
--- ghc-8.0.1.orig/compiler/basicTypes/Unique.hs
+++ ghc-8.0.1/compiler/basicTypes/Unique.hs
@@ -8,6 +8,7 @@
comparison key in the compiler.
If there is any single operation that needs to be fast, it is @Unique@
+
comparison. Unsurprisingly, there is quite a bit of huff-and-puff
directed to that end.
@@ -62,6 +63,7 @@ module Unique (
) where
#include "HsVersions.h"
+#include "Unique.h"
import BasicTypes
import FastString
@@ -123,6 +125,11 @@ deriveUnique (MkUnique i) delta = mkUniq
-- newTagUnique changes the "domain" of a unique to a different char
newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
+-- | How many bits are devoted to the unique index (as opposed to the class
+-- character).
+uniqueMask :: Int
+uniqueMask = (1 `shiftL` UNIQUE_BITS) - 1
+
-- pop the Char in the top 8 bits of the Unique(Supply)
-- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
@@ -135,15 +142,15 @@ mkUnique :: Char -> Int -> Unique
mkUnique c i
= MkUnique (tag .|. bits)
where
- tag = ord c `shiftL` 24
- bits = i .&. 16777215 {-``0x00ffffff''-}
+ tag = ord c `shiftL` UNIQUE_BITS
+ bits = i .&. uniqueMask
unpkUnique (MkUnique u)
= let
-- as long as the Char may have its eighth bit set, we
-- really do need the logical right-shift here!
- tag = chr (u `shiftR` 24)
- i = u .&. 16777215 {-``0x00ffffff''-}
+ tag = chr (u `shiftR` UNIQUE_BITS)
+ i = u .&. uniqueMask
in
(tag, i)
Index: ghc-8.0.1/compiler/cbits/genSym.c
===================================================================
--- ghc-8.0.1.orig/compiler/cbits/genSym.c
+++ ghc-8.0.1/compiler/cbits/genSym.c
@@ -1,18 +1,35 @@
-
+#include <assert.h>
#include "Rts.h"
+#include "Unique.h"
static HsInt GenSymCounter = 0;
static HsInt GenSymInc = 1;
+#define UNIQUE_MASK ((1ULL << UNIQUE_BITS) - 1)
+
+STATIC_INLINE void checkUniqueRange(HsInt u STG_UNUSED) {
+#if DEBUG
+ // Uh oh! We will overflow next time a unique is requested.
+ assert(h != UNIQUE_MASK);
+#endif
+}
+
HsInt genSym(void) {
#if defined(THREADED_RTS)
if (n_capabilities == 1) {
- return GenSymCounter = (GenSymCounter + GenSymInc) & 0xFFFFFF;
+ GenSymCounter = (GenSymCounter + GenSymInc) & UNIQUE_MASK;
+ checkUniqueRange(GenSymCounter);
+ return GenSymCounter;
} else {
- return atomic_inc((StgWord *)&GenSymCounter, GenSymInc) & 0xFFFFFF;
+ HsInt n = atomic_inc((StgWord *)&GenSymCounter, GenSymInc)
+ & UNIQUE_MASK;
+ checkUniqueRange(n);
+ return n;
}
#else
- return GenSymCounter = (GenSymCounter + GenSymInc) & 0xFFFFFF;
+ GenSymCounter = (GenSymCounter + GenSymInc) & UNIQUE_MASK;
+ checkUniqueRange(GenSymCounter);
+ return GenSymCounter;
#endif
}
