Browse files

fix structure stack allocation for high-debug code

  * Allow values to flow through casts in good-for-dx analysis.

  * Let-convert main-entry points for already inlined optional
    dispatches.

  * Don't preserve single-use debug vars in system-lambdas, no
    matter what the policy says.

  * Don't add INDEFINITE-EXTENT declarations to hairy entries without
    &REST arguments.

  * SB-C::REST-CONVERSION optimization declaration was pretty
    pointless, take it out.

  * Test our DX stuff in high-debug code as well.
  • Loading branch information...
1 parent 396a1cc commit d90c8a75da90925a51a587f7bd4d9c494256f68a @nikodemus nikodemus committed Sep 27, 2012
View
2 NEWS
@@ -4,6 +4,8 @@ changes relative to sbcl-1.1.0:
COMPILE-FILE still do.)
* bug fix: SB-CLTL2:MACROEXPAND-ALL correctly handles shadowing of symbol-macros
by lexical bindings.
+ * bug fix: stack allocation was prevented by high DEBUG declaration in several
+ cases.
changes in sbcl-1.1.0 relative to sbcl-1.0.58:
* enhancement: New variable, sb-ext:*disassemble-annotate* for controlling
View
1 src/code/cold-error.lisp
@@ -145,7 +145,6 @@
#!+sb-doc
"Print a message and invoke the debugger without allowing any possibility
of condition handling occurring."
- (declare (optimize (sb!c::rest-conversion 0)))
(let ((*debugger-hook* nil) ; as specifically required by ANSI
(sb!debug:*stack-top-hint* (or sb!debug:*stack-top-hint* 'break)))
(apply #'%break 'break datum arguments)))
View
6 src/compiler/ir1opt.lisp
@@ -1304,7 +1304,7 @@
'(optimize
(preserve-single-use-debug-variables 0))
(lexenv-policy
- (combination-lexenv call)))))
+ (combination-lexenv call)))))
(with-ir1-environment-from-node call
(with-component-last-block (*current-component*
(block-next (node-block call)))
@@ -1715,9 +1715,7 @@
leaf var)))
t)))))
((and (null (rest (leaf-refs var)))
- ;; Don't substitute single-ref variables on high-debug /
- ;; low speed, to improve the debugging experience.
- (policy call (< preserve-single-use-debug-variables 3))
+ (not (preserve-single-use-debug-var-p call var))
(substitute-single-use-lvar arg var)))
(t
(propagate-to-refs var (lvar-type arg))))))
View
29 src/compiler/ir1util.lisp
@@ -80,6 +80,15 @@
use))))
(plu lvar)))
+(defun principal-lvar-dest (lvar)
+ (labels ((pld (lvar)
+ (declare (type lvar lvar))
+ (let ((dest (lvar-dest lvar)))
+ (if (cast-p dest)
+ (pld (cast-lvar dest))
+ dest))))
+ (pld lvar)))
+
;;; Update lvar use information so that NODE is no longer a use of its
;;; LVAR.
;;;
@@ -560,7 +569,7 @@
(when (lambda-p clambda1)
(dolist (var (lambda-vars clambda1) t)
(dolist (var-ref (lambda-var-refs var))
- (let ((dest (lvar-dest (ref-lvar var-ref))))
+ (let ((dest (principal-lvar-dest (ref-lvar var-ref))))
(unless (and (combination-p dest) (recurse dest))
(return-from combination-args-flow-cleanly-p nil)))))))))))
(recurse combination1)))
@@ -2296,3 +2305,21 @@ is :ANY, the function name is not checked."
(and ok (member name fun-names :test #'eq))))
(or (not arg-count)
(= arg-count (length (combination-args use)))))))
+
+;;; True if the optional has a rest-argument.
+(defun optional-rest-p (opt)
+ (dolist (var (optional-dispatch-arglist opt) nil)
+ (let* ((info (when (lambda-var-p var)
+ (lambda-var-arg-info var)))
+ (kind (when info
+ (arg-info-kind info))))
+ (when (eq :rest kind)
+ (return t)))))
+
+;;; Don't substitute single-ref variables on high-debug / low speed, to
+;;; improve the debugging experience. ...but don't bother keeping those
+;;; from system lambdas.
+(defun preserve-single-use-debug-var-p (call var)
+ (and (policy call (eql preserve-single-use-debug-variables 3))
+ (or (not (lambda-var-p var))
+ (not (lambda-system-lambda-p (lambda-var-home var))))))
View
11 src/compiler/locall.lisp
@@ -712,7 +712,8 @@
(convert-hairy-fun-entry ref call (optional-dispatch-main-entry fun)
(append temps more-temps)
(ignores) (call-args)
- more-temps))))
+ (when (optional-rest-p fun)
+ more-temps)))))
(values))
@@ -1028,7 +1029,13 @@
;; with anonymous things, and suppressing inlining
;; for such things can easily give Python acute indigestion, so
;; we don't.)
- (when (leaf-has-source-name-p clambda)
+ ;;
+ ;; A functional that is already inline-expanded in this componsne definitely
+ ;; deserves let-conversion -- and in case of main entry points for inline
+ ;; expanded optional dispatch, the main-etry isn't explicitly marked :INLINE
+ ;; even if the function really is.
+ (when (and (leaf-has-source-name-p clambda)
+ (not (functional-inline-expanded clambda)))
;; ANSI requires that explicit NOTINLINE be respected.
(or (eq (lambda-inlinep clambda) :notinline)
;; If (= LET-CONVERSION 0) we can guess that inlining
View
6 src/compiler/policies.lisp
@@ -45,12 +45,6 @@ Enabling this option can increase heap consing of closures.")
("off" "maybe" "on" "on")
"Control inline-substitution of used-once local functions.")
-(define-optimization-quality rest-conversion
- (if (= debug 3) 0 3)
- ("off" "maybe" "on" "on")
- "Control conversion of &REST argments to &MORE arguments when
-only used as the final argument to APPLY.")
-
(define-optimization-quality alien-funcall-saves-fp-and-pc
(if (<= speed debug) 3 0)
("no" "maybe" "yes" "yes")
View
15 tests/dynamic-extent.impure.lisp
@@ -21,8 +21,17 @@
sb-ext:*stack-allocate-dynamic-extent* t)
(defmacro defun-with-dx (name arglist &body body)
- `(defun ,name ,arglist
- ,@body))
+ (let ((debug-name (sb-int:symbolicate name "-HIGH-DEBUG"))
+ (default-name (sb-int:symbolicate name "-DEFAULT")))
+ `(progn
+ (defun ,debug-name ,arglist
+ (declare (optimize debug))
+ ,@body)
+ (defun ,default-name ,arglist
+ ,@body)
+ (defun ,name (&rest args)
+ (apply #',debug-name args)
+ (apply #',default-name args)))))
(declaim (notinline opaque-identity))
(defun opaque-identity (x)
@@ -682,7 +691,7 @@
(bdowning-2005-iv-16))
(declaim (inline my-nconc))
-(defun-with-dx my-nconc (&rest lists)
+(defun my-nconc (&rest lists)
(declare (dynamic-extent lists))
(apply #'nconc lists))
(defun-with-dx my-nconc-caller (a b c)

0 comments on commit d90c8a7

Please sign in to comment.