Changeset 11661

Timestamp:

02/18/09 12:09:02 (14 years ago)

Author:

Mark Evenson

Message:

Restablish TRACE facility as per svn r11659.

Start documentation for release.

Mark as abcl-0.12.42.

Location:

branches/0.13.x/abcl

Files:

• ChangeLog (added)
• doc/ABCL-SLIME (added)
• scripts/update-version (copied) (copied from trunk/j/scripts/update-version)
• src/org/armedbear/lisp/trace.lisp (modified) (2 diffs)

branches/0.13.x/abcl/src/org/armedbear/lisp/trace.lisp

@@ -35 +35 @@
 
 (require "FORMAT")
-
 (defvar *trace-info-hashtable* (make-hash-table :test #'equal))
 
 (defstruct trace-info name untraced-function breakp)
 
-(defvar *trace-depth* 0)
+(defvar *trace-depth* 0
+  "Current depth of stack push for use of TRACE facility.")
+
+
+;;; XXX This eventually blows up in the compiler.How can we "punt" on  this and MAKE-LOAD-FORM ???
+(require "CLOS") 
+(defmethod make-load-form ((object trace-info) &optional environment)
+  (make-load-form-saving-slots object :environment environment))
 
 (defun list-traced-functions ()
@@ -117 +123 @@
         (setf (fdefinition name) traced-function)))))
 
+(defun untraced-function (name)
+  (let ((info (gethash name *trace-info-hashtable*)))
+    (and info (trace-info-untraced-function info))))
+
+(defun trace-redefined-update (name untraced-function)
+  (when (and *traced-names* (find name *traced-names* :test #'equal))
+    (let* ((info (gethash name *trace-info-hashtable*))
+           (traced-function (traced-function name info untraced-function)))
+      (setf (trace-info-untraced-function info) untraced-function)
+      (let ((*traced-names* '()))
+        (setf (fdefinition name) traced-function)))))
+
 (defun indent (string)
   (concatenate 'string