1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
fun run (f: unit -> unit) =
case Posix.Process.fork () of
SOME pid =>
let
open Posix.Process
val (pid', status) = waitpid (W_CHILD pid, [])
in if pid = pid' andalso status = W_EXITED
then ()
else raise Fail "child failed"
end
| NONE => let open OS.Process
in exit ((f (); success) handle _ => failure)
end
fun succeed () =
let open OS.Process
in exit success
end
open MLton.World MLton.Signal Posix.Signal Posix.Process Posix.ProcEnv
val (w, out) = MLton.TextIO.mkstemp "/tmp/world"
val _ = TextIO.closeOut out
val childReady = ref false
fun print s = TextIO.output (TextIO.stdErr, s)
val _ = setHandler (usr1, Handler.simple (fn () => childReady := true))
val parent = getpid ()
val _ =
case fork () of
NONE =>
let
val canExit = ref false
in
setHandler (usr1, Handler.handler (fn t => (canExit := true
; saveThread (w, t)
; t)))
; kill (K_PROC parent, usr1)
; let
fun loop () = if !canExit then print "success\n" else loop ()
in
loop ()
end
; let open OS.Process
in exit success
end
end
| SOME child =>
let
fun loop () = if !childReady then () else loop ()
in
loop ()
; kill (K_PROC child, usr1)
; wait ()
; run (fn () => load w)
; OS.FileSys.remove w
end
|
