New function: SB-EXT:SPIN-LOOP-HINT

 Some architectures have developed ways to help the processor execute
 spin loops efficiently; expose them, where applicable, via
 SB-EXT:SPIN-LOOP-HINT.

 Assembles to PAUSE on x86oids, and to nothing on other platforms.

diff --git a/NEWS b/NEWS
index 99fd351..66637d2 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -13,6 +13,9 @@ changes relative to sbcl-1.0.50:
     (thanks to Anton Kovalenko).
   * enhancement: more, and more correct, SSE instruction definitions on
     x86-64 (thanks to Alexander Gavrilov).
+  * enhancement: SB-EXT:SPIN-LOOP-HINT assembles to an instruction designed
+    to help the processor execute spin loops, when applicable.  Currently
+    implemented for x86 and x86-64.
   * optimization: unsigned integer divisions by a constant are implemented
     using multiplication (affects CEILING, FLOOR, TRUNCATE, MOD, and REM.)
   * optimization: improved type-derivation for LOAD-TIME-VALUE.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index fffc257..c898ccc 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -603,6 +603,9 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
                "WORD"
                "MOST-POSITIVE-WORD"
 
+               ;; Not an atomic operation, but should be used with them
+               "SPIN-LOOP-HINT"
+
                ;; Time related things
                "CALL-WITH-TIMING"
                "GET-TIME-OF-DAY"

diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp
index 5d2d598..890fd43 100644 (file)
--- a/src/code/late-extensions.lisp
+++ b/src/code/late-extensions.lisp
@@ -296,6 +296,11 @@ EXPERIMENTAL: Interface subject to change."
            (type sb!vm:signed-word diff))
   (%array-atomic-incf/word array index diff))
 
+(defun spin-loop-hint ()
+  #!+sb-doc
+  "Hints the processor that the current thread is spin-looping."
+  (spin-loop-hint))
+
 (defun call-hooks (kind hooks &key (on-error :error))
   (dolist (hook hooks)
     (handler-case

diff --git a/src/compiler/alpha/system.lisp b/src/compiler/alpha/system.lisp
index c79d117..c051514 100644 (file)
--- a/src/compiler/alpha/system.lisp
+++ b/src/compiler/alpha/system.lisp
@@ -245,3 +245,9 @@
       (inst ldl count offset count-vector)
       (inst addq count 1 count)
       (inst stl count offset count-vector))))
+
+;;;; Dummy definition for a spin-loop hint VOP
+(define-vop (spin-loop-hint)
+  (:translate spin-loop-hint)
+  (:policy :fast-safe)
+  (:generator 0))

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 891a39c..edb99d4 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1604,3 +1604,5 @@
     (unsafe))
 (defknown %compare-and-swap-symbol-value (symbol t t) t
     (unsafe unwind))
+(defknown spin-loop-hint () (values)
+    (always-translatable))

diff --git a/src/compiler/hppa/system.lisp b/src/compiler/hppa/system.lisp
index c99cab8..ad172c2 100644 (file)
--- a/src/compiler/hppa/system.lisp
+++ b/src/compiler/hppa/system.lisp
@@ -259,3 +259,8 @@
       (inst addi 1 count count)
       (inst stw count offset count-vector))))
 
+;;;; Dummy definition for a spin-loop hint VOP
+(define-vop (spin-loop-hint)
+  (:translate spin-loop-hint)
+  (:policy :fast-safe)
+  (:generator 0))

diff --git a/src/compiler/mips/system.lisp b/src/compiler/mips/system.lisp
index e5841e5..dcf7aba 100644 (file)
--- a/src/compiler/mips/system.lisp
+++ b/src/compiler/mips/system.lisp
@@ -245,3 +245,9 @@
       (inst nop)
       (inst addu count 1)
       (inst sw count count-vector offset))))
+
+;;;; Dummy definition for a spin-loop hint VOP
+(define-vop (spin-loop-hint)
+  (:translate spin-loop-hint)
+  (:policy :fast-safe)
+  (:generator 0))

diff --git a/src/compiler/ppc/system.lisp b/src/compiler/ppc/system.lisp
index 684bf3c..1482de1 100644 (file)
--- a/src/compiler/ppc/system.lisp
+++ b/src/compiler/ppc/system.lisp
@@ -285,3 +285,9 @@
   (:policy :fast-safe)
   (:translate %data-dependency-barrier)
   (:generator 3))
+
+;;;; Dummy definition for a spin-loop hint VOP
+(define-vop (spin-loop-hint)
+  (:translate spin-loop-hint)
+  (:policy :fast-safe)
+  (:generator 0))

diff --git a/src/compiler/sparc/system.lisp b/src/compiler/sparc/system.lisp
index 0e5b993..62d6f4c 100644 (file)
--- a/src/compiler/sparc/system.lisp
+++ b/src/compiler/sparc/system.lisp
@@ -246,3 +246,9 @@
       (inst ld count count-vector offset)
       (inst add count 1)
       (inst st count count-vector offset))))
+
+;;;; Dummy definition for a spin-loop hint VOP
+(define-vop (spin-loop-hint)
+  (:translate spin-loop-hint)
+  (:policy :fast-safe)
+  (:generator 0))

diff --git a/src/compiler/x86-64/system.lisp b/src/compiler/x86-64/system.lisp
index 1edf735..2d710d9 100644 (file)
--- a/src/compiler/x86-64/system.lisp
+++ b/src/compiler/x86-64/system.lisp
@@ -394,3 +394,9 @@ number of CPU cycles elapsed as secondary value. EXPERIMENTAL."
   (:policy :fast-safe)
   (:translate %data-dependency-barrier)
   (:generator 3))
+
+(define-vop (pause)
+  (:translate spin-loop-hint)
+  (:policy :fast-safe)
+  (:generator 0
+    (inst pause)))

diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index 6850859..720ad62 100644 (file)
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -1285,6 +1285,11 @@
      (emit-byte segment (if (eq size :byte) #b10110000 #b10110001))
      (emit-ea segment dst (reg-tn-encoding src)))))
 
+(define-instruction pause (segment)
+  (:printer two-bytes ((op '(#xf3 #x90))))
+  (:emitter
+   (emit-byte segment #xf3)
+   (emit-byte segment #x90)))
 \f
 (defun emit-prefix (segment name)
   (ecase name

diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp
index fd14fbf..2128d2b 100644 (file)
--- a/src/compiler/x86/system.lisp
+++ b/src/compiler/x86/system.lisp
@@ -385,3 +385,9 @@ number of CPU cycles elapsed as secondary value. EXPERIMENTAL."
   (:policy :fast-safe)
   (:translate %data-dependency-barrier)
   (:generator 3))
+
+(define-vop (pause)
+  (:translate spin-loop-hint)
+  (:policy :fast-safe)
+  (:generator 0
+    (inst pause)))