Re: [Sbcl-commits] master: Add sb-vm:%atomic-exchange
Douglas Katzman via Sbcl-devel <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.devel |
|---|---|
| Message-ID | <CAOrNasxzhGFNsYd92EX0Vpvqgr=+KOE69zid1kYnn_zJVQ9L9g@mail.gmail.com> |
I've been called away. I was just going to try this diff. Apply if you like _______________________________________________ Sbcl-devel mailing list [email protected] https://lists.sourceforge.net/lists/listinfo/sbcl-devel
0001-Guard-a-thing-with-backend-subfeatures.patch
(application/x-patch, 3.1 KB)
From c3c769c92b9637dbb9dadc6ce81cfa5e7f7513a4 Mon Sep 17 00:00:00 2001 From: Douglas Katzman <[email protected]> Date: Wed, 5 Aug 2026 21:34:56 +0000 Subject: [PATCH] Guard a thing with backend-subfeatures --- src/code/setf-funs.lisp | 44 +++++++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 21 deletions(-) diff --git a/src/code/setf-funs.lisp b/src/code/setf-funs.lisp index ab49e56f0..17a5b3071 100644 --- a/src/code/setf-funs.lisp +++ b/src/code/setf-funs.lisp @@ -92,27 +92,29 @@ instance-pointer-lowtag)) (type (dsd-type dsd))) (declare (ignorable disp type)) - #+(or arm64 riscv64 x86-64) - (multiple-value-bind (sc primtype) - (ecase (dsd-raw-type dsd) - (t (if (eq type 'fixnum) - (values 'any-reg 'tagged-num) - (values 'descriptor-reg 't))) - (signed-word (values 'signed-reg 'signed-num)) - (word (values 'unsigned-reg 'unsigned-num))) - `(truly-the ,type - (inline-vop (((instance descriptor-reg t) (the ,(dd-name (car info)) ,instance)) - ((val ,sc ,primtype) (the ,type ,value)) - ((temp))) - ((res ,sc ,primtype)) - #+arm64 (progn (inst add temp instance ,disp) - (inst swpal val res temp)) - #+riscv (progn (inst addi temp instance ,disp) - (inst amoswap res val temp :aq :rl)) - #+x86-64 (progn (move temp val) - (inst xchg temp (ea ,disp instance)) ; LOCK is implicit - (move res temp))))) - #-(or arm64 riscv64 x86-64) + (when (or #+(or riscv64 x86-64) t + #+arm64 (member :arm-v8.1 *backend-subfeatures*)) + (return-from %atomic-exchange + (multiple-value-bind (sc primtype) + (ecase (dsd-raw-type dsd) + (t (if (eq type 'fixnum) + (values 'any-reg 'tagged-num) + (values 'descriptor-reg 't))) + (signed-word (values 'signed-reg 'signed-num)) + (word (values 'unsigned-reg 'unsigned-num))) + `(truly-the ,type + (inline-vop (((instance descriptor-reg t) (the ,(dd-name (car info)) ,instance)) + ((val ,sc ,primtype) (the ,type ,value)) + ((temp))) + ((res ,sc ,primtype)) + #+arm64 (progn (inst add temp instance ,disp) + (inst swpal val res temp)) + #+riscv (progn (inst addi temp instance ,disp) + (inst amoswap res val temp :aq :rl)) + #+x86-64 (progn (move temp val) + (inst xchg temp (ea ,disp instance)) ; LOCK is implicit + (move res temp))))))) + ;; fallback variant `(let* ((.instance. ,instance) ; GET-CAS-EXPANSION exists. I don't care (.new. ,value) (.old. (,accessor .instance.))) -- 2.55.0.629.g250fe7f194-goog