From: Alastair Bridgewater <lisphacker@users.sourceforge.net>
Date: Thu, 7 Oct 2010 16:36:37 +0000 (+0000)
Subject: 1.0.43.31: x86-64: Implement %ARRAY-ATOMIC-INCF/WORD.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=74f749f68b1163d43ec96d63d00144d2b146deab;p=sbcl.git

1.0.43.31: x86-64: Implement %ARRAY-ATOMIC-INCF/WORD.

  * Implement new VOP ARRAY-ATOMIC-INCF/WORD

  * Add x86-64 to the appropriate reader conditionals to
enable use of the new VOP.
---

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 78c8b4b..edcc9a0 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1223,7 +1223,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "%ARRAY-DISPLACED-FROM"
                "%ARRAY-DISPLACEMENT" "%ARRAY-FILL-POINTER"
                "%ARRAY-FILL-POINTER-P" "%ARRAY-RANK"
-               #!+(or)
+               #!+(or x86-64)
                "%ARRAY-ATOMIC-INCF/WORD"
                "%ASSOC"
                "%ASSOC-EQ"
diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp
index 77582d0..947d450 100644
--- a/src/code/late-extensions.lisp
+++ b/src/code/late-extensions.lisp
@@ -177,7 +177,7 @@ EXPERIMENTAL: Interface subject to change."
         (aref
          (when (cddr args)
            (invalid-place))
-         #!+(or)
+         #!+(or x86-64)
          (with-unique-names (array)
            `(let ((,array (the (simple-array sb!ext:word (*)) ,(car args))))
               (%array-atomic-incf/word
@@ -189,7 +189,7 @@ EXPERIMENTAL: Interface subject to change."
                                 `(the sb!vm:signed-word ,diff))
                                (atomic-decf
                                 `(- (the sb!vm:signed-word ,diff))))))))
-         #!-(or)
+         #!-(or x86-64)
          (with-unique-names (array index old-value)
            (let ((incremented-value
                   (ecase name
@@ -289,7 +289,7 @@ EXPERIMENTAL: Interface subject to change."
   (expand-atomic-frob 'atomic-decf place diff))
 
 ;; Interpreter stubs for ATOMIC-INCF.
-#!+(or)
+#!+(or x86-64)
 (defun %array-atomic-incf/word (array index diff)
   (declare (type (simple-array word (*)) array)
            (fixnum index)
diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp
index dd11795..2fc1221 100644
--- a/src/compiler/generic/vm-fndb.lisp
+++ b/src/compiler/generic/vm-fndb.lisp
@@ -168,7 +168,7 @@
 #!+(or x86 x86-64 ppc)
 (defknown %raw-instance-atomic-incf/word (instance index sb!vm:word) sb!vm:word
     (unsafe always-translatable))
-#!+(or)
+#!+(or x86-64)
 (defknown %array-atomic-incf/word (t index sb!vm:word) sb!vm:word
   (unsafe always-translatable))
 
diff --git a/src/compiler/x86-64/array.lisp b/src/compiler/x86-64/array.lisp
index 4a89839..f365216 100644
--- a/src/compiler/x86-64/array.lisp
+++ b/src/compiler/x86-64/array.lisp
@@ -730,3 +730,22 @@
 
 (define-vop (get-vector-subtype get-header-data))
 (define-vop (set-vector-subtype set-header-data))
+
+;;;; ATOMIC-INCF for arrays
+
+(define-vop (array-atomic-incf/word)
+  (:translate %array-atomic-incf/word)
+  (:policy :fast-safe)
+  (:args (array :scs (descriptor-reg))
+         (index :scs (any-reg))
+         (diff :scs (unsigned-reg) :target result))
+  (:arg-types * positive-fixnum unsigned-num)
+  (:results (result :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:generator 4
+    (inst xadd (make-ea :qword :base array
+                        :scale 1 :index index
+                        :disp (- (* vector-data-offset n-word-bytes)
+                                 other-pointer-lowtag))
+          diff :lock)
+    (move result diff)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 4b56650..5ccab60 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.43.30"
+"1.0.43.31"