common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Institute a depth cutoff for source paths

Browse source 
Somewhat arbitrarily choose 100, since that is where the existing test
for lp#654289 puts the dividing line between "small" and "big".  What
this means in practice is that code nested more than 100-levels deep
from the toplevel will not have accurate source path information
associated with it.

Make FORM-NUMBER-TRANSLATIONS and SUB-FIND-SOURCE-PATHS consistent in
how they register (or, rather, do not register) instances of code
while traversing the current form that are EQL to forms that have
already been seen.  This allows a consistency test on code with a
quoted constant as from the lp#654289 bug report.  Also re-enable the
compiler scaling test, since we have carefully chosen the cutoff to
make it passable.  (It's still probably a bad idea to put a literal
1000-level tree in your source code.)
This commit is contained in:
Christophe Rhodes 2025-10-30 21:12:00 +00:00
parent 747a7d7acd
commit e37f5a77cb
4 changed files with 25 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/code/debug-int.lisp
View file

@ -3128,11 +3128,13 @@ register."
(defun form-number-translations (form tlf-number)
(let ((seen nil)
(translations (make-array 12 :fill-pointer 0 :adjustable t)))
(labels ((translate1 (form path)
(labels ((translate1 (form path depth)
(unless (member form seen)
(push form seen)
(vector-push-extend (cons (fill-pointer translations) path)
translations)
(unless (< depth 100) ; ARB but has to be the same as in SUB-FIND-SOURCE-PATHS
(return-from translate1))
(let ((pos 0)
(subform form)
(trail form))
@ -3145,9 +3147,9 @@ register."
((atom subform) (return)))
(let ((fm (car subform)))
(cond
((consp fm) (translate1 fm (cons pos path)))
((consp fm) (translate1 fm (cons pos path) (1+ depth)))
((comma-p fm)
(translate1 (list 'comma (comma-expr fm)) (list* pos path)))))
(translate1 (list 'comma (comma-expr fm)) (list* pos path) (1+ depth)))))
(setq subform (cdr subform)
pos (1+ pos))
(when (eq subform trail) (return)))))
@ -3155,7 +3157,7 @@ register."
(frob)
(frob)
(setq trail (cdr trail))))))))
(translate1 form (list tlf-number)))
(translate1 form (list tlf-number) 0))
(coerce translations 'simple-vector)))
;;; FORM is a top level form, and path is a source-path into it. This

15
src/compiler/ir1tran.lisp
View file

@ -552,11 +552,14 @@
(defun find-source-paths (form tlf-num)
(declare (type index tlf-num))
(let ((*current-form-number* 0))
(sub-find-source-paths form (list tlf-num)))
(sub-find-source-paths form (list tlf-num) 0))
(values))
(defun sub-find-source-paths (form path)
(defun sub-find-source-paths (form path depth)
(unless (get-source-path form)
(note-source-path form path)
(unless (< depth 100) ; ARB, see lp#654289
#+sb-xc-host (bug "Unexpected depth of code")
#-sb-xc-host (return-from sub-find-source-paths))
(let ((pos 0)
(subform form)
(trail form))
@ -572,12 +575,14 @@
(cond
((consp fm)
(incf *current-form-number*)
(sub-find-source-paths fm (cons pos path)))
(sub-find-source-paths fm (cons pos path) (1+ depth)))
;; (a b ,c d) -> (a b (comma c) d)
((comma-p fm)
(incf *current-form-number*)
(sub-find-source-paths (list 'comma (comma-expr fm)) (cons pos path)))
((not (zerop pos)) (note-source-path subform pos path))))
(sub-find-source-paths (list 'comma (comma-expr fm)) (cons pos path) (1+ depth)))
((not (zerop pos))
(unless (get-source-path subform)
(note-source-path subform pos path)))))
(setq subform (cdr subform)
pos (1+ pos))
(when (eq subform trail) (return)))))

2
tests/compiler.pure.lisp
View file

@ -3739,7 +3739,7 @@
(load-time-value (the (values fixnum) 42)))
(() 42)))
(with-test (:name (compile :bug-654289) :fails-on :sbcl)
(with-test (:name (compile :bug-654289))
;; Test that compile-times don't explode when quoted constants
;; get big.
(labels ((time-n (n)

9
tests/form-number-translations.impure.lisp
View file

@ -22,7 +22,7 @@
(defun source-paths (form)
(let ((sb-c::*source-paths* (make-hash-table :test 'eq))
(sb-c::*current-form-number* 0))
(sb-c::sub-find-source-paths form (list 0))
(sb-c::sub-find-source-paths form (list 0) 0)
(let (result)
(sb-int:dohash ((k v) sb-c::*source-paths* :result result)
(declare (ignore k))
@ -91,3 +91,10 @@
expr))))
`(unless ,expr
(%failed-aver ',(replace-symbols expr)))))))
(with-test (:name (:static :deep-tree :check-consistency))
(labels ((make-tree (n acc)
(cond ((zerop n) acc)
(t (make-tree (1- n) (cons acc acc))))))
(check-consistency (eval `'(defmacro deep-tree (n)
(nthcdr n ',(make-tree 200 nil)))))))