wingo pushed a commit to branch wip-whippet
in repository guile.
commit 929069897788262bbc03fcb00bb04a2474dd0426
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Fri Jun 20 16:23:02 2025 +0200
Move atomic box off of scm_cell
* libguile/Makefile.am:
* libguile/atomic.h: Make private. Define "struct scm_atomic_box".
* libguile/atomic.c: Allocate scm_atomic_box via scm_allocate_tagged.
---
libguile.h | 1 -
libguile/Makefile.am | 4 ++--
libguile/atomic.c | 21 ++++++++++++---------
libguile/atomic.h | 34 +++++++++++++++++++++++++++-------
4 files changed, 41 insertions(+), 19 deletions(-)
diff --git a/libguile.h b/libguile.h
index eb0326604..e670522a2 100644
--- a/libguile.h
+++ b/libguile.h
@@ -32,7 +32,6 @@ extern "C" {
#include "libguile/array-handle.h"
#include "libguile/arrays.h"
#include "libguile/async.h"
-#include "libguile/atomic.h"
#include "libguile/boolean.h"
#include "libguile/bitvectors.h"
#include "libguile/bytevectors.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 56c3a7a1f..1a8247d26 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -506,7 +506,8 @@ uninstall-hook:
## compile, since they are #included. So instead we list them here.
## Perhaps we can deal with them normally once the merge seems to be
## working.
-noinst_HEADERS = custom-ports.h \
+noinst_HEADERS = atomic.h \
+ custom-ports.h \
elf.h \
ephemerons.h \
integers.h \
@@ -588,7 +589,6 @@ modinclude_HEADERS = \
array-handle.h \
arrays.h \
async.h \
- atomic.h \
backtrace.h \
boolean.h \
bitvectors.h \
diff --git a/libguile/atomic.c b/libguile/atomic.c
index adb2a0c4b..a091efe42 100644
--- a/libguile/atomic.c
+++ b/libguile/atomic.c
@@ -1,4 +1,4 @@
-/* Copyright 2016,2018-2019
+/* Copyright 2016,2018-2019,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -29,6 +29,7 @@
#include "extensions.h"
#include "gsubr.h"
#include "ports.h"
+#include "threads.h"
#include "version.h"
#include "atomic.h"
@@ -41,9 +42,11 @@ SCM_DEFINE (scm_make_atomic_box, "make-atomic-box", 1, 0, 0,
"Return an atomic box initialized to value @var{init}.")
#define FUNC_NAME s_scm_make_atomic_box
{
- SCM ret = scm_cell (scm_tc7_atomic_box, SCM_UNPACK (SCM_UNDEFINED));
- scm_atomic_box_set_x (ret, init);
- return ret;
+ struct scm_atomic_box *box = scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (*box));
+ box->tag = scm_tc7_atomic_box;
+ scm_atomic_set_scm (scm_atomic_box_loc (box), init);
+ return scm_from_atomic_box (box);
}
#undef FUNC_NAME
@@ -64,7 +67,7 @@ SCM_DEFINE (scm_atomic_box_ref, "atomic-box-ref", 1, 0, 0,
#define FUNC_NAME s_scm_atomic_box_ref
{
SCM_VALIDATE_ATOMIC_BOX (1, box);
- return scm_atomic_ref_scm (scm_atomic_box_loc (box));
+ return scm_atomic_ref_scm (scm_atomic_box_loc (scm_to_atomic_box (box)));
}
#undef FUNC_NAME
@@ -74,7 +77,7 @@ SCM_DEFINE (scm_atomic_box_set_x, "atomic-box-set!", 2, 0, 0,
#define FUNC_NAME s_scm_atomic_box_set_x
{
SCM_VALIDATE_ATOMIC_BOX (1, box);
- scm_atomic_set_scm (scm_atomic_box_loc (box), val);
+ scm_atomic_set_scm (scm_atomic_box_loc (scm_to_atomic_box (box)), val);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -87,7 +90,7 @@ SCM_DEFINE (scm_atomic_box_swap_x, "atomic-box-swap!", 2, 0,
0,
#define FUNC_NAME s_scm_atomic_box_swap_x
{
SCM_VALIDATE_ATOMIC_BOX (1, box);
- return scm_atomic_swap_scm (scm_atomic_box_loc (box), val);
+ return scm_atomic_swap_scm (scm_atomic_box_loc (scm_to_atomic_box (box)),
val);
}
#undef FUNC_NAME
@@ -103,8 +106,8 @@ SCM_DEFINE (scm_atomic_box_compare_and_swap_x,
#define FUNC_NAME s_scm_atomic_box_compare_and_swap_x
{
SCM_VALIDATE_ATOMIC_BOX (1, box);
- return scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (box),
- expected, desired);
+ return scm_atomic_compare_and_swap_scm
+ (scm_atomic_box_loc (scm_to_atomic_box (box)), expected, desired);
}
#undef FUNC_NAME
diff --git a/libguile/atomic.h b/libguile/atomic.h
index 7bf3cae85..62538b721 100644
--- a/libguile/atomic.h
+++ b/libguile/atomic.h
@@ -1,7 +1,7 @@
#ifndef SCM_ATOMIC_H
#define SCM_ATOMIC_H
-/* Copyright 2016,2018
+/* Copyright 2016,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -26,16 +26,38 @@
+/* Atomic boxes
+ */
+struct scm_atomic_box
+{
+ scm_t_bits tag;
+ SCM value;
+};
+
static inline int
-scm_is_atomic_box (SCM obj)
+scm_is_atomic_box (SCM x)
+{
+ return SCM_HAS_TYP7 (x, scm_tc7_atomic_box);
+}
+
+static inline struct scm_atomic_box *
+scm_to_atomic_box (SCM x)
+{
+ if (!scm_is_atomic_box (x))
+ abort ();
+ return (struct scm_atomic_box *) SCM_UNPACK_POINTER (x);
+}
+
+static inline SCM
+scm_from_atomic_box (struct scm_atomic_box *box)
{
- return SCM_HAS_TYP7 (obj, scm_tc7_atomic_box);
+ return SCM_PACK_POINTER (box);
}
static inline SCM*
-scm_atomic_box_loc (SCM obj)
+scm_atomic_box_loc (struct scm_atomic_box *box)
{
- return SCM_CELL_OBJECT_LOC (obj, 1);
+ return &box->value;
}
#define SCM_VALIDATE_ATOMIC_BOX(pos, var) \
@@ -46,7 +68,6 @@ scm_atomic_box_loc (SCM obj)
-#ifdef BUILDING_LIBGUILE
SCM_INTERNAL SCM scm_make_atomic_box (SCM init);
SCM_INTERNAL SCM scm_atomic_box_p (SCM obj);
SCM_INTERNAL SCM scm_atomic_box_ref (SCM box);
@@ -56,6 +77,5 @@ SCM_INTERNAL SCM scm_atomic_box_compare_and_swap_x (SCM box,
SCM expected, SCM d
SCM_INTERNAL void scm_i_atomic_box_print (SCM box, SCM port, scm_print_state
*pstate);
SCM_INTERNAL void scm_register_atomic (void);
-#endif /* BUILDING_LIBGUILE */
#endif /* SCM_ATOMIC_H */
