wingo pushed a commit to branch wip-whippet
in repository guile.
commit 7997496a327d46c3c16d476cd492e421ec7fe0e1
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Fri Jun 20 15:33:33 2025 +0200
Move pairs off of scm_cell
* libguile/pairs.h: Remove inline scm_cons, scm_car, scm_cdr defnitions;
this is less important now with the VM. Add a "struct scm_pair", and
make all SCM_CAR / SCM_CDR checks use it. For now it does type checking
as well.
* libguile/pairs.c (scm_cons, scm_car, scm_cdr): Implement here.
* libguile/scm.h (SCM_DEBUG_PAIR_ACCESSES): No more macro!
---
libguile/deprecated.h | 2 +
libguile/pairs.c | 40 +++++++++-------
libguile/pairs.h | 130 ++++++++++++++++++++++----------------------------
libguile/scm.h | 7 ---
4 files changed, 83 insertions(+), 96 deletions(-)
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index fed5bc94b..2cc495432 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -120,6 +120,8 @@ SCM_DEPRECATED SCM scm_regexp_exec (SCM rx, SCM str, SCM
start, SCM flags);
#define SCM_RGXP(X) (scm_is_true (scm_regexp_p (x)))
#define SCM_VALIDATE_RGXP(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, RGXP,
"regexp")
+#define SCM_VALIDATE_PAIR(cell, expr)
SCM_VALIDATE_PAIR__Gone__Inline_second_argument_at_use
+
/* Deprecated declarations go here. */
void scm_i_init_deprecated (void);
diff --git a/libguile/pairs.c b/libguile/pairs.c
index a2c7a7d96..acf6d3e86 100644
--- a/libguile/pairs.c
+++ b/libguile/pairs.c
@@ -28,6 +28,7 @@
#include "boolean.h"
#include "gc-internal.h"
#include "trace.h"
+#include "threads.h"
#include "gsubr.h"
#include "pairs.h"
@@ -49,26 +50,33 @@ verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION
\
(SCM_ELISP_NIL_BITS, SCM_EOL_BITS));
-#if (SCM_DEBUG_PAIR_ACCESSES == 1)
-
-#include "ports.h"
-#include "strings.h"
-
-void scm_error_pair_access (SCM non_pair)
+/* Return a newly allocated pair whose car is @var{x} and whose cdr is
+ @var{y}. The pair is guaranteed to be different (in the sense of
+ @code{eq?}) from every previously existing object. */
+SCM
+scm_cons (SCM x, SCM y)
{
- static unsigned int running = 0;
- SCM message = scm_from_utf8_string ("Non-pair accessed with SCM_C[AD]R:
`~S'\n");
+ struct scm_pair *p = scm_allocate_tagged (SCM_I_CURRENT_THREAD, sizeof (*p));
+ p->car = x;
+ p->cdr = y;
+ return scm_from_pair (p);
+}
- if (!running)
- {
- running = 1;
- scm_simple_format (scm_current_error_port (),
- message, scm_list_1 (non_pair));
- abort ();
- }
+SCM
+scm_car (SCM x)
+{
+ if (SCM_UNLIKELY (!scm_is_pair (x)))
+ scm_wrong_type_arg_msg ("car", 0, x, "pair");
+ return SCM_CAR (x);
}
-#endif
+SCM
+scm_cdr (SCM x)
+{
+ if (SCM_UNLIKELY (!scm_is_pair (x)))
+ scm_wrong_type_arg_msg ("cdr", 0, x, "pair");
+ return SCM_CDR (x);
+}
SCM
scm_cons2 (SCM w, SCM x, SCM y)
diff --git a/libguile/pairs.h b/libguile/pairs.h
index 4bca40368..94d433439 100644
--- a/libguile/pairs.h
+++ b/libguile/pairs.h
@@ -67,11 +67,61 @@
/* #nil is null. */
#define scm_is_null(x) (scm_is_null_or_nil(x))
-#define SCM_CAR(x) (SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_0 (x)))
-#define SCM_CDR(x) (SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_1 (x)))
+struct scm_pair
+{
+ SCM car;
+ SCM cdr;
+};
+
+static inline int
+scm_is_pair (SCM x)
+{
+ return SCM_I_CONSP (x);
+}
+
+static inline struct scm_pair *
+scm_to_pair (SCM x)
+{
+ if (!scm_is_pair (x))
+ abort ();
+ return (struct scm_pair *) SCM_UNPACK_POINTER (x);
+}
+
+static inline SCM
+scm_from_pair (struct scm_pair *pair)
+{
+ return SCM_PACK_POINTER (pair);
+}
+
+static inline SCM
+scm_pair_car (struct scm_pair *pair)
+{
+ return pair->car;
+}
+
+static inline SCM
+scm_pair_cdr (struct scm_pair *pair)
+{
+ return pair->cdr;
+}
+
+static inline void
+scm_pair_set_car_x (struct scm_pair *pair, SCM car)
+{
+ pair->car = car;
+}
+
+static inline void
+scm_pair_set_cdr_x (struct scm_pair *pair, SCM cdr)
+{
+ pair->cdr = cdr;
+}
+
+#define SCM_CAR(x) (scm_pair_car (scm_to_pair (x)))
+#define SCM_CDR(x) (scm_pair_cdr (scm_to_pair (x)))
-#define SCM_SETCAR(x, v) (SCM_VALIDATE_PAIR (x, SCM_SET_CELL_OBJECT_0
((x), (v))))
-#define SCM_SETCDR(x, v) (SCM_VALIDATE_PAIR (x, SCM_SET_CELL_OBJECT_1
((x), (v))))
+#define SCM_SETCAR(x, v) (scm_pair_set_car_x (scm_to_pair (x), v))
+#define SCM_SETCDR(x, v) (scm_pair_set_cdr_x (scm_to_pair (x), v))
#define SCM_CAAR(OBJ) SCM_CAR (SCM_CAR (OBJ))
#define SCM_CDAR(OBJ) SCM_CDR (SCM_CAR (OBJ))
@@ -116,13 +166,6 @@
#define SCM_VALIDATE_CONS(pos, scm) \
SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_pair, "pair")
-#if (SCM_DEBUG_PAIR_ACCESSES == 1)
-# define SCM_VALIDATE_PAIR(cell, expr) \
- ((!scm_is_pair (cell) ? scm_error_pair_access (cell), 0 : 0), (expr))
-#else
-# define SCM_VALIDATE_PAIR(cell, expr) (expr)
-#endif
-
#ifdef BUILDING_LIBGUILE
#define SCM_VALIDATE_MUTABLE_PAIR(pos, scm) \
SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_mutable_pair, "mutable pair")
@@ -136,68 +179,9 @@
-#if (SCM_DEBUG_PAIR_ACCESSES == 1)
-SCM_API void scm_error_pair_access (SCM);
-#endif
-
-SCM_INLINE int scm_is_pair (SCM x);
-SCM_INLINE SCM scm_cons (SCM x, SCM y);
-SCM_INLINE SCM scm_car (SCM x);
-SCM_INLINE SCM scm_cdr (SCM x);
-
-#if SCM_CAN_INLINE || defined SCM_INLINE_C_IMPLEMENTING_INLINES
-/* Return a newly allocated pair whose car is @var{x} and whose cdr is
- @var{y}. The pair is guaranteed to be different (in the sense of
- @code{eq?}) from every previously existing object. */
-SCM_INLINE_IMPLEMENTATION SCM
-scm_cons (SCM x, SCM y)
-{
- return scm_cell (SCM_UNPACK (x), SCM_UNPACK (y));
-}
-
-SCM_INLINE_IMPLEMENTATION int
-scm_is_pair (SCM x)
-{
- /* The following "workaround_for_gcc_295" avoids bad code generated by
- i386 gcc 2.95.4 (the Debian packaged 2.95.4-24 at least).
-
- Under the default -O2 the inlined SCM_I_CONSP test gets "optimized" so
- the fetch of the tag word from x is done before confirming it's a
- non-immediate (SCM_NIMP). Needless to say that bombs badly if x is a
- immediate. This was seen to afflict scm_srfi1_split_at and something
- deep in the bowels of ceval(). In both cases segvs resulted from
- deferencing a random immediate value. srfi-1.test exposes the problem
- through a short list, the immediate being SCM_EOL in that case.
- Something in syntax.test exposed the ceval() problem.
-
- Just "volatile SCM workaround_for_gcc_295 = lst" is enough to avoid the
- problem, without even using that variable. The "w=w" is just to
- prevent a warning about it being unused.
- */
-#if defined (__GNUC__) && __GNUC__ == 2 && __GNUC_MINOR__ == 95
- volatile SCM workaround_for_gcc_295 = x;
- workaround_for_gcc_295 = workaround_for_gcc_295;
-#endif
-
- return SCM_I_CONSP (x);
-}
-
-SCM_INLINE_IMPLEMENTATION SCM
-scm_car (SCM x)
-{
- if (SCM_UNLIKELY (!scm_is_pair (x)))
- scm_wrong_type_arg_msg ("car", 0, x, "pair");
- return SCM_CAR (x);
-}
-
-SCM_INLINE_IMPLEMENTATION SCM
-scm_cdr (SCM x)
-{
- if (SCM_UNLIKELY (!scm_is_pair (x)))
- scm_wrong_type_arg_msg ("cdr", 0, x, "pair");
- return SCM_CDR (x);
-}
-#endif
+SCM_API SCM scm_cons (SCM x, SCM y);
+SCM_API SCM scm_car (SCM x);
+SCM_API SCM scm_cdr (SCM x);
SCM_INTERNAL int scm_is_mutable_pair (SCM x);
diff --git a/libguile/scm.h b/libguile/scm.h
index 38a522602..25a8fee2d 100644
--- a/libguile/scm.h
+++ b/libguile/scm.h
@@ -39,13 +39,6 @@
#define SCM_DEBUG 0
#endif
-/* If SCM_DEBUG_PAIR_ACCESSES is set to 1, accesses to cons cells will
- be exhaustively checked. Note: If this option is enabled, guile
- will run slower than normally. */
-#ifndef SCM_DEBUG_PAIR_ACCESSES
-#define SCM_DEBUG_PAIR_ACCESSES SCM_DEBUG
-#endif
-
/* If SCM_DEBUG_REST_ARGUMENT is set to 1, functions that take rest
arguments will check whether the rest arguments are actually passed
as a proper list. Otherwise, if SCM_DEBUG_REST_ARGUMENT is 0,
