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