Accepting request 451807 from devel:languages:haskell
Fix boo#1020909 OBS-URL: https://build.opensuse.org/request/show/451807 OBS-URL: https://build.opensuse.org/package/show/openSUSE:Factory/ghc?expand=0&rev=52
This commit is contained in:
Git OBS Bridge
commit
11ba3fe34e
135
D2844.patch
135
D2844.patch
@ -1,135 +0,0 @@
|
||||
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
|
||||
}
|
||||
|
||||
@ -1,3 +1,10 @@
|
||||
-------------------------------------------------------------------
|
||||
Fri Jan 20 08:39:45 UTC 2017 - peter.trommler@ohm-hochschule.de
|
||||
|
||||
- drop D2844.patch
|
||||
* the patch causes more issues with parallel builds
|
||||
- fixes boo#1020909
|
||||
|
||||
-------------------------------------------------------------------
|
||||
Fri Dec 16 08:45:26 UTC 2016 - peter.trommler@ohm-hochschule.de
|
||||
|
||||
|
||||
5
ghc.spec
5
ghc.spec
@ -1,7 +1,7 @@
|
||||
#
|
||||
# spec file for package ghc
|
||||
#
|
||||
# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
|
||||
# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
|
||||
#
|
||||
# All modifications and additions to the file contributed by third parties
|
||||
# remain the property of their copyright owners, unless otherwise agreed
|
||||
@ -67,8 +67,6 @@ Requires: ghc-ghc-devel = %{version}-%{release}
|
||||
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.trommler@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.trommler@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.trommler@ohm-hochschule.de -- Add missing write barrier on mutable arrays.
|
||||
@ -163,7 +161,6 @@ except the ghc library, which is installed by the toplevel ghc metapackage.
|
||||
|
||||
%prep
|
||||
%setup -q
|
||||
%patch1 -p1
|
||||
%patch27 -p1
|
||||
%patch28 -p1
|
||||
%patch29 -p1
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user