;;; does not matter whether a signal occurs during construction of a
;;; dynamic-extent object, as the half-finished construction of the
;;; object will not cause any difficulty. We can therefore elide
-(defvar *dynamic-extent* nil)
+(defmacro maybe-pseudo-atomic (really-p &body forms)
+ `(if ,really-p
+ (progn ,@forms)
+ (pseudo-atomic ,@forms)))
#!+sb-thread
(defmacro pseudo-atomic (&rest forms)
(with-unique-names (label)
- `(if *dynamic-extent* ; I will burn in hell
- (progn ,@forms)
- (let ((,label (gen-label)))
- (inst fs-segment-prefix)
- (inst mov (make-ea :byte
- :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0)
- (inst fs-segment-prefix)
- (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1)
- ,@forms
- (inst fs-segment-prefix)
- (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 0)
- (inst fs-segment-prefix)
- (inst cmp (make-ea :byte
- :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0)
- (inst jmp :eq ,label)
- ;; if PAI was set, interrupts were disabled at the same
- ;; time using the process signal mask.
- (inst break pending-interrupt-trap)
- (emit-label ,label)))))
+ `(let ((,label (gen-label)))
+ (inst fs-segment-prefix)
+ (inst mov (make-ea :byte
+ :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0)
+ (inst fs-segment-prefix)
+ (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1)
+ ,@forms
+ (inst fs-segment-prefix)
+ (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 0)
+ (inst fs-segment-prefix)
+ (inst cmp (make-ea :byte
+ :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0)
+ (inst jmp :eq ,label)
+ ;; if PAI was set, interrupts were disabled at the same
+ ;; time using the process signal mask.
+ (inst break pending-interrupt-trap)
+ (emit-label ,label))))
#!-sb-thread
(defmacro pseudo-atomic (&rest forms)
(with-unique-names (label)
- `(if *dynamic-extent*
- (progn ,@forms)
- (let ((,label (gen-label)))
- ;; FIXME: The MAKE-EA noise should become a MACROLET macro
- ;; or something. (perhaps SVLB, for static variable low
- ;; byte)
- (inst mov (make-ea :byte :disp (+ nil-value
- (static-symbol-offset
- '*pseudo-atomic-interrupted*)
- (ash symbol-value-slot word-shift)
- ;; FIXME: Use mask, not minus, to
- ;; take out type bits.
- (- other-pointer-lowtag)))
- 0)
- (inst mov (make-ea :byte :disp (+ nil-value
- (static-symbol-offset
- '*pseudo-atomic-atomic*)
- (ash symbol-value-slot word-shift)
- (- other-pointer-lowtag)))
- (fixnumize 1))
- ,@forms
- (inst mov (make-ea :byte :disp (+ nil-value
- (static-symbol-offset
- '*pseudo-atomic-atomic*)
- (ash symbol-value-slot word-shift)
- (- other-pointer-lowtag)))
- 0)
- ;; KLUDGE: Is there any requirement for interrupts to be
- ;; handled in order? It seems as though an interrupt coming
- ;; in at this point will be executed before any pending
- ;; interrupts. Or do incoming interrupts check to see
- ;; whether any interrupts are pending? I wish I could find
- ;; the documentation for pseudo-atomics.. -- WHN 19991130
- (inst cmp (make-ea :byte
- :disp (+ nil-value
- (static-symbol-offset
- '*pseudo-atomic-interrupted*)
- (ash symbol-value-slot word-shift)
- (- other-pointer-lowtag)))
- 0)
- (inst jmp :eq ,label)
- ;; if PAI was set, interrupts were disabled at the same
- ;; time using the process signal mask.
- (inst break pending-interrupt-trap)
- (emit-label ,label)))))
+ `(let ((,label (gen-label)))
+ ;; FIXME: The MAKE-EA noise should become a MACROLET macro
+ ;; or something. (perhaps SVLB, for static variable low
+ ;; byte)
+ (inst mov (make-ea :byte :disp (+ nil-value
+ (static-symbol-offset
+ '*pseudo-atomic-interrupted*)
+ (ash symbol-value-slot word-shift)
+ ;; FIXME: Use mask, not minus, to
+ ;; take out type bits.
+ (- other-pointer-lowtag)))
+ 0)
+ (inst mov (make-ea :byte :disp (+ nil-value
+ (static-symbol-offset
+ '*pseudo-atomic-atomic*)
+ (ash symbol-value-slot word-shift)
+ (- other-pointer-lowtag)))
+ (fixnumize 1))
+ ,@forms
+ (inst mov (make-ea :byte :disp (+ nil-value
+ (static-symbol-offset
+ '*pseudo-atomic-atomic*)
+ (ash symbol-value-slot word-shift)
+ (- other-pointer-lowtag)))
+ 0)
+ ;; KLUDGE: Is there any requirement for interrupts to be
+ ;; handled in order? It seems as though an interrupt coming
+ ;; in at this point will be executed before any pending
+ ;; interrupts. Or do incoming interrupts check to see
+ ;; whether any interrupts are pending? I wish I could find
+ ;; the documentation for pseudo-atomics.. -- WHN 19991130
+ (inst cmp (make-ea :byte
+ :disp (+ nil-value
+ (static-symbol-offset
+ '*pseudo-atomic-interrupted*)
+ (ash symbol-value-slot word-shift)
+ (- other-pointer-lowtag)))
+ 0)
+ (inst jmp :eq ,label)
+ ;; if PAI was set, interrupts were disabled at the same
+ ;; time using the process signal mask.
+ (inst break pending-interrupt-trap)
+ (emit-label ,label))))
\f
;;;; indexed references
projects / sbcl.git / blobdiff