;;; which time all calls to alloc() would have needed a syscall to
;;; mask signals for the duration. Now we have pseudoatomic there's
;;; no need for that overhead. Still, inline alloc would be a neat
-;;; addition someday
+;;; addition someday (except see below).
(defun allocation-dynamic-extent (alloc-tn size)
(inst sub esp-tn size)
(defun allocation (alloc-tn size &optional inline dynamic-extent)
(cond
(dynamic-extent (allocation-dynamic-extent alloc-tn size))
- ((or (null inline) (policy inline (>= speed space)))
+ ;; FIXME: for reasons unknown, inline allocation is a speed win on
+ ;; non-P4s, and a speed loss on P4s (and probably other such
+ ;; high-spec high-cache machines). :INLINE-ALLOCATION-IS-GOOD is
+ ;; a bit of a KLUDGE, really. -- CSR, 2004-08-05 (following
+ ;; observations made by ASF and Juho Snellman)
+ ((and (member :inline-allocation-is-good *backend-subfeatures*)
+ (or (null inline) (policy inline (>= speed space))))
(allocation-inline alloc-tn size))
(t (allocation-notinline alloc-tn size)))
(values))
;;; 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