[armedbear-cvs] r11627 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Thu Feb  5 20:13:27 2009
New Revision: 11627

Log:
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.)

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

Modified: trunk/abcl/src/org/armedbear/lisp/trace.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/trace.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/trace.lisp	Thu Feb  5 20:13:27 2009
@@ -35,14 +35,14 @@
 
 (require "FORMAT")
 
-(require "CLOS")
+;;(require "CLOS")
 
 (defvar *trace-info-hashtable* (make-hash-table :test #'equal))
 
 (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)
 
@@ -89,21 +89,23 @@
       (with-standard-io-syntax
         (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)))))