diff --git a/src/org/armedbear/lisp/Atomic.java b/src/org/armedbear/lisp/Atomic.java new file mode 100644 index 000000000..eca3380b3 --- /dev/null +++ b/src/org/armedbear/lisp/Atomic.java @@ -0,0 +1,44 @@ +package org.armedbear.lisp; + +import static org.armedbear.lisp.Lisp.*; + +import java.lang.invoke.MethodHandles; +import java.lang.invoke.VarHandle; + +public class Atomic +{ + static MethodHandles.Lookup Lookup + = MethodHandles.lookup(); + + static boolean compareAndSwap(LispObject place, LispObject expectedValue, LispObject newValue) { + VarHandle vh = null; + if (place instanceof Fixnum) { + try { + vh = Lookup.findVarHandle(Fixnum.class, "value", int.class); + } catch (ReflectiveOperationException e) { + java_error(e); + return false; // unreached + } + } + if (vh == null) { + simple_error("Unable to find VarHandle for place ~a", place); + return false; // unreached + } + return vh.compareAndSet(expectedValue, newValue); + } + + public static final Primitive _CAS = new pf_cas(); + @DocString(name="%cas", + args="place expected-value new-value", + returns="generalized boolean") + private static final class pf_cas extends Primitive { // Maybe a special operator? Or do that Lisp-side? + pf_cas() { + super(Symbol._CAS); + } + @Override + public LispObject execute(LispObject place, LispObject expectedValue, LispObject newValue) { + boolean result = compareAndSwap (place, expectedValue, newValue); + return (result == false) ? NIL : T; // TODO this has to exist somewhere as a static method + } + } +} diff --git a/src/org/armedbear/lisp/Autoload.java b/src/org/armedbear/lisp/Autoload.java index e9b1592f3..36e9d94f4 100644 --- a/src/org/armedbear/lisp/Autoload.java +++ b/src/org/armedbear/lisp/Autoload.java @@ -692,5 +692,7 @@ public LispObject execute(LispObject arg) autoload(PACKAGE_EXT, "autoload-setf-expander", "AutoloadGeneralizedReference", true); autoload(PACKAGE_EXT, "autoload-setf-function", "AutoloadGeneralizedReference", true); autoload(PACKAGE_EXT, "autoload-ref-p", "AutoloadGeneralizedReference", true); + + autoload(Symbol._CAS, "Atomic"); } } diff --git a/src/org/armedbear/lisp/Symbol.java b/src/org/armedbear/lisp/Symbol.java index d96d1f440..17b6693a0 100644 --- a/src/org/armedbear/lisp/Symbol.java +++ b/src/org/armedbear/lisp/Symbol.java @@ -2973,6 +2973,8 @@ public String toString() { PACKAGE_EXT.addExternalSymbol("WEAK-REFERENCE"); public static final Symbol ADD_PACKAGE_LOCAL_NICKNAME = PACKAGE_EXT.addExternalSymbol("ADD-PACKAGE-LOCAL-NICKNAME"); + public static final Symbol _CAS = + PACKAGE_EXT.addExternalSymbol("%CAS"); // MOP. public static final Symbol CLASS_LAYOUT =