mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Hook up gc_heap_set_allocation_failure_handler

Browse source 
* libguile/gc.h:
* libguile/gc.c (scm_gc_after_nonlocal_exit): Give it a scm_thread
argument, and cause GC with whippet API.
(scm_init_gc): Set alloc failure handler using Whippet API instead of
BDW.
(scm_oom_fn): Add heap argumnet.

* libguile/eval.c (eval):
* libguile/exceptions.c (scm_c_with_exception_handler):
* libguile/vm.c (scm_call_n): Adapt.
This commit is contained in:
Andy Wingo 2025-04-23 14:04:23 +02:00
parent 25db208603
commit 23d204b5a0
5 changed files with 10 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/eval.c
View file

@ -1,4 +1,4 @@
/* Copyright 1995-2019 /* Copyright 1995-2019, 2025
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of Guile. This file is part of Guile.
@ -463,7 +463,7 @@ eval (SCM x, SCM env)
{ {
/* The prompt exited nonlocally. */ /* The prompt exited nonlocally. */
t->vm.registers = prev_registers; t->vm.registers = prev_registers;
scm_gc_after_nonlocal_exit (); scm_gc_after_nonlocal_exit (t);
proc = handler; proc = handler;
args = scm_i_prompt_pop_abort_args_x (&t->vm, saved_stack_depth); args = scm_i_prompt_pop_abort_args_x (&t->vm, saved_stack_depth);
goto apply_proc; goto apply_proc;

4
libguile/exceptions.c
View file

@ -1,4 +1,4 @@
/* Copyright 1995-1998,2000-2001,2003-2004,2006,2008,2009-2014,2017-2019,2023 /* Copyright 1995-1998,2000-2001,2003-2004,2006,2008,2009-2014,2017-2019,2023,2025
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of Guile. This file is part of Guile.
@ -152,7 +152,7 @@ scm_c_with_exception_handler (SCM type, scm_t_exception_handler handler,
SCM args; SCM args;
t->vm.registers = prev_registers; t->vm.registers = prev_registers;
scm_gc_after_nonlocal_exit (); scm_gc_after_nonlocal_exit (t);
/* FIXME: We know where the args will be on the stack; we could /* FIXME: We know where the args will be on the stack; we could
avoid consing them. */ avoid consing them. */

8
libguile/gc.c
View file

@ -296,7 +296,7 @@ static int needs_gc_after_nonlocal_exit = 0;
/* Arrange to throw an exception on failed allocations. */ /* Arrange to throw an exception on failed allocations. */
static void* static void*
scm_oom_fn (size_t nbytes) scm_oom_fn (struct gc_heap *heap, size_t nbytes)
{ {
needs_gc_after_nonlocal_exit = 1; needs_gc_after_nonlocal_exit = 1;
scm_report_out_of_memory (); scm_report_out_of_memory ();
@ -313,12 +313,12 @@ scm_gc_warn_proc (char *fmt, GC_word arg)
} }
void void
scm_gc_after_nonlocal_exit (void) scm_gc_after_nonlocal_exit (struct scm_thread *thread)
{ {
if (needs_gc_after_nonlocal_exit) if (needs_gc_after_nonlocal_exit)
{ {
needs_gc_after_nonlocal_exit = 0; needs_gc_after_nonlocal_exit = 0;
GC_gcollect_and_unmap (); gc_collect (thread->mutator, GC_COLLECTION_COMPACTING);
} }
} }
@ -732,7 +732,7 @@ scm_init_gc ()
after_gc_async_thunk), after_gc_async_thunk),
SCM_BOOL_F); SCM_BOOL_F);
GC_set_oom_fn (scm_oom_fn); gc_heap_set_allocation_failure_handler (the_gc_heap, scm_oom_fn);
GC_set_warn_proc (scm_gc_warn_proc); GC_set_warn_proc (scm_gc_warn_proc);
#include "gc.x" #include "gc.x"

2
libguile/gc.h
View file

@ -282,7 +282,7 @@ SCM_API void scm_gc_register_root (SCM *p);
SCM_API void scm_gc_unregister_root (SCM *p); SCM_API void scm_gc_unregister_root (SCM *p);
SCM_API void scm_gc_register_roots (SCM *b, unsigned long n); SCM_API void scm_gc_register_roots (SCM *b, unsigned long n);
SCM_API void scm_gc_unregister_roots (SCM *b, unsigned long n); SCM_API void scm_gc_unregister_roots (SCM *b, unsigned long n);
SCM_INTERNAL void scm_gc_after_nonlocal_exit (void); SCM_INTERNAL void scm_gc_after_nonlocal_exit (struct scm_thread *);
SCM_INTERNAL void scm_init_gc_protect_object (void); SCM_INTERNAL void scm_init_gc_protect_object (void);
SCM_INTERNAL void scm_init_gc (void); SCM_INTERNAL void scm_init_gc (void);

2
libguile/vm.c
View file

@ -1604,7 +1604,7 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs)
if (SCM_UNLIKELY (resume)) if (SCM_UNLIKELY (resume))
{ {
uint8_t *mcode = vp->mra_after_abort; uint8_t *mcode = vp->mra_after_abort;
scm_gc_after_nonlocal_exit (); scm_gc_after_nonlocal_exit (thread);
/* Non-local return. */ /* Non-local return. */
if (vp->abort_hook_enabled) if (vp->abort_hook_enabled)
invoke_abort_hook (thread); invoke_abort_hook (thread);