Commit 239a2aa4 authored by Marius Gerbershagen's avatar Marius Gerbershagen
Browse files

threading: add support for atomic operations

    We support both compare-and-swap and fetch-and-add (via
    atomic-incf/decf) on the most common places and define an
    extension interface for compare-and-swap similiar to the one in
    SBCL.

    These changes introduce new dependencies on the libatomic_ops
    macros AO_fetch_compare_and_swap and AO_fetch_and_add.
parent a19cf59c
......@@ -1034,6 +1034,38 @@ si_svset(cl_object x, cl_object index, cl_object v)
ecl_return1(the_env, x->vector.self.t[i] = v);
}
#ifdef ECL_THREADS
cl_object
mp_compare_and_swap_svref(cl_object x, cl_object index, cl_object old, cl_object new)
{
cl_index i;
if (ecl_unlikely(ecl_t_of(x) != t_vector ||
(x->vector.flags & (ECL_FLAG_ADJUSTABLE | ECL_FLAG_HAS_FILL_POINTER)) ||
CAR(x->vector.displaced) != ECL_NIL ||
(cl_elttype)x->vector.elttype != ecl_aet_object))
{
FEwrong_type_nth_arg(@[mp::compare-and-swap-svref], 1, x, @[simple-vector]);
}
i = checked_index(@[mp::compare-and-swap-svref], x, -1, index, x->vector.dim);
return ecl_compare_and_swap(x->vector.self.t + i, old, new);
}
cl_object
mp_atomic_incf_svref(cl_object x, cl_object index, cl_object increment)
{
cl_index i;
if (ecl_unlikely(ecl_t_of(x) != t_vector ||
(x->vector.flags & (ECL_FLAG_ADJUSTABLE | ECL_FLAG_HAS_FILL_POINTER)) ||
CAR(x->vector.displaced) != ECL_NIL ||
(cl_elttype)x->vector.elttype != ecl_aet_object))
{
FEwrong_type_nth_arg(@[mp::atomic-incf-svref], 1, x, @[simple-vector]);
}
i = checked_index(@[mp::atomic-incf-svref], x, -1, index, x->vector.dim);
return ecl_atomic_incf(x->vector.self.t + i, increment);
}
#endif /* ECL_THREADS */
cl_object
cl_array_has_fill_pointer_p(cl_object a)
{
......
......@@ -39,6 +39,36 @@ cl_set(cl_object var, cl_object value)
ecl_return1(env, ECL_SETQ(env, var, value));
}
#ifdef ECL_THREADS
cl_object
mp_compare_and_swap_symbol_value(cl_object var, cl_object old, cl_object new)
{
unlikely_if (Null(var)) {
FEconstant_assignment(var);
}
unlikely_if (ecl_t_of(var) != t_symbol) {
FEwrong_type_nth_arg(@[mp::compare-and-swap-symbol-value], 1, var, @[symbol]);
}
unlikely_if (var->symbol.stype & ecl_stp_constant)
FEconstant_assignment(var);
return ecl_compare_and_swap(ecl_bds_ref(ecl_process_env(), var), old, new);
}
cl_object
mp_atomic_incf_symbol_value(cl_object var, cl_object increment)
{
unlikely_if (Null(var)) {
FEconstant_assignment(var);
}
unlikely_if (ecl_t_of(var) != t_symbol) {
FEwrong_type_nth_arg(@[mp::atomic-incf-symbol-value], 1, var, @[symbol]);
}
unlikely_if (var->symbol.stype & ecl_stp_constant)
FEconstant_assignment(var);
return ecl_atomic_incf(ecl_bds_ref(ecl_process_env(), var), increment);
}
#endif /* ECL_THREADS */
cl_object
ecl_setq(cl_env_ptr env, cl_object var, cl_object value)
{
......
......@@ -141,6 +141,58 @@ si_instance_set(cl_object x, cl_object index, cl_object value)
@(return value);
}
#ifdef ECL_THREADS
cl_object
ecl_compare_and_swap_instance(cl_object x, cl_fixnum i, cl_object old, cl_object new)
{
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@[mp::compare-and-swap-instance], 1, x, @[ext::instance]);
if (ecl_unlikely(i >= x->instance.length || i < 0))
FEtype_error_index(x, i);
return ecl_compare_and_swap(x->instance.slots + i, old, new);
}
cl_object
mp_compare_and_swap_instance(cl_object x, cl_object index, cl_object old, cl_object new)
{
cl_fixnum i;
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@[mp::compare-and-swap-instance], 1, x, @[ext::instance]);
if (ecl_unlikely(!ECL_FIXNUMP(index)))
FEwrong_type_nth_arg(@[mp::compare-and-swap-instance], 2, index, @[fixnum]);
i = ecl_fixnum(index);
if (ecl_unlikely(i >= (cl_fixnum)x->instance.length || i < 0))
FEtype_error_index(x, i);
return ecl_compare_and_swap(x->instance.slots + i, old, new);
}
cl_object
ecl_atomic_incf_instance(cl_object x, cl_fixnum i, cl_object increment)
{
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@[mp::atomic-incf-instance], 1, x, @[ext::instance]);
if (ecl_unlikely(i >= x->instance.length || i < 0))
FEtype_error_index(x, i);
return ecl_atomic_incf(x->instance.slots + i, increment);
}
cl_object
mp_atomic_incf_instance(cl_object x, cl_object index, cl_object increment)
{
cl_fixnum i;
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@[mp::atomic-incf-instance], 1, x, @[ext::instance]);
if (ecl_unlikely(!ECL_FIXNUMP(index)))
FEwrong_type_nth_arg(@[mp::atomic-incf-instance], 2, index, @[fixnum]);
i = ecl_fixnum(index);
if (ecl_unlikely(i >= (cl_fixnum)x->instance.length || i < 0))
FEtype_error_index(x, i);
return ecl_atomic_incf(x->instance.slots + i, increment);
}
#endif /* ECL_THREADS */
cl_object
si_instancep(cl_object x)
{
......
......@@ -14,6 +14,7 @@
#include <ecl/ecl.h>
#include <ecl/ecl-inl.h>
#include <ecl/internal.h>
struct cl_test {
bool (*test_c_function)(struct cl_test *, cl_object);
......@@ -645,7 +646,7 @@ cl_ldiff(cl_object x, cl_object y)
cl_object
cl_rplaca(cl_object x, cl_object v)
{
if (ecl_unlikely(!CONSP(x)))
if (ecl_unlikely(!ECL_CONSP(x)))
FEwrong_type_nth_arg(@[rplaca], 1, x, @[cons]);
ECL_RPLACA(x, v);
@(return x);
......@@ -654,12 +655,46 @@ cl_rplaca(cl_object x, cl_object v)
cl_object
cl_rplacd(cl_object x, cl_object v)
{
if (ecl_unlikely(!CONSP(x)))
if (ecl_unlikely(!ECL_CONSP(x)))
FEwrong_type_nth_arg(@[rplacd], 1, x, @[cons]);
ECL_RPLACD(x, v);
@(return x);
}
#ifdef ECL_THREADS
cl_object
mp_compare_and_swap_car(cl_object x, cl_object old, cl_object new)
{
if (ecl_unlikely(!ECL_CONSP(x)))
FEwrong_type_nth_arg(@[mp::compare-and-swap-car], 1, x, @[cons]);
return ecl_compare_and_swap(&ECL_CONS_CAR(x), old, new);
}
cl_object
mp_atomic_incf_car(cl_object x, cl_object increment)
{
if (ecl_unlikely(!ECL_CONSP(x)))
FEwrong_type_nth_arg(@[mp::atomic-incf-car], 1, x, @[cons]);
return ecl_atomic_incf(&ECL_CONS_CAR(x), increment);
}
cl_object
mp_compare_and_swap_cdr(cl_object x, cl_object old, cl_object new)
{
if (ecl_unlikely(!ECL_CONSP(x)))
FEwrong_type_nth_arg(@[mp::compare-and-swap-cdr], 1, x, @[cons]);
return ecl_compare_and_swap(&ECL_CONS_CDR(x), old, new);
}
cl_object
mp_atomic_incf_cdr(cl_object x, cl_object increment)
{
if (ecl_unlikely(!ECL_CONSP(x)))
FEwrong_type_nth_arg(@[mp::atomic-incf-cdr], 1, x, @[cons]);
return ecl_atomic_incf(&ECL_CONS_CDR(x), increment);
}
#endif /* ECL_THREADS */
@(defun subst (new_obj old_obj tree &key test test_not key)
struct cl_test t;
cl_object output;
......
......@@ -102,7 +102,7 @@ si_structure_ref(cl_object x, cl_object type, cl_object index)
}
cl_object
ecl_structure_ref(cl_object x, cl_object type, int n)
ecl_structure_ref(cl_object x, cl_object type, cl_fixnum n)
{
if (ecl_unlikely(ecl_t_of(x) != T_STRUCTURE ||
......@@ -122,9 +122,8 @@ si_structure_set(cl_object x, cl_object type, cl_object index, cl_object val)
}
cl_object
ecl_structure_set(cl_object x, cl_object type, int n, cl_object v)
ecl_structure_set(cl_object x, cl_object type, cl_fixnum n, cl_object v)
{
if (ecl_unlikely(ecl_t_of(x) != T_STRUCTURE ||
!structure_subtypep(ECL_STRUCT_TYPE(x), type)))
FEwrong_type_nth_arg(@[si::structure-set], 1, x, type);
......@@ -132,6 +131,17 @@ ecl_structure_set(cl_object x, cl_object type, int n, cl_object v)
return(v);
}
#ifdef ECL_THREADS
cl_object
mp_compare_and_swap_structure(cl_object x, cl_object type, cl_object index, cl_object old, cl_object new)
{
if (ecl_unlikely(ecl_t_of(x) != T_STRUCTURE ||
!structure_subtypep(ECL_STRUCT_TYPE(x), type)))
FEwrong_type_nth_arg(@[mp::compare-and-swap-structure], 1, x, type);
return ecl_compare_and_swap(&(ECL_STRUCT_SLOT(x, ecl_fixnum(index))), old, new);
}
#endif
cl_object
si_structurep(cl_object s)
{
......
......@@ -419,6 +419,14 @@ si_set_symbol_plist(cl_object sym, cl_object plist)
@(return plist);
}
#ifdef ECL_THREADS
cl_object
mp_compare_and_swap_symbol_plist(cl_object x, cl_object old, cl_object new)
{
return ecl_compare_and_swap(ecl_symbol_plist(x), old, new);
}
#endif /* ECL_THREADS */
cl_object
si_putprop(cl_object sym, cl_object value, cl_object indicator)
{
......
......@@ -1618,6 +1618,27 @@ cl_symbols[] = {
{MP_ "MAILBOX-TRY-READ", MP_ORDINARY, IF_MP(mp_mailbox_try_read), 1, OBJNULL},
{MP_ "MAILBOX-SEND", MP_ORDINARY, IF_MP(mp_mailbox_send), 2, OBJNULL},
{MP_ "MAILBOX-TRY-SEND", MP_ORDINARY, IF_MP(mp_mailbox_try_send), 2, OBJNULL},
{MP_ "COMPARE-AND-SWAP-CAR", MP_ORDINARY, IF_MP(mp_compare_and_swap_car), 3, OBJNULL},
{MP_ "COMPARE-AND-SWAP-CDR", MP_ORDINARY, IF_MP(mp_compare_and_swap_cdr), 3, OBJNULL},
{MP_ "COMPARE-AND-SWAP-SYMBOL-PLIST", MP_ORDINARY, IF_MP(mp_compare_and_swap_symbol_plist), 3, OBJNULL},
{MP_ "COMPARE-AND-SWAP-SYMBOL-VALUE", MP_ORDINARY, IF_MP(mp_compare_and_swap_symbol_value), 3, OBJNULL},
{MP_ "COMPARE-AND-SWAP-SVREF", MP_ORDINARY, IF_MP(mp_compare_and_swap_svref), 4, OBJNULL},
{MP_ "COMPARE-AND-SWAP-INSTANCE", MP_ORDINARY, IF_MP(mp_compare_and_swap_instance), 4, OBJNULL},
{MP_ "COMPARE-AND-SWAP-STRUCTURE", MP_ORDINARY, IF_MP(mp_compare_and_swap_structure), 5, OBJNULL},
{MP_ "ATOMIC-INCF-CAR", MP_ORDINARY, IF_MP(mp_atomic_incf_car), 2, OBJNULL},
{MP_ "ATOMIC-INCF-CDR", MP_ORDINARY, IF_MP(mp_atomic_incf_cdr), 2, OBJNULL},
{MP_ "ATOMIC-INCF-SYMBOL-VALUE", MP_ORDINARY, IF_MP(mp_atomic_incf_symbol_value), 2, OBJNULL},
{MP_ "ATOMIC-INCF-SVREF", MP_ORDINARY, IF_MP(mp_atomic_incf_svref), 3, OBJNULL},
{MP_ "ATOMIC-INCF-INSTANCE", MP_ORDINARY, IF_MP(mp_atomic_incf_instance), 3, OBJNULL},
{MP_ "DEFINE-CAS-EXPANDER", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "DEFCAS", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "GET-CAS-EXPANSION", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "COMPARE-AND-SWAP", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "ATOMIC-UPDATE", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "ATOMIC-PUSH", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "ATOMIC-POP", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "ATOMIC-INCF", MP_CONSTANT, NULL, -1, OBJNULL},
{MP_ "ATOMIC-DECF", MP_CONSTANT, NULL, -1, OBJNULL},
/* #endif defined(ECL_THREADS) */
{SYS_ "WHILE", SI_ORDINARY, NULL, -1, OBJNULL},
......
......@@ -1618,6 +1618,27 @@ cl_symbols[] = {
{MP_ "MAILBOX-TRY-READ",IF_MP("mp_mailbox_try_read")},
{MP_ "MAILBOX-SEND",IF_MP("mp_mailbox_send")},
{MP_ "MAILBOX-TRY-SEND",IF_MP("mp_mailbox_try_send")},
{MP_ "COMPARE-AND-SWAP-CAR",IF_MP("mp_compare_and_swap_car")},
{MP_ "COMPARE-AND-SWAP-CDR",IF_MP("mp_compare_and_swap_cdr")},
{MP_ "COMPARE-AND-SWAP-SYMBOL-PLIST",IF_MP("mp_compare_and_swap_symbol_plist")},
{MP_ "COMPARE-AND-SWAP-SYMBOL-VALUE",IF_MP("mp_compare_and_swap_symbol_value")},
{MP_ "COMPARE-AND-SWAP-SVREF",IF_MP("mp_compare_and_swap_svref")},
{MP_ "COMPARE-AND-SWAP-INSTANCE",IF_MP("mp_compare_and_swap_instance")},
{MP_ "COMPARE-AND-SWAP-STRUCTURE",IF_MP("mp_compare_and_swap_structure")},
{MP_ "ATOMIC-INCF-CAR",IF_MP("mp_atomic_incf_car")},
{MP_ "ATOMIC-INCF-CDR",IF_MP("mp_atomic_incf_cdr")},
{MP_ "ATOMIC-INCF-SYMBOL-VALUE",IF_MP("mp_atomic_incf_symbol_value")},
{MP_ "ATOMIC-INCF-SVREF",IF_MP("mp_atomic_incf_svref")},
{MP_ "ATOMIC-INCF-INSTANCE",IF_MP("mp_atomic_incf_instance")},
{MP_ "DEFINE-CAS-EXPANDER",NULL},
{MP_ "DEFCAS",NULL},
{MP_ "GET-CAS-EXPANSION",NULL},
{MP_ "COMPARE-AND-SWAP",NULL},
{MP_ "ATOMIC-UPDATE",NULL},
{MP_ "ATOMIC-PUSH",NULL},
{MP_ "ATOMIC-POP",NULL},
{MP_ "ATOMIC-INCF",NULL},
{MP_ "ATOMIC-DECF",NULL},
/* #endif defined(ECL_THREADS) */
{SYS_ "WHILE",NULL},
......
......@@ -16,7 +16,6 @@
#include <ecl/internal.h>
#ifdef ECL_THREADS
#include "threads/ecl_atomics.h"
cl_object
ecl_atomic_get(cl_object *slot)
......
......@@ -10,10 +10,8 @@
*
*/
#define AO_ASSUME_WINDOWS98 /* We need this for CAS */
#include <ecl/ecl.h>
#include <ecl/internal.h>
#include "threads/ecl_atomics.h"
static ECL_INLINE void
FEerror_not_a_barrier(cl_object barrier)
......
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
/*
* ecl_atomics.h - alternative definitions for atomic operations
*
* Copyright (c) 2012 Juan Jose Garcia Ripoll
*
* See file 'LICENSE' for the copyright details.
*
*/
#ifndef ECL_ATOMICS_H
#define AO_ASSUME_WINDOWS98
#include <ecl/internal.h>
#if !defined(AO_HAVE_compare_and_swap_full)
# error "ECL needs AO_compare_and_swap_full or an equivalent"
#endif
#if !defined(AO_HAVE_compare_and_swap)
# error "ECL needs AO_compare_and_swap or an equivalent"
#endif
#if !defined(AO_HAVE_fetch_and_add1)
# error "Cannot implement mailboxs without AO_fetch_and_add1"
#endif
#endif /* ECL_ATOMICS_H */
......@@ -10,10 +10,8 @@
*
*/
#define AO_ASSUME_WINDOWS98 /* We need this for CAS */
#include <ecl/ecl.h>
#include <ecl/internal.h>
#include "threads/ecl_atomics.h"
static ECL_INLINE void
FEerror_not_a_mailbox(cl_object mailbox)
......
......@@ -10,10 +10,8 @@
*
*/
#define AO_ASSUME_WINDOWS98 /* We need this for CAS */
#include <ecl/ecl.h>
#include <ecl/internal.h>
#include "threads/ecl_atomics.h"
/*----------------------------------------------------------------------
......
......@@ -28,7 +28,6 @@
#endif
#include <ecl/internal.h>
#include <ecl/ecl-inl.h>
#include "threads/ecl_atomics.h"
#ifdef ECL_WINDOWS_THREADS
DWORD cl_env_key;
......
......@@ -16,7 +16,6 @@
#include <signal.h>
#include <ecl/ecl.h>
#include <ecl/internal.h>
#include "threads/ecl_atomics.h"
void ECL_INLINE
ecl_process_yield()
......
......@@ -26,7 +26,7 @@
;;; number of local slots.
;;; b) The new local slots are filled with the value of the old
;;; slots. Only the name is used, so that a new local slot may
;;; get the value of old slots that were eithe local or shared.
;;; get the value of old slots that were either local or shared.
;;; c) Finally, UPDATE-INSTANCE-FOR-DIFFERENT-CLASS is invoked
;;; with a copy of the instance as it looked before the change,
;;; the changed instance and enough information to perform any
......
......@@ -259,3 +259,70 @@
(ignore instance))
(error "Invalid location ~A when accessing slot of class ~A"
location (class-of location)))
;;;
;;; Atomic functions to set and increment slot values
;;;
#+threads
(defun std-slot-location (self slot-name operation)
(let* ((class (class-of self))
(location-table (class-location-table class))
(location (if location-table
(gethash slot-name location-table nil)
;; We ignore possible definitions of
;; slot-value-using-class and hope for the
;; best
(let ((slotd (find slot-name (class-slots class)
:key #'slot-definition-name)))
(if slotd
(slot-definition-location slotd)
nil)))))
(or location (slot-missing class self slot-name operation))))
#+threads
(defun mp::compare-and-swap-standard-instance (instance location old new)
(with-early-accessors (+standard-class-slots+
+slot-definition-slots+)
(ensure-up-to-date-instance instance)
(cond ((ext:fixnump location)
;; local slot
(mp:compare-and-swap-instance instance (truly-the fixnum location) old new))
((consp location)
;; shared slot
(mp:compare-and-swap (car location) old new))
(t
(invalid-slot-location instance location)))))
#+threads
(defun mp::compare-and-swap-slot-value (self slot-name old new)
(with-early-accessors (+standard-class-slots+
+slot-definition-slots+)
(let* ((location (std-slot-location self slot-name 'MP:COMPARE-AND-SWAP))
(old-slot-value
(mp::compare-and-swap-standard-instance self location old new)))
(if (and (not (si:sl-boundp old-slot-value)) (si:sl-boundp old))
(slot-unbound (class-of self) self slot-name)
old-slot-value))))
#+threads
(defun mp::atomic-incf-standard-instance (instance location increment)
(with-early-accessors (+standard-class-slots+
+slot-definition-slots+)
(ensure-up-to-date-instance instance)
(cond ((ext:fixnump location)
;; local slot
(mp:atomic-incf-instance instance (truly-the fixnum location) increment))
((consp location)
;; shared slot
(mp:atomic-incf (car location) increment))
(t
(invalid-slot-location instance location)))))
#+threads
(defun mp::atomic-incf-slot-value (self slot-name increment)
(with-early-accessors (+standard-class-slots+
+slot-definition-slots+)
(mp::atomic-incf-standard-instance self
(std-slot-location self slot-name 'MP:ATOMIC-INCF)
increment)))
......@@ -298,7 +298,7 @@
; (proclamation unbound-slot-instance (condition) si::instance :predicate)
#+clos
(proclamation clos::standard-instance-set (t ext:instance t) t)
(proclamation clos::standard-instance-set (ext:instance t t) t)
#+clos
(proclamation clos:std-compute-applicable-methods (generic-function list) list)
#+clos
......@@ -314,6 +314,11 @@
#+clos
(proclamation clos:extract-specializer-names (list) list)
#+(and threads clos) (proclamation mp::compare-and-swap-standard-instance (ext:instance t t t) t)
#+(and threads clos) (proclamation mp::compare-and-swap-slot-value (ext:instance symbol t t) t)
#+(and threads clos) (proclamation mp::atomic-incf-standard-instance (ext:instance t fixnum) fixnum)
#+(and threads clos) (proclamation mp::atomic-incf-slot-value (ext:instance symbol fixnum) fixnum)
;;;
;;; 8. STRUCTURES
;;;
......@@ -328,6 +333,8 @@
(proclamation si:structurep (t) gen-bool :predicate)
(proclamation si:structure-subtype-p (t t) gen-bool :predicate)
#+threads (proclamation mp:compare-and-swap-structure (structure-object t fixnum t t) t)
;;;
;;; 9. CONDITIONS
;;;
......@@ -404,6 +411,9 @@
(proclamation si:rem-sysprop (t t) boolean)
(proclamation si:put-properties (symbol &rest t) symbol :no-sp-change)
#+threads (proclamation mp:compare-and-swap-symbol-plist (symbol list list) list)
#+threads (proclamation mp:compare-and-swap-symbol-value (symbol t t) t)
#+threads (proclamation mp:atomic-incf-symbol-value (symbol fixnum) fixnum)
;;;
;;; 11. PACKAGES
......@@ -763,6 +773,11 @@
(proclamation si:cons-cdr (cons) t :reader)
(proclamation si::proper-list-p (t) gen-bool :predicate)
#+threads (proclamation mp:compare-and-swap-car (cons t t) t)
#+threads (proclamation mp:atomic-incf-car (cons fixnum) fixnum)
#+threads (proclamation mp:compare-and-swap-cdr (cons t t) t)
#+threads (proclamation mp:atomic-incf-cdr (cons fixnum) fixnum)
;;;
;;; 15. ARRAYS
;;;
......@@ -847,6 +862,9 @@
(proclamation si:fill-pointer-set (vector ext:array-index) ext:array-index)
(proclamation si:replace-array (array array) array)
#+threads (proclamation mp:compare-and-swap-svref (simple-vector ext:array-index t t) t)
#+threads (proclamation mp:atomic-incf-svref (simple-vector ext:array-index fixnum) fixnum)
;;;
;;; 16. STRINGS
;;;
......@@ -1396,6 +1414,9 @@
#+clos
(proclamation clos::load-defclass (t t t t) t)
#+(and threads clos) (proclamation mp:compare-and-swap-instance (t fixnum t t) t)
#+(and threads clos) (proclamation mp:atomic-incf-instance (t fixnum fixnum) fixnum)
;;;
;;; A. FFI
;;;
......
......@@ -752,6 +752,48 @@
#+threads
(def-inline mp:lock-count :unsafe (mp:lock) fixnum "((#0)->lock.count)")
#+threads
(def-inline mp:compare-and-swap-car :always (cons t t) t "ecl_compare_and_swap(&ECL_CONS_CAR(#0),(#1),(#2))")
#+threads
(def-inline mp:atomic-incf-car :always (cons t) t "ecl_atomic_incf(&ECL_CONS_CAR(#0),(#1))")
#+threads
(def-inline mp:atomic-incf-car :always (cons fixnum) t "ecl_atomic_incf_by_fixnum(&ECL_CONS_CAR(#0),(#1))")
#+threads
(def-inline mp:compare-and-swap-cdr :always (cons t t) t "ecl_compare_and_swap(&ECL_CONS_CDR(#0),(#1),(#2))")
#+threads
(def-inline mp:atomic-incf-cdr :always (cons t) t "ecl_atomic_incf(&ECL_CONS_CDR(#0),(#1))")
#+threads
(def-inline mp:atomic-incf-cdr :always (cons fixnum) t "ecl_atomic_incf_by_fixnum(&ECL_CONS_CDR(#0),(#1))")
#+threads
(def-inline mp:compare-and-swap-symbol-value :unsafe (symbol t t) t "ecl_compare_and_swap(ecl_bds_ref(ecl_process_env(),(#0)),(#1),(#2))")
#+threads
(def-inline mp:atomic-incf-symbol-value :always (t fixnum) t "ecl_atomic_incf_by_fixnum(ecl_bds_ref(ecl_process_env(),(#0)),(#1))")
#+threads
(def-inline mp:atomic-incf-symbol-value :unsafe (symbol t) t "ecl_atomic_incf(ecl_bds_ref(ecl_process_env(),(#0)),(#1))")
#+threads
(def-inline mp:atomic-incf-symbol-value :unsafe (symbol fixnum) t "ecl_atomic_incf_by_fixnum(ecl_bds_ref(ecl_process_env(),(#0)),(#1))")
#+threads
(def-inline mp:compare-and-swap-svref :unsafe (t t t t) t "ecl_compare_and_swap((#0)->vector.self.t + ecl_fixnum(#1),(#2),(#3))")
#+threads
(def-inline mp:compare-and-swap-svref :unsafe (t fixnum t t) t "ecl_compare_and_swap((#0)->vector.self.t + (#1),(#2),(#3))")
#+(and threads clos)
(def-inline mp:compare-and-swap-instance :always (t fixnum t t) t "ecl_compare_and_swap_instance((#0),(#1),(#2),(#3))")
#+(and threads clos)
(def-inline mp:compare-and-swap-instance :unsafe (standard-object fixnum t t) t "ecl_compare_and_swap((#0)->instance.slots+(#1),(#2),(#3))")
#+(and threads clos)
(def-inline mp:atomic-incf-instance :always (t fixnum t) t "ecl_atomic_incf_instance((#0),(#1),(#2))")
#+(and threads clos)
(def-inline mp:atomic-incf-instance :unsafe (standard-object fixnum t) t "ecl_atomic_incf((#0)->instance.slots+(#1),(#2))")
#+(and threads clos)
(def-inline mp:atomic-incf-instance :unsafe (standard-object fixnum fixnum) t "ecl_atomic_incf_by_fixnum((#0)->instance.slots+(#1),(#2))")
#+threads
(def-inline mp:compare-and-swap-structure :unsafe (structure-object t fixnum t t) t "ecl_compare_and_swap(&(ECL_STRUCT_SLOT((#0),(#2))),(#3),(#4))")
;; Functions only available with CLOS