[Git][ghc/ghc][wip/no-fptr] 7 commits: GHC.Utils.Binary: Eliminate allocating withForeignPtr uses

Ben Gamari gitlab at gitlab.haskell.org
Fri Dec 4 03:19:56 UTC 2020



Ben Gamari pushed to branch wip/no-fptr at Glasgow Haskell Compiler / GHC


Commits:
d935c519 by Ben Gamari at 2020-12-03T17:18:24-05:00
GHC.Utils.Binary: Eliminate allocating withForeignPtr uses

- - - - -
a34cf3d0 by Ben Gamari at 2020-12-03T17:18:24-05:00
base: Eliminate allocating withForeignPtrs from GHC.Event.Array

- - - - -
9787420a by Ben Gamari at 2020-12-03T17:18:24-05:00
base: Use unsafeWithForeignPtr in GHC.IO.Buffer

- - - - -
397776c9 by Ben Gamari at 2020-12-03T17:18:24-05:00
base: Use unsafeWithForeignPtr in GHC.Event.IntTable

- - - - -
ade9666d by Ben Gamari at 2020-12-03T17:18:24-05:00
Bump bytestring submodule

Teach it to use unsafeWithForeignPtr where appropriate.

- - - - -
8b249760 by Ben Gamari at 2020-12-03T17:18:24-05:00
Sized

- - - - -
10217769 by Ben Gamari at 2020-12-03T17:18:24-05:00
StringBuffer: Use unsafeWithForeignPtr

- - - - -


7 changed files:

- compiler/GHC/Data/StringBuffer.hs
- compiler/GHC/Utils/Binary.hs
- libraries/base/GHC/Event/Array.hs
- libraries/base/GHC/Event/IntTable.hs
- libraries/base/GHC/ForeignPtr/Ops.hs
- libraries/base/GHC/IO/Buffer.hs
- libraries/bytestring


Changes:

=====================================
compiler/GHC/Data/StringBuffer.hs
=====================================
@@ -68,6 +68,12 @@ import GHC.IO.Encoding.Failure  ( CodingFailureMode(IgnoreCodingFailure) )
 import GHC.Exts
 
 import Foreign
+#if MIN_VERSION_base(4,15,0)
+import GHC.ForeignPtr (unsafeWithForeignPtr)
+#else
+unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
+unsafeWithForeignPtr = withForeignPtr
+#endif
 
 -- -----------------------------------------------------------------------------
 -- The StringBuffer type
@@ -107,7 +113,7 @@ hGetStringBuffer fname = do
    offset_i <- skipBOM h size_i 0  -- offset is 0 initially
    let size = fromIntegral $ size_i - offset_i
    buf <- mallocForeignPtrArray (size+3)
-   withForeignPtr buf $ \ptr -> do
+   unsafeWithForeignPtr buf $ \ptr -> do
      r <- if size == 0 then return 0 else hGetBuf h ptr size
      hClose h
      if (r /= size)
@@ -120,7 +126,7 @@ hGetStringBufferBlock handle wanted
          offset_i <- hTell handle >>= skipBOM handle size_i
          let size = min wanted (fromIntegral $ size_i-offset_i)
          buf <- mallocForeignPtrArray (size+3)
-         withForeignPtr buf $ \ptr ->
+         unsafeWithForeignPtr buf $ \ptr ->
              do r <- if size == 0 then return 0 else hGetBuf handle ptr size
                 if r /= size
                    then ioError (userError $ "short read of file: "++show(r,size,size_i,handle))
@@ -128,7 +134,7 @@ hGetStringBufferBlock handle wanted
 
 hPutStringBuffer :: Handle -> StringBuffer -> IO ()
 hPutStringBuffer hdl (StringBuffer buf len cur)
-    = withForeignPtr (plusForeignPtr buf cur) $ \ptr ->
+    = unsafeWithForeignPtr (plusForeignPtr buf cur) $ \ptr ->
           hPutBuf hdl ptr len
 
 -- | Skip the byte-order mark if there is one (see #1744 and #6016),
@@ -165,9 +171,9 @@ newUTF8StringBuffer buf ptr size = do
 appendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer
 appendStringBuffers sb1 sb2
     = do newBuf <- mallocForeignPtrArray (size+3)
-         withForeignPtr newBuf $ \ptr ->
-          withForeignPtr (buf sb1) $ \sb1Ptr ->
-           withForeignPtr (buf sb2) $ \sb2Ptr ->
+         unsafeWithForeignPtr newBuf $ \ptr ->
+          unsafeWithForeignPtr (buf sb1) $ \sb1Ptr ->
+           unsafeWithForeignPtr (buf sb2) $ \sb2Ptr ->
              do copyArray ptr (sb1Ptr `advancePtr` cur sb1) sb1_len
                 copyArray (ptr `advancePtr` sb1_len) (sb2Ptr `advancePtr` cur sb2) sb2_len
                 pokeArray (ptr `advancePtr` size) [0,0,0]
@@ -184,7 +190,7 @@ stringToStringBuffer str =
  unsafePerformIO $ do
   let size = utf8EncodedLength str
   buf <- mallocForeignPtrArray (size+3)
-  withForeignPtr buf $ \ptr -> do
+  unsafeWithForeignPtr buf $ \ptr -> do
     utf8EncodeString ptr str
     pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0]
     -- sentinels for UTF-8 decoding
@@ -203,7 +209,7 @@ nextChar :: StringBuffer -> (Char,StringBuffer)
 nextChar (StringBuffer buf len (I# cur#)) =
   -- Getting our fingers dirty a little here, but this is performance-critical
   inlinePerformIO $
-    withForeignPtr buf $ \(Ptr a#) ->
+    unsafeWithForeignPtr buf $ \(Ptr a#) ->
         case utf8DecodeCharAddr# (a# `plusAddr#` cur#) 0# of
           (# c#, nBytes# #) ->
              let cur' = I# (cur# +# nBytes#) in
@@ -220,7 +226,7 @@ prevChar :: StringBuffer -> Char -> Char
 prevChar (StringBuffer _   _   0)   deflt = deflt
 prevChar (StringBuffer buf _   cur) _     =
   inlinePerformIO $
-    withForeignPtr buf $ \p -> do
+    unsafeWithForeignPtr buf $ \p -> do
       p' <- utf8PrevChar (p `plusPtr` cur)
       return (fst (utf8DecodeChar p'))
 
@@ -258,7 +264,7 @@ atEnd (StringBuffer _ l c) = l == c
 atLine :: Int -> StringBuffer -> Maybe StringBuffer
 atLine line sb@(StringBuffer buf len _) =
   inlinePerformIO $
-    withForeignPtr buf $ \p -> do
+    unsafeWithForeignPtr buf $ \p -> do
       p' <- skipToLine line len p
       if p' == nullPtr
         then return Nothing
@@ -309,14 +315,14 @@ lexemeToFastString :: StringBuffer
 lexemeToFastString _ 0 = nilFS
 lexemeToFastString (StringBuffer buf _ cur) len =
    inlinePerformIO $
-     withForeignPtr buf $ \ptr ->
+     unsafeWithForeignPtr buf $ \ptr ->
        return $! mkFastStringBytes (ptr `plusPtr` cur) len
 
 -- | Return the previous @n@ characters (or fewer if we are less than @n@
 -- characters into the buffer.
 decodePrevNChars :: Int -> StringBuffer -> String
 decodePrevNChars n (StringBuffer buf _ cur) =
-    inlinePerformIO $ withForeignPtr buf $ \p0 ->
+    inlinePerformIO $ unsafeWithForeignPtr buf $ \p0 ->
       go p0 n "" (p0 `plusPtr` (cur - 1))
   where
     go :: Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String


=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -6,6 +6,7 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE UnboxedTuples #-}
 
 {-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
 -- We always optimise this, otherwise performance of a non-optimised
@@ -93,10 +94,16 @@ import System.IO as IO
 import System.IO.Unsafe         ( unsafeInterleaveIO )
 import System.IO.Error          ( mkIOError, eofErrorType )
 import GHC.Real                 ( Ratio(..) )
+#if MIN_VERSION_base(4,15,0)
+import GHC.ForeignPtr           ( unsafeWithForeignPtr )
+#endif
 
 type BinArray = ForeignPtr Word8
 
-
+#if !MIN_VERSION_base(4,15,0)
+unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
+unsafeWithForeignPtr = withForeignPtr
+#endif
 
 ---------------------------------------------------------------
 -- BinData
@@ -111,14 +118,14 @@ instance Binary BinData where
   put_ bh (BinData sz dat) = do
     put_ bh sz
     putPrim bh sz $ \dest ->
-      withForeignPtr dat $ \orig ->
+      unsafeWithForeignPtr dat $ \orig ->
         copyBytes dest orig sz
   --
   get bh = do
     sz <- get bh
     dat <- mallocForeignPtrBytes sz
     getPrim bh sz $ \orig ->
-      withForeignPtr dat $ \dest ->
+      unsafeWithForeignPtr dat $ \dest ->
         copyBytes dest orig sz
     return (BinData sz dat)
 
@@ -226,7 +233,7 @@ writeBinMem (BinMem _ ix_r _ arr_r) fn = do
   h <- openBinaryFile fn WriteMode
   arr <- readIORef arr_r
   ix  <- readFastMutInt ix_r
-  withForeignPtr arr $ \p -> hPutBuf h p ix
+  unsafeWithForeignPtr arr $ \p -> hPutBuf h p ix
   hClose h
 
 readBinMem :: FilePath -> IO BinHandle
@@ -236,7 +243,7 @@ readBinMem filename = do
   filesize' <- hFileSize h
   let filesize = fromIntegral filesize'
   arr <- mallocForeignPtrBytes filesize
-  count <- withForeignPtr arr $ \p -> hGetBuf h p filesize
+  count <- unsafeWithForeignPtr arr $ \p -> hGetBuf h p filesize
   when (count /= filesize) $
        error ("Binary.readBinMem: only read " ++ show count ++ " bytes")
   hClose h
@@ -280,7 +287,7 @@ putPrim h@(BinMem _ ix_r sz_r arr_r) size f = do
   when (ix + size > sz) $
     expandBin h (ix + size)
   arr <- readIORef arr_r
-  withForeignPtr arr $ \op -> f (op `plusPtr` ix)
+  unsafeWithForeignPtr arr $ \op -> f (op `plusPtr` ix)
   writeFastMutInt ix_r (ix + size)
 
 -- -- | Similar to putPrim but advances the index by the actual number of
@@ -302,7 +309,9 @@ getPrim (BinMem _ ix_r sz_r arr_r) size f = do
   when (ix + size > sz) $
       ioError (mkIOError eofErrorType "Data.Binary.getPrim" Nothing Nothing)
   arr <- readIORef arr_r
-  w <- withForeignPtr arr $ \op -> f (op `plusPtr` ix)
+  w <- unsafeWithForeignPtr arr $ \p -> f (p `plusPtr` ix)
+    -- This is safe WRT #17760 as we we guarantee that the above line doesn't
+    -- diverge
   writeFastMutInt ix_r (ix + size)
   return w
 


=====================================
libraries/base/GHC/Event/Array.hs
=====================================
@@ -33,7 +33,7 @@ import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
 import Foreign.Ptr (Ptr, nullPtr, plusPtr)
 import Foreign.Storable (Storable(..))
 import GHC.Base hiding (empty)
-import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_)
+import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_, unsafeWithForeignPtr)
 import GHC.Num (Num(..))
 import GHC.Real (fromIntegral)
 import GHC.Show (show)
@@ -78,9 +78,9 @@ reallocArray p newSize oldSize = reallocHack undefined p
   reallocHack dummy src = do
       let size = sizeOf dummy
       dst <- mallocPlainForeignPtrBytes (newSize * size)
-      withForeignPtr src $ \s ->
+      unsafeWithForeignPtr src $ \s ->
         when (s /= nullPtr && oldSize > 0) .
-          withForeignPtr dst $ \d -> do
+          unsafeWithForeignPtr dst $ \d -> do
             _ <- memcpy d s (fromIntegral (oldSize * size))
             return ()
       return dst
@@ -99,8 +99,8 @@ duplicate a = dupHack undefined a
   dupHack dummy (Array ref) = do
     AC es len cap <- readIORef ref
     ary <- allocArray cap
-    withForeignPtr ary $ \dest ->
-      withForeignPtr es $ \src -> do
+    unsafeWithForeignPtr ary $ \dest ->
+      unsafeWithForeignPtr es $ \src -> do
         _ <- memcpy dest src (fromIntegral (len * sizeOf dummy))
         return ()
     Array `fmap` newIORef (AC ary len cap)
@@ -119,8 +119,8 @@ unsafeRead :: Storable a => Array a -> Int -> IO a
 unsafeRead (Array ref) ix = do
     AC es _ cap <- readIORef ref
     CHECK_BOUNDS("unsafeRead",cap,ix)
-      withForeignPtr es $ \p ->
-        peekElemOff p ix
+      unsafeWithForeignPtr es $ \ptr -> peekElemOff ptr ix
+        -- this is safe WRT #17760 as we assume that peekElemOff doesn't diverge
 
 unsafeWrite :: Storable a => Array a -> Int -> a -> IO ()
 unsafeWrite (Array ref) ix a = do
@@ -130,13 +130,15 @@ unsafeWrite (Array ref) ix a = do
 unsafeWrite' :: Storable a => AC a -> Int -> a -> IO ()
 unsafeWrite' (AC es _ cap) ix a =
     CHECK_BOUNDS("unsafeWrite'",cap,ix)
-      withForeignPtr es $ \p ->
-        pokeElemOff p ix a
+      unsafeWithForeignPtr es $ \ptr -> pokeElemOff ptr ix a
+        -- this is safe WRT #17760 as we assume that peekElemOff doesn't diverge
 
+-- | Precondition: continuation must not diverge due to use of
+-- 'unsafeWithForeignPtr'.
 unsafeLoad :: Array a -> (Ptr a -> Int -> IO Int) -> IO Int
 unsafeLoad (Array ref) load = do
     AC es _ cap <- readIORef ref
-    len' <- withForeignPtr es $ \p -> load p cap
+    len' <- unsafeWithForeignPtr es $ \p -> load p cap
     writeIORef ref (AC es len' cap)
     return len'
 
@@ -146,7 +148,7 @@ unsafeCopyFromBuffer :: Storable a => Array a -> Ptr a -> Int -> IO ()
 unsafeCopyFromBuffer (Array ref) sptr n =
     readIORef ref >>= \(AC es _ cap) ->
     CHECK_BOUNDS("unsafeCopyFromBuffer", cap, n)
-    withForeignPtr es $ \pdest -> do
+    unsafeWithForeignPtr es $ \pdest -> do
       let size = sizeOfPtr sptr undefined
       _ <- memcpy pdest sptr (fromIntegral $ n * size)
       writeIORef ref (AC es n cap)
@@ -198,7 +200,7 @@ forM_ ary g = forHack ary g undefined
       AC es len _ <- readIORef ref
       let size = sizeOf dummy
           offset = len * size
-      withForeignPtr es $ \p -> do
+      unsafeWithForeignPtr es $ \p -> do
         let go n | n >= offset = return ()
                  | otherwise = do
               f =<< peek (p `plusPtr` n)
@@ -269,8 +271,8 @@ copy' d dstart s sstart maxCount = copyHack d s undefined
       then return dac
       else do
         AC dst dlen dcap <- ensureCapacity' dac (dstart + count)
-        withForeignPtr dst $ \dptr ->
-          withForeignPtr src $ \sptr -> do
+        unsafeWithForeignPtr dst $ \dptr ->
+          unsafeWithForeignPtr src $ \sptr -> do
             _ <- memcpy (dptr `plusPtr` (dstart * size))
                         (sptr `plusPtr` (sstart * size))
                         (fromIntegral (count * size))
@@ -286,7 +288,7 @@ removeAt a i = removeHack a undefined
     let size   = sizeOf dummy
         newLen = oldLen - 1
     when (newLen > 0 && i < newLen) .
-      withForeignPtr fp $ \ptr -> do
+      unsafeWithForeignPtr fp $ \ptr -> do
         _ <- memmove (ptr `plusPtr` (size * i))
                      (ptr `plusPtr` (size * (i+1)))
                      (fromIntegral (size * (newLen-i)))


=====================================
libraries/base/GHC/Event/IntTable.hs
=====================================
@@ -17,7 +17,8 @@ module GHC.Event.IntTable
 import Data.Bits ((.&.), shiftL, shiftR)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.Maybe (Maybe(..), isJust)
-import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr)
+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr)
+import GHC.ForeignPtr (unsafeWithForeignPtr)
 import Foreign.Storable (peek, poke)
 import GHC.Base (Monad(..), (=<<), ($), ($!), const, liftM, otherwise, when)
 import GHC.Classes (Eq(..), Ord(..))
@@ -62,7 +63,7 @@ new_ :: Int -> IO (IT a)
 new_ capacity = do
   arr <- Arr.new Empty capacity
   size <- mallocForeignPtr
-  withForeignPtr size $ \ptr -> poke ptr 0
+  unsafeWithForeignPtr size $ \ptr -> poke ptr 0
   return IT { tabArr = arr
             , tabSize = size
             }
@@ -81,7 +82,7 @@ grow oldit ref size = do
                 copyBucket (m+1) bucketNext
           copyBucket n =<< Arr.read (tabArr oldit) i
   copySlot 0 0
-  withForeignPtr (tabSize newit) $ \ptr -> poke ptr size
+  unsafeWithForeignPtr (tabSize newit) $ \ptr -> poke ptr size
   writeIORef ref newit
 
 -- | @insertWith f k v table@ inserts @k@ into @table@ with value @v at .
@@ -100,7 +101,7 @@ insertWith f k v inttable@(IntTable ref) = do
           Arr.write tabArr idx (Bucket k v' next)
           return (Just bucketValue)
         | otherwise = go bkt { bucketNext = seen } bucketNext
-      go seen _ = withForeignPtr tabSize $ \ptr -> do
+      go seen _ = unsafeWithForeignPtr tabSize $ \ptr -> do
         size <- peek ptr
         if size + 1 >= Arr.size tabArr - (Arr.size tabArr `shiftR` 2)
           then grow it ref size >> insertWith f k v inttable
@@ -139,7 +140,7 @@ updateWith f k (IntTable ref) = do
   when (isJust oldVal) $ do
     Arr.write tabArr idx newBucket
     when del $
-      withForeignPtr tabSize $ \ptr -> do
+      unsafeWithForeignPtr tabSize $ \ptr -> do
         size <- peek ptr
         poke ptr (size - 1)
   return oldVal


=====================================
libraries/base/GHC/ForeignPtr/Ops.hs
=====================================
@@ -62,17 +62,17 @@ withFP fp f =
 peekWord8ForeignPtr :: ForeignPtr ty -> Int -> IO Word8
 peekWord8ForeignPtr fp (I# d) = withFP fp $ \addr s0 ->
     case readWord8OffAddr# addr d s0 of
-      (# s1, r #) -> (# s1, W8# r #)
+      (# s1, r #) -> (# s1, W8# (narrowWord8# r) #)
 
 peekWord16ForeignPtr :: ForeignPtr ty -> Int -> IO Word16
 peekWord16ForeignPtr fp (I# d) = withFP fp $ \addr s0 ->
     case readWord16OffAddr# addr d s0 of
-      (# s1, r #) -> (# s1, W16# r #)
+      (# s1, r #) -> (# s1, W16# (narrowWord16# r) #)
 
 peekWord32ForeignPtr :: ForeignPtr ty -> Int -> IO Word32
 peekWord32ForeignPtr fp (I# d) = withFP fp $ \addr s0 ->
     case readWord32OffAddr# addr d s0 of
-      (# s1, r #) -> (# s1, W32# r #)
+      (# s1, r #) -> (# s1, W32# (narrowWord32# r) #)
 
 peekWord64ForeignPtr :: ForeignPtr ty -> Int -> IO Word64
 peekWord64ForeignPtr fp (I# d) = withFP fp $ \addr s0 ->
@@ -87,17 +87,17 @@ peekWordForeignPtr fp (I# d) = withFP fp $ \addr s0 ->
 peekInt8ForeignPtr :: ForeignPtr ty -> Int -> IO Int8
 peekInt8ForeignPtr fp (I# d) = withFP fp $ \addr s0 ->
     case readInt8OffAddr# addr d s0 of
-      (# s1, r #) -> (# s1, I8# r #)
+      (# s1, r #) -> (# s1, I8# (narrowInt8# r) #)
 
 peekInt16ForeignPtr :: ForeignPtr ty -> Int -> IO Int16
 peekInt16ForeignPtr fp (I# d) = withFP fp $ \addr s0 ->
     case readInt16OffAddr# addr d s0 of
-      (# s1, r #) -> (# s1, I16# r #)
+      (# s1, r #) -> (# s1, I16# (narrowInt16# r) #)
 
 peekInt32ForeignPtr :: ForeignPtr ty -> Int -> IO Int32
 peekInt32ForeignPtr fp (I# d) = withFP fp $ \addr s0 ->
     case readInt32OffAddr# addr d s0 of
-      (# s1, r #) -> (# s1, I32# r #)
+      (# s1, r #) -> (# s1, I32# (narrowInt32# r) #)
 
 peekInt64ForeignPtr :: ForeignPtr ty -> Int -> IO Int64
 peekInt64ForeignPtr fp (I# d) = withFP fp $ \addr s0 ->
@@ -116,17 +116,17 @@ peekCharForeignPtr fp (I# d) = withFP fp $ \addr s0 ->
 
 pokeWord8ForeignPtr :: ForeignPtr ty -> Int -> Word8 -> IO ()
 pokeWord8ForeignPtr fp (I# d) (W8# n) = withFP fp $ \addr s0 ->
-    case writeWord8OffAddr# addr d n s0 of
+    case writeWord8OffAddr# addr d (extendWord8# n) s0 of
       s1 -> (# s1, () #)
 
 pokeWord16ForeignPtr :: ForeignPtr ty -> Int -> Word16 -> IO ()
 pokeWord16ForeignPtr fp (I# d) (W16# n) = withFP fp $ \addr s0 ->
-    case writeWord16OffAddr# addr d n s0 of
+    case writeWord16OffAddr# addr d (extendWord16# n) s0 of
       s1 -> (# s1, () #)
 
 pokeWord32ForeignPtr :: ForeignPtr ty -> Int -> Word32 -> IO ()
 pokeWord32ForeignPtr fp (I# d) (W32# n) = withFP fp $ \addr s0 ->
-    case writeWord32OffAddr# addr d n s0 of
+    case writeWord32OffAddr# addr d (extendWord32# n) s0 of
       s1 -> (# s1, () #)
 
 pokeWord64ForeignPtr :: ForeignPtr ty -> Int -> Word64 -> IO ()
@@ -136,22 +136,22 @@ pokeWord64ForeignPtr fp (I# d) (W64# n) = withFP fp $ \addr s0 ->
 
 pokeWordForeignPtr :: ForeignPtr ty -> Int -> Word -> IO ()
 pokeWordForeignPtr fp (I# d) (W# n) = withFP fp $ \addr s0 ->
-    case writeWord64OffAddr# addr d n s0 of
+    case writeWordOffAddr# addr d n s0 of
       s1 -> (# s1, () #)
 
 pokeInt8ForeignPtr :: ForeignPtr ty -> Int -> Int8 -> IO ()
 pokeInt8ForeignPtr fp (I# d) (I8# n) = withFP fp $ \addr s0 ->
-    case writeInt8OffAddr# addr d n s0 of
+    case writeInt8OffAddr# addr d (extendInt8# n) s0 of
       s1 -> (# s1, () #)
 
 pokeInt16ForeignPtr :: ForeignPtr ty -> Int -> Int16 -> IO ()
 pokeInt16ForeignPtr fp (I# d) (I16# n) = withFP fp $ \addr s0 ->
-    case writeInt16OffAddr# addr d n s0 of
+    case writeInt16OffAddr# addr d (extendInt16# n) s0 of
       s1 -> (# s1, () #)
 
 pokeInt32ForeignPtr :: ForeignPtr ty -> Int -> Int32 -> IO ()
 pokeInt32ForeignPtr fp (I# d) (I32# n) = withFP fp $ \addr s0 ->
-    case writeInt32OffAddr# addr d n s0 of
+    case writeInt32OffAddr# addr d (extendInt32# n) s0 of
       s1 -> (# s1, () #)
 
 pokeInt64ForeignPtr :: ForeignPtr ty -> Int -> Int64 -> IO ()


=====================================
libraries/base/GHC/IO/Buffer.hs
=====================================
@@ -73,6 +73,7 @@ import GHC.Show
 import GHC.Real
 import GHC.List
 import GHC.ForeignPtr.Ops
+import GHC.ForeignPtr  (unsafeWithForeignPtr)
 import Foreign.C.Types
 import Foreign.ForeignPtr
 import Foreign.Storable
@@ -118,17 +119,17 @@ type CharBufElem = Char
 type RawCharBuffer = RawBuffer CharBufElem
 
 peekCharBuf :: RawCharBuffer -> Int -> IO Char
-peekCharBuf arr ix = withForeignPtr arr $ \p -> do
+peekCharBuf arr ix = unsafeWithForeignPtr arr $ \p -> do
                         (c,_) <- readCharBufPtr p ix
                         return c
 
 {-# INLINE readCharBuf #-}
 readCharBuf :: RawCharBuffer -> Int -> IO (Char, Int)
-readCharBuf arr ix = withForeignPtr arr $ \p -> readCharBufPtr p ix
+readCharBuf arr ix = unsafeWithForeignPtr arr $ \p -> readCharBufPtr p ix
 
 {-# INLINE writeCharBuf #-}
 writeCharBuf :: RawCharBuffer -> Int -> Char -> IO Int
-writeCharBuf arr ix c = withForeignPtr arr $ \p -> writeCharBufPtr p ix c
+writeCharBuf arr ix c = unsafeWithForeignPtr arr $ \p -> writeCharBufPtr p ix c
 
 {-# INLINE readCharBufPtr #-}
 readCharBufPtr :: Ptr CharBufElem -> Int -> IO (Char, Int)


=====================================
libraries/bytestring
=====================================
@@ -1 +1 @@
-Subproject commit 8b5d8d0da24aefdc4d950174bf396b32335d7e0f
+Subproject commit 36c2df1feaf10fde8d5848ac47b98d6d62c4e1d7



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e5f48e8b7ff3574bcfce4c788827209caf37de0...10217769a4e113b3847dda3827b79d7e2325fa72

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e5f48e8b7ff3574bcfce4c788827209caf37de0...10217769a4e113b3847dda3827b79d7e2325fa72
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/20201203/1c4633d4/attachment-0001.html>


More information about the ghc-commits mailing list