Changeset 7723


Ignore:
Timestamp:
Nov 24, 2007, 6:26:27 PM (17 years ago)
Author:
Gary Byers
Message:

Locking changes.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/working-0711/ccl/level-0/l0-misc.lisp

    r7675 r7723  
    5353  (declaim (inline %lock-futex %unlock-futex)))
    5454
    55 ; Miscellany.
     55;;; Miscellany.
    5656
    5757(defun memq (item list)
    … …  
    529529      (yield))))
    530530
     531(eval-when (:compile-toplevel :execute)
     532  (declaim (inline note-lock-wait note-lock-held note-lock-released)))
     533
     534(defun note-lock-wait (lock)
     535  (setq *locks-pending* (%lock-cons lock *locks-pending*)))
     536
     537(defun note-lock-held ()
     538  (let* ((p *locks-pending*))
     539    (setq *locks-pending* (cdr *locks-pending*))
     540    (rplacd p *locks-held*)
     541    (setq *locks-held* p)))
     542
     543(defun note-lock-released ()
     544  (setf (car *locks-held*) nil
     545        *locks-held* (cdr *locks-held*)))
     546
    531547#-futex
    532 (defun %lock-recursive-lock (lock &optional flag)
    533   (with-macptrs ((p)
    534                  (owner (%get-ptr lock target::lockptr.owner))
    535                  (signal (%get-ptr lock target::lockptr.signal))
    536                  (spin (%inc-ptr lock target::lockptr.spinlock)))
    537     (%setf-macptr-to-object p (%current-tcr))
    538     (if (istruct-typep flag 'lock-acquisition)
    539       (setf (lock-acquisition.status flag) nil)
    540       (if flag (report-bad-arg flag 'lock-acquisition)))
    541     (loop
    542       (without-interrupts
    543        (when (eql p owner)
    544          (incf (%get-natural lock target::lockptr.count))
    545          (when flag
    546            (setf (lock-acquisition.status flag) t))
    547          (return t))
    548        (%get-spin-lock spin)
    549        (when (eql 1 (incf (%get-natural lock target::lockptr.avail)))
    550          (setf (%get-ptr lock target::lockptr.owner) p
    551                (%get-natural lock target::lockptr.count) 1)
    552          (setf (%get-natural spin 0) 0)
    553          (if flag
    554            (setf (lock-acquisition.status flag) t))
    555          (return t))
    556        (setf (%get-natural spin 0) 0))
    557       (%process-wait-on-semaphore-ptr signal 1 0 "waiting for lock"))))
     548(defun %lock-recursive-lock-object (lock &optional flag)
     549  (let* ((ptr (recursive-lock-ptr lock)))
     550    (with-macptrs ((p)
     551                   (owner (%get-ptr ptr target::lockptr.owner))
     552                   (signal (%get-ptr ptr target::lockptr.signal))
     553                   (spin (%inc-ptr ptr target::lockptr.spinlock)))
     554      (%setf-macptr-to-object p (%current-tcr))
     555      (if (istruct-typep flag 'lock-acquisition)
     556        (setf (lock-acquisition.status flag) nil)
     557        (if flag (report-bad-arg flag 'lock-acquisition)))
     558      (note-lock-wait lock)
     559      (loop
     560        (without-interrupts
     561         (when (eql p owner)
     562           (incf (%get-natural ptr target::lockptr.count))
     563           (note-lock-held)
     564           (when flag
     565             (setf (lock-acquisition.status flag) t))
     566           (return t))
     567         (%get-spin-lock spin)
     568         (when (eql 1 (incf (%get-natural ptr target::lockptr.avail)))
     569           (setf (%get-ptr ptr target::lockptr.owner) p
     570                 (%get-natural ptr target::lockptr.count) 1)
     571           (setf (%get-natural spin 0) 0)
     572           (note-lock-held)
     573           (if flag
     574             (setf (lock-acquisition.status flag) t))
     575           (return t))
     576         (setf (%get-natural spin 0) 0))
     577        (%process-wait-on-semaphore-ptr signal 1 0 (recursive-lock-whostate lock))))))
     578
     579
    558580
    559581#+futex
    560 (defun futex-wait (p val)
    561   (syscall syscalls::futex p FUTEX-WAIT val (%null-ptr) (%null-ptr) 0))
     582(defun futex-wait (p val whostate)
     583  (with-process-whostate (whostate)
     584    (syscall syscalls::futex p FUTEX-WAIT val (%null-ptr) (%null-ptr) 0)))
    562585
    563586#+futex
    … …  
    566589
    567590#+futex
    568 (defun %lock-futex (p wait-level)
     591(defun %lock-futex (p wait-level whostate)
    569592  (let* ((val (%ptr-store-conditional p futex-avail futex-locked)))
    570593    (declare (fixnum val))
    … …  
    573596          (if (eql val futex-contended)
    574597            (let* ((*interrupt-level* wait-level))
    575               (futex-wait p val))
     598              (futex-wait p val whostate))
    576599            (setq val futex-contended))
    577600          (when (eql futex-avail (xchgl val p))
    … …  
    585608
    586609
     610
     611
    587612#+futex
    588 (defun %lock-recursive-lock (lock &optional flag)
     613(defun %lock-recursive-lock-object (lock &optional flag)
    589614  (if (istruct-typep flag 'lock-acquisition)
    590615    (setf (lock-acquisition.status flag) nil)
    591616    (if flag (report-bad-arg flag 'lock-acquisition)))
    592617  (let* ((self (%current-tcr))
    593          (level *interrupt-level*))
     618         (level *interrupt-level*)
     619         (ptr (recursive-lock-ptr lock)))
    594620    (declare (fixnum self val))
     621    (note-lock-wait lock)
    595622    (without-interrupts
    596      (cond ((eql self (%get-object lock target::lockptr.owner))
    597             (incf (%get-natural lock target::lockptr.count)))
    598            (t (%lock-futex lock level)
    599               (%set-object lock target::lockptr.owner self)
    600               (setf (%get-natural lock target::lockptr.count) 1)))
     623     (cond ((eql self (%get-object ptr target::lockptr.owner))
     624            (incf (%get-natural ptr target::lockptr.count)))
     625           (t (%lock-futex ptr level (recursive-lock-whostate lock))
     626              (%set-object ptr target::lockptr.owner self)
     627              (setf (%get-natural ptr target::lockptr.count) 1)))
     628     (note-lock-held)
    601629     (when flag
    602630       (setf (lock-acquisition.status flag) t))
    … …  
    605633         
    606634
    607 ;;; Locking the exception lock to inhibit GC (from other threads)
    608 ;;; is probably a bad idea, though it does simplify some issues.
    609 ;;; (One bad consequence is that it means that only one hash table
    610 ;;; can be accessed at a time.)
    611 #+bad-idea
    612 (defun %lock-gc-lock ()
    613   (with-macptrs ((lock))
    614     (%get-kernel-global-ptr exception-lock lock)
    615     (%lock-recursive-lock lock)))
    616 
    617 #+bad-idea
    618 (defun %unlock-gc-lock ()
    619   (with-macptrs ((lock))
    620     (%get-kernel-global-ptr exception-lock lock)
    621     (%unlock-recursive-lock lock)))
     635
     636
    622637
    623638#-futex
    624 (defun %try-recursive-lock (lock &optional flag)
     639(defun %try-recursive-lock-object (lock &optional flag)
    625640  (with-macptrs ((p)
    626                  (owner (%get-ptr lock target::lockptr.owner))
    627                  (spin (%inc-ptr lock target::lockptr.spinlock)))
     641                 (owner (%get-ptr ptr target::lockptr.owner))
     642                 (spin (%inc-ptr ptr target::lockptr.spinlock)))
    628643    (%setf-macptr-to-object p (%current-tcr))
    629644    (if flag
    … …  
    633648    (without-interrupts
    634649     (cond ((eql p owner)
    635             (incf (%get-natural lock target::lockptr.count))
     650            (incf (%get-natural ptr target::lockptr.count))
     651            (setq *locks-held* (%lock-cons lock *locks-held*))
    636652            (if flag (setf (lock-acquisition.status flag) t))
    637653            t)
    … …  
    639655            (let* ((win nil))
    640656              (%get-spin-lock spin)
    641               (when (setq win (eql 1 (incf (%get-natural lock target::lockptr.avail))))
    642                 (setf (%get-ptr lock target::lockptr.owner) p
    643                       (%get-natural lock target::lockptr.count) 1)
     657              (when (setq win (eql 1 (incf (%get-natural ptr target::lockptr.avail))))
     658                (setf (%get-ptr ptr target::lockptr.owner) p
     659                      (%get-natural ptr target::lockptr.count) 1)
     660                (setq *locks-held* (%lock-cons lock *locks-held*))
    644661                (if flag (setf (lock-acquisition.status flag) t)))
    645662              (setf (%get-ptr spin) (%null-ptr))
    646663              win))))))
    647664
     665
     666
    648667#+futex
    649 (defun %try-recursive-lock (lock &optional flag)
    650   (let* ((self (%current-tcr)))
     668(defun %try-recursive-lock-object (lock &optional flag)
     669  (let* ((self (%current-tcr))
     670         (ptr (recursive-lock-ptr lock)))
    651671    (declare (fixnum self))
    652672    (if flag
    … …  
    655675        (report-bad-arg flag 'lock-acquisition)))
    656676    (without-interrupts
    657      (cond ((eql (%get-object lock target::lockptr.owner) self)
    658             (incf (%get-natural lock target::lockptr.count))
     677     (cond ((eql (%get-object ptr target::lockptr.owner) self)
     678            (incf (%get-natural ptr target::lockptr.count))
     679            (setq *locks-held* (%lock-cons lock *locks-held*))
    659680            (if flag (setf (lock-acquisition.status flag) t))
    660681            t)
    661682           (t
    662             (when (eql 0 (%ptr-store-conditional lock futex-avail futex-locked))
    663               (%set-object lock target::lockptr.owner self)
    664               (setf (%get-natural lock target::lockptr.count) 1)
     683            (when (eql 0 (%ptr-store-conditional ptr futex-avail futex-locked))
     684              (%set-object ptr target::lockptr.owner self)
     685              (setf (%get-natural ptr target::lockptr.count) 1)             
     686              (setq *locks-held* (%lock-cons lock *locks-held*))
    665687              (if flag (setf (lock-acquisition.status flag) t))
    666688              t))))))
    … …  
    668690
    669691
     692
     693
    670694#-futex
    671 (defun %unlock-recursive-lock (lock)
    672   (with-macptrs ((signal (%get-ptr lock target::lockptr.signal))
    673                  (spin (%inc-ptr lock target::lockptr.spinlock)))
    674     (unless (eql (%get-object lock target::lockptr.owner) (%current-tcr))
     695(defun %unlock-recursive-lock-object (lock)
     696  (let* ((ptr (%svref lock target::lock._value-cell)))
     697    (with-macptrs ((signal (%get-ptr ptr target::lockptr.signal))
     698                   (spin (%inc-ptr ptr target::lockptr.spinlock)))
     699      (unless (eql (%get-object ptr target::lockptr.owner) (%current-tcr))
     700        (error 'not-lock-owner :lock lock))
     701      (without-interrupts
     702       (when (eql 0 (decf (the fixnum
     703                            (%get-natural ptr target::lockptr.count))))
     704         (note-lock-released)
     705         (%get-spin-lock spin)
     706         (setf (%get-ptr ptr target::lockptr.owner) (%null-ptr))
     707         (let* ((pending (+ (the fixnum
     708                              (1- (the fixnum (%get-fixnum ptr target::lockptr.avail))))
     709                            (the fixnum (%get-fixnum ptr target::lockptr.waiting)))))
     710           (declare (fixnum pending))
     711           (setf (%get-natural ptr target::lockptr.avail) 0
     712                 (%get-natural ptr target::lockptr.waiting) 0)
     713           (decf pending)
     714           (if (> pending 0)
     715             (setf (%get-natural ptr target::lockptr.waiting) pending))
     716           (setf (%get-ptr spin) (%null-ptr))
     717           (if (>= pending 0)
     718             (%signal-semaphore-ptr signal)))))))
     719  nil)
     720
     721
     722
     723#+futex
     724(defun %unlock-recursive-lock-object (lock)
     725  (let* ((ptr (%svref lock target::lock._value-cell)))
     726    (unless (eql (%get-object ptr target::lockptr.owner) (%current-tcr))
    675727      (error 'not-lock-owner :lock lock))
    676728    (without-interrupts
    677729     (when (eql 0 (decf (the fixnum
    678                           (%get-natural lock target::lockptr.count))))
    679        (%get-spin-lock spin)
    680        (setf (%get-ptr lock target::lockptr.owner) (%null-ptr))
    681        (let* ((pending (+ (the fixnum
    682                             (1- (the fixnum (%get-fixnum lock target::lockptr.avail))))
    683                           (the fixnum (%get-fixnum lock target::lockptr.waiting)))))
    684          (declare (fixnum pending))
    685          (setf (%get-natural lock target::lockptr.avail) 0
    686                (%get-natural lock target::lockptr.waiting) 0)
    687          (decf pending)
    688          (if (> pending 0)
    689            (setf (%get-natural lock target::lockptr.waiting) pending))
    690          (setf (%get-ptr spin) (%null-ptr))
    691          (if (>= pending 0)
    692            (%signal-semaphore-ptr signal))))))
    693     nil)
    694 
    695 #+futex
    696 (defun %unlock-recursive-lock (lock)
    697   (unless (eql (%get-object lock target::lockptr.owner) (%current-tcr))
    698     (error 'not-lock-owner :lock lock))
    699   (without-interrupts
    700    (when (eql 0 (decf (the fixnum
    701                         (%get-natural lock target::lockptr.count))))
    702      (setf (%get-natural lock target::lockptr.owner) 0)
    703      (%unlock-futex lock)))
    704     nil)
     730                          (%get-natural ptr target::lockptr.count))))
     731    (note-lock-released)
     732    (setf (%get-natural ptr target::lockptr.owner) 0)
     733    (%unlock-futex ptr))))
     734  nil)
    705735
    706736
    … …  
    793823;;; signaled before we abandon interest in it
    794824#-futex
    795 (defun %write-lock-rwlock-ptr (ptr &optional flag)
     825(defun %write-lock-rwlock-ptr (ptr lock &optional flag)
    796826  (with-macptrs ((write-signal (%get-ptr ptr target::rwlock.writer-signal)) )
    797827    (if (istruct-typep flag 'lock-acquisition)
    … …  
    801831           (tcr (%current-tcr)))
    802832      (declare (fixnum tcr))
     833      (note-lock-wait lock)
    803834      (without-interrupts
    804835       (%get-spin-lock ptr)               ;(%get-spin-lock (%inc-ptr ptr target::rwlock.spin))
    … …  
    807838           (incf (%get-signed-natural ptr target::rwlock.state))
    808839           (setf (%get-natural ptr target::rwlock.spin) 0)
     840           (note-lock-held)
    809841           (if flag
    810842             (setf (lock-acquisition.status flag) t))
    … …  
    813845              ((eql 0 (%get-signed-natural ptr target::rwlock.state))
    814846               ;; That wasn't so bad, was it ?  We have the spinlock now.
     847               (note-lock-held)
    815848               (setf (%get-signed-natural ptr target::rwlock.state) 1
    816849                     (%get-natural ptr target::rwlock.spin) 0)
    … …  
    822855           (setf (%get-natural ptr target::rwlock.spin) 0)
    823856           (let* ((*interrupt-level* level))
    824                   (%process-wait-on-semaphore-ptr write-signal 1 0 "write lock wait"))
     857                  (%process-wait-on-semaphore-ptr write-signal 1 0 (rwlock-write-whostate lock)))
    825858           (%get-spin-lock ptr)))))))
    826859#+futex
    827 (defun %write-lock-rwlock-ptr (ptr &optional flag)
     860(defun %write-lock-rwlock-ptr (ptr lock &optional flag)
    828861  (with-macptrs ((write-signal (%INC-ptr ptr target::rwlock.writer-signal)) )
    829862    (if (istruct-typep flag 'lock-acquisition)
    … …  
    833866           (tcr (%current-tcr)))
    834867      (declare (fixnum tcr))
     868      (note-lock-wait lock)
    835869      (without-interrupts
    836        (%lock-futex ptr level)               ;(%get-spin-lock (%inc-ptr ptr target::rwlock.spin))
     870       (%lock-futex ptr level "futex wait")               ;(%get-spin-lock (%inc-ptr ptr target::rwlock.spin))
    837871       (if (eq (%get-object ptr target::rwlock.writer) tcr)
    838872         (progn
    839873           (incf (%get-signed-natural ptr target::rwlock.state))
    840874           (%unlock-futex ptr)
     875           (note-lock-held)
    841876           (if flag
    842877             (setf (lock-acquisition.status flag) t))
    … …  
    845880              ((eql 0 (%get-signed-natural ptr target::rwlock.state))
    846881               ;; That wasn't so bad, was it ?  We have the spinlock now.
     882               (note-lock-held)
    847883               (setf (%get-signed-natural ptr target::rwlock.state) 1)
    848884               (%unlock-futex ptr)
    … …  
    854890           (let* ((waitval (%get-natural write-signal 0)))
    855891             (%unlock-futex ptr)
    856              (let* ((*interrupt-level* level))
    857                (futex-wait write-signal waitval)))
    858            (%lock-futex ptr level)
     892             (with-process-whostate ((rwlock-write-whostate lock))
     893               (let* ((*interrupt-level* level))
     894                 (futex-wait write-signal waitval (rwlock-write-whostate lock)))))
     895           (%lock-futex ptr level "futex wait")
    859896           (decf (%get-natural ptr target::rwlock.blocked-writers))))))))
    860897
    … …  
    862899
    863900(defun write-lock-rwlock (lock &optional flag)
    864   (%write-lock-rwlock-ptr (read-write-lock-ptr lock) flag))
     901  (%write-lock-rwlock-ptr (read-write-lock-ptr lock) lock flag))
    865902
    866903#-futex
    … …  
    873910           (tcr (%current-tcr)))
    874911      (declare (fixnum tcr))
     912      (note-lock-wait lock)
    875913      (without-interrupts
    876914       (%get-spin-lock ptr)             ;(%get-spin-lock (%inc-ptr ptr target::rwlock.spin))
    … …  
    878916         (progn
    879917           (setf (%get-natural ptr target::rwlock.spin) 0)
     918           (setq *locks-pending* (cdr *locks-pending*))
    880919           (error 'deadlock :lock lock))
    881920         (do* ((state
    … …  
    887926                     (the fixnum (1- state))
    888927                     (%get-natural ptr target::rwlock.spin) 0)
     928               (note-lock-held)
    889929               (if flag
    890930                 (setf (lock-acquisition.status flag) t))
    … …  
    894934           (setf (%get-natural ptr target::rwlock.spin) 0)
    895935           (let* ((*interrupt-level* level))
    896              (%process-wait-on-semaphore-ptr read-signal 1 0 "read lock wait"))
     936             (%process-wait-on-semaphore-ptr read-signal 1 0 (rwlock-read-whostate lock)))
    897937           (%get-spin-lock ptr)))))))
    898938
    … …  
    906946           (tcr (%current-tcr)))
    907947      (declare (fixnum tcr))
     948      (note-lock-wait lock)
    908949      (without-interrupts
    909        (%lock-futex ptr level)
     950       (%lock-futex ptr level "futex wait")
    910951       (if (eq (%get-object ptr target::rwlock.writer) tcr)
    911952         (progn
    912953           (%unlock-futex ptr)
     954           (setq *locks-pending* (cdr *locks-pending*))
    913955           (error 'deadlock :lock lock))
    914956         (do* ((state
    … …  
    919961               (setf (%get-signed-natural ptr target::rwlock.state)
    920962                     (the fixnum (1- state)))
     963               (note-lock-held)
    921964               (%unlock-futex ptr)
    922965               (if flag
    … …  
    928971             (%unlock-futex ptr)
    929972             (let* ((*interrupt-level* level))
    930                (futex-wait reader-signal waitval)))
    931            (%lock-futex ptr level)
     973               (futex-wait reader-signal waitval (rwlock-read-whostate lock))))
     974           (%lock-futex ptr level "futex wait")
    932975           (decf (%get-natural ptr target::rwlock.blocked-readers))))))))
    933976
    … …  
    937980  (%read-lock-rwlock-ptr (read-write-lock-ptr lock) lock flag))
    938981
    939 ;;; If the current thread already owns the lock for writing, increment
    940 ;;; the lock's state.  Otherwise, try to lock the lock for reading.
    941 (defun %ensure-at-least-read-locked (lock &optional flag)
    942   (if (istruct-typep flag 'lock-acquisition)
    943     (setf (lock-acquisition.status flag) nil)
    944     (if flag (report-bad-arg flag 'lock-acquisition)))
    945   (let* ((ptr (read-write-lock-ptr lock))
    946          (tcr (%current-tcr))
    947          #+futex (level *interrupt-level*))
    948     (declare (fixnum tcr))
    949     (or
    950      (without-interrupts
    951       #+futex
    952       (%lock-futex ptr level)
    953       #-futex
    954       (%get-spin-lock ptr)
    955       (let* ((state (%get-signed-natural ptr target::rwlock.state)))
    956         (declare (fixnum state))
    957         (let ((win
    958                (cond ((<= state 0)
    959                       (setf (%get-signed-natural ptr target::rwlock.state)
    960                             (the fixnum (1- state)))
    961                       t)
    962                      ((%ptr-eql (%get-ptr ptr target::rwlock.writer) tcr)
    963                       (setf (%get-signed-natural ptr target::rwlock.state)
    964                             (the fixnum (1+ state)))
    965                       t))))
    966           #+futex
    967           (%unlock-futex ptr)
    968           #-futex
    969           (setf (%get-natural ptr target::rwlock.spin) 0)
    970           (when win
    971             (if flag
    972               (setf (lock-acquisition.status flag) t))
    973             t))))
    974        (%read-lock-rwlock-ptr ptr lock flag))))
     982
    975983
    976984#-futex
    … …  
    10131021         ;; are cleared here (they can't be changed from another thread
    10141022         ;; until this thread releases the spinlock.)
     1023         (note-lock-released)
    10151024         (setf (%get-signed-natural ptr target::rwlock.writer) 0)
    10161025         (let* ((nwriters (%get-natural ptr target::rwlock.blocked-writers))
    … …  
    10351044           (wakeup 0))
    10361045    (without-interrupts
    1037      (%lock-futex ptr -1)
     1046     (%lock-futex ptr -1 "futex wait")
    10381047     (let* ((state (%get-signed-natural ptr target::rwlock.state))
    10391048            (tcr (%current-tcr)))
    … …  
    10491058       (setf (%get-signed-natural ptr target::rwlock.state) state)
    10501059       (when (zerop state)
     1060         (note-lock-released)
    10511061         (setf (%get-signed-natural ptr target::rwlock.writer) 0)
    10521062         (let* ((nwriters (%get-natural ptr target::rwlock.blocked-writers))
    … …  
    10851095      (without-interrupts
    10861096       #+futex
    1087        (%lock-futex ptr level)
     1097       (%lock-futex ptr level "futex wait")
    10881098       #-futex
    10891099       (%get-spin-lock ptr)
Note: See TracChangeset for help on using the changeset viewer.