Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv1444
Modified Files: storage-types.lisp Log Message: Re-worked a bit how hash-tables are translated to movitz. Increased their size quite a bit, so as to reduce the number of collisions.
Date: Wed Apr 21 12:22:56 2004 Author: ffjeld
Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.15 movitz/storage-types.lisp:1.16 --- movitz/storage-types.lisp:1.15 Mon Mar 29 09:35:17 2004 +++ movitz/storage-types.lisp Wed Apr 21 12:22:56 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.15 2004/03/29 14:35:17 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.16 2004/04/21 16:22:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -1126,7 +1126,7 @@
(defun make-movitz-hash-table (lisp-hash) (let* ((undef (movitz-read +undefined-hash-key+)) - (hash-size (* 4 (max 8 (hash-table-count lisp-hash)))) + (hash-size (* 2 (truncate (+ 25 (hash-table-count lisp-hash)) 1/3))) (bucket-data (make-array hash-size :initial-element undef))) (multiple-value-bind (hash-test hash-sxhash) (ecase (hash-table-test lisp-hash) @@ -1139,8 +1139,8 @@ do (loop for pos = (rem (* 2 (movitz-sxhash movitz-key)) hash-size) then (rem (+ 2 pos) hash-size) until (eq undef (svref bucket-data pos)) -;;; do (warn "Hash collision at ~D of ~D: ~S ~S!" -;;; pos hash-size movitz-key (elt bucket-list pos)) +;;; do (warn "Hash collision at ~D of ~D: ~S ~S!" +;;; pos hash-size movitz-key (elt bucket-data pos)) ;;; finally (warn "Hash: pos ~D: ~S ~S" pos movitz-key movitz-value) ;;; finally (when (equal "NIL" key) ;;; (warn "key: ~S, value: ~S pos: ~S" movitz-key movitz-value pos)) @@ -1149,7 +1149,7 @@ (let* ((bucket (make-movitz-vector hash-size :initial-contents bucket-data)) (lh (make-instance 'movitz-struct :name (movitz-read 'muerte::hash-table) - :length 2 + :length 3 :slot-values (list hash-test ; test-function bucket hash-sxhash)))) @@ -1160,7 +1160,7 @@ (assert (= 3 (length (movitz-struct-slot-values movitz-hash)))) (let* ((undef (movitz-read +undefined-hash-key+)) (old-bucket (second (movitz-struct-slot-values movitz-hash))) - (hash-size (* 2 (truncate (hash-table-count lisp-hash) 2/3))) + (hash-size (* 2 (truncate (+ 25 (hash-table-count lisp-hash)) 1/3))) (bucket-data (or (and old-bucket (= (length (movitz-vector-symbolic-data old-bucket)) hash-size) @@ -1178,12 +1178,14 @@ then (rem (+ 2 pos) hash-size) until (eq undef (svref bucket-data pos)) ;;; do (warn "Hash collision at ~D of ~D: ~S ~S!" -;;; pos hash-size movitz-key (elt bucket-list pos)) +;;; pos hash-size movitz-key (elt bucket-data pos)) ;;; finally (warn "Hash: pos ~D: ~S ~S" pos movitz-key movitz-value) ;;; finally (when (equal "NIL" key) ;;; (warn "key: ~S, value: ~S pos: ~S" movitz-key movitz-value pos)) - finally (setf (svref bucket-data pos) movitz-key - (svref bucket-data (1+ pos)) movitz-value))) + finally + (setf (svref bucket-data pos) movitz-key + (svref bucket-data (1+ pos)) movitz-value))) + (setf *foo* bucket-data) (setf (first (movitz-struct-slot-values movitz-hash)) hash-test (second (movitz-struct-slot-values movitz-hash)) (movitz-read bucket-data) (third (movitz-struct-slot-values movitz-hash)) hash-sxhash)