Browse files

Merge branch 'master' into mswin

  • Loading branch information...
akovalenko committed Jan 3, 2013
2 parents 1731faf + 678a5d0 commit beed089a9ae92093ee129047213b5bb4ed8ab850
Showing with 22 additions and 17 deletions.
  1. +5 −4 NEWS
  2. +9 −9 src/code/defboot.lisp
  3. +8 −4 src/code/early-extensions.lisp
@@ -1,15 +1,16 @@
;;;; -*- coding: utf-8; fill-column: 78 -*-
-changes relative to sbcl-1.1.2:
+changes relative to sbcl-1.1.3:
+ * bug fix: very long (or infinite) constant lists in DOLIST do not result
+ in very long compile times or heap exhaustion anymore. (lp#1095488)
+changes in sbcl-1.1.3 relative to sbcl-1.1.2:
* enhancement: warnings about bad locale settings, LANG, LC_CTYPE, etc.
* bug fix: fasls are now once again directly executable (on platforms
supporting shebang lines, with a suitably-installed sbcl).
* bug fix: --help no longer runs (lp#937001)
changes in sbcl-1.1.2 relative to sbcl-1.1.1:
- * notice: System requirements for SBCL on Microsoft Windows: Windows NT 5.1
- or newer (Windows XP, Server 2003) is required. Support for Windows 2000
- (NT 5.0) is no longer being maintained.
* notice: Starting with this version, SBCL on Windows no longer supports
building with disabled thread support.
* enhancement: frlocks have been added to SB-CONCURRENCY contrib module.
@@ -360,17 +360,18 @@ evaluated as a PROGN."
;; var.
(multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil)
(let* ((n-list (gensym "N-LIST"))
- (start (gensym "START"))
- (tmp (gensym "TMP")))
+ (start (gensym "START")))
(multiple-value-bind (clist members clist-ok)
(cond ((sb!xc:constantp list env)
(let ((value (constant-form-value list env)))
- (multiple-value-bind (all dot) (list-members value)
- (when dot
+ (multiple-value-bind (all dot) (list-members value :max-length 20)
+ (when (eql dot t)
;; Full warning is too much: the user may terminate the loop
;; early enough. Contents are still right, though.
(style-warn "Dotted list ~S in DOLIST." value))
- (values value all t))))
+ (if (eql dot :maybe)
+ (values value nil nil)
+ (values value all t)))))
((and (consp list) (eq 'list (car list))
(every (lambda (arg) (sb!xc:constantp arg env)) (cdr list)))
(let ((values (mapcar (lambda (arg) (constant-form-value arg env)) (cdr list))))
@@ -382,10 +383,9 @@ evaluated as a PROGN."
(unless (endp ,n-list)
- (let* (,@(if clist-ok
- `((,tmp (truly-the (member ,@members) (car ,n-list)))
- (,var ,tmp))
- `((,var (car ,n-list)))))
+ (let ((,var ,(if clist-ok
+ `(truly-the (member ,@members) (car ,n-list))
+ `(car ,n-list))))
(setq ,n-list (cdr ,n-list))
(tagbody ,@forms))
@@ -1300,12 +1300,16 @@
;;; Returns a list of members of LIST. Useful for dealing with circular lists.
;;; For a dotted list returns a secondary value of T -- in which case the
;;; primary return value does not include the dotted tail.
-(defun list-members (list)
+;;; If the maximum length is reached, return a secondary value of :MAYBE.
+(defun list-members (list &key max-length)
(when list
(do ((tail (cdr list) (cdr tail))
- (members (list (car list)) (cons (car tail) members)))
- ((or (not (consp tail)) (eq tail list))
- (values members (not (listp tail)))))))
+ (members (list (car list)) (cons (car tail) members))
+ (count 0 (1+ count)))
+ ((or (not (consp tail)) (eq tail list)
+ (and max-length (>= count max-length)))
+ (values members (or (not (listp tail))
+ (and (>= count max-length) :maybe)))))))
;;; Default evaluator mode (interpeter / compiler)

0 comments on commit beed089

Please sign in to comment.