Changeset 7781 for branches/working-0710


Ignore:
Timestamp:
Nov 29, 2007, 8:55:23 PM (12 years ago)
Author:
gb
Message:

Define ABNORMAL-PROGRAM-EXIT, which currently does PRINT-CALL-HISTORY
and (QUIT -1). Call it if we'd enter a break loop.

Make sure that we wait for terminal input only if we're going to
actually enter a break loop in BREAK-LOOP-HANDLE-ERROR.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0710/ccl/level-1/l1-readloop-lds.lisp

    r7705 r7781  
    388388  (break-loop-handle-error condition error-pointer))
    389389
     390(defun abnormal-application-exit ()
     391  (print-call-history)
     392  (quit -1))
     393
    390394(defun break-loop-handle-error (condition error-pointer)
    391395  (multiple-value-bind (bogus-globals newvals oldvals) (%check-error-globals)
     
    397401        (funcall hook condition hook)))
    398402    (%break-message "Error" condition error-pointer)
    399     (with-terminal-input
    400       (let* ((s *error-output*))
    401         (dolist (bogusness bogus-globals)
    402           (let ((oldval (pop oldvals)))
    403             (format s "~&;  NOTE: ~S was " bogusness)
    404             (if (eq oldval (%unbound-marker-8))
    405               (format s "unbound")
    406               (format s "~s" oldval))
    407             (format s ", was reset to ~s ." (symbol-value bogusness)))))
    408       (if (and *break-on-errors* (not *batch-flag*))
    409         (break-loop condition error-pointer)
    410         (if *batch-flag*
    411           (quit -1)
    412           (abort))))))
     403    (let* ((s *error-output*))
     404      (dolist (bogusness bogus-globals)
     405        (let ((oldval (pop oldvals)))
     406          (format s "~&;  NOTE: ~S was " bogusness)
     407          (if (eq oldval (%unbound-marker-8))
     408            (format s "unbound")
     409            (format s "~s" oldval))
     410          (format s ", was reset to ~s ." (symbol-value bogusness)))))
     411    (if (and *break-on-errors* (not *batch-flag*))
     412      (with-terminal-input
     413          (break-loop condition error-pointer))
     414      (if *batch-flag*
     415        (abnormal-application-exit)
     416        (abort))))))
    413417
    414418(defun break (&optional string &rest args)
Note: See TracChangeset for help on using the changeset viewer.