From: Alexey Dejneka Date: Tue, 16 Nov 2004 18:47:46 +0000 (+0000) Subject: 0.8.16.41: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b3e7d6608689a639cb774e2ce15bb5bacaed5179;p=sbcl.git 0.8.16.41: * Partial workaround for the bug 262: inline expansion of a local function is canceled by conversion of RETURN-FROM, referring a deleted CTRAN. (Fixes bug reported by Peter Denno on sbcl-devel.) --- diff --git a/BUGS b/BUGS index 2ee474b..b9e6f93 100644 --- a/BUGS +++ b/BUGS @@ -861,26 +861,12 @@ WORKAROUND: b. The same for CSUBTYPEP. 262: "yet another bug in inline expansion of local functions" - Compiler fails on - - (defun foo (x y) - (declare (integer x y)) - (+ (block nil - (flet ((xyz (u) - (declare (integer u)) - (if (> (1+ (the unsigned-byte u)) 0) - (+ 1 u) - (return (+ 38 (cos (/ u 78))))))) - (declare (inline xyz)) - (return-from foo - (* (funcall (eval #'xyz) x) - (if (> x 30) - (funcall (if (> x 5) #'xyz #'identity) - (+ x 13)) - 38))))) - (sin (* x y)))) - - Urgh... It's time to write IR1-copier. + During inline expansion of a local function Python can try to + reference optimized away objects (functions, variables, CTRANs from + tags and blocks), which later may lead to problems. Some of the + cases are worked around by forbidding expansion in such cases, but + the better way would be to reimplement inline expansion by copying + IR1 structures. 266: David Lichteblau provided (sbcl-devel 2003-06-01) a patch to fix diff --git a/NEWS b/NEWS index 86daf61..45c3c84 100644 --- a/NEWS +++ b/NEWS @@ -48,6 +48,10 @@ changes in sbcl-0.8.17 relative to sbcl-0.8.16: specialized array element types. * FORMAT compile-time argument count checking has been enhanced. (report from Bruno Haible for CMUCL) + * a partial workaround for the bug 262: the compiler does not try to + inline-expand a local function doing RETURN-FROM from a deleted + BLOCK. (thanks to Peter Denno for the bug report and to David + Wragg for the simple test case) * fixed some bugs revealed by Paul Dietz' test suite: ** RENAME-PACKAGE allows all package designators as new package names. diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 6fdb4ac..594999d 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -109,11 +109,14 @@ (ctran-starts-block next) (let* ((found (or (lexenv-find name blocks) (compiler-error "return for unknown block: ~S" name))) + (exit-ctran (second found)) (value-ctran (make-ctran)) (value-lvar (make-lvar)) (entry (first found)) (exit (make-exit :entry entry :value value-lvar))) + (when (ctran-deleted-p exit-ctran) + (throw 'locall-already-let-converted exit-ctran)) (push exit (entry-exits entry)) (setf (lvar-dest value-lvar) exit) (ir1-convert start value-ctran value-lvar value) @@ -121,7 +124,7 @@ (let ((home-lambda (ctran-home-lambda-or-null start))) (when home-lambda (push entry (lambda-calls-or-closes home-lambda)))) - (use-continuation exit (second found) (third found)))) + (use-continuation exit exit-ctran (third found)))) ;;; Return a list of the segments of a TAGBODY. Each segment looks ;;; like (
* (go )). That is, we break up the diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 5126c04..a5e8c16 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -1330,15 +1330,21 @@ (setf (node-prev node) nil) t))))))) +;;; Return true if CTRAN has been deleted, false if it is still a valid +;;; part of IR1. +(defun ctran-deleted-p (ctran) + (declare (type ctran ctran)) + (let ((block (ctran-block ctran))) + (or (not (block-component block)) + (block-delete-p block)))) + ;;; Return true if NODE has been deleted, false if it is still a valid ;;; part of IR1. (defun node-deleted (node) (declare (type node node)) (let ((prev (node-prev node))) - (not (and prev - (let ((block (ctran-block prev))) - (and (block-component block) - (not (block-delete-p block)))))))) + (or (not prev) + (ctran-deleted-p prev)))) ;;; Delete all the blocks and functions in COMPONENT. We scan first ;;; marking the blocks as DELETE-P to prevent weird stuff from being diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index f1c7feb..18d051b 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -378,7 +378,7 @@ (inline-expansion-ok call)) (let* ((end (component-last-block (node-component call))) (pred (block-prev end))) - (multiple-value-bind (losing-local-functional converted-lambda) + (multiple-value-bind (losing-local-object converted-lambda) (catch 'locall-already-let-converted (with-ir1-environment-from-node call (let ((*lexenv* (functional-lexenv original-functional))) @@ -389,12 +389,18 @@ "local inline " (leaf-debug-name original-functional))))))) - (cond (losing-local-functional - (let ((*compiler-error-context* call)) - (compiler-notify "couldn't inline expand because expansion ~ - calls this LET-converted local function:~ - ~% ~S" - (leaf-debug-name losing-local-functional))) + (cond (losing-local-object + (if (functional-p losing-local-object) + (let ((*compiler-error-context* call)) + (compiler-notify "couldn't inline expand because expansion ~ + calls this LET-converted local function:~ + ~% ~S" + (leaf-debug-name losing-local-object))) + (let ((*compiler-error-context* call)) + (compiler-notify "implementation limitation: couldn't inline ~ + expand because expansion refers to ~ + the optimized away object ~S." + losing-local-object))) (loop for block = (block-next pred) then (block-next block) until (eq block end) do (setf (block-delete-p block) t)) diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp index bdd3550..9a2d2f6 100644 --- a/tests/compiler.impure-cload.lisp +++ b/tests/compiler.impure-cload.lisp @@ -382,5 +382,14 @@ (defvar caar)) (defun srctran-lisp1-2 (caar) (funcall (sb-ext:truly-the function caar) 1)) (assert (eql (funcall (eval #'srctran-lisp1-2) #'identity) 1)) + +;;; partial bug 262: reference of deleted CTRAN (in RETURN-FROM) +;;; during inline expansion. Bug report by Peter Denno, simplified +;;; test case by David Wragg. +(defun bug262-return-from (x &aux (y nil)) + (labels ((foo-a (z) (return-from bug262-return-from z)) + (foo-b (z) (foo-a z))) + (declare (inline foo-a)) + (foo-a x))) (sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index dd72d77..e78f60f 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.16.40" +"0.8.16.41"