Fix QUERY-FILE-SYSTEM for Windows UNC and device file names

[sbcl.git] / src / code / deadline.lisp

diff --git a/src/code/deadline.lisp b/src/code/deadline.lisp
index 413eb86..43b4fc9 100644 (file)
--- a/src/code/deadline.lisp
+++ b/src/code/deadline.lisp
@@ -12,13 +12,17 @@
 
 (in-package "SB!IMPL")
 
+(!begin-collecting-cold-init-forms)
+
 ;;; Current deadline as internal time units or NIL.
-(defvar *deadline* nil)
 (declaim (type (or unsigned-byte null) *deadline*))
+(defvar *deadline*)
+(!cold-init-forms (setq *deadline* nil))
 
 ;;; The relative number of seconds the current deadline corresponds
 ;;; to. Used for continuing from TIMEOUT conditions.
-(defvar *deadline-seconds* nil)
+(defvar *deadline-seconds*)
+(!cold-init-forms (setq *deadline-seconds* nil))
 
 (declaim (inline seconds-to-internal-time))
 (defun seconds-to-internal-time (seconds)
@@ -88,19 +92,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."
+        :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
-                *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
-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))
 
+(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,
@@ -158,3 +174,5 @@ 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)))))))
+
+(!defun-from-collected-cold-init-forms !deadline-cold-init)