From: William Harold Newman Date: Sat, 30 Jun 2001 21:47:55 +0000 (+0000) Subject: 0.6.12.43: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=75d94847e52a0e26dc5eb4d66e78dd823fd93d5b;p=sbcl.git 0.6.12.43: made PEEK-CHAR check its argument type explicitly, so it will issue a TYPE-ERROR on e.g. (WITH-INPUT-FROM-STRING (S "SZ[19]") (PEEK-CHAR S)) instead doing PEEK-CHAR on *STANDARD-INPUT* fixed completely-broken bignum-sized-consing code path in profile.lisp (Code coverage testing? What's that?:-) merged MNA/CMUCL compiler bug collection (sbcl-devel 2001-06-25) to BUGS --- diff --git a/BUGS b/BUGS index 2076479..cf652e8 100644 --- a/BUGS +++ b/BUGS @@ -556,7 +556,7 @@ Error in function C::GET-LAMBDA-TO-COMPILE: rightward of the correct location. 65: - (probably related to bug #70) + (probably related to bug #70; maybe related to bug #109) As reported by Carl Witty on submit@bugs.debian.org 1999-05-08, compiling this file (in-package "CL-USER") @@ -653,7 +653,7 @@ Error in function C::GET-LAMBDA-TO-COMPILE: or at least issue a warning. 70: - (probably related to bug #65) + (probably related to bug #65; maybe related to bug #109) The compiler doesn't like &OPTIONAL arguments in LABELS and FLET forms. E.g. (DEFUN FIND-BEFORE (ITEM SEQUENCE &KEY (TEST #'EQL)) @@ -963,6 +963,131 @@ Error in function C::GET-LAMBDA-TO-COMPILE: time trying to GC afterwards. Surely there's some more economical way to implement (ROOM T). +109: + reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs + collection: + ;;; This file fails to compile. + ;;; Maybe this bug is related to bugs #65, #70 in the BUGS file. + (in-package :cl-user) + (defun tst2 () + (labels + ((eff (&key trouble) + (eff) + ;; nil + ;; Uncomment and it works + )) + (eff))) + In SBCL 0.6.12.42, the problem is + internal error, failed AVER: + "(COMMON-LISP:EQ (SB!C::LAMBDA-TAIL-SET SB!C::CALLER) + (SB!C::LAMBDA-TAIL-SET (SB!C::LAMBDA-HOME SB!C::CALLEE)))" + +110: + reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs + collection: + ;;; The compiler is flushing the argument type test, and the default + ;;; case in the cond, so that calling with say a fixnum 0 causes a + ;;; SIGBUS. + (declaim (optimize (safety 2) (speed 3))) + (defun tst (x) + (declare (type (or string stream) x)) + (cond ((typep x 'string) 'string) + ((typep x 'stream) 'stream) + (t + 'none))) + The symptom in sbcl-0.6.12.42 on OpenBSD is actually (TST 0)=>STREAM + (not the SIGBUS reported in the comment) but that's broken too; + type declarations are supposed to be treated as assertions unless + SAFETY 0, so we should be getting a TYPE-ERROR. + +111: + reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs + collection: + (in-package :cl-user) + ;;; Produces an assertion failures when compiled. + (defun foo (z) + (declare (type (or (function (t) t) null) z)) + (let ((z (or z #'identity))) + (declare (type (function (t) t) z)) + (funcall z 1))) + The error in sbcl-0.6.12.42 is + internal error, failed AVER: + "(COMMON-LISP:NOT (COMMON-LISP:EQ SB!C::CHECK COMMON-LISP:T))" + +112: + reported by Martin Atzmueller 2001-06-25; taken from CMU CL bugs + collection; apparently originally reported by Bruno Haible + (in-package :cl-user) + ;;; From: Bruno Haible + ;;; Subject: scope of SPECIAL declarations + ;;; It seems CMUCL has a bug relating to the scope of SPECIAL + ;;; declarations. I observe this with "CMU Common Lisp 18a x86-linux + ;;; 1.4.0 cvs". + (let ((x 0)) + (declare (special x)) + (let ((x 1)) + (let ((y x)) + (declare (special x)) y))) + ;;; Gives: 0 (this should return 1 according to CLHS) + (let ((x 0)) + (declare (special x)) + (let ((x 1)) + (let ((y x) (x 5)) + (declare (special x)) y))) + ;;; Gives: 1 (correct). + The reported results match what we get from the interpreter + in sbcl-0.6.12.42. + +113: + reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs + collection: + (in-package :cl-user) + ;;; From: David Gadbois + ;;; + ;;; Logical pathnames aren't externalizable. + ;;; Test case: + (let ((tempfile "/tmp/test.lisp")) + (setf (logical-pathname-translations "XXX") + '(("XXX:**;*.*" "/tmp/**/*.*"))) + (with-open-file (out tempfile :direction :output) + (write-string "(defvar *path* #P\"XXX:XXX;FOO.LISP\")" out)) + (compile-file tempfile)) + The error message in sbcl-0.6.12.42 is + ; caught ERROR: + ; (while making load form for #) + ; A logical host can't be dumped as a constant: # + +114: + reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs + collection: + (in-package :cl-user) + ;;; This file causes the byte compiler to fail. + (declaim (optimize (speed 0) (safety 1))) + (defun tst1 () + (values + (multiple-value-list + (catch 'a + (return-from tst1))))) + The error message in sbcl-0.6.12.42 is + internal error, failed AVER: + "(COMMON-LISP:EQUAL (SB!C::BYTE-BLOCK-INFO-START-STACK SB!INT:INFO) SB!C::STACK)" + +115: + reported by Martin Atzmueller 2001-06-25; originally from CMU CL bugs + collection: + (in-package :cl-user) + ;;; The following invokes a compiler error. + (declaim (optimize (speed 2) (debug 3))) + (defun tst () + (flet ((m1 () + (unwind-protect nil))) + (if (catch nil) + (m1) + (m1)))) + The error message in sbcl-0.6.12.42 is + internal error, failed AVER: + "(COMMON-LISP:EQ (SB!C::TN-ENVIRONMENT SB!C:TN) SB!C::TN-ENV)" + KNOWN BUGS RELATED TO THE IR1 INTERPRETER (Note: At some point, the pure interpreter (actually a semi-pure diff --git a/src/code/profile.lisp b/src/code/profile.lisp index c156fdd..a381821 100644 --- a/src/code/profile.lisp +++ b/src/code/profile.lisp @@ -170,13 +170,14 @@ (*enclosed-profiles* 0) (nbf-pcounter *n-bytes-freed-or-purified-pcounter*) ;; Typically NBF-PCOUNTER will represent a bignum. - ;; In general we don't want to cons up a new bignum for every - ;; encapsulated call, so instead we keep track of - ;; the PCOUNTER internals, so that as long as we - ;; only cons small amounts, we'll almost always - ;; just do fixnum arithmetic. (And for encapsulated - ;; functions which cons large amounts, then we don't - ;; much care about a single extra consed bignum.) + ;; In general we don't want to cons up a new + ;; bignum for every encapsulated call, so instead + ;; we keep track of the PCOUNTER internals, so + ;; that as long as we only cons small amounts, + ;; we'll almost always just do fixnum arithmetic. + ;; (And for encapsulated functions which cons + ;; large amounts, then we don't much care about a + ;; single extra consed bignum.) (start-consing-integer (pcounter-integer nbf-pcounter)) (start-consing-fixnum (pcounter-fixnum nbf-pcounter))) (declare (inline pcounter-or-fixnum->integer)) @@ -193,7 +194,8 @@ (- (pcounter-fixnum nbf-pcounter) start-consing-fixnum) (- (get-bytes-consed) - (+ pcounter-integer pcounter-fixnum)))) + (+ (pcounter-integer nbf-pcounter) + (pcounter-fixnum nbf-pcounter))))) (setf inner-enclosed-profiles (pcounter-or-fixnum->integer *enclosed-profiles*)) (let ((net-dticks (fastbig- dticks *enclosed-ticks*))) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 5828180..e9af49c 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -320,7 +320,7 @@ (let ((index (1- (lisp-stream-in-index stream))) (buffer (lisp-stream-in-buffer stream))) (declare (fixnum index)) - (when (minusp index) (error "Nothing to unread.")) + (when (minusp index) (error "nothing to unread")) (cond (buffer (setf (aref buffer index) (char-code character)) (setf (lisp-stream-in-index stream) index)) @@ -334,8 +334,20 @@ (defun peek-char (&optional (peek-type nil) (stream *standard-input*) (eof-error-p t) - eof-value recursive-p) + eof-value + recursive-p) (declare (ignore recursive-p)) + ;; FIXME: The type of PEEK-TYPE is also declared in a DEFKNOWN, but + ;; the compiler doesn't seem to be smart enough to go from there to + ;; imposing a type check. Figure out why (because PEEK-TYPE is an + ;; &OPTIONAL argument?) and fix it, and then this explicit type + ;; check can go away. + (unless (typep peek-type '(or character boolean)) + (error 'simple-type-error + :datum peek-type + :expected-type '(or character boolean) + :format-control "~@" + :format-arguments (list peek-type '(or character boolean)))) (let ((stream (in-synonym-of stream))) (if (lisp-stream-p stream) (let ((char (read-char stream eof-error-p eof-value))) @@ -352,12 +364,15 @@ (unless (eq char eof-value) (unread-char char stream)) char))) - (t + ((null peek-type) (unread-char char stream) - char))) - ;; must be Gray streams FUNDAMENTAL-STREAM + char) + (t + (error "internal error: impossible case")))) + ;; by elimination, must be Gray streams FUNDAMENTAL-STREAM (cond ((characterp peek-type) - (do ((char (stream-read-char stream) (stream-read-char stream))) + (do ((char (stream-read-char stream) + (stream-read-char stream))) ((or (eq char :eof) (char= char peek-type)) (cond ((eq char :eof) (eof-or-lose stream eof-error-p eof-value)) @@ -365,18 +380,21 @@ (stream-unread-char stream char) char))))) ((eq peek-type t) - (do ((char (stream-read-char stream) (stream-read-char stream))) + (do ((char (stream-read-char stream) + (stream-read-char stream))) ((or (eq char :eof) (not (whitespace-char-p char))) (cond ((eq char :eof) (eof-or-lose stream eof-error-p eof-value)) (t (stream-unread-char stream char) char))))) - (t + ((null peek-type) (let ((char (stream-peek-char stream))) (if (eq char :eof) (eof-or-lose stream eof-error-p eof-value) - char))))))) + char))) + (t + (error "internal error: impossible case")))))) (defun listen (&optional (stream *standard-input*)) (let ((stream (in-synonym-of stream))) diff --git a/version.lisp-expr b/version.lisp-expr index 340d216..cd6e51e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -16,4 +16,4 @@ ;;; four numeric fields, is used for versions which aren't released ;;; but correspond only to CVS tags or snapshots. -"0.6.12.42" +"0.6.12.43"