From 504959cef381a69a727263ba2a70108f133f8900 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Fri, 19 Sep 2003 12:57:38 +0000 Subject: [PATCH] 0.8.3.81: * DOLIST: take CDR before execution of the body as suggested by Paul F. Dietz; * DELETE-COMPONENT: do not try to delete deleted lambda (bug reported by Paul Dietz); * fix building with #+HIGH-SECURITY: ... {IN,OUT}-SYNONYM-OF: fix comma placing; ... src/pcl/gray-streams.lisp: make redefinition of {INPUT,OUTPUT}-STREAM-P be atomic. --- NEWS | 3 +++ src/code/defboot.lisp | 29 +++++++++++++++++------------ src/code/sysmacs.lisp | 4 ++-- src/compiler/ir1util.lisp | 11 ++++++----- src/compiler/srctran.lisp | 3 +-- src/pcl/gray-streams.lisp | 34 ++++++++++++++++++---------------- tests/compiler.pure-cload.lisp | 5 +++++ version.lisp-expr | 2 +- 8 files changed, 53 insertions(+), 38 deletions(-) diff --git a/NEWS b/NEWS index c7c736c..30e4b50 100644 --- a/NEWS +++ b/NEWS @@ -2062,6 +2062,9 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3: streams. (thanks to Nikodemus Siivola) * bug fix: result form in DO is not contained in the implicit TAGBODY. + * incompatible change: ICR structure is changed; the value part of + CONTINUATION is now called LVAR; corresponding functions are + renamed (e.g. SB-C::CONTINUATION-TYPE has become SB-C::LVAR-TYPE). * fixed some bugs revealed by Paul Dietz' test suite: ** the RETURN clause in LOOP is now equivalent to DO (RETURN ...). ** ROUND and FROUND now give the right answer when given very diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 2cd77e9..f05fb0a 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -304,18 +304,23 @@ ;; since we don't want to use IGNORABLE on what might be a special ;; var. (multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil) - (let ((n-list (gensym))) - `(do* ((,n-list ,list (cdr ,n-list))) - ((endp ,n-list) - ,@(if result - `((let ((,var nil)) - ,var - ,result)) - '(nil))) - (let ((,var (car ,n-list))) - ,@decls - (tagbody - ,@forms)))))) + (let ((n-list (gensym "N-LIST")) + (start (gensym "START"))) + `(block nil + (let ((,n-list ,list)) + (tagbody + ,start + (unless (endp ,n-list) + (let ((,var (car ,n-list))) + ,@decls + (setq ,n-list (cdr ,n-list)) + (tagbody ,@forms)) + (go ,start)))) + ,(if result + `(let ((,var nil)) + ,var + ,result) + nil))))) ;;;; conditions, handlers, restarts diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp index dc1358e..6a7100f 100644 --- a/src/code/sysmacs.lisp +++ b/src/code/sysmacs.lisp @@ -59,7 +59,7 @@ :datum ,svar :expected-type '(satisfies input-stream-p) :format-control "~S isn't an input stream" - :format-arguments ,(list svar))) + :format-arguments (list ,svar))) ,svar))))) (defmacro out-synonym-of (stream &optional check-type) (let ((svar (gensym))) @@ -73,7 +73,7 @@ :datum ,svar :expected-type '(satisfies output-stream-p) :format-control "~S isn't an output stream." - :format-arguments ,(list svar))) + :format-arguments (list ,svar))) ,svar))))) ;;; WITH-mumble-STREAM calls the function in the given SLOT of the diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index d909bf1..5ac3a6a 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -838,7 +838,7 @@ (delete clambda (tail-set-funs tails))) (setf (lambda-tail-set clambda) nil)) (setf (component-lambdas component) - (delete clambda (component-lambdas component))))) + (delq clambda (component-lambdas component))))) ;; If the lambda is an XEP, then we null out the ENTRY-FUN in its ;; ENTRY-FUN so that people will know that it is not an entry @@ -1236,10 +1236,11 @@ (do-blocks (block component) (setf (block-delete-p block) t)) (dolist (fun (component-lambdas component)) - (setf (functional-kind fun) nil) - (setf (functional-entry-fun fun) nil) - (setf (leaf-refs fun) nil) - (delete-functional fun)) + (unless (eq (functional-kind fun) :deleted) + (setf (functional-kind fun) nil) + (setf (functional-entry-fun fun) nil) + (setf (leaf-refs fun) nil) + (delete-functional fun))) (do-blocks (block component) (delete-block block)) (values)) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index cd22846..a403e28 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -2268,8 +2268,7 @@ (defoptimizer (integer-length derive-type) ((x)) (let ((x-type (lvar-type x))) - (when (and (numeric-type-p x-type) - (csubtypep x-type (specifier-type 'integer))) + (when (numeric-type-p x-type) ;; If the X is of type (INTEGER LO HI), then the INTEGER-LENGTH ;; of X is (INTEGER (MIN lo hi) (MAX lo hi), basically. Be ;; careful about LO or HI being NIL, though. Also, if 0 is diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp index b273412..554c904 100644 --- a/src/pcl/gray-streams.lisp +++ b/src/pcl/gray-streams.lisp @@ -60,29 +60,31 @@ (setf (fdefinition 'close) #'pcl-close) -(fmakunbound 'input-stream-p) +(let () + (fmakunbound 'input-stream-p) -(defgeneric input-stream-p (stream) - #+sb-doc - (:documentation "Can STREAM perform input operations?")) + (defgeneric input-stream-p (stream) + #+sb-doc + (:documentation "Can STREAM perform input operations?")) -(defmethod input-stream-p ((stream ansi-stream)) - (ansi-stream-input-stream-p stream)) + (defmethod input-stream-p ((stream ansi-stream)) + (ansi-stream-input-stream-p stream)) -(defmethod input-stream-p ((stream fundamental-input-stream)) - t) + (defmethod input-stream-p ((stream fundamental-input-stream)) + t)) -(fmakunbound 'output-stream-p) +(let () + (fmakunbound 'output-stream-p) -(defgeneric output-stream-p (stream) - #+sb-doc - (:documentation "Can STREAM perform output operations?")) + (defgeneric output-stream-p (stream) + #+sb-doc + (:documentation "Can STREAM perform output operations?")) -(defmethod output-stream-p ((stream ansi-stream)) - (ansi-stream-output-stream-p stream)) + (defmethod output-stream-p ((stream ansi-stream)) + (ansi-stream-output-stream-p stream)) -(defmethod output-stream-p ((stream fundamental-output-stream)) - t) + (defmethod output-stream-p ((stream fundamental-output-stream)) + t)) ;;; character input streams ;;; diff --git a/tests/compiler.pure-cload.lisp b/tests/compiler.pure-cload.lisp index c21dad7..854c1a5 100644 --- a/tests/compiler.pure-cload.lisp +++ b/tests/compiler.pure-cload.lisp @@ -101,6 +101,11 @@ (optimize (speed 3) (safety 1) (debug 1))) (let ((v3 (min -1720 b))) (max v3 (logcount (if (= v3 b) b b))))) +(defun #:foo (d) + (let ((v7 (flet ((%f16 () (labels ((%f3 () -8)) (%f3)))) + (labels ((%f7 () (%f16))) d)))) + 132887443)) + ;;; RESULT-FORM in DO is not contained in the implicit TAGBODY (assert (eq (handler-case (eval `(do ((x '(1 2 3) (cdr x))) ((endp x) (go :loop)) diff --git a/version.lisp-expr b/version.lisp-expr index 6354209..c75f4ad 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,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".) -"0.8.3.80" +"0.8.3.81" -- 1.7.10.4