[Openmcl-cvs-notifications] r9999 - in /trunk/source: level-0/X86/x86-hash.lisp level-0/l0-hash.lisp xdump/hashenv.lisp
gz at clozure.com
gz at clozure.com
Thu Jul 10 07:12:28 EDT 2008
Author: gz
Date: Thu Jul 10 07:12:28 2008
New Revision: 9999
Log:
Propagate r9930,r9931 (faster mod for hash) to trunk
Modified:
trunk/source/level-0/X86/x86-hash.lisp
trunk/source/level-0/l0-hash.lisp
trunk/source/xdump/hashenv.lisp
Modified: trunk/source/level-0/X86/x86-hash.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-0/X86/x86-hash.lisp (original)
+++ trunk/source/level-0/X86/x86-hash.lisp Thu Jul 10 07:12:28 2008
@@ -36,6 +36,23 @@
(mov (% imm1) (% arg_z))
(single-value-return))
=
+
+;; Faster mod based on Bruce Hoult's Dylan version, modified to use a bran=
ch-free max.
+(defx86lapfunction fast-mod-3 ((number arg_x) (divisor arg_y) (recip arg_z=
))
+ (mov (% number) (% imm0))
+ (shrq ($ target::fixnumshift) (% imm0))
+ (mov (% recip) (% imm1))
+ (mul (% imm1)) ;; -> hi word in imm1 (unboxed)
+ (mov (% divisor) (% imm0))
+ (mul (% imm1)) ;; -> lo word in imm0 (boxed)
+ (subq (% imm0) (% number))
+ (subq (% divisor) (% number))
+ (mov (% number) (% arg_z))
+ (mov (% number) (% imm0))
+ (sar ($ (1- target::nbits-in-word)) (% imm0))
+ (andq (% imm0) (% divisor))
+ (addq (% divisor) (% arg_z))
+ (single-value-return))
=
(defx86lapfunction %dfloat-hash ((key arg_z))
(movq (@ x8664::double-float.value (% key)) (% imm0))
Modified: trunk/source/level-0/l0-hash.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-0/l0-hash.lisp (original)
+++ trunk/source/level-0/l0-hash.lisp Thu Jul 10 07:12:28 2008
@@ -212,7 +212,11 @@
=
=
(defun nhash.vector-size (vector)
- (ash (the fixnum (- (the fixnum (uvsize vector)) $nhash.vector_overhead)=
) -1))
+ (nhash.vector.size vector))
+
+(eval-when (:compile-toplevel :execute) (declaim (inline hash-mod)))
+(defun hash-mod (hash entries vector)
+ (fast-mod-3 hash entries (nhash.vector.size-reciprocal vector)))
=
;;; Is KEY something which can be EQL to something it's not EQ to ?
;;; (e.g., is it a number or macptr ?)
@@ -429,11 +433,10 @@
(setq flags (logand (lognot $nhash-track-keys-mask) flags))
(setq flags (bitset $nhash_component_address_bit flags))))
(setf (nhash.vector.flags vector) flags))))
- (let* ((length (- (the fixnum (uvsize vector)) $nhash.vector_overhead=
))
- (entries (ash length -1)))
- (declare (fixnum length entries))
+ (let* ((entries (nhash.vector-size vector)))
+ (declare (fixnum entries))
(values primary
- (fast-mod primary entries)
+ (hash-mod primary entries vector)
entries))))
=
(defun %already-rehashed-p (primary rehash-bits)
@@ -1090,12 +1093,10 @@
(if (symbolp key)
(%hash-symbol key)
(mixup-hash-code (strip-tag-to-fixnum key)))))))
- (length (uvsize vector))
- (count (- length $nhash.vector_overhead))
- (entries (ash count -1))
- (vector-index (index->vector-index (fast-mod hash-code entries)))
+ (entries (nhash.vector-size vector))
+ (vector-index (index->vector-index (hash-mod hash-code entries ve=
ctor)))
(table-key (%svref vector vector-index)))
- (declare (fixnum hash-code entries vector-index count length))
+ (declare (fixnum hash-code entries vector-index))
(if (or (eq key table-key)
(eq table-key free-hash-key-marker))
vector-index
@@ -1103,8 +1104,10 @@
(logand 7 hash-code)))
(initial-index vector-index) =
(first-deleted-index (if (eq table-key deleted-hash-key-marke=
r)
- vector-index)))
- (declare (fixnum secondary-hash initial-index))
+ vector-index))
+ (count (+ entries entries))
+ (length (+ count $nhash.vector_overhead)))
+ (declare (fixnum secondary-hash initial-index count length))
(loop
(incf vector-index secondary-hash)
(when (>=3D vector-index length)
@@ -1144,11 +1147,10 @@
(setf (nhash.vector.flags vector)
(logior $nhash-track-keys-mask flags))))
(mixup-hash-code (strip-tag-to-fixnum key))))))))
- (length (uvsize vector))
- (count (- length $nhash.vector_overhead))
- (vector-index (index->vector-index (fast-mod hash-code (ash count=
-1))))
+ (entries (nhash.vector-size vector))
+ (vector-index (index->vector-index (hash-mod hash-code entries ve=
ctor)))
(table-key (%svref vector vector-index)))
- (declare (fixnum hash-code length count vector-index))
+ (declare (fixnum hash-code vector-index))
(if (or (eq key table-key)
(eq table-key free-hash-key-marker))
vector-index
@@ -1156,8 +1158,10 @@
(logand 7 hash-code)))
(initial-index vector-index) =
(first-deleted-index (if (eq table-key deleted-hash-key-marke=
r)
- vector-index)))
- (declare (fixnum secondary-hash initial-index))
+ vector-index))
+ (count (+ entries entries))
+ (length (+ count $nhash.vector_overhead)))
+ (declare (fixnum secondary-hash initial-index count length))
(loop
(incf vector-index secondary-hash)
(when (>=3D vector-index length)
@@ -1178,12 +1182,10 @@
(if (need-use-eql key)
(let* ((vector (nhash.vector hash))
(hash-code (%%eqlhash-internal key))
- (length (uvsize vector))
- (count (- length $nhash.vector_overhead))
- (entries (ash count -1))
- (vector-index (index->vector-index (fast-mod hash-code entries)=
))
+ (entries (nhash.vector-size vector))
+ (vector-index (index->vector-index (hash-mod hash-code entries =
vector)))
(table-key (%svref vector vector-index)))
- (declare (fixnum hash-code length entries count vector-index))
+ (declare (fixnum hash-code entries vector-index))
(if (or (eql key table-key)
(eq table-key free-hash-key-marker))
vector-index
@@ -1191,8 +1193,10 @@
(logand 7 hash-code)))
(initial-index vector-index)
(first-deleted-index (if (eq table-key deleted-hash-key-mar=
ker)
- vector-index)))
- (declare (fixnum secondary-hash initial-index))
+ vector-index))
+ (count (+ entries entries))
+ (length (+ count $nhash.vector_overhead)))
+ (declare (fixnum secondary-hash initial-index count length))
(loop
(incf vector-index secondary-hash)
(when (>=3D vector-index length)
@@ -1214,12 +1218,10 @@
(if (need-use-eql key)
(let* ((vector (nhash.vector hash))
(hash-code (%%eqlhash-internal key))
- (length (uvsize vector))
- (count (- length $nhash.vector_overhead))
- (entries (ash count -1))
- (vector-index (index->vector-index (fast-mod hash-code entries)=
))
+ (entries (nhash.vector-size vector))
+ (vector-index (index->vector-index (hash-mod hash-code entries =
vector)))
(table-key (%svref vector vector-index)))
- (declare (fixnum hash-code length entries vector-index))
+ (declare (fixnum hash-code entries vector-index))
(if (or (eql key table-key)
(eq table-key free-hash-key-marker))
vector-index
@@ -1227,8 +1229,10 @@
(logand 7 hash-code)))
(initial-index vector-index)
(first-deleted-index (if (eq table-key deleted-hash-key-mar=
ker)
- vector-index)))
- (declare (fixnum secondary-hash initial-index))
+ vector-index))
+ (count (+ entries entries))
+ (length (+ count $nhash.vector_overhead)))
+ (declare (fixnum secondary-hash initial-index count length))
(loop
(incf vector-index secondary-hash)
(when (>=3D vector-index length)
@@ -1683,7 +1687,9 @@
(nhash.vector.deleted-count vector) 0
(nhash.vector.cache-key vector) (%unbound-marker)
(nhash.vector.cache-value vector) nil
- (nhash.vector.cache-idx vector) nil)
+ (nhash.vector.cache-idx vector) nil
+ (nhash.vector.size vector) size
+ (nhash.vector.size-reciprocal vector) (floor (ash 1 (- target::n=
bits-in-word target::fixnumshift)) size))
vector))
=
(defun assert-hash-table-readonly (hash)
Modified: trunk/source/xdump/hashenv.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/xdump/hashenv.lisp (original)
+++ trunk/source/xdump/hashenv.lisp Thu Jul 10 07:12:28 2008
@@ -31,7 +31,7 @@
(defconstant $nhash.lock-map-count-mask #xffff)
(defconstant $nhash.lock-not-while-rehashing #x-20001)
=
-; The hash.vector cell contains a vector with 8 longwords of overhead
+; The hash.vector cell contains a vector with some longwords of overhead
; followed by alternating keys and values.
; A key of $undefined denotes an empty or deleted value
; The value will be $undefined for empty values, or NIL for deleted values.
@@ -46,11 +46,14 @@
nhash.vector.cache-idx ; index of last cached key/value p=
air
nhash.vector.cache-key ; cached key
nhash.vector.cache-value ; cached value
+ nhash.vector.size ; number of entries in table
+ nhash.vector.size-reciprocal ; shifted reciprocal of nhash.vect=
or.size
)
+
=
; number of longwords of overhead in nhash.vector.
; Must be a multiple of 2 or INDEX parameters in LAP code will not be tagg=
ed as fixnums.
-(defconstant $nhash.vector_overhead 10)
+(defconstant $nhash.vector_overhead 12)
=
(defconstant $nhash_weak_bit 12) ; weak hash table
(defconstant $nhash_weak_value_bit 11) ; weak on value vice key if this b=
it set
More information about the Openmcl-cvs-notifications
mailing list