Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2009 Matthew Fluet. |
2 | * Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * Copyright (C) 1997-2000 NEC Research Institute. | |
5 | * | |
6 | * MLton is released under a BSD-style license. | |
7 | * See the file MLton-LICENSE for details. | |
8 | *) | |
9 | ||
10 | structure PosixProcess: POSIX_PROCESS_EXTRA = | |
11 | struct | |
12 | structure Prim = PrimitiveFFI.Posix.Process | |
13 | open Prim | |
14 | structure FileDesc = PrePosix.FileDesc | |
15 | structure PId = PrePosix.PId | |
16 | structure Signal = PrePosix.Signal | |
17 | ||
18 | structure Error = PosixError | |
19 | structure SysCall = Error.SysCall | |
20 | ||
21 | type signal = Signal.t | |
22 | type pid = PId.t | |
23 | ||
24 | val pidToWord = C_PId.castToSysWord o PId.toRep | |
25 | val wordToPid = PId.fromRep o C_PId.castFromSysWord | |
26 | ||
27 | fun fork () = | |
28 | SysCall.syscall' | |
29 | ({errVal = C_PId.castFromFixedInt ~1}, fn () => | |
30 | (Prim.fork (), fn p => | |
31 | if p = C_PId.castFromFixedInt 0 | |
32 | then NONE | |
33 | else SOME (PId.fromRep p))) | |
34 | ||
35 | val fork = | |
36 | if Primitive.MLton.Platform.OS.forkIsEnabled | |
37 | then fork | |
38 | else fn () => Error.raiseSys Error.nosys | |
39 | ||
40 | val conv = NullString.nullTerm | |
41 | val convs = CUtil.C_StringArray.fromList | |
42 | ||
43 | fun exece (path, args, env): 'a = | |
44 | let | |
45 | val path = conv path | |
46 | val args = convs args | |
47 | val env = convs env | |
48 | in | |
49 | (SysCall.simple | |
50 | (fn () => Prim.exece (path, args, env)) | |
51 | ; raise Fail "Posix.Process.exece") | |
52 | end | |
53 | ||
54 | fun exec (path, args): 'a = | |
55 | exece (path, args, PosixProcEnv.environ ()) | |
56 | ||
57 | fun execp (file, args): 'a = | |
58 | let | |
59 | val file = conv file | |
60 | val args = convs args | |
61 | in | |
62 | (SysCall.simple | |
63 | (fn () => Prim.execp (file, args)) | |
64 | ; raise Fail "Posix.Process.execp") | |
65 | end | |
66 | ||
67 | datatype waitpid_arg = | |
68 | W_ANY_CHILD | |
69 | | W_CHILD of pid | |
70 | | W_SAME_GROUP | |
71 | | W_GROUP of pid | |
72 | ||
73 | datatype exit_status = | |
74 | W_EXITED | |
75 | | W_EXITSTATUS of Word8.word | |
76 | | W_SIGNALED of signal | |
77 | | W_STOPPED of signal | |
78 | ||
79 | fun fromStatus' (status : C_Status.t) = | |
80 | if Prim.ifExited status <> C_Int.zero | |
81 | then (case Prim.exitStatus status of | |
82 | 0 => W_EXITED | |
83 | | n => W_EXITSTATUS (Word8.castFromSysWord (C_Int.castToSysWord n))) | |
84 | else if Prim.ifSignaled status <> C_Int.zero | |
85 | then W_SIGNALED (PosixSignal.fromRep (Prim.termSig status)) | |
86 | else if Prim.ifStopped status <> C_Int.zero | |
87 | then W_STOPPED (PosixSignal.fromRep (Prim.stopSig status)) | |
88 | else raise Fail "Posix.Process.fromStatus" | |
89 | fun fromStatus status = | |
90 | fromStatus' (PreOS.Status.toRep status) | |
91 | ||
92 | structure W = | |
93 | struct | |
94 | structure Flags = BitFlags(structure S = C_Int) | |
95 | open W Flags | |
96 | (* val continued = CONTINUED *) | |
97 | val nohang = NOHANG | |
98 | val untraced = UNTRACED | |
99 | end | |
100 | ||
101 | local | |
102 | val status: C_Status.t ref = ref (C_Status.fromInt 0) | |
103 | fun wait (wa, status, flags) = | |
104 | let | |
105 | val pid = | |
106 | case wa of | |
107 | W_ANY_CHILD => C_PId.castFromFixedInt ~1 | |
108 | | W_CHILD pid => PId.toRep pid | |
109 | | W_SAME_GROUP => C_PId.castFromFixedInt 0 | |
110 | | W_GROUP pid => C_PId.~ (PId.toRep pid) | |
111 | val flags = W.flags flags | |
112 | in | |
113 | (PId.fromRep o SysCall.simpleResultRestart') | |
114 | ({errVal = C_PId.castFromFixedInt ~1}, fn () => | |
115 | let | |
116 | val pid = Prim.waitpid (pid, status, flags) | |
117 | in | |
118 | pid | |
119 | end) | |
120 | end | |
121 | fun getStatus () = fromStatus' (!status) | |
122 | in | |
123 | fun waitpid (wa, flags) = | |
124 | let | |
125 | val pid = wait (wa, status, flags) | |
126 | in | |
127 | (pid, getStatus ()) | |
128 | end | |
129 | ||
130 | fun waitpid_nh (wa, flags) = | |
131 | let | |
132 | val pid = wait (wa, status, W.nohang :: flags) | |
133 | in | |
134 | if PId.fromRep (C_PId.castFromFixedInt 0) = pid | |
135 | then NONE | |
136 | else SOME (pid, getStatus ()) | |
137 | end | |
138 | end | |
139 | ||
140 | fun wait () = waitpid (W_ANY_CHILD, []) | |
141 | ||
142 | fun exit (w: Word8.word): 'a = | |
143 | (* Posix.Process.exit does not call atExit cleaners, as per the basis | |
144 | * library spec. | |
145 | *) | |
146 | (Prim.exit (C_Status.castFromSysWord (Word8.castToSysWord w)) | |
147 | ; raise Fail "Posix.Process.exit") | |
148 | ||
149 | datatype killpid_arg = | |
150 | K_PROC of pid | |
151 | | K_SAME_GROUP | |
152 | | K_GROUP of pid | |
153 | ||
154 | fun kill (ka: killpid_arg, s: signal): unit = | |
155 | let | |
156 | val pid = | |
157 | case ka of | |
158 | K_PROC pid => PId.toRep pid | |
159 | | K_SAME_GROUP => C_PId.castFromFixedInt ~1 | |
160 | | K_GROUP pid => C_PId.~ (PId.toRep pid) | |
161 | val s = PosixSignal.toRep s | |
162 | in | |
163 | SysCall.simple (fn () => Prim.kill (pid, s)) | |
164 | end | |
165 | ||
166 | local | |
167 | fun wrap prim (t: Time.time): Time.time = | |
168 | Time.fromSeconds | |
169 | (C_UInt.toLargeInt | |
170 | (prim | |
171 | ((C_UInt.fromLargeInt (Time.toSeconds t)) | |
172 | handle Overflow => Error.raiseSys Error.inval))) | |
173 | in | |
174 | val alarm = wrap Prim.alarm | |
175 | (* val sleep = wrap Prim.sleep *) | |
176 | end | |
177 | ||
178 | fun sleep (t: Time.time): Time.time = | |
179 | let | |
180 | val t = Time.toNanoseconds t | |
181 | val sec = LargeInt.quot (t, 1000000000) | |
182 | val nsec = LargeInt.rem (t, 1000000000) | |
183 | val (sec, nsec) = | |
184 | (C_Time.fromLargeInt sec, C_Long.fromLargeInt nsec) | |
185 | handle Overflow => Error.raiseSys Error.inval | |
186 | val secRem = ref sec | |
187 | val nsecRem = ref nsec | |
188 | fun remaining _ = | |
189 | Time.+ (Time.fromSeconds (C_Time.toLargeInt (!secRem)), | |
190 | Time.fromNanoseconds (C_Long.toLargeInt (!nsecRem))) | |
191 | in | |
192 | SysCall.syscallErr | |
193 | ({clear = false, restart = false, errVal = C_Int.fromInt ~1}, fn () => | |
194 | {handlers = [(Error.intr, remaining)], | |
195 | post = remaining, | |
196 | return = Prim.nanosleep (secRem, nsecRem)}) | |
197 | end | |
198 | ||
199 | (* FIXME: pause *) | |
200 | fun pause () = | |
201 | SysCall.syscallErr | |
202 | ({clear = false, restart = false, errVal = C_Int.fromInt ~1}, | |
203 | fn () => | |
204 | {return = Prim.pause (), | |
205 | post = fn _ => (), | |
206 | handlers = [(Error.intr, fn () => ())]}) | |
207 | end |