directories works correctly. (thanks to Artem V. Andreev)
* fixed bug 125: compiler preserves identity of closures. (reported
by Gabe Garza)
+ * bug fixed: functions with &REST arguments sometimes failed with
+ "Undefined function" when compiled with (DEBUG 3). (reported by
+ Robert J. Macomber)
* build fix: fixed the dependence on *LOAD-PATHNAME* and
*COMPILE-FILE-PATHNAME* being absolute pathnames.
* on x86 compiler partially supports stack allocation of dynamic-extent
closures.
+ * GO and RETURN-FROM do not check the extent of their exit points
+ when compiled with SAFETY 0.
* fixed some bugs related to Unicode integration:
** encoding and decoding errors are now much more robustly
handled; it should now be possible to recover even from invalid
@c _ In addition to suppressing type checks, \code{0} also suppresses
@c _ argument count checking, unbound-symbol checking and array bounds
@c _ checks.
+@c _ ... and checking of tag existence in RETURN-FROM and GO.
@c _
@c _\item[\code{extensions:inhibit-warnings}] \cindex{inhibit-warnings
@c _ optimization quality}This is a CMU extension that determines how
Stack allocation of closures, defined with @code{flet} or
@code{labels} with a bound declaration @code{dynamic-extent}.
Closed-over variables, which are assigned (either inside or outside
-the closure), tags and blocks are still allocated on the heap.
+the closure) are still allocated on the heap. Blocks and tags are also
+allocated on the heap, unless all non-local control transfers to them
+are compiled with zero @code{safety}.
@end itemize
(make-ir2-nlx-info
:home (when (member (cleanup-kind (nlx-info-cleanup nlx))
'(:block :tagbody))
- (make-normal-tn *backend-t-primitive-type*))
+ (if (nlx-info-safe-p nlx)
+ (make-normal-tn *backend-t-primitive-type*)
+ (make-stack-pointer-tn)))
:save-sp (make-nlx-sp-tn physenv)))))
(values))
:type (leaf-type var)
:where-from (leaf-where-from var))))
- (let* ((n-context (gensym "N-CONTEXT-"))
+ (let* ((*allow-instrumenting* nil)
+ (n-context (gensym "N-CONTEXT-"))
(context-temp (make-lambda-var :%source-name n-context))
(n-count (gensym "N-COUNT-"))
(count-temp (make-lambda-var :%source-name n-count
;;; IR2 converted.
(defun ir2-convert-exit (node block)
(declare (type exit node) (type ir2-block block))
- (let ((loc (find-in-physenv (exit-nlx-info node)
- (node-physenv node)))
- (temp (make-stack-pointer-tn))
- (value (exit-value node)))
- (vop value-cell-ref node block loc temp)
+ (let* ((nlx (exit-nlx-info node))
+ (loc (find-in-physenv nlx (node-physenv node)))
+ (temp (make-stack-pointer-tn))
+ (value (exit-value node)))
+ (if (nlx-info-safe-p nlx)
+ (vop value-cell-ref node block loc temp)
+ (emit-move node block loc temp))
(if value
(let ((locs (ir2-lvar-locs (lvar-info value))))
(vop unwind node block temp (first locs) (second locs)))
;;; dynamic extent. This is done by storing 0 into the indirect value
;;; cell that holds the closed unwind block.
(defoptimizer (%lexical-exit-breakup ir2-convert) ((info) node block)
- (vop value-cell-set node block
- (find-in-physenv (lvar-value info) (node-physenv node))
- (emit-constant 0)))
+ (let ((nlx (lvar-value info)))
+ (when (nlx-info-safe-p nlx)
+ (vop value-cell-set node block
+ (find-in-physenv nlx (node-physenv node))
+ (emit-constant 0)))))
;;; We have to do a spurious move of no values to the result lvar so
;;; that lifetime analysis won't get confused.
(ecase kind
((:block :tagbody)
- (do-make-value-cell node block res (ir2-nlx-info-home 2info)))
+ (if (nlx-info-safe-p info)
+ (do-make-value-cell node block res (ir2-nlx-info-home 2info))
+ (emit-move node block res (ir2-nlx-info-home 2info))))
(:unwind-protect
(vop set-unwind-protect node block block-tn))
(:catch)))
;; has the original exit destination as its successor. Null only
;; temporarily.
(target nil :type (or cblock null))
+ ;; for a lexical exit it determines whether tag existence check is
+ ;; needed
+ (safe-p nil :type boolean)
;; some kind of info used by the back end
info)
(defprinter (nlx-info :identity t)
(setq found-it t)))
found-it))
-;;; This is like old CMU CL PRE-ENVIRONMENT-ANALYZE-TOPLEVEL, except
-;;; (1) It's been brought into the post-0.7.0 world where the property
-;;; HAS-EXTERNAL-REFERENCES-P is orthogonal to the property of
-;;; being specialized/optimized for locall at top level.
-;;; (2) There's no return value, since we don't care whether we
-;;; find any possible closure variables.
-;;;
-;;; I wish I could find an explanation of why
-;;; PRE-ENVIRONMENT-ANALYZE-TOPLEVEL is important. The old CMU CL
-;;; comments said
-;;; Called on component with top level lambdas before the
-;;; compilation of the associated non-top-level code to detect
-;;; closed over top level variables. We just do COMPUTE-CLOSURE on
-;;; all the lambdas. This will pre-allocate environments for all
-;;; the functions with closed-over top level variables. The
-;;; post-pass will use the existing structure, rather than
-;;; allocating a new one. We return true if we discover any
-;;; possible closure vars.
-;;; But that doesn't seem to explain either why it's important to do
-;;; this for top level lambdas, or why it's important to do it only
-;;; for top level lambdas instead of just doing it indiscriminately
-;;; for all lambdas. I do observe that when it's not done, compiler
-;;; assertions occasionally fail. My tentative hypothesis for why it's
-;;; important to do it is that other environment analysis expects to
-;;; bottom out on the outermost enclosing thing, and (insert
-;;; mysterious reason here) it's important to set up bottomed-out-here
-;;; environments before anything else. I haven't been able to guess
-;;; why it's important to do it selectively instead of
-;;; indiscriminately. -- WHN 2001-11-10
-(defun preallocate-physenvs-for-toplevelish-lambdas (component)
- (dolist (clambda (component-lambdas component))
- (when (lambda-toplevelish-p clambda)
- (add-lambda-vars-and-let-vars-to-closures clambda)))
- (values))
-
;;; If CLAMBDA has a PHYSENV, return it, otherwise assign an empty one
;;; and return that.
(defun get-lambda-physenv (clambda)
\f
;;;; non-local exit
+#!-sb-fluid (declaim (inline should-exit-check-tag-p))
+(defun exit-should-check-tag-p (exit)
+ (declare (type exit exit))
+ (not (zerop (policy exit check-tag-existence))))
+
;;; Insert the entry stub before the original exit target, and add a
;;; new entry to the PHYSENV-NLX-INFO. The %NLX-ENTRY call in the
;;; stub is passed the NLX-INFO as an argument so that the back end
(setf (exit-nlx-info exit) info)
(setf (nlx-info-target info) new-block)
+ (setf (nlx-info-safe-p info) (exit-should-check-tag-p exit))
(push info (physenv-nlx-info env))
(push info (cleanup-nlx-info cleanup))
(when (member (cleanup-kind cleanup) '(:catch :unwind-protect))
(aver (= (length (block-succ block)) 1))
(unlink-blocks block (first (block-succ block)))
(link-blocks block (component-tail (block-component block)))
- (setf (exit-nlx-info exit) info)))
+ (setf (exit-nlx-info exit) info)
+ (unless (nlx-info-safe-p info)
+ (setf (nlx-info-safe-p info)
+ (exit-should-check-tag-p exit)))))
(t
(insert-nlx-entry-stub exit env)
(setq info (exit-nlx-info exit))
(t 2))
("no" "maybe" "fast" "full"))
+(define-optimization-quality check-tag-existence
+ (cond ((= safety 0) 0)
+ (t 3))
+ ("no" "maybe" "yes" "yes"))
+
(define-optimization-quality let-convertion
(if (<= debug speed) 3 0)
("off" "maybe" "on" "on"))
(type (simple-array (unsigned-byte 32) (*)) v))
(setf (aref v 0) (* (* x #.(floor (ash 1 32) (* 11 80))) y))
nil)))
+
+;;; Bug reported by Robert J. Macomber: instrumenting of more-entry
+;;; prevented open coding of %LISTIFY-REST-ARGS.
+(let ((f (compile nil '(lambda ()
+ (declare (optimize (debug 3)))
+ (with-simple-restart (blah "blah") (error "blah"))))))
+ (handler-bind ((error (lambda (c) (invoke-restart 'blah))))
+ (assert (equal (multiple-value-list (funcall f)) '(nil t)))))
;;; 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.18.32"
+"0.8.18.33"
projects / sbcl.git / commitdiff