- (+ (truncate (* name-count 100)
- compact-info-environment-density)
- 3)))
- (table (make-array table-size :initial-element 0))
- (index (make-array table-size
- :element-type 'compact-info-entries-index))
- (entries (make-array entry-count))
- (entries-info (make-array entry-count
- :element-type 'compact-info-entry))
- (sorted (sort (names)
- #+sb-xc-host #'<
- ;; (This MAKE-FIXNUM hack implements
- ;; pointer comparison, as explained above.)
- #-sb-xc-host (lambda (x y)
- (< (%primitive make-fixnum x)
- (%primitive make-fixnum y))))))
- (/show0 "done making/sorting vectors in COMPACT-INFO-ENVIRONMENT")
- (let ((entries-idx 0))
- (dolist (types sorted)
- (let* ((name (first types))
- (hash (globaldb-sxhashoid name))
- (len-2 (- table-size 2))
- (hash2 (- len-2 (rem hash len-2))))
- (do ((probe (rem hash table-size)
- (rem (+ probe hash2) table-size)))
- (nil)
- (let ((entry (svref table probe)))
- (when (eql entry 0)
- (setf (svref table probe) name)
- (setf (aref index probe) entries-idx)
- (return))
- (assert (not (equal entry name))))))
-
- (unless (zerop entries-idx)
- (setf (aref entries-info (1- entries-idx))
- (logior (aref entries-info (1- entries-idx))
- compact-info-entry-last)))
-
- (loop for (num . value) in (rest types) do
- (setf (aref entries-info entries-idx) num)
- (setf (aref entries entries-idx) value)
- (incf entries-idx)))
- (/show0 "done w/ DOLIST (TYPES SORTED) in COMPACT-INFO-ENVIRONMENT")
-
- (unless (zerop entry-count)
- (/show0 "nonZEROP ENTRY-COUNT")
- (setf (aref entries-info (1- entry-count))
- (logior (aref entries-info (1- entry-count))
- compact-info-entry-last)))
-
- (/show0 "falling through to MAKE-COMPACT-INFO-ENV")
- (make-compact-info-env :name name
- :table table
- :index index
- :entries entries
- :entries-info entries-info))))))
+ (+ (truncate (* name-count 100)
+ compact-info-environment-density)
+ 3)))
+ (table (make-array table-size :initial-element 0))
+ (index (make-array table-size
+ :element-type 'compact-info-entries-index))
+ (entries (make-array entry-count))
+ (entries-info (make-array entry-count
+ :element-type 'compact-info-entry))
+ (sorted (sort (names)
+ #+sb-xc-host #'<
+ ;; (This MAKE-FIXNUM hack implements
+ ;; pointer comparison, as explained above.)
+ #-sb-xc-host (lambda (x y)
+ (< (%primitive make-fixnum x)
+ (%primitive make-fixnum y))))))
+ (/show0 "done making/sorting vectors in COMPACT-INFO-ENVIRONMENT")
+ (let ((entries-idx 0))
+ (dolist (types sorted)
+ (let* ((name (first types))
+ (hash (globaldb-sxhashoid name))
+ (len-2 (- table-size 2))
+ (hash2 (- len-2 (rem hash len-2))))
+ (do ((probe (rem hash table-size)
+ (rem (+ probe hash2) table-size)))
+ (nil)
+ (let ((entry (svref table probe)))
+ (when (eql entry 0)
+ (setf (svref table probe) name)
+ (setf (aref index probe) entries-idx)
+ (return))
+ (aver (not (equal entry name))))))
+
+ (unless (zerop entries-idx)
+ (setf (aref entries-info (1- entries-idx))
+ (logior (aref entries-info (1- entries-idx))
+ compact-info-entry-last)))
+
+ (loop for (num . value) in (rest types) do
+ (setf (aref entries-info entries-idx) num)
+ (setf (aref entries entries-idx) value)
+ (incf entries-idx)))
+ (/show0 "done w/ DOLIST (TYPES SORTED) in COMPACT-INFO-ENVIRONMENT")
+
+ (unless (zerop entry-count)
+ (/show0 "nonZEROP ENTRY-COUNT")
+ (setf (aref entries-info (1- entry-count))
+ (logior (aref entries-info (1- entry-count))
+ compact-info-entry-last)))
+
+ (/show0 "falling through to MAKE-COMPACT-INFO-ENV")
+ (make-compact-info-env :name name
+ :table table
+ :index index
+ :entries entries
+ :entries-info entries-info))))))