[MLton-commit] r4677

[Stephen Weeks]

Fixed profiling, which didn't work on any platform.  There was a
mismatch between the C prototype for GC_profileWrite, which expected a
FILE* and the SML imported type, which expected a file descriptor.  I
went ahead and changed GC_profileWrite to be more like GC_saveWorld
and take a file name (as a string) and did the fopen and fclose in
GC_profileWrite.

This problem would have been caught statically if we used something
like basis-ffi.def + gen-basis-ffi for the runtime imports (like
GC_profileWrite) besides the basis).  Should we just add stuff in
basis-ffi.def, should we create another file, or should we leave
things alone?


----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/profile.sml
U   mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-mlton.sml
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c
U   mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h

----------------------------------------------------------------------

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/profile.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/profile.sml	2006-07-05 06:10:06 UTC (rev 4676)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/profile.sml	2006-07-05 19:57:40 UTC (rev 4677)
@@ -66,26 +66,12 @@
          end
 
       fun write (T {isFreed, raw, ...}, file) =
-         if not isOn
-            then ()
+         if not isOn then
+            ()
+         else if !isFreed then
+            raise Fail "write of freed profile data"
          else
-            if !isFreed
-               then raise Fail "write of freed profile data"
-            else
-               let
-                  val fd =
-                     let
-                        open Posix.FileSys
-                        open S
-                     in
-                        creat (file,
-                               flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth])
-                     end
-                  val _ = P.Data.write (gcState, raw, fd)
-                  val _ = Posix.IO.close fd
-               in
-                  ()
-               end
+            P.Data.write (gcState, raw, Primitive.NullString8.fromString file)
    end
 
 val r: Data.t ref = ref (Data.make P.Data.dummy)

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-07-05 06:10:06 UTC (rev 4676)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-mlton.sml	2006-07-05 19:57:40 UTC (rev 4677)
@@ -256,7 +256,8 @@
             val dummy = Pointer.null
             val free = _import "GC_profileFree": GCState.t * t -> unit;
             val malloc = _import "GC_profileMalloc": GCState.t -> t;
-            val write = _import "GC_profileWrite": GCState.t * t * C_Fd.t -> unit;
+            val write =
+               _import "GC_profileWrite": GCState.t * t * NullString8.t -> unit;
          end
       val done = _import "GC_profileDone": GCState.t -> unit;
       val getCurrent = _import "GC_getProfileCurrent": GCState.t -> Data.t;

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c	2006-07-05 06:10:06 UTC (rev 4676)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c	2006-07-05 19:57:40 UTC (rev 4677)
@@ -244,11 +244,13 @@
   writeNewline (f);
 }
 
-void GC_profileWrite (GC_state s, GC_profileData p, FILE *f) {
+void GC_profileWrite (GC_state s, GC_profileData p, NullString8_t fileName) {
+  FILE *f;
   const char* kind;
 
   if (DEBUG_PROFILE)
     fprintf (stderr, "GC_profileWrite\n");
+  f = fopen_safe ((const char*)fileName, "wb");
   writeString (f, "MLton prof\n");
   kind = "";
   switch (s->profiling.kind) {
@@ -286,6 +288,7 @@
   for (GC_sourceNameIndex i = 0; i < s->sourceMaps.sourceNamesLength; i++)
     writeProfileCount (s, f, p,  
                        (GC_profileMasterIndex)(i + s->sourceMaps.sourcesLength));
+  fclose_safe (f);
 }
 
 

Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h	2006-07-05 06:10:06 UTC (rev 4676)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h	2006-07-05 19:57:40 UTC (rev 4677)
@@ -116,7 +116,7 @@
 void GC_setProfileCurrent (GC_state s, GC_profileData p);
 
 GC_profileData GC_profileMalloc (GC_state s);
-void GC_profileWrite (GC_state s, GC_profileData p, FILE *f);
+void GC_profileWrite (GC_state s, GC_profileData p, NullString8_t fileName);
 void GC_profileFree (GC_state s, GC_profileData p);
 
 void GC_profileDone (GC_state s);