0.9.0.38:

[sbcl.git] / src / compiler / globaldb.lisp

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index 18c0ebb..b0decc0 100644 (file)
--- 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