From 4d7bf80f5df2b1c17f39c7bf7361fc51d57dc739 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Fri, 14 May 2004 13:40:19 +0000
Subject: [PATCH] Add support for storing the symbol hash into a slot in the
 symbol itself.  Only for sparc currently.

Doesn't lazily compute the symbol hash yet.  Simple test shows a 5%
increase in compilation speed, despite making make-symbol
significantly slower.


	* src/code/hash-new.lisp (internal-sxhash): Use the symbol-hash
	slot instead of computing the hash value.

	* src/compiler/generic/new-genesis.lisp (allocate-symbol): Write
	out the sxhash value of the symbol into the symbol-hash slot.

	* src/compiler/globaldb.lisp (info-hash): Update to use the symbol
	hash instead of computing the sxhash.

	* src/code/symbol.lisp (make-symbol): Compute the symbol hash when
	creating the symbol.

	* src/compiler/sparc/cell.lisp ((symbol-hash)): Add vop to extract
	out the symbol hash from a symbol.

	* src/compiler/generic/objdef.lisp: Rename the unused slot to
	hash, so we can make it the symbol hash.
---
 code/hash-new.lisp                |  5 +++--
 code/symbol.lisp                  | 13 +++++++++----
 compiler/generic/new-genesis.lisp | 15 ++++++++++-----
 compiler/generic/objdef.lisp      | 15 ++++++++-------
 compiler/globaldb.lisp            | 10 +++++-----
 compiler/sparc/cell.lisp          | 14 +++++++++++++-
 6 files changed, 48 insertions(+), 24 deletions(-)

diff --git a/code/hash-new.lisp b/code/hash-new.lisp
index a6595f31d..12629a84e 100644
--- a/code/hash-new.lisp
+++ b/code/hash-new.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.28 2003/12/01 22:08:11 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.29 2004/05/14 13:40:18 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -929,7 +929,8 @@
 	 (sxhash-instance s-expr)))
     ;; Other-pointer types.
     (simple-string (sxhash-simple-string s-expr))
-    (symbol (sxhash-simple-string (symbol-name s-expr)))
+    (symbol #-sparc (sxhash-simple-string (symbol-name s-expr))
+	    #+sparc (kernel:symbol-hash s-expr))
     (number
      (etypecase s-expr
        (integer (ldb sxhash-bits-byte s-expr))
diff --git a/code/symbol.lisp b/code/symbol.lisp
index 063f9df29..6193f2ac3 100644
--- a/code/symbol.lisp
+++ b/code/symbol.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/symbol.lisp,v 1.32 2003/04/16 14:04:50 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/symbol.lisp,v 1.33 2004/05/14 13:40:18 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -96,14 +96,19 @@
 
 (defun make-symbol (string)
   "Make and return a new symbol with the STRING as its print name."
-  #-gengc (make-symbol string)
-  #+gengc (%make-symbol (random most-positive-fixnum) string))
+  #-(or gengc sparc) (make-symbol string)
+  #+gengc (%make-symbol (random most-positive-fixnum) string)
+  #+sparc (%make-symbol (sxhash string) string))
 
-#+(or gengc x86)
+#+(or gengc x86 sparc)
 (defun symbol-hash (symbol)
   "Return the hash value for symbol."
   (symbol-hash symbol))
 
+#+sparc
+(defun (setf symbol-hash) (symbol hash)
+  (%set-symbol-hash symbol hash))
+
 (defun get (symbol indicator &optional (default nil))
   "Look on the property list of SYMBOL for the specified INDICATOR.  If this
   is found, return the associated value, else return DEFAULT."
diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp
index 58fce47b1..5e5b750d4 100644
--- a/compiler/generic/new-genesis.lisp
+++ b/compiler/generic/new-genesis.lisp
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.64 2004/01/09 04:52:19 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.65 2004/05/14 13:40:18 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -561,10 +561,15 @@
 		 (or *cold-symbol-allocation-space* *dynamic*)
 		 vm:word-bits (1- vm:symbol-size) vm:symbol-header-type)))
     (write-indexed symbol vm:symbol-value-slot unbound-marker)
-    (when (c:backend-featurep :x86)
-      (write-indexed
-       symbol #+x86 vm:symbol-hash-slot #-x86 vm:symbol-unused-slot
-       (make-fixnum-descriptor (1+ (random vm:target-most-positive-fixnum)))))
+    (when (or (c:backend-featurep :x86)
+	      (c:backend-featurep :sparc))
+      (let ((offset #+(or x86 sparc) vm:symbol-hash-slot
+		    #-(or x86 sparc) vm:symbol-unused-slot)
+	    (value #+x86 (1+ (random vm:target-most-positive-fixnum))
+		   #+sparc (sxhash name)))
+	
+      (write-indexed symbol offset (make-fixnum-descriptor value))))
+
     (write-indexed symbol vm:symbol-plist-slot *nil-descriptor*)
     (write-indexed symbol vm:symbol-name-slot (string-to-core name *dynamic*))
     (write-indexed symbol vm:symbol-package-slot *nil-descriptor*)
diff --git a/compiler/generic/objdef.lisp b/compiler/generic/objdef.lisp
index acba5581d..9a30aa898 100644
--- a/compiler/generic/objdef.lisp
+++ b/compiler/generic/objdef.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.50 2004/05/11 14:36:10 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.51 2004/05/14 13:40:19 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -466,11 +466,11 @@
 
 ;;;; Symbols
 
-#+gengc
+#+(or gengc sparc)
 (defknown %make-symbol (index simple-string) symbol
   (flushable movable))
 
-#+gengc
+#+(or gengc sparc)
 (defknown symbol-hash (symbol) index
   (flushable movable))
 
@@ -481,12 +481,13 @@
 (define-primitive-object (symbol :lowtag other-pointer-type
 				 :header symbol-header-type
 				 #-x86 :alloc-trans
-				 #-(or gengc x86) make-symbol
-				 #+gengc %make-symbol)
+				 #-(or gengc x86 sparc) make-symbol
+				 #+(or gengc sparc) %make-symbol)
   (value :set-trans %set-symbol-value
 	 :init :unbound)
-  #-(or gengc x86) unused
-  #+gengc (hash :init :arg)
+  #-(or gengc x86 sparc) unused
+  #+(or gengc sparc)
+  (hash :init :arg)
   #+x86 (hash)
   (plist :ref-trans symbol-plist
 	 :set-trans %set-symbol-plist
diff --git a/compiler/globaldb.lisp b/compiler/globaldb.lisp
index 92c211405..fa99fd554 100644
--- a/compiler/globaldb.lisp
+++ b/compiler/globaldb.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.47 2004/05/06 14:36:47 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.48 2004/05/14 13:40:18 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -289,16 +289,16 @@
 (defun info-hash (x)
   (cond
    ((symbolp x)
-    #-(or gengc x86) (%sxhash-simple-string (symbol-name x))
-    #+(or gengc x86) (symbol-hash x))
+    #-(or gengc x86 sparc) (%sxhash-simple-string (symbol-name x))
+    #+(or gengc x86 sparc) (symbol-hash x))
    ((and (listp x)
 	 (eq (car x) 'setf)
 	 (let ((next (cdr x)))
 	   (when (listp next)
 	     (let ((name (car next)))
 	       (when (and (symbolp name) (null (cdr next)))
-		 (logxor #-(or gengc x86) (%sxhash-simple-string (symbol-name name))
-			 #+(or gengc x86) (symbol-hash name)
+		 (logxor #-(or gengc x86 sparc) (%sxhash-simple-string (symbol-name name))
+			 #+(or gengc x86 sparc) (symbol-hash name)
 			 110680597)))))))
    (t
     (sxhash x))))
diff --git a/compiler/sparc/cell.lisp b/compiler/sparc/cell.lisp
index 66524cb71..e53fc190b 100644
--- a/compiler/sparc/cell.lisp
+++ b/compiler/sparc/cell.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/cell.lisp,v 1.23 2004/03/29 16:33:46 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/cell.lisp,v 1.24 2004/05/14 13:40:19 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -92,6 +92,18 @@
   (:policy :fast)
   (:translate symbol-value))
 
+(define-vop (symbol-hash)
+  (:policy :fast-safe)
+  (:translate symbol-hash)
+  (:args (symbol :scs (descriptor-reg null)))
+  (:results (res :scs (any-reg)))
+  (:result-types positive-fixnum)
+  (:generator 2
+    ;; the symbol-hash slot of NIL holds NIL because it is also the cdr
+    ;; slot, so we have to strip off the two low bits to make sure it is
+    ;; a fixnum.
+    (loadw res symbol symbol-hash-slot other-pointer-type)
+    (inst andn res vm:fixnum-tag-mask)))
 
 ;;;; Fdefinition (fdefn) objects.
 
-- 
GitLab