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

@@ -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
 

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);
 

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"

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"

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"

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_ */

libguile/frames.c

@@ -40,7 +40,7 @@
 #include "version.h"
 #include "vm.h"
 
-#include "frames.h"
+#include "frames-internal.h"
 
 
 SCM

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_ */

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"

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"

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"

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"
 

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"

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))

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;
 
 

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"

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")
 
 
 

libguile/values-internal.h

@@ -0,0 +1,62 @@
+#ifndef SCM_VALUES_INTERNAL_H
+#define SCM_VALUES_INTERNAL_H
+
+/* Copyright 2000-2001,2006,2008,2012,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/>.  */
+
+
+
+#include "libguile/values.h"
+
+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];
+}
+
+SCM_INTERNAL void scm_values_extract_2 (SCM obj, SCM *p1, SCM *p2);
+SCM_INTERNAL void scm_init_values (void);
+
+#endif  /* SCM_VALUES_INTERNAL_H */

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.

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 */

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"