From ae1efb49d01b7f887b4e6bed741a01a28124c643 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Wed, 25 Jun 2003 04:43:51 +0000 Subject: [PATCH] 0.8.1.3: > 13:17:03 dan`b how does sbcl compile closures? Usually good enough :-( * Fixed bugcase 258: deny inline-expanding when expansion references a deleted or let-converted function. --- BUGS | 14 +------------- src/compiler/ir1tran.lisp | 27 +++------------------------ src/compiler/ir1util.lisp | 14 ++++++++++++++ tests/compiler.impure-cload.lisp | 22 ++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 41 insertions(+), 38 deletions(-) diff --git a/BUGS b/BUGS index 97a6721..a4ed57f 100644 --- a/BUGS +++ b/BUGS @@ -1039,19 +1039,7 @@ WORKAROUND: callees.) 258: - Compiler fails on - - (defun u-b-sra (ad0) - (declare (special *foo* *bar*)) - (declare (optimize (safety 3) (speed 2) (space 1) (debug 1))) - (labels ((c.frob (x) - (random x)) - (ad.frob (ad) - (mapcar #'c.frob ad))) - (declare (inline c.frob ad.frob)) - (list (the list ad0) - (funcall (if (listp ad0) #'ad.frob #'print) ad0) - (funcall (if (listp ad0) #'ad.frob #'print) (reverse ad0))))) + (fixed in 0.8.1.3) DEFUNCT CATEGORIES OF BUGS IR1-#: diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 3242c40..71ec219 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -557,6 +557,8 @@ ;;; functional instead. (defun reference-leaf (start cont leaf) (declare (type continuation start cont) (type leaf leaf)) + (when (functional-p leaf) + (assure-functional-live-p leaf)) (let* ((type (lexenv-find leaf type-restrictions)) (leaf (or (and (defined-fun-p leaf) (not (eq (defined-fun-inlinep leaf) @@ -848,30 +850,7 @@ ;;; are converting inline expansions for local functions during ;;; optimization. (defun ir1-convert-local-combination (start cont form functional) - - ;; The test here is for "when LET converted", as a translation of - ;; the old CMU CL comments into code. Unfortunately, the old CMU CL - ;; comments aren't specific enough to tell whether the correct - ;; translation is FUNCTIONAL-SOMEWHAT-LETLIKE-P or - ;; FUNCTIONAL-LETLIKE-P or what. The old CMU CL code assumed that - ;; any non-null FUNCTIONAL-KIND meant that the function "had been - ;; LET converted", which might even be right, but seems fragile, so - ;; we try to be pickier. - (when (or - ;; looks LET-converted - (functional-somewhat-letlike-p functional) - ;; It's possible for a LET-converted function to end up - ;; deleted later. In that case, for the purposes of this - ;; analysis, it is LET-converted: LET-converted functionals - ;; are too badly trashed to expand them inline, and deleted - ;; LET-converted functionals are even worse. - (eql (functional-kind functional) :deleted)) - (throw 'locall-already-let-converted functional)) - ;; Any other non-NIL KIND value is a case we haven't found a - ;; justification for, and at least some such values (e.g. :EXTERNAL - ;; and :TOPLEVEL) seem obviously wrong. - (aver (null (functional-kind functional))) - + (assure-functional-live-p functional) (ir1-convert-combination start cont form diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 74f5a20..90de784 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -1602,6 +1602,20 @@ *inline-expansion-limit*)) nil) (t t)))) + +;;; Make sure that FUNCTIONAL is not let-converted or deleted. +(defun assure-functional-live-p (functional) + (declare (type functional functional)) + (when (and (or + ;; looks LET-converted + (functional-somewhat-letlike-p functional) + ;; It's possible for a LET-converted function to end up + ;; deleted later. In that case, for the purposes of this + ;; analysis, it is LET-converted: LET-converted functionals + ;; are too badly trashed to expand them inline, and deleted + ;; LET-converted functionals are even worse. + (eql (functional-kind functional) :deleted))) + (throw 'locall-already-let-converted functional))) ;;;; careful call diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp index d9905d0..d5e660e 100644 --- a/tests/compiler.impure-cload.lisp +++ b/tests/compiler.impure-cload.lisp @@ -117,5 +117,27 @@ '((1 2 3) (7 14 21) (21 14 7)))) (delete-package :bug148) + +;;; bug 258 +(defpackage :bug258 (:use :cl)) +(in-package :bug258) + +(defun u-b-sra (ad0) + (declare (special *foo* *bar*)) + (declare (optimize (safety 3) (speed 2) (space 1) (debug 1))) + (labels ((c.frob (x) + (1- x)) + (ad.frob (ad) + (mapcar #'c.frob ad))) + (declare (inline c.frob ad.frob)) + (list (the list ad0) + (funcall (if (listp ad0) #'ad.frob #'print) ad0) + (funcall (if (listp ad0) #'ad.frob #'print) (reverse ad0))))) + +(assert (equal (u-b-sra '(4 9 7)) + '((4 9 7) (3 8 6) (6 8 3)))) + +(delete-package :bug258) + (sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index a4b2a36..3f70143 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.1.2" +"0.8.1.3" -- 1.7.10.4