From 53dfabafa120f20e3e928ff05ac8242de7ee7791 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Mon, 17 May 2004 17:22:31 +0000 Subject: [PATCH] Implement lazy computation of the symbol hash. The hash is set to zero on creation, and is computed when sxhash is called, which is then cached. --- code/exports.lisp | 4 ++-- code/symbol.lisp | 8 +++++--- compiler/generic/objdef.lisp | 6 +++++- compiler/generic/vm-tran.lisp | 17 +++++++++++++++-- compiler/globaldb.lisp | 12 +++++++----- compiler/sparc/cell.lisp | 7 ++++++- compiler/x86/cell.lisp | 7 ++++++- 7 files changed, 46 insertions(+), 15 deletions(-) diff --git a/code/exports.lisp b/code/exports.lisp index 2d457c84b..8e97580c6 100644 --- a/code/exports.lisp +++ b/code/exports.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/exports.lisp,v 1.229 2004/03/23 12:16:47 emarsden Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.230 2004/05/17 17:22:29 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1863,7 +1863,7 @@ "%SET-SAP-REF-SAP" "%SET-SAP-REF-SINGLE" "%SET-SIGNED-SAP-REF-16" "%SET-SIGNED-SAP-REF-32" "%SET-SIGNED-SAP-REF-64" "%SET-SIGNED-SAP-REF-8" - "%SET-STACK-REF" "%SIN" "%SIN-QUICK" + "%SET-STACK-REF" "%SIN" "%SET-SYMBOL-HASH" "%SIN-QUICK" "%SINGLE-FLOAT" "%SINH" "%SP-SET-DEFINITION" "%SP-SET-PLIST" "%SQRT" "%SXHASH-SIMPLE-STRING" "%SXHASH-SIMPLE-SUBSTRING" "%TAN" "%TAN-QUICK" diff --git a/code/symbol.lisp b/code/symbol.lisp index 2eca7d75c..0899e9112 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.34 2004/05/15 18:30:46 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/symbol.lisp,v 1.35 2004/05/17 17:22:30 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -98,7 +98,9 @@ "Make and return a new symbol with the STRING as its print name." #-(or gengc x86 sparc) (make-symbol string) #+gengc (%make-symbol (random most-positive-fixnum) string) - #+(or sparc x86) (%make-symbol (sxhash string) string)) + ;; Initialize the symbol-hash to 0 to make this fast. It will get + ;; computed correctly later on. + #+(or sparc x86) (%make-symbol 0 string)) #+(or gengc x86 sparc) (defun symbol-hash (symbol) @@ -107,7 +109,7 @@ #+sparc (defun (setf symbol-hash) (symbol hash) - (%set-symbol-hash symbol hash)) + (kernel::%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 diff --git a/compiler/generic/objdef.lisp b/compiler/generic/objdef.lisp index 310285962..0d32974fe 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.52 2004/05/15 18:30:47 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.53 2004/05/17 17:22:30 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -474,6 +474,10 @@ (defknown symbol-hash (symbol) index (flushable movable)) +#+(or gencgc sparc x86) +(defknown %set-symbol-hash (symbol index) + t (unsafe)) + #+(and nil x86) (defknown symbol-hash (symbol) lisp::hash (flushable movable)) diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp index 130d16258..a2aab9cd9 100644 --- a/compiler/generic/vm-tran.lisp +++ b/compiler/generic/vm-tran.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/vm-tran.lisp,v 1.50 2004/05/14 14:48:39 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.51 2004/05/17 17:22:30 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -427,10 +427,23 @@ #-sparc (deftransform sxhash ((s-expr) (symbol)) '(%sxhash-simple-string (symbol-name s-expr))) -#+sparc + +#+nil (deftransform sxhash ((s-expr) (symbol)) '(kernel:symbol-hash s-expr)) +#+sparc +(deftransform sxhash ((s-expr) (symbol)) + (if (constant-continuation-p s-expr) + (sxhash (continuation-value s-expr)) + '(let ((result (symbol-hash s-expr))) + (if (<= result 0) + (let ((sxhash (%sxhash-simple-string (symbol-name s-expr)))) + (%set-symbol-hash s-expr sxhash) + sxhash) + result)))) + + (deftransform sxhash ((s-expr) (single-float)) '(let ((bits (single-float-bits s-expr))) diff --git a/compiler/globaldb.lisp b/compiler/globaldb.lisp index fa99fd554..15fb6c2f9 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.48 2004/05/14 13:40:18 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.49 2004/05/17 17:22:30 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -290,16 +290,18 @@ (cond ((symbolp x) #-(or gengc x86 sparc) (%sxhash-simple-string (symbol-name x)) - #+(or gengc x86 sparc) (symbol-hash x)) + #+(or gengc x86 sparc) (sxhash 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 sparc) (%sxhash-simple-string (symbol-name name)) - #+(or gengc x86 sparc) (symbol-hash name) - 110680597))))))) + (let ((sym name)) + (declare (symbol sym)) + (logxor #-(or gengc x86 sparc) (%sxhash-simple-string (symbol-name sym)) + #+(or gengc x86 sparc) (sxhash sym) + 110680597)))))))) (t (sxhash x)))) diff --git a/compiler/sparc/cell.lisp b/compiler/sparc/cell.lisp index e53fc190b..f81ece49f 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.24 2004/05/14 13:40:19 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/cell.lisp,v 1.25 2004/05/17 17:22:30 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -104,6 +104,11 @@ ;; a fixnum. (loadw res symbol symbol-hash-slot other-pointer-type) (inst andn res vm:fixnum-tag-mask))) + +(define-vop (%set-symbol-hash cell-set) + (:translate %set-symbol-hash) + (:variant symbol-hash-slot other-pointer-type)) + ;;;; Fdefinition (fdefn) objects. diff --git a/compiler/x86/cell.lisp b/compiler/x86/cell.lisp index 1be1b6472..9ec64d9c9 100644 --- a/compiler/x86/cell.lisp +++ b/compiler/x86/cell.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/cell.lisp,v 1.13 2003/08/03 11:27:45 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/cell.lisp,v 1.14 2004/05/17 17:22:31 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -147,6 +147,11 @@ (loadw res symbol symbol-hash-slot other-pointer-type) (inst and res (lognot #b11)))) + +(define-vop (%set-symbol-hash cell-set) + (:translate %set-symbol-hash) + (:variant symbol-hash-slot other-pointer-type)) + ;;;; Fdefinition (fdefn) objects. -- GitLab