SBCL

SVREF of vector declared to undefined element type triggers SB-INT:BUG in compiler

Bug #1258716 reported by Bob Alexander
6
This bug affects 1 person
Affects Status Importance Assigned to Milestone
SBCL
Fix Released
High
Unassigned

Bug Description

In a "let" clause that contains several type declarations, one of them causes an error of this sort:

Unhandled SB-INT:BUG in thread #<SB-THREAD:THREAD "main thread" RUNNING
                                  {23FC3D11}>:
    full call to SB-KERNEL:DATA-VECTOR-REF-WITH-OFFSET
  This is probably a bug in SBCL itself. ...

(full message below)

The code snippet is attached. There is one line with the comment "THIS LINE CAUSES A COMPILER ERROR". If that line is in, it errs, otherwise works fine. (Interestingly, there is another very similar declaration a few lines below that causes no problem.)

SBCL version: SBCL 1.1.12 -- on Windows

Yes, it's Windoze, but this problem does not seem likely to be OS-dependent :-)

>systeminfo
OS Name: Microsoft Windows 7 Home Premium
OS Version: 6.1.7601 Service Pack 1 Build 7601
OS Configuration: Standalone Workstation
OS Build Type: Multiprocessor Free
System Manufacturer: Sony Corporation
System Model: VPCEB13FX
System Type: x64-based PC
Processor(s): 1 Processor(s) Installed.
                           [01]: Intel64 Family 6 Model 37 Stepping 2 GenuineIntel ~1178 Mhz

As you can see, this snippet is mainly definitions, and doesn't do anything interesting -- when successful it produces no output.

Here is the full message + backtrace:

Unhandled SB-INT:BUG in thread #<SB-THREAD:THREAD "main thread" RUNNING
                                  {23FC3D11}>:
    full call to SB-KERNEL:DATA-VECTOR-REF-WITH-OFFSET
  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/>.

Backtrace for: #<SB-THREAD:THREAD "main thread" RUNNING {23FC3D11}>
0: ((LAMBDA NIL :IN SB-DEBUG::FUNCALL-WITH-DEBUG-IO-SYNTAX))
1: (SB-IMPL::CALL-WITH-SANE-IO-SYNTAX #<CLOSURE (LAMBDA NIL :IN SB-DEBUG::FUNCAL
L-WITH-DEBUG-IO-SYNTAX) {244DF56D}>)
2: (SB-IMPL::%WITH-STANDARD-IO-SYNTAX #<CLOSURE (LAMBDA NIL :IN SB-DEBUG::FUNCAL
L-WITH-DEBUG-IO-SYNTAX) {244DF555}>)
3: (PRINT-BACKTRACE :STREAM #<SB-SYS:FD-STREAM for "standard error" {23FC4131}>
:START 0 :FROM :INTERRUPTED-FRAME :COUNT NIL :PRINT-THREAD T :PRINT-FRAME-SOURCE
 NIL :METHOD-FRAME-STYLE NIL)
4: (SB-DEBUG::DEBUGGER-DISABLED-HOOK #<SB-INT:BUG "full call to ~S" {244DAB51}>
#<unavailable argument>)
5: (SB-DEBUG::RUN-HOOK *INVOKE-DEBUGGER-HOOK* #<SB-INT:BUG "full call to ~S" {24
4DAB51}>)
6: (INVOKE-DEBUGGER #<SB-INT:BUG "full call to ~S" {244DAB51}>)
7: (ERROR SB-INT:BUG :FORMAT-CONTROL "full call to ~S" :FORMAT-ARGUMENTS (SB-KER
NEL:DATA-VECTOR-REF-WITH-OFFSET))
8: (SB-INT:BUG "full call to ~S" SB-KERNEL:DATA-VECTOR-REF-WITH-OFFSET)
9: (SB-C::PONDER-FULL-CALL #<SB-C::COMBINATION :FUN #<SB-C::REF :LEAF #<SB-C::G
LOBAL-VAR :%SOURCE-NAME SB-KERNEL:DATA-VECTOR-REF-WITH-OFFSET :TYPE #1=#<SB-KERN
EL:FUN-TYPE (FUNCTION (SIMPLE-ARRAY FIXNUM FIXNUM) (VALUES T &OPTIONAL))> :DEFIN
ED-TYPE #1# :WHERE-FROM :DECLARED :KIND :GLOBAL-FUNCTION {2410E371}> {24148AE9}>
 :ARGS (#<CAST :%TYPE-CHECK T :VALUE #<SB-C::LVAR 1 {24148BD1}> :ASSERTED-TYPE #
2=#<SB-KERNEL:ARRAY-TYPE SIMPLE-VECTOR> :TYPE-TO-CHECK #2# {24148CD9}> #<CAST :%
TYPE-CHECK NIL :VALUE #<SB-C::LVAR 2 {243A45D1}> :ASSERTED-TYPE #<SB-KERNEL:NUME
RIC-TYPE (MOD 52)> :TYPE-TO-CHECK #<SB-KERNEL:NAMED-TYPE *> {2431CD11}> #<SB-C::
REF :LEAF #<SB-KERNEL:CONSTANT :VALUE 0 {240E3199}> {24149969}>) {24148B29}>)
10: (SB-C::IR2-CONVERT-FULL-CALL #<SB-C::COMBINATION :FUN #<SB-C::REF :LEAF #<S
B-C::GLOBAL-VAR :%SOURCE-NAME SB-KERNEL:DATA-VECTOR-REF-WITH-OFFSET :TYPE #1=#<S
B-KERNEL:FUN-TYPE (FUNCTION (SIMPLE-ARRAY FIXNUM FIXNUM) (VALUES T &OPTIONAL))>
:DEFINED-TYPE #1# :WHERE-FROM :DECLARED :KIND :GLOBAL-FUNCTION {2410E371}> {2414
8AE9}> :ARGS (#<CAST :%TYPE-CHECK T :VALUE #<SB-C::LVAR 1 {24148BD1}> :ASSERTED-
TYPE #2=#<SB-KERNEL:ARRAY-TYPE SIMPLE-VECTOR> :TYPE-TO-CHECK #2# {24148CD9}> #<C
AST :%TYPE-CHECK NIL :VALUE #<SB-C::LVAR 2 {243A45D1}> :ASSERTED-TYPE #<SB-KERNE
L:NUMERIC-TYPE (MOD 52)> :TYPE-TO-CHECK #<SB-KERNEL:NAMED-TYPE *> {2431CD11}> #<
SB-C::REF :LEAF #<SB-KERNEL:CONSTANT :VALUE 0 {240E3199}> {24149969}>) {24148B2
9}> #<SB-C::IR2-BLOCK :START-VOP #<SB-C::VOP :INFO SB-C:MOVE :ARGS #<SB-C:TN-RE
F :TN #<SB-C:TN I!1> :WRITE-P NIL :VOP SB-C:MOVE> :RESULTS #<SB-C:TN-REF :TN #1=
#<SB-C:TN t2> :WRITE-P T :VOP SB-C:MOVE>> :LAST-VOP #<SB-C::VOP :INFO SB-C:MOVE
:ARGS #<SB-C:TN-REF :TN #1# :WRITE-P NIL :VOP SB-C:MOVE> :RESULTS #<SB-C:TN-REF
:TN #<SB-C:TN t3> :WRITE-P T :VOP SB-C:MOVE>>>)
11: (SB-C::IR2-CONVERT-BLOCK #<SB-C::CBLOCK 89 :START c3 {243A5C89}>)
12: (SB-C:IR2-CONVERT #<SB-C:COMPONENT :NAME (FLET #:CLEANUP-FUN-11 :IN "C:/misc
/misc/sbcl_play/auto-sol/let-clause-bug.lisp") {2417E439}>)
13: (SB-C::%COMPILE-COMPONENT #<SB-C:COMPONENT :NAME (FLET #:CLEANUP-FUN-11 :IN
"C:/misc/misc/sbcl_play/auto-sol/let-clause-bug.lisp") {2417E439}>)
14: (SB-C::COMPILE-COMPONENT #<SB-C:COMPONENT :NAME (FLET #:CLEANUP-FUN-11 :IN "
C:/misc/misc/sbcl_play/auto-sol/let-clause-bug.lisp") {2417E439}>)
15: (SB-C::%COMPILE (LAMBDA NIL (PROGN (LET ((RANK-NAMES #("ace" "deuce" "three"
 "four" "five" "six" "seven" "eight" "nine" "ten" "jack" "queen" "king")) (SUIT-
NAMES #("spades" "hearts" "diamonds" "clubs")) (RANK-ABBREVS #("A" "2" "3" "4" "
5" "6" "7" "8" "9" "10" "J" "Q" "K")) (SUIT-ABBREVS #("s" "H" "D" "c")) (SUIT-CO
LORS #(BLACK RED RED BLACK))) (DECLARE ((VECTOR STRING) RANK-NAMES SUIT-NAMES RA
NK-ABBREVS SUIT-ABBREVS) ((VECTOR SYMBOL) SUIT-COLORS)) (DEFSTRUCT CARD (VALUE 0
 :TYPE FIXNUM) (RANK 0 :TYPE FIXNUM) (SUIT 0 :TYPE FIXNUM) (SUIT-COLOR (QUOTE SP
ADES) :TYPE SYMBOL) (RANK-NAME "" :TYPE STRING) (SUIT-NAME "" :TYPE STRING) (SHO
RT-NAME "" :TYPE STRING) (NAME "" :TYPE STRING)) (DECLAIM (FTYPE (FUNCTION (FIXN
UM) CARD) MAKE-CARD-FROM-VALUE) (FTYPE (FUNCTION NIL (VECTOR CARD 52)) CARD-NEW-
DECK) (FTYPE (FUNCTION (FIXNUM) CARD) CARD-FROM-VALUE) (FTYPE (FUNCTION (STRING)
 CARD) CARD-FROM-SHORT-NAME)) (DEFUN MAKE-CARD-FROM-VALUE (VALUE) (DECLARE (FIXN
UM VALUE)) (MULTIPLE-VALUE-BIND (SUIT RANK) (FLOOR VALUE 13) (DECLARE (FIXNUM SU
IT RANK)) (LET* ((RANK-NAME (SVREF RANK-NAMES RANK)) (SUIT-NAME (SVREF SUIT-NAME
S SUIT))) (DECLARE (STRING RANK-NAME SUIT-NAME)) (MAKE-CARD :VALUE VALUE :RANK (
+ RANK 1) :SUIT SUIT :SUIT-COLOR (SVREF SUIT-COLORS SUIT) :RANK-NAME (SVREF RANK
-NAMES RANK) :SUIT-NAME (SVREF SUIT-NAMES SUIT) :SHORT-NAME (FORMAT NIL "~2@A~A"
 (SVREF RANK-ABBREVS RANK) (SVREF SUIT-ABBREVS SUIT)) :NAME (FORMAT NIL "~A of ~
A" RANK-NAME SUIT-NAME))))) (LET ((CARD-POOL (MAKE-ARRAY 52 :ELEMENT-TYPE (QUOTE
 CARD)))) (DECLARE ((VECTOR CARD 52) CARD-POOL)) (DOTIMES (I 52) (SETF (ELT CARD
-POOL I) (MAKE-CARD-FROM-VALUE I))) (DEFUN CARD-NEW-DECK NIL (LET ((NEW-DECK (MA
KE-ARRAY 52 :FILL-POINTER 52 :ELEMENT-TYPE (QUOTE CARD)))) (DECLARE ((VECTOR CAR
D 52) NEW-DECK)) (DO-VECTOR (CARD CARD-POOL :INDEX I) (SETF (ELT NEW-DECK I) CAR
D)) NEW-DECK)) (DEFUN CARD-FROM-VALUE (I) (DECLARE (FIXNUM I)) (SVREF CARD-POOL
I)) (DEFUN CARD-FROM-SHORT-NAME (SHORT-NAME) (DECLARE (STRING SHORT-NAME)) (LET*
 ((S (FORMAT NIL "~3@A" SHORT-NAME)) (R (CHAR-DOWNCASE (SCHAR S 1))) (RANK (CASE
 R (#\a 1) (#\j 11) (#\q 12) (#\k 13) (T (PARSE-INTEGER (SUBSEQ S 0 2)))))) (DEC
LARE (STRING S) (CHARACTER R) (FIXNUM RANK)) (IF (AND (>= RANK 1) (<= RANK 13))
(LET ((SUIT (POSITION (CHAR-DOWNCASE (SCHAR S 2)) "shdc"))) (DECLARE (FIXNUM SUI
T)) (IF SUIT (CARD-FROM-VALUE (+ (- RANK 1) (* SUIT 13))) NIL)) NIL))))))) #<SB-
C::CORE-OBJECT > :NAME NIL :PATH (SB-C::ORIGINAL-SOURCE-START 0 1))
16: ((FLET #:WITHOUT-INTERRUPTS-BODY-566 :IN SB-THREAD::CALL-WITH-RECURSIVE-LOCK
))
17: (SB-THREAD::CALL-WITH-RECURSIVE-LOCK #<CLOSURE (FLET SB-THREAD::WITH-RECURSI
VE-LOCK-THUNK :IN SB-C::ACTUALLY-COMPILE) {28F28D}> #<SB-THREAD:MUTEX "World Loc
k" owner: #<SB-THREAD:THREAD "main thread" RUNNING {23FC3D11}>> T NIL)
18: ((LAMBDA NIL :IN SB-C::ACTUALLY-COMPILE))
19: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
20: (SB-C::ACTUALLY-COMPILE NIL (LAMBDA NIL (PROGN (LET ((RANK-NAMES #("ace" "de
uce" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "jack" "queen" "ki
ng")) (SUIT-NAMES #("spades" "hearts" "diamonds" "clubs")) (RANK-ABBREVS #("A" "
2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K")) (SUIT-ABBREVS #("s" "H" "D" "c
")) (SUIT-COLORS #(BLACK RED RED BLACK))) (DECLARE ((VECTOR STRING) RANK-NAMES S
UIT-NAMES RANK-ABBREVS SUIT-ABBREVS) ((VECTOR SYMBOL) SUIT-COLORS)) (DEFSTRUCT C
ARD (VALUE 0 :TYPE FIXNUM) (RANK 0 :TYPE FIXNUM) (SUIT 0 :TYPE FIXNUM) (SUIT-COL
OR (QUOTE SPADES) :TYPE SYMBOL) (RANK-NAME "" :TYPE STRING) (SUIT-NAME "" :TYPE
STRING) (SHORT-NAME "" :TYPE STRING) (NAME "" :TYPE STRING)) (DECLAIM (FTYPE (FU
NCTION (FIXNUM) CARD) MAKE-CARD-FROM-VALUE) (FTYPE (FUNCTION NIL (VECTOR CARD 52
)) CARD-NEW-DECK) (FTYPE (FUNCTION (FIXNUM) CARD) CARD-FROM-VALUE) (FTYPE (FUNCT
ION (STRING) CARD) CARD-FROM-SHORT-NAME)) (DEFUN MAKE-CARD-FROM-VALUE (VALUE) (D
ECLARE (FIXNUM VALUE)) (MULTIPLE-VALUE-BIND (SUIT RANK) (FLOOR VALUE 13) (DECLAR
E (FIXNUM SUIT RANK)) (LET* ((RANK-NAME (SVREF RANK-NAMES RANK)) (SUIT-NAME (SVR
EF SUIT-NAMES SUIT))) (DECLARE (STRING RANK-NAME SUIT-NAME)) (MAKE-CARD :VALUE V
ALUE :RANK (+ RANK 1) :SUIT SUIT :SUIT-COLOR (SVREF SUIT-COLORS SUIT) :RANK-NAME
 (SVREF RANK-NAMES RANK) :SUIT-NAME (SVREF SUIT-NAMES SUIT) :SHORT-NAME (FORMAT
NIL "~2@A~A" (SVREF RANK-ABBREVS RANK) (SVREF SUIT-ABBREVS SUIT)) :NAME (FORMAT
NIL "~A of ~A" RANK-NAME SUIT-NAME))))) (LET ((CARD-POOL (MAKE-ARRAY 52 :ELEMENT
-TYPE (QUOTE CARD)))) (DECLARE ((VECTOR CARD 52) CARD-POOL)) (DOTIMES (I 52) (SE
TF (ELT CARD-POOL I) (MAKE-CARD-FROM-VALUE I))) (DEFUN CARD-NEW-DECK NIL (LET ((
NEW-DECK (MAKE-ARRAY 52 :FILL-POINTER 52 :ELEMENT-TYPE (QUOTE CARD)))) (DECLARE
((VECTOR CARD 52) NEW-DECK)) (DO-VECTOR (CARD CARD-POOL :INDEX I) (SETF (ELT NEW
-DECK I) CARD)) NEW-DECK)) (DEFUN CARD-FROM-VALUE (I) (DECLARE (FIXNUM I)) (SVRE
F CARD-POOL I)) (DEFUN CARD-FROM-SHORT-NAME (SHORT-NAME) (DECLARE (STRING SHORT-
NAME)) (LET* ((S (FORMAT NIL "~3@A" SHORT-NAME)) (R (CHAR-DOWNCASE (SCHAR S 1)))
 (RANK (CASE R (#\a 1) (#\j 11) (#\q 12) (#\k 13) (T (PARSE-INTEGER (SUBSEQ S 0
2)))))) (DECLARE (STRING S) (CHARACTER R) (FIXNUM RANK)) (IF (AND (>= RANK 1) (<
= RANK 13)) (LET ((SUIT (POSITION (CHAR-DOWNCASE (SCHAR S 2)) "shdc"))) (DECLARE
 (FIXNUM SUIT)) (IF SUIT (CARD-FROM-VALUE (+ (- RANK 1) (* SUIT 13))) NIL)) NIL)
)))))) #<NULL-LEXENV> #<SB-C::SOURCE-INFO > 1 NIL)
21: (SB-C:COMPILE-IN-LEXENV NIL (LAMBDA NIL (PROGN (LET ((RANK-NAMES #("ace" "de
uce" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "jack" "queen" "ki
ng")) (SUIT-NAMES #("spades" "hearts" "diamonds" "clubs")) (RANK-ABBREVS #("A" "
2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K")) (SUIT-ABBREVS #("s" "H" "D" "c
")) (SUIT-COLORS #(BLACK RED RED BLACK))) (DECLARE ((VECTOR STRING) RANK-NAMES S
UIT-NAMES RANK-ABBREVS SUIT-ABBREVS) ((VECTOR SYMBOL) SUIT-COLORS)) (DEFSTRUCT C
ARD (VALUE 0 :TYPE FIXNUM) (RANK 0 :TYPE FIXNUM) (SUIT 0 :TYPE FIXNUM) (SUIT-COL
OR (QUOTE SPADES) :TYPE SYMBOL) (RANK-NAME "" :TYPE STRING) (SUIT-NAME "" :TYPE
STRING) (SHORT-NAME "" :TYPE STRING) (NAME "" :TYPE STRING)) (DECLAIM (FTYPE (FU
NCTION (FIXNUM) CARD) MAKE-CARD-FROM-VALUE) (FTYPE (FUNCTION NIL (VECTOR CARD 52
)) CARD-NEW-DECK) (FTYPE (FUNCTION (FIXNUM) CARD) CARD-FROM-VALUE) (FTYPE (FUNCT
ION (STRING) CARD) CARD-FROM-SHORT-NAME)) (DEFUN MAKE-CARD-FROM-VALUE (VALUE) (D
ECLARE (FIXNUM VALUE)) (MULTIPLE-VALUE-BIND (SUIT RANK) (FLOOR VALUE 13) (DECLAR
E (FIXNUM SUIT RANK)) (LET* ((RANK-NAME (SVREF RANK-NAMES RANK)) (SUIT-NAME (SVR
EF SUIT-NAMES SUIT))) (DECLARE (STRING RANK-NAME SUIT-NAME)) (MAKE-CARD :VALUE V
ALUE :RANK (+ RANK 1) :SUIT SUIT :SUIT-COLOR (SVREF SUIT-COLORS SUIT) :RANK-NAME
 (SVREF RANK-NAMES RANK) :SUIT-NAME (SVREF SUIT-NAMES SUIT) :SHORT-NAME (FORMAT
NIL "~2@A~A" (SVREF RANK-ABBREVS RANK) (SVREF SUIT-ABBREVS SUIT)) :NAME (FORMAT
NIL "~A of ~A" RANK-NAME SUIT-NAME))))) (LET ((CARD-POOL (MAKE-ARRAY 52 :ELEMENT
-TYPE (QUOTE CARD)))) (DECLARE ((VECTOR CARD 52) CARD-POOL)) (DOTIMES (I 52) (SE
TF (ELT CARD-POOL I) (MAKE-CARD-FROM-VALUE I))) (DEFUN CARD-NEW-DECK NIL (LET ((
NEW-DECK (MAKE-ARRAY 52 :FILL-POINTER 52 :ELEMENT-TYPE (QUOTE CARD)))) (DECLARE
((VECTOR CARD 52) NEW-DECK)) (DO-VECTOR (CARD CARD-POOL :INDEX I) (SETF (ELT NEW
-DECK I) CARD)) NEW-DECK)) (DEFUN CARD-FROM-VALUE (I) (DECLARE (FIXNUM I)) (SVRE
F CARD-POOL I)) (DEFUN CARD-FROM-SHORT-NAME (SHORT-NAME) (DECLARE (STRING SHORT-
NAME)) (LET* ((S (FORMAT NIL "~3@A" SHORT-NAME)) (R (CHAR-DOWNCASE (SCHAR S 1)))
 (RANK (CASE R (#\a 1) (#\j 11) (#\q 12) (#\k 13) (T (PARSE-INTEGER (SUBSEQ S 0
2)))))) (DECLARE (STRING S) (CHARACTER R) (FIXNUM RANK)) (IF (AND (>= RANK 1) (<
= RANK 13)) (LET ((SUIT (POSITION (CHAR-DOWNCASE (SCHAR S 2)) "shdc"))) (DECLARE
 (FIXNUM SUIT)) (IF SUIT (CARD-FROM-VALUE (+ (- RANK 1) (* SUIT 13))) NIL)) NIL)
)))))) #<NULL-LEXENV> #<SB-C::SOURCE-INFO > 1 NIL)
22: (SB-IMPL::%SIMPLE-EVAL (LET ((RANK-NAMES #("ace" "deuce" "three" "four" "fiv
e" "six" "seven" "eight" "nine" "ten" "jack" "queen" "king")) (SUIT-NAMES #("spa
des" "hearts" "diamonds" "clubs")) (RANK-ABBREVS #("A" "2" "3" "4" "5" "6" "7" "
8" "9" "10" "J" "Q" "K")) (SUIT-ABBREVS #("s" "H" "D" "c")) (SUIT-COLORS #(BLACK
 RED RED BLACK))) (DECLARE ((VECTOR STRING) RANK-NAMES SUIT-NAMES RANK-ABBREVS S
UIT-ABBREVS) ((VECTOR SYMBOL) SUIT-COLORS)) (DEFSTRUCT CARD (VALUE 0 :TYPE FIXNU
M) (RANK 0 :TYPE FIXNUM) (SUIT 0 :TYPE FIXNUM) (SUIT-COLOR (QUOTE SPADES) :TYPE
SYMBOL) (RANK-NAME "" :TYPE STRING) (SUIT-NAME "" :TYPE STRING) (SHORT-NAME "" :
TYPE STRING) (NAME "" :TYPE STRING)) (DECLAIM (FTYPE (FUNCTION (FIXNUM) CARD) MA
KE-CARD-FROM-VALUE) (FTYPE (FUNCTION NIL (VECTOR CARD 52)) CARD-NEW-DECK) (FTYPE
 (FUNCTION (FIXNUM) CARD) CARD-FROM-VALUE) (FTYPE (FUNCTION (STRING) CARD) CARD-
FROM-SHORT-NAME)) (DEFUN MAKE-CARD-FROM-VALUE (VALUE) (DECLARE (FIXNUM VALUE)) (
MULTIPLE-VALUE-BIND (SUIT RANK) (FLOOR VALUE 13) (DECLARE (FIXNUM SUIT RANK)) (L
ET* ((RANK-NAME (SVREF RANK-NAMES RANK)) (SUIT-NAME (SVREF SUIT-NAMES SUIT))) (D
ECLARE (STRING RANK-NAME SUIT-NAME)) (MAKE-CARD :VALUE VALUE :RANK (+ RANK 1) :S
UIT SUIT :SUIT-COLOR (SVREF SUIT-COLORS SUIT) :RANK-NAME (SVREF RANK-NAMES RANK)
 :SUIT-NAME (SVREF SUIT-NAMES SUIT) :SHORT-NAME (FORMAT NIL "~2@A~A" (SVREF RANK
-ABBREVS RANK) (SVREF SUIT-ABBREVS SUIT)) :NAME (FORMAT NIL "~A of ~A" RANK-NAME
 SUIT-NAME))))) (LET ((CARD-POOL (MAKE-ARRAY 52 :ELEMENT-TYPE (QUOTE CARD)))) (D
ECLARE ((VECTOR CARD 52) CARD-POOL)) (DOTIMES (I 52) (SETF (ELT CARD-POOL I) (MA
KE-CARD-FROM-VALUE I))) (DEFUN CARD-NEW-DECK NIL (LET ((NEW-DECK (MAKE-ARRAY 52
:FILL-POINTER 52 :ELEMENT-TYPE (QUOTE CARD)))) (DECLARE ((VECTOR CARD 52) NEW-DE
CK)) (DO-VECTOR (CARD CARD-POOL :INDEX I) (SETF (ELT NEW-DECK I) CARD)) NEW-DECK
)) (DEFUN CARD-FROM-VALUE (I) (DECLARE (FIXNUM I)) (SVREF CARD-POOL I)) (DEFUN C
ARD-FROM-SHORT-NAME (SHORT-NAME) (DECLARE (STRING SHORT-NAME)) (LET* ((S (FORMAT
 NIL "~3@A" SHORT-NAME)) (R (CHAR-DOWNCASE (SCHAR S 1))) (RANK (CASE R (#\a 1) (
#\j 11) (#\q 12) (#\k 13) (T (PARSE-INTEGER (SUBSEQ S 0 2)))))) (DECLARE (STRING
 S) (CHARACTER R) (FIXNUM RANK)) (IF (AND (>= RANK 1) (<= RANK 13)) (LET ((SUIT
(POSITION (CHAR-DOWNCASE (SCHAR S 2)) "shdc"))) (DECLARE (FIXNUM SUIT)) (IF SUIT
 (CARD-FROM-VALUE (+ (- RANK 1) (* SUIT 13))) NIL)) NIL))))) #<NULL-LEXENV>)
23: (SB-INT:SIMPLE-EVAL-IN-LEXENV (LET ((RANK-NAMES #("ace" "deuce" "three" "fou
r" "five" "six" "seven" "eight" "nine" "ten" "jack" "queen" "king")) (SUIT-NAMES
 #("spades" "hearts" "diamonds" "clubs")) (RANK-ABBREVS #("A" "2" "3" "4" "5" "6
" "7" "8" "9" "10" "J" "Q" "K")) (SUIT-ABBREVS #("s" "H" "D" "c")) (SUIT-COLORS
#(BLACK RED RED BLACK))) (DECLARE ((VECTOR STRING) RANK-NAMES SUIT-NAMES RANK-AB
BREVS SUIT-ABBREVS) ((VECTOR SYMBOL) SUIT-COLORS)) (DEFSTRUCT CARD (VALUE 0 :TYP
E FIXNUM) (RANK 0 :TYPE FIXNUM) (SUIT 0 :TYPE FIXNUM) (SUIT-COLOR (QUOTE SPADES)
 :TYPE SYMBOL) (RANK-NAME "" :TYPE STRING) (SUIT-NAME "" :TYPE STRING) (SHORT-NA
ME "" :TYPE STRING) (NAME "" :TYPE STRING)) (DECLAIM (FTYPE (FUNCTION (FIXNUM) C
ARD) MAKE-CARD-FROM-VALUE) (FTYPE (FUNCTION NIL (VECTOR CARD 52)) CARD-NEW-DECK)
 (FTYPE (FUNCTION (FIXNUM) CARD) CARD-FROM-VALUE) (FTYPE (FUNCTION (STRING) CARD
) CARD-FROM-SHORT-NAME)) (DEFUN MAKE-CARD-FROM-VALUE (VALUE) (DECLARE (FIXNUM VA
LUE)) (MULTIPLE-VALUE-BIND (SUIT RANK) (FLOOR VALUE 13) (DECLARE (FIXNUM SUIT RA
NK)) (LET* ((RANK-NAME (SVREF RANK-NAMES RANK)) (SUIT-NAME (SVREF SUIT-NAMES SUI
T))) (DECLARE (STRING RANK-NAME SUIT-NAME)) (MAKE-CARD :VALUE VALUE :RANK (+ RAN
K 1) :SUIT SUIT :SUIT-COLOR (SVREF SUIT-COLORS SUIT) :RANK-NAME (SVREF RANK-NAME
S RANK) :SUIT-NAME (SVREF SUIT-NAMES SUIT) :SHORT-NAME (FORMAT NIL "~2@A~A" (SVR
EF RANK-ABBREVS RANK) (SVREF SUIT-ABBREVS SUIT)) :NAME (FORMAT NIL "~A of ~A" RA
NK-NAME SUIT-NAME))))) (LET ((CARD-POOL (MAKE-ARRAY 52 :ELEMENT-TYPE (QUOTE CARD
)))) (DECLARE ((VECTOR CARD 52) CARD-POOL)) (DOTIMES (I 52) (SETF (ELT CARD-POOL
 I) (MAKE-CARD-FROM-VALUE I))) (DEFUN CARD-NEW-DECK NIL (LET ((NEW-DECK (MAKE-AR
RAY 52 :FILL-POINTER 52 :ELEMENT-TYPE (QUOTE CARD)))) (DECLARE ((VECTOR CARD 52)
 NEW-DECK)) (DO-VECTOR (CARD CARD-POOL :INDEX I) (SETF (ELT NEW-DECK I) CARD)) N
EW-DECK)) (DEFUN CARD-FROM-VALUE (I) (DECLARE (FIXNUM I)) (SVREF CARD-POOL I)) (
DEFUN CARD-FROM-SHORT-NAME (SHORT-NAME) (DECLARE (STRING SHORT-NAME)) (LET* ((S
(FORMAT NIL "~3@A" SHORT-NAME)) (R (CHAR-DOWNCASE (SCHAR S 1))) (RANK (CASE R (#
\a 1) (#\j 11) (#\q 12) (#\k 13) (T (PARSE-INTEGER (SUBSEQ S 0 2)))))) (DECLARE
(STRING S) (CHARACTER R) (FIXNUM RANK)) (IF (AND (>= RANK 1) (<= RANK 13)) (LET
((SUIT (POSITION (CHAR-DOWNCASE (SCHAR S 2)) "shdc"))) (DECLARE (FIXNUM SUIT)) (
IF SUIT (CARD-FROM-VALUE (+ (- RANK 1) (* SUIT 13))) NIL)) NIL))))) #<NULL-LEXEN
V>)
24: (EVAL-TLF (LET ((RANK-NAMES #("ace" "deuce" "three" "four" "five" "six" "sev
en" "eight" "nine" "ten" "jack" "queen" "king")) (SUIT-NAMES #("spades" "hearts"
 "diamonds" "clubs")) (RANK-ABBREVS #("A" "2" "3" "4" "5" "6" "7" "8" "9" "10" "
J" "Q" "K")) (SUIT-ABBREVS #("s" "H" "D" "c")) (SUIT-COLORS #(BLACK RED RED BLAC
K))) (DECLARE ((VECTOR STRING) RANK-NAMES SUIT-NAMES RANK-ABBREVS SUIT-ABBREVS)
((VECTOR SYMBOL) SUIT-COLORS)) (DEFSTRUCT CARD (VALUE 0 :TYPE FIXNUM) (RANK 0 :T
YPE FIXNUM) (SUIT 0 :TYPE FIXNUM) (SUIT-COLOR (QUOTE SPADES) :TYPE SYMBOL) (RANK
-NAME "" :TYPE STRING) (SUIT-NAME "" :TYPE STRING) (SHORT-NAME "" :TYPE STRING)
(NAME "" :TYPE STRING)) (DECLAIM (FTYPE (FUNCTION (FIXNUM) CARD) MAKE-CARD-FROM-
VALUE) (FTYPE (FUNCTION NIL (VECTOR CARD 52)) CARD-NEW-DECK) (FTYPE (FUNCTION (F
IXNUM) CARD) CARD-FROM-VALUE) (FTYPE (FUNCTION (STRING) CARD) CARD-FROM-SHORT-NA
ME)) (DEFUN MAKE-CARD-FROM-VALUE (VALUE) (DECLARE (FIXNUM VALUE)) (MULTIPLE-VALU
E-BIND (SUIT RANK) (FLOOR VALUE 13) (DECLARE (FIXNUM SUIT RANK)) (LET* ((RANK-NA
ME (SVREF RANK-NAMES RANK)) (SUIT-NAME (SVREF SUIT-NAMES SUIT))) (DECLARE (STRIN
G RANK-NAME SUIT-NAME)) (MAKE-CARD :VALUE VALUE :RANK (+ RANK 1) :SUIT SUIT :SUI
T-COLOR (SVREF SUIT-COLORS SUIT) :RANK-NAME (SVREF RANK-NAMES RANK) :SUIT-NAME (
SVREF SUIT-NAMES SUIT) :SHORT-NAME (FORMAT NIL "~2@A~A" (SVREF RANK-ABBREVS RANK
) (SVREF SUIT-ABBREVS SUIT)) :NAME (FORMAT NIL "~A of ~A" RANK-NAME SUIT-NAME)))
)) (LET ((CARD-POOL (MAKE-ARRAY 52 :ELEMENT-TYPE (QUOTE CARD)))) (DECLARE ((VECT
OR CARD 52) CARD-POOL)) (DOTIMES (I 52) (SETF (ELT CARD-POOL I) (MAKE-CARD-FROM-
VALUE I))) (DEFUN CARD-NEW-DECK NIL (LET ((NEW-DECK (MAKE-ARRAY 52 :FILL-POINTER
 52 :ELEMENT-TYPE (QUOTE CARD)))) (DECLARE ((VECTOR CARD 52) NEW-DECK)) (DO-VECT
OR (CARD CARD-POOL :INDEX I) (SETF (ELT NEW-DECK I) CARD)) NEW-DECK)) (DEFUN CAR
D-FROM-VALUE (I) (DECLARE (FIXNUM I)) (SVREF CARD-POOL I)) (DEFUN CARD-FROM-SHOR
T-NAME (SHORT-NAME) (DECLARE (STRING SHORT-NAME)) (LET* ((S (FORMAT NIL "~3@A" S
HORT-NAME)) (R (CHAR-DOWNCASE (SCHAR S 1))) (RANK (CASE R (#\a 1) (#\j 11) (#\q
12) (#\k 13) (T (PARSE-INTEGER (SUBSEQ S 0 2)))))) (DECLARE (STRING S) (CHARACTE
R R) (FIXNUM RANK)) (IF (AND (>= RANK 1) (<= RANK 13)) (LET ((SUIT (POSITION (CH
AR-DOWNCASE (SCHAR S 2)) "shdc"))) (DECLARE (FIXNUM SUIT)) (IF SUIT (CARD-FROM-V
ALUE (+ (- RANK 1) (* SUIT 13))) NIL)) NIL))))) 1 #<NULL-LEXENV>)
25: ((FLET SB-FASL::EVAL-FORM :IN SB-INT:LOAD-AS-SOURCE) (LET ((RANK-NAMES #("ac
e" "deuce" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "jack" "quee
n" "king")) (SUIT-NAMES #("spades" "hearts" "diamonds" "clubs")) (RANK-ABBREVS #
("A" "2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K")) (SUIT-ABBREVS #("s" "H"
"D" "c")) (SUIT-COLORS #(BLACK RED RED BLACK))) (DECLARE ((VECTOR STRING) RANK-N
AMES SUIT-NAMES RANK-ABBREVS SUIT-ABBREVS) ((VECTOR SYMBOL) SUIT-COLORS)) (DEFST
RUCT CARD (VALUE 0 :TYPE FIXNUM) (RANK 0 :TYPE FIXNUM) (SUIT 0 :TYPE FIXNUM) (SU
IT-COLOR (QUOTE SPADES) :TYPE SYMBOL) (RANK-NAME "" :TYPE STRING) (SUIT-NAME ""
:TYPE STRING) (SHORT-NAME "" :TYPE STRING) (NAME "" :TYPE STRING)) (DECLAIM (FTY
PE (FUNCTION (FIXNUM) CARD) MAKE-CARD-FROM-VALUE) (FTYPE (FUNCTION NIL (VECTOR C
ARD 52)) CARD-NEW-DECK) (FTYPE (FUNCTION (FIXNUM) CARD) CARD-FROM-VALUE) (FTYPE
(FUNCTION (STRING) CARD) CARD-FROM-SHORT-NAME)) (DEFUN MAKE-CARD-FROM-VALUE (VAL
UE) (DECLARE (FIXNUM VALUE)) (MULTIPLE-VALUE-BIND (SUIT RANK) (FLOOR VALUE 13) (
DECLARE (FIXNUM SUIT RANK)) (LET* ((RANK-NAME (SVREF RANK-NAMES RANK)) (SUIT-NAM
E (SVREF SUIT-NAMES SUIT))) (DECLARE (STRING RANK-NAME SUIT-NAME)) (MAKE-CARD :V
ALUE VALUE :RANK (+ RANK 1) :SUIT SUIT :SUIT-COLOR (SVREF SUIT-COLORS SUIT) :RAN
K-NAME (SVREF RANK-NAMES RANK) :SUIT-NAME (SVREF SUIT-NAMES SUIT) :SHORT-NAME (F
ORMAT NIL "~2@A~A" (SVREF RANK-ABBREVS RANK) (SVREF SUIT-ABBREVS SUIT)) :NAME (F
ORMAT NIL "~A of ~A" RANK-NAME SUIT-NAME))))) (LET ((CARD-POOL (MAKE-ARRAY 52 :E
LEMENT-TYPE (QUOTE CARD)))) (DECLARE ((VECTOR CARD 52) CARD-POOL)) (DOTIMES (I 5
2) (SETF (ELT CARD-POOL I) (MAKE-CARD-FROM-VALUE I))) (DEFUN CARD-NEW-DECK NIL (
LET ((NEW-DECK (MAKE-ARRAY 52 :FILL-POINTER 52 :ELEMENT-TYPE (QUOTE CARD)))) (DE
CLARE ((VECTOR CARD 52) NEW-DECK)) (DO-VECTOR (CARD CARD-POOL :INDEX I) (SETF (E
LT NEW-DECK I) CARD)) NEW-DECK)) (DEFUN CARD-FROM-VALUE (I) (DECLARE (FIXNUM I))
 (SVREF CARD-POOL I)) (DEFUN CARD-FROM-SHORT-NAME (SHORT-NAME) (DECLARE (STRING
SHORT-NAME)) (LET* ((S (FORMAT NIL "~3@A" SHORT-NAME)) (R (CHAR-DOWNCASE (SCHAR
S 1))) (RANK (CASE R (#\a 1) (#\j 11) (#\q 12) (#\k 13) (T (PARSE-INTEGER (SUBSE
Q S 0 2)))))) (DECLARE (STRING S) (CHARACTER R) (FIXNUM RANK)) (IF (AND (>= RANK
 1) (<= RANK 13)) (LET ((SUIT (POSITION (CHAR-DOWNCASE (SCHAR S 2)) "shdc"))) (D
ECLARE (FIXNUM SUIT)) (IF SUIT (CARD-FROM-VALUE (+ (- RANK 1) (* SUIT 13))) NIL)
) NIL))))) 1)
26: (SB-INT:LOAD-AS-SOURCE #<SB-SYS:FD-STREAM for "file C:\\misc\\misc\\sbcl_pla
y\\auto-sol\\let-clause-bug.lisp" {23FCF949}> :VERBOSE NIL :PRINT NIL :CONTEXT "
loading")
27: ((FLET SB-FASL::LOAD-STREAM :IN LOAD) #<SB-SYS:FD-STREAM for "file C:\\misc\
\misc\\sbcl_play\\auto-sol\\let-clause-bug.lisp" {23FCF949}> NIL)
28: (LOAD #<SB-SYS:FD-STREAM for "file C:\\misc\\misc\\sbcl_play\\auto-sol\\let-
clause-bug.lisp" {23FCF949}> :VERBOSE NIL :PRINT NIL :IF-DOES-NOT-EXIST T :EXTER
NAL-FORMAT :DEFAULT)
29: ((FLET SB-IMPL::LOAD-SCRIPT :IN SB-IMPL::PROCESS-SCRIPT) #<SB-SYS:FD-STREAM
for "file C:\\misc\\misc\\sbcl_play\\auto-sol\\let-clause-bug.lisp" {23FCF949}>)

30: ((FLET #:WITHOUT-INTERRUPTS-BODY-171 :IN SB-IMPL::PROCESS-SCRIPT))
31: (SB-IMPL::PROCESS-SCRIPT "let-clause-bug.lisp")
32: (SB-IMPL::TOPLEVEL-INIT)
33: ((FLET #:WITHOUT-INTERRUPTS-BODY-42 :IN SAVE-LISP-AND-DIE))
34: ((LABELS SB-IMPL::RESTART-LISP :IN SAVE-LISP-AND-DIE))
35: ("foreign function: #x429670")
36: ("foreign function: #x41668C")

unhandled condition in --disable-debugger mode, quitting
;
; compilation unit aborted
; caught 1 fatal ERROR condition

Revision history for this message
Bob Alexander (bobjalex) wrote :
Revision history for this message
Stas Boukarev (stassats) wrote :

Can't reproduce.

Changed in sbcl:
status: New → Incomplete
Revision history for this message
Alastair Bridgewater (alastair-bridgewater) wrote :

A somewhat more minimal example, tested on 1.1.18.574-21c12b6-dirty:

(let ((foo (make-array 1 :element-type 'bogus)))
  (declare ((vector bogus 1) foo))
  (lambda (i) (svref foo i)))

Changed in sbcl:
status: Incomplete → Confirmed
importance: Undecided → High
summary: - Declare confuses compiler
+ SVREF of vector declared to undefined element type triggers SB-INT:BUG
+ in compiler
Revision history for this message
Alastair Bridgewater (alastair-bridgewater) wrote :

An even tighter test case:

(lambda (a i) (declare ((vector bogus) a)) (svref a i))

Turns out that the SVREF and %SVSET transforms in SYS:SRC;COMPILER;ARRAY-TRAN.LISP use the declared element type, which is undefined, instead of the upgraded type, which is the wild-type. Using the declared type is probably appropriate in some ways, but both requires and prevents open-coding the operation in this case.

The transforms probably need to detect and appropriately deal with the case of an undefined declared element type.

Revision history for this message
Stas Boukarev (stassats) wrote :

In bd84e72bb655e77c0c0bfeaec1c8eac7a427507b.

Changed in sbcl:
status: Confirmed → Fix Committed
Christophe Rhodes (csr21-cantab)
Changed in sbcl:
status: Fix Committed → Fix Released
To post a comment you must log in.
This report contains Public information  
Everyone can see this information.
Subscribing...

Other bug subscribers

Remote bug watches

Bug watches keep track of this bug in other bug trackers.