full call to SB-KERNEL:%ASH/RIGHT (bug in IR2-CONVERT)

[Paul F. Dietz]

Found in an image built from repository after checkin 0176af (Fix typo from "Reduce consing in ir2opt.lisp"). Found by random testing.

(declaim (special *s1*))

(defparameter *f11*
  '(lambda (b c)
    (declare (type (integer -170213687166264 209287289178177) b))
    (declare (type (integer -858840096 -6) c))
    (declare
     (optimize (space 1) (compilation-speed 3) (safety 1) (debug 1)
      (speed 0)))
    (catch 'ct2
      (flet ((%f13
                 (f13-1
                  &optional
                  (f13-2
                   (the integer
                     (loop for lv4 below 3
                        sum
                        (throw 'ct2 (shiftf b -15281847320162)))))
                  (f13-3 b)
                  (f13-4 0)
                  &key (key2 0)
                  )
               (throw 'ct2 0)))
        (flet ((%f10 (f10-1 f10-2)
                 (%f13 f10-1 f10-2 0 0)))
          (ash
           (the integer
             (let ((*s1*
                    (if t
                        c
                        (%f13 (%f10 1332 b) b b)
                        )))
               (%f13 *s1* b)))
           (min 38 c)
           ))))))

(defun f11test ()
  (let ((f11 (compile nil *f11*)))
    (funcall f11 120616241449101 -686820429)))

(f11test) ==>

full call to SB-KERNEL:%ASH/RIGHT
This is probably a bug in SBCL itself. (Alternatively, SBCL
might have been corrupted by bad user code, e.g. by an undefined
Lisp operation like (FMAKUNBOUND 'COMPILE), or by stray pointers
from alien code or from unsafe Lisp code; or there might be a
bug in the OS or hardware that SBCL is running on.) If it seems
to be a bug in SBCL itself, the maintainers would like to know
about it. Bug reports are welcome on the SBCL mailing lists,
which you can find at <http://sbcl.sourceforge.net/>.
   [Condition of type SB-INT:BUG]

Restarts:
 0: [ABORT] Exit debugger, returning to top level.

Backtrace:
  0: (SB-INT:BUG "full call to ~S" SB-KERNEL:%ASH/RIGHT)
  1: (SB-C::PONDER-FULL-CALL #<SB-C::COMBINATION :FUN #<SB-C::REF :LEAF #<SB-C::GLOBAL-VAR :%SOURCE-NAME SB-KERNEL:%ASH/RIGHT :TYPE #1=#<SB-KERNEL:FUN-TYPE #> :DEFINED-TYPE #1# :WHERE-FROM :DECLARED :KIND..
  2: (SB-C::IR2-CONVERT-FULL-CALL #<SB-C::COMBINATION :FUN #<SB-C::REF :LEAF #<SB-C::GLOBAL-VAR :%SOURCE-NAME SB-KERNEL:%ASH/RIGHT :TYPE #1=#<SB-KERNEL:FUN-TYPE #> :DEFINED-TYPE #1# :WHERE-FROM :DECLARED ..
  3: (SB-C::IR2-CONVERT-BLOCK #<SB-C::CBLOCK 13 :START c2 {1006D966F3}>)
  4: (SB-C:IR2-CONVERT #<SB-C:COMPONENT :NAME (SB-C::ESCAPE-FUN #:EXIT-BLOCK-0) {1006D57533}>)
  5: (SB-C::%COMPILE-COMPONENT #<SB-C:COMPONENT :NAME (SB-C::ESCAPE-FUN #:EXIT-BLOCK-0) {1006D57533}>)
  6: (SB-C::COMPILE-COMPONENT #<SB-C:COMPONENT :NAME (SB-C::ESCAPE-FUN #:EXIT-BLOCK-0) {1006D57533}>)
  7: (SB-C::%COMPILE (LAMBDA (B C) (DECLARE (TYPE # B)) (DECLARE (TYPE # C)) (DECLARE (OPTIMIZE # # # # #)) (CATCH (QUOTE CT2) (FLET # #))) #<SB-C::CORE-OBJECT {1006D1EC43}> :NAME NIL :PATH (SB-C::ORIGINAL..
  8: ((FLET "WITHOUT-INTERRUPTS-BODY-29" :IN SB-THREAD::CALL-WITH-RECURSIVE-LOCK))
  9: (SB-THREAD::CALL-WITH-RECURSIVE-LOCK #<CLOSURE (FLET SB-THREAD::WITH-RECURSIVE-LOCK-THUNK :IN SB-C::ACTUALLY-COMPILE) {7FFFF1EB74AB}> #<SB-THREAD:MUTEX "World Lock" owner: #<SB-THREAD:THREAD "main thr..
 10: ((LAMBDA NIL :IN SB-C::ACTUALLY-COMPILE))
 11: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
 12: (SB-C::ACTUALLY-COMPILE NIL (LAMBDA (B C) (DECLARE (TYPE # B)) (DECLARE (TYPE # C)) (DECLARE (OPTIMIZE # # # # #)) (CATCH (QUOTE CT2) (FLET # #))) #<NULL-LEXENV> NIL NIL NIL)
 13: (SB-C:COMPILE-IN-LEXENV (LAMBDA (B C) (DECLARE (TYPE # B)) (DECLARE (TYPE # C)) (DECLARE (OPTIMIZE # # # # #)) (CATCH (QUOTE CT2) (FLET # #))) #<NULL-LEXENV> NIL NIL NIL NIL)
 14: (COMPILE NIL (LAMBDA (B C) (DECLARE (TYPE # B)) (DECLARE (TYPE # C)) (DECLARE (OPTIMIZE # # # # #)) (CATCH (QUOTE CT2) (FLET # #))))
 15: (F11TEST)
[...]

[Stas Boukarev (stassats)]

In a6a2290231310cc848c028e24e5f3e38533d269e.