X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdeadline.lisp;h=d2577dc255735168f356e6156413fbf834a8a4fe;hb=cee8ef591040db9a79cdd19297867672a9529051;hp=5252a11dafbe657fff1e0669aeb08a362f29e62e;hpb=d6f9676ae94419cb5544c45821a8d31adbc1fbe8;p=sbcl.git diff --git a/src/code/deadline.lisp b/src/code/deadline.lisp index 5252a11..d2577dc 100644 --- a/src/code/deadline.lisp +++ b/src/code/deadline.lisp @@ -43,18 +43,22 @@ not extended. Deadlines are per thread: children are unaffected by their parent's deadlines. Experimental." - (with-unique-names (deadline-seconds deadline) + (with-unique-names (tmp deadline-seconds deadline) ;; We're operating on a millisecond precision, so a single-float ;; is enough, and is an immediate on 64bit platforms. - `(let* ((,deadline-seconds (coerce ,seconds 'single-float)) + `(let* ((,tmp ,seconds) + (,deadline-seconds + (when ,tmp + (coerce ,tmp 'single-float))) (,deadline - (+ (seconds-to-internal-time ,deadline-seconds) - (get-internal-real-time)))) + (when ,deadline-seconds + (+ (seconds-to-internal-time ,deadline-seconds) + (get-internal-real-time))))) (multiple-value-bind (*deadline* *deadline-seconds*) (if ,override (values ,deadline ,deadline-seconds) (let ((old *deadline*)) - (if (and old (< old ,deadline)) + (if (and old (or (not ,deadline) (< old ,deadline))) (values old *deadline-seconds*) (values ,deadline ,deadline-seconds)))) ,@body))))