Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * Copyright (C) 1997-2000 NEC Research Institute. | |
4 | * | |
5 | * MLton is released under a BSD-style license. | |
6 | * See the file MLton-LICENSE for details. | |
7 | *) | |
8 | ||
9 | structure MLtonWorld: MLTON_WORLD = | |
10 | struct | |
11 | structure Prim = Primitive.MLton.World | |
12 | structure Error = PosixError | |
13 | structure SysCall = Error.SysCall | |
14 | ||
15 | val gcState = Primitive.MLton.GCState.gcState | |
16 | ||
17 | datatype status = Clone | Original | |
18 | ||
19 | (* Need to worry about: | |
20 | * - open file descriptors | |
21 | * - redetermine buffer status when restart | |
22 | *) | |
23 | fun save' (file: string): status = | |
24 | let | |
25 | val () = | |
26 | SysCall.simple' | |
27 | ({errVal = false}, | |
28 | fn () => (Prim.save (NullString.nullTerm file) | |
29 | ; Prim.getSaveStatus (gcState))) | |
30 | in | |
31 | if Prim.getAmOriginal gcState | |
32 | then Original | |
33 | else (Prim.setAmOriginal (gcState, true) | |
34 | ; Cleaner.clean Cleaner.atLoadWorld | |
35 | ; Clone) | |
36 | end | |
37 | ||
38 | fun saveThread (file: string, t: MLtonThread.Runnable.t): unit = | |
39 | case save' file of | |
40 | Clone => MLtonThread.switch (fn _ => t) | |
41 | | Original => () | |
42 | ||
43 | fun save (file: string): status = | |
44 | if MLtonThread.amInSignalHandler () | |
45 | then raise Fail "cannot call MLton.World.save within signal handler" | |
46 | else save' file | |
47 | ||
48 | fun load (file: string): 'a = | |
49 | if let open OS_FileSys | |
50 | in access (file, [A_READ]) | |
51 | end | |
52 | then | |
53 | let val c = CommandLine.name () | |
54 | in Posix.Process.exec (c, [c, "@MLton", "load-world", file, "--"]) | |
55 | end | |
56 | else raise Fail (concat ["World.load can not read ", file]) | |
57 | end |