X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fx86%2Fmacros.lisp;h=a054404313494d0b64995d12069b31bd38dd8e38;hb=079ef9dad558ca07cb8178ef428bf738112174fa;hp=137a0e8c2f791d1909da4057b200b5a60e9107f0;hpb=fb8533122551bbb7aea669f40bc91c1211809b58;p=sbcl.git

diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp
index 137a0e8..a054404 100644
--- a/src/compiler/x86/macros.lisp
+++ b/src/compiler/x86/macros.lisp
@@ -143,7 +143,7 @@
 ;;; 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)
@@ -228,7 +228,13 @@
 (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))
@@ -307,79 +313,78 @@
 ;;; 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))))
 
 ;;;; indexed references