Changeset 11627

Timestamp:

02/05/09 20:13:27 (14 years ago)

Author:

ehuelsmann

Message:

Make TRACE protect *TRACE-DEPTH* from non-local returns (such as RETURN to TOP-LEVEL restarts).
Also make TRACE no longer invoke CLOS (and thus the compiler,

making it possible to trace the compiler now, instead of getting a stack overflow.)

File:

• trunk/abcl/src/org/armedbear/lisp/trace.lisp (modified) (3 diffs)

trunk/abcl/src/org/armedbear/lisp/trace.lisp

@@ -36 +36 @@
 (require "FORMAT")
 
-(require "CLOS")
+;;(require "CLOS")
 
 (defvar *trace-info-hashtable* (make-hash-table :test #'equal))
@@ -42 +42 @@
 (defstruct trace-info name untraced-function breakp)
 
-(defmethod make-load-form ((object trace-info) &optional environment)
-   (make-load-form-saving-slots object :environment environment))
+;;(defmethod make-load-form ((object trace-info) &optional environment)
+;;   (make-load-form-saving-slots object :environment environment))
 
 (defvar *trace-depth* 0)
@@ -90 +90 @@
         (let ((*print-readably* nil)
               (*print-structure* nil))
-          (format *trace-output* (indent "~D: ~S~%") *trace-depth*
+          (%format *trace-output* (indent "~D: ~S~%") *trace-depth*
                   (cons name args))))
       (when breakp
         (break))
       (incf *trace-depth*)
-      (let ((results (multiple-value-list (apply untraced-function args))))
-        (decf *trace-depth*)
+      (let ((results (multiple-value-list
+                      (unwind-protect
+                           (apply untraced-function args)
+                        (decf *trace-depth*)))))
         (with-standard-io-syntax
           (let ((*print-readably* nil)
                 (*print-structure* nil))
-            (format *trace-output* (indent "~D: ~A returned") *trace-depth* name)
+            (%format *trace-output* (indent "~D: ~A returned") *trace-depth* name)
             (if results
                 (dolist (result results)
-                  (format *trace-output* " ~S" result))
-                (format *trace-output* " no values"))
+                  (%format *trace-output* " ~S" result))
+                (%format *trace-output* " no values"))
             (terpri *trace-output*)))
         (values-list results)))))