From: Nikodemus S. <de...@us...> - 2007-11-06 15:01:18
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv13012/src/code Modified Files: debug-int.lisp Log Message: 1.0.11.14: thread-safe FORM-NUMBER-TRANSLATIONS * Instead of keeping global tables, allocate new ones for each call. Since common case seems to be a "decently small" form, use a list instead of hash-table. ...but we could really do with a better internal set representation for arbitrary objects -- both here and in MEMBER type machinery. Index: debug-int.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/debug-int.lisp,v retrieving revision 1.116 retrieving revision 1.117 diff -u -d -r1.116 -r1.117 --- debug-int.lisp 6 Nov 2007 14:25:37 -0000 1.116 +++ debug-int.lisp 6 Nov 2007 15:01:06 -0000 1.117 @@ -2639,13 +2639,6 @@ ;;; Given the DEFUN, 3 gets you the LET, 1 gets you the bindings, 0 ;;; gets the first binding, and 1 gets the AREF form. -;;; temporary buffer used to build form-number => source-path translation in -;;; FORM-NUMBER-TRANSLATIONS -(defvar *form-number-temp* (make-array 10 :fill-pointer 0 :adjustable t)) - -;;; table used to detect CAR circularities in FORM-NUMBER-TRANSLATIONS -(defvar *form-number-circularity-table* (make-hash-table :test 'eq)) - ;;; This returns a table mapping form numbers to source-paths. A ;;; source-path indicates a descent into the TOPLEVEL-FORM form, ;;; going directly to the subform corressponding to the form number. @@ -2654,32 +2647,32 @@ ;;; NODE-SOURCE-PATH; that is, the first element is the form number and ;;; the last is the TOPLEVEL-FORM number. (defun form-number-translations (form tlf-number) - (clrhash *form-number-circularity-table*) - (setf (fill-pointer *form-number-temp*) 0) - (sub-translate-form-numbers form (list tlf-number)) - (coerce *form-number-temp* 'simple-vector)) -(defun sub-translate-form-numbers (form path) - (unless (gethash form *form-number-circularity-table*) - (setf (gethash form *form-number-circularity-table*) t) - (vector-push-extend (cons (fill-pointer *form-number-temp*) path) - *form-number-temp*) - (let ((pos 0) - (subform form) - (trail form)) - (declare (fixnum pos)) - (macrolet ((frob () - '(progn - (when (atom subform) (return)) - (let ((fm (car subform))) - (when (consp fm) - (sub-translate-form-numbers fm (cons pos path))) - (incf pos)) - (setq subform (cdr subform)) - (when (eq subform trail) (return))))) - (loop - (frob) - (frob) - (setq trail (cdr trail))))))) + (let ((seen nil) + (translations (make-array 12 :fill-pointer 0 :adjustable t))) + (labels ((translate1 (form path) + (unless (member form seen) + (push form seen) + (vector-push-extend (cons (fill-pointer translations) path) + translations) + (let ((pos 0) + (subform form) + (trail form)) + (declare (fixnum pos)) + (macrolet ((frob () + '(progn + (when (atom subform) (return)) + (let ((fm (car subform))) + (when (consp fm) + (translate1 fm (cons pos path))) + (incf pos)) + (setq subform (cdr subform)) + (when (eq subform trail) (return))))) + (loop + (frob) + (frob) + (setq trail (cdr trail)))))))) + (translate1 form (list tlf-number))) + (coerce translations 'simple-vector))) ;;; FORM is a top level form, and path is a source-path into it. This ;;; returns the form indicated by the source-path. Context is the |