summaryrefslogtreecommitdiff
path: root/module/system
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2025-05-02 15:26:37 +0200
committerAndy Wingo <wingo@pobox.com>2025-05-02 16:03:13 +0200
commit75c7f79abc2f18bb7d9ae0b607fd82c8818dfae9 (patch)
tree8101990b1e5aca7f228df493d0b8c7add6d736db /module/system
parent604a8e8540d2fc27052e1b4383c165c3e156ad70 (diff)
downloadguile-75c7f79abc2f18bb7d9ae0b607fd82c8818dfae9.tar.gz
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.
Diffstat (limited to 'module/system')
-rw-r--r--module/system/finalizers.scm34
-rw-r--r--module/system/foreign-object.scm9
2 files changed, 37 insertions, 6 deletions
diff --git a/module/system/finalizers.scm b/module/system/finalizers.scm
new file mode 100644
index 000000000..1193439e5
--- /dev/null
+++ b/module/system/finalizers.scm
@@ -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))
diff --git a/module/system/foreign-object.scm b/module/system/foreign-object.scm
index 3f05ccaad..2e613d406 100644
--- a/module/system/foreign-object.scm
+++ b/module/system/foreign-object.scm
@@ -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