Commit 0d213c18 authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

UniqSupply: Use full range of machine word

Currently uniques are 32-bits wide. 8 of these bits are for the unique
class, leaving only 24 for the unique number itself. This seems
dangerously small for a large project. Let's use the full range of the
native machine word.

We also add (now largely unnecessary) overflow check to ensure that the
unique number doesn't overflow.

Test Plan: Validate

Reviewers: simonmar, austin, niteria

Reviewed By: niteria

Subscribers: mpickering, thomie

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

GHC Trac Issues: #12944
parent cd4b202f
#include "../includes/MachDeps.h"
#define UNIQUE_BITS (WORD_SIZE_IN_BITS - 8)
......@@ -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"
{-
************************************************************************
* *
......@@ -75,7 +77,7 @@ takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
-- ^ 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:
......
......@@ -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.
......@@ -63,6 +64,7 @@ module Unique (
) where
#include "HsVersions.h"
#include "Unique.h"
import BasicTypes
import FastString
......@@ -126,6 +128,11 @@ deriveUnique (MkUnique i) delta = mkUnique 'X' (i + delta)
-- 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
......@@ -138,15 +145,15 @@ mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
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)
......
#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
}
......
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