From: Christophe Rhodes Date: Fri, 21 May 2004 12:17:48 +0000 (+0000) Subject: 0.8.10.43: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7a896fb715ceac43581a9a3835418e615002f9ec;p=sbcl.git 0.8.10.43: Use SYMBOL-HASH to cache SXHASH values for symbols ... believe it or not: delete various reader conditionals, special-case code, etc. ... one new VOP needed per-backend: implement on alpha, hppa, mips and sparc; ... add some boilerplate; ... unimplemented on ppc. This will break the build, so with luck it won't be too long before an enterprising user implements it. --- diff --git a/NEWS b/NEWS index b063d62..dea236b 100644 --- a/NEWS +++ b/NEWS @@ -2458,6 +2458,9 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10: so that each expands into only one top-level form in a :LOAD-TOPLEVEL context; this appears to decrease fasl sizes by approximately 10%. + * optimization: used a previously little-used slot in symbols to + cache SXHASH values, yielding a 5-10% compiler speedup. (thanks + to Juho Snellman) * fixed some bugs revealed by Paul Dietz' test suite: ** MAKE-INSTANCES-OBSOLETE returns the class name when called with a symbol. diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index bb19574..833c2b2 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1025,7 +1025,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%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" "%SET-SYMBOL-HASH" "%SIN" "%SIN-QUICK" "%SINGLE-FLOAT" "%SINH" "%SQRT" "%SXHASH-SIMPLE-STRING" "%SXHASH-SIMPLE-SUBSTRING" "%TAN" "%TAN-QUICK" diff --git a/src/code/sxhash.lisp b/src/code/sxhash.lisp index 39ccc47..3ad33ca 100644 --- a/src/code/sxhash.lisp +++ b/src/code/sxhash.lisp @@ -105,6 +105,18 @@ (deftransform sxhash ((x) (symbol)) (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x) (sxhash (lvar-value x)) - '(%sxhash-simple-string (symbol-name x)))) - - + ;; Cache the value of the symbol's sxhash in the symbol-hash slot. + '(let ((result (symbol-hash x))) + ;; 0 marks uninitialized slot. We can't use negative values + ;; for the uninitialized slots since NIL might be located so + ;; high in memory on some platforms that its SYMBOL-HASH + ;; (which contains NIL itself) is a negative fixnum. + (if (= 0 result) + (let ((sxhash (%sxhash-simple-string (symbol-name x)))) + ;; We could do a (logor sxhash #x10000000) to ensure + ;; that we never store a 0 in the slot. However, it's + ;; such an unlikely event (1/5e8?) that it makes more + ;; sense to optimize for the common case... + (%set-symbol-hash x sxhash) + sxhash) + result)))) diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp index e1143df..e24c33e 100644 --- a/src/code/symbol.lisp +++ b/src/code/symbol.lisp @@ -48,22 +48,9 @@ symbol) ;;; Return the built-in hash value for SYMBOL. - -;;; only backends for which a SYMBOL-HASH vop exists. In the past, -;;; when the MIPS backend supported (or nearly did) a generational -;;; (non-conservative) garbage collector, this read (OR X86 MIPS). -;;; Having excised the vestigial support for GENGC, this now only -;;; applies for the x86 port, but if someone were to rework the GENGC -;;; support, this might change again. -- CSR, 2002-08-26 -#!+x86 (defun symbol-hash (symbol) (symbol-hash symbol)) -;;; Compute the hash value for SYMBOL. -#!-x86 -(defun symbol-hash (symbol) - (%sxhash-simple-string (symbol-name symbol))) - (defun symbol-function (symbol) #!+sb-doc "Return SYMBOL's current function definition. Settable with SETF." diff --git a/src/compiler/alpha/cell.lisp b/src/compiler/alpha/cell.lisp index 24bfb51..3220e7d 100644 --- a/src/compiler/alpha/cell.lisp +++ b/src/compiler/alpha/cell.lisp @@ -86,6 +86,20 @@ (:variant symbol-value-slot other-pointer-lowtag) (:policy :fast) (:translate symbol-value)) + +(define-vop (symbol-hash) + (:policy :fast-safe) + (:translate symbol-hash) + (:args (symbol :scs (descriptor-reg))) + (: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. The lowtag selection magic that is required to + ;; ensure this is explained in the comment in objdef.lisp + (loadw res symbol symbol-hash-slot other-pointer-lowtag) + (inst bic res #.(ash lowtag-mask -1) res))) ;;;; fdefinition (FDEFN) objects diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index dac2900..7ef58ec 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -798,11 +798,9 @@ (1- sb!vm:symbol-size) sb!vm:symbol-header-widetag))) (write-wordindexed symbol sb!vm:symbol-value-slot *unbound-marker*) - #!+x86 (write-wordindexed symbol sb!vm:symbol-hash-slot - (make-fixnum-descriptor - (1+ (random sb!xc:most-positive-fixnum)))) + (make-fixnum-descriptor 0)) (write-wordindexed symbol sb!vm:symbol-plist-slot *nil-descriptor*) (write-wordindexed symbol sb!vm:symbol-name-slot (string-to-core name *dynamic*)) diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp index 57a4831..5de4603 100644 --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -313,13 +313,9 @@ ;;;; symbols -#!+x86 -(defknown symbol-hash (symbol) (integer 0 #.sb!xc:most-positive-fixnum) - (flushable movable)) - (define-primitive-object (symbol :lowtag other-pointer-lowtag :widetag symbol-header-widetag - #!-x86 :alloc-trans #!-x86 make-symbol) + :alloc-trans make-symbol) ;; Beware when changing this definition. NIL-the-symbol is defined ;; using this layout, and NIL-the-end-of-list-marker is the cons @@ -327,11 +323,14 @@ ;; (conses have no header). Careful selection of lowtags ensures ;; that the same pointer can be used for both purposes: ;; OTHER-POINTER-LOWTAG is 7, LIST-POINTER-LOWTAG is 3, so if you - ;; subtract 3 from (sb-kernel:get-lisp-obj-address 'NIL) you get the + ;; subtract 3 from (SB-KERNEL:GET-LISP-OBJ-ADDRESS 'NIL) you get the ;; first data slot, and if you subtract 7 you get a symbol header. - (value :init :unbound) ;also the CAR of NIL-as-end-of-list - (hash) ;the CDR of NIL-as-end-of-list + ;; also the CAR of NIL-as-end-of-list + (value :init :unbound) + ;; also the CDR of NIL-as-end-of-list. Its reffer needs special + ;; care for this reason, as hash values must be fixnums. + (hash :set-trans %set-symbol-hash) (plist :ref-trans symbol-plist :set-trans %set-symbol-plist diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index f3903c2..69b835a 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -55,6 +55,12 @@ (defknown %sxhash-simple-substring (simple-string index) index (foldable flushable)) +(defknown symbol-hash (symbol) (integer 0 #.sb!xc:most-positive-fixnum) + (flushable movable)) + +(defknown %set-symbol-hash (symbol (integer 0 #.sb!xc:most-positive-fixnum)) + t (unsafe)) + (defknown vector-length (vector) index (flushable)) (defknown vector-sap ((simple-unboxed-array (*))) system-area-pointer diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index f7fbd60..18c0ebb 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -32,11 +32,7 @@ (declaim (special *universal-type*)) ;;; This is sorta semantically equivalent to SXHASH, but optimized for -;;; legal function names. Note: semantically equivalent does *not* -;;; mean that it always returns the same value as SXHASH, just that it -;;; satisfies the formal definition of SXHASH. The ``sorta'' is -;;; because SYMBOL-HASH will not necessarily return the same value in -;;; different lisp images. +;;; legal function names. ;;; ;;; Why optimize? We want to avoid the fully-general TYPECASE in ordinary ;;; SXHASH, because @@ -58,17 +54,17 @@ ;;; aren't used too early in cold boot for SXHASH to run). #!-sb-fluid (declaim (inline globaldb-sxhashoid)) (defun globaldb-sxhashoid (x) - (cond #-sb-xc-host ; (SYMBOL-HASH doesn't exist on cross-compilation host.) - ((symbolp x) - (symbol-hash x)) - #-sb-xc-host ; (SYMBOL-HASH doesn't exist on cross-compilation host.) + (cond ((symbolp x) (sxhash x)) ((and (listp x) (eq (first x) 'setf) (let ((rest (rest x))) (and (symbolp (car rest)) (null (cdr rest))))) - (logxor (symbol-hash (second x)) - 110680597)) + ;; We need to declare the type of the value we're feeding to + ;; SXHASH so that the DEFTRANSFORM on symbols kicks in. + (let ((symbol (second x))) + (declare (symbol symbol)) + (logxor (sxhash symbol) 110680597))) (t (sxhash x)))) ;;; Given any non-negative integer, return a prime number >= to it. diff --git a/src/compiler/hppa/cell.lisp b/src/compiler/hppa/cell.lisp index 50df91a..98bcb26 100644 --- a/src/compiler/hppa/cell.lisp +++ b/src/compiler/hppa/cell.lisp @@ -1,5 +1,16 @@ -(in-package "SB!VM") +;;;; the VM definition of various primitive memory access VOPs for +;;;; HPPA + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. +(in-package "SB!VM") ;;;; Data object ref/set stuff. @@ -19,18 +30,14 @@ (:results) (:generator 1 (storew value object offset lowtag))) - - ;;;; Symbol hacking VOPs: ;;; The compiler likes to be able to directly SET symbols. -;;; (define-vop (set cell-set) (:variant symbol-value-slot other-pointer-lowtag)) ;;; Do a cell ref with an error check for being unbound. -;;; (define-vop (checked-cell-ref) (:args (object :scs (descriptor-reg) :target obj-temp)) (:results (value :scs (descriptor-reg any-reg))) @@ -42,7 +49,6 @@ ;;; With Symbol-Value, we check that the value isn't the trap object. So ;;; Symbol-Value of NIL is NIL. -;;; (define-vop (symbol-value checked-cell-ref) (:translate symbol-value) (:generator 9 @@ -73,7 +79,19 @@ (:policy :fast) (:translate symbol-value)) - +(define-vop (symbol-hash) + (:policy :fast-safe) + (:translate symbol-hash) + (:args (symbol :scs (descriptor-reg))) + (: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. The lowtag selection magic that is required to + ;; ensure this is explained in the comment in objdef.lisp + (loadw res symbol symbol-hash-slot other-pointer-lowtag) + (inst andcm res #b11 res))) ;;;; Fdefinition (fdefn) objects. diff --git a/src/compiler/mips/cell.lisp b/src/compiler/mips/cell.lisp index 1151b6c..a9eb189 100644 --- a/src/compiler/mips/cell.lisp +++ b/src/compiler/mips/cell.lisp @@ -1,5 +1,16 @@ -(in-package "SB!VM") +;;;; the VM definition of various primitive memory access VOPs for +;;;; MIPS + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. +(in-package "SB!VM") ;;;; Data object ref/set stuff. @@ -76,6 +87,23 @@ (:policy :fast) (:translate symbol-value)) +(define-vop (symbol-hash) + (:policy :fast-safe) + (:translate symbol-hash) + (:args (symbol :scs (descriptor-reg))) + (:results (res :scs (any-reg))) + (:result-types positive-fixnum) + (:temporary (:scs (any-reg)) temp) + (: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. The lowtag selection magic that is required to + ;; ensure this is explained in the comment in objdef.lisp + ;; + ;; wow, MIPS sucks (or I do) -- CSR, 2004-05-20 + (inst li temp (fixnumize -1)) + (loadw res symbol symbol-hash-slot other-pointer-lowtag) + (inst and res temp))) ;;;; Fdefinition (fdefn) objects. diff --git a/src/compiler/sparc/cell.lisp b/src/compiler/sparc/cell.lisp index 250098c..18405a3 100644 --- a/src/compiler/sparc/cell.lisp +++ b/src/compiler/sparc/cell.lisp @@ -79,6 +79,19 @@ (:policy :fast) (:translate symbol-value)) +(define-vop (symbol-hash) + (:policy :fast-safe) + (:translate symbol-hash) + (:args (symbol :scs (descriptor-reg))) + (: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. The lowtag selection magic that is required to + ;; ensure this is explained in the comment in objdef.lisp + (loadw res symbol symbol-hash-slot other-pointer-lowtag) + (inst andn res res fixnum-tag-mask))) ;;;; FDEFINITION (fdefn) objects. (define-vop (fdefn-fun cell-ref) diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp index 47adf8f..a0ec28b 100644 --- a/src/compiler/x86/alloc.lisp +++ b/src/compiler/x86/alloc.lisp @@ -181,39 +181,4 @@ (inst lea result (make-ea :byte :base result :disp lowtag)) (storew header result 0 lowtag)))) -(define-vop (make-symbol) - (:policy :fast-safe) - (:translate make-symbol) - (:args (name :scs (descriptor-reg) :to :eval)) - (:temporary (:sc unsigned-reg :from :eval) temp) - (:results (result :scs (descriptor-reg) :from :argument)) - (:node-var node) - (:generator 37 - (with-fixed-allocation (result symbol-header-widetag symbol-size node) - (storew name result symbol-name-slot other-pointer-lowtag) - (storew unbound-marker-widetag - result - symbol-value-slot - other-pointer-lowtag) - ;; Set up a random hash value for the symbol. Perhaps the object - ;; address could be used for even faster and smaller code! - ;; FIXME: We don't mind the symbol hash not being repeatable, so - ;; we might as well add in the object address here, too. (Adding entropy - ;; is good, even if ANSI doesn't understand that.) - (inst imul temp - (make-fixup (extern-alien-name "fast_random_state") :foreign) - 1103515245) - (inst add temp 12345) - (inst mov (make-fixup (extern-alien-name "fast_random_state") :foreign) - temp) - ;; We want a positive fixnum for the hash value, so discard the LS bits. - ;; - ;; FIXME: OK, who wants to tell me (CSR) why these two - ;; instructions aren't replaced by (INST AND TEMP #x8FFFFFFC)? - ;; Are the following two instructions actually faster? Does the - ;; difference in behaviour really matter? - (inst shr temp 1) - (inst and temp #xfffffffc) - (storew temp result symbol-hash-slot other-pointer-lowtag) - (storew nil-value result symbol-plist-slot other-pointer-lowtag) - (storew nil-value result symbol-package-slot other-pointer-lowtag)))) + diff --git a/version.lisp-expr b/version.lisp-expr index a2ee4d0..d5c45db 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.10.42" +"0.8.10.43"