[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)) */