mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-06 07:30:28 +02:00
Add (system finalizers)
This will replace an internal interface in (system foreign-objects). * module/system/finalizers.scm: New file. * am/bootstrap.am (SOURCES): Add new file. * libguile/foreign-object.h: * libguile/foreign-object.c (invoke_finalizer): (sys_add_finalizer_x): (scm_init_foreign_object): (scm_register_foreign_object): Remove. * libguile/init.c (scm_i_init_guile): Register finalizers instead of foreign-object. * module/system/foreign-object.scm (allocate-instance): Use finalizers module. * libguile/finalizers.c (invoke_finalizer): (scm_sys_add_finalizer): New helper.
This commit is contained in:
Andy Wingo
parent
604a8e8540
commit
75c7f79abc
9 changed files with 98 additions and 49 deletions
|
|
@ -1,4 +1,4 @@
|
|||
## Copyright (C) 2009-2024 Free Software Foundation, Inc.
|
||||
## Copyright (C) 2009-2025 Free Software Foundation, Inc.
|
||||
##
|
||||
## This file is part of GNU Guile.
|
||||
##
|
||||
|
|
@ -366,6 +366,7 @@ SOURCES = \
|
|||
system/base/types/internal.scm \
|
||||
system/base/ck.scm \
|
||||
\
|
||||
system/finalizers.scm \
|
||||
system/foreign.scm \
|
||||
system/foreign-library.scm \
|
||||
system/foreign-object.scm \
|
||||
|
|
|
|||
|
|
@ -281,6 +281,7 @@ DOT_X_FILES = \
|
|||
fdes-finalizers.x \
|
||||
feature.x \
|
||||
filesys.x \
|
||||
finalizers.x \
|
||||
fluids.x \
|
||||
foreign.x \
|
||||
fports.x \
|
||||
|
|
|
|||
|
|
@ -32,12 +32,16 @@
|
|||
#include <unistd.h>
|
||||
|
||||
#include "async.h"
|
||||
#include "atomics-internal.h"
|
||||
#include "bdw-gc.h"
|
||||
#include "eval.h"
|
||||
#include "extensions.h"
|
||||
#include "gc.h"
|
||||
#include "gsubr.h"
|
||||
#include "init.h"
|
||||
#include "numbers.h"
|
||||
#include "threads.h"
|
||||
#include "atomics-internal.h"
|
||||
#include "version.h"
|
||||
|
||||
#include "finalizers.h"
|
||||
|
||||
|
|
@ -53,6 +57,13 @@ static SCM run_finalizers_subr;
|
|||
|
||||
|
||||
|
||||
enum finalizer_priority
|
||||
{
|
||||
FINALIZER_PRIORITY_GUARDIAN,
|
||||
FINALIZER_PRIORITY_DEFAULT
|
||||
};
|
||||
|
||||
|
||||
void
|
||||
scm_i_set_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
|
||||
{
|
||||
|
|
@ -139,6 +150,29 @@ scm_i_add_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
|
|||
shuffle_resuscitators_to_front (chained_data);
|
||||
}
|
||||
|
||||
static void
|
||||
invoke_finalizer (void *obj, void *data)
|
||||
{
|
||||
scm_call_1 (PTR2SCM (data), PTR2SCM (obj));
|
||||
}
|
||||
|
||||
SCM_DEFINE_STATIC(scm_sys_add_finalizer, "%add-finalizer!", 3, 0, 0,
|
||||
(SCM obj, SCM proc, SCM priority),
|
||||
"Add a finalizer @var{proc} to object @var{obj}, with "
|
||||
"priority @var{priority}. Return the finalizer object.")
|
||||
#define FUNC_NAME s_scm_sys_add_finalizer
|
||||
{
|
||||
SCM_MAKE_VALIDATE (1, obj, HEAP_OBJECT_P);
|
||||
SCM_VALIDATE_PROC (2, proc);
|
||||
size_t c_priority = scm_to_unsigned_integer (priority,
|
||||
FINALIZER_PRIORITY_GUARDIAN,
|
||||
FINALIZER_PRIORITY_DEFAULT);
|
||||
|
||||
(void) c_priority;
|
||||
scm_i_add_finalizer (SCM2PTR (obj), invoke_finalizer, SCM2PTR (proc));
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
|
||||
|
|
@ -447,6 +481,17 @@ scm_run_finalizers (void)
|
|||
|
||||
|
||||
|
||||
static void scm_init_finalizers_module (void);
|
||||
|
||||
void
|
||||
scm_register_finalizers (void)
|
||||
{
|
||||
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
|
||||
"scm_init_finalizers_module",
|
||||
(scm_t_extension_init_func)scm_init_finalizers_module,
|
||||
NULL);
|
||||
}
|
||||
|
||||
void
|
||||
scm_init_finalizers (void)
|
||||
{
|
||||
|
|
@ -459,6 +504,14 @@ scm_init_finalizers (void)
|
|||
GC_set_finalizer_notifier (queue_finalizer_async);
|
||||
}
|
||||
|
||||
static void
|
||||
scm_init_finalizers_module (void)
|
||||
{
|
||||
#ifndef SCM_MAGIC_SNARFER
|
||||
#include "finalizers.x"
|
||||
#endif
|
||||
}
|
||||
|
||||
void
|
||||
scm_init_finalizer_thread (void)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -48,6 +48,7 @@ SCM_INTERNAL int scm_i_is_finalizer_thread (struct scm_thread *thread);
|
|||
SCM_API int scm_set_automatic_finalization_enabled (int enabled_p);
|
||||
SCM_API int scm_run_finalizers (void);
|
||||
|
||||
SCM_INTERNAL void scm_register_finalizers (void);
|
||||
SCM_INTERNAL void scm_init_finalizers (void);
|
||||
SCM_INTERNAL void scm_init_finalizer_thread (void);
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright 2014,2017-2018
|
||||
/* Copyright 2014,2017-2018,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -25,10 +25,8 @@
|
|||
#endif
|
||||
|
||||
#include "eval.h"
|
||||
#include "extensions.h"
|
||||
#include "finalizers.h"
|
||||
#include "goops.h"
|
||||
#include "gsubr.h"
|
||||
#include "list.h"
|
||||
#include "modules.h"
|
||||
#include "numbers.h"
|
||||
|
|
@ -196,37 +194,3 @@ scm_foreign_object_set_x (SCM obj, size_t n, void *val)
|
|||
scm_t_bits bits = (scm_t_bits) val;
|
||||
scm_foreign_object_unsigned_set_x (obj, n, bits);
|
||||
}
|
||||
|
||||
static void
|
||||
invoke_finalizer (void *obj, void *data)
|
||||
{
|
||||
scm_call_1 (PTR2SCM (data), PTR2SCM (obj));
|
||||
}
|
||||
|
||||
static SCM
|
||||
sys_add_finalizer_x (SCM obj, SCM finalizer)
|
||||
#define FUNC_NAME "%add-finalizer!"
|
||||
{
|
||||
SCM_VALIDATE_PROC (SCM_ARG2, finalizer);
|
||||
|
||||
scm_i_add_finalizer (SCM2PTR (obj), invoke_finalizer, SCM2PTR (finalizer));
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
static void
|
||||
scm_init_foreign_object (void)
|
||||
{
|
||||
scm_c_define_gsubr ("%add-finalizer!", 2, 0, 0,
|
||||
(scm_t_subr) sys_add_finalizer_x);
|
||||
}
|
||||
|
||||
void
|
||||
scm_register_foreign_object (void)
|
||||
{
|
||||
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
|
||||
"scm_init_foreign_object",
|
||||
(scm_t_extension_init_func)scm_init_foreign_object,
|
||||
NULL);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#ifndef SCM_FOREIGN_OBJECT_H
|
||||
#define SCM_FOREIGN_OBJECT_H
|
||||
|
||||
/* Copyright 2014,2018
|
||||
/* Copyright 2014,2018,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -56,7 +56,5 @@ SCM_API scm_t_signed_bits scm_foreign_object_signed_ref (SCM obj, size_t n);
|
|||
SCM_API void scm_foreign_object_signed_set_x (SCM obj, size_t n,
|
||||
scm_t_signed_bits val);
|
||||
|
||||
SCM_INTERNAL void scm_register_foreign_object (void);
|
||||
|
||||
|
||||
#endif /* SCM_FOREIGN_OBJECT_H */
|
||||
|
|
|
|||
|
|
@ -370,8 +370,8 @@ scm_i_init_guile (struct gc_stack_addr base)
|
|||
scm_register_atomic ();
|
||||
scm_register_custom_ports ();
|
||||
scm_register_fdes_finalizers ();
|
||||
scm_register_finalizers ();
|
||||
scm_register_foreign ();
|
||||
scm_register_foreign_object ();
|
||||
scm_register_srfi_60 ();
|
||||
scm_register_poll ();
|
||||
|
||||
|
|
|
|||
34
module/system/finalizers.scm
Normal file
34
module/system/finalizers.scm
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
;;; Copyright (C) 2025 Free Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This library 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.
|
||||
;;;
|
||||
;;; This library 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 this program. If not, see
|
||||
;;; <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
(define-module (system finalizers)
|
||||
#:export (add-finalizer!
|
||||
%guardian-finalizer-priority
|
||||
%default-finalizer-priority))
|
||||
|
||||
(eval-when (expand load eval)
|
||||
(load-extension (string-append "libguile-" (effective-version))
|
||||
"scm_init_finalizers_module"))
|
||||
|
||||
(define %guardian-finalizer-priority 1)
|
||||
(define %default-finalizer-priority 0)
|
||||
|
||||
(define* (add-finalizer! obj proc
|
||||
#:optional (priority %default-finalizer-priority))
|
||||
"Add a finalizer @var{proc} to object @var{obj}, with priority
|
||||
@var{priority}. Return the finalizer object."
|
||||
(%add-finalizer! obj proc priority))
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Wrapping foreign objects in Scheme
|
||||
|
||||
;;; Copyright (C) 2014, 2015, 2024 Free Software Foundation, Inc.
|
||||
;;; Copyright (C) 2014, 2015, 2024, 2025 Free Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This library is free software; you can redistribute it and/or
|
||||
;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
|
@ -24,13 +24,10 @@
|
|||
|
||||
(define-module (system foreign-object)
|
||||
#:use-module (oop goops)
|
||||
#:use-module (system finalizers)
|
||||
#:export (make-foreign-object-type
|
||||
define-foreign-object-type))
|
||||
|
||||
(eval-when (eval load expand)
|
||||
(load-extension (string-append "libguile-" (effective-version))
|
||||
"scm_init_foreign_object"))
|
||||
|
||||
(define-class <foreign-class> (<class>))
|
||||
|
||||
(define-class <foreign-class-with-finalizer> (<foreign-class>)
|
||||
|
|
@ -42,7 +39,7 @@
|
|||
(let ((instance (next-method))
|
||||
(finalizer (finalizer class)))
|
||||
(when finalizer
|
||||
(%add-finalizer! instance finalizer))
|
||||
(add-finalizer! instance finalizer))
|
||||
instance))
|
||||
|
||||
(define* (make-foreign-object-type name slots #:key finalizer
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue