Commit 158d2a91 authored by niteria's avatar niteria Committed by Ben Gamari

Make it possible to have different UniqSupply strategies

To get reproducible/deterministic builds, the way that the Uniques are
assigned shouldn't matter. This allows to test for that.

It add 2 new flags:

* `-dinitial-unique`
* `-dunique-increment`

And by varying these you can get interesting effects:

* `-dinitial-unique=0 -dunique-increment 1` - current sequential
  UniqSupply

* `-dinitial-unique=16777215 -dunique-increment -1` - UniqSupply that
  generates in decreasing order

* `-dinitial-unique=1 -dunique-increment PRIME` - where PRIME big enough
  to overflow often - nonsequential order

I haven't proven the usefullness of the last one yet and it's the reason
why we have to mask the bits with `0xFFFFFF` in `genSym`, so I can
remove it if it becomes contentious.

Test Plan: validate on harbormaster

Reviewers: simonmar, austin, ezyang, bgamari

Reviewed By: austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1360

GHC Trac Issues: #4012
parent d1d8704c
...@@ -22,6 +22,9 @@ module UniqSupply ( ...@@ -22,6 +22,9 @@ module UniqSupply (
-- ** Operations on the monad -- ** Operations on the monad
initUs, initUs_, initUs, initUs_,
lazyThenUs, lazyMapUs, lazyThenUs, lazyMapUs,
-- * Set supply strategy
initUniqSupply
) where ) where
import Unique import Unique
...@@ -85,6 +88,7 @@ mkSplitUniqSupply c ...@@ -85,6 +88,7 @@ mkSplitUniqSupply c
mk_supply mk_supply
foreign import ccall unsafe "genSym" genSym :: IO Int foreign import ccall unsafe "genSym" genSym :: IO Int
foreign import ccall unsafe "initGenSym" initUniqSupply :: Int -> Int -> IO ()
splitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2) splitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2)
listSplitUniqSupply (MkSplitUniqSupply _ s1 s2) = s1 : listSplitUniqSupply s2 listSplitUniqSupply (MkSplitUniqSupply _ s1 s2) = s1 : listSplitUniqSupply s2
......
...@@ -2,16 +2,21 @@ ...@@ -2,16 +2,21 @@
#include "Rts.h" #include "Rts.h"
static HsInt GenSymCounter = 0; static HsInt GenSymCounter = 0;
static HsInt GenSymInc = 1;
HsInt genSym(void) { HsInt genSym(void) {
#if defined(THREADED_RTS) #if defined(THREADED_RTS)
if (n_capabilities == 1) { if (n_capabilities == 1) {
return GenSymCounter++; return GenSymCounter = (GenSymCounter + GenSymInc) & 0xFFFFFF;
} else { } else {
return atomic_inc((StgWord *)&GenSymCounter, 1); return atomic_inc((StgWord *)&GenSymCounter, GenSymInc) & 0xFFFFFF;
} }
#else #else
return GenSymCounter++; return GenSymCounter = (GenSymCounter + GenSymInc) & 0xFFFFFF;
#endif #endif
} }
void initGenSym(HsInt NewGenSymCounter, HsInt NewGenSymInc) {
GenSymCounter = NewGenSymCounter;
GenSymInc = NewGenSymInc;
}
...@@ -900,7 +900,11 @@ data DynFlags = DynFlags { ...@@ -900,7 +900,11 @@ data DynFlags = DynFlags {
maxInlineMemsetInsns :: Int, maxInlineMemsetInsns :: Int,
-- | Reverse the order of error messages in GHC/GHCi -- | Reverse the order of error messages in GHC/GHCi
reverseErrors :: Bool reverseErrors :: Bool,
-- | Unique supply configuration for testing build determinism
initialUnique :: Int,
uniqueIncrement :: Int
} }
class HasDynFlags m where class HasDynFlags m where
...@@ -1561,9 +1565,7 @@ defaultDynFlags mySettings = ...@@ -1561,9 +1565,7 @@ defaultDynFlags mySettings =
maxInlineAllocSize = 128, maxInlineAllocSize = 128,
maxInlineMemcpyInsns = 32, maxInlineMemcpyInsns = 32,
maxInlineMemsetInsns = 32, maxInlineMemsetInsns = 32
reverseErrors = False
} }
defaultWays :: Settings -> [Way] defaultWays :: Settings -> [Way]
...@@ -2402,10 +2404,6 @@ dynamic_flags = [ ...@@ -2402,10 +2404,6 @@ dynamic_flags = [
deprecate "Use -fno-force-recomp instead")) deprecate "Use -fno-force-recomp instead"))
, defGhcFlag "no-recomp" (NoArg (do setGeneralFlag Opt_ForceRecomp , defGhcFlag "no-recomp" (NoArg (do setGeneralFlag Opt_ForceRecomp
deprecate "Use -fforce-recomp instead")) deprecate "Use -fforce-recomp instead"))
, defFlag "freverse-errors"
(noArg (\d -> d {reverseErrors = True} ))
, defFlag "fno-reverse-errors"
(noArg (\d -> d {reverseErrors = False} ))
------ HsCpp opts --------------------------------------------------- ------ HsCpp opts ---------------------------------------------------
, defFlag "D" (AnySuffix (upd . addOptP)) , defFlag "D" (AnySuffix (upd . addOptP))
......
...@@ -429,3 +429,35 @@ Checking for consistency ...@@ -429,3 +429,35 @@ Checking for consistency
single: -dcmm-lint single: -dcmm-lint
Ditto for C-- level. Ditto for C-- level.
.. _checking-determinism:
Checking for determinism
------------------------
.. index::
single: deterministic builds
``-dinitial-unique=⟨s⟩``
.. index::
single: -dinitial-unique
Start ``UniqSupply`` allocation from ⟨s⟩.
``-dunique-increment=⟨i⟩``
.. index::
single: -dunique-increment
Set the increment for the generated ``Unique``'s to ⟨i⟩.
This is useful in combination with ``-dinitial-unique`` to test if the
generated files depend on the order of ``Unique``'s.
Some interesting values:
* ``-dinitial-unique=0 -dunique-increment=1`` - current sequential
``UniqSupply``
* ``-dinitial-unique=16777215 -dunique-increment=-1`` - ``UniqSupply`` that
generates in decreasing order
* ``-dinitial-unique=1 -dunique-increment=PRIME`` - where PRIME big enough
to overflow often - nonsequential order
...@@ -44,6 +44,7 @@ import Outputable ...@@ -44,6 +44,7 @@ import Outputable
import SrcLoc import SrcLoc
import Util import Util
import Panic import Panic
import UniqSupply
import MonadUtils ( liftIO ) import MonadUtils ( liftIO )
-- Imports for --abi-hash -- Imports for --abi-hash
...@@ -236,6 +237,7 @@ main' postLoadMode dflags0 args flagWarnings = do ...@@ -236,6 +237,7 @@ main' postLoadMode dflags0 args flagWarnings = do
printInfoForUser (dflags6 { pprCols = 200 }) printInfoForUser (dflags6 { pprCols = 200 })
(pkgQual dflags6) (pprModuleMap dflags6) (pkgQual dflags6) (pprModuleMap dflags6)
liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6)
---------------- Final sanity checking ----------- ---------------- Final sanity checking -----------
liftIO $ checkOptions postLoadMode dflags6 srcs objs liftIO $ checkOptions postLoadMode dflags6 srcs objs
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment