11:21 a.m.
This patch introduces an asynchronous finalization strategy on
C level.
With this patch the severe NEW_GC finalization bug (especially the
lstream finalization problem) is gone, at least in my tests.
Therefore, I'd like to call for another round of tests with
`--enable-newgc' on all the systems out there!
Here are the details:
Currently, XEmacs's finalizers run synchronously during a garbage
collection, just before the sweep phase. Since the finalizers run
while still in the middle of the collection, special care has to be
taken how finalizers are written and what actions they take. This can
easily cause errors, and it obviously does for lstream finalization in
combination with the incremental garbage collector.
Therefore, it is better to have the finalizers run asynchronously
after a garbage collection. XEmacs already has an asynchronous
finalization mechanism, the post-gc-hook, currently only used to run
finalizers on the Lisp level for the ephemeron Lisp object.
To have all finalizers run asynchronously on the C level, I change the
post_gc_action semantics: Instead of calling run_post_gc_action at the
end of a garbage collection, I postpone the call to the next eval
call, just like post-gc-hook works.
Additionally, I make sure that every Lisp object is finalized only
once: Therefore, each Lisp object gets a new bit called `finalize'
that is initialized to 1 if the according lrecord_implementation
contains a finalizer function. The finalizer only executes when
`finalize' is set, and the finalizer unsets the bit after the object
is finalized.
The garbage collector enqueues the finalizer for later execution via
add_post_gc_action instead of calling the finalizer on the object
directly, and the object is not freed in this garbage collection
cycle. The next time when eval is called, the finalizers run; the
next time when a collection runs, the objects are freed.
Note that I did not conditionalize these changes on MC_ALLOC or
NEW_GC: With this patch, the old garbage collector also uses
asynchronous finalization. In my opinion, this does not hurt: No
speed penalty, only a slightly bigger memory overhead, and it makes
finalization bullet proof.
I'll commit end of next week, if nobody objects or comes up with
suggestions.
src/ChangeLog addition:
2006-01-21 Marcus Crestani <crestani(a)xemacs.org>
* alloc.c (finalize_string): Use finalize bit.
* alloc.c (sweep_lcrecords_1): Register finalizer as post gc
action if it has to be finalized instead of call it directly.
* buffer.c (DEFVAR_BUFFER_LOCAL_1): Set finalize bit.
* bytecode.c (finalize_compiled_function): Use finalize bit.
* console.c (DEFVAR_CONSOLE_LOCAL_1): Set finalize bit.
* database.c (finalize_database): Use finalize bit.
* device-msw.c (finalize_devmode): Use finalize bit.
* elhash.c: NEW_GC does not need a finalizer for hash tables.
* elhash.c (finalize_hash_table): Use finalize bit.
* eval.c (Ffuncall): Add run_post_gc_actions here.
* event-stream.c (finalize_command_builder): Use finalize bit.
* extents.c (finalize_extent_info): Use finalize bit.
* file-coding.c (finalize_coding_system): Use finalize bit.
* gc.c (struct post_gc_action): Add for_disksave argument to post-gc
function.
* gc.c (register_post_gc_action): Add for_disksave argument.
* gc.c (run_post_gc_actions): Call finalizer with for_disksave
argument.
* gc.c (gc_finish): Remove synchronous run_post_gc_actions call,
move it eval.c.
* glyphs-msw.c (finalize_destroy_window): Add for_disksave
argument.
* glyphs.c (finalize_image_instance): Use finalize bit.
* gui.c: Remove unused finalize_gui_item.
* lisp.h: Add run_post_gc_actions, add for_disksave argument.
* lisp.h (struct Lisp_String): Add finalize bit, adjust other
bit fields.
* lisp.h (DEFUN_NORETURN): Add finalize bit.
* lisp.h (DEFUN): Add finalize bit.
* lrecord.h: Add finalize bit accessor macros.
* lrecord.h (struct lrecord_header): Add finalize bit, adjust
other bit fields.
* lrecord.h (set_lheader_implementation): Initialize finalize bit
according to the finalizer field in the lrecord implementation of
the lrecord.
* lrecord.h (MC_ALLOC_REGISTER_FINALIZER): New.
* lstream.c (finalize_lstream): Use finalize bit.
* marker.c (finalize_marker): Use finalize bit.
* mc-alloc.c (remove_cell): Set finalize bit to avoid finalization
of an already freed object.
* mc-alloc.c (finalize_page): Register finalizer as post gc action
instead of call it directly, keep objects that need to be
finalized alive for now..
* objects.c (finalize_color_instance): Use finalize bit.
* objects.c (finalize_font_instance): Use finalize bit.
* process.c (finalize_process): Use finalize bit.
* scrollbar-msw.c (unshow_that_mofo): Add for_disksave argument.
* specifier.c (finalize_specifier): Use finalize bit, remove
unneeded mc_free call.
* symbols.c (guts_of_unbound_marker): Add finalize bit.
* symeval.h (DEFVAR_SYMVAL_FWD): Add finalize bit.
* window.c (finalize_window): Use finalize bit, use for_disksave.
* xft-fonts.c (finalize_fc_pattern): Add for_disksave argument,
use finalize bit.
xemacs-21.5 source patch:
Diff command: cvs -q diff -u
Files affected: src/xft-fonts.c src/window.c src/symeval.h src/symbols.c src/specifier.c
src/scrollbar-msw.c src/process.c src/objects.c src/mc-alloc.c src/marker.c src/lstream.c
src/lrecord.h src/lisp.h src/gui.c src/glyphs.c src/glyphs-msw.c src/gc.c
src/file-coding.c src/extents.c src/event-stream.c src/eval.c src/elhash.c
src/device-msw.c src/database.c src/console.c src/bytecode.c src/buffer.c src/alloc.c
Index: src/alloc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v
retrieving revision 1.122
diff -u -r1.122 alloc.c
--- src/alloc.c 25 Dec 2005 11:21:46 -0000 1.122
+++ src/alloc.c 21 Jan 2006 10:42:26 -0000
＠＠ -2355,10 +2355,12 ＠＠
{
if (!for_disksave)
{
+ if (!LRECORD_FINALIZE_P (header)) return;
Lisp_String *s = (Lisp_String *) header;
Bytecount size = s->size_;
if (BIG_STRING_SIZE_P (size))
xfree (s->data_, Ibyte *);
+ SET_LRECORD_NOT_FINALIZE (header);
}
}
＠＠ -3500,10 +3502,15 ＠＠
GC_CHECK_LHEADER_INVARIANTS (h);
- if (! MARKED_RECORD_HEADER_P (h) && ! header->free)
+ if (! MARKED_RECORD_HEADER_P (h) && ! header->free
+ && LRECORD_FINALIZE_P (h))
{
if (LHEADER_IMPLEMENTATION (h)->finalizer)
- LHEADER_IMPLEMENTATION (h)->finalizer (h, 0);
+ {
+ register_post_gc_action
+ (LHEADER_IMPLEMENTATION (h)->finalizer, (void *) h);
+ MARK_RECORD_HEADER (h);
+ }
}
}
Index: src/buffer.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/buffer.c,v
retrieving revision 1.75
diff -u -r1.75 buffer.c
--- src/buffer.c 17 Dec 2005 21:04:16 -0000 1.75
+++ src/buffer.c 21 Jan 2006 10:42:28 -0000
＠＠ -2137,7 +2137,6 ＠＠
struct symbol_value_forward *I_hate_C = \
alloc_lrecord_type (struct symbol_value_forward, \
&lrecord_symbol_value_forward); \
- /*mcpro ((Lisp_Object) I_hate_C);*/ \
\
I_hate_C->magic.value = &(buffer_local_flags.field_name); \
I_hate_C->magic.type = forward_type; \
＠＠ -2166,6 +2165,7 ＠＠
{ /* struct old_lcrecord_header */ \
{ /* struct lrecord_header */ \
lrecord_type_symbol_value_forward, /* lrecord_type_index */ \
+ 0, /* finalize bit */ \
1, /* mark bit */ \
1, /* c_readonly bit */ \
1 /* lisp_readonly bit */ \
Index: src/bytecode.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/bytecode.c,v
retrieving revision 1.48
diff -u -r1.48 bytecode.c
--- src/bytecode.c 25 Nov 2005 01:41:56 -0000 1.48
+++ src/bytecode.c 21 Jan 2006 10:42:29 -0000
＠＠ -2253,10 +2253,12 ＠＠
{
if (!for_disksave)
{
+ if (!LRECORD_FINALIZE_P (header)) return;
struct Lisp_Compiled_Function *cf =
(struct Lisp_Compiled_Function *) header;
if (cf->args_in_array)
xfree (cf->args, Lisp_Object *);
+ SET_LRECORD_NOT_FINALIZE (header);
}
}
Index: src/console.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console.c,v
retrieving revision 1.46
diff -u -r1.46 console.c
--- src/console.c 18 Dec 2005 11:44:28 -0000 1.46
+++ src/console.c 21 Jan 2006 10:42:30 -0000
＠＠ -1331,7 +1331,6 ＠＠
struct symbol_value_forward *I_hate_C = \
alloc_lrecord_type (struct symbol_value_forward, \
&lrecord_symbol_value_forward); \
- /*mcpro ((Lisp_Object) I_hate_C);*/ \
\
I_hate_C->magic.value = &(console_local_flags.field_name); \
I_hate_C->magic.type = forward_type; \
＠＠ -1358,6 +1357,7 ＠＠
{ /* struct old_lcrecord_header */ \
{ /* struct lrecord_header */ \
lrecord_type_symbol_value_forward, /* lrecord_type_index */ \
+ 0, /* finalize bit */ \
1, /* mark bit */ \
1, /* c_readonly bit */ \
1 /* lisp_readonly bit */ \
Index: src/database.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/database.c,v
retrieving revision 1.38
diff -u -r1.38 database.c
--- src/database.c 16 Nov 2005 07:22:46 -0000 1.38
+++ src/database.c 21 Jan 2006 10:42:30 -0000
＠＠ -185,6 +185,7 ＠＠
{
Lisp_Database *db = (Lisp_Database *) header;
+ if (!for_disksave && !LRECORD_FINALIZE_P (header)) return;
if (for_disksave)
{
invalid_operation
＠＠ -192,6 +193,7 ＠＠
wrap_database (db));
}
db->funcs->close (db);
+ if (!for_disksave) SET_LRECORD_NOT_FINALIZE (header);
}
DEFINE_LRECORD_IMPLEMENTATION ("database", database,
Index: src/device-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device-msw.c,v
retrieving revision 1.60
diff -u -r1.60 device-msw.c
--- src/device-msw.c 25 Nov 2005 01:41:58 -0000 1.60
+++ src/device-msw.c 21 Jan 2006 10:42:31 -0000
＠＠ -1169,6 +1169,7 ＠＠
{
Lisp_Devmode *dm = (Lisp_Devmode *) header;
+ if (!for_disksave && !LRECORD_FINALIZE_P (header)) return;
if (for_disksave)
{
Lisp_Object devmode = wrap_devmode (dm);
＠＠ -1179,6 +1180,7 ＠＠
}
assert (NILP (dm->device));
+ if (!for_disksave) SET_LRECORD_NOT_FINALIZE (header);
}
static int
Index: src/elhash.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/elhash.c,v
retrieving revision 1.44
diff -u -r1.44 elhash.c
--- src/elhash.c 25 Nov 2005 01:42:00 -0000 1.44
+++ src/elhash.c 21 Jan 2006 10:42:32 -0000
＠＠ -443,16 +443,20 ＠＠
#endif /* not NEW_GC */
}
+#ifndef NEW_GC
static void
finalize_hash_table (void *header, int for_disksave)
{
if (!for_disksave)
{
+ if (!LRECORD_FINALIZE_P (header)) return;
Lisp_Hash_Table *ht = (Lisp_Hash_Table *) header;
free_hentries (ht->hentries, ht->size);
ht->hentries = 0;
+ SET_LRECORD_NOT_FINALIZE (header);
}
}
+#endif /* not NEW_GC */
static const struct memory_description htentry_description_1[] = {
{ XD_LISP_OBJECT, offsetof (htentry, key) },
＠＠ -515,6 +519,14 ＠＠
{ XD_END }
};
+#ifdef NEW_GC
+DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table,
+ 1, /*dumpable-flag*/
+ mark_hash_table, print_hash_table,
+ 0, hash_table_equal, hash_table_hash,
+ hash_table_description,
+ Lisp_Hash_Table);
+#else /* not NEW_GC */
DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table,
1, /*dumpable-flag*/
mark_hash_table, print_hash_table,
＠＠ -522,6 +534,7 ＠＠
hash_table_equal, hash_table_hash,
hash_table_description,
Lisp_Hash_Table);
+#endif /* not NEW_GC */
static Lisp_Hash_Table *
xhash_table (Lisp_Object hash_table)
Index: src/eval.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/eval.c,v
retrieving revision 1.91
diff -u -r1.91 eval.c
--- src/eval.c 25 Nov 2005 01:42:00 -0000 1.91
+++ src/eval.c 21 Jan 2006 10:42:36 -0000
＠＠ -3835,6 +3835,7 ＠＠
{
need_to_signal_post_gc = 0;
recompute_funcall_allocation_flag ();
+ run_post_gc_actions ();
run_post_gc_hook ();
}
}
Index: src/event-stream.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-stream.c,v
retrieving revision 1.92
diff -u -r1.92 event-stream.c
--- src/event-stream.c 25 Oct 2005 11:16:23 -0000 1.92
+++ src/event-stream.c 21 Jan 2006 10:42:38 -0000
＠＠ -360,11 +360,13 ＠＠
if (!for_disksave)
{
struct command_builder *b = (struct command_builder *) header;
+ if (!LRECORD_FINALIZE_P (header)) return;
if (b->echo_buf)
{
xfree (b->echo_buf, Ibyte *);
b->echo_buf = 0;
}
+ SET_LRECORD_NOT_FINALIZE (header);
}
}
Index: src/extents.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/extents.c,v
retrieving revision 1.63
diff -u -r1.63 extents.c
--- src/extents.c 25 Nov 2005 01:42:01 -0000 1.63
+++ src/extents.c 21 Jan 2006 10:42:43 -0000
＠＠ -1277,6 +1277,7 ＠＠
if (for_disksave)
return;
+ if (!LRECORD_FINALIZE_P (header)) return;
#ifdef NEW_GC
data->soe = 0;
data->extents = 0;
＠＠ -1292,6 +1293,7 ＠＠
data->extents = 0;
}
#endif /* not NEW_GC */
+ SET_LRECORD_NOT_FINALIZE (header);
}
DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info,
Index: src/file-coding.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/file-coding.c,v
retrieving revision 1.50
diff -u -r1.50 file-coding.c
--- src/file-coding.c 17 Dec 2005 19:47:03 -0000 1.50
+++ src/file-coding.c 21 Jan 2006 10:42:45 -0000
＠＠ -313,7 +313,11 ＠＠
necessary. But it would be necessary if we changed things
so that coding systems could go away. */
if (!for_disksave) /* see comment in lstream.c */
- MAYBE_XCODESYSMETH (cs, finalize, (cs));
+ {
+ if (!LRECORD_FINALIZE_P (header)) return;
+ MAYBE_XCODESYSMETH (cs, finalize, (cs));
+ SET_LRECORD_NOT_FINALIZE (header);
+ }
}
static Bytecount
Index: src/gc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gc.c,v
retrieving revision 1.1
diff -u -r1.1 gc.c
--- src/gc.c 25 Nov 2005 01:42:03 -0000 1.1
+++ src/gc.c 21 Jan 2006 10:42:46 -0000
＠＠ -1339,7 +1339,7 ＠＠
struct post_gc_action
{
- void (*fun) (void *);
+ void (*fun) (void *, int);
void *arg;
};
＠＠ -1362,7 +1362,7 ＠＠
*/
void
-register_post_gc_action (void (*fun) (void *), void *arg)
+register_post_gc_action (void (*fun) (void *, int), void *arg)
{
post_gc_action action;
＠＠ -1375,7 +1375,7 ＠＠
Dynarr_add (post_gc_actions, action);
}
-static void
+void
run_post_gc_actions (void)
{
int i;
＠＠ -1385,7 +1385,7 ＠＠
for (i = 0; i < Dynarr_length (post_gc_actions); i++)
{
post_gc_action action = Dynarr_at (post_gc_actions, i);
- (action.fun) (action.arg);
+ (action.fun) (action.arg, 0);
}
Dynarr_reset (post_gc_actions);
＠＠ -1738,8 +1738,6 ＠＠
inhibit_non_essential_conversion_operations = 0;
#endif /* not NEW_GC */
gc_in_progress = 0;
-
- run_post_gc_actions ();
/******* End of garbage collection ********/
Index: src/glyphs-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-msw.c,v
retrieving revision 1.56
diff -u -r1.56 glyphs-msw.c
--- src/glyphs-msw.c 27 Sep 2005 05:48:26 -0000 1.56
+++ src/glyphs-msw.c 21 Jan 2006 10:42:48 -0000
＠＠ -1737,7 +1737,7 ＠＠
#endif
static void
-finalize_destroy_window (void *win)
+finalize_destroy_window (void *win, int UNUSED (for_disksave))
{
DestroyWindow ((HWND) win);
}
Index: src/glyphs.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs.c,v
retrieving revision 1.55
diff -u -r1.55 glyphs.c
--- src/glyphs.c 25 Nov 2005 01:42:04 -0000 1.55
+++ src/glyphs.c 21 Jan 2006 10:42:51 -0000
＠＠ -1123,6 +1123,7 ＠＠
return;
if (for_disksave) finalose (i);
+ if (!for_disksave && !LRECORD_FINALIZE_P (header)) return;
/* We can't use the domain here, because it might have
disappeared. */
MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (i)),
＠＠ -1130,6 +1131,7 ＠＠
/* Make sure we don't try this twice. */
IMAGE_INSTANCE_DEVICE (i) = Qnil;
+ if (!for_disksave) SET_LRECORD_NOT_FINALIZE (header);
}
static int
Index: src/gui.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gui.c,v
retrieving revision 1.31
diff -u -r1.31 gui.c
--- src/gui.c 24 Oct 2005 10:07:37 -0000 1.31
+++ src/gui.c 21 Jan 2006 10:42:51 -0000
＠＠ -804,15 +804,10 ＠＠
RETURN_UNGCPRO (ret);
}
-static void
-finalize_gui_item (void *UNUSED (header), int UNUSED (for_disksave))
-{
-}
-
DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item,
0, /*dumpable-flag*/
mark_gui_item, print_gui_item,
- finalize_gui_item, gui_item_equal,
+ 0, gui_item_equal,
gui_item_hash,
gui_item_description,
Lisp_Gui_Item);
Index: src/lisp.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v
retrieving revision 1.136
diff -u -r1.136 lisp.h
--- src/lisp.h 26 Nov 2005 11:46:09 -0000 1.136
+++ src/lisp.h 21 Jan 2006 10:42:55 -0000
＠＠ -2637,19 +2637,20 ＠＠
/* WARNING: Everything before ascii_begin must agree exactly with
struct lrecord_header */
unsigned int type :8;
+ unsigned int finalize :1;
#ifdef MC_ALLOC
unsigned int lisp_readonly :1;
unsigned int free :1;
/* Number of chars at beginning of string that are one byte in length
(byte_ascii_p) */
- unsigned int ascii_begin :22;
+ unsigned int ascii_begin :21;
#else /* not MC_ALLOC */
unsigned int mark :1;
unsigned int c_readonly :1;
unsigned int lisp_readonly :1;
/* Number of chars at beginning of string that are one byte in length
(byte_ascii_p) */
- unsigned int ascii_begin :21;
+ unsigned int ascii_begin :20;
#endif /* not MC_ALLOC */
} v;
} u;
＠＠ -3459,6 +3460,7 ＠＠
{ \
{ /* struct lrecord_header */ \
lrecord_type_subr, /* lrecord_type_index */ \
+ 0, /* finalize bit */ \
1, /* lisp_readonly bit */ \
0, /* free */ \
0 /* uid */ \
＠＠ -3481,6 +3483,7 ＠＠
{ \
{ /* struct lrecord_header */ \
lrecord_type_subr, /* lrecord_type_index */ \
+ 0, /* finalize bit */ \
1, /* mark bit */ \
1, /* c_readonly bit */ \
1, /* lisp_readonly bit */ \
＠＠ -4033,7 +4036,8 ＠＠
#endif /* not DEBUG_XEMACS */
#endif /* MC_ALLOC */
-void register_post_gc_action (void (*fun) (void *), void *arg);
+void register_post_gc_action (void (*fun) (void *, int), void *arg);
+void run_post_gc_actions (void);
int begin_gc_forbidden (void);
void end_gc_forbidden (int count);
extern int gc_currently_forbidden;
Index: src/lrecord.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lrecord.h,v
retrieving revision 1.46
diff -u -r1.46 lrecord.h
--- src/lrecord.h 27 Nov 2005 10:51:25 -0000 1.46
+++ src/lrecord.h 21 Jan 2006 10:42:56 -0000
＠＠ -111,6 +111,11 ＠＠
field. */
unsigned int type :8;
+ /* The `finalize' field is a flag that indicates whether this
+ lrecord has to be finalized or not. This allows an asynchronous
+ finalization mechanism. */
+ unsigned int finalize :1;
+
#ifdef MC_ALLOC
/* 1 if the object is readonly from lisp */
unsigned int lisp_readonly :1;
＠＠ -123,7 +128,7 ＠＠
/* The `uid' field is just for debugging/printing convenience. Having
this slot doesn't hurt us spacewise, since the bits are unused
anyway. (The bits are used for strings, though.) */
- unsigned int uid :22;
+ unsigned int uid :21;
#else /* not MC_ALLOC */
/* If `mark' is 0 after the GC mark phase, the object will be freed
＠＠ -143,7 +148,7 ＠＠
/* The `uid' field is just for debugging/printing convenience. Having
this slot doesn't hurt us spacewise, since the bits are unused
anyway. (The bits are used for strings, though.) */
- unsigned int uid :21;
+ unsigned int uid :20;
#endif /* not MC_ALLOC */
};
＠＠ -156,6 +161,7 ＠＠
#define set_lheader_implementation(header,imp) do { \
struct lrecord_header* SLI_header = (header); \
SLI_header->type = (imp)->lrecord_type_index; \
+ SLI_header->finalize = ((imp)->finalizer) ? 1 : 0; \
SLI_header->lisp_readonly = 0; \
SLI_header->free = 0; \
SLI_header->uid = lrecord_uid_counter++; \
＠＠ -164,6 +170,7 ＠＠
#define set_lheader_implementation(header,imp) do { \
struct lrecord_header* SLI_header = (header); \
SLI_header->type = (imp)->lrecord_type_index; \
+ SLI_header->finalize = (imp)->finalizer ? 1 : 0; \
SLI_header->mark = 0; \
SLI_header->c_readonly = 0; \
SLI_header->lisp_readonly = 0; \
＠＠ -453,6 +460,23 ＠＠
#endif /* ALLOC_TYPE_STATS */
/* Tell mc-alloc how to call a finalizer. */
+#define MC_ALLOC_REGISTER_FINALIZER(ptr) \
+{ \
+ Lisp_Object MCACF_obj = wrap_pointer_1 (ptr); \
+ struct lrecord_header *MCACF_lheader = XRECORD_LHEADER (MCACF_obj); \
+ if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj) \
+ && LRECORD_FINALIZE_P (MCACF_lheader) \
+ && !LRECORD_FREE_P (MCACF_lheader) ) \
+ { \
+ const struct lrecord_implementation *MCACF_implementation \
+ = LHEADER_IMPLEMENTATION (MCACF_lheader); \
+ if (MCACF_implementation && MCACF_implementation->finalizer) \
+ { \
+ register_post_gc_action \
+ (MCACF_implementation->finalizer, (void *) ptr); \
+ } \
+ } \
+} while (0)
#ifdef NEW_GC
#define MC_ALLOC_CALL_FINALIZER(ptr) \
{ \
＠＠ -474,14 +498,17 ＠＠
#define MC_ALLOC_CALL_FINALIZER(ptr) \
{ \
Lisp_Object MCACF_obj = wrap_pointer_1 (ptr); \
- struct lrecord_header *MCACF_lheader = XRECORD_LHEADER (MCACF_obj); \
+ struct lrecord_header *MCACF_lheader = XRECORD_LHEADER (MCACF_obj); \
if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj) \
+ && LRECORD_FINALIZE_P (MCACF_lheader) \
&& !LRECORD_FREE_P (MCACF_lheader) ) \
{ \
const struct lrecord_implementation *MCACF_implementation \
= LHEADER_IMPLEMENTATION (MCACF_lheader); \
if (MCACF_implementation && MCACF_implementation->finalizer) \
- MCACF_implementation->finalizer (ptr, 0); \
+ { \
+ MCACF_implementation->finalizer (ptr, 0); \
+ } \
} \
} while (0)
#endif /* not NEW_GC */
＠＠ -553,6 +580,15 ＠＠
#endif /* not USE_KKCC */
#define RECORD_DUMPABLE(lheader)
(lrecord_implementations_table[(lheader)->type])->dumpable
+
+#define LRECORD_FINALIZE_P(ptr) \
+(((struct lrecord_header *) ptr)->finalize)
+
+#define SET_LRECORD_FINALIZE(ptr) \
+(((struct lrecord_header *) ptr)->finalize = 1)
+
+#define SET_LRECORD_NOT_FINALIZE(ptr) \
+(((struct lrecord_header *) ptr)->finalize = 0)
/* Data description stuff
Index: src/lstream.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lstream.c,v
retrieving revision 1.36
diff -u -r1.36 lstream.c
--- src/lstream.c 25 Oct 2005 08:32:48 -0000 1.36
+++ src/lstream.c 21 Jan 2006 10:42:57 -0000
＠＠ -76,6 +76,7 ＠＠
(at dump time) on objects that are not being released. */
Lstream *lstr = (Lstream *) header;
+ if (!for_disksave && !LRECORD_FINALIZE_P (header)) return;
#if 0 /* this may cause weird Broken Pipes? */
if (for_disksave)
{
＠＠ -97,8 +98,9 ＠＠
if (!for_disksave)
{
- if (lstr->imp->finalizer)
+ if (lstr->imp && lstr->imp->finalizer)
(lstr->imp->finalizer) (lstr);
+ SET_LRECORD_NOT_FINALIZE (header);
}
}
Index: src/marker.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/marker.c,v
retrieving revision 1.18
diff -u -r1.18 marker.c
--- src/marker.c 25 Oct 2005 11:16:26 -0000 1.18
+++ src/marker.c 21 Jan 2006 10:42:57 -0000
＠＠ -111,7 +111,9 ＠＠
if (!for_disksave)
{
Lisp_Object tem = wrap_marker (header);
+ if (!LRECORD_FINALIZE_P (header)) return;
unchain_marker (tem);
+ SET_LRECORD_NOT_FINALIZE (header);
}
}
Index: src/mc-alloc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mc-alloc.c,v
retrieving revision 1.6
diff -u -r1.6 mc-alloc.c
--- src/mc-alloc.c 25 Nov 2005 01:42:05 -0000 1.6
+++ src/mc-alloc.c 21 Jan 2006 10:42:58 -0000
＠＠ -1463,6 +1463,7 ＠＠
#ifdef ERROR_CHECK_GC
assert (!LRECORD_FREE_P (ptr));
deadbeef_memory (ptr, PH_CELL_SIZE (ph));
+ SET_LRECORD_NOT_FINALIZE (ptr);
MARK_LRECORD_AS_FREE (ptr);
#endif
}
＠＠ -1530,7 +1531,12 ＠＠
#endif /* not NEW_GC */
{
EMACS_INT ptr = (heap_space + (heap_space_step * mark_bit));
- MC_ALLOC_CALL_FINALIZER ((void *) ptr);
+ MC_ALLOC_REGISTER_FINALIZER ((void *) ptr);
+#ifdef NEW_GC
+ SET_BIT (ph, mark_bit * N_MARK_BITS, BLACK);
+#else /* not NEW_GC */
+ SET_BIT (ph, mark_bit * N_MARK_BITS, 1);
+#endif /* not NEW_GC */
}
}
}
Index: src/objects.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v
retrieving revision 1.31
diff -u -r1.31 objects.c
--- src/objects.c 26 Nov 2005 11:46:10 -0000 1.31
+++ src/objects.c 21 Jan 2006 10:42:59 -0000
＠＠ -117,11 +117,13 ＠＠
{
Lisp_Color_Instance *c = (Lisp_Color_Instance *) header;
+ if (!for_disksave && !LRECORD_FINALIZE_P (header)) return;
if (!NILP (c->device))
{
if (for_disksave) finalose (c);
MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c));
}
+ if (!for_disksave) SET_LRECORD_NOT_FINALIZE (header);
}
static int
＠＠ -333,11 +335,13 ＠＠
{
Lisp_Font_Instance *f = (Lisp_Font_Instance *) header;
+ if (!for_disksave && !LRECORD_FINALIZE_P (header)) return;
if (!NILP (f->device))
{
if (for_disksave) finalose (f);
MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f));
}
+ if (!for_disksave) SET_LRECORD_NOT_FINALIZE (header);
}
/* Fonts are equal if they resolve to the same name.
Index: src/process.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/process.c,v
retrieving revision 1.69
diff -u -r1.69 process.c
--- src/process.c 25 Oct 2005 11:16:27 -0000 1.69
+++ src/process.c 21 Jan 2006 10:43:00 -0000
＠＠ -194,6 +194,7 ＠＠
/* #### this probably needs to be tied into the tty event loop */
/* #### when there is one */
Lisp_Process *p = (Lisp_Process *) header;
+ if (!for_disksave && !LRECORD_FINALIZE_P (header)) return;
#ifdef HAVE_WINDOW_SYSTEM
if (!for_disksave)
{
＠＠ -207,6 +208,7 ＠＠
if (!for_disksave)
xfree (p->process_data, void *);
}
+ if (!for_disksave) SET_LRECORD_NOT_FINALIZE (header);
}
DEFINE_LRECORD_IMPLEMENTATION ("process", process,
Index: src/scrollbar-msw.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/scrollbar-msw.c,v
retrieving revision 1.31
diff -u -r1.31 scrollbar-msw.c
--- src/scrollbar-msw.c 25 Oct 2005 08:32:49 -0000 1.31
+++ src/scrollbar-msw.c 21 Jan 2006 10:43:00 -0000
＠＠ -104,7 +104,7 ＠＠
}
static void
-unshow_that_mofo (void *handle)
+unshow_that_mofo (void *handle, int UNUSED (for_disksave))
{
ShowScrollBar ((HWND) handle, SB_CTL, 0);
}
Index: src/specifier.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v
retrieving revision 1.43
diff -u -r1.43 specifier.c
--- src/specifier.c 25 Nov 2005 01:42:06 -0000 1.43
+++ src/specifier.c 21 Jan 2006 10:43:02 -0000
＠＠ -299,16 +299,16 ＠＠
finalize_specifier (void *header, int for_disksave)
{
Lisp_Specifier *sp = (Lisp_Specifier *) header;
+ if (!for_disksave && !LRECORD_FINALIZE_P (header)) return;
/* don't be snafued by the disksave finalization. */
if (!for_disksave && !GHOST_SPECIFIER_P(sp) && sp->caching)
{
-#ifdef NEW_GC
- mc_free (sp->caching);
-#else /* not NEW_GC */
+#ifndef NEW_GC
xfree (sp->caching, struct specifier_caching *);
#endif /* not NEW_GC */
sp->caching = 0;
}
+ if (!for_disksave) SET_LRECORD_NOT_FINALIZE (header);
}
static int
Index: src/symbols.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/symbols.c,v
retrieving revision 1.54
diff -u -r1.54 symbols.c
--- src/symbols.c 25 Oct 2005 08:32:49 -0000 1.54
+++ src/symbols.c 21 Jan 2006 10:43:04 -0000
＠＠ -3259,6 +3259,7 ＠＠
{ /* struct old_lcrecord_header */
{ /* struct lrecord_header */
lrecord_type_symbol_value_forward, /* lrecord_type_index */
+ 0, /* finalize bit */
1, /* mark bit */
1, /* c_readonly bit */
1, /* lisp_readonly bit */
Index: src/symeval.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/symeval.h,v
retrieving revision 1.16
diff -u -r1.16 symeval.h
--- src/symeval.h 25 Oct 2005 08:32:49 -0000 1.16
+++ src/symeval.h 21 Jan 2006 10:43:05 -0000
＠＠ -423,6 +423,7 ＠＠
{ /* struct old_lcrecord_header */ \
{ /* struct lrecord_header */ \
lrecord_type_symbol_value_forward, /* lrecord_type_index */ \
+ 0, /* finalize bit */ \
1, /* mark bit */ \
1, /* c_readonly bit */ \
1, /* lisp_readonly bit */ \
Index: src/window.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/window.c,v
retrieving revision 1.90
diff -u -r1.90 window.c
--- src/window.c 25 Nov 2005 01:42:08 -0000 1.90
+++ src/window.c 21 Jan 2006 10:43:08 -0000
＠＠ -326,10 +326,12 ＠＠
}
static void
-finalize_window (void *header, int UNUSED (for_disksave))
+finalize_window (void *header, int for_disksave)
{
struct window *w = (struct window *) header;
+ if (!for_disksave && !LRECORD_FINALIZE_P (header)) return;
+
if (w->line_start_cache)
{
Dynarr_free (w->line_start_cache);
＠＠ -358,6 +360,8 ＠＠
Dynarr_free (w->glyph_cachels);
w->glyph_cachels = 0;
}
+
+ if (!for_disksave) SET_LRECORD_NOT_FINALIZE (header);
}
/* These caches map buffers to markers. They are key-weak so that entries
Index: src/xft-fonts.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/xft-fonts.c,v
retrieving revision 1.3
diff -u -r1.3 xft-fonts.c
--- src/xft-fonts.c 26 Nov 2005 18:25:03 -0000 1.3
+++ src/xft-fonts.c 21 Jan 2006 10:43:08 -0000
＠＠ -88,14 +88,16 ＠＠
****************************************************************/
static void
-finalize_fc_pattern (void *header, int UNUSED (for_disksave))
+finalize_fc_pattern (void *header, int for_disksave)
{
struct fc_pattern *p = (struct fc_pattern *) header;
+ if (!for_disksave && !LRECORD_FINALIZE_P (header)) return;
if (p->fcpatPtr)
{
FcPatternDestroy (p->fcpatPtr);
p->fcpatPtr = 0;
}
+ if (!for_disksave) SET_LRECORD_NOT_FINALIZE (header);
}
static const struct memory_description fcpattern_description [] = {
--
Marcus