Skip to content
This repository
Browse code

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...
commit d90c8a75da90925a51a587f7bd4d9c494256f68a 1 parent 396a1cc
Nikodemus Siivola nikodemus authored
2  NEWS
@@ -4,6 +4,8 @@ changes relative to sbcl-1.1.0:
4 4 COMPILE-FILE still do.)
5 5 * bug fix: SB-CLTL2:MACROEXPAND-ALL correctly handles shadowing of symbol-macros
6 6 by lexical bindings.
  7 + * bug fix: stack allocation was prevented by high DEBUG declaration in several
  8 + cases.
7 9
8 10 changes in sbcl-1.1.0 relative to sbcl-1.0.58:
9 11 * enhancement: New variable, sb-ext:*disassemble-annotate* for controlling
1  src/code/cold-error.lisp
@@ -145,7 +145,6 @@
145 145 #!+sb-doc
146 146 "Print a message and invoke the debugger without allowing any possibility
147 147 of condition handling occurring."
148   - (declare (optimize (sb!c::rest-conversion 0)))
149 148 (let ((*debugger-hook* nil) ; as specifically required by ANSI
150 149 (sb!debug:*stack-top-hint* (or sb!debug:*stack-top-hint* 'break)))
151 150 (apply #'%break 'break datum arguments)))
6 src/compiler/ir1opt.lisp
@@ -1304,7 +1304,7 @@
1304 1304 '(optimize
1305 1305 (preserve-single-use-debug-variables 0))
1306 1306 (lexenv-policy
1307   - (combination-lexenv call)))))
  1307 + (combination-lexenv call)))))
1308 1308 (with-ir1-environment-from-node call
1309 1309 (with-component-last-block (*current-component*
1310 1310 (block-next (node-block call)))
@@ -1715,9 +1715,7 @@
1715 1715 leaf var)))
1716 1716 t)))))
1717 1717 ((and (null (rest (leaf-refs var)))
1718   - ;; Don't substitute single-ref variables on high-debug /
1719   - ;; low speed, to improve the debugging experience.
1720   - (policy call (< preserve-single-use-debug-variables 3))
  1718 + (not (preserve-single-use-debug-var-p call var))
1721 1719 (substitute-single-use-lvar arg var)))
1722 1720 (t
1723 1721 (propagate-to-refs var (lvar-type arg))))))
29 src/compiler/ir1util.lisp
@@ -80,6 +80,15 @@
80 80 use))))
81 81 (plu lvar)))
82 82
  83 +(defun principal-lvar-dest (lvar)
  84 + (labels ((pld (lvar)
  85 + (declare (type lvar lvar))
  86 + (let ((dest (lvar-dest lvar)))
  87 + (if (cast-p dest)
  88 + (pld (cast-lvar dest))
  89 + dest))))
  90 + (pld lvar)))
  91 +
83 92 ;;; Update lvar use information so that NODE is no longer a use of its
84 93 ;;; LVAR.
85 94 ;;;
@@ -560,7 +569,7 @@
560 569 (when (lambda-p clambda1)
561 570 (dolist (var (lambda-vars clambda1) t)
562 571 (dolist (var-ref (lambda-var-refs var))
563   - (let ((dest (lvar-dest (ref-lvar var-ref))))
  572 + (let ((dest (principal-lvar-dest (ref-lvar var-ref))))
564 573 (unless (and (combination-p dest) (recurse dest))
565 574 (return-from combination-args-flow-cleanly-p nil)))))))))))
566 575 (recurse combination1)))
@@ -2296,3 +2305,21 @@ is :ANY, the function name is not checked."
2296 2305 (and ok (member name fun-names :test #'eq))))
2297 2306 (or (not arg-count)
2298 2307 (= arg-count (length (combination-args use)))))))
  2308 +
  2309 +;;; True if the optional has a rest-argument.
  2310 +(defun optional-rest-p (opt)
  2311 + (dolist (var (optional-dispatch-arglist opt) nil)
  2312 + (let* ((info (when (lambda-var-p var)
  2313 + (lambda-var-arg-info var)))
  2314 + (kind (when info
  2315 + (arg-info-kind info))))
  2316 + (when (eq :rest kind)
  2317 + (return t)))))
  2318 +
  2319 +;;; Don't substitute single-ref variables on high-debug / low speed, to
  2320 +;;; improve the debugging experience. ...but don't bother keeping those
  2321 +;;; from system lambdas.
  2322 +(defun preserve-single-use-debug-var-p (call var)
  2323 + (and (policy call (eql preserve-single-use-debug-variables 3))
  2324 + (or (not (lambda-var-p var))
  2325 + (not (lambda-system-lambda-p (lambda-var-home var))))))
11 src/compiler/locall.lisp
@@ -712,7 +712,8 @@
712 712 (convert-hairy-fun-entry ref call (optional-dispatch-main-entry fun)
713 713 (append temps more-temps)
714 714 (ignores) (call-args)
715   - more-temps))))
  715 + (when (optional-rest-p fun)
  716 + more-temps)))))
716 717
717 718 (values))
718 719
@@ -1028,7 +1029,13 @@
1028 1029 ;; with anonymous things, and suppressing inlining
1029 1030 ;; for such things can easily give Python acute indigestion, so
1030 1031 ;; we don't.)
1031   - (when (leaf-has-source-name-p clambda)
  1032 + ;;
  1033 + ;; A functional that is already inline-expanded in this componsne definitely
  1034 + ;; deserves let-conversion -- and in case of main entry points for inline
  1035 + ;; expanded optional dispatch, the main-etry isn't explicitly marked :INLINE
  1036 + ;; even if the function really is.
  1037 + (when (and (leaf-has-source-name-p clambda)
  1038 + (not (functional-inline-expanded clambda)))
1032 1039 ;; ANSI requires that explicit NOTINLINE be respected.
1033 1040 (or (eq (lambda-inlinep clambda) :notinline)
1034 1041 ;; If (= LET-CONVERSION 0) we can guess that inlining
6 src/compiler/policies.lisp
@@ -45,12 +45,6 @@ Enabling this option can increase heap consing of closures.")
45 45 ("off" "maybe" "on" "on")
46 46 "Control inline-substitution of used-once local functions.")
47 47
48   -(define-optimization-quality rest-conversion
49   - (if (= debug 3) 0 3)
50   - ("off" "maybe" "on" "on")
51   - "Control conversion of &REST argments to &MORE arguments when
52   -only used as the final argument to APPLY.")
53   -
54 48 (define-optimization-quality alien-funcall-saves-fp-and-pc
55 49 (if (<= speed debug) 3 0)
56 50 ("no" "maybe" "yes" "yes")
15 tests/dynamic-extent.impure.lisp
@@ -21,8 +21,17 @@
21 21 sb-ext:*stack-allocate-dynamic-extent* t)
22 22
23 23 (defmacro defun-with-dx (name arglist &body body)
24   - `(defun ,name ,arglist
25   - ,@body))
  24 + (let ((debug-name (sb-int:symbolicate name "-HIGH-DEBUG"))
  25 + (default-name (sb-int:symbolicate name "-DEFAULT")))
  26 + `(progn
  27 + (defun ,debug-name ,arglist
  28 + (declare (optimize debug))
  29 + ,@body)
  30 + (defun ,default-name ,arglist
  31 + ,@body)
  32 + (defun ,name (&rest args)
  33 + (apply #',debug-name args)
  34 + (apply #',default-name args)))))
26 35
27 36 (declaim (notinline opaque-identity))
28 37 (defun opaque-identity (x)
@@ -682,7 +691,7 @@
682 691 (bdowning-2005-iv-16))
683 692
684 693 (declaim (inline my-nconc))
685   -(defun-with-dx my-nconc (&rest lists)
  694 +(defun my-nconc (&rest lists)
686 695 (declare (dynamic-extent lists))
687 696 (apply #'nconc lists))
688 697 (defun-with-dx my-nconc-caller (a b c)

0 comments on commit d90c8a7

Please sign in to comment.
Something went wrong with that request. Please try again.