Ignore:
Timestamp:
Nov 19, 2012, 5:41:59 PM (7 years ago)
Author:
gb
Message:

Try to clean up code which uses CMPXCHG: imm0 should contain the expected
value (which may or may not be the current value, as of a few cycles before
the CMPXCHG ...). In general, we don't need or want to repeat the CMPXCHG
in order to do a conditional store (failures aren't transient). In cases
where we repeat a CMPXCHG in a loop, ensure that the loop contains a PAUSE
instruction to work correctly with hyperthreading.

Change the x86 pc_luser_xp() to account for changes in
_SPstore_node_conditional and _SPset_hash_key_conditional.

Introduce a WITH-EXCEPTION-LOCK macro; refactor
%LOCK-RECURSIVE-LOCK-OBJECT and friends so that we can lock/unlock a
kernel lock (with no lisp LOCK object around it) without having to
call into the kernel. RECURSIVE-LOCK-WHOSTATE allows its argument to
be a string. (WITH-EXCEPTION-LOCK isn't used anywhere yet; it may be
a better alternative to things like WITHOUT-GCING, where (a) it's
preferable to delay exception handing in other threads than to let
the heap grow and (b) the body is short and doesn't try to grab other
locks.)

This is all intended to fix ticket:1030 in the trunk.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/l0-misc.lisp

    r14619 r15500  
    572572
    573573
     574(eval-when (:compile-toplevel)
     575  (declaim (inline %lock-recursive-lock-ptr %unlock-recursive-lock-ptr)))
    574576
    575577#-futex
     578(defun %lock-recursive-lock-ptr (ptr lock flag)
     579  (with-macptrs ((p)
     580                 (owner (%get-ptr ptr target::lockptr.owner))
     581                 (signal (%get-ptr ptr target::lockptr.signal))
     582                 (spin (%inc-ptr ptr target::lockptr.spinlock)))
     583    (%setf-macptr-to-object p (%current-tcr))
     584    (if (istruct-typep flag 'lock-acquisition)
     585      (setf (lock-acquisition.status flag) nil)
     586      (if flag (report-bad-arg flag 'lock-acquisition)))
     587    (loop
     588      (without-interrupts
     589       (when (eql p owner)
     590         (incf (%get-natural ptr target::lockptr.count))
     591         (when flag
     592           (setf (lock-acquisition.status flag) t))
     593         (return t))
     594       (%get-spin-lock spin)
     595       (when (eql 1 (incf (%get-natural ptr target::lockptr.avail)))
     596         (setf (%get-ptr ptr target::lockptr.owner) p
     597               (%get-natural ptr target::lockptr.count) 1)
     598         (setf (%get-natural spin 0) 0)
     599         (if flag
     600           (setf (lock-acquisition.status flag) t))
     601         (return t))
     602       (setf (%get-natural spin 0) 0))
     603      (%process-wait-on-semaphore-ptr signal 1 0 (recursive-lock-whostate lock)))))
     604
     605#+futex
     606(defun %lock-recursive-lock-ptr (ptr lock flag)
     607  (if (istruct-typep flag 'lock-acquisition)
     608    (setf (lock-acquisition.status flag) nil)
     609    (if flag (report-bad-arg flag 'lock-acquisition)))
     610  (let* ((self (%current-tcr))
     611         (level *interrupt-level*))
     612    (declare (fixnum self))
     613    (without-interrupts
     614     (cond ((eql self (%get-object ptr target::lockptr.owner))
     615            (incf (%get-natural ptr target::lockptr.count)))
     616           (t (%lock-futex ptr level lock #'recursive-lock-whostate)
     617              (%set-object ptr target::lockptr.owner self)
     618              (setf (%get-natural ptr target::lockptr.count) 1)))
     619     (when flag
     620       (setf (lock-acquisition.status flag) t))
     621     t)))
     622 
     623
    576624(defun %lock-recursive-lock-object (lock &optional flag)
    577   (let* ((ptr (recursive-lock-ptr lock)))
    578     (with-macptrs ((p)
    579                    (owner (%get-ptr ptr target::lockptr.owner))
    580                    (signal (%get-ptr ptr target::lockptr.signal))
    581                    (spin (%inc-ptr ptr target::lockptr.spinlock)))
    582       (%setf-macptr-to-object p (%current-tcr))
    583       (if (istruct-typep flag 'lock-acquisition)
    584         (setf (lock-acquisition.status flag) nil)
    585         (if flag (report-bad-arg flag 'lock-acquisition)))
    586       (loop
    587         (without-interrupts
    588          (when (eql p owner)
    589            (incf (%get-natural ptr target::lockptr.count))
    590            (when flag
    591              (setf (lock-acquisition.status flag) t))
    592            (return t))
    593          (%get-spin-lock spin)
    594          (when (eql 1 (incf (%get-natural ptr target::lockptr.avail)))
    595            (setf (%get-ptr ptr target::lockptr.owner) p
    596                  (%get-natural ptr target::lockptr.count) 1)
    597            (setf (%get-natural spin 0) 0)
    598            (if flag
    599              (setf (lock-acquisition.status flag) t))
    600            (return t))
    601          (setf (%get-natural spin 0) 0))
    602         (%process-wait-on-semaphore-ptr signal 1 0 (recursive-lock-whostate lock))))))
     625  (%lock-recursive-lock-ptr (recursive-lock-ptr lock) lock flag))
     626
    603627
    604628
     
    655679
    656680
    657 #+futex
    658 (defun %lock-recursive-lock-object (lock &optional flag)
    659   (if (istruct-typep flag 'lock-acquisition)
    660     (setf (lock-acquisition.status flag) nil)
    661     (if flag (report-bad-arg flag 'lock-acquisition)))
    662   (let* ((self (%current-tcr))
    663          (level *interrupt-level*)
    664          (ptr (recursive-lock-ptr lock)))
    665     (declare (fixnum self))
    666     (without-interrupts
    667      (cond ((eql self (%get-object ptr target::lockptr.owner))
    668             (incf (%get-natural ptr target::lockptr.count)))
    669            (t (%lock-futex ptr level lock #'recursive-lock-whostate)
    670               (%set-object ptr target::lockptr.owner self)
    671               (setf (%get-natural ptr target::lockptr.count) 1)))
    672      (when flag
    673        (setf (lock-acquisition.status flag) t))
    674      t)))
     681
     682
     683
    675684
    676685         
     
    733742
    734743#-futex
    735 (defun %unlock-recursive-lock-object (lock)
    736   (let* ((ptr (%svref lock target::lock._value-cell)))
    737     (with-macptrs ((signal (%get-ptr ptr target::lockptr.signal))
    738                    (spin (%inc-ptr ptr target::lockptr.spinlock)))
    739       (unless (eql (%get-object ptr target::lockptr.owner) (%current-tcr))
    740         (error 'not-lock-owner :lock lock))
    741       (without-interrupts
    742        (when (eql 0 (decf (the fixnum
    743                             (%get-natural ptr target::lockptr.count))))
    744          (%get-spin-lock spin)
    745          (setf (%get-ptr ptr target::lockptr.owner) (%null-ptr))
    746          (let* ((pending (+ (the fixnum
    747                               (1- (the fixnum (%get-fixnum ptr target::lockptr.avail))))
    748                             (the fixnum (%get-fixnum ptr target::lockptr.waiting)))))
    749            (declare (fixnum pending))
    750            (setf (%get-natural ptr target::lockptr.avail) 0
    751                  (%get-natural ptr target::lockptr.waiting) 0)
    752            (decf pending)
    753            (if (> pending 0)
    754              (setf (%get-natural ptr target::lockptr.waiting) pending))
    755            (setf (%get-ptr spin) (%null-ptr))
    756            (if (>= pending 0)
    757              (%signal-semaphore-ptr signal)))))))
    758   nil)
    759 
    760 
    761 
    762 #+futex
    763 (defun %unlock-recursive-lock-object (lock)
    764   (let* ((ptr (%svref lock target::lock._value-cell)))
     744(defun %unlock-recursive-lock-ptr (ptr lock)
     745  (with-macptrs ((signal (%get-ptr ptr target::lockptr.signal))
     746                 (spin (%inc-ptr ptr target::lockptr.spinlock)))
    765747    (unless (eql (%get-object ptr target::lockptr.owner) (%current-tcr))
    766748      (error 'not-lock-owner :lock lock))
     
    768750     (when (eql 0 (decf (the fixnum
    769751                          (%get-natural ptr target::lockptr.count))))
    770     (setf (%get-natural ptr target::lockptr.owner) 0)
    771     (%unlock-futex ptr))))
     752       (%get-spin-lock spin)
     753       (setf (%get-ptr ptr target::lockptr.owner) (%null-ptr))
     754       (let* ((pending (+ (the fixnum
     755                            (1- (the fixnum (%get-fixnum ptr target::lockptr.avail))))
     756                          (the fixnum (%get-fixnum ptr target::lockptr.waiting)))))
     757         (declare (fixnum pending))
     758         (setf (%get-natural ptr target::lockptr.avail) 0
     759               (%get-natural ptr target::lockptr.waiting) 0)
     760         (decf pending)
     761         (if (> pending 0)
     762           (setf (%get-natural ptr target::lockptr.waiting) pending))
     763         (setf (%get-ptr spin) (%null-ptr))
     764         (if (>= pending 0)
     765           (%signal-semaphore-ptr signal)))))
     766    nil))
     767
     768
     769
     770
     771#+futex
     772(defun %unlock-recursive-lock-ptr (ptr lock)
     773  (unless (eql (%get-object ptr target::lockptr.owner) (%current-tcr))
     774    (error 'not-lock-owner :lock lock))
     775  (without-interrupts
     776   (when (eql 0 (decf (the fixnum
     777                        (%get-natural ptr target::lockptr.count))))
     778     (setf (%get-natural ptr target::lockptr.owner) 0)
     779     (%unlock-futex ptr)))
    772780  nil)
     781
     782(defun %unlock-recursive-lock-object (lock)
     783  (%unlock-recursive-lock-ptr (%svref lock target::lock._value-cell) lock))
    773784
    774785
Note: See TracChangeset for help on using the changeset viewer.