mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-01 07:20:20 +02:00
Code Activity

Deprecate C hooks

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2025-06-25 09:49:58 +02:00
parent 08296e6022
commit a6b848dcba
8 changed files with 148 additions and 204 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/Makefile.am
View file

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

108
libguile/chooks.c
View file

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

71
libguile/chooks.h
View file

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

98
libguile/deprecated.c
View file

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

43
libguile/deprecated.h
View file

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

22
libguile/gc.c
View file

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

7
libguile/gc.h
View file

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