diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2021-02-02 14:41:41 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-05 19:12:01 -0500 |
| commit | fe789978453bfd4e5ff456a6be57fc8041664d75 (patch) | |
| tree | 4be620f0225abd40ed292744cdeed6c17134b25c | |
| parent | 003df39c8103823d8aac4b65f0e06cf49580f5e8 (diff) | |
| download | haskell-fe789978453bfd4e5ff456a6be57fc8041664d75.tar.gz | |
IntVar: fix allocation size
As found by @phadej in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4740/diffs#note_327510
Also fix FastMutInt which allocating the size in bits instead of bytes.
| -rw-r--r-- | compiler/GHC/Data/FastMutInt.hs | 4 | ||||
| -rw-r--r-- | libraries/base/GHC/Event/IntVar.hs | 5 |
2 files changed, 6 insertions, 3 deletions
diff --git a/compiler/GHC/Data/FastMutInt.hs b/compiler/GHC/Data/FastMutInt.hs index cc81b88b01..d7b8072b2c 100644 --- a/compiler/GHC/Data/FastMutInt.hs +++ b/compiler/GHC/Data/FastMutInt.hs @@ -34,7 +34,7 @@ data FastMutInt = FastMutInt (MutableByteArray# RealWorld) newFastMutInt = IO $ \s -> case newByteArray# size s of { (# s, arr #) -> (# s, FastMutInt arr #) } - where !(I# size) = finiteBitSize (0 :: Int) + where !(I# size) = finiteBitSize (0 :: Int) `unsafeShiftR` 3 readFastMutInt (FastMutInt arr) = IO $ \s -> case readIntArray# arr 0# s of { (# s, i #) -> @@ -50,7 +50,7 @@ newFastMutPtr = IO $ \s -> case newByteArray# size s of { (# s, arr #) -> (# s, FastMutPtr arr #) } -- GHC assumes 'sizeof (Int) == sizeof (Ptr a)' - where !(I# size) = finiteBitSize (0 :: Int) + where !(I# size) = finiteBitSize (0 :: Int) `unsafeShiftR` 3 readFastMutPtr (FastMutPtr arr) = IO $ \s -> case readAddrArray# arr 0# s of { (# s, i #) -> diff --git a/libraries/base/GHC/Event/IntVar.hs b/libraries/base/GHC/Event/IntVar.hs index f52deebd00..f973a34bfb 100644 --- a/libraries/base/GHC/Event/IntVar.hs +++ b/libraries/base/GHC/Event/IntVar.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP, MagicHash, NoImplicitPrelude, UnboxedTuples #-} module GHC.Event.IntVar @@ -9,13 +10,15 @@ module GHC.Event.IntVar ) where import GHC.Base +import GHC.Bits data IntVar = IntVar (MutableByteArray# RealWorld) newIntVar :: Int -> IO IntVar newIntVar n = do + let !(I# size) = finiteBitSize (0 :: Int) `unsafeShiftR` 3 iv <- IO $ \s -> - case newByteArray# 1# s of + case newByteArray# size s of (# s', mba #) -> (# s', IntVar mba #) writeIntVar iv n return iv |