projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
1.0.46.31: clean up mach port deallocation on x86
[sbcl.git]
/
src
/
code
/
deadline.lisp
diff --git
a/src/code/deadline.lisp
b/src/code/deadline.lisp
index
413eb86
..
97a147b
100644
(file)
--- a/
src/code/deadline.lisp
+++ b/
src/code/deadline.lisp
@@
-88,19
+88,31
@@
for calling this when a deadline is reached."
(error 'deadline-timeout :seconds *deadline-seconds*)
(defer-deadline (&optional (seconds *deadline-seconds*))
:report "Defer the deadline for SECONDS more."
(error 'deadline-timeout :seconds *deadline-seconds*)
(defer-deadline (&optional (seconds *deadline-seconds*))
:report "Defer the deadline for SECONDS more."
+ :interactive (lambda ()
+ (sb!int:read-evaluated-form
+ "By how many seconds shall the deadline ~
+ be deferred?: "))
(let* ((new-deadline-seconds (coerce seconds 'single-float))
(new-deadline (+ (seconds-to-internal-time new-deadline-seconds)
(get-internal-real-time))))
(setf *deadline* new-deadline
(let* ((new-deadline-seconds (coerce seconds 'single-float))
(new-deadline (+ (seconds-to-internal-time new-deadline-seconds)
(get-internal-real-time))))
(setf *deadline* new-deadline
- *deadline-seconds* new-deadline-seconds))))))
+ *deadline-seconds* new-deadline-seconds)))
+ (cancel-deadline ()
+ :report "Cancel the deadline and continue."
+ (setf *deadline* nil *deadline-seconds* nil))))
+ nil)
(defun defer-deadline (seconds &optional condition)
"Find the DEFER-DEADLINE restart associated with CONDITION, and
(defun defer-deadline (seconds &optional condition)
"Find the DEFER-DEADLINE restart associated with CONDITION, and
-calls it with SECONDS as argument (deferring the deadline by that many
-seconds.) Continues from the indicated restart, or returns NIL if the
-restart is not found."
+invoke it with SECONDS as argument (deferring the deadline by that many
+seconds.) Otherwise return NIL if the restart is not found."
(try-restart 'defer-deadline condition seconds))
(try-restart 'defer-deadline condition seconds))
+(defun cancel-deadline (&optional condition)
+ "Find and invoke the CANCEL-DEADLINE restart associated with
+CONDITION, or return NIL if the restart is not found."
+ (try-restart 'cancel-deadline condition))
+
;;; Returns TIMEOUT-SEC, TIMEOUT-USEC, DEADLINE-SEC, DEADLINE-USEC, SIGNALP
;;;
;;; Takes *DEADLINE* into account: if it occurs before given SECONDS,
;;; Returns TIMEOUT-SEC, TIMEOUT-USEC, DEADLINE-SEC, DEADLINE-USEC, SIGNALP
;;;
;;; Takes *DEADLINE* into account: if it occurs before given SECONDS,
@@
-158,3
+170,4
@@
it will signal a timeout condition."
(decode-internal-time final-deadline)
(values to-sec to-usec stop-sec stop-usec signalp)))
(values nil nil nil nil nil)))))))
(decode-internal-time final-deadline)
(values to-sec to-usec stop-sec stop-usec signalp)))
(values nil nil nil nil nil)))))))
+