wingo pushed a commit to branch wip-whippet
in repository guile.
commit a6b848dcbaacaade2d75d259c7fe8363eda9c41c
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Wed Jun 25 09:49:58 2025 +0200
Deprecate C hooks
* libguile/chooks.c:
* libguile/chooks.h: Remove.
* libguile/deprecated.h:
* libguile/deprecated.c: Add deprecated implementations.
* libguile/gc.c:
* libguile/gc.h: Arrange to call before/after C hooks if deprecated code
is enabled.
* libguile/Makefile.am:
* libguile.h: Remove chooks.[ch] references.
---
libguile.h | 1 -
libguile/Makefile.am | 2 -
libguile/chooks.c | 108 --------------------------------------------------
libguile/chooks.h | 71 ---------------------------------
libguile/deprecated.c | 98 +++++++++++++++++++++++++++++++++++++++++++++
libguile/deprecated.h | 43 ++++++++++++++++++++
libguile/gc.c | 22 ++++------
libguile/gc.h | 7 ----
8 files changed, 148 insertions(+), 204 deletions(-)
diff --git a/libguile.h b/libguile.h
index e670522a2..5b2b9685c 100644
--- a/libguile.h
+++ b/libguile.h
@@ -36,7 +36,6 @@ extern "C" {
#include "libguile/bitvectors.h"
#include "libguile/bytevectors.h"
#include "libguile/chars.h"
-#include "libguile/chooks.h"
#include "libguile/continuations.h"
#include "libguile/dynl.h"
#include "libguile/dynwind.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index a51a0dead..0e2e5d300 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -142,7 +142,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES =
\
bitvectors.c \
bytevectors.c \
chars.c \
- chooks.c \
control.c \
continuations.c \
custom-ports.c \
@@ -596,7 +595,6 @@ modinclude_HEADERS = \
bitvectors.h \
bytevectors.h \
chars.h \
- chooks.h \
control.h \
continuations.h \
debug.h \
diff --git a/libguile/chooks.c b/libguile/chooks.c
deleted file mode 100644
index a4301d3a3..000000000
--- a/libguile/chooks.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/* Copyright 1995-1996,1998-2001,2003,2006,2008-2009,2011,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/>. */
-
-
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include <stdio.h>
-
-#include "gc.h"
-
-#include "chooks.h"
-#include "threads.h"
-
-
-
-/* C level hooks
- *
- */
-
-void
-scm_c_hook_init (scm_t_c_hook *hook, void *hook_data, scm_t_c_hook_type type)
-{
- hook->first = 0;
- hook->type = type;
- hook->data = hook_data;
-}
-
-void
-scm_c_hook_add (scm_t_c_hook *hook,
- scm_t_c_hook_function func,
- void *fn_data,
- int appendp)
-{
- scm_t_c_hook_entry *entry;
- scm_t_c_hook_entry **loc = &hook->first;
-
- entry = scm_allocate_sloppy (SCM_I_CURRENT_THREAD,
- sizeof (scm_t_c_hook_entry));
- if (appendp)
- while (*loc)
- loc = &(*loc)->next;
- entry->next = *loc;
- entry->func = func;
- entry->data = fn_data;
- *loc = entry;
-}
-
-void
-scm_c_hook_remove (scm_t_c_hook *hook,
- scm_t_c_hook_function func,
- void *fn_data)
-{
- scm_t_c_hook_entry **loc = &hook->first;
- while (*loc)
- {
- if ((*loc)->func == func && (*loc)->data == fn_data)
- {
- *loc = (*loc)->next;
- return;
- }
- loc = &(*loc)->next;
- }
- fprintf (stderr, "Attempt to remove non-existent hook function\n");
- abort ();
-}
-
-void *
-scm_c_hook_run (scm_t_c_hook *hook, void *data)
-{
- scm_t_c_hook_entry *entry = hook->first;
- scm_t_c_hook_type type = hook->type;
- void *res = 0;
- while (entry)
- {
- res = (entry->func) (hook->data, entry->data, data);
- if (res)
- {
- if (type == SCM_C_HOOK_OR)
- break;
- }
- else
- {
- if (type == SCM_C_HOOK_AND)
- break;
- }
- entry = entry->next;
- }
- return res;
-}
diff --git a/libguile/chooks.h b/libguile/chooks.h
deleted file mode 100644
index f4fb20d6c..000000000
--- a/libguile/chooks.h
+++ /dev/null
@@ -1,71 +0,0 @@
-#ifndef SCM_CHOOKS_H
-#define SCM_CHOOKS_H
-
-/* Copyright 1995-1996,1999,2000-2001,2006,2008-2009,2018
- 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/scm.h"
-
-/*
- * C level hooks
- */
-
-/*
- * The interface is designed for and- and or-type hooks which
- * both may want to indicate success/failure and return a result.
- */
-
-typedef enum scm_t_c_hook_type {
- SCM_C_HOOK_NORMAL,
- SCM_C_HOOK_OR,
- SCM_C_HOOK_AND
-} scm_t_c_hook_type;
-
-typedef void *(*scm_t_c_hook_function) (void *hook_data,
- void *fn_data,
- void *data);
-
-typedef struct scm_t_c_hook_entry {
- struct scm_t_c_hook_entry *next;
- scm_t_c_hook_function func;
- void *data;
-} scm_t_c_hook_entry;
-
-typedef struct scm_t_c_hook {
- scm_t_c_hook_entry *first;
- scm_t_c_hook_type type;
- void *data;
-} scm_t_c_hook;
-
-SCM_API void scm_c_hook_init (scm_t_c_hook *hook,
- void *hook_data,
- scm_t_c_hook_type type);
-SCM_API void scm_c_hook_add (scm_t_c_hook *hook,
- scm_t_c_hook_function func,
- void *fn_data,
- int appendp);
-SCM_API void scm_c_hook_remove (scm_t_c_hook *hook,
- scm_t_c_hook_function func,
- void *fn_data);
-SCM_API void *scm_c_hook_run (scm_t_c_hook *hook, void *data);
-
-
-#endif /* SCM_CHOOKS_H */
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 90fe7c064..16bdbc4e1 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -21,6 +21,8 @@
# include <config.h>
#endif
+#include <stdio.h>
+
#define SCM_BUILDING_DEPRECATED_CODE
#include "deprecation.h"
@@ -765,6 +767,102 @@ scm_i_simple_vector_set_x (SCM v, size_t k, SCM val)
+scm_t_c_hook scm_before_gc_c_hook = { 0, SCM_C_HOOK_NORMAL, NULL };
+scm_t_c_hook scm_before_mark_c_hook = { 0, SCM_C_HOOK_NORMAL, NULL };
+scm_t_c_hook scm_before_sweep_c_hook = { 0, SCM_C_HOOK_NORMAL, NULL };
+scm_t_c_hook scm_after_sweep_c_hook = { 0, SCM_C_HOOK_NORMAL, NULL };
+scm_t_c_hook scm_after_gc_c_hook = { 0, SCM_C_HOOK_NORMAL, NULL };
+
+void
+scm_c_hook_init (scm_t_c_hook *hook, void *hook_data, scm_t_c_hook_type type)
+{
+ scm_c_issue_deprecation_warning
+ ("C hooks (scm_c_hook_ functions) are deprecated. Implement this
yourself.");
+ hook->first = 0;
+ hook->type = type;
+ hook->data = hook_data;
+}
+
+void
+scm_c_hook_add (scm_t_c_hook *hook,
+ scm_t_c_hook_function func,
+ void *fn_data,
+ int appendp)
+{
+ scm_c_issue_deprecation_warning
+ ("C hooks (scm_c_hook_ functions) are deprecated. Implement this
yourself.");
+
+ scm_t_c_hook_entry *entry;
+ scm_t_c_hook_entry **loc = &hook->first;
+
+ entry = scm_allocate_sloppy (SCM_I_CURRENT_THREAD,
+ sizeof (scm_t_c_hook_entry));
+ if (appendp)
+ while (*loc)
+ loc = &(*loc)->next;
+ entry->next = *loc;
+ entry->func = func;
+ entry->data = fn_data;
+ *loc = entry;
+}
+
+void
+scm_c_hook_remove (scm_t_c_hook *hook,
+ scm_t_c_hook_function func,
+ void *fn_data)
+{
+ scm_c_issue_deprecation_warning
+ ("C hooks (scm_c_hook_ functions) are deprecated. Implement this
yourself.");
+
+ scm_t_c_hook_entry **loc = &hook->first;
+ while (*loc)
+ {
+ if ((*loc)->func == func && (*loc)->data == fn_data)
+ {
+ *loc = (*loc)->next;
+ return;
+ }
+ loc = &(*loc)->next;
+ }
+ fprintf (stderr, "Attempt to remove non-existent hook function\n");
+ abort ();
+}
+
+void *
+scm_c_hook_run (scm_t_c_hook *hook, void *data)
+{
+ scm_c_issue_deprecation_warning
+ ("C hooks (scm_c_hook_ functions) are deprecated. Implement this
yourself.");
+
+ return scm_i_c_hook_run (hook, data);
+}
+
+void *
+scm_i_c_hook_run (scm_t_c_hook *hook, void *data)
+{
+ scm_t_c_hook_entry *entry = hook->first;
+ scm_t_c_hook_type type = hook->type;
+ void *res = 0;
+ while (entry)
+ {
+ res = (entry->func) (hook->data, entry->data, data);
+ if (res)
+ {
+ if (type == SCM_C_HOOK_OR)
+ break;
+ }
+ else
+ {
+ if (type == SCM_C_HOOK_AND)
+ break;
+ }
+ entry = entry->next;
+ }
+ return res;
+}
+
+
+
void
scm_i_init_deprecated ()
{
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 199a800f3..f23b9abe6 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -130,6 +130,49 @@ SCM_DEPRECATED void scm_i_simple_vector_set_x (SCM v,
size_t k, SCM val);
#define SCM_SIMPLE_VECTOR_REF(x,idx) (scm_i_simple_vector_ref (x, idx))
#define SCM_SIMPLE_VECTOR_SET(x,idx,val) (scm_i_simple_vector_set_x (x, idx,
val))
+typedef enum scm_t_c_hook_type {
+ SCM_C_HOOK_NORMAL,
+ SCM_C_HOOK_OR,
+ SCM_C_HOOK_AND
+} scm_t_c_hook_type;
+
+typedef void *(*scm_t_c_hook_function) (void *hook_data, void *fn_data,
+ void *data);
+
+typedef struct scm_t_c_hook_entry {
+ struct scm_t_c_hook_entry *next;
+ scm_t_c_hook_function func;
+ void *data;
+} scm_t_c_hook_entry;
+
+typedef struct scm_t_c_hook {
+ scm_t_c_hook_entry *first;
+ scm_t_c_hook_type type;
+ void *data;
+} scm_t_c_hook;
+
+SCM_DEPRECATED void scm_c_hook_init (scm_t_c_hook *hook,
+ void *hook_data,
+ scm_t_c_hook_type type);
+SCM_DEPRECATED void scm_c_hook_add (scm_t_c_hook *hook,
+ scm_t_c_hook_function func,
+ void *fn_data,
+ int appendp);
+SCM_DEPRECATED void scm_c_hook_remove (scm_t_c_hook *hook,
+ scm_t_c_hook_function func,
+ void *fn_data);
+SCM_DEPRECATED void *scm_c_hook_run (scm_t_c_hook *hook, void *data);
+SCM_INTERNAL void *scm_i_c_hook_run (scm_t_c_hook *hook, void *data);
+
+/* Mark a couple of these as SCM_API so that they can be invoked
+ internally without triggering deprecation warnings at
+ compile-time. */
+SCM_API scm_t_c_hook scm_before_gc_c_hook;
+SCM_DEPRECATED scm_t_c_hook scm_before_mark_c_hook;
+SCM_DEPRECATED scm_t_c_hook scm_before_sweep_c_hook;
+SCM_DEPRECATED scm_t_c_hook scm_after_sweep_c_hook;
+SCM_API scm_t_c_hook scm_after_gc_c_hook;
+
/* Deprecated declarations go here. */
void scm_i_init_deprecated (void);
diff --git a/libguile/gc.c b/libguile/gc.c
index 721fa9bbd..80a93cce3 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -33,6 +33,7 @@
#include "arrays.h"
#include "async.h"
#include "atomics-internal.h"
+#include "deprecated.h"
#include "deprecation.h"
#include "dynwind.h"
#include "eval.h"
@@ -98,13 +99,6 @@ int scm_debug_cells_gc_interval = 0;
garbage collection. */
static SCM scm_protects;
-/* Hooks. */
-scm_t_c_hook scm_before_gc_c_hook;
-scm_t_c_hook scm_before_mark_c_hook;
-scm_t_c_hook scm_before_sweep_c_hook;
-scm_t_c_hook scm_after_sweep_c_hook;
-scm_t_c_hook scm_after_gc_c_hook;
-
static SCM after_gc_thunks = SCM_EOL;
static SCM after_gc_async_cell;
@@ -141,7 +135,9 @@ scm_gc_event_listener_mutators_stopped (void *data)
{
struct scm_gc_event_listener *scm_listener = data;
gc_basic_stats_mutators_stopped (&scm_listener->stats);
- scm_c_hook_run (&scm_before_gc_c_hook, NULL);
+#if (SCM_ENABLE_DEPRECATED == 1)
+ scm_i_c_hook_run (&scm_before_gc_c_hook, NULL);
+#endif
}
static inline void
@@ -186,9 +182,11 @@ scm_gc_event_listener_restarting_mutators (void *data)
struct scm_gc_event_listener *scm_listener = data;
gc_basic_stats_restarting_mutators (&scm_listener->stats);
+#if (SCM_ENABLE_DEPRECATED == 1)
/* Run any C hooks. The mutator is not yet let go, so we can't
allocate here. */
- scm_c_hook_run (&scm_after_gc_c_hook, NULL);
+ scm_i_c_hook_run (&scm_after_gc_c_hook, NULL);
+#endif
/* If there are Scheme hooks and we have a current Guile thread,
enqueue those to be run on the current thread. */
@@ -662,12 +660,6 @@ scm_storage_prehistory (struct gc_stack_addr base)
// gets called.
gc_heap_set_roots (the_gc_heap, &heap_roots);
- scm_c_hook_init (&scm_before_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
- scm_c_hook_init (&scm_before_mark_c_hook, 0, SCM_C_HOOK_NORMAL);
- scm_c_hook_init (&scm_before_sweep_c_hook, 0, SCM_C_HOOK_NORMAL);
- scm_c_hook_init (&scm_after_sweep_c_hook, 0, SCM_C_HOOK_NORMAL);
- scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
-
return mut;
}
diff --git a/libguile/gc.h b/libguile/gc.h
index 4422d6092..fbf774468 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -23,7 +23,6 @@
#include "libguile/inline.h"
-#include "libguile/chooks.h"
/* Before Guile 2.0, Guile had a custom garbage collector and memory
@@ -86,12 +85,6 @@ typedef struct scm_t_cell
SCM_API unsigned long scm_gc_ports_collected;
-SCM_API scm_t_c_hook scm_before_gc_c_hook;
-SCM_API scm_t_c_hook scm_before_mark_c_hook;
-SCM_API scm_t_c_hook scm_before_sweep_c_hook;
-SCM_API scm_t_c_hook scm_after_sweep_c_hook;
-SCM_API scm_t_c_hook scm_after_gc_c_hook;
-
SCM_API SCM scm_set_debug_cell_accesses_x (SCM flag);
