wingo pushed a commit to branch wip-whippet
in repository guile.
commit 6a32628e18b17df6ca089d44fb38972976bf889c
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Tue Jul 1 10:43:14 2025 +0200
frames, values: BUILDING_LIBGUILE-guarded defs to internal headers
I was writing the trace function, which is included by Whippet, which
doesn't have the BUILDING_LIBGUILE define. It is just as fine to put
these in private headers; better, even.
* libguile/frames-internal.h:
* libguile/values-internal.h: New files.
* libguile/Makefile.am (noinst_HEADERS): Add new files.
* libguile/backtrace.c:
* libguile/continuations.c:
* libguile/control.c:
* libguile/eval.c:
* libguile/frames.c:
* libguile/frames.h:
* libguile/gsubr.c:
* libguile/init.c:
* libguile/intrinsics.c:
* libguile/numbers.c:
* libguile/print.c:
* libguile/smob.c:
* libguile/smob.h:
* libguile/stacks.c:
* libguile/stacks.h:
* libguile/values.c:
* libguile/values.h:
* libguile/vm.c: Include new files.
---
libguile/Makefile.am | 2 +
libguile/backtrace.c | 4 +-
libguile/continuations.c | 1 +
libguile/control.c | 2 +-
libguile/eval.c | 4 +-
libguile/frames-internal.h | 111 +++++++++++++++++++++++++++++++
libguile/frames.c | 2 +-
libguile/frames.h | 89 -------------------------
libguile/gsubr.c | 2 +-
libguile/init.c | 4 +-
libguile/intrinsics.c | 2 +-
libguile/numbers.c | 2 +-
libguile/print.c | 4 +-
libguile/smob.c | 22 +++++-
libguile/smob.h | 1 +
libguile/stacks.c | 2 +-
libguile/stacks.h | 4 --
libguile/{values.h => values-internal.h} | 25 ++-----
libguile/values.c | 2 +-
libguile/values.h | 37 -----------
libguile/vm.c | 2 +-
21 files changed, 155 insertions(+), 169 deletions(-)
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 16ca88ce1..bf0f612e1 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -522,6 +522,7 @@ noinst_HEADERS = atomic.h
\
dynstack.h \
filesys-internal.h \
fluids-internal.h \
+ frames-internal.h \
gc-inline.h \
gc-internal.h \
gsubr-internal.h \
@@ -538,6 +539,7 @@ noinst_HEADERS = atomic.h
\
syntax.h \
threads-internal.h \
trace.h \
+ values-internal.h \
vectors-internal.h \
whippet-embedder.h
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index fb34c3e54..6d8a95e92 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -37,7 +37,7 @@
#include "eval.h"
#include "filesys.h"
#include "fluids.h"
-#include "frames.h"
+#include "frames-internal.h"
#include "gsubr.h"
#include "keywords.h"
#include "list.h"
@@ -113,7 +113,7 @@ scm_print_exception (SCM port, SCM frame, SCM key, SCM args)
SCM_VALIDATE_OPOUTPORT (1, port);
if (scm_is_true (frame))
- SCM_VALIDATE_FRAME (2, frame);
+ SCM_VALIDATE_VM_FRAME (2, frame);
SCM_VALIDATE_SYMBOL (3, key);
SCM_VALIDATE_LIST (4, args);
diff --git a/libguile/continuations.c b/libguile/continuations.c
index d15a281d1..d5d1bb6b8 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -34,6 +34,7 @@
#include "debug.h"
#include "dynstack.h"
#include "eval.h"
+#include "frames-internal.h"
#include "gc-internal.h"
#include "gsubr.h"
#include "init.h"
diff --git a/libguile/control.c b/libguile/control.c
index 5abfaadc6..75105d819 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -25,7 +25,7 @@
#include "dynstack.h"
#include "extensions.h"
-#include "frames.h"
+#include "frames-internal.h"
#include "gsubr.h"
#include "instructions.h"
#include "jit.h"
diff --git a/libguile/eval.c b/libguile/eval.c
index 1da6b9151..b589e4c6f 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -37,7 +37,7 @@
#include "eq.h"
#include "expand.h"
#include "feature.h"
-#include "frames.h"
+#include "frames-internal.h"
#include "fluids.h"
#include "goops.h"
#include "gsubr-internal.h"
@@ -60,7 +60,7 @@
#include "symbols.h"
#include "threads-internal.h"
#include "throw.h"
-#include "values.h"
+#include "values-internal.h"
#include "variable.h"
#include "vectors.h"
#include "vm.h"
diff --git a/libguile/frames-internal.h b/libguile/frames-internal.h
new file mode 100644
index 000000000..dcf8c257f
--- /dev/null
+++ b/libguile/frames-internal.h
@@ -0,0 +1,111 @@
+/* Copyright 2001,2009-2015,2018,2025
+ Free Software Foundation, Inc.
+
+ This file is part of Guile.
+
+ Guile is free software: you can redistribute it and/or modify it
+ under the terms of the GNU Lesser General Public License as published
+ by the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Guile is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
+ License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with Guile. If not, see
+ <https://www.gnu.org/licenses/>. */
+
+#ifndef _SCM_FRAMES_INTERNAL_H_
+#define _SCM_FRAMES_INTERNAL_H_
+
+#include <libguile/frames.h>
+
+
+struct scm_frame
+{
+ void *stack_holder;
+ ptrdiff_t fp_offset;
+ ptrdiff_t sp_offset;
+ uint32_t *ip;
+};
+
+struct scm_vm_frame
+{
+ scm_t_bits tag_and_flags;
+ struct scm_frame frame;
+};
+
+enum scm_vm_frame_kind
+{
+ SCM_VM_FRAME_KIND_VM,
+ SCM_VM_FRAME_KIND_CONT
+};
+
+static inline int
+scm_is_vm_frame (SCM x)
+{
+ return SCM_HAS_TYP7 (x, scm_tc7_frame);
+}
+
+#define SCM_VM_FRAME_P(x) (scm_is_vm_frame (x))
+#define SCM_VALIDATE_VM_FRAME(p,x) SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
+
+static inline struct scm_vm_frame*
+scm_vm_frame (SCM x)
+{
+ if (!scm_is_vm_frame (x))
+ abort ();
+ return (struct scm_vm_frame *) SCM_UNPACK_POINTER (x);
+}
+
+static inline enum scm_vm_frame_kind
+scm_vm_frame_kind (struct scm_vm_frame *frame)
+{
+ return (enum scm_vm_frame_kind) (frame->tag_and_flags >> 8);
+}
+
+SCM_INTERNAL union scm_vm_stack_element*
+scm_vm_frame_stack_top (struct scm_vm_frame *frame);
+
+static inline union scm_vm_stack_element*
+scm_vm_frame_fp (struct scm_vm_frame *frame)
+{
+ return scm_vm_frame_stack_top (frame) - frame->frame.fp_offset;
+}
+
+static inline union scm_vm_stack_element*
+scm_vm_frame_sp (struct scm_vm_frame *frame)
+{
+ return scm_vm_frame_stack_top (frame) - frame->frame.sp_offset;
+}
+
+static inline uint32_t*
+scm_vm_frame_ip (struct scm_vm_frame *frame)
+{
+ return frame->frame.ip;
+}
+
+/* See notes in frames.c before using this. */
+SCM_INTERNAL SCM scm_c_frame_closure (enum scm_vm_frame_kind kind,
+ const struct scm_frame *frame);
+
+SCM_INTERNAL SCM scm_c_make_frame (enum scm_vm_frame_kind kind,
+ const struct scm_frame *frame);
+
+SCM_INTERNAL int scm_c_frame_previous (enum scm_vm_frame_kind kind,
+ struct scm_frame *frame);
+
+static inline void
+scm_frame_init_from_vm_frame (struct scm_frame *frame,
+ const struct scm_vm_frame *vm_frame)
+{
+ memcpy (frame, &vm_frame->frame, sizeof (*frame));
+}
+
+SCM_INTERNAL void scm_i_frame_print (SCM frame, SCM port,
+ scm_print_state *pstate);
+SCM_INTERNAL void scm_init_frames (void);
+
+#endif /* _SCM_FRAMES_INTERNAL_H_ */
diff --git a/libguile/frames.c b/libguile/frames.c
index f1dc81f5b..864dc3339 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -40,7 +40,7 @@
#include "version.h"
#include "vm.h"
-#include "frames.h"
+#include "frames-internal.h"
SCM
diff --git a/libguile/frames.h b/libguile/frames.h
index 8bf76b470..8de8f7b87 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -118,91 +118,6 @@ union scm_vm_stack_element
* Heap frames
*/
-#ifdef BUILDING_LIBGUILE
-
-struct scm_frame
-{
- void *stack_holder;
- ptrdiff_t fp_offset;
- ptrdiff_t sp_offset;
- uint32_t *ip;
-};
-
-struct scm_vm_frame
-{
- scm_t_bits tag_and_flags;
- struct scm_frame frame;
-};
-
-enum scm_vm_frame_kind
-{
- SCM_VM_FRAME_KIND_VM,
- SCM_VM_FRAME_KIND_CONT
-};
-
-static inline int
-scm_is_vm_frame (SCM x)
-{
- return SCM_HAS_TYP7 (x, scm_tc7_frame);
-}
-
-#define SCM_VM_FRAME_P(x) (scm_is_vm_frame (x))
-#define SCM_VALIDATE_VM_FRAME(p,x) SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
-
-static inline struct scm_vm_frame*
-scm_vm_frame (SCM x)
-{
- if (!scm_is_vm_frame (x))
- abort ();
- return (struct scm_vm_frame *) SCM_UNPACK_POINTER (x);
-}
-
-static inline enum scm_vm_frame_kind
-scm_vm_frame_kind (struct scm_vm_frame *frame)
-{
- return (enum scm_vm_frame_kind) (frame->tag_and_flags >> 8);
-}
-
-SCM_INTERNAL union scm_vm_stack_element*
-scm_vm_frame_stack_top (struct scm_vm_frame *frame);
-
-static inline union scm_vm_stack_element*
-scm_vm_frame_fp (struct scm_vm_frame *frame)
-{
- return scm_vm_frame_stack_top (frame) - frame->frame.fp_offset;
-}
-
-static inline union scm_vm_stack_element*
-scm_vm_frame_sp (struct scm_vm_frame *frame)
-{
- return scm_vm_frame_stack_top (frame) - frame->frame.sp_offset;
-}
-
-static inline uint32_t*
-scm_vm_frame_ip (struct scm_vm_frame *frame)
-{
- return frame->frame.ip;
-}
-
-/* See notes in frames.c before using this. */
-SCM_INTERNAL SCM scm_c_frame_closure (enum scm_vm_frame_kind kind,
- const struct scm_frame *frame);
-
-SCM_INTERNAL SCM scm_c_make_frame (enum scm_vm_frame_kind kind,
- const struct scm_frame *frame);
-
-SCM_INTERNAL int scm_c_frame_previous (enum scm_vm_frame_kind kind,
- struct scm_frame *frame);
-
-static inline void
-scm_frame_init_from_vm_frame (struct scm_frame *frame,
- const struct scm_vm_frame *vm_frame)
-{
- memcpy (frame, &vm_frame->frame, sizeof (*frame));
-}
-
-#endif
-
SCM_API SCM scm_frame_p (SCM obj);
SCM_API SCM scm_frame_procedure_name (SCM frame);
SCM_API SCM scm_frame_call_representation (SCM frame);
@@ -215,8 +130,4 @@ SCM_API SCM scm_frame_return_address (SCM frame);
SCM_API SCM scm_frame_dynamic_link (SCM frame);
SCM_API SCM scm_frame_previous (SCM frame);
-SCM_INTERNAL void scm_i_frame_print (SCM frame, SCM port,
- scm_print_state *pstate);
-SCM_INTERNAL void scm_init_frames (void);
-
#endif /* _SCM_FRAMES_H_ */
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index d45a5bce1..d57d1a575 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -29,7 +29,7 @@
#include <string.h>
#include "foreign.h"
-#include "frames.h"
+#include "frames-internal.h"
#include "gc-inline.h"
#include "instructions.h"
#include "jit.h"
diff --git a/libguile/init.c b/libguile/init.c
index 76423cd92..9ae855b60 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -73,7 +73,7 @@
#include "foreign-object.h"
#include "foreign.h"
#include "fports.h"
-#include "frames.h"
+#include "frames-internal.h"
#include "gc.h"
#include "gc-internal.h"
#include "generalized-vectors.h"
@@ -136,7 +136,7 @@
#include "throw.h"
#include "unicode.h"
#include "uniform.h"
-#include "values.h"
+#include "values-internal.h"
#include "variable.h"
#include "vectors-internal.h"
#include "version.h"
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 3243e8ce9..d686964e8 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -30,7 +30,7 @@
#include "cache-internal.h"
#include "extensions.h"
#include "fluids-internal.h"
-#include "frames.h"
+#include "frames-internal.h"
#include "gc-inline.h"
#include "goops.h"
#include "gsubr.h"
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 73417f909..0c497655b 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -72,7 +72,7 @@
#include "simpos.h"
#include "strings-internal.h"
#include "threads-internal.h"
-#include "values.h"
+#include "values-internal.h"
#include "numbers.h"
diff --git a/libguile/print.c b/libguile/print.c
index d45f18011..06bfa6c97 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -47,7 +47,7 @@
#include "filesys-internal.h"
#include "fluids-internal.h"
#include "foreign.h"
-#include "frames.h"
+#include "frames-internal.h"
#include "goops.h"
#include "gsubr.h"
#include "hashtab.h"
@@ -69,7 +69,7 @@
#include "symbols.h"
#include "syntax.h"
#include "threads-internal.h"
-#include "values.h"
+#include "values-internal.h"
#include "variable.h"
#include "vectors.h"
#include "vm.h"
diff --git a/libguile/smob.c b/libguile/smob.c
index 4f4d95551..7845e746a 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -283,11 +283,20 @@ SCM
scm_new_smob (scm_t_bits tc, scm_t_bits data)
{
scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
- const scm_smob_descriptor* desc = &scm_smobs[smobnum];
+ scm_smob_descriptor* desc = &scm_smobs[smobnum];
scm_thread *thr = SCM_I_CURRENT_THREAD;
struct scm_single_smob *ret;
size_t sz = sizeof (*ret);
+ scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
+ if (desc->observed_size != 2)
+ {
+ if (desc->observed_size)
+ abort ();
+ desc->observed_size = 2;
+ }
+ scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
+
if (desc->field_count)
{
if (desc->field_count != 1)
@@ -317,11 +326,20 @@ scm_new_double_smob (scm_t_bits tc, scm_t_bits data1,
scm_t_bits data2, scm_t_bits data3)
{
scm_t_bits smobnum = SCM_TC2SMOBNUM (tc);
- const scm_smob_descriptor* desc = &scm_smobs[smobnum];
+ scm_smob_descriptor* desc = &scm_smobs[smobnum];
scm_thread *thr = SCM_I_CURRENT_THREAD;
struct scm_double_smob *ret;
size_t sz = sizeof (*ret);
+ scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
+ if (desc->observed_size != 4)
+ {
+ if (desc->observed_size)
+ abort ();
+ desc->observed_size = 4;
+ }
+ scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
+
if (desc->field_count)
{
if (!(desc->field_count == 2 || desc->field_count == 3))
diff --git a/libguile/smob.h b/libguile/smob.h
index 6df4db516..8021af714 100644
--- a/libguile/smob.h
+++ b/libguile/smob.h
@@ -42,6 +42,7 @@ typedef struct scm_smob_descriptor
SCM apply_trampoline;
size_t field_count;
uint32_t unmanaged_fields;
+ size_t observed_size;
} scm_smob_descriptor;
diff --git a/libguile/stacks.c b/libguile/stacks.c
index d5c754dcc..5eec60130 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -30,7 +30,7 @@
#include "debug.h"
#include "eval.h"
#include "fluids.h"
-#include "frames.h" /* vm frames */
+#include "frames-internal.h" /* vm frames */
#include "gsubr.h"
#include "list.h"
#include "macros.h"
diff --git a/libguile/stacks.h b/libguile/stacks.h
index 846cdf192..b2b9593ce 100644
--- a/libguile/stacks.h
+++ b/libguile/stacks.h
@@ -43,12 +43,8 @@ SCM_API SCM scm_stack_type;
#define SCM_STACK_FRAME(obj) (SCM_STRUCT_SLOT_REF (obj,2))
#define SCM_SET_STACK_FRAME(obj,f) (SCM_STRUCT_SLOT_SET (obj,2,f))
-#define SCM_FRAMEP(obj) (scm_is_vm_frame (obj))
-
#define SCM_VALIDATE_STACK(pos, v) \
SCM_MAKE_VALIDATE_MSG (pos, v, STACKP, "stack")
-#define SCM_VALIDATE_FRAME(pos, v) \
- SCM_MAKE_VALIDATE_MSG (pos, v, FRAMEP, "frame")
diff --git a/libguile/values.h b/libguile/values-internal.h
similarity index 72%
copy from libguile/values.h
copy to libguile/values-internal.h
index f8a4ef8bc..999ee3503 100644
--- a/libguile/values.h
+++ b/libguile/values-internal.h
@@ -1,5 +1,5 @@
-#ifndef SCM_VALUES_H
-#define SCM_VALUES_H
+#ifndef SCM_VALUES_INTERNAL_H
+#define SCM_VALUES_INTERNAL_H
/* Copyright 2000-2001,2006,2008,2012,2018,2025
Free Software Foundation, Inc.
@@ -22,15 +22,8 @@
-#include "libguile/gc.h"
+#include "libguile/values.h"
-static inline int
-scm_is_values (SCM x)
-{
- return SCM_HAS_TYP7 (x, scm_tc7_values);
-}
-
-#ifdef BUILDING_LIBGUILE
struct scm_values
{
scm_t_bits tag_and_count;
@@ -62,18 +55,8 @@ scm_values_ref (struct scm_values *values, size_t n)
{
return values->values[n];
}
-#endif
-
-#define SCM_VALUESP(x) (scm_is_values (x))
SCM_INTERNAL void scm_values_extract_2 (SCM obj, SCM *p1, SCM *p2);
-
-SCM_API SCM scm_values (SCM args);
-SCM_API SCM scm_c_values (SCM *base, size_t n);
-SCM_API SCM scm_values_2 (SCM a, SCM b);
-SCM_API SCM scm_values_3 (SCM a, SCM b, SCM c);
-SCM_API size_t scm_c_nvalues (SCM obj);
-SCM_API SCM scm_c_value_ref (SCM obj, size_t idx);
SCM_INTERNAL void scm_init_values (void);
-#endif /* SCM_VALUES_H */
+#endif /* SCM_VALUES_INTERNAL_H */
diff --git a/libguile/values.c b/libguile/values.c
index bbe11ee17..daa4b76eb 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -29,7 +29,7 @@
#include "pairs.h"
#include "threads-internal.h"
-#include "values.h"
+#include "values-internal.h"
/* OBJ must be a values object containing exactly two values.
diff --git a/libguile/values.h b/libguile/values.h
index f8a4ef8bc..90e894994 100644
--- a/libguile/values.h
+++ b/libguile/values.h
@@ -30,50 +30,13 @@ scm_is_values (SCM x)
return SCM_HAS_TYP7 (x, scm_tc7_values);
}
-#ifdef BUILDING_LIBGUILE
-struct scm_values
-{
- scm_t_bits tag_and_count;
- SCM values[];
-};
-
-static inline struct scm_values*
-scm_to_values (SCM x)
-{
- if (!scm_is_values (x))
- abort ();
- return (struct scm_values*) SCM_UNPACK_POINTER (x);
-}
-
-static inline SCM
-scm_from_values (struct scm_values *values)
-{
- return SCM_PACK_POINTER (values);
-}
-
-static inline size_t
-scm_values_count (struct scm_values *x)
-{
- return x->tag_and_count >> 8;
-}
-
-static inline SCM
-scm_values_ref (struct scm_values *values, size_t n)
-{
- return values->values[n];
-}
-#endif
-
#define SCM_VALUESP(x) (scm_is_values (x))
-SCM_INTERNAL void scm_values_extract_2 (SCM obj, SCM *p1, SCM *p2);
-
SCM_API SCM scm_values (SCM args);
SCM_API SCM scm_c_values (SCM *base, size_t n);
SCM_API SCM scm_values_2 (SCM a, SCM b);
SCM_API SCM scm_values_3 (SCM a, SCM b, SCM c);
SCM_API size_t scm_c_nvalues (SCM obj);
SCM_API SCM scm_c_value_ref (SCM obj, size_t idx);
-SCM_INTERNAL void scm_init_values (void);
#endif /* SCM_VALUES_H */
diff --git a/libguile/vm.c b/libguile/vm.c
index 6878a5315..792c65d3f 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -46,7 +46,7 @@
#include "eval.h"
#include "extensions.h"
#include "foreign.h"
-#include "frames.h"
+#include "frames-internal.h"
#include "gc-inline.h"
#include "gsubr-internal.h"
#include "instructions.h"
