Changeset 10729


Ignore:
Timestamp:
Sep 14, 2008, 4:21:57 AM (11 years ago)
Author:
gz
Message:

It works.

Location:
branches/gz
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/gz/level-0/l0-hash.lisp

    r10709 r10729  
    6767  (require "HASHENV" "ccl:xdump;hashenv")
    6868  (require :number-case-macro)
    69   (define-symbol-macro free-hash-key-marker (%unbound-marker))
    7069  (define-symbol-macro deleted-hash-key-marker (%slot-unbound-marker))
     70  (define-symbol-macro free-hash-marker (%unbound-marker))
     71  (define-symbol-macro rehashing-value-marker (%slot-unbound-marker))
    7172  (declaim (inline nhash.vector-size))
    7273  (declaim (inline mixup-hash-code))
     
    367368          (declare (inline new-flags))
    368369          (if (hash-lock-free-p hash)
    369               (loop
     370            (loop
    370371                (let* ((flags (nhash.vector.flags vector))
    371372                       (new-flags (new-flags flags addressp)))
     
    415416before doing so.")
    416417
     418(defparameter *lock-free-hash-table-default* #+(or gz ccl-0711) t #-(or gz ccl-0711) nil)
     419
    417420(defun make-hash-table (&key (test 'eql)
    418421                             (size 60)
     
    423426                             (finalizeable nil)
    424427                             (address-based t)  ;; Ignored
    425                              (lock-free nil)    ;; Experimental
     428                             (lock-free *lock-free-hash-table-default*)
    426429                             (shared *shared-hash-table-default*))
    427430  "Create and return a new hash table. The keywords are as follows:
     
    437440       approaching zero as the threshold approaches 0. Density 1 means an
    438441       average of one entry per bucket."
    439   (declare (ignore address-based))
     442  (declare (ignore address-based)) ;; TODO: could reinterpret as "warn if becomes address-based"
    440443  (unless (and test (or (functionp test) (symbolp test)))
    441444    (report-bad-arg test '(and (not null) (or symbol function))))
     
    589592   table that can hold however many entries HASH-TABLE can hold without
    590593   having to be grown."
    591   (let ((vector (nhash.vector hash)))
    592     (floor (nhash.vector.size vector) (nhash.rehash-ratio hash))))
     594  (let* ((hash (require-type hash 'hash-table))
     595         (vector (nhash.vector hash)))
     596    (values (floor (nhash.vector.size vector) (nhash.rehash-ratio hash)))))
    593597
    594598(defun hash-table-test (hash)
     
    611615;; nearly-lock-free hash tables
    612616;;
    613              ;; It's kinda risky to use lock-free hash tables with address-based
    614              ;; keys, because it will thrash in low-memory situations, but we don't
    615              ;; disallow it because there are situations where it won't be a problem.
    616 
    617  (defun lock-free-rehash (hash)
     617;; A modification of the lock-free hash table algorithm described by Cliff Click Jr.  in
     618;; http://blogs.azulsystems.com/cliff/2007/03/a_nonblocking_h.html.
     619;;
     620;; The modifications have to do with the fact that the goal of the current implementation
     621;; is to have thread-safe hash tables with minimal performance penalty on reads, so I don't
     622;; bother with aspects of his algorithm that aren't relevant to that goal.
     623;;
     624;; The main difference from Click's algorithm is that I don't try to do rehashing
     625;; concurrently.  Instead, rehashing grabs a lock, so that only one thread can be
     626;; rehashing at any given time, and readers/writers will block waiting for the rehashing
     627;; to finish.
     628;;
     629;; In addition, I don't have a separate state for partially inserted key, I reuse the
     630;; DELETED state for that.  So in our implementation the following are the possible states
     631;; of a hash table entry (where "object" means any object other than the special markers):
     632;;
     633;; State      Key               Value
     634;; DELETED    object            free-hash-marker
     635;; IN-USE     object            object
     636;; FREE       free-hash-marker  free-hash-marker
     637;; REHASHING  object            rehashing-value-marker
     638;; REHASHING  free-hash-marker  rehashing-value-marker
     639;;
     640;; No other states are allowed - at no point in time can a hash table entry be in any
     641;; other state.   In addition, the only transition allowed on the Key slot is
     642;; free-hash-marker -> object.  Once a key slot is so claimed, it must never change
     643;; again (even after the hash vector has been discarded after rehashing, because
     644;; there can be some process still looking at it).
     645;; In particular, rehashing in place is not an option.  All rehashing creates a new
     646;; vector and copies into it.  This means it's kinda risky to use lock-free hash
     647;; tables with address-based keys, because they will thrash in low-memory situations,
     648;; but we don't disallow it because a particular use might not have this problem.
     649
     650
     651(defun lock-free-rehash (hash)
     652  ;;(break "We think we need to rehash ~s" (nhash.vector hash))
    618653  (with-lock-context
    619     (without-interrupts
    620      (let ((lock (nhash.exclusion-lock hash)))
    621        (grab-lock lock)
    622        ;; TODO: might also want to rehash if deleted entries are a large percentage
    623        ;; of all entries, more or less.
    624        (when (or (%i<= (nhash.grow-threshold hash) 0) ;; no room
    625                  (%needs-rehashing-p (nhash.vector hash)))    ;; or keys moved
    626          (%lock-free-rehash hash))
    627        (release-lock lock)))))
    628 
     654    (without-interrupts ;; not re-entrant
     655      (let ((lock (nhash.exclusion-lock hash)))
     656        (%lock-recursive-lock-object lock)
     657        ;; TODO: might also want to rehash if deleted entries are a large percentage
     658        ;; of all entries, more or less.
     659        (when (or (%i<= (nhash.grow-threshold hash) 0) ;; no room
     660                  (%needs-rehashing-p (nhash.vector hash))) ;; or keys moved
     661          (%lock-free-rehash hash))
     662        (%unlock-recursive-lock-object lock)))))
     663
     664
     665;; TODO: This is silly.  We're implementing atomic swap using store-conditional,
     666;; but internally store-conditional is probably implemented using some kind of
     667;; an atomic swap!!
    629668(defun atomic-swap-gvector (index gvector value)
    630   ;; This is silly.  We're implementing atomic swap using store-conditional, but internally
    631   ;; store-conditional is probably implemented using some kind of an atomic swap!!
    632669  (loop
    633670    (let ((old-value (%svref gvector index)))
     
    638675;; threads attempting a rehash.
    639676;; Other threads might be reading/writing/deleting individual entries, but they
    640 ;; will block if they see a value = free-hash-key-marker.
    641 ;; GC may run.
     677;; will block if they see a value = rehashing-value-marker.
     678;; GC may run, updating the needs-rehashing flags and deleting weak entries in both
     679;; old and new vectors.
    642680(defun %lock-free-rehash (hash)
    643681  ;; Prevent puthash from adding new entries.  Note this doesn't keep it from undeleting
     
    655693     REHASH
    656694     (loop for i from $nhash.vector_overhead below (uvsize old-vector) by 2
    657        do (let ((value (atomic-swap-gvector (%i+ i 1) old-vector free-hash-key-marker)))
    658             (when (eq value free-hash-key-marker) (error "Who else is doing this?"))
    659             (unless (eq value deleted-hash-key-marker)
     695       do (let ((value (atomic-swap-gvector (%i+ i 1) old-vector rehashing-value-marker)))
     696            (when (eq value rehashing-value-marker) (error "Who else is doing this?"))
     697            (unless (eq value free-hash-marker)
    660698              (let* ((key (%svref old-vector i))
    661699                     (new-index (%growhash-probe new-vector hash key))
     
    667705                  (go RESTART))))))
    668706     (when (%needs-rehashing-p new-vector) ;; keys moved, but at least can use the same new-vector.
    669        (%init-misc free-hash-key-marker new-vector)
     707       (%init-misc free-hash-marker new-vector)
    670708       (%init-nhash-vector new-vector inherited-flags)
    671        (go REHASH))
    672      (setf (nhash.vector.hash new-vector) hash)
    673      (setf (nhash.grow-threshold hash) grow-threshold)
    674      ;; At this point, another thread might decrement the threshold while they're looking at the old vector.
    675      ;; That's ok, just means it will be too small and we'll rehash sooner than planned, no big deal.
    676      (setf (nhash.vector.hash new-vector) hash))))
     709       (go REHASH)))
     710    (setf (nhash.vector.hash new-vector) hash)
     711    (setf (nhash.grow-threshold hash) grow-threshold)
     712    ;; At this point, another thread might decrement the threshold while they're looking at the old
     713    ;; vector. That's ok, just means it will be too small and we'll rehash sooner than planned,
     714    ;; no big deal.
     715    (setf (nhash.vector hash) new-vector)))
    677716
    678717
     
    683722           (vector-index (funcall (the function (nhash.find hash)) hash key)))
    684723      (declare (fixnum vector-index))
    685       (cond ((or (eql vector-index -1)
    686                  (neq vector (nhash.vector hash)))
    687              (unless (or (%needs-rehashing-p vector)
    688                          ;; Need to punt if vector changed because no way to know
    689                          ;; whether nhash.find was using old or new vector.
    690                          (neq vector (nhash.vector hash)))
    691                (return-from lock-free-gethash (values default nil))))
    692             (t (let ((value (%svref vector (%i+ vector-index 1))))
    693                  (unless (or (eq value free-hash-key-marker)
    694                              (neq vector (nhash.vector hash)))
    695                    (if (eq value deleted-hash-key-marker)
    696                      (return-from lock-free-gethash (values default nil))
    697                      (return-from lock-free-gethash (values value t))))))))
     724      ;; Need to punt if vector changed because no way to know whether nhash.find was
     725      ;; using old or new vector.
     726      (when (eq vector (nhash.vector hash))
     727        (cond ((eql vector-index -1)
     728               (unless (%needs-rehashing-p vector)
     729                 (return-from lock-free-gethash (values default nil))))
     730              (t (let ((value (%svref vector (%i+ vector-index 1))))
     731                   (unless (eq value rehashing-value-marker)
     732                     (if (eq value free-hash-marker)
     733                       (return-from lock-free-gethash (values default nil))
     734                       (return-from lock-free-gethash (values value t)))))))))
    698735    ;; We're here because the table needs rehashing or it was getting rehashed while we
    699736    ;; were searching. Take care of it and try again.
     
    706743           (vector-index (funcall (the function (nhash.find hash)) hash key)))
    707744      (declare (fixnum vector-index))
    708       (cond ((or (eql vector-index -1)
    709                  (neq vector (nhash.vector hash)))
    710              (unless (or (%needs-rehashing-p vector)
    711                          ;; Need to punt if vector changed because no way to know
    712                          ;; whether nhash.find was using old or new vector.
    713                          (neq vector (nhash.vector hash)))
    714                (return-from lock-free-remhash nil)))
    715             (t (let ((old-value (%svref vector (%i+ vector-index 1))))
    716                  (unless (or (eq old-value free-hash-key-marker)
    717                              (neq vector (nhash.vector hash)))
    718                    (when (eq old-value deleted-hash-key-marker)
    719                      (return-from lock-free-remhash nil))
    720                    (when (set-hash-value-conditional vector-index vector old-value deleted-hash-key-marker)
    721                      (return-from lock-free-remhash t))))))
     745      ;; Need to punt if vector changed because no way to know whether nhash.find was
     746      ;; using old or new vector.
     747      (when (eq vector (nhash.vector hash))
     748        (cond ((eql vector-index -1)
     749               (unless (%needs-rehashing-p vector)
     750                 (return-from lock-free-remhash nil)))
     751              (t (let ((old-value (%svref vector (%i+ vector-index 1))))
     752                   (unless (eq old-value rehashing-value-marker)
     753                     (when (eq old-value free-hash-marker)
     754                       (return-from lock-free-remhash nil))
     755                     (when (set-hash-value-conditional vector-index vector old-value free-hash-marker)
     756                       (return-from lock-free-remhash t)))))))
    722757      ;; We're here because the table needs rehashing or it was getting rehashed while we
    723758      ;; were searching.  Take care of it and try again.
    724759      (lock-free-rehash hash))))
    725 
    726 ;; lock-free hash tables are not appropriate in situations where writers,
    727 ;; i.e. puthash/remhash/clrhash, are performance-critical
    728760
    729761(defun lock-free-clrhash (hash)
     
    731763    (without-interrupts
    732764     (let ((lock (nhash.exclusion-lock hash)))
    733        (grab-lock lock)
     765       (%lock-recursive-lock-object lock) ;; disallow rehashing.
    734766       (loop
    735767         with vector = (nhash.vector hash)
    736          for i fixnum from (%i+ $nhash.vector_overhead 1) below (uvsize vector) by 2
    737          do (setf (%svref vector i) deleted-hash-key-marker))
    738        (release-lock lock))))
     768         for i1 fixnum from (%i+ $nhash.vector_overhead 1) below (uvsize vector) by 2
     769         do (setf (%svref vector i1) free-hash-marker))
     770       (%unlock-recursive-lock-object lock))))
    739771  hash)
    740772
    741773(defun lock-free-puthash (key hash value)
    742774  (declare (optimize (speed 3) (safety 0) (debug 0)))
    743   (when (eq key free-hash-key-marker)
     775  (when (eq key free-hash-marker)
    744776    (error "Can't use ~s as a hash-table key" key))
    745   (when (or (eq value free-hash-key-marker)
    746             (eq value deleted-hash-key-marker))
     777  (when (or (eq value rehashing-value-marker)
     778            (eq value free-hash-marker))
    747779    (error "Illegal value ~s for storing in a hash table" value))
    748780  (loop
    749781    (let* ((vector (nhash.vector  hash))
    750782           (vector-index (funcall (nhash.find-new hash) hash key)))
    751       ;; Need to punt if vector changed because no way to know
    752       ;; whether nhash.find-new was using old or new vector.
     783      ;; Need to punt if vector changed because no way to know whether nhash.find-new was
     784      ;; using old or new vector.
    753785      (when (eq vector (nhash.vector hash))
    754786        (cond ((or (eql vector-index -1)
    755                    (eq (%svref vector vector-index) free-hash-key-marker))
     787                   (eq (%svref vector vector-index) free-hash-marker))
    756788               (unless (or (%needs-rehashing-p vector)
    757789                           (%i<= (nhash.grow-threshold hash) 0))
    758790                 ;; Note if the puthash fails, grow-threshold will end up too small. This
    759791                 ;; just means we might rehash sooner than absolutely necessary, no real
    760                  ;; harm done (the most likely cause of failing is that somebody is already
    761                  ;; rehashing anyway).
    762                  ;; DON'T try to incf it back on failure -- that risks grow-threshold ending
    763                  ;; up too big (e.g. if somebody rehashes before the incf), which could be harmful.
     792                 ;; harm done (the most likely cause of failing is that somebody is
     793                 ;; already rehashing anyway).  DON'T try to incf it back on failure --
     794                 ;; that risks grow-threshold ending up too big (e.g. if somebody rehashes
     795                 ;; before the incf), which _could_ be harmful.
    764796                 (atomic-decf (nhash.grow-threshold hash))
    765                  (if (set-hash-key-conditional vector-index vector free-hash-key-marker key)
    766                    (when (set-hash-value-conditional vector-index vector deleted-hash-key-marker value)
     797                 (if (set-hash-key-conditional vector-index vector free-hash-marker key)
     798                   (when (set-hash-value-conditional vector-index vector free-hash-marker value)
    767799                     (return-from lock-free-puthash value)))))
    768800              (t (let ((old-value (%svref vector (%i+ vector-index 1))))
    769                    (unless (or (eq old-value free-hash-key-marker)
    770                                (neq vector (nhash.vector hash)))
     801                   (unless (eq old-value rehashing-value-marker)
    771802                     (when (set-hash-value-conditional vector-index vector old-value value)
    772803                       (return-from lock-free-puthash value))))))))
     
    787818    with vector = (nhash.vector hash)
    788819    for i fixnum from $nhash.vector_overhead below (uvsize vector) by 2
    789     count (and (neq (%svref vector i) free-hash-key-marker)
     820    count (and (neq (%svref vector i) free-hash-marker)
    790821               (let ((value (%svref vector (%i+ i 1))))
    791                  (when (eq value free-hash-key-marker)
     822                 (when (eq value rehashing-value-marker)
    792823                   ;; This table is being rehashed.  Wait for it to be
    793824                   ;; done and try again.
    794825                   (lock-free-rehash hash)
    795826                   (return-from lock-free-count-entries (lock-free-count-entries hash)))
    796                  (neq value deleted-hash-key-marker)))))
     827                 (neq value free-hash-marker)))))
    797828
    798829;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
    868899         (if (eq key (nhash.vector.cache-key vector))
    869900           (progn
    870              (setf (nhash.vector.cache-key vector) free-hash-key-marker
     901             (setf (nhash.vector.cache-key vector) free-hash-marker
    871902                   (nhash.vector.cache-value vector) nil)
    872903             (let ((vidx (index->vector-index (nhash.vector.cache-idx vector))))
     
    882913               ;; comparison function and don't want to keep a possibly
    883914               ;; deleted key from being GC'd
    884                (setf (nhash.vector.cache-key vector) free-hash-key-marker
     915               (setf (nhash.vector.cache-key vector) free-hash-marker
    885916                     (nhash.vector.cache-value vector) nil)
    886917               ;; Update the count
     
    897928                ((= i n))
    898929             (declare (fixnum i n))
    899              (setf (%svref vector i) free-hash-key-marker))
     930             (setf (%svref vector i) free-hash-marker))
    900931           (setf (nhash.grow-threshold hash)
    901932                 (+ (nhash.vector.deleted-count vector)
     
    926957       (declare (fixnum size count index))
    927958       (dotimes (i count)
    928          (setf (%svref vector index) free-hash-key-marker)
     959         (setf (%svref vector index) free-hash-marker)
    929960         (incf index))
    930961       (incf (the fixnum (nhash.grow-threshold hash))
     
    932963                            (the fixnum (nhash.vector.deleted-count vector)))))
    933964       (setf (nhash.vector.count vector) 0
    934              (nhash.vector.cache-key vector) free-hash-key-marker
     965             (nhash.vector.cache-key vector) free-hash-marker
    935966             (nhash.vector.cache-value vector) nil
    936967             (nhash.vector.finalization-alist vector) nil
     
    950981  (when (hash-lock-free-p hash)
    951982    (return-from puthash (lock-free-puthash key hash value)))
    952   (if (eq key free-hash-key-marker)
    953     (error "Can't use ~s as a hash-table key" free-hash-key-marker))
     983  (if (eq key free-hash-marker)
     984    (error "Can't use ~s as a hash-table key" key))
    954985  (with-lock-context
    955986    (without-interrupts
     
    9821013                                          (nhash.vector.deleted-count vector)))))
    9831014                       (%normalize-hash-table-count hash)))
    984                     ((eq old-value free-hash-key-marker)
     1015                    ((eq old-value free-hash-marker)
    9851016                     (when (eql 0 (nhash.grow-threshold hash))
    9861017                       (%unlock-gc-lock)
     
    10101041           (count 0))
    10111042      (loop
    1012         (when (neq (%svref vector idx) free-hash-key-marker)
     1043        (when (neq (%svref vector idx) free-hash-marker)
    10131044          (incf count))
    10141045        (when (>= (setq idx (+ idx 2)) size)
     
    10651096               
    10661097                 (let ((key (%svref old-vector vector-index)))
    1067                    (unless (or (eq key free-hash-key-marker)
     1098                   (unless (or (eq key free-hash-marker)
    10681099                               (eq key deleted-hash-key-marker))
    10691100                     (let* ((new-index (%growhash-probe vector hash key))
     
    10831114                     (nhash.vector hash) vector
    10841115                     (nhash.vector.hash vector) hash
    1085                      (nhash.vector.cache-key vector) free-hash-key-marker
     1116                     (nhash.vector.cache-key vector) free-hash-marker
    10861117                     (nhash.vector.cache-value vector) nil
    10871118                     (nhash.vector.gc-count vector) gc-count
     
    11061137;;;   index - the index in the vector for key (where it was or where
    11071138;;;           to insert if the current key at that index is deleted-hash-key-marker
    1108 ;;;           or free-hash-key-marker)
     1139;;;           or free-hash-marker)
    11091140
    11101141
     
    11281159                          (setq vector-index (index->vector-index index)
    11291160                                table-key (%svref vector vector-index))
    1130                           (cond ((eq table-key free-hash-key-marker)
     1161                          (cond ((eq table-key free-hash-marker)
    11311162                                 (return-it (if for-put-p
    11321163                                              (or first-deleted-index
     
    11841215    (if (eq table-key key)
    11851216      vector-index
    1186       (if (eq table-key free-hash-key-marker)
     1217      (if (eq table-key free-hash-marker)
    11871218        -1
    11881219        (let* ((secondary-hash (%svref secondary-keys-*-2
     
    12011232            (if (eq table-key key)
    12021233              (return vector-index)
    1203               (when (eq table-key free-hash-key-marker)
     1234              (when (eq table-key free-hash-marker)
    12041235                (return -1)))))))))
    12051236
     
    12331264    (declare (fixnum hash-code vector-index))
    12341265    (if (or (eq key table-key)
    1235             (eq table-key free-hash-key-marker))
     1266            (eq table-key free-hash-marker))
    12361267      vector-index
    12371268      (let* ((secondary-hash (%svref secondary-keys-*-2
     
    12531284          (if (eq table-key key)
    12541285            (return vector-index)
    1255             (if (eq table-key free-hash-key-marker)
     1286            (if (eq table-key free-hash-marker)
    12561287              (return (or first-deleted-index vector-index))
    12571288              (if (and (null first-deleted-index)
     
    12701301      (if (eql key table-key)
    12711302        vector-index
    1272         (if (eq table-key free-hash-key-marker)
     1303        (if (eq table-key free-hash-marker)
    12731304          -1
    12741305          (let* ((secondary-hash (%svref secondary-keys-*-2
     
    12871318              (if (eql table-key key)
    12881319                (return vector-index)
    1289                 (when (eq table-key free-hash-key-marker)
     1320                (when (eq table-key free-hash-marker)
    12901321                  (return -1))))))))
    12911322    (eq-hash-find hash key)))
     
    13011332      (declare (fixnum hash-code entries vector-index))
    13021333      (if (or (eql key table-key)
    1303               (eq table-key free-hash-key-marker))
     1334              (eq table-key free-hash-marker))
    13041335        vector-index
    13051336        (let* ((secondary-hash (%svref secondary-keys-*-2
     
    13211352            (if (eql table-key key)
    13221353              (return vector-index)
    1323               (if (eq table-key free-hash-key-marker)
     1354              (if (eq table-key free-hash-marker)
    13241355                (return (or first-deleted-index vector-index))
    13251356                (if (and (null first-deleted-index)
     
    13491380    (setf (nhash.vector.flags vector)
    13501381          (logand flags $nhash-clear-key-bits-mask))
    1351     (setf (nhash.vector.cache-key vector) free-hash-key-marker
     1382    (setf (nhash.vector.cache-key vector) free-hash-marker
    13521383          (nhash.vector.cache-value vector) nil)
    13531384    (%set-does-not-need-rehashing hash)
     
    13591390               (deleted (eq key deleted-hash-key-marker)))
    13601391          (unless
    1361             (when (or deleted (eq key free-hash-key-marker))
     1392            (when (or deleted (eq key free-hash-marker))
    13621393              (if deleted  ; one less deleted entry
    13631394                (let ((count (1- (nhash.vector.deleted-count vector))))
     
    13711402                  (incf (nhash.grow-threshold hash))
    13721403                  ;; Change deleted to free
    1373                   (setf (%svref vector vector-index) free-hash-key-marker)))
     1404                  (setf (%svref vector vector-index) free-hash-marker)))
    13741405              t)
    13751406            (let* ((last-index index)
     
    13881419                        (when first ; or (eq last-index index) ?
    13891420                          (setq first nil)
    1390                           (setf (%svref vector vector-index) free-hash-key-marker)
    1391                           (setf (%svref vector (the fixnum (1+ vector-index))) free-hash-key-marker))
     1421                          (setf (%svref vector vector-index) free-hash-marker)
     1422                          (setf (%svref vector (the fixnum (1+ vector-index))) free-hash-marker))
    13921423                        (%set-hash-table-vector-key vector found-vector-index key)
    13931424                        (setf (%svref vector (the fixnum (1+ found-vector-index))) value)                       
    1394                         (when (or (eq newkey free-hash-key-marker)
     1425                        (when (or (eq newkey free-hash-marker)
    13951426                                  (setq deleted (eq newkey deleted-hash-key-marker)))
    13961427                          (when deleted
     
    14481479           (vector-key nil))
    14491480      (declare (fixnum vector-index))
    1450       (if (or (eq free-hash-key-marker
     1481      (if (or (eq free-hash-marker
    14511482                  (setq vector-key (%svref vector vector-index)))
    14521483              (eq deleted-hash-key-marker vector-key))
     
    14581489            (when (>= index entries)
    14591490              (setq index (- index entries)))
    1460             (when (or (eq free-hash-key-marker
     1491            (when (or (eq free-hash-marker
    14611492                          (setq vector-key (%svref vector (index->vector-index index))))
    14621493                      (eq deleted-hash-key-marker vector-key))
     
    17371768(defun %cons-nhash-vector (size &optional (flags 0))
    17381769  (declare (fixnum size))
    1739   (let* ((vector (%alloc-misc (+ (+ size size) $nhash.vector_overhead) target::subtag-hash-vector free-hash-key-marker)))
     1770  (let* ((vector (%alloc-misc (+ (+ size size) $nhash.vector_overhead) target::subtag-hash-vector free-hash-marker)))
    17401771    (%init-nhash-vector vector flags)
    17411772    vector))
    17421773
    1743 (defun %init-nhash-vector (vector &optional (flags 0))
     1774(defun %init-nhash-vector (vector flags)
    17441775  (let ((size (vector-index->index (uvsize vector))))
    17451776    (declare (fixnum size))
     
    17531784          (nhash.vector.deleted-count vector) 0
    17541785          (nhash.vector.count vector) 0
    1755           (nhash.vector.cache-key vector) free-hash-key-marker
     1786          (nhash.vector.cache-key vector) free-hash-marker
    17561787          (nhash.vector.cache-value vector) nil
    17571788          (nhash.vector.cache-idx vector) nil
     
    18141845
    18151846 
    1816 ;; ** TODO: for lock-free hash tables, we don't need to copy to map,
     1847;; ** TODO: for lock-free hash tables, we don't need to copy,
    18171848;; we could map over the actual hash table vector, because it's
    18181849;; always valid.
     
    18281859    (declare (fixnum in-idx insize out-idx outsize))
    18291860    (let* ((key (%svref in in-idx)))
    1830       (unless (eq key free-hash-key-marker)
     1861      (unless (eq key free-hash-marker)
    18311862        (let ((val (%svref in (%i+ in-idx 1))))
    1832           (when (eq val free-hash-key-marker)
     1863          (when (eq val rehashing-value-marker)
    18331864            ;; This table is being rehashed.  Wait to finish and try again
    18341865            (lock-free-rehash hash)
    18351866            (return-from lock-free-enumerate-hash-keys-and-values
    18361867                         (lock-free-enumerate-hash-keys-and-values hash keys values)))
    1837           (unless (eq val deleted-hash-key-marker)
     1868          (unless (eq val free-hash-marker)
    18381869            (when keys (setf (%svref keys out-idx) key))
    18391870            (when values (setf (%svref values out-idx) val))
     
    18601891           (declare (fixnum in-idx insize out-idx outsize))
    18611892           (let* ((key (%svref in in-idx)))
    1862              (unless (or (eq key free-hash-key-marker)
     1893             (unless (or (eq key free-hash-marker)
    18631894                         (eq key deleted-hash-key-marker))
    18641895               (when keys
  • branches/gz/lib/setf.lisp

    r9924 r10729  
    316316    (multiple-value-bind (dummies vals newval setter getter)
    317317        (get-setf-method place env)
    318       (let ((d (gensym)))
     318      (let ((d (gensym))
     319            ;; Doesn't propagate inferred types, but better than nothing.
     320            (d-type (cond ((constantp delta) (type-of delta))
     321                          ((and (consp delta) (eq (car delta) 'the)) (cadr delta))
     322                          (t t)))
     323            (v-type (if (and (consp place) (eq (car place) 'the)) (cadr place) t)))
    319324        `(let* (,@(mapcar #'list dummies vals)
    320325                (,d ,delta)
    321326                (,(car newval) (+ ,getter ,d)))
    322           ,setter)))))
     327           (declare (type ,d-type ,d) (type ,v-type ,(car newval)))
     328           ,setter)))))
    323329
    324330(defmacro decf (place &optional (delta 1) &environment env)
     
    332338    (multiple-value-bind (dummies vals newval setter getter)
    333339        (get-setf-method place env)
    334       (let ((d (gensym)))
     340      (let* ((d (gensym))
     341             ;; Doesn't propagate inferred types, but better than nothing.
     342             (d-type (cond ((constantp delta) (type-of delta))
     343                           ((and (consp delta) (eq (car delta) 'the)) (cadr delta))
     344                           (t t)))
     345             (v-type (if (and (consp place) (eq (car place) 'the)) (cadr place) t)))
    335346        `(let* (,@(mapcar #'list dummies vals)
    336347                (,d ,delta)
    337348                (,(car newval) (- ,getter ,d)))
    338           ,setter)))))
     349           (declare (type ,d-type ,d) (type ,v-type ,(car newval)))
     350           ,setter)))))
    339351 
    340352(defmacro psetf (&whole call &rest pairs &environment env)  ;same structure as psetq
  • branches/gz/lisp-kernel/gc-common.c

    r10709 r10729  
    235235          ! ref_bit(markbits, dnode)) {
    236236        if (keys_frozen) {
    237           if (pairp[1] != unbound) {
    238             pairp[1] = slot_unbound;
     237          if (pairp[1] != slot_unbound) {
     238            pairp[1] = unbound;
    239239          }
    240240        }
Note: See TracChangeset for help on using the changeset viewer.