Commit b2599d31 authored by Mart Lubbers's avatar Mart Lubbers

Add readPipe*N variants and readPipe reads pipebuffer

parent 02fdcabc
Pipeline #42003 failed with stage
in 1 minute
......@@ -3,6 +3,7 @@ definition module System._Posix
from System._Pointer import :: Pointer
from StdInt import IF_INT_64_OR_32
from System.Time import :: Tm, :: Timespec
from System.OSError import :: MaybeOSError, :: MaybeError, :: OSError, :: OSErrorMessage, :: OSErrorCode
WNOHANG :== 0x00000001
WUNTRACED :== 0x00000002
......@@ -27,6 +28,8 @@ STDERR_FILENO :== 2
FIONREAD :== 0x541B
F_GETPIPE_SZ :== 0x408
F_SETFD :== 2
FD_CLOEXEC :== 1
......@@ -105,3 +108,5 @@ memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer
//Mapping to/from byte arrays
unpackStat :: !{#Char} -> Stat
sizeOfStat :: Int
pipeBufferSize :: !Int !*w -> (!MaybeOSError Int, !*w)
......@@ -2,6 +2,7 @@ implementation module System._Posix
import System._Pointer, System.Time
import StdInt
import System.OSError
errno :: !*w -> (!Int,!*w)
errno world = (getErrno,world)
......@@ -211,3 +212,9 @@ unpackStat s =
sizeOfStat :: Int
sizeOfStat = IF_INT_64_OR_32 144 88
pipeBufferSize :: !Int !*w -> (!MaybeOSError Int, !*w)
pipeBufferSize fd world
# (res, world) = fcntlArg fd F_GETPIPE_SZ 0 world
| res == -1 = getLastOSError world
= (Ok res, world)
......@@ -106,3 +106,5 @@ memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer
//Mapping to/from byte arrays
unpackStat :: !{#Char} -> Stat
sizeOfStat :: Int
pipeBufferSize :: !Int !*w -> (!MaybeOSError Int, !*w)
......@@ -209,3 +209,6 @@ unpackStat s =
sizeOfStat :: Int
sizeOfStat = 144
pipeBufferSize :: !Int !*w -> (!MaybeOSError Int, !*w)
pipeBufferSize fd world = (Ok 65336, world)
......@@ -97,7 +97,16 @@ callProcess :: !FilePath ![String] !(Maybe String) !*World -> (MaybeOSError Int,
* @param the pipe to read from
* @return the data read from the pipe
*/
readPipeNonBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World)
readPipeNonBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World)
/**
* read at most n bytes from the pipe
* without blocking if no data is available
* @param the pipe to read from
* @param n
* @return the data read from the pipe
*/
readPipeNonBlockingN :: !ReadPipe !Int !*World -> (!MaybeOSError String, !*World)
/**
* read the currently available string from the pipe
......@@ -105,7 +114,16 @@ readPipeNonBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World
* @param the pipe to read from
* @return the data read from the pipe (at least one character)
*/
readPipeBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World)
readPipeBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World)
/**
* read at most n bytes from the pipe
* and blocks until some data is available
* @param the pipe to read from
* @param n
* @return the data read from the pipe (at least one character)
*/
readPipeBlockingN :: !ReadPipe !Int !*World -> (!MaybeOSError String, !*World)
/**
* read the currently available string from a number of pipes
......
......@@ -24,8 +24,6 @@ import System._Posix
import Text.GenJSON
DEFAULT_READ_BUF :== 1024
:: WritePipe = WritePipe !Int
:: ReadPipe = ReadPipe !Int
......@@ -353,7 +351,11 @@ callProcess path args mCurrentDirectory world
Error e = (Error e, world)
readPipeNonBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World)
readPipeNonBlocking (ReadPipe fd) world
readPipeNonBlocking pipe=:(ReadPipe fd) world
= seqErrorsSt (pipeBufferSize fd) (readPipeNonBlockingN pipe) world
readPipeNonBlockingN :: !ReadPipe !Int !*World -> (!MaybeOSError String, !*World)
readPipeNonBlockingN (ReadPipe fd) n world
# (timeout, world) = mallocSt 16 world
| timeout == 0 = getLastOSError world
# timeout = IF_INT_64_OR_32
......@@ -362,14 +364,18 @@ readPipeNonBlocking (ReadPipe fd) world
# ((res, world), timeout) = readP (\ptr->readSelect [fd] ptr world) timeout
# world = freeSt timeout world
| isError res = (liftError res, world)
| and (fromOk res) = realRead fd world
| and (fromOk res) = realRead fd n world
= (Ok "", world)
readPipeBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World)
readPipeBlocking (ReadPipe fd) world
readPipeBlocking pipe=:(ReadPipe fd) world
= seqErrorsSt (pipeBufferSize fd) (readPipeBlockingN pipe) world
readPipeBlockingN :: !ReadPipe !Int !*World -> (!MaybeOSError String, !*World)
readPipeBlockingN (ReadPipe fd) n world
# (res, world) = readSelect [fd] 0 world
| isError res = (liftError res, world)
= realRead fd world
= realRead fd n world
readPipeBlockingMulti :: ![ReadPipe] !*World -> (!MaybeOSError [String], !*World)
readPipeBlockingMulti pipes world
......@@ -378,8 +384,11 @@ readPipeBlockingMulti pipes world
= seq
[ \(res, world) -> case res of
Ok res`
# (res, world) = pipeBufferSize fd world
| isError res = (liftError res, world)
# (Ok bufsize) = res
# (r, world) = if ready
(realRead fd world)
(realRead fd bufsize world)
(Ok "", world)
= (seqErrors r (\r` -> Ok [r`:res`]), world)
error = (error, world)
......@@ -387,11 +396,11 @@ readPipeBlockingMulti pipes world
]
(Ok [], world)
realRead :: !Int !*World -> (!MaybeOSError String, !*World)
realRead fd world
# (buf, world) = mallocSt DEFAULT_READ_BUF world
realRead :: !Int !Int !*World -> (!MaybeOSError String, !*World)
realRead fd bufsize world
# (buf, world) = mallocSt bufsize world
| buf == 0 = getLastOSError world
# (res, world) = read fd buf DEFAULT_READ_BUF world
# (res, world) = read fd buf bufsize world
| res == -1
= getLastOSError (freeSt buf world)
# (str, buf) = readP (\ptr->derefCharArray ptr res) buf
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment