[MLton] cvs commit: {OS,Posix}.Process.sleep

[Stephen Weeks]

sweeks      05/07/12 12:37:09

  Modified:    basis-library/posix primitive.sml process.sml
               basis-library/system process.sml
               doc      changelog
  Added:       runtime/Posix/Process nanosleep.c
  Log:
  MAIL {OS,Posix}.Process.sleep
  
  Attempted revision of {OS,Posix}.Process.sleep as per mailing list
  discussion.  Please read the code and make sure it makes sense.
  
  Both are now implemented by calling nanosleep.  Neither raises an
  exception.  The difference between the two is that Posix.Process.sleep
  returns (with the time remaining) when it is interrupted by a signal,
  whereas OS.Process.sleep loops calling Posix.Process.sleep with the
  time remaining.

Revision  Changes    Path
1.36      +3 -1      mlton/basis-library/posix/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/primitive.sml,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -r1.35 -r1.36
--- primitive.sml	23 May 2005 00:17:25 -0000	1.35
+++ primitive.sml	12 Jul 2005 19:37:07 -0000	1.36
@@ -194,8 +194,10 @@
 	       : Status.t -> bool;
 	    val ifStopped = _import "Posix_Process_ifStopped": Status.t -> bool;
 	    val kill = _import "Posix_Process_kill": Pid.t * Signal.t -> int;
+	    val nanosleep =
+	       _import "Posix_Process_nanosleep": int ref * int ref -> int;
 	    val pause = _import "Posix_Process_pause": unit -> int;
-	    val sleep = _import "Posix_Process_sleep": int -> int;
+(*	    val sleep = _import "Posix_Process_sleep": int -> int; *)
 	    val stopSig = _import "Posix_Process_stopSig": Status.t -> Signal.t;
 	    val system =
 	       _import "Posix_Process_system": NullString.t -> Status.t;



1.33      +21 -2     mlton/basis-library/posix/process.sml

Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/process.sml,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- process.sml	4 May 2005 15:03:12 -0000	1.32
+++ process.sml	12 Jul 2005 19:37:07 -0000	1.33
@@ -168,9 +168,28 @@
 	       handle Overflow => Error.raiseSys Error.inval)))
       in
 	 val alarm = wrap Prim.alarm
-	 val sleep = wrap Prim.sleep
+(*	 val sleep = wrap Prim.sleep *)
       end
-	 
+
+      fun sleep (t: Time.time): Time.time =
+	 let
+	    val (sec, nsec) = IntInf.quotRem (Time.toNanoseconds t, 1000000000)
+	    val (sec, nsec) =
+	       (IntInf.toInt sec, IntInf.toInt nsec)
+	       handle Overflow => Error.raiseSys Error.inval
+	    val secRem = ref sec
+	    val nsecRem = ref nsec
+	    fun remaining () =
+	       Time.+ (Time.fromSeconds (Int.toLarge (!secRem)),
+		       Time.fromNanoseconds (Int.toLarge (!nsecRem)))
+	 in
+	    SysCall.syscallErr
+	    ({clear = false, restart = false}, fn () =>
+	     {handlers = [(Error.intr, remaining)],
+	      post = remaining,
+	      return = Prim.nanosleep (secRem, nsecRem)})
+	 end
+
       (* FIXME: pause *)
       fun pause () =
 	 SysCall.syscallErr



1.16      +4 -3      mlton/basis-library/system/process.sml

Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/process.sml,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- process.sml	2 May 2005 19:20:27 -0000	1.15
+++ process.sml	12 Jul 2005 19:37:08 -0000	1.16
@@ -50,7 +50,8 @@
 
       val getEnv = Posix.ProcEnv.getenv
 
-      fun sleep t = if Time.<= (t, Time.zeroTime)
-		       then ()
-		    else (ignore (Posix.Process.sleep t); ())
+      fun sleep t =
+	 if Time.<= (t, Time.zeroTime)
+	    then ()
+	 else sleep (Posix.Process.sleep t)
    end



1.162     +5 -1      mlton/doc/changelog

Index: changelog
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/changelog,v
retrieving revision 1.161
retrieving revision 1.162
diff -u -r1.161 -r1.162
--- changelog	12 Jul 2005 02:33:43 -0000	1.161
+++ changelog	12 Jul 2005 19:37:08 -0000	1.162
@@ -1,6 +1,10 @@
 Here are the changes since version 20041109.
 
-* 2005-07-02
+* 2005-07-12
+  - Changed {OS,Posix}.Process.sleep to call nanosleep() instead of
+    sleep().
+
+* 2005-07-11
   - InetSock.{any,toAddr} raise SysErr if port is not in [0, 2^16).
 
 * 2005-07-02



1.1                  mlton/runtime/Posix/Process/nanosleep.c

Index: nanosleep.c
===================================================================
#include "platform.h"

Int Posix_Process_nanosleep (Pointer sec, Pointer nsec) {
	struct timespec rem;
	struct timespec req;
	int res;

	req.tv_sec = *(Int*)sec;
	req.tv_nsec =*(Int*)nsec;
	rem.tv_sec = 0;
	rem.tv_nsec = 0;
	res = nanosleep (&req, &rem);
	if (FALSE)
		fprintf (stderr, "res = %d  sec = %d  nsec = %d\n",
				res, (int)rem.tv_sec, (int)rem.tv_nsec);
	*(Int*)sec = rem.tv_sec;
	*(Int*)nsec = rem.tv_nsec;
	return res;
}