Changeset 7694


Ignore:
Timestamp:
Nov 20, 2007, 3:07:05 PM (12 years ago)
Author:
gb
Message:

New hash-table iteration interface; new locking stuff.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0710/ccl/lib/macros.lisp

    r7414 r7694  
    23322332         (free-resource ,resource-var ,var))))))
    23332333
     2334;;; Bind per-thread specials which help with lock accounting.
     2335(defmacro with-lock-context (&body body)
     2336  `(let* ((*locks-held* *locks-held*)
     2337          (*locks-pending* *locks-pending*)
     2338          (*lock-conses* *lock-conses*))
     2339    ,@body))
     2340           
     2341 
     2342
    23342343(defmacro with-lock-grabbed ((lock &optional
    23352344                                   (whostate "Lock"))
     
    23382347the lock held."
    23392348  (declare (ignore whostate))
    2340   `(with-recursive-lock (,lock) ,@body))
     2349    (let* ((locked (gensym))
     2350           (l (gensym)))
     2351      `  (with-lock-context
     2352           (let ((,locked (make-lock-acquisition))
     2353             (,l ,lock))
     2354        (declare (dynamic-extent ,locked))
     2355        (unwind-protect
     2356             (progn
     2357               (%lock-recursive-lock-object ,l ,locked )
     2358               ,@body)
     2359          (when (lock-acquisition.status ,locked) (%unlock-recursive-lock-object ,l)))))))
    23412360
    23422361(defmacro with-lock-grabbed-maybe ((lock &optional
     
    23442363                                   &body body)
    23452364  (declare (ignore whostate))
    2346   `(with-recursive-lock-maybe (,lock) ,@body))
     2365  (let* ((l (gensym)))
     2366    `(with-lock-context
     2367      (let* ((,l ,lock))
     2368        (when (%try-recursive-lock-object ,l)
     2369          (unwind-protect
     2370               (progn ,@body)
     2371            (%unlock-recursive-lock-object ,l)))))))
    23472372
    23482373(defmacro with-standard-abort-handling (abort-message &body body)
     
    25892614     nil))
    25902615
    2591 (defmacro with-hash-write-lock ((hash) &body body)
    2592   `(with-write-lock ((nhash.exclusion-lock ,hash))
    2593     ,@body))
    2594 
    2595 ;;; To ... er, um, ... expedite implementation, we lock the hash
    2596 ;;; table exclusively whenever touching it.  For now.
    2597 
    2598 (defmacro with-exclusive-hash-lock ((hash) &body body)
    2599   `(with-hash-write-lock (,hash) ,@body))
     2616
    26002617
    26012618(defmacro with-hash-table-iterator ((mname hash-table) &body body &environment env)
     
    26062623   any objects remain in the hash table. When the first value is non-NIL,
    26072624   the second and third values are the key and the value of the next object."
    2608   (let ((state (gensym))
    2609         (htab (gensym)))
    2610     (multiple-value-bind (body decls) (parse-body body env)
    2611       `(let* ((,htab ,hash-table)
    2612               (,state (vector nil nil nil
    2613                               nil nil)))
    2614         (declare (dynamic-extent ,state))
    2615         (unwind-protect
    2616              (macrolet ((,mname () `(do-hash-table-iteration ,',state)))
    2617                (start-hash-table-iterator ,htab ,state)
    2618                (locally ,@decls ,@body))
    2619           (finish-hash-table-iterator ,state))))))
     2625  (let* ((hash (gensym))
     2626         (keys (gensym))
     2627         (state (gensym)))
     2628    `(let* ((,hash ,hash-table)
     2629            (,keys (make-array (the fixnum (hash-table-count ,hash))))
     2630            (,state (vector ,hash 0 ,keys (enumerate-hash-keys ,hash ,keys))))
     2631      (declare (dynamic-extent ,keys ,state))
     2632      (macrolet ((,mname () `(next-hash-table-iteration ,',state)))
     2633        ,@body))))
     2634
    26202635
    26212636(eval-when (compile load eval)
     
    29782993        (setf (%process-whostate ,p) ,old-whostate)))))
    29792994
    2980 (defmacro %with-recursive-lock-ptr ((lockptr) &body body)
    2981   (let* ((locked (gensym)))
    2982     `(let ((,locked (make-lock-acquisition)))
    2983       (declare (dynamic-extent ,locked))
    2984       (unwind-protect
    2985            (progn
    2986              (%lock-recursive-lock ,lockptr ,locked )
    2987              ,@body)
    2988         (when (lock-acquisition.status ,locked) (%unlock-recursive-lock ,lockptr))))))
    2989 
    2990 (defmacro %with-recursive-lock-ptr-maybe ((lockptr) &body body)
    2991   `(when (%try-recursive-lock ,lockptr)
    2992     (unwind-protect
    2993          (progn ,@body)
    2994       (%unlock-recursive-lock ,lockptr))))
    2995 
    2996 
    2997 (defmacro with-recursive-lock ((lock) &body body)
    2998   (let* ((p (gensym)))
    2999     `(let* ((,p (recursive-lock-ptr ,lock)))
    3000       (%with-recursive-lock-ptr (,p) ,@body))))
    3001 
    3002 (defmacro with-recursive-lock-maybe ((lock) &body body)
    3003   (let* ((p (gensym)))
    3004     `(let* ((,p (recursive-lock-ptr ,lock)))
    3005       (%with-recursive-lock-ptr-maybe (,p) ,@body))))
     2995
     2996
     2997
    30062998
    30072999(defmacro with-read-lock ((lock) &body body)
     
    30093001its body with the lock held."
    30103002  (let* ((p (gensym)))
    3011     `(let* ((,p ,lock))
    3012       (unwind-protect
    3013            (progn
    3014              (read-lock-rwlock ,p)
    3015              ,@body)
    3016         (unlock-rwlock ,p)))))
     3003    `(with-lock-context
     3004      (let* ((,p ,lock))
     3005        (unwind-protect
     3006             (progn
     3007               (read-lock-rwlock ,p)
     3008               ,@body)
     3009          (unlock-rwlock ,p))))))
    30173010
    30183011
     
    30213014its body with the lock held."
    30223015  (let* ((p (gensym)))
    3023     `(let* ((,p ,lock))
     3016    `(with-lock-context
     3017      (let* ((,p ,lock))
    30243018      (unwind-protect
    30253019           (progn
    30263020             (write-lock-rwlock ,p)
    30273021             ,@body)
    3028         (unlock-rwlock ,p)))))
     3022        (unlock-rwlock ,p))))))
    30293023
    30303024
Note: See TracChangeset for help on using the changeset viewer.