diff --git a/compiler/globaldb.lisp b/compiler/globaldb.lisp index ba4f5415291b2def757775aa7611c5b8b5e077f1..5c4b06ce3f4653b5621e041003abc79afff53a72 100644 --- a/compiler/globaldb.lisp +++ b/compiler/globaldb.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.16 1991/01/02 19:15:35 ram Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.17 1991/01/30 01:23:35 ram Exp $ ;;; ;;; This file provides a functional interface to global information about ;;; named things in the system. Information is considered to be global if it @@ -636,6 +636,10 @@ ;;; it has, then build the result. This code assumes that all the entries for ;;; a name well be iterated over contiguously, which holds true for the ;;; implementation of iteration over both kinds of environments. +;;; +;;; When building the table, we sort the entries by POINTER< in an attempt +;;; to preserve any VM locality present in the original load order, rather than +;;; randomizing with the original hash function. ;;; (defun compact-info-environment (env &key (name (info-env-name env))) "Return a new compact info environment that holds the same information as @@ -643,29 +647,38 @@ (let ((name-count 0) (prev-name 0) (entry-count 0)) - (do-info (env :name name) - (unless (eq name prev-name) - (incf name-count) - (setq prev-name name)) - (incf entry-count)) - - (let* ((table-size - (primify - (+ (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))) - - (let ((prev-name 0) - (entries-idx 0)) + (collect ((names)) + (let ((types ())) (do-info (env :name name :type-number num :value value) - (unless (eq prev-name name) + (unless (eq name prev-name) + (incf name-count) + (unless (eql prev-name 0) + (names (cons prev-name types))) (setq prev-name name) - (let* ((hash (info-hash name)) + (setq types ())) + (incf entry-count) + (push (cons num value) types)) + (unless (eql prev-name 0) + (names (cons prev-name types)))) + + (let* ((table-size + (primify + (+ (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) #'(lambda (x y) + (< (%primitive make-fixnum x) + (%primitive make-fixnum y)))))) + (let ((entries-idx 0)) + (dolist (types sorted) + (let* ((name (first types)) + (hash (info-hash name)) (len-2 (- table-size 2)) (hash2 (- len-2 (rem hash len-2)))) (do ((probe (rem hash table-size) @@ -677,26 +690,27 @@ (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)))) + 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))) - (setf (aref entries-info entries-idx) num) - (setf (aref entries entries-idx) value) - (incf entries-idx))) - - (unless (zerop entry-count) - (setf (aref entries-info (1- entry-count)) - (logior (aref entries-info (1- entry-count)) - compact-info-entry-last))) - - (make-compact-info-env :name name - :table table - :index index - :entries entries - :entries-info entries-info)))) + (unless (zerop entry-count) + (setf (aref entries-info (1- entry-count)) + (logior (aref entries-info (1- entry-count)) + compact-info-entry-last))) + + (make-compact-info-env :name name + :table table + :index index + :entries entries + :entries-info entries-info))))))