[prev in list] [next in list] [prev in thread] [next in thread]
List: sbcl-commits
Subject: [Sbcl-commits] master: Move nanosleep into C.
From: "stassats" <stassats () users ! sourceforge ! net>
Date: 2017-03-28 23:49:20
Message-ID: 1490744960.324108.11213 () sfp-scm-4 ! v30 ! ch3 ! sourceforge ! com
[Download RAW message or body]
The branch "master" has been updated in SBCL:
via b2071832914e31500f73f037f063a63905400e8f (commit)
from 5db73e64041b8f511b20bdc1ee99354e3d98766e (commit)
- Log -----------------------------------------------------------------
commit b2071832914e31500f73f037f063a63905400e8f
Author: Stas Boukarev <stassats@gmail.com>
Date: Wed Mar 29 02:11:26 2017 +0300
Move nanosleep into C.
There's already a wrapper, do more in it.
---
src/code/unix.lisp | 43 -------------------------------------------
src/runtime/wrap.c | 41 +++++++++++++++++++++++++++++++++++++++--
2 files changed, 39 insertions(+), 45 deletions(-)
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 11ed3d6..d35efde 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -937,49 +937,6 @@ avoiding atexit(3) hooks, etc. Otherwise exit(2) is called."
;; type is N-WORD-BITS wide.
(daylight-savings-p (boolean 32) :out))
-#!-(or win32 darwin)
-(defun nanosleep (secs nsecs)
- (declare (optimize (sb!c:alien-funcall-saves-fp-and-pc 0)))
- (with-alien ((req (struct timespec))
- (rem (struct timespec)))
- (setf (slot req 'tv-sec) secs
- (slot req 'tv-nsec) nsecs)
- (loop while (and (eql eintr
- (nth-value 1
- (int-syscall ("sb_nanosleep" (* (struct timespec))
- (* (struct timespec)))
- (addr req) (addr rem))))
- ;; KLUDGE: On Darwin, if an interrupt cases nanosleep to
- ;; take longer than the requested time, the call will
- ;; return with EINT and (unsigned)-1 seconds in the
- ;; remainder timespec, which would cause us to enter
- ;; nanosleep again for ~136 years. So, we check that the
- ;; remainder time is actually decreasing.
- ;;
- ;; It would be neat to do this bit of defensive
- ;; programming on all platforms, but unfortunately on
- ;; Linux, REM can be a little higher than REQ if the
- ;; nanosleep() call is interrupted quickly enough,
- ;; probably due to the request being rounded up to the
- ;; nearest HZ. This would cause the sleep to return way
- ;; too early.
- #!+darwin
- (let ((rem-sec (slot rem 'tv-sec))
- (rem-nsec (slot rem 'tv-nsec)))
- (when (or (> secs rem-sec)
- (and (= secs rem-sec) (>= nsecs rem-nsec)))
- ;; Update for next round.
- (setf secs rem-sec
- nsecs rem-nsec)
- t)))
- do (setf (slot req 'tv-sec) (slot rem 'tv-sec)
- (slot req 'tv-nsec) (slot rem 'tv-nsec)))))
-
-;;; nanosleep() is not re-entrant on some versions of Darwin,
-;;; this reimplements it using the underlying syscalls.
-;;; It uses a different interface to avoid copying code with a
-;;; different license.
-#!+darwin
(defun nanosleep (secs nsecs)
(declare (optimize (sb!c:alien-funcall-saves-fp-and-pc 0)))
(int-syscall ("sb_nanosleep" time-t int) secs nsecs)
diff --git a/src/runtime/wrap.c b/src/runtime/wrap.c
index ee25a46..c386215 100644
--- a/src/runtime/wrap.c
+++ b/src/runtime/wrap.c
@@ -551,10 +551,47 @@ int sb_gettimeofday(struct timeval *tp, void *tzp)
}
#ifndef LISP_FEATURE_DARWIN /* reimplements nanosleep in darwin-os.c */
-int sb_nanosleep(struct timespec *rqtp, struct timespec *rmtp)
+void sb_nanosleep(time_t sec, int nsec)
{
- return nanosleep(rqtp, rmtp);
+ struct timespec rqtp = {sec, nsec};
+ struct timespec rmtp;
+
+ while(nanosleep(&rqtp, &rmtp) && errno == EINTR) {
+ rqtp = rmtp;
+ /* The old lisp version stated
+ ;; KLUDGE: On Darwin, if an interrupt cases nanosleep to
+ ;; take longer than the requested time, the call will
+ ;; return with EINT and (unsigned)-1 seconds in the
+ ;; remainder timespec, which would cause us to enter
+ ;; nanosleep again for ~136 years. So, we check that the
+ ;; remainder time is actually decreasing.
+ ;;
+ ;; It would be neat to do this bit of defensive
+ ;; programming on all platforms, but unfortunately on
+ ;; Linux, REM can be a little higher than REQ if the
+ ;; nanosleep() call is interrupted quickly enough,
+ ;; probably due to the request being rounded up to the
+ ;; nearest HZ. This would cause the sleep to return way
+ ;; too early.
+ #!+darwin
+ (let ((rem-sec (slot rem 'tv-sec))
+ (rem-nsec (slot rem 'tv-nsec)))
+ (when (or (> secs rem-sec)
+ (and (= secs rem-sec) (>= nsecs rem-nsec)))
+ ;; Update for next round.
+ (setf secs rem-sec
+ nsecs rem-nsec)
+ t)
+
+ but the Darwin variant is implemented elsewhere
+ */
+ }
}
+#else
+/* nanosleep() is not re-entrant on some versions of Darwin and is
+ * reimplemented it using the underlying syscalls.
+ */
+void sb_nanosleep(time_t sec, int nsec);
#endif
int sb_select(int nfds, fd_set *readfds, fd_set *writefds, fd_set *exceptfds,
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
------------------------------------------------------------------------------
Check out the vibrant tech community on one of the world's most
engaging tech sites, Slashdot.org! http://sdm.link/slashdot
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic