Changeset 12221


Ignore:
Timestamp:
Jun 7, 2009, 7:24:09 PM (10 years ago)
Author:
gz
Message:

Merge r12186: check io vars for bogosity on entry to debugger and C

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

Legend:

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

    r12220 r12221  
    12691269
    12701270
    1271  
    1272 
     1271(flet ((io-stream-p (x) (and (streamp x) (eq (stream-direction x) :io)))
     1272       (input-stream-p (x) (and (streamp x) (input-stream-p x)))
     1273       (output-stream-p (x) (and (streamp x) (output-stream-p x)))
     1274       (default-terminal-io () (make-echoing-two-way-stream *stdin* *stdout*))
     1275       (terminal-io () *terminal-io*)
     1276       (standard-output () *standard-output*))
     1277
     1278  ;; Note that order matters.  These need to come out of %check-error-globals with
     1279  ;; *terminal-io* first and *trace-output* last
     1280  (check-error-global '*terminal-io* #'io-stream-p #'default-terminal-io)
     1281  (check-error-global '*query-io* #'io-stream-p #'terminal-io)
     1282  (check-error-global '*debug-io* #'io-stream-p #'terminal-io)
     1283  (check-error-global '*standard-input* #'input-stream-p #'terminal-io)
     1284  (check-error-global '*standard-output* #'output-stream-p #'terminal-io)
     1285  (check-error-global '*error-output* #'output-stream-p #'standard-output)
     1286  (check-error-global '*trace-output* #'output-stream-p #'standard-output))
     1287
  • trunk/source/level-1/l1-events.lisp

    r12196 r12221  
    105105  (process-interrupt p
    106106                     #'(lambda ()
    107                          (let* ((condition (make-condition 'interrupt-signal-condition)))
    108                            (ignoring-without-interrupts
    109                             (when *invoke-debugger-hook-on-interrupt*
    110                               (let* ((hook *debugger-hook*)
    111                                      (*debugger-hook* nil))
    112                                 (when hook
    113                                   (funcall hook condition hook))))
    114                             (%break-in-frame
    115                              #+ppc-target *fake-stack-frames*
    116                              #+x86-target (or (let* ((xcf (%current-xcf)))
    117                                                 (if xcf
    118                                                   (%%frame-backlink xcf)))
    119                                               (%get-frame-ptr))
    120                              condition)
    121                             (clear-input *terminal-io*))))))
     107                         (multiple-value-bind (vars inits old-vals) (%check-error-globals)
     108                           (progv vars old-vals
     109                             (mapcar (lambda (v f) (set v (funcall f))) vars inits)
     110                             (let ((condition (make-condition 'interrupt-signal-condition)))
     111                               (ignoring-without-interrupts
     112                                 (when *invoke-debugger-hook-on-interrupt*
     113                                   (let* ((hook *debugger-hook*)
     114                                          (*debugger-hook* nil))
     115                                     (when hook
     116                                       (funcall hook condition hook))))
     117                                 (%break-in-frame
     118                                  #+ppc-target *fake-stack-frames*
     119                                  #+x86-target (or (let* ((xcf (%current-xcf)))
     120                                                     (if xcf
     121                                                       (%%frame-backlink xcf)))
     122                                                   (%get-frame-ptr))
     123                                  condition)
     124                                 (clear-input *terminal-io*))))))))
    122125
    123126(defglobal *quit-interrupt-hook* nil)
Note: See TracChangeset for help on using the changeset viewer.