Changeset 11661


Ignore:
Timestamp:
02/18/09 12:09:02 (12 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:
2 added
1 edited
1 copied

Legend:

Unmodified
Added
Removed
  • branches/0.13.x/abcl/src/org/armedbear/lisp/trace.lisp

    r11628 r11661  
    3535
    3636(require "FORMAT")
    37 
    3837(defvar *trace-info-hashtable* (make-hash-table :test #'equal))
    3938
    4039(defstruct trace-info name untraced-function breakp)
    4140
    42 (defvar *trace-depth* 0)
     41(defvar *trace-depth* 0
     42  "Current depth of stack push for use of TRACE facility.")
     43
     44
     45;;; XXX This eventually blows up in the compiler.How can we "punt" on  this and MAKE-LOAD-FORM ???
     46(require "CLOS")
     47(defmethod make-load-form ((object trace-info) &optional environment)
     48  (make-load-form-saving-slots object :environment environment))
    4349
    4450(defun list-traced-functions ()
     
    117123        (setf (fdefinition name) traced-function)))))
    118124
     125(defun untraced-function (name)
     126  (let ((info (gethash name *trace-info-hashtable*)))
     127    (and info (trace-info-untraced-function info))))
     128
     129(defun trace-redefined-update (name untraced-function)
     130  (when (and *traced-names* (find name *traced-names* :test #'equal))
     131    (let* ((info (gethash name *trace-info-hashtable*))
     132           (traced-function (traced-function name info untraced-function)))
     133      (setf (trace-info-untraced-function info) untraced-function)
     134      (let ((*traced-names* '()))
     135        (setf (fdefinition name) traced-function)))))
     136
    119137(defun indent (string)
    120138  (concatenate 'string
Note: See TracChangeset for help on using the changeset viewer.