[MLton-devel] cvs commit: signal initialization more tolerant

[Stephen Weeks]

sweeks      03/02/08 13:15:23

  Modified:    basis-library/mlton signal.sml
  Log:
  Initialization of the signal handler array now notices when a signal
  is invalid and records the fact, rather than raising SysErr.
  
  This fixes the problem that Roberto was seeing on RedHat 8.0.9{2,3}.

Revision  Changes    Path
1.18      +24 -17    mlton/basis-library/mlton/signal.sml

Index: signal.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/signal.sml,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- signal.sml	3 Jan 2003 06:14:14 -0000	1.17
+++ signal.sml	8 Feb 2003 21:15:22 -0000	1.18
@@ -14,7 +14,8 @@
 
 type t = signal
    
-local open Prim
+local
+   open Prim
 in
    val prof = prof
    val vtalrm = vtalrm
@@ -64,38 +65,40 @@
 	 Default
        | Handler of unit MLtonThread.t -> unit MLtonThread.t
        | Ignore
+       | InvalidSignal
    end
 
 datatype handler = datatype Handler.t
 
-(* Signal 0 is invalid, so we pretend it is default *)
 local
    val r = ref false
 in
-   fun defaultOrIgnore s =
-      if 0 = s
-	 orelse (PosixError.checkResult (Prim.isDefault (s, r))
-		 ; !r)
-	 then Default
-      else Ignore
+   fun initHandler s =
+      if 0 = Prim.isDefault (s, r)
+	 then if !r
+		 then Default
+	      else Ignore
+      else InvalidSignal
 end
-    
+
+fun raiseInval () =
+   let
+      open PosixError
+   in
+      raiseSys inval
+   end
+
 val (get, set, handlers) =
    let
-      val handlers = Array.tabulate (Prim.numSignals, defaultOrIgnore)
+      val handlers = Array.tabulate (Prim.numSignals, initHandler)
       val _ =
 	 Cleaner.addNew
 	 (Cleaner.atLoadWorld, fn () =>
-	  Array.modifyi (defaultOrIgnore o #1) handlers)
+	  Array.modifyi (initHandler o #1) handlers)
    in
       (fn s => Array.sub (handlers, s),
        fn (s, h) => if Primitive.MLton.Profile.isOn andalso s = prof
-		       then
-			  let
-			     open PosixError
-			  in
-			     raiseSys inval
-			  end
+		       then raiseInval ()
 		    else Array.update (handlers, s, h),
        handlers)
    end
@@ -105,12 +108,14 @@
 fun ignore s =
    case get s of
       Ignore => ()
+    | InvalidSignal => raiseInval ()
     | _ => (set (s, Ignore)
 	    ; checkResult (Prim.ignore s))
 
 fun handleDefault s =
    case getHandler s of
       Default => ()
+    | InvalidSignal => raiseInval ()
     | _ => (set (s, Default)
 	    ; checkResult (Prim.default s))
 
@@ -160,6 +165,7 @@
    in
       case old of
 	 Handler _ => ()
+       | InvalidSignal => raiseInval ()
        | _ => checkResult (Prim.handlee s)
    end
 
@@ -172,6 +178,7 @@
       Default => handleDefault s
     | Handler f => handleWithSafe (s, Handler f)
     | Ignore => ignore s
+    | InvalidSignal => raiseInval ()
 
 fun suspend m =
    (Mask.create m





-------------------------------------------------------
This SF.NET email is sponsored by:
SourceForge Enterprise Edition + IBM + LinuxWorld = Something 2 See!
http://www.vasoftware.com
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel