1.0.47.27: limit open coding from MEMBER, ASSOC, &co

  Open coding massive lists doesn't really help, and a sufficiently
  long list can blow the stack during compilation.

diff --git a/NEWS b/NEWS
index 5adaafc..281a811 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -30,6 +30,8 @@ changes relative to sbcl-1.0.47:
     engages the obsolete instance protocol. (lp#766271)
   * bug fix: constant improper lists could break source coverage recording.
     (lp#767959)
+  * bug fix: compiling calls to eg. MEMBER with massive constant list arguments
+    could exhaust stack.
 
 changes in sbcl-1.0.47 relative to sbcl-1.0.46:
   * bug fix: fix mach port rights leaks in mach exception handling code on

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 7775528..67ecb5a 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -316,6 +316,8 @@
       (bug "Unknown list item seek transform: name=~S, key-functions=~S variant=~S"
            function-name key-functions variant)))
 
+(defparameter *list-open-code-limit* 128)
+
 (defun transform-list-item-seek (name item list key test test-not node)
   (when (and test test-not)
     (abort-ir1-transform "Both ~S and ~S supplied to ~S." :test :test-not name))
@@ -376,7 +378,8 @@
         (let* ((cp (constant-lvar-p list))
                (c-list (when cp (lvar-value list))))
           (cond ((and cp c-list (member name '(assoc rassoc member))
-                      (policy node (>= speed space)))
+                      (policy node (>= speed space))
+                      (not (nthcdr *list-open-code-limit* c-list)))
                  `(let ,(mapcar (lambda (fun) `(,(second fun) ,(ensure-fun fun))) funs)
                     ,(open-code c-list)))
                 ((and cp (not c-list))
@@ -431,7 +434,8 @@
                         ,(open-code (cdr tail))))))
         (let* ((cp (constant-lvar-p list))
                (c-list (when cp (lvar-value list))))
-          (cond ((and cp c-list (policy node (>= speed space)))
+          (cond ((and cp c-list (policy node (>= speed space))
+                      (not (nthcdr *list-open-code-limit* c-list)))
                  `(let ((pred ,pred-expr)
                         ,@(when key `((key ,key-form))))
                     ,(open-code c-list)))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index c2223e7..f6dcabf 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3867,3 +3867,10 @@
                   (assoc
                    nil
                    '((:ordinary . ordinary-lambda-list))))))
+
+(with-test (:name :member-on-long-constant-list)
+  ;; This used to blow stack with a sufficiently long list.
+  (let ((cycle (list t)))
+    (nconc cycle cycle)
+    (compile nil `(lambda (x)
+                    (member x ',cycle)))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 93d53f0..72e16ed 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,4 @@
 ;;; 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".)
-"1.0.47.26"
+"1.0.47.27"