From 6a32628e18b17df6ca089d44fb38972976bf889c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 1 Jul 2025 10:43:14 +0200 Subject: [PATCH] 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-internal.h | 62 +++++++++++++++++++++ libguile/values.c | 2 +- libguile/values.h | 37 ------------- libguile/vm.c | 2 +- 21 files changed, 213 insertions(+), 148 deletions(-) create mode 100644 libguile/frames-internal.h create mode 100644 libguile/values-internal.h 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 + . */ + +#ifndef _SCM_FRAMES_INTERNAL_H_ +#define _SCM_FRAMES_INTERNAL_H_ + +#include + + +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 #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-internal.h b/libguile/values-internal.h new file mode 100644 index 000000000..999ee3503 --- /dev/null +++ b/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 + . */ + + + +#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 */ 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"