Commit 63c774b9 authored by Bas Lijnse's avatar Bas Lijnse

Ported process module to mac

git-svn-id: https://svn.cs.ru.nl/repos/clean-platform/trunk@85 2afc29ad-3112-4e41-907a-9359c7e6e986
parent 30345227
......@@ -2,9 +2,20 @@ definition module _Posix
from _Pointer import :: Pointer
//Posix API calls
WNOHANG :== 0x00000001
WUNTRACED :== 0x00000002
//Posix API calls
errno :: !*World -> (!Int,!*World)
strerr :: !Int -> Pointer
stat :: !{#Char} !{#Char} -> Int
unlink :: !{#Char} -> Int
stat :: !{#Char} !{#Char} !*World -> (!Int,!*World)
unlink :: !{#Char} !*World -> (!Int,!*World)
fork :: !*World -> (!Int,!*World)
execvp :: !{#Char} !{#Pointer} !*World -> (!Int,!*World)
waitpid :: !Int !{#Int} !Int !*World -> (!Int,!*World)
exit :: !Int !*World -> (!.a,!*World)
//Memory (impure)
malloc :: !Int -> Pointer
free :: !Pointer -> Int
memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer
......@@ -18,12 +18,41 @@ strerr world = code {
ccall strerror "I:p"
}
stat :: !{#Char} !{#Char} -> !Int
stat path buf = code {
ccall stat "ss:I"
stat :: !{#Char} !{#Char} !*World -> (!Int,!*World)
stat path buf world = code {
ccall stat "ss:I:A"
}
unlink :: !{#Char} -> !Int
unlink path = code {
ccall unlink "s:I"
unlink :: !{#Char} !*World -> (!Int,!*World)
unlink path world = code {
ccall unlink "s:I:A"
}
fork :: !*World -> (!Int,!*World)
fork world = code {
ccall fork ":I:A"
}
execvp :: !{#Char} !{#Pointer} !*World -> (!Int,!*World)
execvp name argv world = code {
ccall execvp "sA:I:A"
}
waitpid :: !Int !{#Int} !Int !*World -> (!Int,!*World)
waitpid pid status_p options world = code {
ccall waitpid "IAI:I:A"
}
exit :: !Int !*World -> (!.a,!*World)
exit num world = code {
ccall exit "I:p:A"
}
malloc :: !Int -> Pointer
malloc num = code {
ccall malloc "p:p"
}
free :: !Pointer -> Int
free ptr = code {
ccall free "p:I"
}
memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer
memcpy_string_to_pointer p s n = code {
ccall memcpy "psp:p"
}
......@@ -56,14 +56,14 @@ withFile filename filemode operation env
fileExists :: !String *World -> (Bool, *World)
fileExists path world
# buf = createArray (IF_INT_64_OR_32 144 88) '\0'
# ok = '_Posix'.stat (packString path) buf
| ok == 0 = (True, world)
= (False, world)
# buf = createArray (IF_INT_64_OR_32 144 88) '\0'
# (ok,world) = '_Posix'.stat (packString path) buf world
| ok == 0 = (True, world)
= (False, world)
deleteFile :: !String *World -> (MaybeOSError Void, *World)
deleteFile path world
# ok = '_Posix'.unlink (packString path)
| ok <> 0 = getLastOSError world
= (Ok Void, world)
# (ok,world) = '_Posix'.unlink (packString path) world
| ok <> 0 = getLastOSError world
= (Ok Void, world)
definition module Process
import Void, Maybe, Either
import OSError
import FilePath
/*
Not yet implemented:
- Pass startup directory
- Passsing environment, i.e. [(!String,!String)], to created process
- Ability to redirect standard input, standard output, standard error
*/
:: ProcessHandle = { pid :: Int
}
/**
* runs a new process
* @param Path to the executable
* @param a list of command-line arguments
* @param (optional) startup directory
* @return Process handle to the process
*/
runProcess :: !FilePath ![String] !(Maybe String) !*World -> (MaybeOSError ProcessHandle, *World)
/**
* Check if a process is still running
* @param Process handle to the process
* @return Boolean indicating if process is still running
*/
checkProcess :: !ProcessHandle !*World -> (MaybeOSError (Maybe Int), *World)
/**
* Wait for a process to terminate, closes the handle and returns the exit code
* @param Process handle to the process
* @return Exit code of the process
*/
waitForProcess :: !ProcessHandle !*World -> (!MaybeOSError Int, !*World)
/**
* runs a new process and wait for it to terminate
* @param Path to the executable
* @param a list of command-line arguments
* @param (optional) startup directory
* @return Exit code of the process
*/
callProcess :: !FilePath ![String] !(Maybe String) !*World -> (MaybeOSError Int, *World)
implementation module Process
//StdEnv
import StdArray
import StdBool
import StdClass
import StdInt
import StdList
import StdString
import StdMisc
//Data
import Maybe
import Void
//System
import FilePath
import OSError
import _Pointer
import _Posix
runProcess :: !FilePath ![String] !(Maybe String) !*World -> (MaybeOSError ProcessHandle, *World)
runProcess path args mCurrentDirectory world
//Fork
# (argv,args_memory) = makeArgv ["\"" +++ path +++ "\"":args]
# (pid, world) = fork world
| pid == 0
//Exec
# (res,world) = execvp path argv world
= exit 1 world
| pid > 0
| free args_memory<0
= getLastOSError world
| otherwise
= (Ok {ProcessHandle| pid = pid}, world)
| otherwise
= getLastOSError world
where
makeArgv argv_list
# args_size = argvLength argv_list 0
args_string = createArgsString args_size argv_list
args_memory = malloc args_size
| args_memory == 0
= abort "malloc failed"
# args_memory = memcpy_string_to_pointer args_memory args_string args_size
argv = createArgv argv_list args_memory
= (argv,args_memory)
where
argvLength [a:as] l
= argvLength as (l+((size a +(IF_INT_64_OR_32 8 4)) bitand (IF_INT_64_OR_32 -8 -4)))
argvLength [] l
= l
createArgsString args_size argv_list
# s = createArray args_size '\0'
= copyArgs argv_list 0 s
where
copyArgs [a:as] i s
# s = copyChars 0 a i s
= copyArgs as (i+((size a +(IF_INT_64_OR_32 8 4)) bitand (IF_INT_64_OR_32 -8 -4))) s
copyArgs [] i s
= s
copyChars :: !Int !{#Char} !Int !*{#Char} -> *{#Char}
copyChars ai a si s
| ai<size a
# s = {s & [si]=a.[ai]}
= copyChars (ai+1) a (si+1) s
= s
createArgv argv_list args_memory
# n_args = length argv_list
# argv = createArray (n_args+1) 0;
= fillArgv 0 argv_list argv args_memory
where
fillArgv :: !Int ![{#Char}] !*{#Pointer} !Int -> *{#Pointer}
fillArgv arg_n [a:as] argv args_memory
# argv = {argv & [arg_n]=args_memory}
args_memory = args_memory + ((size a +(IF_INT_64_OR_32 8 4)) bitand (IF_INT_64_OR_32 -8 -4))
= fillArgv (arg_n+1) as argv args_memory
fillArgv arg_n [] argv args_memory
= {argv & [arg_n]=0}
checkProcess :: !ProcessHandle !*World -> (MaybeOSError (Maybe Int), *World)
checkProcess {pid} world
# status = createArray 1 0
# (ret,world) = waitpid pid status WNOHANG world //Non-blocking wait :)
| ret == 0
= (Ok Nothing, world)
| ret == pid
# exitCode = (status.[0] >> 8) bitand 0xFF
= (Ok (Just exitCode), world)
| otherwise
= getLastOSError world
waitForProcess :: !ProcessHandle !*World -> (!MaybeOSError Int, !*World)
waitForProcess {pid} world
# status = createArray 1 0
# (ret,world) = waitpid pid status 0 world //Blocking wait
| ret == pid
# exitCode = (status.[0] >> 8) bitand 0xFF
= (Ok exitCode, world)
| otherwise
= getLastOSError world
callProcess :: !FilePath ![String] !(Maybe String) !*World -> (MaybeOSError Int, *World)
callProcess path args mCurrentDirectory world
# (res, world) = runProcess path args mCurrentDirectory world
= case res of
Ok handle = waitForProcess handle world
Error e = (Error e, 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