Changeset 12090 for trunk/source/level-1


Ignore:
Timestamp:
May 19, 2009, 12:52:40 PM (10 years ago)
Author:
gz
Message:

Add ccl:*break-hook*; Also make c signal a specific condition class, ccl:interrupt-signal-condition

Location:
trunk/source/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-events.lisp

    r11765 r12090  
    9999(defparameter *invoke-debugger-hook-on-interrupt* nil)
    100100
     101(define-condition interrupt-signal-condition (condition) ()
     102  (:report "interrupt signal"))
     103
    101104(defun force-break-in-listener (p)
    102105  (process-interrupt p
    103106                     #'(lambda ()
    104                          (let* ((condition (condition-arg "interrupt signal" nil 'simple-condition)))
     107                         (let* ((condition (make-condition 'interrupt-signal-condition)))
    105108                           (ignoring-without-interrupts
    106109                            (when *invoke-debugger-hook-on-interrupt*
  • trunk/source/level-1/l1-readloop-lds.lisp

    r11963 r12090  
    543543                                        ; returns NIL
    544544
     545(defvar *break-hook* nil)
     546
    545547(defun cbreak-loop (msg cont-string condition error-pointer)
    546   (let* ((*print-readably* nil))
    547     (%break-message msg condition error-pointer)
    548     (restart-case (break-loop condition error-pointer)
     548  (let* ((*print-readably* nil)
     549         (hook *break-hook*))
     550    (restart-case (progn
     551                    (when hook
     552                      (let ((*break-hook* nil))
     553                        (funcall hook condition hook))
     554                      (setq hook nil))
     555                    (%break-message msg condition error-pointer)
     556                    (break-loop condition error-pointer))
    549557      (continue () :report (lambda (stream) (write-string cont-string stream))))
    550     (fresh-line *error-output*)
     558    (unless hook
     559      (fresh-line *error-output*))
    551560    nil))
    552561
Note: See TracChangeset for help on using the changeset viewer.