Commit fc35030b authored by Steffen Michels's avatar Steffen Michels

enforce correct order of 'free' calls in System.Input; introduced variant of...

enforce correct order of 'free' calls in System.Input; introduced variant of 'free' using unique state, as other methods to enforce order are too error prone
parent de1a8939
...@@ -60,6 +60,7 @@ kill :: !Int !Int !*w -> (!Int, !*w) ...@@ -60,6 +60,7 @@ kill :: !Int !Int !*w -> (!Int, !*w)
//Memory (impure) //Memory (impure)
malloc :: !Int -> Pointer malloc :: !Int -> Pointer
free :: !Pointer -> Int free :: !Pointer -> Int
freeSt :: !Pointer !*w -> *w
memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer
//Posix datastructures //Posix datastructures
......
...@@ -130,6 +130,10 @@ free :: !Pointer -> Int ...@@ -130,6 +130,10 @@ free :: !Pointer -> Int
free ptr = code { free ptr = code {
ccall free "p:I" ccall free "p:I"
} }
freeSt :: !Pointer !*w -> *w
freeSt ptr world = code {
ccall free "p:V:A"
}
memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer
memcpy_string_to_pointer p s n = code { memcpy_string_to_pointer p s n = code {
ccall memcpy "psp:p" ccall memcpy "psp:p"
......
...@@ -153,8 +153,7 @@ runProcessMakeArgv argv_list world ...@@ -153,8 +153,7 @@ runProcessMakeArgv argv_list world
= abort "malloc failed" = abort "malloc failed"
# args_memory = memcpy_string_to_pointer args_memory args_string args_size # args_memory = memcpy_string_to_pointer args_memory args_string args_size
# (argv, args_memory) = readP (createArgv argv_list) args_memory # (argv, args_memory) = readP (createArgv argv_list) args_memory
#!fRes = free args_memory # world = freeSt args_memory world
| fRes <> fRes = undef
= (argv, world) = (argv, world)
where where
argvLength [a:as] l argvLength [a:as] l
...@@ -194,17 +193,15 @@ where ...@@ -194,17 +193,15 @@ where
openPipe :: !*World -> (MaybeOSError (Int, Int), !*World) openPipe :: !*World -> (MaybeOSError (Int, Int), !*World)
openPipe world openPipe world
#! ptr = malloc 8 # ptr = malloc 8
| ptr == 0 = abort "malloc failed" | ptr == 0 = abort "malloc failed"
#! (res, world) = pipe ptr world # (res, world) = pipe ptr world
| res == -1 | res == -1
# fRes = free ptr # world = freeSt ptr world
| fRes <> fRes = undef
= getLastOSError world = getLastOSError world
# (rEnd, ptr) = readP (\ptr -> readInt4S ptr 0) ptr # (rEnd, ptr) = readP (\ptr -> readInt4S ptr 0) ptr
# (wEnd, ptr) = readP (\ptr -> readInt4S ptr 4) ptr # (wEnd, ptr) = readP (\ptr -> readInt4S ptr 4) ptr
#! fRes = free ptr # world = freeSt ptr world
| fRes <> fRes = undef
= (Ok (rEnd, wEnd), world) = (Ok (rEnd, wEnd), world)
checkProcess :: !ProcessHandle !*World -> (MaybeOSError (Maybe Int), *World) checkProcess :: !ProcessHandle !*World -> (MaybeOSError (Maybe Int), *World)
...@@ -240,24 +237,20 @@ callProcess path args mCurrentDirectory world ...@@ -240,24 +237,20 @@ callProcess path args mCurrentDirectory world
readPipeNonBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World) readPipeNonBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World)
readPipeNonBlocking (ReadPipe fd) world readPipeNonBlocking (ReadPipe fd) world
# ptr = malloc 4 # ptr = malloc 4
#! (res, world) = ioctl fd FIONREAD ptr world # (res, world) = ioctl fd FIONREAD ptr world
| res == -1 | res == -1
#! fRes = free ptr # world = freeSt ptr world
| fRes <> fRes = undef
= getLastOSError world = getLastOSError world
# (n, ptr) = readP (\ptr -> readInt4Z ptr 0) ptr # (n, ptr) = readP (\ptr -> readInt4Z ptr 0) ptr
#! fRes = free ptr # world = freeSt ptr world
| fRes <> fRes = undef
| n == 0 = (Ok "", world) | n == 0 = (Ok "", world)
# buffer = malloc n # buffer = malloc n
#! (res, world) = read fd buffer n world # (res, world) = read fd buffer n world
| res == -1 | res == -1
#! fRes = free buffer # world = freeSt buffer world
| fRes <> fRes = undef
= getLastOSError world = getLastOSError world
#(str, buffer) = readP (\ptr -> derefCharArray ptr n) buffer # (str, buffer) = readP (\ptr -> derefCharArray ptr n) buffer
#!fRes = free buffer # world = freeSt buffer world
| fRes <> fRes = undef
= (Ok str, world) = (Ok str, world)
readPipeBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World) readPipeBlocking :: !ReadPipe !*World -> (!MaybeOSError String, !*World)
...@@ -266,13 +259,10 @@ readPipeBlocking pipe=:(ReadPipe fd) world ...@@ -266,13 +259,10 @@ readPipeBlocking pipe=:(ReadPipe fd) world
// init array // init array
# readfds = seq [\ptr -> writeIntElemOffset ptr i 0 \\ i <- [0..IF_INT_64_OR_32 15 31]] readfds # readfds = seq [\ptr -> writeIntElemOffset ptr i 0 \\ i <- [0..IF_INT_64_OR_32 15 31]] readfds
// set bit for fd // set bit for fd
# offset = fromInt fd / IF_INT_64_OR_32 64 32 # readfds = readPipeBlockingSetFdBit fd readfds
# val = (readIntElemOffset readfds offset) bitor (1 << (fd rem IF_INT_64_OR_32 64 32))
# readfds = writeIntElemOffset readfds offset val
// wait // wait
#! (res, world) = select_ (fd + 1) readfds 0 0 0 world # (res, world) = select_ (fd + 1) readfds 0 0 0 world
#!fRes = free readfds # world = freeSt readfds world
| fRes <> fRes = undef
| res == -1 = getLastOSError world | res == -1 = getLastOSError world
= readPipeNonBlocking pipe world = readPipeNonBlocking pipe world
...@@ -282,11 +272,10 @@ readPipeBlockingMulti pipes world ...@@ -282,11 +272,10 @@ readPipeBlockingMulti pipes world
// init array // init array
#readfds = seq [\ptr -> writeIntElemOffset ptr i 0 \\ i <- [0..IF_INT_64_OR_32 15 31]] readfds #readfds = seq [\ptr -> writeIntElemOffset ptr i 0 \\ i <- [0..IF_INT_64_OR_32 15 31]] readfds
// set bits for fds // set bits for fds
#readfds = seq [setFdBit fd \\ ReadPipe fd <- pipes] readfds #readfds = seq [readPipeBlockingSetFdBit fd \\ ReadPipe fd <- pipes] readfds
// wait // wait
#!(res, world) = select_ (maxFd + 1) readfds 0 0 0 world # (res, world) = select_ (maxFd + 1) readfds 0 0 0 world
#!fRes = free readfds # world = freeSt readfds world
| fRes <> fRes = undef
| res == -1 = getLastOSError world | res == -1 = getLastOSError world
= seq [ \(res, world) -> case res of = seq [ \(res, world) -> case res of
Ok res` Ok res`
...@@ -299,10 +288,11 @@ readPipeBlockingMulti pipes world ...@@ -299,10 +288,11 @@ readPipeBlockingMulti pipes world
where where
maxFd = maximum [fd \\ ReadPipe fd <- pipes] maxFd = maximum [fd \\ ReadPipe fd <- pipes]
setFdBit fd ptr readPipeBlockingSetFdBit :: !Int !Pointer -> Pointer
#offset = fromInt fd / IF_INT_64_OR_32 64 32 readPipeBlockingSetFdBit fd ptr
#val = (readIntElemOffset ptr offset) bitor (1 << (fd rem IF_INT_64_OR_32 64 32)) # offset = fromInt fd / IF_INT_64_OR_32 64 32
= writeIntElemOffset ptr offset val # val = (readIntElemOffset ptr offset) bitor (1 << (fd rem IF_INT_64_OR_32 64 32))
= writeIntElemOffset ptr offset val
writePipe :: !String !WritePipe !*World -> (!MaybeOSError (), !*World) writePipe :: !String !WritePipe !*World -> (!MaybeOSError (), !*World)
writePipe str (WritePipe fd) world writePipe str (WritePipe fd) world
......
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