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 - . */ - - - -#ifdef HAVE_CONFIG_H -# include -#endif - -#include - -#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 - . */ - - - -#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 #endif +#include + #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);