X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=b0decc0481a83f8bb1bfb2c32b26213db94a177e;hb=af178240ffbda39e9c3bf584ad8ed0adcf4b6abd;hp=18c0ebbc50256c1b7c761755192f58c97fb4e02e;hpb=7a896fb715ceac43581a9a3835418e615002f9ec;p=sbcl.git diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index 18c0ebb..b0decc0 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -54,18 +54,19 @@ ;;; aren't used too early in cold boot for SXHASH to run). #!-sb-fluid (declaim (inline globaldb-sxhashoid)) (defun globaldb-sxhashoid (x) - (cond ((symbolp x) (sxhash x)) - ((and (listp x) - (eq (first x) 'setf) - (let ((rest (rest x))) - (and (symbolp (car rest)) - (null (cdr rest))))) - ;; We need to declare the type of the value we're feeding to - ;; SXHASH so that the DEFTRANSFORM on symbols kicks in. - (let ((symbol (second x))) - (declare (symbol symbol)) - (logxor (sxhash symbol) 110680597))) - (t (sxhash x)))) + (logand sb!xc:most-positive-fixnum + (cond ((symbolp x) (sxhash x)) + ((and (listp x) + (eq (first x) 'setf) + (let ((rest (rest x))) + (and (symbolp (car rest)) + (null (cdr rest))))) + ;; We need to declare the type of the value we're feeding to + ;; SXHASH so that the DEFTRANSFORM on symbols kicks in. + (let ((symbol (second x))) + (declare (symbol symbol)) + (logxor (sxhash symbol) 110680597))) + (t (sxhash x))))) ;;; Given any non-negative integer, return a prime number >= to it. ;;; @@ -371,7 +372,7 @@ (n-info-types '*info-types*)) `(dotimes (,n-index (length ,n-table)) (declare (type index ,n-index)) - (block ,PUNT + (block ,punt (let ((,name-var (svref ,n-table ,n-index))) (unless (eql ,name-var 0) (do-anonymous ((,n-type (aref ,n-entries-index ,n-index) @@ -393,7 +394,7 @@ ,@body (unless (zerop (logand ,n-info compact-info-entry-last)) - (return-from ,PUNT)))))))))))))) + (return-from ,punt)))))))))))))) ;;; Return code to iterate over a volatile info environment. (defun do-volatile-info (name-var class-var type-var type-number-var value-var @@ -476,7 +477,19 @@ ;;;; compact info environments ;;; The upper limit on the size of the ENTRIES vector in a COMPACT-INFO-ENV. -(def!constant compact-info-env-entries-bits 16) +;;; +;;; "Why (U-B 28)?", you might wonder. Originally this was (U-B 16), +;;; presumably to ensure that the arrays of :ELEMENT-TYPE +;;; COMPACT-INFO-ENTRIES-INDEX could use a more space-efficient representation. +;;; It turns out that a environment of of only 65536 entries is insufficient in +;;; the modern world (see message from Cyrus Harmon to sbcl-devel, "Subject: +;;; purify failure when compact-info-env-entries-bits is too small"). Using +;;; (U-B 28) instead of (U-B 29) is to avoid the need for bignum overflow +;;; checks, a probably pointless micro-optimization. Hardcoding the amount of +;;; bits instead of deriving it from SB!VM::N-WORD-BITS is done to allow +;;; use of a more efficient array representation on 64-bit platforms. +;;; -- JES, 2005-04-06 +(def!constant compact-info-env-entries-bits 28) (deftype compact-info-entries-index () `(unsigned-byte ,compact-info-env-entries-bits)) ;;; the type of the values in COMPACT-INFO-ENTRIES-INFO @@ -538,18 +551,6 @@ ;;; GLOBALDB-SXHASHOID of NAME. (defun compact-info-lookup (env name hash) (declare (type compact-info-env env) - ;; FIXME: this used to read (TYPE INDEX HASH), but that was - ;; wrong, because HASH was a positive fixnum, not a (MOD - ;; MOST-POSITIVE-FIXNUM). - ;; - ;; However, this, its replacement, is also wrong. In the - ;; cross-compiler, GLOBALDB-SXHASHOID is essentially - ;; SXHASH. But our host compiler could have any value at - ;; all as its MOST-POSITIVE-FIXNUM, and so could in - ;; principle return a value exceeding our target positive - ;; fixnum range. - ;; - ;; My brain hurts. -- CSR, 2003-08-28 (type (integer 0 #.sb!xc:most-positive-fixnum) hash)) (let* ((table (compact-info-env-table env)) (len (length table)) @@ -713,7 +714,6 @@ ;;; Just like COMPACT-INFO-LOOKUP, only do it on a volatile environment. (defun volatile-info-lookup (env name hash) (declare (type volatile-info-env env) - ;; FIXME: see comment in COMPACT-INFO-LOOKUP (type (integer 0 #.sb!xc:most-positive-fixnum) hash)) (let ((table (volatile-info-env-table env))) (macrolet ((lookup (test) @@ -906,7 +906,6 @@ ;;; the current environment, allowing any inherited info to become ;;; visible. We return true if there was any info. (defun clear-info (class type name) - #!+sb-doc (let ((info (type-info-or-lose class type))) (clear-info-value name (type-info-number info)))) #!-sb-fluid @@ -1279,6 +1278,11 @@ :type :info :type-spec t :default nil) +(define-info-type + :class :typed-structure + :type :documentation + :type-spec (or string null) + :default nil) (define-info-class :declaration) (define-info-type