Changeset 7943


Ignore:
Timestamp:
Dec 26, 2007, 7:52:21 AM (13 years ago)
Author:
gb
Message:

A few small changes; there may be bad bugs in EQUAL/EQUALP hashing.
Get keys/values for new maphash.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-0/l0-hash.lisp

    r7908 r7943  
    360360        (mixup-hash-code (strip-tag-to-fixnum primary))))))
    361361
    362 ;; call %%eqlhash
    363 
    364 (defun string-hash (key start len)
    365   (declare (fixnum start len))
    366   (let* ((res len))
    367     (dotimes (i len)
    368       (let ((code (%scharcode key (%i+ i start))))
    369         (setq code (mixup-hash-code code))
    370         (setq res (%i+ (rotate-hash-code res) code))))
    371     res))
    372 
    373 
    374362
    375363(defun %%equalhash (key)
     
    385373          ((and hash (neq hash key)) hash)  ; eql stuff
    386374          (t (typecase key
    387                 (simple-string (string-hash key 0 (length key)))
     375                (simple-string (%pname-hash key (length key)))
    388376                (string
    389377                 (let ((length (length key)))
    390378                   (multiple-value-bind (data offset) (array-data-and-offset key)
    391                      (string-hash data offset length))))
     379                     (%string-hash offset data length))))
    392380                (bit-vector (bit-vector-hash key))
    393381                (cons
     
    10351023
    10361024
     1025
    10371026(defun %hash-probe (hash key update-hash-flags)
    10381027  (declare (optimize (speed 3) (space 0)))
     
    17491738 
    17501739 
     1740
     1741
    17511742(defun enumerate-hash-keys (hash out)
    17521743  (unless (hash-table-p hash)
     
    17701761             (setf (%svref out out-idx) val)
    17711762             (incf out-idx))))))))
     1763
     1764(defun enumerate-hash-keys-and-values (hash keys values)
     1765  (unless (hash-table-p hash)
     1766    (report-bad-arg hash 'hash-table))
     1767  (with-lock-context
     1768    (without-interrupts
     1769     (let* ((readonly (eq (read-lock-hash-table hash) :readonly)))
     1770       (do* ((in (nhash.vector hash))
     1771             (in-idx $nhash.vector_overhead (+ in-idx 2))
     1772             (insize (uvsize in))
     1773             (outsize (length keys))
     1774             (out-idx 0))
     1775            ((or (= in-idx insize)
     1776                 (= out-idx outsize))
     1777             (unlock-hash-table hash readonly)
     1778             out-idx)
     1779         (declare (fixnum in-idx insize out-idx outsize))
     1780         (let* ((key (%svref in in-idx)))
     1781           (unless (or (eq key free-hash-key-marker)
     1782                       (eq key deleted-hash-key-marker))
     1783             (setf (%svref keys out-idx) key)
     1784             (setf (%svref values out-idx) (%svref in (the fixnum (1+ in-idx))))
     1785             (incf out-idx))))))))
Note: See TracChangeset for help on using the changeset viewer.