Changeset 7545 for branches/working-0710


Ignore:
Timestamp:
Oct 29, 2007, 6:47:20 AM (12 years ago)
Author:
gb
Message:

(Optionally, conditionally) use futexes instead of spin-locks.
Currently disabled (see the ugly #+(and nil ...) near the top of the file.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0710/ccl/level-0/l0-misc.lisp

    r7515 r7545  
    1616
    1717(in-package "CCL")
     18
     19;;; Bootstrapping for futexes
     20#+(and nil linuxx8664-target)
     21(eval-when (:compile-toplevel :execute)
     22  (pushnew :futex *features*))
     23
     24#+futex
     25(eval-when (:compile-toplevel :execute)
     26  (or  #$?FUTEX_WAKE (error "Need new interfaces to compile this code."))
     27  (defconstant futex-avail 0)
     28  (defconstant futex-locked 1)
     29  (defconstant futex-contended 2)
     30  (require "X8664-LINUX-SYSCALLS")
     31  (declaim (inline %lock-futex %unlock-futex)))
    1832
    1933; Miscellany.
     
    481495(defparameter *spin-lock-timeouts* 0)
    482496
     497#-futex
    483498(defun %get-spin-lock (p)
    484499  (let* ((self (%current-tcr))
     
    492507      (yield))))
    493508
     509#-futex
    494510(defun %lock-recursive-lock (lock &optional flag)
    495511  (with-macptrs ((p)
     
    519535      (%process-wait-on-semaphore-ptr signal 1 0 "waiting for lock"))))
    520536
     537#+futex
     538(defun futex-wait (p val)
     539  (syscall syscalls::futex p #$FUTEX_WAIT val (%null-ptr) (%null-ptr) 0))
     540
     541#+futex
     542(defun futex-wake (p n)
     543  (syscall syscalls::futex p #$FUTEX_WAKE n (%null-ptr) (%null-ptr) 0))
     544
     545#+futex
     546(defun %lock-futex (p wait-level)
     547  (let* ((val (%ptr-store-conditional p futex-avail futex-locked)))
     548    (declare (fixnum val))
     549    (or (eql val futex-avail)
     550        (loop
     551          (if (eql val futex-contended)
     552            (let* ((*interrupt-level* wait-level))
     553              (futex-wait p val))
     554            (setq val futex-contended))
     555          (when (eql futex-avail (xchgl val p))
     556            (return t))))))
     557
     558#+futex
     559(defun %unlock-futex (p)
     560  (unless (eql futex-avail (%atomic-decf-ptr p))
     561    (setf (%get-natural p target::lockptr.avail) futex-avail)
     562    (futex-wake p #$INT_MAX)))
     563
     564
     565#+futex
     566(defun %lock-recursive-lock (lock &optional flag)
     567  (if (istruct-typep flag 'lock-acquisition)
     568    (setf (lock-acquisition.status flag) nil)
     569    (if flag (report-bad-arg flag 'lock-acquisition)))
     570  (let* ((self (%current-tcr))
     571         (level *interrupt-level*))
     572    (declare (fixnum self val))
     573    (without-interrupts
     574     (cond ((eql self (%get-object lock target::lockptr.owner))
     575            (incf (%get-natural lock target::lockptr.count)))
     576           (t (%lock-futex lock level)
     577              (%set-object lock target::lockptr.owner self)
     578              (setf (%get-natural lock target::lockptr.count) 1)))
     579     (when flag
     580       (setf (lock-acquisition.status flag) t))
     581     t)))
     582
     583         
    521584
    522585;;; Locking the exception lock to inhibit GC (from other threads)
     
    536599    (%unlock-recursive-lock lock)))
    537600
     601#-futex
    538602(defun %try-recursive-lock (lock &optional flag)
    539603  (with-macptrs ((p)
     
    560624              win))))))
    561625
    562 
     626#+futex
     627(defun %try-recursive-lock (lock &optional flag)
     628  (let* ((self (%current-tcr)))
     629    (declare (fixnum self))
     630    (if flag
     631      (if (istruct-typep flag 'lock-acquisition)
     632        (setf (lock-acquisition.status flag) nil)
     633        (report-bad-arg flag 'lock-acquisition)))
     634    (without-interrupts
     635     (cond ((eql (%get-object lock target::lockptr.owner) self)
     636            (incf (%get-natural lock target::lockptr.count))
     637            (if flag (setf (lock-acquisition.status flag) t))
     638            t)
     639           (t
     640            (when (eql 0 (%ptr-store-conditional lock futex-avail futex-locked))
     641              (%set-object lock target::lockptr.owner self)
     642              (setf (%get-natural lock target::lockptr.count) 1)
     643              (if flag (setf (lock-acquisition.status flag) t))
     644              t))))))
     645
     646
     647
     648#-futex
    563649(defun %unlock-recursive-lock (lock)
    564650  (with-macptrs ((signal (%get-ptr lock target::lockptr.signal))
     
    585671    nil)
    586672
     673#+futex
     674(defun %unlock-recursive-lock (lock)
     675  (unless (eql (%get-object lock target::lockptr.owner) (%current-tcr))
     676    (error 'not-lock-owner :lock lock))
     677  (without-interrupts
     678   (when (eql 0 (decf (the fixnum
     679                        (%get-natural lock target::lockptr.count))))
     680     (setf (%get-natural lock target::lockptr.owner) 0)
     681     (%unlock-futex lock)))
     682    nil)
     683
     684
     685
    587686
    588687(defun %%lock-owner (lock)
     
    660759;;; and we abort out of the semaphore wait ?  If the writer semaphore is
    661760;;; signaled before we abandon interest in it
     761#-futex
    662762(defun %write-lock-rwlock-ptr (ptr &optional flag)
    663763  (with-macptrs ((write-signal (%get-ptr ptr target::rwlock.writer-signal)) )
     
    691791                  (%process-wait-on-semaphore-ptr write-signal 1 0 "write lock wait"))
    692792           (%get-spin-lock ptr)))))))
     793#+futex
     794(defun %write-lock-rwlock-ptr (ptr &optional flag)
     795  (with-macptrs ((write-signal (%INC-ptr ptr target::rwlock.writer-signal)) )
     796    (if (istruct-typep flag 'lock-acquisition)
     797      (setf (lock-acquisition.status flag) nil)
     798      (if flag (report-bad-arg flag 'lock-acquisition)))
     799    (let* ((level *interrupt-level*)
     800           (tcr (%current-tcr)))
     801      (declare (fixnum tcr))
     802      (without-interrupts
     803       (%lock-futex ptr level)               ;(%get-spin-lock (%inc-ptr ptr target::rwlock.spin))
     804       (if (eq (%get-object ptr target::rwlock.writer) tcr)
     805         (progn
     806           (incf (%get-signed-natural ptr target::rwlock.state))
     807           (%unlock-futex ptr)
     808           (if flag
     809             (setf (lock-acquisition.status flag) t))
     810           t)
     811         (do* ()
     812              ((eql 0 (%get-signed-natural ptr target::rwlock.state))
     813               ;; That wasn't so bad, was it ?  We have the spinlock now.
     814               (setf (%get-signed-natural ptr target::rwlock.state) 1)
     815               (%unlock-futex ptr)
     816               (%set-object ptr target::rwlock.writer tcr)
     817               (if flag
     818                 (setf (lock-acquisition.status flag) t))
     819               t)
     820           (incf (%get-natural ptr target::rwlock.blocked-writers))
     821           (let* ((waitval (%get-natural write-signal 0)))
     822             (%unlock-futex ptr)
     823             (let* ((*interrupt-level* level))
     824               (futex-wait write-signal waitval)))
     825           (%lock-futex ptr level)
     826           (decf (%get-natural ptr target::rwlock.blocked-writers))))))))
     827
     828
    693829
    694830(defun write-lock-rwlock (lock &optional flag)
    695831  (%write-lock-rwlock-ptr (read-write-lock-ptr lock) flag))
    696832
     833#-futex
    697834(defun %read-lock-rwlock-ptr (ptr lock &optional flag)
    698835  (with-macptrs ((read-signal (%get-ptr ptr target::rwlock.reader-signal)))
     
    727864           (%get-spin-lock ptr)))))))
    728865
     866#+futex
     867(defun %read-lock-rwlock-ptr (ptr lock &optional flag)
     868  (with-macptrs ((reader-signal (%INC-ptr ptr target::rwlock.reader-signal)))
     869    (if (istruct-typep flag 'lock-acquisition)
     870      (setf (lock-acquisition.status flag) nil)
     871      (if flag (report-bad-arg flag 'lock-acquisition)))
     872    (let* ((level *interrupt-level*)
     873           (tcr (%current-tcr)))
     874      (declare (fixnum tcr))
     875      (without-interrupts
     876       (%lock-futex ptr level)
     877       (if (eq (%get-object ptr target::rwlock.writer) tcr)
     878         (progn
     879           (%unlock-futex ptr)
     880           (error 'deadlock :lock lock))
     881         (do* ((state
     882                (%get-signed-natural ptr target::rwlock.state)
     883                (%get-signed-natural ptr target::rwlock.state)))
     884              ((<= state 0)
     885               ;; That wasn't so bad, was it ?  We have the spinlock now.
     886               (setf (%get-signed-natural ptr target::rwlock.state)
     887                     (the fixnum (1- state)))
     888               (%unlock-futex ptr)
     889               (if flag
     890                 (setf (lock-acquisition.status flag) t))
     891               t)
     892           (declare (fixnum state))
     893           (incf (%get-natural ptr target::rwlock.blocked-readers))
     894           (let* ((waitval (%get-natural reader-signal 0)))
     895             (%unlock-futex ptr)
     896             (let* ((*interrupt-level* level))
     897               (futex-wait reader-signal waitval)))
     898           (%lock-futex ptr level)
     899           (decf (%get-natural ptr target::rwlock.blocked-readers))))))))
     900
     901
     902
    729903(defun read-lock-rwlock (lock &optional flag)
    730904  (%read-lock-rwlock-ptr (read-write-lock-ptr lock) lock flag))
     
    737911    (if flag (report-bad-arg flag 'lock-acquisition)))
    738912  (let* ((ptr (read-write-lock-ptr lock))
    739          (tcr (%current-tcr)))
     913         (tcr (%current-tcr))
     914         #+futex (level *interrupt-level*))
    740915    (declare (fixnum tcr))
    741916    (or
    742917     (without-interrupts
     918      #+futex
     919      (%lock-futex ptr level)
     920      #-futex
    743921      (%get-spin-lock ptr)
    744922      (let* ((state (%get-signed-natural ptr target::rwlock.state)))
     
    753931                            (the fixnum (1+ state)))
    754932                      t))))
     933          #+futex
     934          (%unlock-futex ptr)
     935          #-futex
    755936          (setf (%get-natural ptr target::rwlock.spin) 0)
    756937          (when win
     
    760941       (%read-lock-rwlock-ptr ptr lock flag))))
    761942
     943#-futex
    762944(defun %unlock-rwlock-ptr (ptr lock)
    763945  (with-macptrs ((reader-signal (%get-ptr ptr target::rwlock.reader-signal))
     
    813995       t))))
    814996
     997#+futex
     998(defun %unlock-rwlock-ptr (ptr lock)
     999  (with-macptrs ((reader-signal (%INC-ptr ptr target::rwlock.reader-signal))
     1000                 (writer-signal (%INC-ptr ptr target::rwlock.writer-signal)))
     1001    (let* ((signal nil)
     1002           (wakeup 0))
     1003    (without-interrupts
     1004     (%lock-futex ptr -1)
     1005     (let* ((state (%get-signed-natural ptr target::rwlock.state))
     1006            (tcr (%current-tcr)))
     1007       (declare (fixnum state tcr))
     1008       (cond ((> state 0)
     1009              (unless (eql tcr (%get-object ptr target::rwlock.writer))
     1010                (%unlock-futex ptr)
     1011                (error 'not-lock-owner :lock lock))
     1012              (decf state))
     1013             ((< state 0) (incf state))
     1014             (t (%unlock-futex ptr)
     1015                (error 'not-locked :lock lock)))
     1016       (setf (%get-signed-natural ptr target::rwlock.state) state)
     1017       (when (zerop state)
     1018         (setf (%get-signed-natural ptr target::rwlock.writer) 0)
     1019         (let* ((nwriters (%get-natural ptr target::rwlock.blocked-writers))
     1020                (nreaders (%get-natural ptr target::rwlock.blocked-readers)))
     1021           (declare (fixnum nreaders nwriters))
     1022           (if (> nwriters 0)
     1023             (setq signal writer-signal wakeup 1)
     1024             (if (> nreaders 0)
     1025               (setq signal reader-signal wakeup #$INT_MAX)))))
     1026       (when signal (incf (%get-signed-natural signal 0)))
     1027       (%unlock-futex ptr)
     1028       (when signal (futex-wake signal wakeup))
     1029       t)))))
     1030
     1031
    8151032(defun unlock-rwlock (lock)
    8161033  (%unlock-rwlock-ptr (read-write-lock-ptr lock) lock))
     
    8341051           (tcr (%current-tcr)))
    8351052      (without-interrupts
     1053       #+futex
     1054       (%lock-futex ptr level)
     1055       #-futex
    8361056       (%get-spin-lock ptr)
    8371057       (let* ((state (%get-signed-natural ptr target::rwlock.state)))
     
    8391059         (cond ((> state 0)
    8401060                (unless (eql (%get-object ptr target::rwlock.writer) tcr)
     1061                  #+futex
     1062                  (%unlock-futex ptr)
     1063                  #-futex
    8411064                  (setf (%get-natural ptr target::rwlock.spin) 0)
    8421065                  (error :not-lock-owner :lock lock)))
    8431066               ((= state 0)
    844                   (setf (%get-natural ptr target::rwlock.spin) 0)
    845                   (error :not-locked :lock lock))
     1067                #+futex (%unlock-futex ptr)
     1068                #-futex (setf (%get-natural ptr target::rwlock.spin) 0)
     1069                (error :not-locked :lock lock))
    8461070               (t
    8471071                (if (= state -1)
    8481072                  (progn
    849                     (setf (%get-signed-natural ptr target::rwlock.state) 1
    850                           (%get-natural ptr target::rwlock.spin) 0)
     1073                    (setf (%get-signed-natural ptr target::rwlock.state) 1)
    8511074                    (%set-object ptr target::rwlock.writer tcr)
     1075                    #+futex
     1076                    (%unlock-futex ptr)
     1077                    #-futex
     1078                    (setf (%get-natural ptr target::rwlock.spin) 0)
    8521079                    (if flag
    8531080                      (setf (lock-acquisition.status flag) t))
     
    8581085                      (%write-lock-rwlock-ptr ptr flag)))))))))))
    8591086                     
    860                
    861            
    862            
    863  
    8641087
    8651088
Note: See TracChangeset for help on using the changeset viewer.