[MLton] cvs commit: {OS,Posix}.Process.sleep
Stephen Weeks
sweeks@mlton.org
Tue, 12 Jul 2005 12:37:10 -0700
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;
}