[MLton-commit] r4654
Matthew Fluet
MLton@mlton.org
Fri, 16 Jun 2006 21:04:03 -0700
Fixed problem introduced at r4642:
The second change is how the SML code saves the world:
Now the filename is passed to C, and a failure does not abort the program.
Instead, we check return codes and propogate the error code back to an SML
exception, raised with the correct error status.
The problem is due to changing the primtive from
val save = _prim "World_save": C.Fd.t -> unit
to
val save = _prim "World_save": NullString8_t -> bool C_Error.t
It is not possible to have the type of save as
NullString8.t -> bool C_Errno.t, because there are two different ways
to return from the call to save. One way is the direct obvious way,
in the program instance that called save. However, another way to
return is in the program instance that loads the world. Making save
return a bool creates nasty bugs where the return code from the CCall
expects to see a bool result according to the C return convention, but
there isn't one when returning in the load world.
So, save's result status is accessible via:
val getSaveStatus =
_import "GC_getSaveWorldStatus" : GCState.t -> bool C_Errno.t
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-mlton.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml 2006-06-14 12:16:33 UTC (rev 4653)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/world.sml 2006-06-17 04:03:56 UTC (rev 4654)
@@ -25,7 +25,8 @@
val () =
SysCall.simple'
({errVal = false},
- fn () => Prim.save (NullString.nullTerm file))
+ fn () => (Prim.save (NullString.nullTerm file)
+ ; Prim.saveStatus (gcState)))
in
if Prim.getAmOriginal gcState
then Original
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-mlton.sml 2006-06-14 12:16:33 UTC (rev 4653)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-mlton.sml 2006-06-17 04:03:56 UTC (rev 4654)
@@ -316,7 +316,20 @@
struct
val getAmOriginal = _import "GC_getAmOriginal": GCState.t -> bool;
val setAmOriginal = _import "GC_setAmOriginal": GCState.t * bool -> unit;
- val save = _prim "World_save": NullString8.t -> bool C_Errno.t;
+ val getSaveStatus = _import "GC_getSaveWorldStatus": GCState.t -> bool C_Errno.t;
+ (* save's result status is accesible via getSaveStatus ().
+ * It is not possible to have the type of save as
+ * NullString8.t -> bool C_Errno.t, because there are two
+ * different ways to return from the call to save. One way is
+ * the direct obvious way, in the program instance that called
+ * save. However, another way to return is in the program
+ * instance that loads the world. Making save return a bool
+ * creates nasty bugs where the return code from the CCall
+ * expects to see a bool result according to the C return
+ * convention, but there isn't one when returning in the load
+ * world.
+ *)
+ val save = _prim "World_save": NullString8.t -> unit;
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun 2006-06-14 12:16:33 UTC (rev 4653)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/hash-type.fun 2006-06-17 04:03:56 UTC (rev 4654)
@@ -362,7 +362,7 @@
| Word_toReal (s, s', _) => done ([word s], real s')
| Word_toWord (s, s', _) => done ([word s], word s')
| Word_xorb s => wordBinary s
- | World_save => done ([string], bool)
+ | World_save => done ([string], unit)
| _ => Error.bug (concat ["HashType.checkPrimApp: strange prim: ",
Prim.toString prim])
end
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun 2006-06-14 12:16:33 UTC (rev 4653)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun 2006-06-17 04:03:56 UTC (rev 4654)
@@ -228,10 +228,10 @@
prototype = let
open CType
in
- (Vector.new2 (Pointer, Pointer), SOME bool)
+ (Vector.new2 (Pointer, Pointer), NONE)
end,
readsStackTop = true,
- return = Type.bool,
+ return = unit,
target = Direct "GC_saveWorld",
writesStackTop = true}
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun 2006-06-14 12:16:33 UTC (rev 4653)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ssa/ssa-tree2.fun 2006-06-17 04:03:56 UTC (rev 4654)
@@ -476,7 +476,7 @@
| Word_toReal (s, s', _) => done ([word s], real s')
| Word_toWord (s, s', _) => done ([word s], word s')
| Word_xorb s => wordBinary s
- | World_save => done ([string], bool)
+ | World_save => done ([string], unit)
| _ => Error.bug (concat ["SsaTree2.Type.checkPrimApp got strange prim: ",
Prim.toString prim])
end
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2006-06-14 12:16:33 UTC (rev 4653)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2006-06-17 04:03:56 UTC (rev 4654)
@@ -49,6 +49,7 @@
* Thread interrupted by arrival of signal.
*/
int (*saveGlobals)(FILE *f); /* saves the globals to the file. */
+ bool saveWorldStatus; /* */
struct GC_heap secondaryHeap; /* Used for major copying collection. */
objptr signalHandlerThread; /* Handler for signals (in heap). */
struct GC_signalsInfo signalsInfo;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2006-06-14 12:16:33 UTC (rev 4653)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2006-06-17 04:03:56 UTC (rev 4654)
@@ -222,7 +222,7 @@
assert (isAligned (sizeof (struct GC_stack), s->alignment));
assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_thread),
s->alignment));
- // While the following asserts is manifestly true,
+ // While the following assert is manifestly true,
// it checks the asserts in sizeofWeak.
assert (sizeofWeak (s) == sizeofWeak (s));
@@ -286,6 +286,7 @@
s->sysvals.totalRam = GC_totalRam ();
s->sysvals.pageSize = GC_pageSize ();
s->weaks = NULL;
+ s->saveWorldStatus = true;
initSignalStack (s);
worldFile = NULL;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.c 2006-06-14 12:16:33 UTC (rev 4653)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.c 2006-06-17 04:03:56 UTC (rev 4654)
@@ -86,24 +86,30 @@
return 0;
}
-C_Errno_t(Bool_t) GC_saveWorld (GC_state s, NullString8_t fileName) {
+void GC_saveWorld (GC_state s, NullString8_t fileName) {
FILE *f;
enter (s);
f = fopen ((const char*)fileName, "wb");
if (f == 0) {
- leave (s);
- return (Bool_t)FALSE;
+ s->saveWorldStatus = false;
+ goto done;
}
if (saveWorldToFILE (s, f) != 0) {
- leave (s);
- return (Bool_t)FALSE;
+ s->saveWorldStatus = false;
+ goto done;
}
if (fclose (f) != 0) {
- leave (s);
- return (Bool_t)FALSE;
+ s->saveWorldStatus = false;
+ goto done;
}
+ s->saveWorldStatus = true;
+done:
leave (s);
- return (Bool_t)TRUE;
+ return;
}
+
+C_Errno_t(Bool_t) GC_getSaveWorldStatus (GC_state s) {
+ return (Bool_t)(s->saveWorldStatus);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h 2006-06-14 12:16:33 UTC (rev 4653)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.h 2006-06-17 04:03:56 UTC (rev 4654)
@@ -16,7 +16,8 @@
#if (defined (MLTON_GC_INTERNAL_BASIS))
+void GC_saveWorld (GC_state s, NullString8_t fileName);
/* TRUE = success, FALSE = failure */
-C_Errno_t(Bool_t) GC_saveWorld (GC_state s, NullString8_t fileName);
+C_Errno_t(Bool_t) GC_getSaveWorldStatus (GC_state s);
#endif /* (defined (MLTON_GC_INTERNAL_BASIS)) */