wingo pushed a commit to branch wip-whippet
in repository guile.
commit 93e5a2454a414ae0bf9e1badc40d7925b5c7b03b
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Fri May 30 10:25:00 2025 +0200
Tighten up exported ABI / API of "programs"
* libguile/programs.h (scm_program_p, scm_program_code)
(scm_primitive_code_p, scm_primitive_code_name, scm_primitive_call_ip):
Don't expose these internal functions to C
ABI.
(scm_program_num_free_variables, scm_program_free_variable_ref,
scm_program_free_variable_set_x): Don't expose these previously-public
functions to C ABI.
(scm_is_program): New internal inline function.
* libguile/stacks.c (narrow_stack): Use new scm_is_program helper.
* libguile/programs.c: Adapt implementation to use SCM_DEFINE_STATIC.
---
libguile/programs.c | 66 ++++++++++++++++++++++++++---------------------------
libguile/programs.h | 20 ++++++----------
libguile/stacks.c | 4 ++--
3 files changed, 42 insertions(+), 48 deletions(-)
diff --git a/libguile/programs.c b/libguile/programs.c
index 81495a5b1..eb814f802 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -1,4 +1,4 @@
-/* Copyright 2001,2009-2014,2017-2019
+/* Copyright 2001,2009-2014,2017-2019,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -43,10 +43,10 @@
static SCM write_program = SCM_BOOL_F;
-SCM_DEFINE (scm_program_code, "program-code", 1, 0, 0,
- (SCM program),
- "")
-#define FUNC_NAME s_scm_program_code
+SCM_DEFINE_STATIC (program_code, "program-code", 1, 0, 0,
+ (SCM program),
+ "")
+#define FUNC_NAME s_program_code
{
SCM_VALIDATE_PROGRAM (1, program);
@@ -148,19 +148,19 @@ scm_i_program_print (SCM program, SCM port,
scm_print_state *pstate)
* Scheme interface
*/
-SCM_DEFINE (scm_program_p, "program?", 1, 0, 0,
- (SCM obj),
- "")
-#define FUNC_NAME s_scm_program_p
+SCM_DEFINE_STATIC (program_p, "program?", 1, 0, 0,
+ (SCM obj),
+ "")
+#define FUNC_NAME s_program_p
{
return scm_from_bool (SCM_PROGRAM_P (obj));
}
#undef FUNC_NAME
-SCM_DEFINE (scm_primitive_code_p, "primitive-code?", 1, 0, 0,
- (SCM code),
- "")
-#define FUNC_NAME s_scm_primitive_code_p
+SCM_DEFINE_STATIC (primitive_code_p, "primitive-code?", 1, 0, 0,
+ (SCM code),
+ "")
+#define FUNC_NAME s_primitive_code_p
{
const uint32_t * ptr = (const uint32_t *) scm_to_uintptr_t (code);
@@ -168,10 +168,10 @@ SCM_DEFINE (scm_primitive_code_p, "primitive-code?", 1,
0, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_primitive_call_ip, "primitive-call-ip", 1, 0, 0,
- (SCM prim),
- "")
-#define FUNC_NAME s_scm_primitive_call_ip
+SCM_DEFINE_STATIC (primitive_call_ip, "primitive-call-ip", 1, 0, 0,
+ (SCM prim),
+ "")
+#define FUNC_NAME s_primitive_call_ip
{
uintptr_t ip;
@@ -182,10 +182,10 @@ SCM_DEFINE (scm_primitive_call_ip, "primitive-call-ip",
1, 0, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_primitive_code_name, "primitive-code-name", 1, 0, 0,
- (SCM code),
- "")
-#define FUNC_NAME s_scm_primitive_code_name
+SCM_DEFINE_STATIC (primitive_code_name, "primitive-code-name", 1, 0, 0,
+ (SCM code),
+ "")
+#define FUNC_NAME s_primitive_code_name
{
const uint32_t * ptr = (const uint32_t *) scm_to_uintptr_t (code);
@@ -224,10 +224,10 @@ scm_program_address_range (SCM program)
return scm_call_1 (scm_variable_ref (program_address_range), program);
}
-SCM_DEFINE (scm_program_num_free_variables, "program-num-free-variables", 1,
0, 0,
- (SCM program),
- "")
-#define FUNC_NAME s_scm_program_num_free_variables
+SCM_DEFINE_STATIC (program_num_free_variables, "program-num-free-variables",
+ 1, 0, 0, (SCM program),
+ "")
+#define FUNC_NAME s_program_num_free_variables
{
SCM_VALIDATE_PROGRAM (1, program);
@@ -235,10 +235,10 @@ SCM_DEFINE (scm_program_num_free_variables,
"program-num-free-variables", 1, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_program_free_variable_ref, "program-free-variable-ref", 2, 0,
0,
- (SCM program, SCM i),
- "")
-#define FUNC_NAME s_scm_program_free_variable_ref
+SCM_DEFINE_STATIC (program_free_variable_ref, "program-free-variable-ref",
+ 2, 0, 0, (SCM program, SCM i),
+ "")
+#define FUNC_NAME s_program_free_variable_ref
{
unsigned long idx;
@@ -250,10 +250,10 @@ SCM_DEFINE (scm_program_free_variable_ref,
"program-free-variable-ref", 2, 0, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_program_free_variable_set_x, "program-free-variable-set!", 3,
0, 0,
- (SCM program, SCM i, SCM x),
- "")
-#define FUNC_NAME s_scm_program_free_variable_set_x
+SCM_DEFINE_STATIC (program_free_variable_set_x, "program-free-variable-set!",
+ 3, 0, 0, (SCM program, SCM i, SCM x),
+ "")
+#define FUNC_NAME s_program_free_variable_set_x
{
unsigned long idx;
diff --git a/libguile/programs.h b/libguile/programs.h
index fb5921362..c3f3dc1c9 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -1,4 +1,4 @@
-/* Copyright 2001,2009-2014,2018
+/* Copyright 2001,2009-2014,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -54,27 +54,21 @@ scm_i_make_program (const uint32_t *code)
{
return scm_cell (scm_tc7_program, (scm_t_bits)code);
}
-#endif
-
-SCM_INTERNAL SCM scm_program_p (SCM obj);
-SCM_INTERNAL SCM scm_program_code (SCM program);
-SCM_INTERNAL SCM scm_primitive_code_p (SCM code);
-SCM_INTERNAL SCM scm_primitive_code_name (SCM code);
-SCM_INTERNAL SCM scm_primitive_call_ip (SCM prim);
+static inline int
+scm_is_program (SCM x)
+{
+ return SCM_PROGRAM_P (x);
+}
+#endif
SCM_INTERNAL SCM scm_i_program_name (SCM program);
SCM_INTERNAL SCM scm_i_program_documentation (SCM program);
SCM_INTERNAL SCM scm_i_program_properties (SCM program);
SCM_INTERNAL SCM scm_find_source_for_addr (SCM ip);
-
SCM_INTERNAL SCM scm_program_address_range (SCM program);
-SCM_API SCM scm_program_num_free_variables (SCM program);
-SCM_API SCM scm_program_free_variable_ref (SCM program, SCM i);
-SCM_API SCM scm_program_free_variable_set_x (SCM program, SCM i, SCM x);
-
SCM_INTERNAL int scm_i_program_arity (SCM program, int *req, int *opt, int
*rest);
SCM_INTERNAL void scm_i_program_print (SCM program, SCM port,
scm_print_state *pstate);
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 9160c0cbf..2f5273e03 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -122,13 +122,13 @@ narrow_stack (long len, enum scm_vm_frame_kind kind,
struct scm_frame *frame,
/* Resolve procedure cuts to address ranges, if possible. If the
debug information has been stripped, this might not be
possible. */
- if (scm_is_true (scm_program_p (inner_cut)))
+ if (scm_is_program (inner_cut))
{
SCM addr_range = scm_program_address_range (inner_cut);
if (scm_is_pair (addr_range))
inner_cut = addr_range;
}
- if (scm_is_true (scm_program_p (outer_cut)))
+ if (scm_is_program (outer_cut))
{
SCM addr_range = scm_program_address_range (outer_cut);
if (scm_is_pair (addr_range))
