From 23c0c48f562d7dc5d1615bf13cb831b46c91d106 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 29 Aug 2006 13:35:23 +0000 Subject: [PATCH] 0.9.16.6: better circularity detection in fasl dumper * We need to detect car-circularity too, which can get expensive, so we approximate: CYCLIC-LIST-P => MAYBE-CYCLIC-P * Reported by Marco Monteiro on sbcl-devel. --- NEWS | 2 ++ package-data-list.lisp-expr | 2 +- src/code/early-extensions.lisp | 41 +++++++++++++++++++++++++++++++--------- src/code/pred.lisp | 7 +++---- src/compiler/dump.lisp | 2 +- tests/circ-tree-test.lisp | 5 +++++ tests/compiler.impure.lisp | 5 +++++ version.lisp-expr | 2 +- 8 files changed, 50 insertions(+), 16 deletions(-) create mode 100644 tests/circ-tree-test.lisp diff --git a/NEWS b/NEWS index b613ab5..033fc69 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,8 @@ changes in sbcl-0.9.17 (0.9.99?) relative to sbcl-0.9.16: for a type now works. * bug fix: loading of default sysinit file works. (thanks to Leonid Slobodov) + * bug fix: better detection of circularities in the file-compiler. + (reported by Marco Monteiro) changes in sbcl-0.9.16 relative to sbcl-0.9.15: * feature: implemented the READER-METHOD-CLASS and diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index e2dd14b..833033a 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -869,7 +869,7 @@ retained, possibly temporariliy, because it might be used internally." "ADJUST-LIST" "%FIND-PACKAGE-OR-LOSE" "FIND-UNDELETED-PACKAGE-OR-LOSE" "SANE-PACKAGE" - "CYCLIC-LIST-P" + "MAYBE-CYCLIC-P" "COMPOUND-OBJECT-P" "SWAPPED-ARGS-FUN" "AND/TYPE" "NOT/TYPE" diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index df396b3..5115fc0 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -127,16 +127,39 @@ ;;;; type-ish predicates -;;; Is X a list containing a cycle? -(defun cyclic-list-p (x) +;;; X may contain cycles -- a conservative approximation. This +;;; occupies a somewhat uncomfortable niche between being fast for +;;; common cases (we don't want to allocate a hash-table), and not +;;; falling down to exponential behaviour for large trees (so we set +;;; an arbitrady depth limit beyond which we punt). +(defun maybe-cyclic-p (x &optional (depth-limit 12)) (and (listp x) - (labels ((safe-cddr (x) (if (listp (cdr x)) (cddr x)))) - (do ((y x (safe-cddr y)) - (started-p nil t) - (z x (cdr z))) - ((not (and (consp z) (consp y))) nil) - (when (and started-p (eq y z)) - (return t)))))) + (labels ((safe-cddr (cons) + (let ((cdr (cdr cons))) + (when (consp cdr) + (cdr cdr)))) + (check-cycle (object seen depth) + (when (and (consp object) + (or (> depth depth-limit) + (member object seen) + (circularp object seen depth))) + (return-from maybe-cyclic-p t))) + (circularp (list seen depth) + ;; Almost regular circular list detection, with a twist: + ;; we also check each element of the list for upward + ;; references using CHECK-CYCLE. + (do ((fast (cons (car list) (cdr list)) (safe-cddr fast)) + (slow list (cdr slow))) + ((not (consp fast)) + ;; Not CDR-circular, need to check remaining CARs yet + (do ((tail slow (and (cdr tail)))) + ((not (consp tail)) + nil) + (check-cycle (car tail) (cons tail seen) (1+ depth)))) + (check-cycle (car slow) (cons slow seen) (1+ depth)) + (when (eq fast slow) + (return t))))) + (circularp x (list x) 0)))) ;;; Is X a (possibly-improper) list of at least N elements? (declaim (ftype (function (t index)) list-of-length-at-least-p)) diff --git a/src/code/pred.lisp b/src/code/pred.lisp index 76286c4..27158cf 100644 --- a/src/code/pred.lisp +++ b/src/code/pred.lisp @@ -221,10 +221,9 @@ (defun equal (x y) #!+sb-doc - "Return T if X and Y are EQL or if they are structured components - whose elements are EQUAL. Strings and bit-vectors are EQUAL if they - are the same length and have identical components. Other arrays must be - EQ to be EQUAL." + "Return T if X and Y are EQL or if they are structured components whose +elements are EQUAL. Strings and bit-vectors are EQUAL if they are the same +length and have identical components. Other arrays must be EQ to be EQUAL." ;; Non-tail self-recursion implemented with a local auxiliary function ;; is a lot faster than doing it the straightforward way (at least ;; on x86oids) due to calling convention differences. -- JES, 2005-12-30 diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index a5d750c..4d136f3 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -384,7 +384,7 @@ ;; take a little more care while dumping these. ;; So if better list coalescing is needed, start here. ;; -- WHN 2000-11-07 - (if (cyclic-list-p x) + (if (maybe-cyclic-p x) (progn (dump-list x file) (eq-save-object x file)) diff --git a/tests/circ-tree-test.lisp b/tests/circ-tree-test.lisp new file mode 100644 index 0000000..2189186 --- /dev/null +++ b/tests/circ-tree-test.lisp @@ -0,0 +1,5 @@ +;;; fasl-dumper and circular trees, reported by Marco Monteiro +(COMPILE NIL + '(LAMBDA () + (LIST '#5= (#5# #5# . #5#)) + (LIST '#6= (#7= (#6#) . #7#)))) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 78d6416..ae57aa9 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -1383,4 +1383,9 @@ (assert (not res)) (assert (typep err 'type-error))) +(handler-case + (delete-file (compile-file "circ-tree-test.lisp")) + (storage-condition (e) + (error e))) + ;;; success diff --git a/version.lisp-expr b/version.lisp-expr index 3f1829f..d2080d2 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,5 +17,5 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.16.5" +"0.9.16.6" -- 1.7.10.4