summaryrefslogtreecommitdiff
path: root/compiler/GHC/ByteCode
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2021-09-15 15:44:36 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-02-09 20:42:23 -0500
commite01ffec2456739bcfba750f0c36716ff697404bf (patch)
tree08c4502c783004a2c5b54844b49295918c2808cf /compiler/GHC/ByteCode
parent2b1cced18159171a4d6e730ba1d69cd024babb8d (diff)
downloadhaskell-e01ffec2456739bcfba750f0c36716ff697404bf.tar.gz
ByteCode: avoid out-of-bound read
Cf https://gitlab.haskell.org/ghc/ghc/-/issues/18431#note_287139
Diffstat (limited to 'compiler/GHC/ByteCode')
-rw-r--r--compiler/GHC/ByteCode/Asm.hs20
1 files changed, 15 insertions, 5 deletions
diff --git a/compiler/GHC/ByteCode/Asm.hs b/compiler/GHC/ByteCode/Asm.hs
index 1d7402c9cf..427549b6fd 100644
--- a/compiler/GHC/ByteCode/Asm.hs
+++ b/compiler/GHC/ByteCode/Asm.hs
@@ -497,7 +497,7 @@ assembleI platform i = case i of
litlabel fs = lit [BCONPtrLbl fs]
addr (RemotePtr a) = words [fromIntegral a]
- float = words . mkLitF
+ float = words . mkLitF platform
double = words . mkLitD platform
int = words . mkLitI
int8 = words . mkLitI64 platform
@@ -586,18 +586,28 @@ mkTupleInfoLit platform tuple_info =
-- words are placed in memory at increasing addresses, the
-- bit pattern is correct for the host's word size and endianness.
mkLitI :: Int -> [Word]
-mkLitF :: Float -> [Word]
+mkLitF :: Platform -> Float -> [Word]
mkLitD :: Platform -> Double -> [Word]
mkLitI64 :: Platform -> Int64 -> [Word]
-mkLitF f
- = runST (do
+mkLitF platform f = case platformWordSize platform of
+ PW4 -> runST $ do
arr <- newArray_ ((0::Int),0)
writeArray arr 0 f
f_arr <- castSTUArray arr
w0 <- readArray f_arr 0
return [w0 :: Word]
- )
+
+ PW8 -> runST $ do
+ arr <- newArray_ ((0::Int),1)
+ writeArray arr 0 f
+ -- on 64-bit architectures we read two (32-bit) Float cells when we read
+ -- a (64-bit) Word: so we write a dummy value in the second cell to
+ -- avoid an out-of-bound read.
+ writeArray arr 1 0.0
+ f_arr <- castSTUArray arr
+ w0 <- readArray f_arr 0
+ return [w0 :: Word]
mkLitD platform d = case platformWordSize platform of
PW4 -> runST (do