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