X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=BUGS;h=688b166181bee55cfced8fab477492679086b8f7;hb=61c18727668ff0c3263a3d363e609d4522d545cc;hp=bb197f8558447122a7bc67baa77a92d2a4e3b4b4;hpb=583e68ba34023bf5f1fdce3aa7e643fb097cc9ae;p=sbcl.git diff --git a/BUGS b/BUGS index bb197f8..688b166 100644 --- a/BUGS +++ b/BUGS @@ -32,8 +32,6 @@ have gone away (typically because they were fixed, but sometimes for other reasons, e.g. because they were moved elsewhere). -KNOWN BUGS OF NO SPECIAL CLASS: - 2: DEFSTRUCT almost certainly should overwrite the old LAYOUT information instead of just punting when a contradictory structure definition @@ -84,59 +82,13 @@ WORKAROUND: 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. - - 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. - -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. + d: (fixed in 0.8.1.5) 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: @@ -146,28 +98,12 @@ WORKAROUND: (during macroexpansion of IN-PACKAGE, during macroexpansion of DEFFOO) -15: - (SUBTYPEP '(FUNCTION (T BOOLEAN) NIL) - '(FUNCTION (FIXNUM FIXNUM) NIL)) => T, T - (Also, when this is fixed, we can enable the code in PROCLAIM which - checks for incompatible FTYPE redeclarations.) - 19: (I *think* this is a bug. It certainly seems like strange behavior. But the ANSI spec is scary, dark, and deep.. -- WHN) (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 @@ -221,19 +157,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 @@ -242,22 +165,9 @@ 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, - (/ 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, - and LEAST-NEGATIVE-LONG-FLOAT. c: Many expressions generate floating infinity on x86/Linux: (/ 1 0.0) (/ 1 0.0d0) @@ -276,38 +186,16 @@ WORKAROUND: 46: type safety errors reported by Peter Van Eynde July 25, 2000: - c: (COERCE 'AND 'FUNCTION) returns something related to - (MACRO-FUNCTION 'AND), but ANSI says it should raise an error. k: READ-BYTE is supposed to signal TYPE-ERROR when its argument is 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.) + string-input streams, e.g. (MAKE-STRING-INPUT-STREAM "abc"). + [ Bug was reported as "from character streams", but in 0.8.3.10 we + get correct behaviour from (WITH-OPEN-FILE (i "/dev/zero") (READ-BYTE i)) ] + 60: The debugger LIST-LOCATIONS command doesn't work properly. + (How should it work properly?) 61: Compiling and loading @@ -316,17 +204,6 @@ WORKAROUND: then requesting a BACKTRACE at the debugger prompt gives no information about where in the user program the problem occurred. -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 @@ -341,12 +218,6 @@ WORKAROUND: crashes SBCL. In general tracing anything which is used in the implementation of TRACE is likely to have the same problem. -75: - As reported by Martin Atzmueller on sbcl-devel 26 Dec 2000, - ANSI says that WITH-OUTPUT-TO-STRING should have a keyword - :ELEMENT-TYPE, but in sbcl-0.6.9 this is not defined for - WITH-OUTPUT-TO-STRING. - 78: ANSI says in one place that type declarations can be abbreviated even when the type name is not a symbol, e.g. @@ -370,18 +241,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 @@ -406,34 +265,6 @@ WORKAROUND: holding... * is not equivalent to T in many cases, such as (VECTOR *) /= (VECTOR T). -94a: - Inconsistencies between derived and declared VALUES return types for - DEFUN aren't checked very well. E.g. the logic which successfully - catches problems like - (declaim (ftype (function (fixnum) float) foo)) - (defun foo (x) - (declare (type integer x)) - (values x)) ; wrong return type, detected, gives warning, good! - fails to catch - (declaim (ftype (function (t) (values t t)) bar)) - (defun bar (x) - (values x)) ; wrong number of return values, no warning, bad! - The cause of this is seems to be that (1) the internal function - VALUES-TYPES-EQUAL-OR-INTERSECT used to make the check handles its - arguments symmetrically, and (2) when the type checking code was - written back when when SBCL's code was still CMU CL, the intent - was that this case - (declaim (ftype (function (t) t) bar)) - (defun bar (x) - (values x x)) ; wrong number of return values; should give warning? - not be warned for, because a two-valued return value is considered - to be compatible with callers who expects a single value to be - returned. That intent is probably not appropriate for modern ANSI - Common Lisp, but fixing this might be complicated because of other - divergences between auld-style and new-style handling of - multiple-VALUES types. (Some issues related to this were discussed - on cmucl-imp at some length sometime in 2000.) - 95: The facility for dumping a running Lisp image to disk gets confused when run without the PURIFY option, and creates an unnecessarily large @@ -450,20 +281,31 @@ WORKAROUND: so the compiler doesn't compile the type test into code, but instead just saves the type in a lexical closure and interprets it at runtime. - A proper solution involves deciding whether it's really worth - saving space by implementing structure slot accessors as closures. - (If it's not worth it, the problem vanishes automatically. If it - is worth it, there are hacks we could use to force type tests to - be compiled anyway, and even shared. E.g. we could implement - an EQUAL hash table mapping from types to compiled type tests, - and save the appropriate compiled type test as part of each lexical - closure; or we could make the lexical closures be placeholders - which overwrite their old definition as a lexical closure with - a new compiled definition the first time that they're called.) - As a workaround for the problem, #'(SETF FOO) expressions can - be replaced with (EFFICIENT-SETF-FUNCTION FOO), where + To exercise the problem, compile and load + (cl:in-package :cl-user) + (defstruct foo + (bar (error "missing") :type bar)) + (defvar *foo*) + (defun wastrel1 (x) + (loop (setf (foo-bar *foo*) x))) + (defstruct bar) + (defvar *bar* (make-bar)) + (defvar *foo* (make-foo :bar *bar*)) + (defvar *setf-foo-bar* #'(setf foo-bar)) + (defun wastrel2 (x) + (loop (funcall *setf-foo-bar* x *foo*))) + then run (WASTREL1 *BAR*) or (WASTREL2 *BAR*), hit Ctrl-C, and + use BACKTRACE, to see it's spending all essentially all its time + in %TYPEP and VALUES-SPECIFIER-TYPE and so forth. + One possible solution would be simply to give up on + representing structure slot accessors as functions, and represent + them as macroexpansions instead. This can be inconvenient for users, + but it's not clear that it's worse than trying to help by expanding + into a horribly inefficient implementation. + 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 @@ -519,6 +361,8 @@ WORKAROUND: your pre-0.7.0 state of grace with #+sbcl (declaim (notinline find position find-if position-if)) ; bug 117.. + (see also bug 279) + 118: as reported by Eric Marsden on cmucl-imp@cons.org 2001-08-14: (= (FLOAT 1 DOUBLE-FLOAT-EPSILON) @@ -648,23 +492,8 @@ 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: + a. ANSI allows types `(COMPLEX ,FOO) to use very hairy values for FOO, e.g. (COMPLEX (AND REAL (SATISFIES ODDP))). The old CMU CL COMPLEX implementation didn't deal with this, and hasn't been @@ -672,6 +501,8 @@ WORKAROUND: conformance problem, since seems hard to construct useful code where it matters.) + b. (fixed in 0.8.3.43) + 146: Floating point errors are reported poorly. E.g. on x86 OpenBSD with sbcl-0.7.1, @@ -684,38 +515,6 @@ WORKAROUND: See also bugs #45.c and #183 -148: - In sbcl-0.7.1.3 on x86, COMPILE-FILE on the file - (in-package :cl-user) - (defvar *thing*) - (defvar *zoom*) - (defstruct foo bar bletch) - (defun %zeep () - (labels ((kidify1 (kid) - ) - (kid-frob (kid) - (if *thing* - (setf sweptm - (m+ (frobnicate kid) - sweptm)) - (kidify1 kid)))) - (declare (inline kid-frob)) - (map nil - #'kid-frob - (the simple-vector (foo-bar perd))))) - fails with - debugger invoked on condition of type TYPE-ERROR: - The value NIL is not of type SB-C::NODE. - The location of this failure has moved around as various related - issues were cleaned up. As of sbcl-0.7.1.9, it occurs in - NODE-BLOCK called by LAMBDA-COMPONENT called by IR2-CONVERT-CLOSURE. - - (Python LET-converts KIDIFY1 into KID-FROB, then tries to inline - expand KID-FROB into %ZEEP. Having partially done it, it sees a call - of KIDIFY1, which already does not exist. So it gives up on - expansion, leaving garbage consisting of infinished blocks of the - partially converted function.) - 162: (reported by Robert E. Brown 2002-04-16) When a function is called with too few arguments, causing the @@ -736,6 +535,8 @@ WORKAROUND: isn't too surprising since there are many differences in stack implementation and GC conservatism between the X86 and other ports.) + This is probably the same bug as 216 + 167: In sbcl-0.7.3.11, compiling the (illegal) code (in-package :cl-user) @@ -790,99 +591,35 @@ 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 - the DEFTRANSFORM by hand.) In sbcl-0.7.5.11 on a 700 MHz Pentium III, (time (compile nil '(lambda () - (declare (optimize (safety 3))) - (declare (optimize (compilation-speed 2))) - (declare (optimize (speed 1) (debug 1) (space 1))) - (let ((fn "if-this-file-exists-the-universe-is-strange")) - (load fn :if-does-not-exist nil) - (load (concatenate 'string fn ".lisp") :if-does-not-exist nil) - (load (concatenate 'string fn ".fasl") :if-does-not-exist nil) - (load (concatenate 'string fn ".misc-garbage") - :if-does-not-exist nil))))) - reports - 134.552 seconds of real time - 133.35156 seconds of user run time - 0.03125 seconds of system run time - [Run times include 2.787 seconds GC run time.] - 0 page faults and - 246883368 bytes consed. - BACKTRACE from Ctrl-C in the compilation shows that the compiler is - thinking about type relationships involving types like - #)[:EXTERNAL] + (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)))))) + + This example could be solved with clever enough constraint + propagation or with SSA, but consider + + (let ((x 0)) + (loop (incf x 2))) + + The careful type of X is {2k} :-(. Is it really important to be + able to work with unions of many intervals? 190: "PPC/Linux pipe? buffer? bug" In sbcl-0.7.6, the run-program.test.sh test script sometimes hangs @@ -912,68 +649,8 @@ 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) - - c. (defun foo (x y) - (locally (declare (type fixnum x y)) - (+ x (* 2 y)))) - (foo 1.1 2) => 5.1 - -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) +201: "Incautious type inference from compound types" + a. (reported by APD sbcl-devel 2002-09-17) (DEFUN FOO (X) (LET ((Y (CAR (THE (CONS INTEGER *) X)))) (SETF (CAR X) NIL) @@ -986,13 +663,16 @@ 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. + b. + * (defun foo (x) + (declare (type (array * (4 4)) x)) + (let ((y x)) + (setq x (make-array '(4 4))) + (adjust-array y '(3 5)) + (= (array-dimension y 0) (eval `(array-dimension ,y 0))))) + FOO + * (foo (make-array '(4 4) :adjustable t)) + NIL 205: "environment issues in cross compiler" (These bugs have no impact on user code, but should be fixed or @@ -1026,15 +706,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. @@ -1082,20 +753,6 @@ WORKAROUND: (INTEGERP (CAR (MAKE-SEQUENCE '(CONS INTEGER *) 2))) can erroneously return T. -214: - SBCL 0.6.12.43 fails to compile - - (locally - (declare (optimize (inhibit-warnings 0) (compilation-speed 2))) - (flet ((foo (&key (x :vx x-p)) (list x x-p))) - (foo 1 2))) - - or a more simple example: - - (locally - (declare (optimize (inhibit-warnings 0) (compilation-speed 2))) - (lambda (x) (declare (fixnum x)) (if (< x 0) 0 (1- x)))) - 215: ":TEST-NOT handling by functions" a. FIND and POSITION currently signal errors when given non-NIL for both their :TEST and (deprecated) :TEST-NOT arguments, but by @@ -1120,6 +777,8 @@ WORKAROUND: the bad VECTOR-PUSH-EXTEND frame causes GC problems, though that may not be the actual problem. (CMU CL 18c doesn't have problems with this.) + This is probably the same bug as 162 + 217: "Bad type operations with FUNCTION types" In sbcl.0.7.7: @@ -1143,58 +802,9 @@ WORKAROUND: Then (FOO #\1 *STANDARD-OUTPUT*) signals type error. (In 0.7.9.1 the result type is (FUNCTION * *), so Python does not - 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 - - (multiple-value-call #'list - (the integer (helper)) - nil) - - Type check for INTEGER, the result of which serves as the first - argument of M-V-C, is inserted after evaluation of NIL. So arguments - of M-V-C are pushed in the wrong order. As a temporary workaround - type checking was disabled for M-V-Cs in 0.7.9.13. A better solution - would be to put the check between evaluation of arguments, but it - could be tricky to check result types of PROG1, IF etc. - -229: - (subtypep 'function '(function)) => nil, t. - -231: "SETQ does not correctly check the type of a variable being set" - b. - (defun foo (x z) - (declare (type integer x)) - (locally (declare (type (real 1) x)) - (setq x z)) - (list x z)) - (foo 0 0) => (0 0). - - (fixed in 0.7.12.8) + produce invalid code, but type checking is not accurate.) 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) @@ -1203,9 +813,6 @@ WORKAROUND: (+ x 2))) (foo 1d0 5) => segmentation violation -234: - (fixed in sbcl-0.7.10.36) - 235: "type system and inline expansion" a. (declaim (ftype (function (cons) number) acc)) @@ -1221,34 +828,6 @@ WORKAROUND: (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. - -236: "THE semantics is broken" - - (defun foo (a f) - (declare (optimize (speed 2) (safety 0))) - (+ 1d0 - (the double-float - (multiple-value-prog1 - (svref a 0) - (unless f (return-from foo 0)))))) - - (foo #(4) nil) => SEGV - - VOP selection thinks that in unsafe code result type assertions - should be valid immediately. (See also bug 233a.) - - The similar problem exists for TRULY-THE. - 237: "Environment arguments to type functions" a. Functions SUBTYPEP, TYPEP, UPGRADED-ARRAY-ELEMENT-TYPE, and UPGRADED-COMPLEX-PART-TYPE now have an optional environment @@ -1273,28 +852,395 @@ WORKAROUND: compiler gets its hands on the code needing compilation from the REPL, it has been macroexpanded several times. -239: - Since 0.7.0: - (defun foo (bit-array-2 &optional result-bit-array) - (declare (type (array bit) bit-array-2) - (type (or (array bit) (member t nil)) result-bit-array)) - (unless (simple-bit-vector-p bit-array-2) - (multiple-value-call - (lambda (data1 start1) - (multiple-value-call - (lambda (data2 start2) - (multiple-value-call - (lambda (data3 start3) - (declare (ignore start3)) - (print (list data1 data2))) - (values 0 0))) - (values bit-array-2 0))) - (values 444 0)))) - - Then (foo (make-array 4 :element-type 'bit :adjustable t) nil) - must return the same value as it prints, but it returns random garbage. - -DEFUNCT CATEGORIES OF BUGS - IR1-#: - These labels were used for bugs related to the old IR1 interpreter. - The # values reached 6 before the category was closed down. + 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!) + +256: + Compiler does not emit warnings for + + a. (lambda () (svref (make-array 8 :adjustable t) 1)) + + b. (lambda (x) + (list (let ((y (the real x))) + (unless (floatp y) (error "")) + y) + (integer-length x))) + + c. (lambda (x) + (declare (optimize (debug 0))) + (declare (type vector x)) + (list (fill-pointer x) + (svref x 1))) + +257: + Complex array type does not have corresponding type specifier. + + This is a problem because the compiler emits optimization notes when + you use a non-simple array, and without a type specifier for hairy + array types, there's no good way to tell it you're doing it + intentionally so that it should shut up and just compile the code. + + Another problem is confusing error message "asserted type ARRAY + conflicts with derived type (VALUES SIMPLE-VECTOR &OPTIONAL)" during + compiling (LAMBDA (V) (VALUES (SVREF V 0) (VECTOR-POP V))). + + The last problem is that when type assertions are converted to type + checks, types are represented with type specifiers, so we could lose + complex attribute. (Now this is probably not important, because + currently checks for complex arrays seem to be performed by + callees.) + +259: + (compile nil '(lambda () (aref (make-array 0) 0))) compiles without + warning. Analogous cases with the index and length being equal and + greater than 0 are warned for; the problem here seems to be that the + type required for an array reference of this type is (INTEGER 0 (0)) + which is canonicalized to NIL. + +260: + a. + (let* ((s (gensym)) + (t1 (specifier-type s))) + (eval `(defstruct ,s)) + (type= t1 (specifier-type s))) + => NIL, NIL + + (fixed in 0.8.1.24) + + b. The same for CSUBTYPEP. + +261: + * (let () (list (the (values &optional fixnum) (eval '(values))))) + debugger invoked on condition of type TYPE-ERROR: + The value NIL is not of type FIXNUM. + +262: "yet another bug in inline expansion of local functions" + Compiler fails on + + (defun foo (x y) + (declare (integer x y)) + (+ (block nil + (flet ((xyz (u) + (declare (integer u)) + (if (> (1+ (the unsigned-byte u)) 0) + (+ 1 u) + (return (+ 38 (cos (/ u 78))))))) + (declare (inline xyz)) + (return-from foo + (* (funcall (eval #'xyz) x) + (if (> x 30) + (funcall (if (> x 5) #'xyz #'identity) + (+ x 13)) + 38))))) + (sin (* x y)))) + + Urgh... It's time to write IR1-copier. + +265: + SB-EXT:RUN-PROGRAM is currently non-functional on Linux/PPC; + attempting to use it leads to segmentation violations. This is + probably because of a bogus implementation of + os_restore_fp_control(). + +266: + David Lichteblau provided (sbcl-devel 2003-06-01) a patch to fix + behaviour of streams with element-type (SIGNED-BYTE 8). The patch + looks reasonable, if not obviously correct; however, it caused the + PPC/Linux port to segfault during warm-init while loading + src/pcl/std-class.fasl. A workaround patch was made, but it would + be nice to understand why the first patch caused problems, and to + fix the cause if possible. + +268: "wrong free declaration scope" + The following code must signal type error: + + (locally (declare (optimize (safety 3))) + (flet ((foo (x &optional (y (car x))) + (declare (optimize (safety 0))) + (list x y))) + (funcall (eval #'foo) 1))) + +269: + SCALE-FLOAT should accept any integer for its second argument. + +270: + In the following function constraint propagator optimizes nothing: + + (defun foo (x) + (declare (integer x)) + (declare (optimize speed)) + (typecase x + (fixnum "hala") + (fixnum "buba") + (bignum "hip") + (t "zuz"))) + +273: + Compilation of the following two forms causes "X is unbound" error: + + (symbol-macrolet ((x pi)) + (macrolet ((foo (y) (+ x y))) + (declaim (inline bar)) + (defun bar (z) + (* z (foo 4))))) + (defun quux (z) + (bar z)) + + (See (COERCE (CDR X) 'FUNCTION) in IR1-CONVERT-INLINE-LAMBDA.) + +274: + CLHS says that type declaration of a symbol macro should not affect + its expansion, but in SBCL it does. (If you like magic and want to + fix it, don't forget to change all uses of MACROEXPAND to + MACROEXPAND*.) + +275: + The following code (taken from CLOCC) takes a lot of time to compile: + + (defun foo (n) + (declare (type (integer 0 #.large-constant) n)) + (expt 1/10 n)) + + (fixed in 0.8.2.51, but a test case would be good) + +276: + (defmethod fee ((x fixnum)) + (setq x (/ x 2)) + x) + (fee 1) => type error + + (taken from CLOCC) + +278: + a. + (defun foo () + (declare (optimize speed)) + (loop for i of-type (integer 0) from 0 by 2 below 10 + collect i)) + + uses generic arithmetic. + + b. (fixed in 0.8.3.6) + +279: type propagation error -- correctly inferred type goes astray? + In sbcl-0.8.3 and sbcl-0.8.1.47, the warning + The binding of ABS-FOO is a (VALUES (INTEGER 0 0) + &OPTIONAL), not a (INTEGER 1 536870911) + is emitted when compiling this file: + (declaim (ftype (function ((integer 0 #.most-positive-fixnum)) + (integer #.most-negative-fixnum 0)) + foo)) + (defun foo (x) + (- x)) + (defun bar (x) + (let* (;; Uncomment this for a type mismatch warning indicating + ;; that the type of (FOO X) is correctly understood. + #+nil (fs-foo (float-sign (foo x))) + ;; Uncomment this for a type mismatch warning + ;; indicating that the type of (ABS (FOO X)) is + ;; correctly understood. + #+nil (fs-abs-foo (float-sign (abs (foo x)))) + ;; something wrong with this one though + (abs-foo (abs (foo x)))) + (declare (type (integer 1 100) abs-foo)) + (print abs-foo))) + + (see also bug 117) + +280: bogus WARNING about duplicate function definition + In sbcl-0.8.3 and sbcl-0.8.1.47, if BS.MIN is defined inline, + e.g. by + (declaim (inline bs.min)) + (defun bs.min (bases) nil) + before compiling the file below, the compiler warns + Duplicate definition for BS.MIN found in one static + unit (usually a file). + when compiling + (declaim (special *minus* *plus* *stagnant*)) + (defun b.*.min (&optional (x () xp) (y () yp) &rest rest) + (bs.min avec)) + (define-compiler-macro b.*.min (&rest rest) + `(bs.min ,@rest)) + (defun afish-d-rbd (pd) + (if *stagnant* + (b.*.min (foo-d-rbd *stagnant*)) + (multiple-value-bind (reduce-fn initial-value) + (etypecase pd + (list (values #'bs.min 0)) + (vector (values #'bs.min *plus*))) + (let ((cv-ks (cv (kpd.ks pd)))) + (funcall reduce-fn d-rbds))))) + (defun bfish-d-rbd (pd) + (if *stagnant* + (b.*.min (foo-d-rbd *stagnant*)) + (multiple-value-bind (reduce-fn initial-value) + (etypecase pd + (list (values #'bs.min *minus*)) + (vector (values #'bs.min 0))) + (let ((cv-ks (cv (kpd.ks pd)))) + (funcall reduce-fn d-rbds))))) + +281: COMPUTE-EFFECTIVE-METHOD error signalling. + (slightly obscured by a non-0 default value for + SB-PCL::*MAX-EMF-PRECOMPUTE-METHODS*) + It would be natural for COMPUTE-EFFECTIVE-METHOD to signal errors + when it finds a method with invalid qualifiers. However, it + shouldn't signal errors when any such methods are not applicable to + the particular call being evaluated, and certainly it shouldn't when + simply precomputing effective methods that may never be called. + (setf sb-pcl::*max-emf-precompute-methods* 0) + (defgeneric foo (x) + (:method-combination +) + (:method ((x symbol)) 1) + (:method + ((x number)) x)) + (foo 1) -> ERROR, but should simply return 1 + + The issue seems to be that construction of a discriminating function + calls COMPUTE-EFFECTIVE-METHOD with methods that are not all applicable. + +283: Thread safety: libc functions + There are places that we call unsafe-for-threading libc functions + that we should find alternatives for, or put locks around. Known or + strongly suspected problems, as of 0.8.3.10: please update this + bug instead of creating new ones + + localtime() - called for timezone calculations in code/time.lisp + +284: Thread safety: special variables + There are lots of special variables in SBCL, and I feel sure that at + least some of them are indicative of potentially thread-unsafe + parts of the system. See doc/internals/notes/threading-specials + +286: "recursive known functions" + Self-call recognition conflicts with known function + recognition. Currently cross compiler and target COMPILE do not + recognize recursion, and in target compiler it can be disabled. We + can always disable it for known functions with RECURSIVE attribute, + but there remains a possibility of a function with a + (tail)-recursive simplification pass and transforms/VOPs for base + cases. + +287: PPC/Linux miscompilation or corruption in first GC + When the runtime is compiled with -O3 on certain PPC/Linux machines, a + segmentation fault is reported at the point of first triggered GC, + during the compilation of DEFSTRUCT WRAPPER. As a temporary workaround, + the runtime is no longer compiled with -O3 on PPC/Linux, but it is likely + that this merely obscures, not solves, the underlying problem; as and when + underlying problems are fixed, it would be worth trying again to provoke + this problem. + +288: fundamental cross-compilation issues (from old UGLINESS file) + 288a: Using host floating point numbers to represent target + floating point numbers, or host characters to represent + target characters, is theoretically shaky. (The characters + are OK as long as the characters are in the ANSI-guaranteed + character set, though, so they aren't a real problem as + long as the sources don't need anything but that.) + 288b: The compiler still makes assumptions about cross-compilation-host + implementation of ANSI CL: + 288b1: Simple bit vectors are distinct from simple vectors (in + DEFINE-STORAGE-BASE and elsewhere). (Actually, I'm not *sure* + that things would really break if this weren't so, but I + strongly suspect that they would.) + 288b2: SINGLE-FLOAT is distinct from DOUBLE-FLOAT. (This is + in a sense just one aspect of bug 288a.) + +289: "type checking and source-transforms" + a. + (block nil (let () (funcall #'+ (eval 'nil) (eval '1) (return :good)))) + signals type error. + + Our policy is to check argument types at the moment of a call. It + disagrees with ANSI, which says that type assertions are put + immediately onto argument expressions, but is easier to implement in + IR1 and is more compatible to type inference, inline expansion, + etc. IR1-transforms automatically keep this policy, but source + transforms for associative functions (such as +), being applied + during IR1-convertion, do not. It may be tolerable for direct calls + (+ x y z), but for (FUNCALL #'+ x y z) it is non-conformant. + + b. Another aspect of this problem is efficiency. [x y + z +] + requires less registers than [x y z + +]. This transformation is + currently performed with source transforms, but it would be good to + also perform it in IR1 optimization phase. + +290: Alpha floating point and denormalized traps + In SBCL 0.8.3.6x on the alpha, we work around what appears to be a + hardware or kernel deficiency: the status of the enable/disable + denormalized-float traps bit seems to be ambiguous; by the time we + get to os_restore_fp_control after a trap, denormalized traps seem + to be enabled. Since we don't want a trap every time someone uses a + denormalized float, in general, we mask out that bit when we restore + the control word; however, this clobbers any change the user might + have made. + +295: + From Paul Dietz: + + (ash -1000000000000 -10000000000000000000) ==> 0 ;; should be -1 + +296: + (reported by Adam Warner, sbcl-devel 2003-09-23) + + The --load toplevel argument does not perform any sanitization of its + argument. As a result, files with Lisp pathname pattern characters + (#\* or #\?, for instance) or quotation marks can cause the system + to perform arbitrary behaviour.