X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=BUGS;h=534f427fb98fac64556a0f0c5dd2fec2263c9026;hb=8871a1f72225f959a454a1b77f7a0e85642ba427;hp=4cbbbb846791486fad961f36233abc2e23ce1417;hpb=71985ecfdc880e6c11a191d799313de9b4e0c12b;p=sbcl.git diff --git a/BUGS b/BUGS index 4cbbbb8..534f427 100644 --- a/BUGS +++ b/BUGS @@ -42,7 +42,8 @@ KNOWN BUGS OF NO SPECIAL CLASS: program, even if you know or guess enough about the internals of SBCL to wager that this (undefined in ANSI) operation would be safe. -3: +3: "type checking of structure slots" + a: ANSI specifies that a type mismatch in a structure slot initialization value should not cause a warning. WORKAROUND: @@ -78,42 +79,35 @@ WORKAROUND: Such code should compile without complaint and work correctly either on SBCL or on any other completely compliant Common Lisp system. -6: - bogus warnings about undefined functions for magic functions like - SB!C::%%DEFUN and SB!C::%DEFCONSTANT when cross-compiling files - like src/code/float.lisp. Fixing this will probably require - straightening out enough bootstrap consistency issues that - the cross-compiler can run with *TYPE-SYSTEM-INITIALIZED*. - Instead, the cross-compiler runs in a slightly flaky state - which is sane enough to compile SBCL itself, but which is - also unstable in several ways, including its inability - to really grok function declarations. - - As of sbcl-0.7.5, sbcl's cross-compiler does run with - *TYPE-SYSTEM-INITIALIZED*; however, this bug remains. + b: &AUX argument in a boa-constructor without a default value means + "do not initilize this slot" and does not cause type error. But + an error may be signalled at read time and it would be good if + SBCL did it. + + c: Reading of not initialized slot sometimes causes SEGV (for inline + accessors it is fixed, but out-of-line still do not perform type + check). + + d: + (declaim (optimize (safety 3) (speed 1) (space 1))) + (defstruct foo + x y) + (defstruct (stringwise-foo (:include foo + (x "x" :type simple-string) + (y "y" :type simple-string)))) + (defparameter *stringwise-foo* + (make-stringwise-foo)) + (setf (foo-x *stringwise-foo*) 0) + (defun frob-stringwise-foo (sf) + (aref (stringwise-foo-x sf) 0)) + (frob-stringwise-foo *stringwise-foo*) + SEGV. 7: The "compiling top-level form:" output ought to be condensed. Perhaps any number of such consecutive lines ought to turn into a single "compiling top-level forms:" line. -10: - The way that the compiler munges types with arguments together - with types with no arguments (in e.g. TYPE-EXPAND) leads to - weirdness visible to the user: - (DEFTYPE FOO () 'FIXNUM) - (TYPEP 11 'FOO) => T - (TYPEP 11 '(FOO)) => T, which seems weird - (TYPEP 11 'FIXNUM) => T - (TYPEP 11 '(FIXNUM)) signals an error, as it should - The situation is complicated by the presence of Common Lisp types - like UNSIGNED-BYTE (which can either be used in list form or alone) - so I'm not 100% sure that the behavior above is actually illegal. - But I'm 90+% sure, and the following related behavior, - (TYPEP 11 'AND) => T - treating the bare symbol AND as equivalent to '(AND), is specifically - forbidden (by the ANSI specification of the AND type). - 11: It would be nice if the caught ERROR: @@ -135,16 +129,6 @@ WORKAROUND: (FORMAT NIL "~,1G" 1.4) => "1. " (FORMAT NIL "~3,1G" 1.4) => "1. " -20: - from Marco Antoniotti on cmucl-imp mailing list 1 Mar 2000: - (defclass ccc () ()) - (setf (find-class 'ccc1) (find-class 'ccc)) - (defmethod zut ((c ccc1)) 123) - In sbcl-0.7.1.13, this gives an error, - There is no class named CCC1. - DTC's recommended workaround from the mailing list 3 Mar 2000: - (setf (pcl::find-class 'ccc1) (pcl::find-class 'ccc)) - 27: Sometimes (SB-EXT:QUIT) fails with Argh! maximum interrupt nesting depth (4096) exceeded, exiting @@ -198,19 +182,6 @@ WORKAROUND: (Also, verify that the compiler handles declared function return types as assertions.) -41: - TYPEP of VALUES types is sometimes implemented very inefficiently, e.g. in - (DEFTYPE INDEXOID () '(INTEGER 0 1000)) - (DEFUN FOO (X) - (DECLARE (TYPE INDEXOID X)) - (THE (VALUES INDEXOID) - (VALUES X))) - where the implementation of the type check in function FOO - includes a full call to %TYPEP. There are also some fundamental problems - with the interpretation of VALUES types (inherited from CMU CL, and - from the ANSI CL standard) as discussed on the cmucl-imp@cons.org - mailing list, e.g. in Robert Maclachlan's post of 21 Jun 2000. - 42: The definitions of SIGCONTEXT-FLOAT-REGISTER and %SET-SIGCONTEXT-FLOAT-REGISTER in x86-vm.lisp say they're not @@ -219,18 +190,11 @@ WORKAROUND: so they could be supported after all. Very likely SIGCONTEXT-FLOATING-POINT-MODES could now be supported, too. -43: - (as discussed by Douglas Crosher on the cmucl-imp mailing list ca. - Aug. 10, 2000): CMUCL currently interprets 'member as '(member); same - issue with 'union, 'and, 'or etc. So even though according to the - ANSI spec, bare 'MEMBER, 'AND, and 'OR are not legal types, CMUCL - (and now SBCL) interpret them as legal types. - 45: a slew of floating-point-related errors reported by Peter Van Eynde on July 25, 2000: - b: SBCL's value for LEAST-POSITIVE-SHORT-FLOAT is bogus, and - should probably be 1.4012985e-45. In SBCL, + b: SBCL's value for LEAST-POSITIVE-SHORT-FLOAT on the x86 is + bogus, and should probably be 1.4012985e-45. In SBCL, (/ LEAST-POSITIVE-SHORT-FLOAT 2) returns a number smaller than LEAST-POSITIVE-SHORT-FLOAT. Similar problems exist for LEAST-NEGATIVE-SHORT-FLOAT, LEAST-POSITIVE-LONG-FLOAT, @@ -259,30 +223,6 @@ WORKAROUND: not a binary input stream, but instead cheerfully reads from character streams, e.g. (MAKE-STRING-INPUT-STREAM "abc"). -47: - DEFCLASS bugs reported by Peter Van Eynde July 25, 2000: - d: (DEFGENERIC IF (X)) should signal a PROGRAM-ERROR, but instead - causes a COMPILER-ERROR. - -51: - miscellaneous errors reported by Peter Van Eynde July 25, 2000: - a: (PROGN - (DEFGENERIC FOO02 (X)) - (DEFMETHOD FOO02 ((X NUMBER)) T) - (LET ((M (FIND-METHOD (FUNCTION FOO02) - NIL - (LIST (FIND-CLASS (QUOTE NUMBER)))))) - (REMOVE-METHOD (FUNCTION FOO02) M) - (DEFGENERIC FOO03 (X)) - (ADD-METHOD (FUNCTION FOO03) M))) - should give an error, but SBCL allows it. - -52: - It has been reported (e.g. by Peter Van Eynde) that there are - several metaobject protocol "errors". (In order to fix them, we might - need to document exactly what metaobject protocol specification - we're following -- the current code is just inherited from PCL.) - 60: The debugger LIST-LOCATIONS command doesn't work properly. @@ -293,51 +233,6 @@ WORKAROUND: then requesting a BACKTRACE at the debugger prompt gives no information about where in the user program the problem occurred. -62: - The compiler is supposed to do type inference well enough that - the declaration in - (TYPECASE X - ((SIMPLE-ARRAY SINGLE-FLOAT) - (LOCALLY - (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) X)) - ..)) - ..) - is redundant. However, as reported by Juan Jose Garcia Ripoll for - CMU CL, it sometimes doesn't. Adding declarations is a pretty good - workaround for the problem for now, but can't be done by the TYPECASE - macros themselves, since it's too hard for the macro to detect - assignments to the variable within the clause. - Note: The compiler *is* smart enough to do the type inference in - many cases. This case, derived from a couple of MACROEXPAND-1 - calls on Ripoll's original test case, - (DEFUN NEGMAT (A) - (DECLARE (OPTIMIZE SPEED (SAFETY 0))) - (COND ((TYPEP A '(SIMPLE-ARRAY SINGLE-FLOAT)) NIL - (LET ((LENGTH (ARRAY-TOTAL-SIZE A))) - (LET ((I 0) (G2554 LENGTH)) - (DECLARE (TYPE REAL G2554) (TYPE REAL I)) - (TAGBODY - SB-LOOP::NEXT-LOOP - (WHEN (>= I G2554) (GO SB-LOOP::END-LOOP)) - (SETF (ROW-MAJOR-AREF A I) (- (ROW-MAJOR-AREF A I))) - (GO SB-LOOP::NEXT-LOOP) - SB-LOOP::END-LOOP)))))) - demonstrates the problem; but the problem goes away if the TAGBODY - and GO forms are removed (leaving the SETF in ordinary, non-looping - code), or if the TAGBODY and GO forms are retained, but the - assigned value becomes 0.0 instead of (- (ROW-MAJOR-AREF A I)). - -63: - Paul Werkowski wrote on cmucl-imp@cons.org 2000-11-15 - I am looking into this problem that showed up on the cmucl-help - list. It seems to me that the "implementation specific environment - hacking functions" found in pcl/walker.lisp are completely messed - up. The good thing is that they appear to be barely used within - PCL and the munged environment object is passed to cmucl only - in calls to macroexpand-1, which is probably why this case fails. - SBCL uses essentially the same code, so if the environment hacking - is screwed up, it affects us too. - 64: Using the pretty-printer from the command prompt gives funny results, apparently because the pretty-printer doesn't know @@ -381,18 +276,6 @@ WORKAROUND: (partially alleviated in sbcl-0.7.9.32 by a fix by Matthew Danish to make the temporary filename less easily guessable) -82: - Functions are assigned names based on the context in which they're - defined. This is less than ideal for the functions which are - used to implement CLOS methods. E.g. the output of - (DESCRIBE 'PRINT-OBJECT) lists functions like - # - and - # - It would be better if these functions' names always identified - them as methods, and identified their generic functions and - specializers. - 83: RANDOM-INTEGER-EXTRA-BITS=10 may not be large enough for the RANDOM RNG to be high quality near RANDOM-FIXNUM-MAX; it looks as though @@ -474,7 +357,7 @@ WORKAROUND: As a workaround for the problem, #'(SETF FOO) expressions can be replaced with (EFFICIENT-SETF-FUNCTION FOO), where (defmacro efficient-setf-function (place-function-name) - (or #+sbcl (and (sb-impl::info :function :accessor-for place-function-name) + (or #+sbcl (and (sb-int:info :function :accessor-for place-function-name) ;; a workaround for the problem, encouraging the ;; inline expansion of the structure accessor, so ;; that the compiler can optimize its type test @@ -637,7 +520,6 @@ WORKAROUND: (note the space between the comma and the point) - 143: (reported by Jesse Bouwman 2001-10-24 through the unfortunately prominent SourceForge web/db bug tracking system, which is @@ -660,22 +542,6 @@ WORKAROUND: under OpenBSD 2.9 on my X86 laptop. Do be patient when you try it: it took more than two minutes (but less than five) for me. -144: - (This was once known as IR1-4, but it lived on even after the - IR1 interpreter went to the big bit bucket in the sky.) - The system accepts DECLAIM in most places where DECLARE would be - accepted, without even issuing a warning. ANSI allows this, but since - it's fairly easy to mistype DECLAIM instead of DECLARE, and the - meaning is rather different, and it's unlikely that the user - has a good reason for doing DECLAIM not at top level, it would be - good to issue a STYLE-WARNING when this happens. A possible - fix would be to issue STYLE-WARNINGs for DECLAIMs not at top level, - or perhaps to issue STYLE-WARNINGs for any EVAL-WHEN not at top level. - [This is considered an IR1-interpreter-related bug because until - EVAL-WHEN is rewritten, which won't happen until after the IR1 - interpreter is gone, the system's notion of what's a top-level form - and what's not will remain too confused to fix this problem.] - 145: ANSI allows types `(COMPLEX ,FOO) to use very hairy values for FOO, e.g. (COMPLEX (AND REAL (SATISFIES ODDP))). The old CMU CL @@ -728,10 +594,8 @@ WORKAROUND: expansion, leaving garbage consisting of infinished blocks of the partially converted function.) -157: - Functions SUBTYPEP, TYPEP, UPGRADED-ARRAY-ELEMENT-TYPE, and - UPGRADED-COMPLEX-PART-TYPE should have an optional environment argument. - (reported by Alexey Dejneka sbcl-devel 2002-04-12) + (due to reordering of the compiler this example is compiled + successfully by 0.7.14, but the bug probably remains) 162: (reported by Robert E. Brown 2002-04-16) @@ -807,63 +671,6 @@ WORKAROUND: :ACCRUED-EXCEPTIONS (:INEXACT) :FAST-MODE NIL) -187: "type inference confusion around DEFTRANSFORM time" - (reported even more verbosely on sbcl-devel 2002-06-28 as "strange - bug in DEFTRANSFORM") - After the file below is compiled and loaded in sbcl-0.7.5, executing - (TCX (MAKE-ARRAY 4 :FILL-POINTER 2) 0) - at the REPL returns an adjustable vector, which is wrong. Presumably - somehow the DERIVE-TYPE information for the output values of %WAD is - being mispropagated as a type constraint on the input values of %WAD, - and so causing the type test to be optimized away. It's unclear how - hand-expanding the DEFTRANSFORM would change this, but it suggests - the DEFTRANSFORM machinery (or at least the way DEFTRANSFORMs are - invoked at a particular phase) is involved. - (cl:in-package :sb-c) - (eval-when (:compile-toplevel) - ;;; standin for %DATA-VECTOR-AND-INDEX - (defknown %dvai (array index) - (values t t) - (foldable flushable)) - (deftransform %dvai ((array index) - (vector t) - * - :important t) - (let* ((atype (continuation-type array)) - (eltype (array-type-specialized-element-type atype))) - (when (eq eltype *wild-type*) - (give-up-ir1-transform - "specialized array element type not known at compile-time")) - (when (not (array-type-complexp atype)) - (give-up-ir1-transform "SIMPLE array!")) - `(if (array-header-p array) - (%wad array index nil) - (values array index)))) - ;;; standin for %WITH-ARRAY-DATA - (defknown %wad (array index (or index null)) - (values (simple-array * (*)) index index index) - (foldable flushable)) - ;;; (Commenting out this optimizer causes the bug to go away.) - (defoptimizer (%wad derive-type) ((array start end)) - (let ((atype (continuation-type array))) - (when (array-type-p atype) - (values-specifier-type - `(values (simple-array ,(type-specifier - (array-type-specialized-element-type atype)) - (*)) - index index index))))) - ) ; EVAL-WHEN - (defun %wad (array start end) - (format t "~&in %WAD~%") - (%with-array-data array start end)) - (cl:in-package :cl-user) - (defun tcx (v i) - (declare (type (vector t) v)) - (declare (notinline sb-kernel::%with-array-data)) - ;; (Hand-expending DEFTRANSFORM %DVAI here also causes the bug to - ;; go away.) - (sb-c::%dvai v i)) - 188: "compiler performance fiasco involving type inference and UNION-TYPE" (In sbcl-0.7.6.10, DEFTRANSFORM CONCATENATE was commented out until this bug could be fixed properly, so you won't see the bug unless you restore @@ -901,6 +708,28 @@ WORKAROUND: (INTEGER 1296 1296) ...)>)[:EXTERNAL] + In recent SBCL the following example also illustrates this bug: + + (time (compile + nil + '(lambda () + (declare (optimize (safety 3))) + (declare (optimize (compilation-speed 2))) + (declare (optimize (speed 1) (debug 1) (space 1))) + (let ((start 4)) + (declare (type (integer 0) start)) + (print (incf start 22)) + (print (incf start 26)) + (print (incf start 28))) + (let ((start 6)) + (declare (type (integer 0) start)) + (print (incf start 22)) + (print (incf start 26))) + (let ((start 10)) + (declare (type (integer 0) start)) + (print (incf start 22)) + (print (incf start 26)))))) + 190: "PPC/Linux pipe? buffer? bug" In sbcl-0.7.6, the run-program.test.sh test script sometimes hangs on the PPC/Linux platform, waiting for a zombie env process. This @@ -929,60 +758,6 @@ WORKAROUND: c. the examples in CLHS 7.6.5.1 (regarding generic function lambda lists and &KEY arguments) do not signal errors when they should. -192: "Python treats free type declarations as promises." - b. What seemed like the same fundamental problem as bug 192a, but - was not fixed by the same (APD "more strict type checking - sbcl-devel 2002-08-97) patch: - (DOTIMES (I ...) (DOTIMES (J ...) (DECLARE ...) ...)): - (declaim (optimize (speed 1) (safety 3))) - (defun trust-assertion (i) - (dotimes (j i) - (declare (type (mod 4) i)) ; when commented out, behavior changes! - (unless (< i 5) - (print j)))) - (trust-assertion 6) ; prints nothing unless DECLARE is commented out - - (see bug 203) - -194: "no error from (THE REAL '(1 2 3)) in some cases" - fixed parts: - a. In sbcl-0.7.7.9, - (multiple-value-prog1 (progn (the real '(1 2 3)))) - returns (1 2 3) instead of signalling an error. This was fixed by - APD's "more strict type checking patch", but although the fixed - code (in sbcl-0.7.7.19) works (signals TYPE-ERROR) interactively, - it's difficult to write a regression test for it, because - (IGNORE-ERRORS (MULTIPLE-VALUE-PROG1 (PROGN (THE REAL '(1 2 3))))) - still returns (1 2 3). - still-broken parts: - b. (IGNORE-ERRORS (MULTIPLE-VALUE-PROG1 (PROGN (THE REAL '(1 2 3))))) - returns (1 2 3). (As above, this shows up when writing regression - tests for fixed-ness of part a.) - c. Also in sbcl-0.7.7.9, (IGNORE-ERRORS (THE REAL '(1 2 3))) => (1 2 3). - d. At the REPL, - (null (ignore-errors - (let ((arg1 1) - (arg2 (identity (the real #(1 2 3))))) - (if (< arg1 arg2) arg1 arg2)))) - => T - but putting the same expression inside (DEFUN FOO () ...), - (FOO) => NIL. - notes: - * Actually this entry is probably multiple bugs, as - Alexey Dejneka commented on sbcl-devel 2002-09-03:) - I don't think that placing these two bugs in one entry is - a good idea: they have different explanations. The second - (min 1 nil) is caused by flushing of unused code--IDENTITY - can do nothing with it. So it is really bug 122. The first - (min nil) is due to M-V-PROG1: substituting a continuation - for the result, it forgets about type assertion. The purpose - of IDENTITY is to save the restricted continuation from - inaccurate transformations. - * Alexey Dejneka pointed out that - (IGNORE-ERRORS (IDENTITY (THE REAL '(1 2 3)))) - and - (IGNORE-ERRORS (VALUES (THE REAL '(1 2 3)))) - work as they should. 201: "Incautious type inference from compound CONS types" (reported by APD sbcl-devel 2002-09-17) @@ -998,14 +773,6 @@ WORKAROUND: (FOO ' (1 . 2)) => "NIL IS INTEGER, Y = 1" -203: - Compiler does not check THEs on unused values, e.g. in - - (progn (the real (list 1)) t) - - This situation may appear during optimizing away degenerate cases of - certain functions: see bug 192b. - 205: "environment issues in cross compiler" (These bugs have no impact on user code, but should be fixed or documented.) @@ -1038,15 +805,6 @@ WORKAROUND: to redo MIX using a lookup into a 256-entry s-box containing 29-bit pseudorandom numbers? -208: "package confusion in PCL handling of structure slot handlers" - In sbcl-0.7.8 compiling and loading - (in-package :cl) - (defstruct foo (slot (error "missing")) :type list :read-only t) - (defmethod print-object ((foo foo) stream) (print nil stream)) - causes CERROR "attempting to modify a symbol in the COMMON-LISP - package: FOO-SLOT". (This is fairly bad code, but still it's hard - to see that it should cause symbols to be interned in the CL package.) - 211: "keywords processing" a. :ALLOW-OTHER-KEYS T should allow a function to receive an odd number of keyword arguments. @@ -1158,12 +916,6 @@ WORKAROUND: produce invalid code, but type checking is not accurate. Similar problems exist with VALUES-TYPE-INTERSECTION.) -218: "VALUES type specifier semantics" - (THE (VALUES ...) ...) in safe code discards extra values. - - (defun test (x y) (the (values integer) (truncate x y))) - (test 10 4) => 2 - 220: Sbcl 0.7.9 fails to compile @@ -1178,34 +930,142 @@ WORKAROUND: would be to put the check between evaluation of arguments, but it could be tricky to check result types of PROG1, IF etc. -228: "function-lambda-expression problems" - in sbcl-0.7.9.6x, from the REPL: - * (progn (declaim (inline foo)) (defun foo (x) x)) - FOO - * (function-lambda-expression #'foo) - (SB-C:LAMBDA-WITH-LEXENV NIL NIL NIL (X) (BLOCK FOO X)), NIL, FOO - but this first return value is not suitable for input to FUNCTION or - COMPILE, as required by ANSI. - -229: - (subtypep 'function '(function)) => nil, t. - -231: "SETQ does not correctly check the type of a variable being set" - (reported by Robert E. Brown sbcl-devel 2002-12-19) - in sbcl-0.7.10.19, - (DEFUN FOO (X) - (DECLARE (OPTIMIZE SAFETY) (TYPE (INTEGER 0 8) X)) - (INCF X)) - (FOO 8) - returns 9, rather than (as in CMUCL) signalling an error. Replacing - (INCF X) by (SETQ X (+ X 1)) causes a TYPE-ERROR to be signalled. Or - (defun bar (x y) - (declare (type (integer 0 8) x)) - (setq x y) - x) - Then (BAR 7 9) returns 9. - - (fixed in 0.7.10.28) +233: bugs in constraint propagation + a. + (defun foo (x) + (declare (optimize (speed 2) (safety 3))) + (let ((y 0d0)) + (values + (the double-float x) + (setq y (+ x 1d0)) + (setq x 3d0) + (quux y (+ y 2d0) (* y 3d0))))) + (foo 4) => segmentation violation + + (see usage of CONTINUATION-ASSERTED-TYPE in USE-RESULT-CONSTRAINTS) + (see also bug 236) + + b. + (declaim (optimize (speed 2) (safety 3))) + (defun foo (x y) + (if (typep (prog1 x (setq x y)) 'double-float) + (+ x 1d0) + (+ x 2))) + (foo 1d0 5) => segmentation violation + +235: "type system and inline expansion" + a. + (declaim (ftype (function (cons) number) acc)) + (declaim (inline acc)) + (defun acc (c) + (the number (car c))) + + (defun foo (x y) + (values (locally (declare (optimize (safety 0))) + (acc x)) + (locally (declare (optimize (safety 3))) + (acc y)))) + + (foo '(nil) '(t)) => NIL, T. + + b. (reported by brown on #lisp 2003-01-21) + + (defun find-it (x) + (declare (optimize (speed 3) (safety 0))) + (declare (notinline mapcar)) + (let ((z (mapcar #'car x))) + (find 'foobar z))) + + Without (DECLARE (NOTINLINE MAPCAR)), Python cannot derive that Z is + LIST. + +237: "Environment arguments to type functions" + a. Functions SUBTYPEP, TYPEP, UPGRADED-ARRAY-ELEMENT-TYPE, and + UPGRADED-COMPLEX-PART-TYPE now have an optional environment + argument, but they ignore it completely. This is almost + certainly not correct. + b. Also, the compiler's optimizers for TYPEP have not been informed + about the new argument; consequently, they will not transform + calls of the form (TYPEP 1 'INTEGER NIL), even though this is + just as optimizeable as (TYPEP 1 'INTEGER). + +238: "REPL compiler overenthusiasm for CLOS code" + From the REPL, + * (defclass foo () ()) + * (defmethod bar ((x foo) (foo foo)) (call-next-method)) + causes approximately 100 lines of code deletion notes. Some + discussion on this issue happened under the title 'Three "interesting" + bugs in PCL', resulting in a fix for this oververbosity from the + compiler proper; however, the problem persists in the interactor + because the notion of original source is not preserved: for the + compiler, the original source of the above expression is (DEFMETHOD + BAR ((X FOO) (FOO FOO)) (CALL-NEXT-METHOD)), while by the time the + compiler gets its hands on the code needing compilation from the REPL, + it has been macroexpanded several times. + + A symptom of the same underlying problem, reported by Tony Martinez: + * (handler-case + (with-input-from-string (*query-io* " no") + (yes-or-no-p)) + (simple-type-error () 'error)) + ; in: LAMBDA NIL + ; (SB-KERNEL:FLOAT-WAIT) + ; + ; note: deleting unreachable code + ; compilation unit finished + ; printed 1 note + +241: "DEFCLASS mysteriously remembers uninterned accessor names." + (from tonyms on #lisp IRC 2003-02-25) + In sbcl-0.7.12.55, typing + (defclass foo () ((bar :accessor foo-bar))) + (profile foo-bar) + (unintern 'foo-bar) + (defclass foo () ((bar :accessor foo-bar))) + gives the error message + "#:FOO-BAR already names an ordinary function or a macro." + So it's somehow checking the uninterned old accessor name instead + of the new requested accessor name, which seems broken to me (WHN). + +242: "WRITE-SEQUENCE suboptimality" + (observed from clx performance) + In sbcl-0.7.13, WRITE-SEQUENCE of a sequence of type + (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) on a stream with element-type + (UNSIGNED-BYTE 8) will write to the stream one byte at a time, + rather than writing the sequence in one go, leading to severe + performance degradation. + +243: "STYLE-WARNING overenthusiasm for unused variables" + (observed from clx compilation) + In sbcl-0.7.14, in the presence of the macros + (DEFMACRO FOO (X) `(BAR ,X)) + (DEFMACRO BAR (X) (DECLARE (IGNORABLE X)) 'NIL) + somewhat surprising style warnings are emitted for + (COMPILE NIL '(LAMBDA (Y) (FOO Y))): + ; in: LAMBDA (Y) + ; (LAMBDA (Y) (FOO Y)) + ; + ; caught STYLE-WARNING: + ; The variable Y is defined but never used. + +245: bugs in disassembler + a. On X86 an immediate operand for IMUL is printed incorrectly. + b. On X86 operand size prefix is not recognized. + +248: "reporting errors in type specifier syntax" + (TYPEP 1 '(SYMBOL NIL)) says something about "unknown type + specifier". + +251: + (defun foo (&key (a :x)) + (declare (fixnum a)) + a) + + does not cause a warning. (BTW: old SBCL issued a warning, but for a + function, which was never called!) + +255: + (fixed in 0.8.0.57) DEFUNCT CATEGORIES OF BUGS IR1-#: