From: William Harold Newman Date: Sat, 12 Oct 2002 15:51:35 +0000 (+0000) Subject: 0.7.8.31: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=42b8c7570a2faa21529fadeef84a0caea186aa8c;p=sbcl.git 0.7.8.31: cleaned up my make-fill-pointer-output-stream-lazy-about-checking-arguments fix from 0.7.8.24 (in response to CSR's remarks on IRC) made CROSS-TYPEP deal with error signaled in SATISFIES testing removed no-op TRANSLATE in SB!XC:TYPE-OF as per FIXME added more BUGS entries --- diff --git a/BUGS b/BUGS index e932280..10082dc 100644 --- a/BUGS +++ b/BUGS @@ -1236,6 +1236,32 @@ WORKAROUND: Enabling :SB-FLUID in the target-features list in sbcl-0.7.8 breaks the build. +207: "poorly distributed SXHASH results for compound data" + SBCL's SXHASH could probably try a little harder. ANSI: "the + intent is that an implementation should make a good-faith + effort to produce hash-codes that are well distributed + within the range of non-negative fixnums". But + (let ((hits (make-hash-table))) + (dotimes (i 16) + (dotimes (j 16) + (let* ((ij (cons i j)) + (newlist (push ij (gethash (sxhash ij) hits)))) + (when (cdr newlist) + (format t "~&collision: ~S~%" newlist)))))) + reports lots of collisions in sbcl-0.7.8. A stronger MIX function + would be an obvious way of fix. Maybe it would be acceptably efficient + 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.) + DEFUNCT CATEGORIES OF BUGS IR1-#: These labels were used for bugs related to the old IR1 interpreter. diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp index 7fc1393..e4031af 100644 --- a/src/code/cross-type.lisp +++ b/src/code/cross-type.lisp @@ -66,29 +66,27 @@ (warn "possible floating point information loss in ~S" call))) (defun sb!xc:type-of (object) - (labels (;; FIXME: This function is a no-op now that we no longer - ;; have a distinct package T%CL to translate - ;; for-the-target-Lisp CL symbols to, and should go away - ;; completely. - (translate (expr) expr)) - (let ((raw-result (type-of object))) - (cond ((or (subtypep raw-result 'float) - (subtypep raw-result 'complex)) - (warn-possible-cross-type-float-info-loss - `(sb!xc:type-of ,object)) - (translate raw-result)) - ((subtypep raw-result 'integer) - (cond ((<= 0 object 1) - 'bit) - ((fixnump object) - 'fixnum) - (t - 'integer))) - ((some (lambda (type) (subtypep raw-result type)) - '(array character list symbol)) - (translate raw-result)) - (t - (error "can't handle TYPE-OF ~S in cross-compilation")))))) + (let ((raw-result (type-of object))) + (cond ((or (subtypep raw-result 'float) + (subtypep raw-result 'complex)) + (warn-possible-cross-type-float-info-loss + `(sb!xc:type-of ,object)) + raw-result) + ((subtypep raw-result 'integer) + (cond ((<= 0 object 1) + 'bit) + (;; We can't rely on the host's opinion of whether + ;; it's a FIXNUM, but instead test against target + ;; MOST-fooITIVE-FIXNUM limits. + (fixnump object) + 'fixnum) + (t + 'integer))) + ((some (lambda (type) (subtypep raw-result type)) + '(array character list symbol)) + raw-result) + (t + (error "can't handle TYPE-OF ~S in cross-compilation"))))) ;;; Is SYMBOL in the CL package? Note that we're testing this on the ;;; cross-compilation host, which could do things any old way. In @@ -278,11 +276,20 @@ (destructuring-bind (predicate-name) rest (if (and (in-cl-package-p predicate-name) (fboundp predicate-name)) - ;; Many things like KEYWORDP, ODDP, PACKAGEP, + ;; Many predicates like KEYWORDP, ODDP, PACKAGEP, ;; and NULL correspond between host and target. - (values (not (null (funcall predicate-name - host-object))) - t) + ;; But we still need to handle errors, because + ;; the code which calls us may not understand + ;; that a type is unreachable. (E.g. when compiling + ;; (AND STRING (SATISFIES ARRAY-HAS-FILL-POINTER-P)) + ;; CTYPEP may be called on the SATISFIES expression + ;; even for non-STRINGs.) + (multiple-value-bind (result error?) + (ignore-errors (funcall predicate-name + host-object)) + (if error? + (values nil nil) + (values result t))) ;; For symbols not in the CL package, it's not ;; in general clear how things correspond ;; between host and target, so we punt. diff --git a/src/code/describe.lisp b/src/code/describe.lisp index b937104..584e709 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -185,7 +185,7 @@ (:function (if name (format s "Function: ~S" x) (format s "~S is a function." x)))) - (format s "~@:_Its associated name (as in ~S) is ~S." + (format s "~@:_~@" 'function-lambda-expression (%fun-name x)) (case (widetag-of x) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 2b2cc12..29b8b21 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -1185,20 +1185,21 @@ ;;; the CLM, but they are required for the implementation of ;;; WITH-OUTPUT-TO-STRING. +(deftype string-with-fill-pointer () + '(and string + (satisfies array-has-fill-pointer-p))) + (defstruct (fill-pointer-output-stream (:include ansi-stream (out #'fill-pointer-ouch) (sout #'fill-pointer-sout) (misc #'fill-pointer-misc)) - (:constructor %make-fill-pointer-output-stream (string)) + (:constructor make-fill-pointer-output-stream (string)) (:copier nil)) ;; a string with a fill pointer where we stuff the stuff we write - (string (error "missing argument") :type string :read-only t)) - -(defun make-fill-pointer-output-stream (string) - (declare (type string string)) - (fill-pointer string) ; called for side effect of checking has-fill-pointer - (%make-fill-pointer-output-stream string)) + (string (error "missing argument") + :type string-with-fill-pointer + :read-only t)) (defun fill-pointer-ouch (stream character) (let* ((buffer (fill-pointer-output-stream-string stream)) diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp index 5fb9762..347fc5c 100644 --- a/src/code/target-sxhash.lisp +++ b/src/code/target-sxhash.lisp @@ -26,9 +26,9 @@ ;;; desiderata: ;;; * Non-commutativity keeps us from hashing e.g. #(1 5) to the ;;; same value as #(5 1), and ending up in real trouble in some -;;; special cases like bit vectors the way that CMUCL SXHASH 18b +;;; special cases like bit vectors the way that CMUCL 18b SXHASH ;;; does. (Under CMUCL 18b, SXHASH of any bit vector is 1..) -;;; * We'd like to scatter our hash values the entire possible range +;;; * We'd like to scatter our hash values over the entire possible range ;;; of values instead of hashing small or common key values (like ;;; 2 and NIL and #\a) to small FIXNUMs the way that the CMUCL 18b ;;; SXHASH function does, again helping to avoid pathologies like diff --git a/version.lisp-expr b/version.lisp-expr index e633c5b..921468e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; internal versions off the main CVS branch, it gets hairier, e.g. ;;; "0.pre7.14.flaky4.13".) -"0.7.8.30" +"0.7.8.31"