[Sbcl-devel] failed aver in convert-mv-call

[Larry D'A. <la...@el...>]

Form 1 below causes (aver (not (functional-entry-fun fun))) in convert-mv-call
to fail.  The problem seems to be that convert-mv-call has decided that the
m-v-c is eligible to be converted to a local call, but the #'k has caused an
external entry point to be made for k and convert-mv-call expects that to have
been deleted by the time it gets to the aver.  For form 2 the aver does not
fail, because in that case the entry-fun does get deleted before the aver is
called.  Form 3 is slightly less contrived and also causes the same aver to
fail.  At this point I haven't been able to figure out what exactly is
responsible for deleting the entry-fun and why it doesn't work on 1, but a hackey
workaround is to just get rid of the aver and have convert-mv-call pass when the
aver would have failed.  This prevents 1 from being optimized, but 1 is pretty
silly anyway.  It causes 3 to be compiled correctly, and it shouldn't change
sbcl's behavior on any inputs that don't cause failed avers now.  patch below.

1.
(flet ((k (&rest x) (declare (ignore x))))
   (multiple-value-call #'k #'k))

2.
(flet ((k (&optional (x) (y) &rest z))) 
  (multiple-value-call #'k #'k))

3.
(flet ((k (&rest x)))
  (multiple-value-call #'k
    (block b
      (catch 'tag
        (return-from b (thing)))
      (throw 'tag #'k))))

patch:

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 86bd481..c20425d 100644
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -489,13 +489,13 @@
   (declare (type ref ref) (type mv-combination call) (type functional fun))
   (when (and (looks-like-an-mv-bind fun)
              (singleton-p (leaf-refs fun))
-             (singleton-p (basic-combination-args call)))
+             (singleton-p (basic-combination-args call))
+             (not (functional-entry-fun fun)))
     (let* ((*current-component* (node-component ref))
            (ep (optional-dispatch-entry-point-fun
                 fun (optional-dispatch-max-args fun))))
       (when (null (leaf-refs ep))
         (aver (= (optional-dispatch-min-args fun) 0))
-        (aver (not (functional-entry-fun fun)))
         (setf (basic-combination-kind call) :local)
         (sset-adjoin ep (lambda-calls-or-closes (node-home-lambda call)))
         (merge-tail-sets call ep)