X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO.hs;h=0a7416f461ec484a91483387a9011ffa15935d59;hb=4b26136ab82fb1ff12e49477c4833a9586d368c5;hp=830889ea1047263391a418baf605f8b913dafd7d;hpb=5ca4b4302f3e41760081ebd1ad9c193d59865698;p=haskell-directory.git diff --git a/GHC/IO.hs b/GHC/IO.hs index 830889e..0a7416f 100644 --- a/GHC/IO.hs +++ b/GHC/IO.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-} +{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-} #undef DEBUG_DUMP @@ -16,22 +16,18 @@ -- ----------------------------------------------------------------------------- +-- #hide module GHC.IO ( hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr, commitBuffer', -- hack, see below hGetcBuffered, -- needed by ghc/compiler/utils/StringBuffer.lhs hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking, slurpFile, -{- NOTE: As far as I can tell, not defined. - createPipe, createPipeEx, --} memcpy_ba_baoff, memcpy_ptr_baoff, memcpy_baoff_ba, memcpy_baoff_ptr, ) where -#include "config.h" - import Foreign import Foreign.C @@ -49,7 +45,10 @@ import GHC.Num import GHC.Show import GHC.List import GHC.Exception ( ioError, catch ) + +#ifdef mingw32_HOST_OS import GHC.Conc +#endif -- --------------------------------------------------------------------------- -- Simple input operations @@ -64,9 +63,16 @@ import GHC.Conc -- It returns 'True' as soon as input is available on @hdl@, -- or 'False' if no input is available within @t@ milliseconds. -- +-- If @t@ is less than zero, then @hWaitForInput@ waits indefinitely. +-- -- This operation may fail with: -- -- * 'isEOFError' if the end of file has been reached. +-- +-- NOTE for GHC users: unless you use the @-threaded@ flag, +-- @hWaitForInput t@ where @t >= 0@ will block all other Haskell +-- threads for the duration of the call. It behaves like a +-- @safe@ foreign call in this respect. hWaitForInput :: Handle -> Int -> IO Bool hWaitForInput h msecs = do @@ -78,12 +84,19 @@ hWaitForInput h msecs = do then return True else do - r <- throwErrnoIfMinus1Retry "hWaitForInput" - (inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs) (haIsStream handle_)) - return (r /= 0) + if msecs < 0 + then do buf' <- fillReadBuffer (haFD handle_) True + (haIsStream handle_) buf + writeIORef ref buf' + return True + else do r <- throwErrnoIfMinus1Retry "hWaitForInput" $ + inputReady (haFD handle_) + (fromIntegral msecs) + (fromIntegral $ fromEnum $ haIsStream handle_) + return (r /= 0) -foreign import ccall unsafe "inputReady" - inputReady :: CInt -> CInt -> Bool -> IO CInt +foreign import ccall safe "inputReady" + inputReady :: CInt -> CInt -> CInt -> IO CInt -- --------------------------------------------------------------------------- -- hGetChar @@ -120,7 +133,7 @@ hGetChar handle = NoBuffering -> do -- make use of the minimal buffer we already have let raw = bufBuf buf - r <- readRawBuffer "hGetChar" (fromIntegral fd) (haIsStream handle_) raw 0 1 + r <- readRawBuffer "hGetChar" fd (haIsStream handle_) raw 0 1 if r == 0 then ioe_EOF else do (c,_) <- readCharFromBuffer raw 0 @@ -166,24 +179,25 @@ hGetLine h = do Nothing -> hGetLineUnBuffered h Just l -> return l - +hGetLineBuffered :: Handle__ -> IO String hGetLineBuffered handle_ = do let ref = haBuffer handle_ buf <- readIORef ref hGetLineBufferedLoop handle_ ref buf [] - -hGetLineBufferedLoop handle_ ref - buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } xss = - let - -- find the end-of-line character, if there is one - loop raw r - | r == w = return (False, w) - | otherwise = do - (c,r') <- readCharFromBuffer raw r - if c == '\n' - then return (True, r) -- NB. not r': don't include the '\n' - else loop raw r' +hGetLineBufferedLoop :: Handle__ -> IORef Buffer -> Buffer -> [String] + -> IO String +hGetLineBufferedLoop handle_ ref + buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } xss = + let + -- find the end-of-line character, if there is one + loop raw r + | r == w = return (False, w) + | otherwise = do + (c,r') <- readCharFromBuffer raw r + if c == '\n' + then return (True, r) -- NB. not r': don't include the '\n' + else loop raw r' in do (eol, off) <- loop raw r @@ -196,24 +210,24 @@ hGetLineBufferedLoop handle_ ref -- if eol == True, then off is the offset of the '\n' -- otherwise off == w and the buffer is now empty. if eol - then do if (w == off + 1) - then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } - else writeIORef ref buf{ bufRPtr = off + 1 } - return (concat (reverse (xs:xss))) - else do - maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_) - buf{ bufWPtr=0, bufRPtr=0 } - case maybe_buf of - -- Nothing indicates we caught an EOF, and we may have a - -- partial line to return. - Nothing -> do - writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } - let str = concat (reverse (xs:xss)) - if not (null str) - then return str - else ioe_EOF - Just new_buf -> - hGetLineBufferedLoop handle_ ref new_buf (xs:xss) + then do if (w == off + 1) + then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } + else writeIORef ref buf{ bufRPtr = off + 1 } + return (concat (reverse (xs:xss))) + else do + maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_) + buf{ bufWPtr=0, bufRPtr=0 } + case maybe_buf of + -- Nothing indicates we caught an EOF, and we may have a + -- partial line to return. + Nothing -> do + writeIORef ref buf{ bufRPtr=0, bufWPtr=0 } + let str = concat (reverse (xs:xss)) + if not (null str) + then return str + else ioe_EOF + Just new_buf -> + hGetLineBufferedLoop handle_ ref new_buf (xs:xss) maybeFillReadBuffer fd is_line is_stream buf @@ -337,7 +351,7 @@ lazyRead' h handle_ = do NoBuffering -> do -- make use of the minimal buffer we already have let raw = bufBuf buf - r <- readRawBuffer "lazyRead" (fromIntegral fd) (haIsStream handle_) raw 0 1 + r <- readRawBuffer "lazyRead" fd (haIsStream handle_) raw 0 1 if r == 0 then do handle_ <- hClose_help handle_ return (handle_, "") @@ -391,16 +405,16 @@ unpackAcc buf (I# r) (I# len) acc = IO $ \s -> unpack acc (len -# 1#) s -- * 'isPermissionError' if another system resource limit would be exceeded. hPutChar :: Handle -> Char -> IO () -hPutChar handle c = - c `seq` do -- must evaluate c before grabbing the handle lock +hPutChar handle c = do + c `seq` return () wantWritableHandle "hPutChar" handle $ \ handle_ -> do let fd = haFD handle_ case haBufferMode handle_ of LineBuffering -> hPutcBuffered handle_ True c BlockBuffering _ -> hPutcBuffered handle_ False c NoBuffering -> - withObject (castCharToCChar c) $ \buf -> do - writeRawBufferPtr "hPutChar" (fromIntegral fd) (haIsStream handle_) buf 0 1 + with (castCharToCChar c) $ \buf -> do + writeRawBufferPtr "hPutChar" fd (haIsStream handle_) buf 0 1 return () hPutcBuffered handle_ is_line c = do @@ -552,7 +566,7 @@ commitBuffer commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do wantWritableHandle "commitAndReleaseBuffer" hdl $ - commitBuffer' hdl raw sz count flush release + commitBuffer' raw sz count flush release -- Explicitly lambda-lift this function to subvert GHC's full laziness -- optimisations, which otherwise tends to float out subexpressions @@ -565,7 +579,7 @@ commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do -- -- This hack is a fairly big win for hPutStr performance. --SDM 18/9/2001 -- -commitBuffer' hdl raw sz@(I# _) count@(I# _) flush release +commitBuffer' raw sz@(I# _) count@(I# _) flush release handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do #ifdef DEBUG_DUMP @@ -588,7 +602,7 @@ commitBuffer' hdl raw sz@(I# _) count@(I# _) flush release -- not flushing, and there's enough room in the buffer: -- just copy the data in and update bufWPtr. - then do memcpy_baoff_ba old_raw w raw (fromIntegral count) + then do memcpy_baoff_ba old_raw (fromIntegral w) raw (fromIntegral count) writeIORef ref old_buf{ bufWPtr = w + count } return (newEmptyBuffer raw WriteBuffer sz) @@ -682,7 +696,7 @@ bufWrite fd ref is_stream ptr count can_block = if (size - w > count) -- There's enough room in the buffer: -- just copy the data in and update bufWPtr. - then do memcpy_baoff_ptr old_raw w ptr (fromIntegral count) + then do memcpy_baoff_ptr old_raw (fromIntegral w) ptr (fromIntegral count) writeIORef ref old_buf{ bufWPtr = w + count } return count @@ -705,7 +719,7 @@ writeChunk fd is_stream ptr bytes = loop 0 bytes loop _ bytes | bytes <= 0 = return () loop off bytes = do r <- fromIntegral `liftM` - writeRawBufferPtr "writeChunk" (fromIntegral fd) is_stream ptr + writeRawBufferPtr "writeChunk" fd is_stream ptr off (fromIntegral bytes) -- write can't return 0 loop (off + r) (bytes - r) @@ -716,8 +730,8 @@ writeChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes loop :: Int -> Int -> IO Int loop off bytes | bytes <= 0 = return off loop off bytes = do -#ifndef mingw32_TARGET_OS - ssize <- c_write (fromIntegral fd) (ptr `plusPtr` off) (fromIntegral bytes) +#ifndef mingw32_HOST_OS + ssize <- c_write fd (ptr `plusPtr` off) (fromIntegral bytes) let r = fromIntegral ssize :: Int if (r == -1) then do errno <- getErrno @@ -726,7 +740,8 @@ writeChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes else throwErrno "writeChunk" else loop (off + r) (bytes - r) #else - (ssize, rc) <- asyncWrite fd (fromIntegral $ fromEnum is_stream) + (ssize, rc) <- asyncWrite (fromIntegral fd) + (fromIntegral $ fromEnum is_stream) (fromIntegral bytes) (ptr `plusPtr` off) let r = fromIntegral ssize :: Int @@ -751,65 +766,56 @@ writeChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes -- is closed, 'hGetBuf' will behave as if EOF was reached. hGetBuf :: Handle -> Ptr a -> Int -> IO Int -hGetBuf h ptr count = hGetBuf' h ptr count True - -hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int -hGetBufNonBlocking h ptr count = hGetBuf' h ptr count False - -hGetBuf' :: Handle -> Ptr a -> Int -> Bool -> IO Int -hGetBuf' handle ptr count can_block +hGetBuf h ptr count | count == 0 = return 0 - | count < 0 = illegalBufferSize handle "hGetBuf" count + | count < 0 = illegalBufferSize h "hGetBuf" count | otherwise = - wantReadableHandle "hGetBuf" handle $ + wantReadableHandle "hGetBuf" h $ \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do - bufRead fd ref is_stream ptr 0 count can_block + bufRead fd ref is_stream ptr 0 count -bufRead fd ref is_stream ptr so_far count can_block = +-- small reads go through the buffer, large reads are satisfied by +-- taking data first from the buffer and then direct from the file +-- descriptor. +bufRead fd ref is_stream ptr so_far count = seq fd $ seq so_far $ seq count $ do -- strictness hack buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref if bufferEmpty buf - then if so_far > 0 then return so_far else - if count < sz - then do - mb_buf <- maybeFillReadBuffer fd (not can_block) is_stream buf - case mb_buf of - Nothing -> return 0 - Just new_buf -> do - writeIORef ref new_buf - bufRead fd ref is_stream ptr so_far count can_block - else if can_block - then readChunk fd is_stream ptr count - else readChunkNonBlocking fd is_stream ptr count + then if count > sz -- small read? + then do rest <- readChunk fd is_stream ptr count + return (so_far + rest) + else do mb_buf <- maybeFillReadBuffer fd True is_stream buf + case mb_buf of + Nothing -> return so_far -- got nothing, we're done + Just buf' -> do + writeIORef ref buf' + bufRead fd ref is_stream ptr so_far count else do - let avail = w - r + let avail = w - r if (count == avail) then do - memcpy_ptr_baoff ptr raw r (fromIntegral count) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } return (so_far + count) else do if (count < avail) then do - memcpy_ptr_baoff ptr raw r (fromIntegral count) + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) writeIORef ref buf{ bufRPtr = r + count } return (so_far + count) else do - - memcpy_ptr_baoff ptr raw r (fromIntegral avail) + + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail) writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } - let remaining = count - avail so_far' = so_far + avail ptr' = ptr `plusPtr` avail if remaining < sz - then bufRead fd ref is_stream ptr' so_far' remaining can_block + then bufRead fd ref is_stream ptr' so_far' remaining else do - rest <- if can_block - then readChunk fd is_stream ptr' remaining - else readChunkNonBlocking fd is_stream ptr' remaining + rest <- readChunk fd is_stream ptr' remaining return (so_far' + rest) readChunk :: FD -> Bool -> Ptr a -> Int -> IO Int @@ -819,39 +825,103 @@ readChunk fd is_stream ptr bytes = loop 0 bytes loop off bytes | bytes <= 0 = return off loop off bytes = do r <- fromIntegral `liftM` - readRawBufferPtr "readChunk" (fromIntegral fd) is_stream + readRawBufferPtr "readChunk" fd is_stream (castPtr ptr) off (fromIntegral bytes) if r == 0 then return off else loop (off + r) (bytes - r) + +-- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@ +-- into the buffer @buf@ until either EOF is reached, or +-- @count@ 8-bit bytes have been read, or there is no more data available +-- to read immediately. +-- +-- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will +-- never block waiting for data to become available, instead it returns +-- only whatever data is available. To wait for data to arrive before +-- calling 'hGetBufNonBlocking', use 'hWaitForInput'. +-- +-- If the handle is a pipe or socket, and the writing end +-- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached. +-- +hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int +hGetBufNonBlocking h ptr count + | count == 0 = return 0 + | count < 0 = illegalBufferSize h "hGetBufNonBlocking" count + | otherwise = + wantReadableHandle "hGetBufNonBlocking" h $ + \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do + bufReadNonBlocking fd ref is_stream ptr 0 count + +bufReadNonBlocking fd ref is_stream ptr so_far count = + seq fd $ seq so_far $ seq count $ do -- strictness hack + buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref + if bufferEmpty buf + then if count > sz -- large read? + then do rest <- readChunkNonBlocking fd is_stream ptr count + return (so_far + rest) + else do buf' <- fillReadBufferWithoutBlocking fd is_stream buf + case buf' of { Buffer{ bufWPtr=w } -> + if (w == 0) + then return so_far + else do writeIORef ref buf' + bufReadNonBlocking fd ref is_stream ptr + so_far (min count w) + -- NOTE: new count is 'min count w' + -- so we will just copy the contents of the + -- buffer in the recursive call, and not + -- loop again. + } + else do + let avail = w - r + if (count == avail) + then do + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) + writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } + return (so_far + count) + else do + if (count < avail) + then do + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count) + writeIORef ref buf{ bufRPtr = r + count } + return (so_far + count) + else do + + memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail) + writeIORef ref buf{ bufWPtr=0, bufRPtr=0 } + let remaining = count - avail + so_far' = so_far + avail + ptr' = ptr `plusPtr` avail + + -- we haven't attempted to read anything yet if we get to here. + if remaining < sz + then bufReadNonBlocking fd ref is_stream ptr' so_far' remaining + else do + + rest <- readChunkNonBlocking fd is_stream ptr' remaining + return (so_far' + rest) + + readChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int -readChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes - where - loop :: Int -> Int -> IO Int - loop off bytes | bytes <= 0 = return off - loop off bytes = do -#ifndef mingw32_TARGET_OS - ssize <- c_read (fromIntegral fd) (ptr `plusPtr` off) (fromIntegral bytes) +readChunkNonBlocking fd is_stream ptr bytes = do +#ifndef mingw32_HOST_OS + ssize <- c_read fd (castPtr ptr) (fromIntegral bytes) let r = fromIntegral ssize :: Int if (r == -1) then do errno <- getErrno if (errno == eAGAIN || errno == eWOULDBLOCK) - then return off + then return 0 else throwErrno "readChunk" - else if (r == 0) - then return off - else loop (off + r) (bytes - r) + else return r #else - (ssize, rc) <- asyncRead fd (fromIntegral $ fromEnum is_stream) - (fromIntegral bytes) - (ptr `plusPtr` off) - let r = fromIntegral ssize :: Int - if r == (-1) - then ioError (errnoToIOError "hGetBufNonBlocking" (Errno (fromIntegral rc)) Nothing Nothing) - else if (r == 0) - then return off - else loop (off + r) (bytes - r) + fromIntegral `liftM` + readRawBufferPtr "readChunkNonBlocking" fd is_stream + (castPtr ptr) 0 (fromIntegral bytes) + + -- we don't have non-blocking read support on Windows, so just invoke + -- the ordinary low-level read which will block until data is available, + -- but won't wait for the whole buffer to fill. #endif slurpFile :: FilePath -> IO (Ptr (), Int) @@ -869,113 +939,16 @@ slurpFile fname = do return (chunk, r) -- --------------------------------------------------------------------------- --- pipes - -{-| -(@createPipe@) creates an anonymous /pipe/ and returns a pair of -handles, the first for reading and the second for writing. Both -pipe ends can be inherited by a child process. - -> createPipe = createPipeEx (BinaryMode AppendMode) --} -createPipe :: IO (Handle,Handle) -createPipe = createPipeEx AppendMode - -{-| -(@createPipeEx modeEx@) creates an anonymous /pipe/ and returns a pair of -handles, the first for reading and the second for writing. -The pipe mode @modeEx@ can be: - - * @'TextMode' mode@ -- the pipe is opened in text mode. - - * @'BinaryMode' mode@ -- the pipe is opened in binary mode. - -The @mode@ determines if child processes can inherit the pipe handles: - - * 'ReadMode' -- The /read/ handle of the pipe is private to this process. - - * 'WriteMode' -- The /write/ handle of the pipe is private to this process. - - * 'ReadWriteMode' -- Both handles are private to this process. - - * 'AppendMode' -- Both handles are available (inheritable) to child processes. - This mode can be used to /append/ (|) two seperate child processes. - -If a broken pipe is read, an end-of-file ('GHC.IOBase.EOF') -exception is raised. If a broken pipe is written to, an invalid argument exception -is raised ('GHC.IOBase.InvalidArgument'). --} -createPipeEx :: IOMode -> IO (Handle,Handle) -createPipeEx mode = do -#if 1 - return (error "createPipeEx") -#else - -#ifndef mingw32_TARGET_OS - -- ignore modeEx for Unix: just always inherit the descriptors - allocaArray 2 $ \p -> do - throwErrnoIfMinus1 "createPipe" (c_pipe p) - r <- peekElemOff p 0 - hr <- openFd (fromIntegral r) (Just Stream) ("") ReadMode - False{-text mode-} False{-don't truncate-} - w <- peekElemOff p 1 - hw <- openFd (fromIntegral w) (Just Stream) ("") WriteMode - False{-text mode-} False{-don't truncate-} - return (hr,hw) -#else - - alloca $ \pFdRead -> - alloca $ \pFdWrite -> - do{ r <- winCreatePipe (fromIntegral textmode) (fromIntegral inherit) 4096 pFdRead pFdWrite - ; when (r/=0) (ioError (userError ("unable to create pipe"))) - ; fdRead <- do{ fd <- peek pFdRead - ; case mode of - WriteMode -> inheritFd fd -- a child process must be able to read from it - other -> return fd - } - ; fdWrite <- do{ fd <- peek pFdWrite - ; case mode of - ReadMode -> inheritFd fd -- a child process must be able to write to it - other -> return fd - } - ; hRead <- openFd (fromIntegral fd) (Just Stream) - "" ReadMode textmode False - ; hWrite <- openFd (fromIntegral fd) (Just Stream) - "" WriteMode textmode False - ; return (hRead,hWrite) - } - where - (mode,textmode) = case modeEx of - TextMode mode -> (mode,1::Int) - BinaryMode mode -> (mode,0::Int) - - inherit :: Int - inherit = case mode of - ReadMode -> 0 -- not inheritable - WriteMode -> 0 -- not inheritable - ReadWriteMode -> 0 -- not inheritable - AppendMode -> 1 -- both inheritable - -inheritFd :: CInt -> IO CInt -inheritFd fd0 - = do{ fd1 <- c_dup fd0 -- dup() makes a file descriptor inheritable - ; c_close fd0 - ; return fd1 - } -#endif -#endif /* mingw32_TARGET_OS */ - --- --------------------------------------------------------------------------- -- memcpy wrappers foreign import ccall unsafe "__hscore_memcpy_src_off" - memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ()) + memcpy_ba_baoff :: RawBuffer -> RawBuffer -> CInt -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_src_off" - memcpy_ptr_baoff :: Ptr a -> RawBuffer -> Int -> CSize -> IO (Ptr ()) + memcpy_ptr_baoff :: Ptr a -> RawBuffer -> CInt -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_dst_off" - memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ()) + memcpy_baoff_ba :: RawBuffer -> CInt -> RawBuffer -> CSize -> IO (Ptr ()) foreign import ccall unsafe "__hscore_memcpy_dst_off" - memcpy_baoff_ptr :: RawBuffer -> Int -> Ptr a -> CSize -> IO (Ptr ()) + memcpy_baoff_ptr :: RawBuffer -> CInt -> Ptr a -> CSize -> IO (Ptr ()) ----------------------------------------------------------------------------- -- Internal Utils