[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 9d8d065: Add support for finalizers
From: |
Daniel Colascione |
Subject: |
[Emacs-diffs] master 9d8d065: Add support for finalizers |
Date: |
Mon, 02 Mar 2015 23:39:35 +0000 |
branch: master
commit 9d8d0658147dfe5a90e2fb07ff666f35b1162d6e
Author: Daniel Colascione <address@hidden>
Commit: Daniel Colascione <address@hidden>
Add support for finalizers
+2015-03-02 Daniel Colascione <address@hidden>
+
+ * NEWS: Mention finalizers.
+
2015-02-09 Gareth Rees <address@hidden> (tiny change)
* NEWS.24: Fix typo (bug#19820)
diff --git a/src/ChangeLog b/src/ChangeLog
index 4aa64c1..2f04d0b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,21 @@
+2015-03-02 Daniel Colascione <address@hidden>
+
+ * print.c (print_object): Print finalizers.
+
+ * alloc.c:
+ (finalizers, doomed_finalizers): New variables.
+ (init_finalizer_list, finalizer_insert, unchain_finalizer)
+ (mark_finalizer_list, queue_doomed_finalizers)
+ (run_finalizer_handler, run_finalizer_function, run_finalizers):
+ New functions.
+ (garbage_collect_1, mark_object, sweep_misc)
+ (init_alloc_once, syms_of_alloc): Support finalizers.
+ (gc-precise-p): New Lisp variable.
+
+ * lisp.h (Lisp_Misc_Type): New value Lisp_Misc_Finalizer.
+ (FINALIZERP, XFINALIZER): New functions.
+ (Lisp_Finalizer): New structure.
+
2015-02-28 Paul Eggert <address@hidden>
* character.c (alphabeticp, decimalnump): Avoid undefined behavior
diff --git a/test/ChangeLog b/test/ChangeLog
index cf1b2c1..684e98f 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,9 @@
+2015-03-02 Daniel Colascione <address@hidden>
+
+ * automated/finalizer-tests.el (finalizer-basic)
+ (finalizer-circular-reference, finalizer-cross-reference)
+ (finalizer-error): New tests.
+
2015-03-01 Michael Albinus <address@hidden>
* automated/vc-tests.el (vc-test--create-repo): Add check for
---
etc/ChangeLog | 4 +
etc/NEWS | 3 +
src/ChangeLog | 18 ++++
src/alloc.c | 172 +++++++++++++++++++++++++++++++++++-
src/lisp.h | 33 +++++++
src/print.c | 6 +-
test/ChangeLog | 6 ++
test/automated/finalizer-tests.el | 78 +++++++++++++++++
8 files changed, 314 insertions(+), 6 deletions(-)
diff --git a/etc/ChangeLog b/etc/ChangeLog
index 24cb6f2..99a74f9 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,7 @@
+2015-03-02 Daniel Colascione <address@hidden>
+
+ * NEWS: Mention finalizers.
+
2015-02-09 Gareth Rees <address@hidden> (tiny change)
* NEWS.24: Fix typo (bug#19820)
diff --git a/etc/NEWS b/etc/NEWS
index 3be820e..6c94a58 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -621,6 +621,9 @@ word syntax, use `\sw' instead.
* Lisp Changes in Emacs 25.1
+** New finalizer facility for running code when objects
+ become unreachable.
+
** lexical closures can use (:documentation <form>) to build their docstring.
It should be placed right where the docstring would be, and <form> is then
evaluated (and should return a string) when the closure is built.
diff --git a/src/ChangeLog b/src/ChangeLog
index 4aa64c1..2f04d0b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,21 @@
+2015-03-02 Daniel Colascione <address@hidden>
+
+ * print.c (print_object): Print finalizers.
+
+ * alloc.c:
+ (finalizers, doomed_finalizers): New variables.
+ (init_finalizer_list, finalizer_insert, unchain_finalizer)
+ (mark_finalizer_list, queue_doomed_finalizers)
+ (run_finalizer_handler, run_finalizer_function, run_finalizers):
+ New functions.
+ (garbage_collect_1, mark_object, sweep_misc)
+ (init_alloc_once, syms_of_alloc): Support finalizers.
+ (gc-precise-p): New Lisp variable.
+
+ * lisp.h (Lisp_Misc_Type): New value Lisp_Misc_Finalizer.
+ (FINALIZERP, XFINALIZER): New functions.
+ (Lisp_Finalizer): New structure.
+
2015-02-28 Paul Eggert <address@hidden>
* character.c (alphabeticp, decimalnump): Avoid undefined behavior
diff --git a/src/alloc.c b/src/alloc.c
index 9aa94b8..eec53e7 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -441,6 +441,15 @@ mmap_lisp_allowed_p (void)
return pointers_fit_in_lispobj_p () && !might_dump;
}
+/* Head of a circularly-linked list of extant finalizers. */
+static struct Lisp_Finalizer finalizers;
+
+/* Head of a circularly-linked list of finalizers that must be invoked
+ because we deemed them unreachable. This list must be global, and
+ not a local inside garbage_collect_1, in case we GC again while
+ running finalizers. */
+static struct Lisp_Finalizer doomed_finalizers;
+
/************************************************************************
Malloc
@@ -3695,6 +3704,131 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
}
}
+static void
+init_finalizer_list (struct Lisp_Finalizer *head)
+{
+ head->prev = head->next = head;
+}
+
+/* Insert FINALIZER before ELEMENT. */
+
+static void
+finalizer_insert (struct Lisp_Finalizer *element,
+ struct Lisp_Finalizer* finalizer)
+{
+ eassert (finalizer->prev == NULL);
+ eassert (finalizer->next == NULL);
+ finalizer->next = element;
+ finalizer->prev = element->prev;
+ finalizer->prev->next = finalizer;
+ element->prev = finalizer;
+}
+
+static void
+unchain_finalizer (struct Lisp_Finalizer *finalizer)
+{
+ if (finalizer->prev != NULL) {
+ eassert (finalizer->next != NULL);
+ finalizer->prev->next = finalizer->next;
+ finalizer->next->prev = finalizer->prev;
+ finalizer->prev = finalizer->next = NULL;
+ }
+}
+
+static void
+mark_finalizer_list (struct Lisp_Finalizer *head)
+{
+ for (struct Lisp_Finalizer *finalizer = head->next;
+ finalizer != head;
+ finalizer = finalizer->next)
+ {
+ finalizer->base.gcmarkbit = 1;
+ mark_object (finalizer->function);
+ }
+}
+
+/* Move doomed finalizers in list SRC onto list DEST. A doomed
+ finalizer is one that is not GC-reachable and whose
+ finalizer->function is non-nil. (We reset finalizer->function to
+ before attempting to run it.) */
+
+static void
+queue_doomed_finalizers (struct Lisp_Finalizer *dest,
+ struct Lisp_Finalizer *src)
+{
+ struct Lisp_Finalizer* finalizer = src->next;
+ while (finalizer != src)
+ {
+ struct Lisp_Finalizer *next = finalizer->next;
+ if (!finalizer->base.gcmarkbit && !NILP (finalizer->function))
+ {
+ unchain_finalizer (finalizer);
+ finalizer_insert (dest, finalizer);
+ }
+
+ finalizer = next;
+ }
+}
+
+static Lisp_Object
+run_finalizer_handler (Lisp_Object args)
+{
+ add_to_log ("finalizer failed: %S", args, Qnil);
+ return Qnil;
+}
+
+static void
+run_finalizer_function (Lisp_Object function)
+{
+ struct gcpro gcpro1;
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ GCPRO1 (function);
+ specbind (Qinhibit_quit, Qt);
+ internal_condition_case_1 (call0, function, Qt, run_finalizer_handler);
+ unbind_to (count, Qnil);
+ UNGCPRO;
+}
+
+static void
+run_finalizers (struct Lisp_Finalizer* finalizers)
+{
+ struct Lisp_Finalizer* finalizer;
+ Lisp_Object function;
+ struct gcpro gcpro1;
+
+ while (finalizers->next != finalizers) {
+ finalizer = finalizers->next;
+ eassert (finalizer->base.type == Lisp_Misc_Finalizer);
+ unchain_finalizer (finalizer);
+ function = finalizer->function;
+ if (!NILP (function))
+ {
+ finalizer->function = Qnil;
+ run_finalizer_function (function);
+ }
+ }
+}
+
+DEFUN ("make-finalizer", Fmake_finalizer, Smake_finalizer, 1, 1, 0,
+ doc: /* Make a finalizer that will run FUNCTION.
+FUNCTION will be called after garbage collection when the returned
+finalizer object becomes unreachable. If the finalizer object is
+reachable only through references from finalizer objects, it does not
+count as reachable for the purpose of deciding whether to run
+FUNCTION. FUNCTION will be run once per finalizer object. */)
+ (Lisp_Object function)
+{
+ Lisp_Object val;
+ struct Lisp_Finalizer *finalizer;
+
+ val = allocate_misc (Lisp_Misc_Finalizer);
+ finalizer = XFINALIZER (val);
+ finalizer->function = function;
+ finalizer->prev = finalizer->next = NULL;
+ finalizer_insert (&finalizers, finalizer);
+ return val;
+}
/************************************************************************
@@ -5613,9 +5747,9 @@ garbage_collect_1 (void *end)
mark_stack (end);
#endif
- /* Everything is now marked, except for the data in font caches
- and undo lists. They're compacted by removing an items which
- aren't reachable otherwise. */
+ /* Everything is now marked, except for the data in font caches,
+ undo lists, and finalizers. The first two are compacted by
+ removing an items which aren't reachable otherwise. */
compact_font_caches ();
@@ -5628,6 +5762,16 @@ garbage_collect_1 (void *end)
mark_object (BVAR (nextb, undo_list));
}
+ /* Now pre-sweep finalizers. Here, we add any unmarked finalizers
+ to doomed_finalizers so we can run their associated functions
+ after GC. It's important to scan finalizers at this stage so
+ that we can be sure that unmarked finalizers are really
+ unreachable except for references from their associated functions
+ and from other finalizers. */
+
+ queue_doomed_finalizers (&doomed_finalizers, &finalizers);
+ mark_finalizer_list (&doomed_finalizers);
+
gc_sweep ();
/* Clear the mark bits that we set in certain root slots. */
@@ -5728,6 +5872,9 @@ garbage_collect_1 (void *end)
}
#endif
+ /* GC is complete: now we can run our finalizer callbacks. */
+ run_finalizers (&doomed_finalizers);
+
if (!NILP (Vpost_gc_hook))
{
ptrdiff_t gc_count = inhibit_garbage_collection ();
@@ -6364,7 +6511,12 @@ mark_object (Lisp_Object arg)
case Lisp_Misc_Overlay:
mark_overlay (XOVERLAY (obj));
- break;
+ break;
+
+ case Lisp_Misc_Finalizer:
+ XMISCANY (obj)->gcmarkbit = 1;
+ mark_object (XFINALIZER (obj)->function);
+ break;
default:
emacs_abort ();
@@ -6746,6 +6898,8 @@ sweep_misc (void)
{
if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
unchain_marker (&mblk->markers[i].m.u_marker);
+ if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
+ unchain_finalizer (&mblk->markers[i].m.u_finalizer);
/* Set the type of the freed object to Lisp_Misc_Free.
We could leave the type alone, since nobody checks it,
but this might catch bugs faster. */
@@ -7115,11 +7269,14 @@ init_alloc_once (void)
{
/* Even though Qt's contents are not set up, its address is known. */
Vpurify_flag = Qt;
+ gc_precise_p = (GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE);
purebeg = PUREBEG;
pure_size = PURESIZE;
verify_alloca ();
+ init_finalizer_list (&finalizers);
+ init_finalizer_list (&doomed_finalizers);
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
mem_init ();
@@ -7254,7 +7411,11 @@ do hash-consing of the objects allocated to pure space.
*/);
doc: /* Accumulated time elapsed in garbage collections.
The time is in seconds as a floating point value. */);
DEFVAR_INT ("gcs-done", gcs_done,
- doc: /* Accumulated number of garbage collections done. */);
+ doc: /* Accumulated number of garbage collections done. */);
+
+ DEFVAR_BOOL ("gc-precise-p", gc_precise_p,
+ doc: /* Non-nil means GC stack marking is precise.
+Useful mainly for automated GC tests. Build time constant.*/);
defsubr (&Scons);
defsubr (&Slist);
@@ -7267,6 +7428,7 @@ The time is in seconds as a floating point value. */);
defsubr (&Smake_bool_vector);
defsubr (&Smake_symbol);
defsubr (&Smake_marker);
+ defsubr (&Smake_finalizer);
defsubr (&Spurecopy);
defsubr (&Sgarbage_collect);
defsubr (&Smemory_limit);
diff --git a/src/lisp.h b/src/lisp.h
index fb43677..37f3b28 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -488,6 +488,7 @@ enum Lisp_Misc_Type
Lisp_Misc_Marker,
Lisp_Misc_Overlay,
Lisp_Misc_Save_Value,
+ Lisp_Misc_Finalizer,
/* Currently floats are not a misc type,
but let's define this in case we want to change that. */
Lisp_Misc_Float,
@@ -600,6 +601,7 @@ INLINE bool OVERLAYP (Lisp_Object);
INLINE bool PROCESSP (Lisp_Object);
INLINE bool PSEUDOVECTORP (Lisp_Object, int);
INLINE bool SAVE_VALUEP (Lisp_Object);
+INLINE bool FINALIZERP (Lisp_Object);
INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
Lisp_Object);
INLINE bool STRINGP (Lisp_Object);
@@ -610,6 +612,7 @@ INLINE bool (VECTORLIKEP) (Lisp_Object);
INLINE bool WINDOWP (Lisp_Object);
INLINE bool TERMINALP (Lisp_Object);
INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
+INLINE struct Lisp_Finalizer *XFINALIZER (Lisp_Object);
INLINE struct Lisp_Symbol *(XSYMBOL) (Lisp_Object);
INLINE void *(XUNTAG) (Lisp_Object, int);
@@ -2183,6 +2186,21 @@ XSAVE_OBJECT (Lisp_Object obj, int n)
return XSAVE_VALUE (obj)->data[n].object;
}
+/* A finalizer sentinel. We run FUNCTION when this value becomes
+ unreachable. We treat these values specially in the GC to ensure
+ that we still run the finalizer even if FUNCTION contains a
+ reference to the finalizer; i.e., we run a finalizer's function
+ when FUNCTION is reachable _only_ through finalizers. */
+struct Lisp_Finalizer
+ {
+ struct Lisp_Misc_Any base;
+ /* Circular list of all active weak references */
+ struct Lisp_Finalizer *prev;
+ struct Lisp_Finalizer *next;
+ /* Called when this object becomes unreachable */
+ Lisp_Object function;
+ };
+
/* A miscellaneous object, when it's on the free list. */
struct Lisp_Free
{
@@ -2202,6 +2220,7 @@ union Lisp_Misc
struct Lisp_Marker u_marker;
struct Lisp_Overlay u_overlay;
struct Lisp_Save_Value u_save_value;
+ struct Lisp_Finalizer u_finalizer;
};
INLINE union Lisp_Misc *
@@ -2243,6 +2262,14 @@ XSAVE_VALUE (Lisp_Object a)
eassert (SAVE_VALUEP (a));
return & XMISC (a)->u_save_value;
}
+
+INLINE struct Lisp_Finalizer *
+XFINALIZER (Lisp_Object a)
+{
+ eassert (FINALIZERP (a));
+ return & XMISC (a)->u_finalizer;
+}
+
/* Forwarding pointer to an int variable.
This is allowed only in the value cell of a symbol,
@@ -2490,6 +2517,12 @@ SAVE_VALUEP (Lisp_Object x)
}
INLINE bool
+FINALIZERP (Lisp_Object x)
+{
+ return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer;
+}
+
+INLINE bool
AUTOLOADP (Lisp_Object x)
{
return CONSP (x) && EQ (Qautoload, XCAR (x));
diff --git a/src/print.c b/src/print.c
index 1a0aebb..d391fd5 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2043,7 +2043,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
printcharfun);
}
PRINTCHAR ('>');
- break;
+ break;
+
+ case Lisp_Misc_Finalizer:
+ strout ("#<finalizer>", -1, -1, printcharfun);
+ break;
/* Remaining cases shouldn't happen in normal usage, but let's
print them anyway for the benefit of the debugger. */
diff --git a/test/ChangeLog b/test/ChangeLog
index cf1b2c1..684e98f 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,9 @@
+2015-03-02 Daniel Colascione <address@hidden>
+
+ * automated/finalizer-tests.el (finalizer-basic)
+ (finalizer-circular-reference, finalizer-cross-reference)
+ (finalizer-error): New tests.
+
2015-03-01 Michael Albinus <address@hidden>
* automated/vc-tests.el (vc-test--create-repo): Add check for
diff --git a/test/automated/finalizer-tests.el
b/test/automated/finalizer-tests.el
new file mode 100644
index 0000000..5308f01
--- /dev/null
+++ b/test/automated/finalizer-tests.el
@@ -0,0 +1,78 @@
+;;; finalizer-tests.el --- Finalizer tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Daniel Colascione <address@hidden>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program 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 General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+
+(ert-deftest finalizer-basic ()
+ "Test that finalizers run at all."
+ (skip-unless gc-precise-p)
+ (let* ((finalized nil)
+ (finalizer (make-finalizer (lambda () (setf finalized t)))))
+ (garbage-collect)
+ (should (equal finalized nil))
+ (setf finalizer nil)
+ (garbage-collect)
+ (should (equal finalized t))))
+
+(ert-deftest finalizer-circular-reference ()
+ "Test references from a callback to a finalizer."
+ (skip-unless gc-precise-p)
+ (let ((finalized nil))
+ (let* ((value nil)
+ (finalizer (make-finalizer (lambda () (setf finalized value)))))
+ (setf value finalizer)
+ (setf finalizer nil))
+ (garbage-collect)
+ (should finalized)))
+
+(ert-deftest finalizer-cross-reference ()
+ "Test that between-finalizer references do not prevent collection."
+ (skip-unless gc-precise-p)
+ (let ((d nil) (fc 0))
+ (let* ((f1-data (cons nil nil))
+ (f2-data (cons nil nil))
+ (f1 (make-finalizer
+ (lambda () (cl-incf fc) (setf d f1-data))))
+ (f2 (make-finalizer
+ (lambda () (cl-incf fc) (setf d f2-data)))))
+ (setcar f1-data f2)
+ (setcar f2-data f1))
+ (garbage-collect)
+ (should (equal fc 2))))
+
+(ert-deftest finalizer-error ()
+ "Test that finalizer errors are suppressed"
+ (skip-unless gc-precise-p)
+ (make-finalizer (lambda () (error "ABCDEF")))
+ (garbage-collect)
+ (with-current-buffer "*Messages*"
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line -1)
+ (should (equal
+ (buffer-substring (point) (point-at-eol))
+ "finalizer failed: (error \"ABCDEF\")")))))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 9d8d065: Add support for finalizers,
Daniel Colascione <=