[MLton-devel] cvs commit: fixed segfault when compiling -profile time

[Stephen Weeks]

sweeks      02/11/02 15:07:13

  Modified:    basis-library/mlton profile-alloc.sml profile-time.sml
                        profile.fun
  Log:
  Fixed bug in ProfileTime that caused a segfault sometimes when running
  executables compiled -profile time.  I had introduced the problem with the merge
  of the allocation profiling branch, where I had deleted the line that turned off
  the resetting of the SIGPROF itimer, which meant that some signals were received
  after the data buffer had been freed.
  
  The fix was to add the line back to turn off the itimer.

Revision  Changes    Path
1.3       +2 -1      mlton/basis-library/mlton/profile-alloc.sml

Index: profile-alloc.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/profile-alloc.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- profile-alloc.sml	2 Nov 2002 03:37:34 -0000	1.2
+++ profile-alloc.sml	2 Nov 2002 23:07:13 -0000	1.3
@@ -1 +1,2 @@
-structure ProfileAlloc = Profile (Primitive.MLton.ProfileAlloc)
+structure ProfileAlloc = Profile (open Primitive.MLton.ProfileAlloc
+				  fun clean _ = ())



1.3       +11 -4     mlton/basis-library/mlton/profile-time.sml

Index: profile-time.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/profile-time.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- profile-time.sml	2 Nov 2002 03:37:34 -0000	1.2
+++ profile-time.sml	2 Nov 2002 23:07:13 -0000	1.3
@@ -1,12 +1,19 @@
 structure ProfileTime: MLTON_PROFILE =
 struct
 
-structure Prim = Primitive.MLton.ProfileTime
-structure P = Profile (Prim)
-open P
-   
 fun setItimer (t: Time.time): unit =
    Itimer.set' (Itimer.Prof, {interval = t, value = t})
+
+(* It is important that clean () happend before the data is freed, because
+ * otherwise the signal will keep arriving and the catcher (see profile-time.c)
+ * will get a segfault trying to update a nonexistent array.
+ *)
+fun clean () = setItimer Time.zeroTime
+
+structure Prim = Primitive.MLton.ProfileTime
+structure P = Profile (open Prim
+		       val clean = clean)
+open P
 
 val _ =
    if not isOn



1.3       +2 -0      mlton/basis-library/mlton/profile.fun

Index: profile.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/profile.fun,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- profile.fun	2 Nov 2002 03:37:34 -0000	1.2
+++ profile.fun	2 Nov 2002 23:07:13 -0000	1.3
@@ -1,5 +1,6 @@
 functor Profile (S:
 		 sig
+		    val clean: unit -> unit
 		    val isOn: bool
 		    structure Data:
 		       sig
@@ -131,6 +132,7 @@
       Cleaner.addNew
       (Cleaner.atExit, fn () =>
        let
+	  val _ = clean ()
 	  val _ = Data.write (current (), "mlmon.out")
 	  val _ = List.app (S.Data.free o Data.array) (!Data.all)
        in





-------------------------------------------------------
This sf.net email is sponsored by: See the NEW Palm 
Tungsten T handheld. Power & Color in a compact size!
http://ads.sourceforge.net/cgi-bin/redirect.pl?palm0001en
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel