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

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

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					\

libguile/chooks.c

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

libguile/chooks.h

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

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

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

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

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