diff --git a/assembly/ppc/array.lisp b/assembly/ppc/array.lisp index 0887e0494c6e9ff12432d125cf3ea40020c8e02f..65b5cd7dbfc52250974f8e2bb3a60413595fd42b 100644 --- a/assembly/ppc/array.lisp +++ b/assembly/ppc/array.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/array.lisp,v 1.3 2004/08/08 11:15:11 rtoy Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/array.lisp,v 1.4 2004/09/08 02:10:54 rtoy Exp $ ;;; ;;; This file contains the support routines for arrays and vectors. ;;; @@ -65,6 +65,7 @@ (inst b sxhash-simple-substring-entry)) +#+nil (define-assembly-routine (sxhash-simple-substring (:translate %sxhash-simple-substring) (:policy :fast-safe) @@ -109,3 +110,61 @@ (inst slwi result accum 5) (inst srwi result result 3)) + +;; One-at-a-time hash algorithm. See assembly/sparc/array.lisp for a +;; description. + +(define-assembly-routine (sxhash-simple-substring + (:translate %sxhash-simple-substring) + (:policy :fast-safe) + (:arg-types * positive-fixnum) + (:result-types positive-fixnum)) + ((:arg string descriptor-reg a0-offset) + (:arg length any-reg a1-offset) + (:res result any-reg a0-offset) + + (:temp accum non-descriptor-reg nl0-offset) + (:temp data non-descriptor-reg nl1-offset) + (:temp temp non-descriptor-reg nl2-offset) + (:temp offset non-descriptor-reg nl3-offset)) + (emit-label sxhash-simple-substring-entry) + + (inst li offset (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)) + (move accum zero-tn) + (inst b test) + + LOOP + + ;; hash += key[i] + (inst add accum accum data) + ;; hash += (hash << 10) + (inst slwi temp accum 10) + (inst add accum accum temp) + + ;; hash ^= (hash >> 6) + (inst srwi temp accum 6) + (inst xor accum accum temp) + (inst addi offset offset 1) + + TEST + + (inst subic. length length (fixnumize 1)) + (inst lbzx data string offset) + (inst bge loop) + + ;; hash += (hash << 3) + (inst slwi temp accum 3) + (inst add accum accum temp) + + ;; hash ^= (hash >> 11) + (inst srwi temp accum 11) + (inst xor accum accum temp) + + ;; hash += (hash << 15); + (inst slwi temp accum 15) + (inst add accum accum temp) + + ;; Make the result a positive fixnum. Shifting it left, then right + ;; does what we want, and extracts the bits we need. + (inst slwi accum accum 3) + (inst srwi result accum 1)) diff --git a/bootfiles/19a/boot6-sxhash.lisp b/bootfiles/19a/boot6-sxhash.lisp new file mode 100644 index 0000000000000000000000000000000000000000..40456cf890d480f466a961292a1689979d5f0309 --- /dev/null +++ b/bootfiles/19a/boot6-sxhash.lisp @@ -0,0 +1,6 @@ +;;; Cross-compile bootstrap file for new sxhash function. +;;; +;;; Nothing fancy needed. Just load up the default cross-compile script. + +#+ppc +(load "target:tools/cross-scripts/cross-ppc-ppc-darwin") diff --git a/code/hash-new.lisp b/code/hash-new.lisp index 3513ddb23b2bd092b7cdd4dd11b0af9262fa9122..17d4d1058266f7df75e2c35b9cd2d65d4db32ff0 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.32 2004/06/09 14:50:05 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.33 2004/09/08 02:10:54 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -929,8 +929,8 @@ (sxhash-instance s-expr))) ;; Other-pointer types. (simple-string (sxhash-simple-string s-expr)) - (symbol #-(or sparc x86) (sxhash-simple-string (symbol-name s-expr)) - #+(or sparc x86) (sxhash s-expr)) + (symbol #-(or sparc x86 ppc) (sxhash-simple-string (symbol-name s-expr)) + #+(or sparc x86 ppc) (sxhash s-expr)) (number (etypecase s-expr (integer (ldb sxhash-bits-byte s-expr)) diff --git a/code/symbol.lisp b/code/symbol.lisp index fb8fd78823f563a3f5e4b92917df2e35603110b9..237558b41fead757434e1f8e758360966a71bc69 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.37 2004/06/10 01:36:09 cwang Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/symbol.lisp,v 1.38 2004/09/08 02:10:54 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -96,18 +96,18 @@ (defun make-symbol (string) "Make and return a new symbol with the STRING as its print name." - #-(or gengc x86 amd64 sparc) (make-symbol string) + #-(or gengc x86 amd64 sparc ppc) (make-symbol string) #+gengc (%make-symbol (random most-positive-fixnum) string) ;; Initialize the symbol-hash to -1 to make this fast. It will get ;; computed correctly later on. - #+(or sparc x86 amd64) (%make-symbol -1 string)) + #+(or sparc x86 amd64 ppc) (%make-symbol -1 string)) -#+(or gengc x86 amd64 sparc) +#+(or gengc x86 amd64 sparc ppc) (defun symbol-hash (symbol) "Return the hash value for symbol." (symbol-hash symbol)) -#+sparc +#+(or sparc ppc) (defun (setf symbol-hash) (symbol hash) (kernel::%set-symbol-hash symbol hash)) diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp index 5df92fe7f13349580eae47437a4db5fe0eb496b4..2048cb036152a30bf4520b118b6130dcc5ad4e00 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.72 2004/08/20 22:54:06 cwang Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.73 2004/09/08 02:10:55 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -589,9 +589,10 @@ (write-indexed symbol vm:symbol-value-slot unbound-marker) (when (or (c:backend-featurep :x86) (c:backend-featurep :amd64) - (c:backend-featurep :sparc)) - (let ((offset #+(or x86 amd64 sparc) vm:symbol-hash-slot - #-(or x86 amd64 sparc) vm:symbol-unused-slot) + (c:backend-featurep :sparc) + (c:backend-featurep :ppc)) + (let ((offset #+(or x86 amd64 sparc ppc) vm:symbol-hash-slot + #-(or x86 amd64 sparc ppc) vm:symbol-unused-slot) (value (sxhash name))) (write-indexed symbol offset (make-fixnum-descriptor value)))) diff --git a/compiler/generic/objdef.lisp b/compiler/generic/objdef.lisp index 2fba6103c8ef15eebe88bddc88a15c5ad60327f5..2c035608ee5e3c3d2ef546ddd3d1f63a3d687dec 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.57 2004/07/25 18:15:52 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.58 2004/09/08 02:10:55 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -466,15 +466,15 @@ ;;;; Symbols -#+(or gengc sparc x86 amd64) +#+(or gengc sparc x86 amd64 ppc) (defknown %make-symbol (fixnum simple-string) symbol (flushable movable)) -#+(or gengc sparc x86 amd64) +#+(or gengc sparc x86 amd64 ppc) (defknown symbol-hash (symbol) fixnum (flushable movable)) -#+(or gencgc sparc x86 amd64) +#+(or gencgc sparc x86 amd64 ppc) (defknown %set-symbol-hash (symbol index) t (unsafe)) @@ -488,12 +488,12 @@ (define-primitive-object (symbol :lowtag other-pointer-type :header symbol-header-type :alloc-trans - #-(or gengc x86 amd64 sparc) make-symbol - #+(or gengc x86 amd64 sparc) %make-symbol) + #-(or gengc x86 amd64 sparc ppc) make-symbol + #+(or gengc x86 amd64 sparc ppc) %make-symbol) (value :set-trans %set-symbol-value :init :unbound) - #-(or gengc x86 amd64 sparc) unused - #+(or gengc x86 amd64 sparc) + #-(or gengc x86 amd64 sparc ppc) unused + #+(or gengc x86 amd64 sparc ppc) (hash :init :arg) (plist :ref-trans symbol-plist :set-trans %set-symbol-plist diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp index 05ecee30cebb990db47a7431901a3cb4c87b10d4..cab9b020ba741beafe5a1d42a469329f52b81999 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.54 2004/06/10 01:46:47 cwang Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.55 2004/09/08 02:10:55 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -424,11 +424,11 @@ (deftransform sxhash ((s-expr) (simple-string)) '(%sxhash-simple-string s-expr)) -#-(or sparc x86 amd64) +#-(or sparc x86 amd64 ppc) (deftransform sxhash ((s-expr) (symbol)) '(%sxhash-simple-string (symbol-name s-expr))) -#+(or sparc x86 amd64) +#+(or sparc x86 amd64 ppc) (deftransform sxhash ((s-expr) (symbol)) ;; Pick off the constant case first. (Important!) (if (constant-continuation-p s-expr) diff --git a/compiler/globaldb.lisp b/compiler/globaldb.lisp index 1c7faab4713099ff69d24fcafbbfdbefa5fac145..dd3d2490b3d63edf42e3b72ac06248d1c9e42bcc 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.50 2004/05/24 22:52:34 cwang Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.51 2004/09/08 02:10:55 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -289,8 +289,8 @@ (defun info-hash (x) (cond ((symbolp x) - #-(or gengc x86 amd64 sparc) (%sxhash-simple-string (symbol-name x)) - #+(or gengc x86 amd64 sparc) (sxhash x)) + #-(or gengc x86 amd64 sparc ppc) (%sxhash-simple-string (symbol-name x)) + #+(or gengc x86 amd64 sparc ppc) (sxhash x)) ((and (listp x) (eq (car x) 'setf) (let ((next (cdr x))) @@ -299,8 +299,8 @@ (when (and (symbolp name) (null (cdr next))) (let ((sym name)) (declare (symbol sym)) - (logxor #-(or gengc x86 amd64 sparc) (%sxhash-simple-string (symbol-name sym)) - #+(or gengc x86 amd64 sparc) (sxhash sym) + (logxor #-(or gengc x86 amd64 sparc ppc) (%sxhash-simple-string (symbol-name sym)) + #+(or gengc x86 amd64 sparc ppc) (sxhash sym) 110680597)))))))) (t (sxhash x)))) diff --git a/compiler/ppc/cell.lisp b/compiler/ppc/cell.lisp index 6400cc650b2936880ac7995f3a97d1d556e0bcdf..1dce5911134229cf9da82619669395b4ad1fa30d 100644 --- a/compiler/ppc/cell.lisp +++ b/compiler/ppc/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/ppc/cell.lisp,v 1.2 2004/07/25 18:15:52 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/cell.lisp,v 1.3 2004/09/08 02:10:55 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -92,6 +92,23 @@ (: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 tagged-num) + (: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 clrrwi res res 2))) + +(define-vop (%set-symbol-hash cell-set) + (:translate %set-symbol-hash) + (:variant symbol-hash-slot other-pointer-type)) + ;;;; Fdefinition (fdefn) objects.