master: ppc, ppc64: add %raw-instance-cas/signed-word
stassats via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via ffb6f743c0332193a0ae65ff9746a09afd656d18 (commit)
from 341713c776046393dfe3dc15031c7ca3fde8488c (commit)
- Log -----------------------------------------------------------------
commit ffb6f743c0332193a0ae65ff9746a09afd656d18
Author: Stas Boukarev <[email protected]>
Date: Thu Aug 6 00:24:36 2026 +0300
ppc, ppc64: add %raw-instance-cas/signed-word
---
src/code/cas.lisp | 4 ++--
src/code/macros.lisp | 2 +-
src/compiler/generic/vm-fndb.lisp | 2 +-
src/compiler/ppc/cell.lisp | 10 ++++++++++
src/compiler/ppc64/cell.lisp | 10 ++++++++++
tests/atomic-xchg.pure.lisp | 3 +++
tests/compare-and-swap.impure.lisp | 8 ++++----
tests/test-util.lisp | 20 +++++++++++++-------
8 files changed, 44 insertions(+), 15 deletions(-)
diff --git a/src/code/cas.lisp b/src/code/cas.lisp
index 7947adba8..fcfc3ed01 100644
--- a/src/code/cas.lisp
+++ b/src/code/cas.lisp
@@ -31,11 +31,11 @@
;; because it is used for effect. And if compare-and-swap vops exist,
;; then the setter isn't used at all.
(def %instance-cas (instance index) %instance-ref %instance-set)
- #+(or x86-64 x86 riscv loongarch64)
+ #+(or arm64 ppc ppc64 x86-64 x86 riscv loongarch64)
(def %raw-instance-cas/word (instance index)
%raw-instance-ref/word
%raw-instance-set/word)
- #+(or arm64 riscv x86 x86-64 loongarch64)
+ #+(or arm64 riscv ppc ppc64 x86 x86-64 loongarch64)
(def %raw-instance-cas/signed-word (instance index)
%raw-instance-ref/signed-word
%raw-instance-set/signed-word)
diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index 102380f4c..011fa0840 100644
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -1778,7 +1778,7 @@ invoked. In that case it will store into PLACE and start over."
((t) '%instance-cas)
#+(or arm64 loongarch64 ppc ppc64 riscv x86 x86-64)
((word) '%raw-instance-cas/word)
- #+(or arm64 loongarch64 riscv x86 x86-64)
+ #+(or arm64 loongarch64 ppc ppc64 riscv x86 x86-64)
((sb-vm:signed-word) '%raw-instance-cas/signed-word))))
(unless casser
(error "Cannot use COMPARE-AND-SWAP with structure accessor ~
diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp
index aeb21aa67..9adbc4fc3 100644
--- a/src/compiler/generic/vm-fndb.lisp
+++ b/src/compiler/generic/vm-fndb.lisp
@@ -240,7 +240,7 @@
#+(or arm64 loongarch64 ppc ppc64 riscv x86 x86-64)
(defknown %raw-instance-cas/word (instance index sb-vm:word sb-vm:word)
sb-vm:word ())
-#+(or arm64 loongarch64 riscv x86 x86-64)
+#+(or arm64 loongarch64 ppc ppc64 riscv x86 x86-64)
(defknown %raw-instance-cas/signed-word (instance index sb-vm:signed-word sb-vm:signed-word)
sb-vm:signed-word ())
(defknown %raw-instance-xchg/word (instance index sb-vm:word) sb-vm:word ())
diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp
index abc3a6bd5..2217c6050 100644
--- a/src/compiler/ppc/cell.lisp
+++ b/src/compiler/ppc/cell.lisp
@@ -435,6 +435,16 @@
(:result-types unsigned-num)
(:translate %raw-instance-cas/word))
+(define-vop (%raw-instance-cas/signed-word %instance-cas)
+ (:args (object)
+ (index)
+ (old-value :scs (signed-reg))
+ (new-value :scs (signed-reg)))
+ (:arg-types * tagged-num signed-num signed-num)
+ (:results (result :scs (signed-reg) :from :load))
+ (:result-types signed-num)
+ (:translate %raw-instance-cas/signed-word))
+
;;;; Code object frobbing.
diff --git a/src/compiler/ppc64/cell.lisp b/src/compiler/ppc64/cell.lisp
index 99fc1af26..b8eae46d6 100644
--- a/src/compiler/ppc64/cell.lisp
+++ b/src/compiler/ppc64/cell.lisp
@@ -504,6 +504,16 @@
(:result-types unsigned-num)
(:translate %raw-instance-cas/word))
+(define-vop (%raw-instance-cas/signed-word %instance-cas)
+ (:args (object)
+ (index)
+ (old-value :scs (signed-reg))
+ (new-value :scs (signed-reg)))
+ (:arg-types * tagged-num signed-num signed-num)
+ (:results (result :scs (signed-reg) :from :load))
+ (:result-types signed-num)
+ (:translate %raw-instance-cas/signed-word))
+
;;;; Code object frobbing.
diff --git a/tests/atomic-xchg.pure.lisp b/tests/atomic-xchg.pure.lisp
index 53c04b8d7..09ed6faa4 100644
--- a/tests/atomic-xchg.pure.lisp
+++ b/tests/atomic-xchg.pure.lisp
@@ -1,3 +1,6 @@
+(unless (vop-existsp "SB-KERNEL:%RAW-INSTANCE-CAS/SIGNED-WORD")
+ (invoke-restart 'run-tests::skip-file))
+
(defstruct s (f 0 :type fixnum) (w 0 :type word) (sw 0 :type signed-word))
(defun swapw (mystruct v) (sb-vm:%atomic-exchange (s-w mystruct) v))
diff --git a/tests/compare-and-swap.impure.lisp b/tests/compare-and-swap.impure.lisp
index 289d771ef..3a5de72af 100644
--- a/tests/compare-and-swap.impure.lisp
+++ b/tests/compare-and-swap.impure.lisp
@@ -152,14 +152,14 @@
(assert (= (- (ash 1 sb-vm:n-word-bits) 2) (box-word box)))))
(with-test (:name :cas-raw-instance-ref-word
- :skipped-on (not (or :x86 :x86-64)))
+ :implemented-on (:vop-existsp "SB-KERNEL:%RAW-INSTANCE-CAS/WORD"))
(let ((foo (make-box :word 42)))
;; basic smoke test - not checking for atomicity or anything
(assert (eql (cas (box-word foo) 42 43) 42))
(assert (eql (cas (box-word foo) 43 44) 43))))
(with-test (:name :atomic-incf-full-call-lp1381867
- :skipped-on (not (or :x86 :x86-64 :ppc)))
+ :implemented-on (:vop-existsp "SB-KERNEL:%RAW-INSTANCE-ATOMIC-INCF/WORD"))
;; contortions to avoid reader errors
(let* ((%riai/w (intern "%RAW-INSTANCE-ATOMIC-INCF/WORD" "SB-KERNEL"))
(form
@@ -729,7 +729,7 @@
(setf small-generation-limit 1)))
(test-util:with-test (:name :cas-aref
- :skipped-on (not (or :arm64 :x86-64)))
+ :implemented-on (or :arm64 :x86-64))
(dolist (bits '(8 16 32 #+64-bit 64))
(let ((unsigned (make-array '(3 3) :element-type `(unsigned-byte ,bits)
:initial-element 0))
@@ -744,7 +744,7 @@
(assert (equalp unsigned #2A((1 2 3) (4 5 6) (7 8 9))))
(assert (equalp signed #2A((-4 -3 -2) (-1 0 1) (2 3 4)))))))
-(test-util:with-test (:name :cas-aref-float :skipped-on (not :x86-64))
+(test-util:with-test (:name :cas-aref-float :implemented-on :x86-64)
(dolist (et '(single-float double-float))
(let ((a (make-array 4 :element-type et)))
(dotimes (i 4)
diff --git a/tests/test-util.lisp b/tests/test-util.lisp
index bbb1ebcc1..796bd4378 100644
--- a/tests/test-util.lisp
+++ b/tests/test-util.lisp
@@ -347,13 +347,19 @@
(really-invoke-debugger condition))))
(defun vop-existsp (name &optional (query :translate))
- (ecase query
- (:named
- (gethash name sb-c::*backend-template-names*))
- (:translate
- (let ((info (sb-int:info :function :info name)))
- (when info
- (sb-c::fun-info-templates info))))))
+ (let ((name (if (stringp name)
+ (let ((colon (position #\: name)))
+ (find-symbol (subseq name (1+ colon))
+ (subseq name 0 colon)))
+ name)))
+ (when name
+ (ecase query
+ (:named
+ (gethash name sb-c::*backend-template-names*))
+ (:translate
+ (let ((info (sb-int:info :function :info name)))
+ (when info
+ (sb-c::fun-info-templates info))))))))
(defun skipped-p (x)
(typecase x
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL