summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--libraries/base/GHC/IO/Buffer.hs51
-rw-r--r--libraries/base/GHC/IO/BufferedIO.hs24
-rw-r--r--libraries/base/GHC/IO/Device.hs35
-rw-r--r--libraries/base/GHC/IO/Encoding/CodePage.hs19
-rw-r--r--libraries/base/GHC/IO/Encoding/CodePage/API.hs16
-rw-r--r--libraries/base/GHC/IO/FD.hs18
-rw-r--r--libraries/base/GHC/IO/Handle.hs44
-rw-r--r--libraries/base/GHC/IO/Handle/Internals.hs54
-rw-r--r--libraries/base/GHC/IO/Handle/Text.hs80
-rw-r--r--libraries/base/GHC/IO/Handle/Types.hs2
-rw-r--r--libraries/base/GHC/TopHandler.hs2
-rw-r--r--libraries/base/GHC/Windows.hs77
-rw-r--r--libraries/base/System/IO.hs9
-rw-r--r--libraries/base/include/windows_cconv.h12
m---------libraries/haskeline0
m---------libraries/process0
m---------utils/hsc2hs0
17 files changed, 293 insertions, 150 deletions
diff --git a/libraries/base/GHC/IO/Buffer.hs b/libraries/base/GHC/IO/Buffer.hs
index 447c574e2b..5098e087d1 100644
--- a/libraries/base/GHC/IO/Buffer.hs
+++ b/libraries/base/GHC/IO/Buffer.hs
@@ -31,6 +31,8 @@ module GHC.IO.Buffer (
bufferAdd,
slideContents,
bufferAdjustL,
+ bufferAddOffset,
+ bufferAdjustOffset,
-- ** Inspecting
isEmptyBuffer,
@@ -39,6 +41,7 @@ module GHC.IO.Buffer (
isWriteBuffer,
bufferElems,
bufferAvailable,
+ bufferOffset,
summaryBuffer,
-- ** Operating on the raw buffer as a Ptr
@@ -61,6 +64,10 @@ module GHC.IO.Buffer (
charSize,
) where
+#if defined(CHARBUF_UTF16)
+import Data.Word (Word64)
+#endif
+
import GHC.Base
-- import GHC.IO
import GHC.Num
@@ -68,6 +75,7 @@ import GHC.Ptr
import GHC.Word
import GHC.Show
import GHC.Real
+import GHC.List
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Storable
@@ -89,6 +97,9 @@ import Foreign.Storable
-- broken. In particular, the built-in codecs
-- e.g. GHC.IO.Encoding.UTF{8,16,32} need to use isFullCharBuffer or
-- similar in place of the ow >= os comparisons.
+--
+-- Tamar: We need to do this eventually for Windows, as we have to re-encode
+-- the text as UTF-16 anyway, so if we can avoid it it would be great.
-- ---------------------------------------------------------------------------
-- Raw blocks of data
@@ -177,13 +188,23 @@ charSize = 4
-- a memory-mapped file and in which case 'bufL' will point to the
-- next location to be written, which is not necessarily the beginning
-- of the file.
+--
+-- On Posix systems the I/O manager has an implicit reliance on doing a file
+-- read moving the file pointer. However on Windows async operations the kernel
+-- object representing a file does not use the file pointer offset. Logically
+-- this makes sense since operations can be performed in any arbitrary order.
+-- OVERLAPPED operations don't respect the file pointer offset as their
+-- intention is to support arbitrary async reads to anywhere at a much lower
+-- level. As such we should explicitly keep track of the file offsets of the
+-- target in the buffer. Any operation to seek should also update this entry.
data Buffer e
= Buffer {
- bufRaw :: !(RawBuffer e),
- bufState :: BufferState,
- bufSize :: !Int, -- in elements, not bytes
- bufL :: !Int, -- offset of first item in the buffer
- bufR :: !Int -- offset of last item + 1
+ bufRaw :: !(RawBuffer e),
+ bufState :: BufferState,
+ bufSize :: !Int, -- in elements, not bytes
+ bufOffset :: !Word64, -- start location for next read
+ bufL :: !Int, -- offset of first item in the buffer
+ bufR :: !Int -- offset of last item + 1
}
#if defined(CHARBUF_UTF16)
@@ -237,9 +258,19 @@ bufferAdjustL l buf@Buffer{ bufR=w }
bufferAdd :: Int -> Buffer e -> Buffer e
bufferAdd i buf@Buffer{ bufR=w } = buf{ bufR=w+i }
+bufferOffset :: Buffer e -> Word64
+bufferOffset Buffer{ bufOffset=off } = off
+
+bufferAdjustOffset :: Word64 -> Buffer e -> Buffer e
+bufferAdjustOffset offs buf = buf{ bufOffset=offs }
+
+bufferAddOffset :: Int -> Buffer e -> Buffer e
+bufferAddOffset offs buf@Buffer{ bufOffset=w } =
+ buf{ bufOffset=w+(fromIntegral offs) }
+
emptyBuffer :: RawBuffer e -> Int -> BufferState -> Buffer e
emptyBuffer raw sz state =
- Buffer{ bufRaw=raw, bufState=state, bufR=0, bufL=0, bufSize=sz }
+ Buffer{ bufRaw=raw, bufState=state, bufOffset=0, bufR=0, bufL=0, bufSize=sz }
newByteBuffer :: Int -> BufferState -> IO (Buffer Word8)
newByteBuffer c st = newBuffer c c st
@@ -266,7 +297,13 @@ foreign import ccall unsafe "memmove"
summaryBuffer :: Buffer a -> String
summaryBuffer !buf -- Strict => slightly better code
- = "buf" ++ show (bufSize buf) ++ "(" ++ show (bufL buf) ++ "-" ++ show (bufR buf) ++ ")"
+ = ppr (show $ bufRaw buf) ++ "@buf" ++ show (bufSize buf)
+ ++ "(" ++ show (bufL buf) ++ "-" ++ show (bufR buf) ++ ")"
+ ++ " (>=" ++ show (bufOffset buf) ++ ")"
+ where ppr :: String -> String
+ ppr ('0':'x':xs) = let p = dropWhile (=='0') xs
+ in if null p then "0x0" else '0':'x':p
+ ppr x = x
-- INVARIANTS on Buffers:
-- * r <= w
diff --git a/libraries/base/GHC/IO/BufferedIO.hs b/libraries/base/GHC/IO/BufferedIO.hs
index cd38cefe07..c6f4cde477 100644
--- a/libraries/base/GHC/IO/BufferedIO.hs
+++ b/libraries/base/GHC/IO/BufferedIO.hs
@@ -92,9 +92,11 @@ class BufferedIO dev where
readBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)
readBuf dev bbuf = do
let bytes = bufferAvailable bbuf
+ let offset = bufferOffset bbuf
res <- withBuffer bbuf $ \ptr ->
- RawIO.read dev (ptr `plusPtr` bufR bbuf) bytes
- return (res, bbuf{ bufR = bufR bbuf + res })
+ RawIO.read dev (ptr `plusPtr` bufR bbuf) offset bytes
+ let bbuf' = bufferAddOffset res bbuf
+ return (res, bbuf'{ bufR = bufR bbuf' + res })
-- zero indicates end of file
readBufNonBlocking :: RawIO dev => dev -> Buffer Word8
@@ -103,24 +105,30 @@ readBufNonBlocking :: RawIO dev => dev -> Buffer Word8
Buffer Word8)
readBufNonBlocking dev bbuf = do
let bytes = bufferAvailable bbuf
+ let offset = bufferOffset bbuf
res <- withBuffer bbuf $ \ptr ->
- IODevice.readNonBlocking dev (ptr `plusPtr` bufR bbuf) bytes
+ IODevice.readNonBlocking dev (ptr `plusPtr` bufR bbuf) offset bytes
case res of
Nothing -> return (Nothing, bbuf)
- Just n -> return (Just n, bbuf{ bufR = bufR bbuf + n })
+ Just n -> do let bbuf' = bufferAddOffset n bbuf
+ return (Just n, bbuf'{ bufR = bufR bbuf' + n })
writeBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Buffer Word8)
writeBuf dev bbuf = do
let bytes = bufferElems bbuf
+ let offset = bufferOffset bbuf
withBuffer bbuf $ \ptr ->
- IODevice.write dev (ptr `plusPtr` bufL bbuf) bytes
- return bbuf{ bufL=0, bufR=0 }
+ IODevice.write dev (ptr `plusPtr` bufL bbuf) offset bytes
+ let bbuf' = bufferAddOffset bytes bbuf
+ return bbuf'{ bufL=0, bufR=0 }
-- XXX ToDo
writeBufNonBlocking :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)
writeBufNonBlocking dev bbuf = do
let bytes = bufferElems bbuf
+ let offset = bufferOffset bbuf
res <- withBuffer bbuf $ \ptr ->
- IODevice.writeNonBlocking dev (ptr `plusPtr` bufL bbuf) bytes
- return (res, bufferAdjustL (bufL bbuf + res) bbuf)
+ IODevice.writeNonBlocking dev (ptr `plusPtr` bufL bbuf) offset bytes
+ let bbuf' = bufferAddOffset bytes bbuf
+ return (res, bufferAdjustL (bufL bbuf + res) bbuf')
diff --git a/libraries/base/GHC/IO/Device.hs b/libraries/base/GHC/IO/Device.hs
index 024ff7bbbb..0f244ae626 100644
--- a/libraries/base/GHC/IO/Device.hs
+++ b/libraries/base/GHC/IO/Device.hs
@@ -34,26 +34,29 @@ import GHC.IO
import {-# SOURCE #-} GHC.IO.Exception ( unsupportedOperation )
-- | A low-level I/O provider where the data is bytes in memory.
+-- The Word64 offsets currently have no effect on POSIX system or consoles
+-- where the implicit behaviour of the C runtime is assume to move the file
+-- pointer on every read/write without needing an explicit seek.
class RawIO a where
- -- | Read up to the specified number of bytes, returning the number
- -- of bytes actually read. This function should only block if there
- -- is no data available. If there is not enough data available,
- -- then the function should just return the available data. A return
- -- value of zero indicates that the end of the data stream (e.g. end
+ -- | Read up to the specified number of bytes starting from a specified
+ -- offset, returning the number of bytes actually read. This function
+ -- should only block if there is no data available. If there is not enough
+ -- data available, then the function should just return the available data.
+ -- A return value of zero indicates that the end of the data stream (e.g. end
-- of file) has been reached.
- read :: a -> Ptr Word8 -> Int -> IO Int
+ read :: a -> Ptr Word8 -> Word64 -> Int -> IO Int
- -- | Read up to the specified number of bytes, returning the number
- -- of bytes actually read, or 'Nothing' if the end of the stream has
- -- been reached.
- readNonBlocking :: a -> Ptr Word8 -> Int -> IO (Maybe Int)
+ -- | Read up to the specified number of bytes starting from a specified
+ -- offset, returning the number of bytes actually read, or 'Nothing' if
+ -- the end of the stream has been reached.
+ readNonBlocking :: a -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
- -- | Write the specified number of bytes.
- write :: a -> Ptr Word8 -> Int -> IO ()
+ -- | Write the specified number of bytes starting at a given offset.
+ write :: a -> Ptr Word8 -> Word64 -> Int -> IO ()
- -- | Write up to the specified number of bytes without blocking. Returns
- -- the actual number of bytes written.
- writeNonBlocking :: a -> Ptr Word8 -> Int -> IO Int
+ -- | Write up to the specified number of bytes without blocking starting at a
+ -- given offset. Returns the actual number of bytes written.
+ writeNonBlocking :: a -> Ptr Word8 -> Word64 -> Int -> IO Int
-- | I/O operations required for implementing a 'System.IO.Handle'.
@@ -78,7 +81,7 @@ class IODevice a where
isSeekable _ = return False
-- | seek to the specified position in the data.
- seek :: a -> SeekMode -> Integer -> IO ()
+ seek :: a -> SeekMode -> Integer -> IO Integer
seek _ _ _ = ioe_unsupportedOperation
-- | return the current position in the data.
diff --git a/libraries/base/GHC/IO/Encoding/CodePage.hs b/libraries/base/GHC/IO/Encoding/CodePage.hs
index 42980b59bc..ef03e985fa 100644
--- a/libraries/base/GHC/IO/Encoding/CodePage.hs
+++ b/libraries/base/GHC/IO/Encoding/CodePage.hs
@@ -5,7 +5,8 @@
module GHC.IO.Encoding.CodePage(
#if defined(mingw32_HOST_OS)
codePageEncoding, mkCodePageEncoding,
- localeEncoding, mkLocaleEncoding
+ localeEncoding, mkLocaleEncoding, CodePage,
+ getCurrentCodePage
#endif
) where
@@ -32,19 +33,15 @@ import GHC.IO.Encoding.UTF8 (mkUTF8)
import GHC.IO.Encoding.UTF16 (mkUTF16le, mkUTF16be)
import GHC.IO.Encoding.UTF32 (mkUTF32le, mkUTF32be)
-#if defined(mingw32_HOST_OS)
-# if defined(i386_HOST_ARCH)
-# define WINDOWS_CCONV stdcall
-# elif defined(x86_64_HOST_ARCH)
-# define WINDOWS_CCONV ccall
-# else
-# error Unknown mingw32 arch
-# endif
-#endif
+import GHC.Windows (DWORD)
+
+#include "windows_cconv.h"
+
+type CodePage = DWORD
-- note CodePage = UInt which might not work on Win64. But the Win32 package
-- also has this issue.
-getCurrentCodePage :: IO Word32
+getCurrentCodePage :: IO CodePage
getCurrentCodePage = do
conCP <- getConsoleCP
if conCP > 0
diff --git a/libraries/base/GHC/IO/Encoding/CodePage/API.hs b/libraries/base/GHC/IO/Encoding/CodePage/API.hs
index 9c2dc0e85c..48afa90f69 100644
--- a/libraries/base/GHC/IO/Encoding/CodePage/API.hs
+++ b/libraries/base/GHC/IO/Encoding/CodePage/API.hs
@@ -27,7 +27,7 @@ import GHC.IO.Encoding.UTF16
import GHC.Num
import GHC.Show
import GHC.Real
-import GHC.Windows
+import GHC.Windows hiding (LPCSTR)
import GHC.ForeignPtr (castForeignPtr)
import System.Posix.Internals
@@ -41,15 +41,7 @@ debugIO s
| c_DEBUG_DUMP = puts s
| otherwise = return ()
-
-#if defined(i386_HOST_ARCH)
-# define WINDOWS_CCONV stdcall
-#elif defined(x86_64_HOST_ARCH)
-# define WINDOWS_CCONV ccall
-#else
-# error Unknown mingw32 arch
-#endif
-
+#include "windows_cconv.h"
type LPCSTR = Ptr Word8
@@ -188,10 +180,10 @@ saner code ibuf obuf = do
else return (why, bufL ibuf' - bufL ibuf, ibuf', obuf')
byteView :: Buffer CWchar -> Buffer Word8
-byteView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr bufRaw, bufSize = bufSize * 2, bufL = bufL * 2, bufR = bufR * 2 }
+byteView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr bufRaw, bufSize = bufSize * 2, bufOffset = 0, bufL = bufL * 2, bufR = bufR * 2 }
cwcharView :: Buffer Word8 -> Buffer CWchar
-cwcharView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr bufRaw, bufSize = half bufSize, bufL = half bufL, bufR = half bufR }
+cwcharView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr bufRaw, bufSize = half bufSize, bufOffset = 0, bufL = half bufL, bufR = half bufR }
where half x = case x `divMod` 2 of (y, 0) -> y
_ -> errorWithoutStackTrace "cwcharView: utf16_(encode|decode) (wrote out|consumed) non multiple-of-2 number of bytes"
diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs
index ad9b11564a..7d7c195000 100644
--- a/libraries/base/GHC/IO/FD.hs
+++ b/libraries/base/GHC/IO/FD.hs
@@ -436,14 +436,14 @@ setRaw fd raw = System.Posix.Internals.setCooked (fdFD fd) (not raw)
-- -----------------------------------------------------------------------------
-- Reading and Writing
-fdRead :: FD -> Ptr Word8 -> Int -> IO Int
-fdRead fd ptr bytes
+fdRead :: FD -> Ptr Word8 -> Word64 -> Int -> IO Int
+fdRead fd ptr _offset bytes
= do { r <- readRawBufferPtr "GHC.IO.FD.fdRead" fd ptr 0
(fromIntegral $ clampReadSize bytes)
; return (fromIntegral r) }
-fdReadNonBlocking :: FD -> Ptr Word8 -> Int -> IO (Maybe Int)
-fdReadNonBlocking fd ptr bytes = do
+fdReadNonBlocking :: FD -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
+fdReadNonBlocking fd ptr _offset bytes = do
r <- readRawBufferPtrNoBlock "GHC.IO.FD.fdReadNonBlocking" fd ptr
0 (fromIntegral $ clampReadSize bytes)
case fromIntegral r of
@@ -451,18 +451,18 @@ fdReadNonBlocking fd ptr bytes = do
n -> return (Just n)
-fdWrite :: FD -> Ptr Word8 -> Int -> IO ()
-fdWrite fd ptr bytes = do
+fdWrite :: FD -> Ptr Word8 -> Word64 -> Int -> IO ()
+fdWrite fd ptr _offset bytes = do
res <- writeRawBufferPtr "GHC.IO.FD.fdWrite" fd ptr 0
(fromIntegral $ clampWriteSize bytes)
let res' = fromIntegral res
if res' < bytes
- then fdWrite fd (ptr `plusPtr` res') (bytes - res')
+ then fdWrite fd (ptr `plusPtr` res') (_offset + fromIntegral res') (bytes - res')
else return ()
-- XXX ToDo: this isn't non-blocking
-fdWriteNonBlocking :: FD -> Ptr Word8 -> Int -> IO Int
-fdWriteNonBlocking fd ptr bytes = do
+fdWriteNonBlocking :: FD -> Ptr Word8 -> Word64 -> Int -> IO Int
+fdWriteNonBlocking fd ptr _offset bytes = do
res <- writeRawBufferPtrNoBlock "GHC.IO.FD.fdWriteNonBlocking" fd ptr 0
(fromIntegral $ clampWriteSize bytes)
return (fromIntegral res)
diff --git a/libraries/base/GHC/IO/Handle.hs b/libraries/base/GHC/IO/Handle.hs
index a847bcffca..6b00706fc0 100644
--- a/libraries/base/GHC/IO/Handle.hs
+++ b/libraries/base/GHC/IO/Handle.hs
@@ -56,7 +56,8 @@ import GHC.IO.Encoding
import GHC.IO.Buffer
import GHC.IO.BufferedIO ( BufferedIO )
import GHC.IO.Device as IODevice
-import GHC.IO.Handle.FD
+import GHC.IO.SmartHandles
+import GHC.IO.SubSystem
import GHC.IO.Handle.Lock
import GHC.IO.Handle.Types
import GHC.IO.Handle.Internals
@@ -120,6 +121,7 @@ hFileSize handle =
SemiClosedHandle -> ioe_semiclosedHandle
_ -> do flushWriteBuffer handle_
r <- IODevice.getSize dev
+ debugIO $ "hFileSize: " ++ show r ++ " " ++ show handle
if r /= -1
then return r
else ioException (IOError Nothing InappropriateType "hFileSize"
@@ -237,7 +239,7 @@ hSetBuffering handle mode =
-- for most common uses), so simply disable its use here.
NoBuffering -> IODevice.setRaw haDevice True
#else
- NoBuffering -> return ()
+ NoBuffering -> return () <!> IODevice.setRaw haDevice True
#endif
_ -> IODevice.setRaw haDevice False
@@ -402,22 +404,36 @@ hSeek :: Handle -> SeekMode -> Integer -> IO ()
hSeek handle mode offset =
wantSeekableHandle "hSeek" handle $ \ handle_@Handle__{..} -> do
debugIO ("hSeek " ++ show (mode,offset))
- buf <- readIORef haCharBuffer
+ cbuf <- readIORef haCharBuffer
+ bbuf <- readIORef haByteBuffer
+ debugIO $ "hSeek - bbuf:" ++ summaryBuffer bbuf
+ debugIO $ "hSeek - cbuf:" ++ summaryBuffer cbuf
- if isWriteBuffer buf
+ if isWriteBuffer cbuf
then do flushWriteBuffer handle_
- IODevice.seek haDevice mode offset
+ new_offset <- IODevice.seek haDevice mode offset
+ -- buffer has been updated, need to re-read it
+ bbuf1 <- readIORef haByteBuffer
+ let bbuf2 = bbuf1{ bufOffset = fromIntegral new_offset }
+ debugIO $ "hSeek - seek:: " ++ show offset ++
+ " - " ++ show new_offset
+ debugIO $ "hSeek - wr flush bbuf1:" ++ summaryBuffer bbuf2
+ writeIORef haByteBuffer bbuf2
else do
- let r = bufL buf; w = bufR buf
+ let r = bufL cbuf; w = bufR cbuf
if mode == RelativeSeek && isNothing haDecoder &&
offset >= 0 && offset < fromIntegral (w - r)
- then writeIORef haCharBuffer buf{ bufL = r + fromIntegral offset }
+ then writeIORef haCharBuffer cbuf{ bufL = r + fromIntegral offset }
else do
flushCharReadBuffer handle_
flushByteReadBuffer handle_
- IODevice.seek haDevice mode offset
+ -- read the updated values
+ bbuf2 <- readIORef haByteBuffer
+ new_offset <- IODevice.seek haDevice mode offset
+ debugIO $ "hSeek after: " ++ show new_offset
+ writeIORef haByteBuffer bbuf2{ bufOffset = fromIntegral new_offset }
-- | Computation 'hTell' @hdl@ returns the current position of the
@@ -433,13 +449,19 @@ hTell :: Handle -> IO Integer
hTell handle =
wantSeekableHandle "hGetPosn" handle $ \ handle_@Handle__{..} -> do
- posn <- IODevice.tell haDevice
+ -- TODO: Guard these on Windows
+ sub <- getIoSubSystem
+ posn <- if sub == IoNative
+ then (fromIntegral . bufOffset) `fmap` readIORef haByteBuffer
+ else IODevice.tell haDevice
-- we can't tell the real byte offset if there are buffered
-- Chars, so must flush first:
flushCharBuffer handle_
bbuf <- readIORef haByteBuffer
+ debugIO ("hTell bbuf (elems=" ++ show (bufferElems bbuf) ++ ")"
+ ++ summaryBuffer bbuf)
let real_posn
| isWriteBuffer bbuf = posn + fromIntegral (bufferElems bbuf)
@@ -448,7 +470,7 @@ hTell handle =
cbuf <- readIORef haCharBuffer
debugIO ("\nhGetPosn: (posn, real_posn) = " ++ show (posn, real_posn))
debugIO (" cbuf: " ++ summaryBuffer cbuf ++
- " bbuf: " ++ summaryBuffer bbuf)
+ " bbuf: " ++ summaryBuffer bbuf)
return real_posn
@@ -647,7 +669,7 @@ dupHandle filepath h other_side h_@Handle__{..} mb_finalizer = do
withHandle_' "dupHandle" h r $ \Handle__{haDevice=dev} -> do
dupHandle_ dev filepath other_side h_ mb_finalizer
-dupHandle_ :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
+dupHandle_ :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
-> FilePath
-> Maybe (MVar Handle__)
-> Handle__
diff --git a/libraries/base/GHC/IO/Handle/Internals.hs b/libraries/base/GHC/IO/Handle/Internals.hs
index c0b7e35a11..a93d8fa880 100644
--- a/libraries/base/GHC/IO/Handle/Internals.hs
+++ b/libraries/base/GHC/IO/Handle/Internals.hs
@@ -62,7 +62,8 @@ import GHC.IO.Handle.Types
import GHC.IO.Buffer
import GHC.IO.BufferedIO (BufferedIO)
import GHC.IO.Exception
-import GHC.IO.Device (IODevice, SeekMode(..))
+import GHC.IO.Device (IODevice, RawIO, SeekMode(..))
+import GHC.IO.SubSystem ((<!>))
import qualified GHC.IO.Device as IODevice
import qualified GHC.IO.BufferedIO as Buffered
@@ -93,8 +94,10 @@ newFileHandle :: FilePath -> Maybe HandleFinalizer -> Handle__ -> IO Handle
newFileHandle filepath mb_finalizer hc = do
m <- newMVar hc
case mb_finalizer of
- Just finalizer -> addMVarFinalizer m (finalizer filepath m)
- Nothing -> return ()
+ Just finalizer -> do debugIO $ "Registering finalizer: " ++ show filepath
+ addMVarFinalizer m (finalizer filepath m)
+ Nothing -> do debugIO $ "No finalizer: " ++ show filepath
+ return ()
return (FileHandle filepath m)
-- ---------------------------------------------------------------------------
@@ -504,6 +507,7 @@ flushByteWriteBuffer h_@Handle__{..} = do
bbuf <- readIORef haByteBuffer
when (not (isEmptyBuffer bbuf)) $ do
bbuf' <- Buffered.flushWriteBuffer haDevice bbuf
+ debugIO ("flushByteWriteBuffer: bbuf=" ++ summaryBuffer bbuf')
writeIORef haByteBuffer bbuf'
-- write the contents of the CharBuffer to the Handle__.
@@ -583,10 +587,11 @@ flushCharReadBuffer Handle__{..} = do
(bbuf1,cbuf1) <- (streamEncode decoder) bbuf0
cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
- debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
+ let bbuf2 = bbuf1 -- {bufOffset = bufOffset bbuf1 - fromIntegral (bufL bbuf1)}
+ debugIO ("finished, bbuf=" ++ summaryBuffer bbuf2 ++
" cbuf=" ++ summaryBuffer cbuf1)
- writeIORef haByteBuffer bbuf1
+ writeIORef haByteBuffer bbuf2
-- When flushing the byte read buffer, we seek backwards by the number
@@ -604,26 +609,32 @@ flushByteReadBuffer h_@Handle__{..} = do
when (not seekable) $ ioe_cannotFlushNotSeekable
let seek = negate (bufR bbuf - bufL bbuf)
+ let offset = bufOffset bbuf - fromIntegral (bufR bbuf - bufL bbuf)
debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
- IODevice.seek haDevice RelativeSeek (fromIntegral seek)
+ debugIO ("flushByteReadBuffer: " ++ summaryBuffer bbuf)
- writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }
+ let mIOSeek = IODevice.seek haDevice RelativeSeek (fromIntegral seek)
+ -- win-io doesn't need this, but it allows us to error out on invalid offsets
+ let winIOSeek = IODevice.seek haDevice AbsoluteSeek (fromIntegral offset)
+
+ _ <- mIOSeek <!> winIOSeek -- execute one of these two seek functions
+
+ writeIORef haByteBuffer bbuf{ bufL=0, bufR=0, bufOffset=offset }
-- ----------------------------------------------------------------------------
-- Making Handles
-mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
- -> FilePath
- -> HandleType
- -> Bool -- buffered?
- -> Maybe TextEncoding
- -> NewlineMode
- -> Maybe HandleFinalizer
- -> Maybe (MVar Handle__)
- -> IO Handle
-
-mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
+mkHandle :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
+ -> FilePath
+ -> HandleType
+ -> Bool -- buffered?
+ -> Maybe TextEncoding
+ -> NewlineMode
+ -> Maybe HandleFinalizer
+ -> Maybe (MVar Handle__)
+ -> IO Handle
+mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side =
openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
let buf_state = initBufferState ha_type
@@ -636,6 +647,7 @@ mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
else mkUnBuffer buf_state
spares <- newIORef BufferListNil
+ debugIO $ "making handle for " ++ filepath
newFileHandle filepath finalizer
(Handle__ { haDevice = dev,
haType = ha_type,
@@ -653,7 +665,7 @@ mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
})
-- | makes a new 'Handle'
-mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)
+mkFileHandle :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev)
=> dev -- ^ the underlying IO device, which must support
-- 'IODevice', 'BufferedIO' and 'Typeable'
-> FilePath
@@ -674,7 +686,7 @@ mkFileHandle dev filepath iomode mb_codec tr_newlines = do
-- | like 'mkFileHandle', except that a 'Handle' is created with two
-- independent buffers, one for reading and one for writing. Used for
-- full-duplex streams, such as network sockets.
-mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
+mkDuplexHandle :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
-> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
mkDuplexHandle dev filepath mb_codec tr_newlines = do
@@ -840,7 +852,9 @@ readTextDevice h_@Handle__{..} cbuf = do
bbuf1 <- if not (isEmptyBuffer bbuf0)
then return bbuf0
else do
+ debugIO $ "readBuf at " ++ show (bufferOffset bbuf0)
(r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
+ debugIO $ "readBuf after " ++ show (bufferOffset bbuf1)
if r == 0 then ioe_EOF else do -- raise EOF
return bbuf1
diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs
index 20a449f39d..07a619dd40 100644
--- a/libraries/base/GHC/IO/Handle/Text.hs
+++ b/libraries/base/GHC/IO/Handle/Text.hs
@@ -32,7 +32,6 @@ module GHC.IO.Handle.Text (
) where
import GHC.IO
-import GHC.IO.FD
import GHC.IO.Buffer
import qualified GHC.IO.BufferedIO as Buffered
import GHC.IO.Exception
@@ -46,7 +45,6 @@ import Foreign
import Foreign.C
import qualified Control.Exception as Exception
-import Data.Typeable
import System.IO.Error
import Data.Either (Either(..))
import Data.Maybe
@@ -717,7 +715,7 @@ commitBuffer hdl !raw !sz !count flush release =
debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
++ ", flush=" ++ show flush ++ ", release=" ++ show release)
- writeCharBuffer h_ Buffer{ bufRaw=raw, bufState=WriteBuffer,
+ writeCharBuffer h_ Buffer{ bufRaw=raw, bufState=WriteBuffer, bufOffset=0,
bufL=0, bufR=count, bufSize=sz }
when flush $ flushByteWriteBuffer h_
@@ -741,7 +739,7 @@ commitBuffer' raw sz@(I# _) count@(I# _) flush release h_@Handle__{..}
++ ", flush=" ++ show flush ++ ", release=" ++ show release)
let this_buf = Buffer{ bufRaw=raw, bufState=WriteBuffer,
- bufL=0, bufR=count, bufSize=sz }
+ bufL=0, bufR=count, bufSize=sz, bufOffset=0 }
writeCharBuffer h_ this_buf
@@ -819,7 +817,7 @@ hPutBuf' handle ptr count can_block
bufWrite :: Handle__-> Ptr Word8 -> Int -> Bool -> IO Int
bufWrite h_@Handle__{..} ptr count can_block =
seq count $ do -- strictness hack
- old_buf@Buffer{ bufRaw=old_raw, bufR=w, bufSize=size }
+ old_buf@Buffer{ bufRaw=old_raw, bufR=w, bufSize=size, bufOffset=offset }
<- readIORef haByteBuffer
-- TODO: Possible optimisation:
@@ -860,19 +858,17 @@ bufWrite h_@Handle__{..} ptr count can_block =
if count < size
then bufWrite h_ ptr count can_block
else if can_block
- then do writeChunk h_ (castPtr ptr) count
+ then do writeChunk h_ (castPtr ptr) offset count
return count
- else writeChunkNonBlocking h_ (castPtr ptr) count
+ else writeChunkNonBlocking h_ (castPtr ptr) offset count
-writeChunk :: Handle__ -> Ptr Word8 -> Int -> IO ()
-writeChunk h_@Handle__{..} ptr bytes
- | Just fd <- cast haDevice = RawIO.write (fd::FD) ptr bytes
- | otherwise = error "Todo: hPutBuf"
+writeChunk :: Handle__ -> Ptr Word8 -> Word64 -> Int -> IO ()
+writeChunk h_@Handle__{..} ptr offset bytes
+ = RawIO.write haDevice ptr offset bytes
-writeChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int
-writeChunkNonBlocking h_@Handle__{..} ptr bytes
- | Just fd <- cast haDevice = RawIO.writeNonBlocking (fd::FD) ptr bytes
- | otherwise = error "Todo: hPutBuf"
+writeChunkNonBlocking :: Handle__ -> Ptr Word8 -> Word64 -> Int -> IO Int
+writeChunkNonBlocking h_@Handle__{..} ptr offset bytes
+ = RawIO.writeNonBlocking haDevice ptr offset bytes
-- ---------------------------------------------------------------------------
-- hGetBuf
@@ -898,12 +894,16 @@ hGetBuf h !ptr count
| count < 0 = illegalBufferSize h "hGetBuf" count
| otherwise =
wantReadableHandle_ "hGetBuf" h $ \ h_@Handle__{..} -> do
- flushCharReadBuffer h_
- buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
+ debugIO $ ":: hGetBuf - " ++ show h
+ flushCharReadBuffer h_
+ buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
<- readIORef haByteBuffer
- if isEmptyBuffer buf
- then bufReadEmpty h_ buf (castPtr ptr) 0 count
- else bufReadNonEmpty h_ buf (castPtr ptr) 0 count
+ debugIO ("hGetBuf: " ++ summaryBuffer buf)
+ res <- if isEmptyBuffer buf
+ then bufReadEmpty h_ buf (castPtr ptr) 0 count
+ else bufReadNonEmpty h_ buf (castPtr ptr) 0 count
+ debugIO "** hGetBuf done."
+ return res
-- small reads go through the buffer, large reads are satisfied by
-- taking data first from the buffer and then direct from the file
@@ -914,8 +914,9 @@ bufReadNonEmpty h_@Handle__{..}
buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
ptr !so_far !count
= do
+ debugIO ":: bufReadNonEmpty"
let avail = w - r
- if (count < avail)
+ if (count <= avail)
then do
copyFromRawBuffer ptr raw r count
writeIORef haByteBuffer buf{ bufL = r + count }
@@ -929,6 +930,7 @@ bufReadNonEmpty h_@Handle__{..}
so_far' = so_far + avail
ptr' = ptr `plusPtr` avail
+ debugIO ("bufReadNonEmpty: " ++ summaryBuffer buf' ++ " s:" ++ show so_far' ++ " r:" ++ show remaining)
if remaining == 0
then return so_far'
else bufReadEmpty h_ buf' ptr' so_far' remaining
@@ -936,9 +938,14 @@ bufReadNonEmpty h_@Handle__{..}
bufReadEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadEmpty h_@Handle__{..}
- buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
+ buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz, bufOffset=bff }
ptr so_far count
- | count > sz, Just fd <- cast haDevice = loop fd 0 count
+ | count > sz = do count <- loop haDevice 0 bff count
+ let buf1 = bufferAddOffset (fromIntegral count) buf
+ -- let buf2 = buf1 { bufR = w + count }
+ writeIORef haByteBuffer buf1
+ debugIO ("bufReadEmpty: " ++ summaryBuffer buf1)
+ return count
| otherwise = do
(r,buf') <- Buffered.fillReadBuffer haDevice buf
if r == 0
@@ -946,13 +953,15 @@ bufReadEmpty h_@Handle__{..}
else do writeIORef haByteBuffer buf'
bufReadNonEmpty h_ buf' ptr so_far count
where
- loop :: FD -> Int -> Int -> IO Int
- loop fd off bytes | bytes <= 0 = return (so_far + off)
- loop fd off bytes = do
- r <- RawIO.read (fd::FD) (ptr `plusPtr` off) bytes
+ loop :: RawIO.RawIO dev => dev -> Int -> Word64 -> Int -> IO Int
+ loop dev delta off bytes | bytes <= 0 = return (so_far + delta)
+ loop dev delta off bytes = do
+ r <- RawIO.read dev (ptr `plusPtr` delta) off bytes
+ debugIO $ show ptr ++ " - loop read@" ++ show delta ++ ": " ++ show r
+ debugIO $ "next:" ++ show (delta + r) ++ " - left:" ++ show (bytes - r)
if r == 0
- then return (so_far + off)
- else loop fd (off + r) (bytes - r)
+ then return (so_far + delta)
+ else loop dev (delta + r) (off + fromIntegral r) (bytes - r)
-- ---------------------------------------------------------------------------
-- hGetBufSome
@@ -984,7 +993,7 @@ hGetBufSome h !ptr count
buf@Buffer{ bufSize=sz } <- readIORef haByteBuffer
if isEmptyBuffer buf
then case count > sz of -- large read? optimize it with a little special case:
- True | Just fd <- haFD h_ -> do RawIO.read fd (castPtr ptr) count
+ True -> RawIO.read haDevice (castPtr ptr) 0 count
_ -> do (r,buf') <- Buffered.fillReadBuffer haDevice buf
if r == 0
then return 0
@@ -997,9 +1006,6 @@ hGetBufSome h !ptr count
let count' = min count (bufferElems buf)
in bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count'
-haFD :: Handle__ -> Maybe FD
-haFD h_@Handle__{..} = cast haDevice
-
-- | '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
@@ -1034,11 +1040,11 @@ hGetBufNonBlocking h !ptr count
bufReadNBEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNBEmpty h_@Handle__{..}
- buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
+ buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz
+ , bufOffset=offset }
ptr so_far count
- | count > sz,
- Just fd <- cast haDevice = do
- m <- RawIO.readNonBlocking (fd::FD) ptr count
+ | count > sz = do
+ m <- RawIO.readNonBlocking haDevice ptr offset count
case m of
Nothing -> return so_far
Just n -> return (so_far + n)
diff --git a/libraries/base/GHC/IO/Handle/Types.hs b/libraries/base/GHC/IO/Handle/Types.hs
index 6923d252b9..71c75d98b1 100644
--- a/libraries/base/GHC/IO/Handle/Types.hs
+++ b/libraries/base/GHC/IO/Handle/Types.hs
@@ -119,7 +119,7 @@ instance Eq Handle where
_ == _ = False
data Handle__
- = forall dev enc_state dec_state . (IODevice dev, BufferedIO dev, Typeable dev) =>
+ = forall dev enc_state dec_state . (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
Handle__ {
haDevice :: !dev,
haType :: HandleType, -- type (read/write/append etc.)
diff --git a/libraries/base/GHC/TopHandler.hs b/libraries/base/GHC/TopHandler.hs
index bb358a337f..324b34d656 100644
--- a/libraries/base/GHC/TopHandler.hs
+++ b/libraries/base/GHC/TopHandler.hs
@@ -40,8 +40,8 @@ import GHC.Base
import GHC.Conc hiding (throwTo)
import GHC.Real
import GHC.IO
-import GHC.IO.Handle.FD
import GHC.IO.Handle
+import GHC.IO.SmartHandles
import GHC.IO.Exception
import GHC.Weak
diff --git a/libraries/base/GHC/Windows.hs b/libraries/base/GHC/Windows.hs
index 45032d56ac..d8f8bef804 100644
--- a/libraries/base/GHC/Windows.hs
+++ b/libraries/base/GHC/Windows.hs
@@ -26,11 +26,22 @@ module GHC.Windows (
LPBOOL,
BYTE,
DWORD,
+ DDWORD,
UINT,
+ ULONG,
ErrCode,
HANDLE,
LPWSTR,
LPTSTR,
+ LPCTSTR,
+ LPVOID,
+ LPDWORD,
+ LPSTR,
+ LPCSTR,
+ LPCWSTR,
+ WORD,
+ UCHAR,
+ NTSTATUS,
-- * Constants
iNFINITE,
@@ -56,39 +67,67 @@ module GHC.Windows (
-- $errno
c_maperrno,
c_maperrno_func,
+
+ -- * Misc
+ ddwordToDwords,
+ dwordsToDdword,
+ nullHANDLE,
) where
+import Data.Bits (shiftL, shiftR, (.|.), (.&.))
import Data.Char
import Data.OldList
import Data.Maybe
import Data.Word
+import Data.Int
import Foreign.C.Error
import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr
import GHC.Base
+import GHC.Enum (maxBound)
import GHC.IO
import GHC.Num
+import GHC.Real (fromIntegral)
import System.IO.Error
import qualified Numeric
-#if defined(i386_HOST_ARCH)
-# define WINDOWS_CCONV stdcall
-#elif defined(x86_64_HOST_ARCH)
-# define WINDOWS_CCONV ccall
+#if MIN_VERSION_base(4,7,0)
+import Data.Bits (finiteBitSize)
#else
-# error Unknown mingw32 arch
+import Data.Bits (Bits, bitSize)
+
+finiteBitSize :: (Bits a) => a -> Int
+finiteBitSize = bitSize
#endif
-type BOOL = Bool
-type LPBOOL = Ptr BOOL
-type BYTE = Word8
-type DWORD = Word32
-type UINT = Word32
-type ErrCode = DWORD
-type HANDLE = Ptr ()
-type LPWSTR = Ptr CWchar
+#include "windows_cconv.h"
+
+type BOOL = Bool
+type LPBOOL = Ptr BOOL
+type BYTE = Word8
+type DWORD = Word32
+type UINT = Word32
+type ULONG = Word32
+type ErrCode = DWORD
+type HANDLE = Ptr ()
+type LPWSTR = Ptr CWchar
+type LPCTSTR = LPTSTR
+type LPVOID = Ptr ()
+type LPDWORD = Ptr DWORD
+type LPSTR = Ptr CChar
+type LPCSTR = LPSTR
+type LPCWSTR = LPWSTR
+type WORD = Word16
+type UCHAR = Word8
+type NTSTATUS = Int32
+
+nullHANDLE :: HANDLE
+nullHANDLE = nullPtr
+
+-- Not really a basic type, but used in many places
+type DDWORD = Word64
-- | Be careful with this. LPTSTR can mean either WCHAR* or CHAR*, depending
-- on whether the UNICODE macro is defined in the corresponding C code.
@@ -194,3 +233,15 @@ foreign import WINDOWS_CCONV unsafe "windows.h LocalFree"
-- | Get the last system error produced in the current thread.
foreign import WINDOWS_CCONV unsafe "windows.h GetLastError"
getLastError :: IO ErrCode
+
+----------------------------------------------------------------
+-- Misc helpers
+----------------------------------------------------------------
+
+ddwordToDwords :: DDWORD -> (DWORD,DWORD)
+ddwordToDwords n =
+ (fromIntegral (n `shiftR` finiteBitSize (undefined :: DWORD))
+ ,fromIntegral (n .&. fromIntegral (maxBound :: DWORD)))
+
+dwordsToDdword:: (DWORD,DWORD) -> DDWORD
+dwordsToDdword (hi,low) = (fromIntegral low) .|. (fromIntegral hi `shiftL` finiteBitSize hi)
diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs
index a4d4ec4e67..c5c0f15414 100644
--- a/libraries/base/System/IO.hs
+++ b/libraries/base/System/IO.hs
@@ -245,13 +245,14 @@ import GHC.IORef
import GHC.Num
import GHC.IO hiding ( bracket, onException )
import GHC.IO.IOMode
-import GHC.IO.Handle.FD
import qualified GHC.IO.FD as FD
import GHC.IO.Handle
+import qualified GHC.IO.Handle.FD as POSIX
import GHC.IO.Handle.Text ( hGetBufSome, hPutStrLn )
import GHC.IO.Exception ( userError )
import GHC.IO.Encoding
import Text.Read
+import GHC.IO.SmartHandles
import GHC.Show
import GHC.MVar
@@ -534,7 +535,7 @@ openTempFile' loc tmp_dir template binary mode
withCWString tmp_dir $ \c_tmp_dir ->
withCWString label $ \c_template ->
withCWString suffix $ \c_suffix ->
- -- NOTE: revisit this when new I/O manager in place and use a UUID
+ -- FIXME: revisit this when new I/O manager in place and use a UUID
-- based one when we are no longer MAX_PATH bound.
allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do
res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0
@@ -561,7 +562,7 @@ openTempFile' loc tmp_dir template binary mode
True{-is_nonblock-}
enc <- getLocaleEncoding
- h <- mkHandleFromFD fD fd_type filename ReadWriteMode
+ h <- POSIX.mkHandleFromFD fD fd_type filename ReadWriteMode
False{-set non-block-} (Just enc)
return (filename, h)
@@ -588,7 +589,7 @@ output_flags = std_flags
True{-is_nonblock-}
enc <- getLocaleEncoding
- h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
+ h <- POSIX.mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
return (filepath, h)
diff --git a/libraries/base/include/windows_cconv.h b/libraries/base/include/windows_cconv.h
new file mode 100644
index 0000000000..4fa84071c8
--- /dev/null
+++ b/libraries/base/include/windows_cconv.h
@@ -0,0 +1,12 @@
+#if !defined(__WINDOWS_CCONV_H)
+#define __WINDOWS_CCONV_H
+
+#if defined(i386_HOST_ARCH)
+# define WINDOWS_CCONV stdcall
+#elif defined(x86_64_HOST_ARCH)
+# define WINDOWS_CCONV ccall
+#else
+# error Unknown mingw32 arch
+#endif
+
+#endif
diff --git a/libraries/haskeline b/libraries/haskeline
-Subproject d3885e4bc1dfe6b06829871361bf9330414fc9e
+Subproject 5f16b76168f13c6413413386efc44fb1152048d
diff --git a/libraries/process b/libraries/process
-Subproject 8f4ecebb6578a179a6c04074cb06600683e2e50
+Subproject cb1d1a6ead68f0e1b209277e79ec608980e9ac8
diff --git a/utils/hsc2hs b/utils/hsc2hs
-Subproject e792dd8e5589d42a4d416f78df8efb70995f95e
+Subproject 7accbea001bcac638c4320d3755af2947811490
View Lorry Controller Status