| 1 : |
monnier |
416 |
(* posix-process.sml
|
| 2 : |
|
|
*
|
| 3 : |
|
|
* COPYRIGHT (c) 1995 AT&T Bell Laboratories.
|
| 4 : |
|
|
*
|
| 5 : |
|
|
* Structure for POSIX 1003.1 process submodule
|
| 6 : |
|
|
*
|
| 7 : |
|
|
*)
|
| 8 : |
|
|
|
| 9 : |
|
|
local
|
| 10 : |
|
|
structure SysWord = SysWordImp
|
| 11 : |
|
|
structure Word8 = Word8Imp
|
| 12 : |
|
|
structure Time = TimeImp
|
| 13 : |
|
|
structure Int = IntImp
|
| 14 : |
|
|
in
|
| 15 : |
|
|
structure POSIX_Process =
|
| 16 : |
|
|
struct
|
| 17 : |
|
|
|
| 18 : |
|
|
structure Sig = POSIX_Signal
|
| 19 : |
|
|
|
| 20 : |
|
|
val ++ = SysWord.orb
|
| 21 : |
|
|
val & = SysWord.andb
|
| 22 : |
|
|
infix ++ &
|
| 23 : |
|
|
|
| 24 : |
|
|
type word = SysWord.word
|
| 25 : |
|
|
type s_int = SysInt.int
|
| 26 : |
|
|
|
| 27 : |
|
|
type signal = Sig.signal
|
| 28 : |
|
|
datatype pid = PID of s_int
|
| 29 : |
|
|
fun pidToWord (PID i) = SysWord.fromInt i
|
| 30 : |
|
|
fun wordToPid w = PID (SysWord.toInt w)
|
| 31 : |
|
|
|
| 32 : |
|
|
fun cfun x = CInterface.c_function "POSIX-Process" x
|
| 33 : |
|
|
val osval : string -> s_int = cfun "osval"
|
| 34 : |
|
|
val w_osval = SysWord.fromInt o osval
|
| 35 : |
|
|
|
| 36 : |
|
|
val sysconf : string -> SysWord.word =
|
| 37 : |
|
|
CInterface.c_function "POSIX-ProcEnv" "sysconf"
|
| 38 : |
|
|
|
| 39 : |
|
|
val fork' : unit -> s_int = cfun "fork"
|
| 40 : |
|
|
fun fork () =
|
| 41 : |
|
|
case fork' () of
|
| 42 : |
|
|
0 => NONE
|
| 43 : |
|
|
| child_pid => SOME(PID child_pid)
|
| 44 : |
|
|
|
| 45 : |
|
|
fun exec (x: string * string list) : 'a = cfun "exec" x
|
| 46 : |
|
|
fun exece (x: string * string list * string list) : 'a = cfun "exece" x
|
| 47 : |
|
|
fun execp (x: string * string list): 'a = cfun "execp" x
|
| 48 : |
|
|
|
| 49 : |
|
|
datatype waitpid_arg
|
| 50 : |
|
|
= W_ANY_CHILD
|
| 51 : |
|
|
| W_CHILD of pid
|
| 52 : |
|
|
| W_SAME_GROUP
|
| 53 : |
|
|
| W_GROUP of pid
|
| 54 : |
|
|
|
| 55 : |
|
|
datatype killpid_arg
|
| 56 : |
|
|
= K_PROC of pid
|
| 57 : |
|
|
| K_SAME_GROUP
|
| 58 : |
|
|
| K_GROUP of pid
|
| 59 : |
|
|
|
| 60 : |
|
|
datatype exit_status
|
| 61 : |
|
|
= W_EXITED
|
| 62 : |
|
|
| W_EXITSTATUS of Word8.word
|
| 63 : |
|
|
| W_SIGNALED of signal
|
| 64 : |
|
|
| W_STOPPED of signal
|
| 65 : |
|
|
|
| 66 : |
|
|
(* (pid',status,status_val) = waitpid' (pid,options) *)
|
| 67 : |
|
|
val waitpid' : s_int * word -> s_int * s_int * s_int = cfun "waitpid"
|
| 68 : |
|
|
|
| 69 : |
|
|
fun argToInt W_ANY_CHILD = ~1
|
| 70 : |
|
|
| argToInt (W_CHILD (PID pid)) = pid
|
| 71 : |
|
|
| argToInt (W_SAME_GROUP) = 0
|
| 72 : |
|
|
| argToInt (W_GROUP (PID pid)) = ~pid
|
| 73 : |
|
|
|
| 74 : |
|
|
(* The exit status from wait is encoded as a pair of integers.
|
| 75 : |
|
|
* If the first integer is 0, the child exited normally, and
|
| 76 : |
|
|
* the second integer gives its exit value.
|
| 77 : |
|
|
* If the first integer is 1, the child exited due to an uncaught
|
| 78 : |
|
|
* signal, and the second integer gives the signal value.
|
| 79 : |
|
|
* Otherwise, the child is stopped and the second integer
|
| 80 : |
|
|
* gives the signal value that caused the child to stop.
|
| 81 : |
|
|
*)
|
| 82 : |
|
|
fun mkExitStatus (0,0) = W_EXITED
|
| 83 : |
|
|
| mkExitStatus (0,v) = W_EXITSTATUS(Word8.fromInt v)
|
| 84 : |
|
|
| mkExitStatus (1,s) = W_SIGNALED (Sig.SIG s)
|
| 85 : |
|
|
| mkExitStatus (_,s) = W_STOPPED (Sig.SIG s)
|
| 86 : |
|
|
|
| 87 : |
|
|
|
| 88 : |
|
|
val wnohang = w_osval "WNOHANG"
|
| 89 : |
|
|
structure W =
|
| 90 : |
|
|
struct
|
| 91 : |
|
|
datatype flags = WF of word
|
| 92 : |
|
|
|
| 93 : |
|
|
fun fromWord w = WF w
|
| 94 : |
|
|
fun toWord (WF w) = w
|
| 95 : |
|
|
|
| 96 : |
|
|
fun flags ms = WF(List.foldl (fn (WF m,acc) => m ++ acc) 0w0 ms)
|
| 97 : |
|
|
fun anySet (WF m, WF m') = (m & m') <> 0w0
|
| 98 : |
|
|
fun allSet (WF m, WF m') = (m & m') = m
|
| 99 : |
|
|
|
| 100 : |
|
|
fun orF (WF f,acc) = f ++ acc
|
| 101 : |
|
|
|
| 102 : |
|
|
val untraced =
|
| 103 : |
|
|
WF(sysconf "JOB_CONTROL"; w_osval "WUNTRACED") handle _ => WF 0w0
|
| 104 : |
|
|
end
|
| 105 : |
|
|
|
| 106 : |
|
|
fun waitpid (arg,flags) = let
|
| 107 : |
|
|
val (pid,status,sv) = waitpid'(argToInt arg, List.foldl W.orF 0w0 flags)
|
| 108 : |
|
|
in
|
| 109 : |
|
|
(PID pid, mkExitStatus(status,sv))
|
| 110 : |
|
|
end
|
| 111 : |
|
|
|
| 112 : |
|
|
fun waitpid_nh (arg,flags) =
|
| 113 : |
|
|
case waitpid'(argToInt arg, List.foldl W.orF wnohang flags) of
|
| 114 : |
|
|
(0,_,_) => NONE
|
| 115 : |
|
|
| (pid,status,sv) => SOME(PID pid, mkExitStatus(status,sv))
|
| 116 : |
|
|
|
| 117 : |
|
|
fun wait () = waitpid(W_ANY_CHILD,[])
|
| 118 : |
|
|
|
| 119 : |
|
|
fun exit (x: Word8.word) : 'a = cfun "exit" x
|
| 120 : |
|
|
|
| 121 : |
|
|
val kill' : s_int * s_int -> unit = cfun "kill"
|
| 122 : |
|
|
fun kill (K_PROC (PID pid),Sig.SIG s) = kill'(pid, s)
|
| 123 : |
|
|
| kill (K_SAME_GROUP,Sig.SIG s) = kill'(~1, s)
|
| 124 : |
|
|
| kill (K_GROUP (PID pid),Sig.SIG s) = kill'(~pid, s)
|
| 125 : |
|
|
|
| 126 : |
|
|
local
|
| 127 : |
|
|
fun wrap f t =
|
| 128 : |
|
|
Time.fromSeconds(Int.toLarge(f(Int.fromLarge(Time.toSeconds t))))
|
| 129 : |
|
|
val alarm' : int -> int = cfun "alarm"
|
| 130 : |
|
|
val sleep' : int -> int = cfun "sleep"
|
| 131 : |
|
|
in
|
| 132 : |
|
|
val alarm = wrap alarm'
|
| 133 : |
|
|
val sleep = wrap sleep'
|
| 134 : |
|
|
end
|
| 135 : |
|
|
|
| 136 : |
|
|
val pause : unit -> unit = cfun "pause"
|
| 137 : |
|
|
|
| 138 : |
|
|
|
| 139 : |
|
|
end (* structure POSIX_Process *)
|
| 140 : |
|
|
end
|
| 141 : |
|
|
|
Parent Directory
| 
Revision Log
