mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-02 02:10:19 +02:00
Add ephemeron-table-clear!; ephemeron key can be immediate
* libguile/ephemerons.c (scm_make_ephemeron): Relax restriction that key be a heap object. It's too annoying otherwise. (scm_c_ephemeron_table_clear_x): (scm_ephemeron_table_clear_x): New interface. * module/ice-9/ephemerons.scm: Expose ephemeron-table-clear!. * test-suite/tests/ephemerons.test ("ephemerons"): Update tests.
This commit is contained in:
parent
c35cbd65f1
commit
d457aaa57d
4 changed files with 49 additions and 10 deletions
|
@ -57,6 +57,12 @@ scm_atomic_ref_pointer (void **loc)
|
|||
atomic_uintptr_t *a_loc = (atomic_uintptr_t *) loc;
|
||||
return (void *) atomic_load (a_loc);
|
||||
}
|
||||
static inline void *
|
||||
scm_atomic_swap_pointer (void **loc, void *new_val)
|
||||
{
|
||||
atomic_uintptr_t *a_loc = (atomic_uintptr_t *) loc;
|
||||
return (void *) atomic_exchange (a_loc, (uintptr_t) new_val);
|
||||
}
|
||||
static inline void
|
||||
scm_atomic_set_bits (scm_t_bits *loc, scm_t_bits val)
|
||||
{
|
||||
|
@ -141,6 +147,16 @@ scm_atomic_ref_pointer (void **loc)
|
|||
scm_i_pthread_mutex_unlock (&atomics_lock);
|
||||
return ret;
|
||||
}
|
||||
static inline void *
|
||||
scm_atomic_swap_pointer (void **loc, void *new_val)
|
||||
{
|
||||
void *ret;
|
||||
scm_i_pthread_mutex_lock (&atomics_lock);
|
||||
ret = *loc;
|
||||
*loc = new_val;
|
||||
scm_i_pthread_mutex_unlock (&atomics_lock);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static inline void
|
||||
scm_atomic_set_bits (scm_t_bits *loc, scm_t_bits val)
|
||||
|
|
|
@ -30,6 +30,7 @@
|
|||
#include <stdio.h>
|
||||
#include <unistd.h>
|
||||
|
||||
#include "atomics-internal.h"
|
||||
#include "extensions.h"
|
||||
#include "gc-internal.h"
|
||||
#include "gsubr.h"
|
||||
|
@ -147,7 +148,6 @@ SCM_DEFINE_STATIC (scm_make_ephemeron, "make-ephemeron", 2, 0, 0,
|
|||
"as @var{key} and the ephemeron itself are alive.")
|
||||
#define FUNC_NAME s_scm_make_ephemeron
|
||||
{
|
||||
SCM_MAKE_VALIDATE (1, key, HEAP_OBJECT_P);
|
||||
return PTR2SCM (scm_c_make_ephemeron (key, val));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
@ -299,6 +299,15 @@ scm_c_ephemeron_table_try_push_x (struct scm_ephemeron_table *et, size_t idx,
|
|||
return prev;
|
||||
}
|
||||
|
||||
static struct gc_ephemeron*
|
||||
scm_c_ephemeron_table_clear_x (struct scm_ephemeron_table *et, size_t idx)
|
||||
{
|
||||
if (idx >= et->size)
|
||||
abort();
|
||||
|
||||
return scm_atomic_swap_pointer ((void**) &et->contents[idx], NULL);
|
||||
}
|
||||
|
||||
struct scm_ephemeron_table*
|
||||
scm_c_ephemeron_table_copy (struct scm_ephemeron_table *et)
|
||||
{
|
||||
|
@ -408,6 +417,23 @@ SCM_DEFINE_STATIC (scm_ephemeron_table_try_push_x, "ephemeron-table-try-push!",
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE_STATIC (scm_ephemeron_table_clear_x, "ephemeron-table-clear!",
|
||||
2, 0, 0, (SCM et, SCM idx),
|
||||
"Clear the slot @var{idx} of the ephemeron table @var{et} "
|
||||
"and return its previous value.")
|
||||
#define FUNC_NAME s_scm_ephemeron_table_clear_x
|
||||
{
|
||||
SCM_VALIDATE_EPHEMERON_TABLE (1, et);
|
||||
SCM_ASSERT_RANGE (2, idx,
|
||||
scm_to_size_t (idx) < scm_as_ephemeron_table (et)->size);
|
||||
|
||||
struct gc_ephemeron *prev =
|
||||
scm_c_ephemeron_table_clear_x (scm_as_ephemeron_table (et),
|
||||
scm_to_size_t (idx));
|
||||
return prev ? PTR2SCM (prev) : SCM_BOOL_F;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
int
|
||||
scm_i_print_ephemeron_table (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
|
||||
{
|
||||
|
|
|
@ -35,7 +35,8 @@
|
|||
|
||||
ephemeron-table-ref
|
||||
ephemeron-table-push!
|
||||
ephemeron-table-try-push!))
|
||||
ephemeron-table-try-push!
|
||||
ephemeron-table-clear!))
|
||||
|
||||
(eval-when (expand load eval)
|
||||
(load-extension (string-append "libguile-" (effective-version))
|
||||
|
|
|
@ -27,14 +27,10 @@
|
|||
(pass-if (ephemeron? (make-ephemeron (cons 42 42) 42)))
|
||||
|
||||
(with-test-prefix "ephemeron key not heap object"
|
||||
(pass-if-exception "fixnum" exception:wrong-type-arg
|
||||
(make-ephemeron 42 42))
|
||||
(pass-if-exception "char" exception:wrong-type-arg
|
||||
(make-ephemeron #\a 42))
|
||||
(pass-if-exception "bool" exception:wrong-type-arg
|
||||
(make-ephemeron #f 42))
|
||||
(pass-if-exception "bool" exception:wrong-type-arg
|
||||
(make-ephemeron #t 42)))
|
||||
(pass-if "fixnum" (ephemeron? (make-ephemeron 42 42)))
|
||||
(pass-if "char" (ephemeron? (make-ephemeron #\a 42)))
|
||||
(pass-if "bool" (ephemeron? (make-ephemeron #f 42)))
|
||||
(pass-if "bool" (ephemeron? (make-ephemeron #t 42))))
|
||||
|
||||
(let ((x (cons 42 69)))
|
||||
(define e (make-ephemeron x 100))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue