[Git][ghc/ghc][wip/seek-bin-off-by-one] Deleted 1 commit: Remove `seekBin` function
Hannes Siebenhandl (@fendor)
gitlab at gitlab.haskell.org
Tue Apr 2 07:57:29 UTC 2024
Hannes Siebenhandl pushed to branch wip/seek-bin-off-by-one at Glasgow Haskell Compiler / GHC
WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below.
Deleted commits:
f7d2f9e1 by Fendor at 2024-04-02T09:45:39+02:00
Remove `seekBin` function
Binary utility `seekBin` used to expand the buffer of the `BinMem`
handle. This is dubious, because the only way to call `seekBin` requires
us use `tellBin`, which always gives us a pointer to already allocated
index. As we don't have a way to reduce the buffer size of the
underlying `BinArray`, there is no way to create an out-of-bounds pointer
for the same `BinArray`.
Thus, it is effectively a bug, if anyone manages to seek to an
out-of-bounds location.
We make this more clear by removing `seekBin` and replacing all
occurrences with `seekBinNoExpand`.
- - - - -
5 changed files:
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Ext/Binary.hs
- compiler/GHC/Iface/Ext/Fields.hs
- compiler/GHC/StgToJS/Object.hs
- compiler/GHC/Utils/Binary.hs
Changes:
=====================================
compiler/GHC/Iface/Binary.hs
=====================================
@@ -135,7 +135,7 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do
mod_iface <- getWithUserData name_cache bh
- seekBin bh extFields_p
+ seekBinNoExpand bh extFields_p
extFields <- get bh
return mod_iface
@@ -191,7 +191,7 @@ writeBinIface profile traceBinIface hi_path mod_iface = do
extFields_p <- tellBin bh
putAt bh extFields_p_p extFields_p
- seekBin bh extFields_p
+ seekBinNoExpand bh extFields_p
put_ bh (mi_ext_fields mod_iface)
-- And send the result to the file
=====================================
compiler/GHC/Iface/Ext/Binary.hs
=====================================
@@ -113,7 +113,7 @@ writeHieFile hie_file_path hiefile = do
-- write the symtab pointer at the front of the file
symtab_p <- tellBin bh
putAt bh symtab_p_p symtab_p
- seekBin bh symtab_p
+ seekBinNoExpand bh symtab_p
-- write the symbol table itself
symtab_next' <- readFastMutInt symtab_next
@@ -123,7 +123,7 @@ writeHieFile hie_file_path hiefile = do
-- write the dictionary pointer at the front of the file
dict_p <- tellBin bh
putAt bh dict_p_p dict_p
- seekBin bh dict_p
+ seekBinNoExpand bh dict_p
-- write the dictionary itself
dict_next <- readFastMutInt dict_next_ref
@@ -232,17 +232,17 @@ readHieFileContents bh0 name_cache = do
get_dictionary bin_handle = do
dict_p <- get bin_handle
data_p <- tellBin bin_handle
- seekBin bin_handle dict_p
+ seekBinNoExpand bin_handle dict_p
dict <- getDictionary bin_handle
- seekBin bin_handle data_p
+ seekBinNoExpand bin_handle data_p
return dict
get_symbol_table bh1 = do
symtab_p <- get bh1
data_p' <- tellBin bh1
- seekBin bh1 symtab_p
+ seekBinNoExpand bh1 symtab_p
symtab <- getSymbolTable bh1 name_cache
- seekBin bh1 data_p'
+ seekBinNoExpand bh1 data_p'
return symtab
putFastString :: HieDictionary -> BinHandle -> FastString -> IO ()
=====================================
compiler/GHC/Iface/Ext/Fields.hs
=====================================
@@ -42,7 +42,7 @@ instance Binary ExtensibleFields where
forM_ header_entries $ \(field_p_p, dat) -> do
field_p <- tellBin bh
putAt bh field_p_p field_p
- seekBin bh field_p
+ seekBinNoExpand bh field_p
put_ bh dat
get bh = do
@@ -54,7 +54,7 @@ instance Binary ExtensibleFields where
-- Seek to and get each field's payload:
fields <- forM header_entries $ \(name, field_p) -> do
- seekBin bh field_p
+ seekBinNoExpand bh field_p
dat <- get bh
return (name, dat)
=====================================
compiler/GHC/StgToJS/Object.hs
=====================================
@@ -392,7 +392,7 @@ getObjectBlocks obj bids = mapMaybeM read_entry (zip (objIndex obj) [0..])
bh = objHandle obj
read_entry (IndexEntry syms offset,i)
| IS.member i bids = do
- seekBin bh offset
+ seekBinNoExpand bh offset
Just <$> getObjBlock syms bh
| otherwise = pure Nothing
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -28,9 +28,9 @@ module GHC.Utils.Binary
unsafeUnpackBinBuffer,
openBinMem,
+ seekBinNoExpand,
-- closeBin,
- seekBin,
tellBin,
castBin,
withBinBuffer,
@@ -222,10 +222,10 @@ class Binary a where
put bh a = do p <- tellBin bh; put_ bh a; return p
putAt :: Binary a => BinHandle -> Bin a -> a -> IO ()
-putAt bh p x = do seekBin bh p; put_ bh x; return ()
+putAt bh p x = do seekBinNoExpand bh p; put_ bh x; return ()
getAt :: Binary a => BinHandle -> Bin a -> IO a
-getAt bh p = do seekBin bh p; get bh
+getAt bh p = do seekBinNoExpand bh p; get bh
openBinMem :: Int -> IO BinHandle
openBinMem size
@@ -240,13 +240,6 @@ openBinMem size
tellBin :: BinHandle -> IO (Bin a)
tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix)
-seekBin :: BinHandle -> Bin a -> IO ()
-seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do
- sz <- readFastMutInt sz_r
- if (p > sz)
- then do expandBin h p; writeFastMutInt ix_r p
- else writeFastMutInt ix_r p
-
-- | 'seekBinNoExpand' moves the index pointer to the location pointed to
-- by 'Bin a'.
-- This operation may 'panic', if the pointer location is out of bounds of the
@@ -1028,7 +1021,7 @@ lazyPut bh a = do
put_ bh a -- dump the object
q <- tellBin bh -- q = ptr to after object
putAt bh pre_a q -- fill in slot before a with ptr to q
- seekBin bh q -- finally carry on writing at q
+ seekBinNoExpand bh q -- finally carry on writing at q
lazyGet :: Binary a => BinHandle -> IO a
lazyGet bh = do
@@ -1039,7 +1032,7 @@ lazyGet bh = do
-- safety.
off_r <- newFastMutInt 0
getAt bh { _off_r = off_r } p_a
- seekBin bh p -- skip over the object for now
+ seekBinNoExpand bh p -- skip over the object for now
return a
-- | Serialize the constructor strictly but lazily serialize a value inside a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7d2f9e18e9705cd8e44c903f0129c5d1567d081
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7d2f9e18e9705cd8e44c903f0129c5d1567d081
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240402/684ac82b/attachment-0001.html>
More information about the ghc-commits
mailing list