Mercurial > hg > xemacs-beta
changeset 887:ccc3177ef10b
[xemacs-hg @ 2002-06-28 14:21:41 by michaels]
2002-06-27 Mike Sperber <mike@xemacs.org>
* eval.c (Ffuncall): Run `post-gc-hook' if GC just happened.
* alloc.c (garbage_collect_1): Delay running `post-gc-hook' until later.
author | michaels |
---|---|
date | Fri, 28 Jun 2002 14:21:41 +0000 |
parents | 011e1bce6ece |
children | 201c016cfc12 |
files | src/alloc.c src/eval.c |
diffstat | 2 files changed, 41 insertions(+), 8 deletions(-) [+] |
line wrap: on
line diff
--- a/src/alloc.c Fri Jun 28 14:20:42 2002 +0000 +++ b/src/alloc.c Fri Jun 28 14:21:41 2002 +0000 @@ -96,6 +96,7 @@ static EMACS_INT consing_since_gc; int need_to_garbage_collect; int need_to_check_c_alloca; +int need_to_signal_post_gc; int funcall_allocation_flag; Bytecount __temp_alloca_size__; Bytecount funcall_alloca_count; @@ -3626,6 +3627,9 @@ have infinite GC recursion. */ speccount = begin_gc_forbidden (); + need_to_signal_post_gc = 0; + recompute_funcall_allocation_flag(); + if (!gc_hooks_inhibited) run_hook_trapping_problems ("Error in pre-gc-hook", Qpre_gc_hook, @@ -3770,7 +3774,8 @@ iterate until nothing more gets marked. */ while (finish_marking_weak_hash_tables () > 0 || - finish_marking_weak_lists () > 0) + finish_marking_weak_lists () > 0 || + finish_marking_ephemerons () > 0) ; /* And prune (this needs to be called after everything else has been @@ -3782,6 +3787,7 @@ prune_specifiers (); prune_syntax_tables (); + prune_ephemerons (); prune_weak_boxes (); gc_sweep (); @@ -3801,10 +3807,6 @@ /******* End of garbage collection ********/ - run_hook_trapping_problems - ("Error in post-gc-hook", Qpost_gc_hook, - INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION); - /* Now remove the GC cursor/message */ if (!noninteractive) { @@ -3837,6 +3839,10 @@ } UNGCPRO; + + need_to_signal_post_gc = 1; + funcall_allocation_flag = 1; + return; } @@ -4012,7 +4018,10 @@ void recompute_funcall_allocation_flag (void) { - funcall_allocation_flag = need_to_garbage_collect || need_to_check_c_alloca; + funcall_allocation_flag = + need_to_garbage_collect || + need_to_check_c_alloca || + need_to_signal_post_gc; } /* True if it's time to garbage collect now. */ @@ -4427,8 +4436,8 @@ DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook /* Function or functions to be run just after each garbage collection. Interrupts, garbage collection, and errors are inhibited while this hook -runs, so be extremely careful in what you add here. In particular, avoid -consing, and do not interact with the user. +runs. Each hook is called with one argument which is an alist with +finalization data. */ ); Vpost_gc_hook = Qnil;
--- a/src/eval.c Fri Jun 28 14:20:42 2002 +0000 +++ b/src/eval.c Fri Jun 28 14:21:41 2002 +0000 @@ -246,6 +246,7 @@ Lisp_Object Qdebug_on_signal, Qstack_trace_on_signal; Lisp_Object Qdebugger; Lisp_Object Qinhibit_quit; +Lisp_Object Qfinalize_list; Lisp_Object Qrun_hooks; Lisp_Object Qsetq; Lisp_Object Qdisplay_warning; @@ -3686,6 +3687,14 @@ funcall_alloca_count = 0; } } + if (need_to_signal_post_gc) + { + static void run_post_gc_hook(void); /* forward */ + + need_to_signal_post_gc = 0; + recompute_funcall_allocation_flag(); + run_post_gc_hook(); + } } if (++lisp_eval_depth > max_lisp_eval_depth) @@ -5511,6 +5520,20 @@ RUN_HOOKS_TO_COMPLETION, flags)); } +static void +run_post_gc_hook() +{ + Lisp_Object args[2]; + + args[0] = Qpost_gc_hook; + args[1] = Fcons (Fcons (Qfinalize_list, zap_finalize_list()), Qnil); + + run_hook_with_args_trapping_problems + ("Error in post-gc-hook", + 2, args, + RUN_HOOKS_TO_COMPLETION, + INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION); +} /************************************************************************/ /* The special binding stack */ @@ -6224,6 +6247,7 @@ DEFSYMBOL (Qvalues); DEFSYMBOL (Qdisplay_warning); DEFSYMBOL (Qrun_hooks); + DEFSYMBOL (Qfinalize_list); DEFSYMBOL (Qif); DEFSUBR (For);