Commit db641808 authored by rwbarton's avatar rwbarton

Check for integer overflow in allocate() (#9172)

Summary: Check for integer overflow in allocate() (#9172)

Test Plan: validate

Reviewers: austin

Reviewed By: austin

Subscribers: simonmar, relrod, carter

Differential Revision: https://phabricator.haskell.org/D36
parent 5f3c5384
......@@ -686,7 +686,15 @@ StgPtr allocate (Capability *cap, W_ n)
CCS_ALLOC(cap->r.rCCCS,n);
if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
W_ req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
// The largest number of bytes such that
// the computation of req_blocks will not overflow.
W_ max_bytes = (HS_WORD_MAX & ~(BLOCK_SIZE-1)) / sizeof(W_);
W_ req_blocks;
if (n > max_bytes)
req_blocks = HS_WORD_MAX; // signal overflow below
else
req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
// Attempting to allocate an object larger than maxHeapSize
// should definitely be disallowed. (bug #1791)
......
......@@ -1293,6 +1293,9 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk
/tests/rts/linker_unload
/tests/rts/outofmem
/tests/rts/outofmem2
/tests/rts/overflow1
/tests/rts/overflow2
/tests/rts/overflow3
/tests/rts/prep.out
/tests/rts/return_mem_to_os
/tests/rts/rtsflags001
......
......@@ -230,3 +230,8 @@ test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], c
# I couldn't reproduce 9078 with the -threaded runtime, but could easily
# with the non-threaded one.
test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug'])
# 251 = RTS exit code for "out of memory"
test('overflow1', [ exit_code(251) ], compile_and_run, [''])
test('overflow2', [ exit_code(251) ], compile_and_run, [''])
test('overflow3', [ exit_code(251) ], compile_and_run, [''])
module Main where
import Data.Array.IO
import Data.Word
-- Try to overflow BLOCK_ROUND_UP in the computation of req_blocks in allocate()
-- Here we invoke allocate() via newByteArray# and the array package.
-- Request a number of bytes close to HS_WORD_MAX,
-- subtracting a few words for overhead in newByteArray#.
-- Allocate Word32s (rather than Word8s) to get around bounds-checking in array.
main = newArray (0,maxBound `div` 4 - 10) 0 :: IO (IOUArray Word Word32)
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
import Foreign
-- Test allocate(), the easy way.
data Cap = Cap
foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap)
foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ())
-- Number of words n such that n * sizeof(W_) exactly overflows a word
-- (2^30 on a 32-bit system, 2^61 on a 64-bit system)
overflowWordCount :: Word
overflowWordCount = fromInteger $
(fromIntegral (maxBound :: Word) + 1) `div`
fromIntegral (sizeOf (undefined :: Word))
main = do
cap <- myCapability
allocate cap (overflowWordCount - 1)
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
import Foreign
-- Test allocate(), the easy way.
data Cap = Cap
foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap)
foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ())
-- Number of words n such that n * sizeof(W_) exactly overflows a word
-- (2^30 on a 32-bit system, 2^61 on a 64-bit system)
overflowWordCount :: Word
overflowWordCount = fromInteger $
(fromIntegral (maxBound :: Word) + 1) `div`
fromIntegral (sizeOf (undefined :: Word))
main = do
cap <- myCapability
allocate cap (overflowWordCount + 1)
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