X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdeadline.lisp;h=5252a11dafbe657fff1e0669aeb08a362f29e62e;hb=f7faed97898dd0e94a18b0d1fca03aaa0fe24ab0;hp=43b4fc9e51ada0f778a494f89a15f93def014c7d;hpb=23e31980c78d174ef9cb775bf28f970890327fea;p=sbcl.git

diff --git a/src/code/deadline.lisp b/src/code/deadline.lisp
index 43b4fc9..5252a11 100644
--- a/src/code/deadline.lisp
+++ b/src/code/deadline.lisp
@@ -117,6 +117,21 @@ seconds.) Otherwise return NIL if the restart is not found."
 CONDITION, or return NIL if the restart is not found."
   (try-restart 'cancel-deadline condition))
 
+(declaim (inline relative-decoded-times))
+(defun relative-decoded-times (abs-sec abs-usec)
+  #!+sb-doc
+  "Returns relative decoded times: difference between SEC and USEC and
+current real time."
+  (multiple-value-bind (now-sec now-usec)
+      (decode-internal-time (get-internal-real-time))
+    (let ((rel-sec (- abs-sec now-sec)))
+      (cond ((> now-usec abs-usec)
+             (values (max 0 (1- rel-sec))
+                     (- (+ abs-usec 1000000) now-usec)))
+            (t
+             (values (max 0 rel-sec)
+                     (- abs-usec now-usec)))))))
+
 ;;; Returns TIMEOUT-SEC, TIMEOUT-USEC, DEADLINE-SEC, DEADLINE-USEC, SIGNALP
 ;;;
 ;;; Takes *DEADLINE* into account: if it occurs before given SECONDS,
@@ -172,7 +187,7 @@ it will signal a timeout condition."
                    (decode-internal-time final-timeout)
                  (multiple-value-bind (stop-sec stop-usec)
                      (decode-internal-time final-deadline)
-                   (values to-sec to-usec stop-sec stop-usec signalp)))
+                   (values (max 0 to-sec) (max 0 to-usec) stop-sec stop-usec signalp)))
                (values nil nil nil nil nil)))))))
 
 (!defun-from-collected-cold-init-forms !deadline-cold-init)