diff options
-rw-r--r-- | libguile/intrinsics.c | 30 | ||||
-rw-r--r-- | libguile/intrinsics.h | 8 | ||||
-rw-r--r-- | libguile/vm-engine.c | 14 |
3 files changed, 45 insertions, 7 deletions
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index c9fc22e9c..89eed1867 100644 --- a/libguile/intrinsics.c +++ b/libguile/intrinsics.c @@ -22,6 +22,7 @@ #endif #include "alist.h" +#include "atomics-internal.h" #include "boolean.h" #include "cache-internal.h" #include "extensions.h" @@ -410,6 +411,31 @@ push_prompt (scm_thread *thread, uint8_t escape_only_p, vra, mra, thread->vm.registers); } +static SCM +atomic_ref_scm (SCM *loc) +{ + return scm_atomic_ref_scm (loc); +} + +static void +atomic_set_scm (SCM *loc, SCM val) +{ + scm_atomic_set_scm (loc, val); +} + +static SCM +atomic_swap_scm (SCM *loc, SCM val) +{ + return scm_atomic_swap_scm (loc, val); +} + +static SCM +atomic_compare_and_swap_scm (SCM *loc, SCM expected, SCM desired) +{ + scm_atomic_compare_and_swap_scm (loc, &expected, desired); + return expected; +} + void scm_bootstrap_intrinsics (void) { @@ -478,6 +504,10 @@ scm_bootstrap_intrinsics (void) scm_vm_intrinsics.allocate_words = allocate_words; scm_vm_intrinsics.current_module = current_module; scm_vm_intrinsics.push_prompt = push_prompt; + scm_vm_intrinsics.atomic_ref_scm = atomic_ref_scm; + scm_vm_intrinsics.atomic_set_scm = atomic_set_scm; + scm_vm_intrinsics.atomic_swap_scm = atomic_swap_scm; + scm_vm_intrinsics.atomic_compare_and_swap_scm = atomic_compare_and_swap_scm; scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, "scm_init_intrinsics", diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index 44b996bdf..b00471123 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -88,6 +88,10 @@ typedef void (*scm_t_thread_mra_intrinsic) (scm_thread*, uint8_t*); typedef uint32_t* (*scm_t_vra_from_thread_intrinsic) (scm_thread*); typedef uint8_t* (*scm_t_mra_from_thread_scm_intrinsic) (scm_thread*, SCM); typedef uint8_t* (*scm_t_mra_from_thread_mra_intrinsic) (scm_thread*, uint8_t*); +typedef SCM (*scm_t_scm_from_ptr_intrinsic) (SCM*); +typedef void (*scm_t_ptr_scm_intrinsic) (SCM*, SCM); +typedef SCM (*scm_t_scm_from_ptr_scm_intrinsic) (SCM*, SCM); +typedef SCM (*scm_t_scm_from_ptr_scm_scm_intrinsic) (SCM*, SCM, SCM); #define SCM_FOR_ALL_VM_INTRINSICS(M) \ M(scm_from_scm_scm, add, "add", ADD) \ @@ -159,6 +163,10 @@ typedef uint8_t* (*scm_t_mra_from_thread_mra_intrinsic) (scm_thread*, uint8_t*); M(thread, invoke_return_hook, "invoke-return-hook", INVOKE_RETURN_HOOK) \ M(thread, invoke_next_hook, "invoke-next-hook", INVOKE_NEXT_HOOK) \ M(thread, invoke_abort_hook, "invoke-abort-hook", INVOKE_ABORT_HOOK) \ + M(scm_from_ptr, atomic_ref_scm, "atomic-ref-scm", ATOMIC_REF_SCM) \ + M(ptr_scm, atomic_set_scm, "atomic-set-scm", ATOMIC_SET_SCM) \ + M(scm_from_ptr_scm, atomic_swap_scm, "atomic-swap-scm", ATOMIC_SWAP_SCM) \ + M(scm_from_ptr_scm_scm, atomic_compare_and_swap_scm, "atomic-compare-and-swap-scm", ATOMIC_COMPARE_AND_SWAP_SCM) \ /* Add new intrinsics here; also update scm_bootstrap_intrinsics. */ enum scm_vm_intrinsic diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index d64ce9ee7..2af02dcea 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -1784,7 +1784,7 @@ VM_NAME (scm_thread *thread) SCM *loc; UNPACK_8_8_8 (op, dst, obj, offset); loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset); - SP_SET (dst, scm_atomic_ref_scm (loc)); + SP_SET (dst, CALL_INTRINSIC (atomic_ref_scm, (loc))); NEXT (1); } @@ -1794,7 +1794,7 @@ VM_NAME (scm_thread *thread) SCM *loc; UNPACK_8_8_8 (op, obj, offset, val); loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset); - scm_atomic_set_scm (loc, SP_REF (val)); + CALL_INTRINSIC (atomic_set_scm, (loc, SP_REF (val))); NEXT (1); } @@ -1807,7 +1807,7 @@ VM_NAME (scm_thread *thread) UNPACK_24 (ip[1], obj); UNPACK_8_24 (ip[2], offset, val); loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset); - SP_SET (dst, scm_atomic_swap_scm (loc, SP_REF (val))); + SP_SET (dst, CALL_INTRINSIC (atomic_swap_scm, (loc, SP_REF (val)))); NEXT (3); } @@ -1816,15 +1816,15 @@ VM_NAME (scm_thread *thread) uint32_t dst, obj, expected, desired; uint8_t offset; SCM *loc; - SCM scm_expected; + SCM got; UNPACK_24 (op, dst); UNPACK_24 (ip[1], obj); UNPACK_8_24 (ip[2], offset, expected); UNPACK_24 (ip[3], desired); loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset); - scm_expected = SP_REF (expected); - scm_atomic_compare_and_swap_scm (loc, &scm_expected, SP_REF (desired)); - SP_SET (dst, scm_expected); + got = CALL_INTRINSIC (atomic_compare_and_swap_scm, + (loc, SP_REF (expected), SP_REF (desired))); + SP_SET (dst, got); NEXT (4); } |