Mercurial > hg > xemacs-beta
annotate src/gc.c @ 4952:19a72041c5ed
Mule-izing, various fixes related to char * arguments
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (print_pgresult):
* postgresql/postgresql.c (Fpq_conn_defaults):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_result_status):
* postgresql/postgresql.c (Fpq_res_status):
Mule-ize large parts of it.
2010-01-26 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
* ldap/eldap.c (allocate_ldap):
Use write_ascstring().
src/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (build_ascstring):
* alloc.c (build_msg_cistring):
* alloc.c (staticpro_1):
* alloc.c (staticpro_name):
* alloc.c (staticpro_nodump_1):
* alloc.c (staticpro_nodump_name):
* alloc.c (unstaticpro_nodump_1):
* alloc.c (mcpro_1):
* alloc.c (mcpro_name):
* alloc.c (object_memory_usage_stats):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_once_early):
* buffer.c (print_buffer):
* buffer.c (vars_of_buffer):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.c (init_initial_directory):
* bytecode.c (invalid_byte_code):
* bytecode.c (print_compiled_function):
* bytecode.c (mark_compiled_function):
* chartab.c (print_table_entry):
* chartab.c (print_char_table):
* config.h.in:
* console-gtk.c:
* console-gtk.c (gtk_device_to_console_connection):
* console-gtk.c (gtk_semi_canonicalize_console_connection):
* console-gtk.c (gtk_canonicalize_console_connection):
* console-gtk.c (gtk_semi_canonicalize_device_connection):
* console-gtk.c (gtk_canonicalize_device_connection):
* console-stream.c (stream_init_frame_1):
* console-stream.c (vars_of_console_stream):
* console-stream.c (init_console_stream):
* console-x.c (x_semi_canonicalize_console_connection):
* console-x.c (x_semi_canonicalize_device_connection):
* console-x.c (x_canonicalize_device_connection):
* console-x.h:
* data.c (eq_with_ebola_notice):
* data.c (Fsubr_interactive):
* data.c (Fnumber_to_string):
* data.c (digit_to_number):
* device-gtk.c (gtk_init_device):
* device-msw.c (print_devmode):
* device-x.c (x_event_name):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-msw.c (vars_of_dialog_mswindows):
* doc.c (weird_doc):
* doc.c (Fsnarf_documentation):
* doc.c (vars_of_doc):
* dumper.c (pdump):
* dynarr.c:
* dynarr.c (Dynarr_realloc):
* editfns.c (Fuser_real_login_name):
* editfns.c (get_home_directory):
* elhash.c (print_hash_table_data):
* elhash.c (print_hash_table):
* emacs.c (main_1):
* emacs.c (vars_of_emacs):
* emodules.c:
* emodules.c (_emodules_list):
* emodules.c (Fload_module):
* emodules.c (Funload_module):
* emodules.c (Flist_modules):
* emodules.c (find_make_module):
* emodules.c (attempt_module_delete):
* emodules.c (emodules_load):
* emodules.c (emodules_doc_subr):
* emodules.c (emodules_doc_sym):
* emodules.c (syms_of_module):
* emodules.c (vars_of_module):
* emodules.h:
* eval.c (print_subr):
* eval.c (signal_call_debugger):
* eval.c (build_error_data):
* eval.c (signal_error):
* eval.c (maybe_signal_error):
* eval.c (signal_continuable_error):
* eval.c (maybe_signal_continuable_error):
* eval.c (signal_error_2):
* eval.c (maybe_signal_error_2):
* eval.c (signal_continuable_error_2):
* eval.c (maybe_signal_continuable_error_2):
* eval.c (signal_ferror):
* eval.c (maybe_signal_ferror):
* eval.c (signal_continuable_ferror):
* eval.c (maybe_signal_continuable_ferror):
* eval.c (signal_ferror_with_frob):
* eval.c (maybe_signal_ferror_with_frob):
* eval.c (signal_continuable_ferror_with_frob):
* eval.c (maybe_signal_continuable_ferror_with_frob):
* eval.c (syntax_error):
* eval.c (syntax_error_2):
* eval.c (maybe_syntax_error):
* eval.c (sferror):
* eval.c (sferror_2):
* eval.c (maybe_sferror):
* eval.c (invalid_argument):
* eval.c (invalid_argument_2):
* eval.c (maybe_invalid_argument):
* eval.c (invalid_constant):
* eval.c (invalid_constant_2):
* eval.c (maybe_invalid_constant):
* eval.c (invalid_operation):
* eval.c (invalid_operation_2):
* eval.c (maybe_invalid_operation):
* eval.c (invalid_change):
* eval.c (invalid_change_2):
* eval.c (maybe_invalid_change):
* eval.c (invalid_state):
* eval.c (invalid_state_2):
* eval.c (maybe_invalid_state):
* eval.c (wtaerror):
* eval.c (stack_overflow):
* eval.c (out_of_memory):
* eval.c (print_multiple_value):
* eval.c (issue_call_trapping_problems_warning):
* eval.c (backtrace_specials):
* eval.c (backtrace_unevalled_args):
* eval.c (Fbacktrace):
* eval.c (warn_when_safe):
* event-Xt.c (modwarn):
* event-Xt.c (modbarf):
* event-Xt.c (check_modifier):
* event-Xt.c (store_modifier):
* event-Xt.c (emacs_Xt_format_magic_event):
* event-Xt.c (describe_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (store_modifier):
* event-gtk.c (gtk_reset_modifier_mapping):
* event-msw.c (dde_eval_string):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (FROB):
* event-msw.c (emacs_mswindows_format_magic_event):
* event-stream.c (external_debugging_print_event):
* event-stream.c (execute_help_form):
* event-stream.c (vars_of_event_stream):
* events.c (print_event_1):
* events.c (print_event):
* events.c (event_equal):
* extents.c (print_extent_1):
* extents.c (print_extent):
* extents.c (vars_of_extents):
* faces.c (print_face):
* faces.c (complex_vars_of_faces):
* file-coding.c:
* file-coding.c (print_coding_system):
* file-coding.c (print_coding_system_in_print_method):
* file-coding.c (default_query_method):
* file-coding.c (find_coding_system):
* file-coding.c (make_coding_system_1):
* file-coding.c (chain_print):
* file-coding.c (undecided_print):
* file-coding.c (gzip_print):
* file-coding.c (vars_of_file_coding):
* file-coding.c (complex_vars_of_file_coding):
* fileio.c:
* fileio.c (report_file_type_error):
* fileio.c (report_error_with_errno):
* fileio.c (report_file_error):
* fileio.c (barf_or_query_if_file_exists):
* fileio.c (vars_of_fileio):
* floatfns.c (matherr):
* fns.c (print_bit_vector):
* fns.c (Fmapconcat):
* fns.c (add_suffix_to_symbol):
* fns.c (add_prefix_to_symbol):
* frame-gtk.c:
* frame-gtk.c (Fgtk_window_id):
* frame-x.c (def):
* frame-x.c (x_cde_transfer_callback):
* frame.c:
* frame.c (Fmake_frame):
* gc.c (show_gc_cursor_and_message):
* gc.c (vars_of_gc):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (gtk_print_image_instance):
* glyphs-msw.c (mswindows_print_image_instance):
* glyphs-x.c (x_print_image_instance):
* glyphs-x.c (update_widget_face):
* glyphs.c (make_string_from_file):
* glyphs.c (print_image_instance):
* glyphs.c (signal_image_error):
* glyphs.c (signal_image_error_2):
* glyphs.c (signal_double_image_error):
* glyphs.c (signal_double_image_error_2):
* glyphs.c (xbm_mask_file_munging):
* glyphs.c (pixmap_to_lisp_data):
* glyphs.h:
* gui.c (gui_item_display_flush_left):
* hpplay.c (player_error_internal):
* hpplay.c (myHandler):
* intl-win32.c:
* intl-win32.c (langcode_to_lang):
* intl-win32.c (sublangcode_to_lang):
* intl-win32.c (Fmswindows_get_locale_info):
* intl-win32.c (lcid_to_locale_mule_or_no):
* intl-win32.c (mswindows_multibyte_to_unicode_print):
* intl-win32.c (complex_vars_of_intl_win32):
* keymap.c:
* keymap.c (print_keymap):
* keymap.c (ensure_meta_prefix_char_keymapp):
* keymap.c (Fkey_description):
* keymap.c (Ftext_char_description):
* lisp.h:
* lisp.h (struct):
* lisp.h (DECLARE_INLINE_HEADER):
* lread.c (Fload_internal):
* lread.c (locate_file):
* lread.c (read_escape):
* lread.c (read_raw_string):
* lread.c (read1):
* lread.c (read_list):
* lread.c (read_compiled_function):
* lread.c (init_lread):
* lrecord.h:
* marker.c (print_marker):
* marker.c (marker_equal):
* menubar-msw.c (displayable_menu_item):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar.c (vars_of_menubar):
* minibuf.c (reinit_complex_vars_of_minibuf):
* minibuf.c (complex_vars_of_minibuf):
* mule-charset.c (Fmake_charset):
* mule-charset.c (complex_vars_of_mule_charset):
* mule-coding.c (iso2022_print):
* mule-coding.c (fixed_width_query):
* number.c (bignum_print):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-msw.c:
* objects-msw.c (mswindows_color_to_string):
* objects-msw.c (mswindows_color_list):
* objects-tty.c:
* objects-tty.c (tty_font_list):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c (xft_find_charset_font):
* objects-xlike-inc.c (endif):
* print.c:
* print.c (write_istring):
* print.c (write_ascstring):
* print.c (Fterpri):
* print.c (Fprint):
* print.c (print_error_message):
* print.c (print_vector_internal):
* print.c (print_cons):
* print.c (print_string):
* print.c (printing_unreadable_object):
* print.c (print_internal):
* print.c (print_float):
* print.c (print_symbol):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_canonicalize_host_name):
* process-unix.c (unix_canonicalize_host_name):
* process.c (print_process):
* process.c (report_process_error):
* process.c (report_network_error):
* process.c (make_process_internal):
* process.c (Fstart_process_internal):
* process.c (status_message):
* process.c (putenv_internal):
* process.c (vars_of_process):
* process.h:
* profile.c (vars_of_profile):
* rangetab.c (print_range_table):
* realpath.c (vars_of_realpath):
* redisplay.c (vars_of_redisplay):
* search.c (wordify):
* search.c (Freplace_match):
* sheap.c (sheap_adjust_h):
* sound.c (report_sound_error):
* sound.c (Fplay_sound_file):
* specifier.c (print_specifier):
* symbols.c (Fsubr_name):
* symbols.c (do_symval_forwarding):
* symbols.c (set_default_buffer_slot_variable):
* symbols.c (set_default_console_slot_variable):
* symbols.c (store_symval_forwarding):
* symbols.c (default_value):
* symbols.c (defsymbol_massage_name_1):
* symbols.c (defsymbol_massage_name_nodump):
* symbols.c (defsymbol_massage_name):
* symbols.c (defsymbol_massage_multiword_predicate_nodump):
* symbols.c (defsymbol_massage_multiword_predicate):
* symbols.c (defsymbol_nodump):
* symbols.c (defsymbol):
* symbols.c (defkeyword):
* symbols.c (defkeyword_massage_name):
* symbols.c (check_module_subr):
* symbols.c (deferror_1):
* symbols.c (deferror):
* symbols.c (deferror_massage_name):
* symbols.c (deferror_massage_name_and_message):
* symbols.c (defvar_magic):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* sysdep.c:
* sysdep.c (init_system_name):
* sysdll.c:
* sysdll.c (MAYBE_PREPEND_UNDERSCORE):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (dll_error):
* sysdll.c (dll_open):
* sysdll.c (dll_close):
* sysdll.c (image_for_address):
* sysdll.c (my_find_image):
* sysdll.c (search_linked_libs):
* sysdll.h:
* sysfile.h:
* sysfile.h (DEFAULT_DIRECTORY_FALLBACK):
* syswindows.h:
* tests.c (DFC_CHECK_LENGTH):
* tests.c (DFC_CHECK_CONTENT):
* tests.c (Ftest_hash_tables):
* text.c (vars_of_text):
* text.h:
* tooltalk.c (tt_opnum_string):
* tooltalk.c (tt_message_arg_ival_string):
* tooltalk.c (Ftooltalk_default_procid):
* tooltalk.c (Ftooltalk_default_session):
* tooltalk.c (init_tooltalk):
* tooltalk.c (vars_of_tooltalk):
* ui-gtk.c (Fdll_load):
* ui-gtk.c (type_to_marshaller_type):
* ui-gtk.c (Fgtk_import_function_internal):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* unicode.c (unicode_to_ichar):
* unicode.c (unicode_print):
* unicode.c (unicode_query):
* unicode.c (vars_of_unicode):
* unicode.c (complex_vars_of_unicode):
* win32.c:
* win32.c (mswindows_report_process_error):
* window.c (print_window):
* xemacs.def.in.in:
BASIC IDEA: Further fixing up uses of char * and CIbyte *
to reflect their actual semantics; Mule-izing some code;
redoing of the not-yet-working code to handle message translation.
Clean up code to handle message-translation (not yet working).
Create separate versions of build_msg_string() for working with
Ibyte *, CIbyte *, and Ascbyte * arguments. Assert that Ascbyte *
arguments are pure-ASCII. Make build_msg_string() be the same
as build_msg_ascstring(). Create same three versions of GETTEXT()
and DEFER_GETTEXT(). Also create build_defer_string() and
variants for the equivalent of DEFER_GETTEXT() when building a
string. Remove old CGETTEXT(). Clean up code where GETTEXT(),
DEFER_GETTEXT(), build_msg_string(), etc. was being called and
introduce some new calls to build_msg_string(), etc. Remove
GETTEXT() from calls to weird_doc() -- we assume that the
message snarfer knows about weird_doc(). Remove uses of
DEFER_GETTEXT() from error messages in sysdep.c and instead use
special comments /* @@@begin-snarf@@@ */ and /* @@@end-snarf@@@ */
that the message snarfer presumably knows about.
Create build_ascstring() and use it in many instances in place
of build_string(). The purpose of having Ascbyte * variants is
to make the code more self-documenting in terms of what sort of
semantics is expected for char * strings. In fact in the process
of looking for uses of build_string(), much improperly Mule-ized
was discovered.
Mule-ize a lot of code as described in previous paragraph,
e.g. in sysdep.c.
Make the error functions take Ascbyte * strings and fix up a
couple of places where non-pure-ASCII strings were being passed in
(file-coding.c, mule-coding.c, unicode.c). (It's debatable whether
we really need to make the error functions work this way. It
helps catch places where code is written in a way that message
translation won't work, but we may well never implement message
translation.)
Make staticpro() and friends take Ascbyte * strings instead of
raw char * strings. Create a const_Ascbyte_ptr dynarr type
to describe what's held by staticpro_names[] and friends,
create pdump descriptions for const_Ascbyte_ptr dynarrs, and
use them in place of specially-crafted staticpro descriptions.
Mule-ize certain other functions (e.g. x_event_name) by correcting
raw use of char * to Ascbyte *, Rawbyte * or another such type,
and raw use of char[] buffers to another type (usually Ascbyte[]).
Change many uses of write_c_string() to write_msg_string(),
write_ascstring(), etc.
Mule-ize emodules.c, emodules.h, sysdll.h.
Fix some un-Mule-ized code in intl-win32.c.
A comment in event-Xt.c and the limitations of the message
snarfer (make-msgfile or whatever) is presumably incorrect --
it should be smart enough to handle function calls spread over
more than one line. Clean up code in event-Xt.c that was
written awkwardly for this reason.
In config.h.in, instead of NEED_ERROR_CHECK_TYPES_INLINES,
create a more general XEMACS_DEFS_NEEDS_INLINE_DECLS to
indicate when inlined functions need to be declared in
xemacs.defs.in.in, and make use of it in xemacs.defs.in.in.
We need to do this because postgresql.c now calls qxestrdup(),
which is an inline function.
Make nconc2() and other such functions MODULE_API and put
them in xemacs.defs.in.in since postgresql.c now uses them.
Clean up indentation in lread.c and a few other places.
In text.h, document ASSERT_ASCTEXT_ASCII() and
ASSERT_ASCTEXT_ASCII_LEN(), group together the stand-in
encodings and add some more for DLL symbols, function and
variable names, etc.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Tue, 26 Jan 2010 23:22:30 -0600 |
| parents | 714f7c9fabb1 |
| children | cbe181529c34 |
| rev | line source |
|---|---|
| 3092 | 1 /* New incremental garbage collector for XEmacs. |
| 2 Copyright (C) 2005 Marcus Crestani. | |
|
4934
714f7c9fabb1
make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents:
4502
diff
changeset
|
3 Copyright (C) 2010 Ben Wing. |
| 3092 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not in FSF. */ | |
| 23 | |
| 24 #include <config.h> | |
| 25 #include "lisp.h" | |
| 26 | |
| 27 #include "backtrace.h" | |
| 28 #include "buffer.h" | |
| 29 #include "bytecode.h" | |
| 30 #include "chartab.h" | |
| 31 #include "console-stream.h" | |
| 32 #include "device.h" | |
| 33 #include "elhash.h" | |
| 34 #include "events.h" | |
| 35 #include "extents-impl.h" | |
| 36 #include "file-coding.h" | |
| 37 #include "frame-impl.h" | |
| 38 #include "gc.h" | |
| 39 #include "glyphs.h" | |
| 40 #include "opaque.h" | |
| 41 #include "lrecord.h" | |
| 42 #include "lstream.h" | |
| 43 #include "process.h" | |
| 44 #include "profile.h" | |
| 45 #include "redisplay.h" | |
| 46 #include "specifier.h" | |
| 47 #include "sysfile.h" | |
| 48 #include "sysdep.h" | |
| 49 #include "window.h" | |
| 50 #include "vdb.h" | |
| 51 | |
| 52 | |
| 53 #define GC_CONS_THRESHOLD 2000000 | |
| 54 #define GC_CONS_INCREMENTAL_THRESHOLD 200000 | |
| 55 #define GC_INCREMENTAL_TRAVERSAL_THRESHOLD 100000 | |
| 56 | |
| 57 /* Number of bytes of consing done since the last GC. */ | |
| 58 EMACS_INT consing_since_gc; | |
| 59 | |
| 60 /* Number of bytes of consing done since startup. */ | |
| 61 EMACS_UINT total_consing; | |
| 62 | |
| 63 /* Number of bytes of current allocated heap objects. */ | |
| 64 EMACS_INT total_gc_usage; | |
| 65 | |
| 66 /* If the above is set. */ | |
| 67 int total_gc_usage_set; | |
| 68 | |
| 69 /* Number of bytes of consing since gc before another gc should be done. */ | |
| 70 EMACS_INT gc_cons_threshold; | |
| 71 | |
| 72 /* Nonzero during gc */ | |
| 73 int gc_in_progress; | |
| 74 | |
| 75 /* Percentage of consing of total data size before another GC. */ | |
| 76 EMACS_INT gc_cons_percentage; | |
| 77 | |
| 78 #ifdef NEW_GC | |
| 79 /* Number of bytes of consing since gc before another cycle of the gc | |
| 80 should be done in incremental mode. */ | |
| 81 EMACS_INT gc_cons_incremental_threshold; | |
| 82 | |
| 83 /* Number of elements marked in one cycle of incremental GC. */ | |
| 84 EMACS_INT gc_incremental_traversal_threshold; | |
| 85 | |
| 86 /* Nonzero during write barrier */ | |
| 87 int write_barrier_enabled; | |
| 88 #endif /* NEW_GC */ | |
| 89 | |
| 90 | |
| 91 | |
| 92 #ifdef NEW_GC | |
| 93 /************************************************************************/ | |
| 94 /* Incremental State and Statistics */ | |
| 95 /************************************************************************/ | |
| 96 | |
| 97 enum gc_phase | |
| 98 { | |
| 99 NONE, | |
| 100 INIT_GC, | |
| 101 PUSH_ROOT_SET, | |
| 102 MARK, | |
| 103 REPUSH_ROOT_SET, | |
| 104 FINISH_MARK, | |
| 105 FINALIZE, | |
| 106 SWEEP, | |
| 107 FINISH_GC | |
| 108 }; | |
| 109 | |
| 110 #ifndef ERROR_CHECK_GC | |
| 4124 | 111 typedef struct gc_state_type |
| 3092 | 112 { |
| 113 enum gc_phase phase; | |
| 4124 | 114 } gc_state_type; |
| 3092 | 115 #else /* ERROR_CHECK_GC */ |
| 116 enum gc_stat_id | |
| 117 { | |
| 118 GC_STAT_TOTAL, | |
| 119 GC_STAT_IN_LAST_GC, | |
| 120 GC_STAT_IN_THIS_GC, | |
| 121 GC_STAT_IN_LAST_CYCLE, | |
| 122 GC_STAT_IN_THIS_CYCLE, | |
| 123 GC_STAT_COUNT /* has to be last */ | |
| 124 }; | |
| 125 | |
| 4124 | 126 typedef struct gc_state_type |
| 3092 | 127 { |
| 128 enum gc_phase phase; | |
| 3313 | 129 double n_gc[GC_STAT_COUNT]; |
| 130 double n_cycles[GC_STAT_COUNT]; | |
| 131 double enqueued[GC_STAT_COUNT]; | |
| 132 double dequeued[GC_STAT_COUNT]; | |
| 133 double repushed[GC_STAT_COUNT]; | |
| 134 double enqueued2[GC_STAT_COUNT]; | |
| 135 double dequeued2[GC_STAT_COUNT]; | |
| 136 double finalized[GC_STAT_COUNT]; | |
| 137 double freed[GC_STAT_COUNT]; | |
| 4124 | 138 } gc_state_type; |
| 3092 | 139 #endif /* ERROR_CHECK_GC */ |
| 140 | |
| 4124 | 141 gc_state_type gc_state; |
| 142 | |
| 3092 | 143 #define GC_PHASE gc_state.phase |
| 144 #define GC_SET_PHASE(p) GC_PHASE = p | |
| 145 | |
| 146 #ifdef ERROR_CHECK_GC | |
| 147 # define GC_STAT_START_NEW_GC gc_stat_start_new_gc () | |
| 148 # define GC_STAT_RESUME_GC gc_stat_resume_gc () | |
| 149 | |
| 150 #define GC_STAT_TICK(STAT) \ | |
| 151 gc_state.STAT[GC_STAT_TOTAL]++; \ | |
| 152 gc_state.STAT[GC_STAT_IN_THIS_GC]++; \ | |
| 153 gc_state.STAT[GC_STAT_IN_THIS_CYCLE]++ | |
| 154 | |
| 155 # define GC_STAT_ENQUEUED \ | |
| 156 if (GC_PHASE == REPUSH_ROOT_SET) \ | |
| 157 { \ | |
| 158 GC_STAT_TICK (enqueued2); \ | |
| 159 } \ | |
| 160 else \ | |
| 161 { \ | |
| 162 GC_STAT_TICK (enqueued); \ | |
| 163 } | |
| 164 | |
| 165 # define GC_STAT_DEQUEUED \ | |
| 166 if (gc_state.phase == REPUSH_ROOT_SET) \ | |
| 167 { \ | |
| 168 GC_STAT_TICK (dequeued2); \ | |
| 169 } \ | |
| 170 else \ | |
| 171 { \ | |
| 172 GC_STAT_TICK (dequeued); \ | |
| 173 } | |
| 174 # define GC_STAT_REPUSHED GC_STAT_TICK (repushed) | |
| 175 | |
| 176 #define GC_STAT_RESUME(stat) \ | |
| 177 gc_state.stat[GC_STAT_IN_LAST_CYCLE] = \ | |
| 178 gc_state.stat[GC_STAT_IN_THIS_CYCLE]; \ | |
| 179 gc_state.stat[GC_STAT_IN_THIS_CYCLE] = 0 | |
| 180 | |
| 181 #define GC_STAT_RESTART(stat) \ | |
| 182 gc_state.stat[GC_STAT_IN_LAST_GC] = \ | |
| 183 gc_state.stat[GC_STAT_IN_THIS_GC]; \ | |
| 184 gc_state.stat[GC_STAT_IN_THIS_GC] = 0; \ | |
| 185 GC_STAT_RESUME (stat) | |
| 186 | |
| 187 void | |
| 188 gc_stat_start_new_gc (void) | |
| 189 { | |
| 190 gc_state.n_gc[GC_STAT_TOTAL]++; | |
| 191 gc_state.n_cycles[GC_STAT_TOTAL]++; | |
| 192 gc_state.n_cycles[GC_STAT_IN_LAST_GC] = gc_state.n_cycles[GC_STAT_IN_THIS_GC]; | |
| 193 gc_state.n_cycles[GC_STAT_IN_THIS_GC] = 1; | |
| 194 | |
| 195 GC_STAT_RESTART (enqueued); | |
| 196 GC_STAT_RESTART (dequeued); | |
| 197 GC_STAT_RESTART (repushed); | |
| 198 GC_STAT_RESTART (finalized); | |
| 199 GC_STAT_RESTART (enqueued2); | |
| 200 GC_STAT_RESTART (dequeued2); | |
| 201 GC_STAT_RESTART (freed); | |
| 202 } | |
| 203 | |
| 204 void | |
| 205 gc_stat_resume_gc (void) | |
| 206 { | |
| 207 gc_state.n_cycles[GC_STAT_TOTAL]++; | |
| 208 gc_state.n_cycles[GC_STAT_IN_THIS_GC]++; | |
| 209 GC_STAT_RESUME (enqueued); | |
| 210 GC_STAT_RESUME (dequeued); | |
| 211 GC_STAT_RESUME (repushed); | |
| 212 GC_STAT_RESUME (finalized); | |
| 213 GC_STAT_RESUME (enqueued2); | |
| 214 GC_STAT_RESUME (dequeued2); | |
| 215 GC_STAT_RESUME (freed); | |
| 216 } | |
| 217 | |
| 218 void | |
| 219 gc_stat_finalized (void) | |
| 220 { | |
| 221 GC_STAT_TICK (finalized); | |
| 222 } | |
| 223 | |
| 224 void | |
| 225 gc_stat_freed (void) | |
| 226 { | |
| 227 GC_STAT_TICK (freed); | |
| 228 } | |
| 229 | |
| 230 DEFUN("gc-stats", Fgc_stats, 0, 0 ,"", /* | |
| 231 Return statistics about garbage collection cycles in a property list. | |
| 232 */ | |
| 233 ()) | |
| 234 { | |
| 235 Lisp_Object pl = Qnil; | |
| 236 #define PL(name,value) \ | |
| 3313 | 237 pl = cons3 (intern (name), make_float (gc_state.value), pl) |
| 3092 | 238 |
| 239 PL ("freed-in-this-cycle", freed[GC_STAT_IN_THIS_CYCLE]); | |
| 240 PL ("freed-in-this-gc", freed[GC_STAT_IN_THIS_GC]); | |
| 241 PL ("freed-in-last-cycle", freed[GC_STAT_IN_LAST_CYCLE]); | |
| 242 PL ("freed-in-last-gc", freed[GC_STAT_IN_LAST_GC]); | |
| 243 PL ("freed-total", freed[GC_STAT_TOTAL]); | |
| 244 PL ("finalized-in-this-cycle", finalized[GC_STAT_IN_THIS_CYCLE]); | |
| 245 PL ("finalized-in-this-gc", finalized[GC_STAT_IN_THIS_GC]); | |
| 246 PL ("finalized-in-last-cycle", finalized[GC_STAT_IN_LAST_CYCLE]); | |
| 247 PL ("finalized-in-last-gc", finalized[GC_STAT_IN_LAST_GC]); | |
| 248 PL ("finalized-total", finalized[GC_STAT_TOTAL]); | |
| 249 PL ("repushed-in-this-cycle", repushed[GC_STAT_IN_THIS_CYCLE]); | |
| 250 PL ("repushed-in-this-gc", repushed[GC_STAT_IN_THIS_GC]); | |
| 251 PL ("repushed-in-last-cycle", repushed[GC_STAT_IN_LAST_CYCLE]); | |
| 252 PL ("repushed-in-last-gc", repushed[GC_STAT_IN_LAST_GC]); | |
| 253 PL ("repushed-total", repushed[GC_STAT_TOTAL]); | |
| 254 PL ("dequeued2-in-this-cycle", dequeued2[GC_STAT_IN_THIS_CYCLE]); | |
| 255 PL ("dequeued2-in-this-gc", dequeued2[GC_STAT_IN_THIS_GC]); | |
| 256 PL ("dequeued2-in-last-cycle", dequeued2[GC_STAT_IN_LAST_CYCLE]); | |
| 257 PL ("dequeued2-in-last-gc", dequeued2[GC_STAT_IN_LAST_GC]); | |
| 258 PL ("dequeued2-total", dequeued2[GC_STAT_TOTAL]); | |
| 259 PL ("enqueued2-in-this-cycle", enqueued2[GC_STAT_IN_THIS_CYCLE]); | |
| 260 PL ("enqueued2-in-this-gc", enqueued2[GC_STAT_IN_THIS_GC]); | |
| 261 PL ("enqueued2-in-last-cycle", enqueued2[GC_STAT_IN_LAST_CYCLE]); | |
| 262 PL ("enqueued2-in-last-gc", enqueued2[GC_STAT_IN_LAST_GC]); | |
| 263 PL ("enqueued2-total", enqueued2[GC_STAT_TOTAL]); | |
| 264 PL ("dequeued-in-this-cycle", dequeued[GC_STAT_IN_THIS_CYCLE]); | |
| 265 PL ("dequeued-in-this-gc", dequeued[GC_STAT_IN_THIS_GC]); | |
| 266 PL ("dequeued-in-last-cycle", dequeued[GC_STAT_IN_LAST_CYCLE]); | |
| 267 PL ("dequeued-in-last-gc", dequeued[GC_STAT_IN_LAST_GC]); | |
| 268 PL ("dequeued-total", dequeued[GC_STAT_TOTAL]); | |
| 269 PL ("enqueued-in-this-cycle", enqueued[GC_STAT_IN_THIS_CYCLE]); | |
| 270 PL ("enqueued-in-this-gc", enqueued[GC_STAT_IN_THIS_GC]); | |
| 271 PL ("enqueued-in-last-cycle", enqueued[GC_STAT_IN_LAST_CYCLE]); | |
| 272 PL ("enqueued-in-last-gc", enqueued[GC_STAT_IN_LAST_GC]); | |
| 273 PL ("enqueued-total", enqueued[GC_STAT_TOTAL]); | |
| 274 PL ("n-cycles-in-this-gc", n_cycles[GC_STAT_IN_THIS_GC]); | |
| 275 PL ("n-cycles-in-last-gc", n_cycles[GC_STAT_IN_LAST_GC]); | |
| 276 PL ("n-cycles-total", n_cycles[GC_STAT_TOTAL]); | |
| 277 PL ("n-gc-total", n_gc[GC_STAT_TOTAL]); | |
| 278 PL ("phase", phase); | |
| 279 return pl; | |
| 280 } | |
| 281 #else /* not ERROR_CHECK_GC */ | |
| 282 # define GC_STAT_START_NEW_GC | |
| 283 # define GC_STAT_RESUME_GC | |
| 284 # define GC_STAT_ENQUEUED | |
| 285 # define GC_STAT_DEQUEUED | |
| 286 # define GC_STAT_REPUSHED | |
| 287 # define GC_STAT_REMOVED | |
| 288 #endif /* not ERROR_CHECK_GC */ | |
| 289 #endif /* NEW_GC */ | |
| 290 | |
| 291 | |
| 292 /************************************************************************/ | |
| 293 /* Recompute need to garbage collect */ | |
| 294 /************************************************************************/ | |
| 295 | |
| 296 int need_to_garbage_collect; | |
| 297 | |
| 298 #ifdef ERROR_CHECK_GC | |
| 299 int always_gc = 0; /* Debugging hack; equivalent to | |
| 300 (setq gc-cons-thresold -1) */ | |
| 301 #else | |
| 302 #define always_gc 0 | |
| 303 #endif | |
| 304 | |
| 305 /* True if it's time to garbage collect now. */ | |
| 306 void | |
| 307 recompute_need_to_garbage_collect (void) | |
| 308 { | |
| 309 if (always_gc) | |
| 310 need_to_garbage_collect = 1; | |
| 311 else | |
| 312 need_to_garbage_collect = | |
| 313 #ifdef NEW_GC | |
| 314 write_barrier_enabled ? | |
| 315 (consing_since_gc > gc_cons_incremental_threshold) : | |
| 316 #endif /* NEW_GC */ | |
| 317 (consing_since_gc > gc_cons_threshold | |
| 318 && | |
| 319 #if 0 /* #### implement this better */ | |
| 4115 | 320 ((double)consing_since_gc) / total_data_usage()) >= |
| 321 ((double)gc_cons_percentage / 100) | |
| 3092 | 322 #else |
| 323 (!total_gc_usage_set || | |
| 4115 | 324 ((double)consing_since_gc / total_gc_usage) >= |
| 325 ((double)gc_cons_percentage / 100)) | |
| 3092 | 326 #endif |
| 327 ); | |
| 328 recompute_funcall_allocation_flag (); | |
| 329 } | |
| 330 | |
| 331 | |
| 332 | |
| 333 /************************************************************************/ | |
| 334 /* Mark Phase */ | |
| 335 /************************************************************************/ | |
| 336 | |
| 337 static const struct memory_description lisp_object_description_1[] = { | |
| 338 { XD_LISP_OBJECT, 0 }, | |
| 339 { XD_END } | |
| 340 }; | |
| 341 | |
| 342 const struct sized_memory_description lisp_object_description = { | |
| 343 sizeof (Lisp_Object), | |
| 344 lisp_object_description_1 | |
| 345 }; | |
| 346 | |
| 347 #if defined (USE_KKCC) || defined (PDUMP) | |
| 348 | |
| 349 /* This function extracts the value of a count variable described somewhere | |
| 350 else in the description. It is converted corresponding to the type */ | |
| 351 EMACS_INT | |
| 352 lispdesc_indirect_count_1 (EMACS_INT code, | |
| 353 const struct memory_description *idesc, | |
| 354 const void *idata) | |
| 355 { | |
| 356 EMACS_INT count; | |
| 357 const void *irdata; | |
| 358 | |
| 359 int line = XD_INDIRECT_VAL (code); | |
| 360 int delta = XD_INDIRECT_DELTA (code); | |
| 361 | |
| 362 irdata = ((char *) idata) + | |
| 363 lispdesc_indirect_count (idesc[line].offset, idesc, idata); | |
| 364 switch (idesc[line].type) | |
| 365 { | |
| 366 case XD_BYTECOUNT: | |
| 367 count = * (Bytecount *) irdata; | |
| 368 break; | |
| 369 case XD_ELEMCOUNT: | |
| 370 count = * (Elemcount *) irdata; | |
| 371 break; | |
| 372 case XD_HASHCODE: | |
| 373 count = * (Hashcode *) irdata; | |
| 374 break; | |
| 375 case XD_INT: | |
| 376 count = * (int *) irdata; | |
| 377 break; | |
| 378 case XD_LONG: | |
| 379 count = * (long *) irdata; | |
| 380 break; | |
| 381 default: | |
| 382 stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n", | |
| 383 idesc[line].type, line, (long) code); | |
| 384 #if defined(USE_KKCC) && defined(DEBUG_XEMACS) | |
| 385 if (gc_in_progress) | |
| 386 kkcc_backtrace (); | |
| 387 #endif | |
| 388 #ifdef PDUMP | |
| 389 if (in_pdump) | |
| 390 pdump_backtrace (); | |
| 391 #endif | |
| 392 count = 0; /* warning suppression */ | |
| 393 ABORT (); | |
| 394 } | |
| 395 count += delta; | |
| 396 return count; | |
| 397 } | |
| 398 | |
| 399 /* SDESC is a "description map" (basically, a list of offsets used for | |
| 400 successive indirections) and OBJ is the first object to indirect off of. | |
| 401 Return the description ultimately found. */ | |
| 402 | |
| 403 const struct sized_memory_description * | |
| 404 lispdesc_indirect_description_1 (const void *obj, | |
| 405 const struct sized_memory_description *sdesc) | |
| 406 { | |
| 407 int pos; | |
| 408 | |
| 409 for (pos = 0; sdesc[pos].size >= 0; pos++) | |
| 410 obj = * (const void **) ((const char *) obj + sdesc[pos].size); | |
| 411 | |
| 412 return (const struct sized_memory_description *) obj; | |
| 413 } | |
| 414 | |
| 415 /* Compute the size of the data at RDATA, described by a single entry | |
| 416 DESC1 in a description array. OBJ and DESC are used for | |
| 417 XD_INDIRECT references. */ | |
| 418 | |
| 419 static Bytecount | |
| 420 lispdesc_one_description_line_size (void *rdata, | |
| 421 const struct memory_description *desc1, | |
| 422 const void *obj, | |
| 423 const struct memory_description *desc) | |
| 424 { | |
| 425 union_switcheroo: | |
| 426 switch (desc1->type) | |
| 427 { | |
| 428 case XD_LISP_OBJECT_ARRAY: | |
| 429 { | |
| 430 EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); | |
| 431 return (val * sizeof (Lisp_Object)); | |
| 432 } | |
| 433 case XD_LISP_OBJECT: | |
| 434 case XD_LO_LINK: | |
| 435 return sizeof (Lisp_Object); | |
| 436 case XD_OPAQUE_PTR: | |
| 437 return sizeof (void *); | |
| 438 #ifdef NEW_GC | |
| 439 case XD_LISP_OBJECT_BLOCK_PTR: | |
| 440 #endif /* NEW_GC */ | |
| 441 case XD_BLOCK_PTR: | |
| 442 { | |
| 443 EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); | |
| 444 return val * sizeof (void *); | |
| 445 } | |
| 446 case XD_BLOCK_ARRAY: | |
| 447 { | |
| 448 EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); | |
| 449 | |
| 450 return (val * | |
| 451 lispdesc_block_size | |
| 452 (rdata, | |
| 453 lispdesc_indirect_description (obj, desc1->data2.descr))); | |
| 454 } | |
| 455 case XD_OPAQUE_DATA_PTR: | |
| 456 return sizeof (void *); | |
| 457 case XD_UNION_DYNAMIC_SIZE: | |
| 458 { | |
| 459 /* If an explicit size was given in the first-level structure | |
| 460 description, use it; else compute size based on current union | |
| 461 constant. */ | |
| 462 const struct sized_memory_description *sdesc = | |
| 463 lispdesc_indirect_description (obj, desc1->data2.descr); | |
| 464 if (sdesc->size) | |
| 465 return sdesc->size; | |
| 466 else | |
| 467 { | |
| 468 desc1 = lispdesc_process_xd_union (desc1, desc, obj); | |
| 469 if (desc1) | |
| 470 goto union_switcheroo; | |
| 471 break; | |
| 472 } | |
| 473 } | |
| 474 case XD_UNION: | |
| 475 { | |
| 476 /* If an explicit size was given in the first-level structure | |
| 477 description, use it; else compute size based on maximum of all | |
| 478 possible structures. */ | |
| 479 const struct sized_memory_description *sdesc = | |
| 480 lispdesc_indirect_description (obj, desc1->data2.descr); | |
| 481 if (sdesc->size) | |
| 482 return sdesc->size; | |
| 483 else | |
| 484 { | |
| 485 int count; | |
| 486 Bytecount max_size = -1, size; | |
| 487 | |
| 488 desc1 = sdesc->description; | |
| 489 | |
| 490 for (count = 0; desc1[count].type != XD_END; count++) | |
| 491 { | |
| 492 size = lispdesc_one_description_line_size (rdata, | |
| 493 &desc1[count], | |
| 494 obj, desc); | |
| 495 if (size > max_size) | |
| 496 max_size = size; | |
| 497 } | |
| 498 return max_size; | |
| 499 } | |
| 500 } | |
| 501 case XD_ASCII_STRING: | |
| 502 return sizeof (void *); | |
| 503 case XD_DOC_STRING: | |
| 504 return sizeof (void *); | |
| 505 case XD_INT_RESET: | |
| 506 return sizeof (int); | |
| 507 case XD_BYTECOUNT: | |
| 508 return sizeof (Bytecount); | |
| 509 case XD_ELEMCOUNT: | |
| 510 return sizeof (Elemcount); | |
| 511 case XD_HASHCODE: | |
| 512 return sizeof (Hashcode); | |
| 513 case XD_INT: | |
| 514 return sizeof (int); | |
| 515 case XD_LONG: | |
| 516 return sizeof (long); | |
| 517 default: | |
| 518 stderr_out ("Unsupported dump type : %d\n", desc1->type); | |
| 519 ABORT (); | |
| 520 } | |
| 521 | |
| 522 return 0; | |
| 523 } | |
| 524 | |
| 525 | |
| 526 /* Return the size of the memory block (NOT necessarily a structure!) | |
| 527 described by SDESC and pointed to by OBJ. If SDESC records an | |
| 528 explicit size (i.e. non-zero), it is simply returned; otherwise, | |
| 529 the size is calculated by the maximum offset and the size of the | |
| 530 object at that offset, rounded up to the maximum alignment. In | |
| 531 this case, we may need the object, for example when retrieving an | |
| 532 "indirect count" of an inlined array (the count is not constant, | |
| 533 but is specified by one of the elements of the memory block). (It | |
| 534 is generally not a problem if we return an overly large size -- we | |
| 535 will simply end up reserving more space than necessary; but if the | |
| 536 size is too small we could be in serious trouble, in particular | |
| 537 with nested inlined structures, where there may be alignment | |
| 538 padding in the middle of a block. #### In fact there is an (at | |
| 539 least theoretical) problem with an overly large size -- we may | |
| 540 trigger a protection fault when reading from invalid memory. We | |
| 541 need to handle this -- perhaps in a stupid but dependable way, | |
| 542 i.e. by trapping SIGSEGV and SIGBUS.) */ | |
| 543 | |
| 544 Bytecount | |
| 545 lispdesc_block_size_1 (const void *obj, Bytecount size, | |
| 546 const struct memory_description *desc) | |
| 547 { | |
| 548 EMACS_INT max_offset = -1; | |
| 549 int max_offset_pos = -1; | |
| 550 int pos; | |
| 551 | |
| 552 if (size) | |
| 553 return size; | |
| 554 | |
| 555 for (pos = 0; desc[pos].type != XD_END; pos++) | |
| 556 { | |
| 557 EMACS_INT offset = lispdesc_indirect_count (desc[pos].offset, desc, obj); | |
| 558 if (offset == max_offset) | |
| 559 { | |
| 560 stderr_out ("Two relocatable elements at same offset?\n"); | |
| 561 ABORT (); | |
| 562 } | |
| 563 else if (offset > max_offset) | |
| 564 { | |
| 565 max_offset = offset; | |
| 566 max_offset_pos = pos; | |
| 567 } | |
| 568 } | |
| 569 | |
| 570 if (max_offset_pos < 0) | |
| 571 return 0; | |
| 572 | |
| 573 { | |
| 574 Bytecount size_at_max; | |
| 575 size_at_max = | |
| 576 lispdesc_one_description_line_size ((char *) obj + max_offset, | |
| 577 &desc[max_offset_pos], obj, desc); | |
| 578 | |
| 579 /* We have no way of knowing the required alignment for this structure, | |
| 580 so just make it maximally aligned. */ | |
| 581 return MAX_ALIGN_SIZE (max_offset + size_at_max); | |
| 582 } | |
| 583 } | |
| 584 #endif /* defined (USE_KKCC) || defined (PDUMP) */ | |
| 585 | |
| 3263 | 586 #ifdef NEW_GC |
| 3092 | 587 #define GC_CHECK_NOT_FREE(lheader) \ |
| 588 gc_checking_assert (! LRECORD_FREE_P (lheader)); | |
| 3263 | 589 #else /* not NEW_GC */ |
| 3092 | 590 #define GC_CHECK_NOT_FREE(lheader) \ |
| 591 gc_checking_assert (! LRECORD_FREE_P (lheader)); \ | |
| 592 gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || \ | |
| 593 ! ((struct old_lcrecord_header *) lheader)->free) | |
| 3263 | 594 #endif /* not NEW_GC */ |
| 3092 | 595 |
| 596 #ifdef USE_KKCC | |
| 597 /* The following functions implement the new mark algorithm. | |
| 598 They mark objects according to their descriptions. They | |
| 599 are modeled on the corresponding pdumper procedures. */ | |
| 600 | |
| 601 #if 0 | |
| 602 # define KKCC_STACK_AS_QUEUE 1 | |
| 603 #endif | |
| 604 | |
| 605 #ifdef DEBUG_XEMACS | |
| 606 /* The backtrace for the KKCC mark functions. */ | |
| 607 #define KKCC_INIT_BT_STACK_SIZE 4096 | |
| 608 | |
| 609 typedef struct | |
| 610 { | |
| 611 void *obj; | |
| 612 const struct memory_description *desc; | |
| 613 int pos; | |
| 614 } kkcc_bt_stack_entry; | |
| 615 | |
| 616 static kkcc_bt_stack_entry *kkcc_bt; | |
| 617 static int kkcc_bt_stack_size; | |
| 618 static int kkcc_bt_depth = 0; | |
| 619 | |
| 620 static void | |
| 621 kkcc_bt_init (void) | |
| 622 { | |
| 623 kkcc_bt_depth = 0; | |
| 624 kkcc_bt_stack_size = KKCC_INIT_BT_STACK_SIZE; | |
| 625 kkcc_bt = (kkcc_bt_stack_entry *) | |
| 626 xmalloc_and_zero (kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry)); | |
| 627 if (!kkcc_bt) | |
| 628 { | |
| 629 stderr_out ("KKCC backtrace stack init failed for size %d\n", | |
| 630 kkcc_bt_stack_size); | |
| 631 ABORT (); | |
| 632 } | |
| 633 } | |
| 634 | |
| 635 void | |
| 636 kkcc_backtrace (void) | |
| 637 { | |
| 638 int i; | |
| 639 stderr_out ("KKCC mark stack backtrace :\n"); | |
| 640 for (i = kkcc_bt_depth - 1; i >= 0; i--) | |
| 641 { | |
| 642 Lisp_Object obj = wrap_pointer_1 (kkcc_bt[i].obj); | |
| 643 stderr_out (" [%d]", i); | |
| 644 if ((XRECORD_LHEADER (obj)->type >= lrecord_type_last_built_in_type) | |
| 645 || (!LRECORDP (obj)) | |
| 646 || (!XRECORD_LHEADER_IMPLEMENTATION (obj))) | |
| 647 { | |
| 648 stderr_out (" non Lisp Object"); | |
| 649 } | |
| 650 else | |
| 651 { | |
| 652 stderr_out (" %s", | |
| 653 XRECORD_LHEADER_IMPLEMENTATION (obj)->name); | |
| 654 } | |
| 3519 | 655 stderr_out (" (addr: %p, desc: %p, ", |
| 656 (void *) kkcc_bt[i].obj, | |
| 657 (void *) kkcc_bt[i].desc); | |
| 3092 | 658 if (kkcc_bt[i].pos >= 0) |
| 659 stderr_out ("pos: %d)\n", kkcc_bt[i].pos); | |
| 660 else | |
| 661 if (kkcc_bt[i].pos == -1) | |
| 662 stderr_out ("root set)\n"); | |
| 663 else if (kkcc_bt[i].pos == -2) | |
| 664 stderr_out ("dirty object)\n"); | |
| 665 } | |
| 666 } | |
| 667 | |
| 668 static void | |
| 669 kkcc_bt_stack_realloc (void) | |
| 670 { | |
| 671 kkcc_bt_stack_size *= 2; | |
| 672 kkcc_bt = (kkcc_bt_stack_entry *) | |
| 673 xrealloc (kkcc_bt, kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry)); | |
| 674 if (!kkcc_bt) | |
| 675 { | |
| 676 stderr_out ("KKCC backtrace stack realloc failed for size %d\n", | |
| 677 kkcc_bt_stack_size); | |
| 678 ABORT (); | |
| 679 } | |
| 680 } | |
| 681 | |
| 682 static void | |
| 683 kkcc_bt_free (void) | |
| 684 { | |
| 685 xfree_1 (kkcc_bt); | |
| 686 kkcc_bt = 0; | |
| 687 kkcc_bt_stack_size = 0; | |
| 688 } | |
| 689 | |
| 690 static void | |
| 691 kkcc_bt_push (void *obj, const struct memory_description *desc, | |
| 692 int level, int pos) | |
| 693 { | |
| 694 kkcc_bt_depth = level; | |
| 695 kkcc_bt[kkcc_bt_depth].obj = obj; | |
| 696 kkcc_bt[kkcc_bt_depth].desc = desc; | |
| 697 kkcc_bt[kkcc_bt_depth].pos = pos; | |
| 698 kkcc_bt_depth++; | |
| 699 if (kkcc_bt_depth >= kkcc_bt_stack_size) | |
| 700 kkcc_bt_stack_realloc (); | |
| 701 } | |
| 702 | |
| 703 #else /* not DEBUG_XEMACS */ | |
| 704 #define kkcc_bt_init() | |
| 705 #define kkcc_bt_push(obj, desc, level, pos) | |
| 706 #endif /* not DEBUG_XEMACS */ | |
| 707 | |
| 708 /* Object memory descriptions are in the lrecord_implementation structure. | |
| 709 But copying them to a parallel array is much more cache-friendly. */ | |
| 710 const struct memory_description *lrecord_memory_descriptions[countof (lrecord_implementations_table)]; | |
| 711 | |
| 712 /* the initial stack size in kkcc_gc_stack_entries */ | |
| 713 #define KKCC_INIT_GC_STACK_SIZE 16384 | |
| 714 | |
| 715 typedef struct | |
| 716 { | |
| 717 void *data; | |
| 718 const struct memory_description *desc; | |
| 719 #ifdef DEBUG_XEMACS | |
| 720 int level; | |
| 721 int pos; | |
| 722 #endif | |
| 723 } kkcc_gc_stack_entry; | |
| 724 | |
| 725 | |
| 726 static kkcc_gc_stack_entry *kkcc_gc_stack_ptr; | |
| 727 static int kkcc_gc_stack_front; | |
| 728 static int kkcc_gc_stack_rear; | |
| 729 static int kkcc_gc_stack_size; | |
| 730 | |
| 731 #define KKCC_INC(i) ((i + 1) % kkcc_gc_stack_size) | |
| 732 #define KKCC_INC2(i) ((i + 2) % kkcc_gc_stack_size) | |
| 733 | |
| 734 #define KKCC_GC_STACK_FULL (KKCC_INC2 (kkcc_gc_stack_rear) == kkcc_gc_stack_front) | |
| 735 #define KKCC_GC_STACK_EMPTY (KKCC_INC (kkcc_gc_stack_rear) == kkcc_gc_stack_front) | |
| 736 | |
| 737 static void | |
| 738 kkcc_gc_stack_init (void) | |
| 739 { | |
| 740 kkcc_gc_stack_size = KKCC_INIT_GC_STACK_SIZE; | |
| 741 kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *) | |
| 742 xmalloc_and_zero (kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry)); | |
| 743 if (!kkcc_gc_stack_ptr) | |
| 744 { | |
| 745 stderr_out ("stack init failed for size %d\n", kkcc_gc_stack_size); | |
| 746 ABORT (); | |
| 747 } | |
| 748 kkcc_gc_stack_front = 0; | |
| 749 kkcc_gc_stack_rear = kkcc_gc_stack_size - 1; | |
| 750 } | |
| 751 | |
| 752 static void | |
| 753 kkcc_gc_stack_free (void) | |
| 754 { | |
| 755 xfree_1 (kkcc_gc_stack_ptr); | |
| 756 kkcc_gc_stack_ptr = 0; | |
| 757 kkcc_gc_stack_front = 0; | |
| 758 kkcc_gc_stack_rear = 0; | |
| 759 kkcc_gc_stack_size = 0; | |
| 760 } | |
| 761 | |
| 762 static void | |
| 763 kkcc_gc_stack_realloc (void) | |
| 764 { | |
| 765 kkcc_gc_stack_entry *old_ptr = kkcc_gc_stack_ptr; | |
| 766 int old_size = kkcc_gc_stack_size; | |
| 767 kkcc_gc_stack_size *= 2; | |
| 768 kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *) | |
| 769 xmalloc_and_zero (kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry)); | |
| 770 if (!kkcc_gc_stack_ptr) | |
| 771 { | |
| 772 stderr_out ("stack realloc failed for size %d\n", kkcc_gc_stack_size); | |
| 773 ABORT (); | |
| 774 } | |
| 775 if (kkcc_gc_stack_rear >= kkcc_gc_stack_front) | |
| 776 { | |
| 777 int number_elements = kkcc_gc_stack_rear - kkcc_gc_stack_front + 1; | |
| 778 memcpy (kkcc_gc_stack_ptr, &old_ptr[kkcc_gc_stack_front], | |
| 779 number_elements * sizeof (kkcc_gc_stack_entry)); | |
| 780 kkcc_gc_stack_front = 0; | |
| 781 kkcc_gc_stack_rear = number_elements - 1; | |
| 782 } | |
| 783 else | |
| 784 { | |
| 785 int number_elements = old_size - kkcc_gc_stack_front; | |
| 786 memcpy (kkcc_gc_stack_ptr, &old_ptr[kkcc_gc_stack_front], | |
| 787 number_elements * sizeof (kkcc_gc_stack_entry)); | |
| 788 memcpy (&kkcc_gc_stack_ptr[number_elements], &old_ptr[0], | |
| 789 (kkcc_gc_stack_rear + 1) * sizeof (kkcc_gc_stack_entry)); | |
| 790 kkcc_gc_stack_front = 0; | |
| 791 kkcc_gc_stack_rear = kkcc_gc_stack_rear + number_elements; | |
| 792 } | |
| 793 xfree_1 (old_ptr); | |
| 794 } | |
| 795 | |
| 796 static void | |
| 797 #ifdef DEBUG_XEMACS | |
| 798 kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc, | |
| 799 int level, int pos) | |
| 800 #else | |
| 801 kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc) | |
| 802 #endif | |
| 803 { | |
| 804 #ifdef NEW_GC | |
| 805 GC_STAT_ENQUEUED; | |
| 806 #endif /* NEW_GC */ | |
| 807 if (KKCC_GC_STACK_FULL) | |
| 808 kkcc_gc_stack_realloc(); | |
| 809 kkcc_gc_stack_rear = KKCC_INC (kkcc_gc_stack_rear); | |
| 810 kkcc_gc_stack_ptr[kkcc_gc_stack_rear].data = data; | |
| 811 kkcc_gc_stack_ptr[kkcc_gc_stack_rear].desc = desc; | |
| 812 #ifdef DEBUG_XEMACS | |
| 813 kkcc_gc_stack_ptr[kkcc_gc_stack_rear].level = level; | |
| 814 kkcc_gc_stack_ptr[kkcc_gc_stack_rear].pos = pos; | |
| 815 #endif | |
| 816 } | |
| 817 | |
| 818 #ifdef DEBUG_XEMACS | |
| 819 #define kkcc_gc_stack_push(data, desc, level, pos) \ | |
| 820 kkcc_gc_stack_push_1 (data, desc, level, pos) | |
| 821 #else | |
| 822 #define kkcc_gc_stack_push(data, desc, level, pos) \ | |
| 823 kkcc_gc_stack_push_1 (data, desc) | |
| 824 #endif | |
| 825 | |
| 826 static kkcc_gc_stack_entry * | |
| 827 kkcc_gc_stack_pop (void) | |
| 828 { | |
| 829 if (KKCC_GC_STACK_EMPTY) | |
| 830 return 0; | |
| 831 #ifdef NEW_GC | |
| 832 GC_STAT_DEQUEUED; | |
| 833 #endif /* NEW_GC */ | |
| 834 #ifndef KKCC_STACK_AS_QUEUE | |
| 835 /* stack behaviour */ | |
| 836 return &kkcc_gc_stack_ptr[kkcc_gc_stack_rear--]; | |
| 837 #else | |
| 838 /* queue behaviour */ | |
| 839 { | |
| 840 int old_front = kkcc_gc_stack_front; | |
| 841 kkcc_gc_stack_front = KKCC_INC (kkcc_gc_stack_front); | |
| 842 return &kkcc_gc_stack_ptr[old_front]; | |
| 843 } | |
| 844 #endif | |
| 845 } | |
| 846 | |
| 847 void | |
| 848 #ifdef DEBUG_XEMACS | |
| 849 kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos) | |
| 850 #else | |
| 851 kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj) | |
| 852 #endif | |
| 853 { | |
| 854 if (XTYPE (obj) == Lisp_Type_Record) | |
| 855 { | |
| 856 struct lrecord_header *lheader = XRECORD_LHEADER (obj); | |
| 857 const struct memory_description *desc; | |
| 858 GC_CHECK_LHEADER_INVARIANTS (lheader); | |
| 859 desc = RECORD_DESCRIPTION (lheader); | |
| 860 if (! MARKED_RECORD_HEADER_P (lheader)) | |
| 861 { | |
| 862 #ifdef NEW_GC | |
| 863 MARK_GREY (lheader); | |
| 864 #else /* not NEW_GC */ | |
| 865 MARK_RECORD_HEADER (lheader); | |
| 866 #endif /* not NEW_GC */ | |
| 867 kkcc_gc_stack_push ((void *) lheader, desc, level, pos); | |
| 868 } | |
| 869 } | |
| 870 } | |
| 871 | |
| 872 #ifdef NEW_GC | |
| 873 #ifdef DEBUG_XEMACS | |
| 874 #define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ | |
| 875 kkcc_gc_stack_push_lisp_object_1 (obj, level, pos) | |
| 876 #else | |
| 877 #define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ | |
| 878 kkcc_gc_stack_push_lisp_object_1 (obj) | |
| 879 #endif | |
| 880 | |
| 881 void | |
| 882 #ifdef DEBUG_XEMACS | |
| 883 kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj, int level, int pos) | |
| 884 #else | |
| 885 kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj) | |
| 886 #endif | |
| 887 { | |
| 888 if (XTYPE (obj) == Lisp_Type_Record) | |
| 889 { | |
| 890 struct lrecord_header *lheader = XRECORD_LHEADER (obj); | |
| 891 const struct memory_description *desc; | |
| 892 GC_STAT_REPUSHED; | |
| 893 GC_CHECK_LHEADER_INVARIANTS (lheader); | |
| 894 desc = RECORD_DESCRIPTION (lheader); | |
| 895 MARK_GREY (lheader); | |
| 896 kkcc_gc_stack_push ((void*) lheader, desc, level, pos); | |
| 897 } | |
| 898 } | |
| 899 #endif /* NEW_GC */ | |
| 900 | |
| 901 #ifdef ERROR_CHECK_GC | |
| 902 #define KKCC_DO_CHECK_FREE(obj, allow_free) \ | |
| 903 do \ | |
| 904 { \ | |
| 905 if (!allow_free && XTYPE (obj) == Lisp_Type_Record) \ | |
| 906 { \ | |
| 907 struct lrecord_header *lheader = XRECORD_LHEADER (obj); \ | |
| 908 GC_CHECK_NOT_FREE (lheader); \ | |
| 909 } \ | |
| 910 } while (0) | |
| 911 #else | |
| 912 #define KKCC_DO_CHECK_FREE(obj, allow_free) | |
| 913 #endif | |
| 914 | |
| 915 #ifdef ERROR_CHECK_GC | |
| 916 #ifdef DEBUG_XEMACS | |
| 917 static void | |
| 918 mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free, | |
| 919 int level, int pos) | |
| 920 #else | |
| 921 static void | |
| 922 mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free) | |
| 923 #endif | |
| 924 { | |
| 925 KKCC_DO_CHECK_FREE (obj, allow_free); | |
| 926 kkcc_gc_stack_push_lisp_object (obj, level, pos); | |
| 927 } | |
| 928 | |
| 929 #ifdef DEBUG_XEMACS | |
| 930 #define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ | |
| 931 mark_object_maybe_checking_free_1 (obj, allow_free, level, pos) | |
| 932 #else | |
| 933 #define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ | |
| 934 mark_object_maybe_checking_free_1 (obj, allow_free) | |
| 935 #endif | |
| 936 #else /* not ERROR_CHECK_GC */ | |
| 937 #define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ | |
| 938 kkcc_gc_stack_push_lisp_object (obj, level, pos) | |
| 939 #endif /* not ERROR_CHECK_GC */ | |
| 940 | |
| 941 | |
| 942 /* This function loops all elements of a struct pointer and calls | |
| 943 mark_with_description with each element. */ | |
| 944 static void | |
| 945 #ifdef DEBUG_XEMACS | |
| 946 mark_struct_contents_1 (const void *data, | |
| 947 const struct sized_memory_description *sdesc, | |
| 948 int count, int level, int pos) | |
| 949 #else | |
| 950 mark_struct_contents_1 (const void *data, | |
| 951 const struct sized_memory_description *sdesc, | |
| 952 int count) | |
| 953 #endif | |
| 954 { | |
| 955 int i; | |
| 956 Bytecount elsize; | |
| 957 elsize = lispdesc_block_size (data, sdesc); | |
| 958 | |
| 959 for (i = 0; i < count; i++) | |
| 960 { | |
| 961 kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description, | |
| 962 level, pos); | |
| 963 } | |
| 964 } | |
| 965 | |
| 966 #ifdef DEBUG_XEMACS | |
| 967 #define mark_struct_contents(data, sdesc, count, level, pos) \ | |
| 968 mark_struct_contents_1 (data, sdesc, count, level, pos) | |
| 969 #else | |
| 970 #define mark_struct_contents(data, sdesc, count, level, pos) \ | |
| 971 mark_struct_contents_1 (data, sdesc, count) | |
| 972 #endif | |
| 973 | |
| 974 | |
| 975 #ifdef NEW_GC | |
| 976 /* This function loops all elements of a struct pointer and calls | |
| 977 mark_with_description with each element. */ | |
| 978 static void | |
| 979 #ifdef DEBUG_XEMACS | |
| 980 mark_lisp_object_block_contents_1 (const void *data, | |
| 981 const struct sized_memory_description *sdesc, | |
| 982 int count, int level, int pos) | |
| 983 #else | |
| 984 mark_lisp_object_block_contents_1 (const void *data, | |
| 985 const struct sized_memory_description *sdesc, | |
| 986 int count) | |
| 987 #endif | |
| 988 { | |
| 989 int i; | |
| 990 Bytecount elsize; | |
| 991 elsize = lispdesc_block_size (data, sdesc); | |
| 992 | |
| 993 for (i = 0; i < count; i++) | |
| 994 { | |
| 995 const Lisp_Object obj = wrap_pointer_1 (((char *) data) + elsize * i); | |
| 996 if (XTYPE (obj) == Lisp_Type_Record) | |
| 997 { | |
| 998 struct lrecord_header *lheader = XRECORD_LHEADER (obj); | |
| 999 const struct memory_description *desc; | |
| 1000 GC_CHECK_LHEADER_INVARIANTS (lheader); | |
| 1001 desc = sdesc->description; | |
| 1002 if (! MARKED_RECORD_HEADER_P (lheader)) | |
| 1003 { | |
| 1004 MARK_GREY (lheader); | |
| 1005 kkcc_gc_stack_push ((void *) lheader, desc, level, pos); | |
| 1006 } | |
| 1007 } | |
| 1008 } | |
| 1009 } | |
| 1010 | |
| 1011 #ifdef DEBUG_XEMACS | |
| 1012 #define mark_lisp_object_block_contents(data, sdesc, count, level, pos) \ | |
| 1013 mark_lisp_object_block_contents_1 (data, sdesc, count, level, pos) | |
| 1014 #else | |
| 1015 #define mark_lisp_object_block_contents(data, sdesc, count, level, pos) \ | |
| 1016 mark_lisp_object_block_contents_1 (data, sdesc, count) | |
| 1017 #endif | |
| 1018 #endif /* not NEW_GC */ | |
| 1019 | |
| 1020 /* This function implements the KKCC mark algorithm. | |
| 1021 Instead of calling mark_object, all the alive Lisp_Objects are pushed | |
| 1022 on the kkcc_gc_stack. This function processes all elements on the stack | |
| 1023 according to their descriptions. */ | |
| 1024 static void | |
| 1025 kkcc_marking ( | |
| 1026 #ifdef NEW_GC | |
| 1027 int cnt | |
| 1028 #else /* not NEW_GC */ | |
| 1029 int UNUSED(cnt) | |
| 1030 #endif /* not NEW_GC */ | |
| 1031 ) | |
| 1032 { | |
| 1033 kkcc_gc_stack_entry *stack_entry = 0; | |
| 1034 void *data = 0; | |
| 1035 const struct memory_description *desc = 0; | |
| 1036 int pos; | |
| 1037 #ifdef NEW_GC | |
| 1038 int count = cnt; | |
| 1039 #endif /* NEW_GC */ | |
| 1040 #ifdef DEBUG_XEMACS | |
| 1041 int level = 0; | |
| 1042 #endif | |
| 1043 | |
| 1044 while ((stack_entry = kkcc_gc_stack_pop ()) != 0) | |
| 1045 { | |
| 1046 data = stack_entry->data; | |
| 1047 desc = stack_entry->desc; | |
| 1048 #ifdef DEBUG_XEMACS | |
| 1049 level = stack_entry->level + 1; | |
| 1050 #endif | |
| 1051 kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos); | |
| 1052 | |
| 1053 #ifdef NEW_GC | |
| 1054 /* Mark black if object is currently grey. This first checks, | |
| 1055 if the object is really allocated on the mc-heap. If it is, | |
| 1056 it can be marked black; if it is not, it cannot be marked. */ | |
| 1057 maybe_mark_black (data); | |
| 1058 #endif /* NEW_GC */ | |
| 1059 | |
| 1060 if (!data) continue; | |
| 1061 | |
| 1062 gc_checking_assert (data); | |
| 1063 gc_checking_assert (desc); | |
| 1064 | |
| 1065 for (pos = 0; desc[pos].type != XD_END; pos++) | |
| 1066 { | |
| 1067 const struct memory_description *desc1 = &desc[pos]; | |
| 1068 const void *rdata = | |
| 1069 (const char *) data + lispdesc_indirect_count (desc1->offset, | |
| 1070 desc, data); | |
| 1071 union_switcheroo: | |
| 1072 | |
| 1073 /* If the flag says don't mark, then don't mark. */ | |
| 1074 if ((desc1->flags) & XD_FLAG_NO_KKCC) | |
| 1075 continue; | |
| 1076 | |
| 1077 switch (desc1->type) | |
| 1078 { | |
| 1079 case XD_BYTECOUNT: | |
| 1080 case XD_ELEMCOUNT: | |
| 1081 case XD_HASHCODE: | |
| 1082 case XD_INT: | |
| 1083 case XD_LONG: | |
| 1084 case XD_INT_RESET: | |
| 1085 case XD_LO_LINK: | |
| 1086 case XD_OPAQUE_PTR: | |
| 1087 case XD_OPAQUE_DATA_PTR: | |
| 1088 case XD_ASCII_STRING: | |
| 1089 case XD_DOC_STRING: | |
| 1090 break; | |
| 1091 case XD_LISP_OBJECT: | |
| 1092 { | |
| 1093 const Lisp_Object *stored_obj = (const Lisp_Object *) rdata; | |
| 1094 | |
| 1095 /* Because of the way that tagged objects work (pointers and | |
| 1096 Lisp_Objects have the same representation), XD_LISP_OBJECT | |
| 1097 can be used for untagged pointers. They might be NULL, | |
| 1098 though. */ | |
| 1099 if (EQ (*stored_obj, Qnull_pointer)) | |
| 1100 break; | |
| 3263 | 1101 #ifdef NEW_GC |
| 3092 | 1102 mark_object_maybe_checking_free (*stored_obj, 0, level, pos); |
| 3263 | 1103 #else /* not NEW_GC */ |
| 3092 | 1104 mark_object_maybe_checking_free |
| 1105 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, | |
| 1106 level, pos); | |
| 3263 | 1107 #endif /* not NEW_GC */ |
| 3092 | 1108 break; |
| 1109 } | |
| 1110 case XD_LISP_OBJECT_ARRAY: | |
| 1111 { | |
| 1112 int i; | |
| 1113 EMACS_INT count = | |
| 1114 lispdesc_indirect_count (desc1->data1, desc, data); | |
| 1115 | |
| 1116 for (i = 0; i < count; i++) | |
| 1117 { | |
| 1118 const Lisp_Object *stored_obj = | |
| 1119 (const Lisp_Object *) rdata + i; | |
| 1120 | |
| 1121 if (EQ (*stored_obj, Qnull_pointer)) | |
| 1122 break; | |
| 3263 | 1123 #ifdef NEW_GC |
| 3092 | 1124 mark_object_maybe_checking_free |
| 1125 (*stored_obj, 0, level, pos); | |
| 3263 | 1126 #else /* not NEW_GC */ |
| 3092 | 1127 mark_object_maybe_checking_free |
| 1128 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, | |
| 1129 level, pos); | |
| 3263 | 1130 #endif /* not NEW_GC */ |
| 3092 | 1131 } |
| 1132 break; | |
| 1133 } | |
| 1134 #ifdef NEW_GC | |
| 1135 case XD_LISP_OBJECT_BLOCK_PTR: | |
| 1136 { | |
| 1137 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, | |
| 1138 data); | |
| 1139 const struct sized_memory_description *sdesc = | |
| 1140 lispdesc_indirect_description (data, desc1->data2.descr); | |
| 1141 const char *dobj = * (const char **) rdata; | |
| 1142 if (dobj) | |
| 1143 mark_lisp_object_block_contents | |
| 1144 (dobj, sdesc, count, level, pos); | |
| 1145 break; | |
| 1146 } | |
| 1147 #endif /* NEW_GC */ | |
| 1148 case XD_BLOCK_PTR: | |
| 1149 { | |
| 1150 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, | |
| 1151 data); | |
| 1152 const struct sized_memory_description *sdesc = | |
| 1153 lispdesc_indirect_description (data, desc1->data2.descr); | |
| 1154 const char *dobj = * (const char **) rdata; | |
| 1155 if (dobj) | |
| 1156 mark_struct_contents (dobj, sdesc, count, level, pos); | |
| 1157 break; | |
| 1158 } | |
| 1159 case XD_BLOCK_ARRAY: | |
| 1160 { | |
| 1161 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, | |
| 1162 data); | |
| 1163 const struct sized_memory_description *sdesc = | |
| 1164 lispdesc_indirect_description (data, desc1->data2.descr); | |
| 1165 | |
| 1166 mark_struct_contents (rdata, sdesc, count, level, pos); | |
| 1167 break; | |
| 1168 } | |
| 1169 case XD_UNION: | |
| 1170 case XD_UNION_DYNAMIC_SIZE: | |
| 1171 desc1 = lispdesc_process_xd_union (desc1, desc, data); | |
| 1172 if (desc1) | |
| 1173 goto union_switcheroo; | |
| 1174 break; | |
| 1175 | |
| 1176 default: | |
| 1177 stderr_out ("Unsupported description type : %d\n", desc1->type); | |
| 1178 kkcc_backtrace (); | |
| 1179 ABORT (); | |
| 1180 } | |
| 1181 } | |
| 1182 | |
| 1183 #ifdef NEW_GC | |
| 1184 if (cnt) | |
| 1185 if (!--count) | |
| 1186 break; | |
| 1187 #endif /* NEW_GC */ | |
| 1188 } | |
| 1189 } | |
| 1190 #endif /* USE_KKCC */ | |
| 1191 | |
| 1192 /* I hate duplicating all this crap! */ | |
| 1193 int | |
| 1194 marked_p (Lisp_Object obj) | |
| 1195 { | |
| 1196 /* Checks we used to perform. */ | |
| 1197 /* if (EQ (obj, Qnull_pointer)) return 1; */ | |
| 1198 /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */ | |
| 1199 /* if (PURIFIED (XPNTR (obj))) return 1; */ | |
| 1200 | |
| 1201 if (XTYPE (obj) == Lisp_Type_Record) | |
| 1202 { | |
| 1203 struct lrecord_header *lheader = XRECORD_LHEADER (obj); | |
| 1204 | |
| 1205 GC_CHECK_LHEADER_INVARIANTS (lheader); | |
| 1206 | |
| 1207 return MARKED_RECORD_HEADER_P (lheader); | |
| 1208 } | |
| 1209 return 1; | |
| 1210 } | |
| 1211 | |
| 1212 | |
| 1213 /* Mark reference to a Lisp_Object. If the object referred to has not been | |
| 1214 seen yet, recursively mark all the references contained in it. */ | |
| 1215 void | |
| 1216 mark_object ( | |
| 1217 #ifdef USE_KKCC | |
| 1218 Lisp_Object UNUSED (obj) | |
| 1219 #else | |
| 1220 Lisp_Object obj | |
| 1221 #endif | |
| 1222 ) | |
| 1223 { | |
| 1224 #ifdef USE_KKCC | |
| 1225 /* this code should never be reached when configured for KKCC */ | |
| 1226 stderr_out ("KKCC: Invalid mark_object call.\n"); | |
| 1227 stderr_out ("Replace mark_object with kkcc_gc_stack_push_lisp_object.\n"); | |
| 1228 ABORT (); | |
| 1229 #else /* not USE_KKCC */ | |
| 1230 | |
| 1231 tail_recurse: | |
| 1232 | |
| 1233 /* Checks we used to perform */ | |
| 1234 /* if (EQ (obj, Qnull_pointer)) return; */ | |
| 1235 /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */ | |
| 1236 /* if (PURIFIED (XPNTR (obj))) return; */ | |
| 1237 | |
| 1238 if (XTYPE (obj) == Lisp_Type_Record) | |
| 1239 { | |
| 1240 struct lrecord_header *lheader = XRECORD_LHEADER (obj); | |
| 1241 | |
| 1242 GC_CHECK_LHEADER_INVARIANTS (lheader); | |
| 1243 | |
| 1244 /* We handle this separately, above, so we can mark free objects */ | |
| 1245 GC_CHECK_NOT_FREE (lheader); | |
| 1246 | |
| 1247 /* All c_readonly objects have their mark bit set, | |
| 1248 so that we only need to check the mark bit here. */ | |
| 1249 if (! MARKED_RECORD_HEADER_P (lheader)) | |
| 1250 { | |
| 1251 MARK_RECORD_HEADER (lheader); | |
| 1252 | |
| 1253 if (RECORD_MARKER (lheader)) | |
| 1254 { | |
| 1255 obj = RECORD_MARKER (lheader) (obj); | |
| 1256 if (!NILP (obj)) goto tail_recurse; | |
| 1257 } | |
| 1258 } | |
| 1259 } | |
| 1260 #endif /* not KKCC */ | |
| 1261 } | |
| 1262 | |
| 1263 | |
| 1264 /************************************************************************/ | |
| 1265 /* Hooks */ | |
| 1266 /************************************************************************/ | |
| 1267 | |
| 1268 /* Nonzero when calling certain hooks or doing other things where a GC | |
| 1269 would be bad. It prevents infinite recursive calls to gc. */ | |
| 1270 int gc_currently_forbidden; | |
| 1271 | |
| 1272 int | |
| 1273 begin_gc_forbidden (void) | |
| 1274 { | |
| 1275 return internal_bind_int (&gc_currently_forbidden, 1); | |
| 1276 } | |
| 1277 | |
| 1278 void | |
| 1279 end_gc_forbidden (int count) | |
| 1280 { | |
| 1281 unbind_to (count); | |
| 1282 } | |
| 1283 | |
| 1284 /* Hooks. */ | |
| 1285 Lisp_Object Vpre_gc_hook, Qpre_gc_hook; | |
| 1286 Lisp_Object Vpost_gc_hook, Qpost_gc_hook; | |
| 1287 | |
| 1288 /* Maybe we want to use this when doing a "panic" gc after memory_full()? */ | |
| 1289 static int gc_hooks_inhibited; | |
| 1290 | |
| 1291 struct post_gc_action | |
| 1292 { | |
| 1293 void (*fun) (void *); | |
| 1294 void *arg; | |
| 1295 }; | |
| 1296 | |
| 1297 typedef struct post_gc_action post_gc_action; | |
| 1298 | |
| 1299 typedef struct | |
| 1300 { | |
| 1301 Dynarr_declare (post_gc_action); | |
| 1302 } post_gc_action_dynarr; | |
| 1303 | |
| 1304 static post_gc_action_dynarr *post_gc_actions; | |
| 1305 | |
| 1306 /* Register an action to be called at the end of GC. | |
| 1307 gc_in_progress is 0 when this is called. | |
| 1308 This is used when it is discovered that an action needs to be taken, | |
| 1309 but it's during GC, so it's not safe. (e.g. in a finalize method.) | |
| 1310 | |
| 1311 As a general rule, do not use Lisp objects here. | |
| 1312 And NEVER signal an error. | |
| 1313 */ | |
| 1314 | |
| 1315 void | |
| 1316 register_post_gc_action (void (*fun) (void *), void *arg) | |
| 1317 { | |
| 1318 post_gc_action action; | |
| 1319 | |
| 1320 if (!post_gc_actions) | |
| 1321 post_gc_actions = Dynarr_new (post_gc_action); | |
| 1322 | |
| 1323 action.fun = fun; | |
| 1324 action.arg = arg; | |
| 1325 | |
| 1326 Dynarr_add (post_gc_actions, action); | |
| 1327 } | |
| 1328 | |
| 1329 static void | |
| 1330 run_post_gc_actions (void) | |
| 1331 { | |
| 1332 int i; | |
| 1333 | |
| 1334 if (post_gc_actions) | |
| 1335 { | |
| 1336 for (i = 0; i < Dynarr_length (post_gc_actions); i++) | |
| 1337 { | |
| 1338 post_gc_action action = Dynarr_at (post_gc_actions, i); | |
| 1339 (action.fun) (action.arg); | |
| 1340 } | |
| 1341 | |
| 1342 Dynarr_reset (post_gc_actions); | |
| 1343 } | |
| 1344 } | |
| 1345 | |
| 3263 | 1346 #ifdef NEW_GC |
| 1347 /* Asynchronous finalization. */ | |
| 1348 typedef struct finalize_elem | |
| 1349 { | |
| 1350 Lisp_Object obj; | |
| 1351 struct finalize_elem *next; | |
| 1352 } finalize_elem; | |
| 1353 | |
| 1354 finalize_elem *Vall_finalizable_objs; | |
| 1355 Lisp_Object Vfinalizers_to_run; | |
| 1356 | |
| 1357 void | |
| 1358 add_finalizable_obj (Lisp_Object obj) | |
| 1359 { | |
| 1360 finalize_elem *next = Vall_finalizable_objs; | |
| 1361 Vall_finalizable_objs = | |
| 1362 (finalize_elem *) xmalloc_and_zero (sizeof (finalize_elem)); | |
| 1363 Vall_finalizable_objs->obj = obj; | |
| 1364 Vall_finalizable_objs->next = next; | |
| 1365 } | |
| 1366 | |
| 1367 void | |
| 1368 register_for_finalization (void) | |
| 1369 { | |
| 1370 finalize_elem *rest = Vall_finalizable_objs; | |
| 1371 | |
| 1372 if (!rest) | |
| 1373 return; | |
| 1374 | |
| 1375 while (!marked_p (rest->obj)) | |
| 1376 { | |
| 1377 finalize_elem *temp = rest; | |
| 1378 Vfinalizers_to_run = Fcons (rest->obj, Vfinalizers_to_run); | |
| 1379 Vall_finalizable_objs = rest->next; | |
| 1380 xfree (temp, finalize_elem *); | |
| 1381 rest = Vall_finalizable_objs; | |
| 1382 } | |
| 1383 | |
| 1384 while (rest->next) | |
| 1385 { | |
| 1386 if (LRECORDP (rest->next->obj) | |
| 1387 && !marked_p (rest->next->obj)) | |
| 1388 { | |
| 1389 finalize_elem *temp = rest->next; | |
| 1390 Vfinalizers_to_run = Fcons (rest->next->obj, Vfinalizers_to_run); | |
| 1391 rest->next = rest->next->next; | |
| 1392 xfree (temp, finalize_elem *); | |
| 1393 } | |
| 1394 else | |
| 1395 { | |
| 1396 rest = rest->next; | |
| 1397 } | |
| 1398 } | |
| 1399 /* Keep objects alive that need to be finalized by marking | |
| 1400 Vfinalizers_to_run transitively. */ | |
| 1401 kkcc_gc_stack_push_lisp_object (Vfinalizers_to_run, 0, -1); | |
| 1402 kkcc_marking (0); | |
| 1403 } | |
| 1404 | |
| 1405 void | |
| 1406 run_finalizers (void) | |
| 1407 { | |
| 1408 Lisp_Object rest; | |
| 1409 for (rest = Vfinalizers_to_run; !NILP (rest); rest = XCDR (rest)) | |
| 1410 { | |
| 1411 MC_ALLOC_CALL_FINALIZER (XPNTR (XCAR (rest))); | |
| 1412 } | |
| 1413 Vfinalizers_to_run = Qnil; | |
| 1414 } | |
| 1415 #endif /* not NEW_GC */ | |
| 3092 | 1416 |
| 1417 | |
| 1418 /************************************************************************/ | |
| 1419 /* Garbage Collection */ | |
| 1420 /************************************************************************/ | |
| 1421 | |
| 1422 /* Enable/disable incremental garbage collection during runtime. */ | |
| 1423 int allow_incremental_gc; | |
| 1424 | |
| 1425 /* For profiling. */ | |
| 1426 static Lisp_Object QSin_garbage_collection; | |
| 1427 | |
| 1428 /* Nonzero means display messages at beginning and end of GC. */ | |
| 1429 int garbage_collection_messages; | |
| 1430 | |
| 1431 /* "Garbage collecting" */ | |
| 1432 Lisp_Object Vgc_message; | |
| 1433 Lisp_Object Vgc_pointer_glyph; | |
| 1434 static const Ascbyte gc_default_message[] = "Garbage collecting"; | |
| 1435 Lisp_Object Qgarbage_collecting; | |
| 1436 | |
| 1437 /* "Locals" during GC. */ | |
| 1438 struct frame *f; | |
| 1439 int speccount; | |
| 1440 int cursor_changed; | |
| 1441 Lisp_Object pre_gc_cursor; | |
| 1442 | |
| 1443 /* PROFILE_DECLARE */ | |
| 1444 int do_backtrace; | |
| 1445 struct backtrace backtrace; | |
| 1446 | |
| 1447 /* Maximum amount of C stack to save when a GC happens. */ | |
| 1448 #ifndef MAX_SAVE_STACK | |
| 1449 #define MAX_SAVE_STACK 0 /* 16000 */ | |
| 1450 #endif | |
| 1451 | |
| 1452 void | |
| 3267 | 1453 show_gc_cursor_and_message (void) |
| 3092 | 1454 { |
| 3267 | 1455 /* Now show the GC cursor/message. */ |
| 1456 pre_gc_cursor = Qnil; | |
| 1457 cursor_changed = 0; | |
| 3092 | 1458 |
| 1459 /* We used to call selected_frame() here. | |
| 1460 | |
| 1461 The following functions cannot be called inside GC | |
| 1462 so we move to after the above tests. */ | |
| 1463 { | |
| 1464 Lisp_Object frame; | |
| 1465 Lisp_Object device = Fselected_device (Qnil); | |
| 1466 if (NILP (device)) /* Could happen during startup, eg. if always_gc */ | |
| 1467 return; | |
| 1468 frame = Fselected_frame (device); | |
| 1469 if (NILP (frame)) | |
| 1470 invalid_state ("No frames exist on device", device); | |
| 1471 f = XFRAME (frame); | |
| 1472 } | |
| 1473 | |
| 1474 if (!noninteractive) | |
| 1475 { | |
| 1476 if (FRAME_WIN_P (f)) | |
| 1477 { | |
| 1478 Lisp_Object frame = wrap_frame (f); | |
| 1479 Lisp_Object cursor = glyph_image_instance (Vgc_pointer_glyph, | |
| 1480 FRAME_SELECTED_WINDOW (f), | |
| 1481 ERROR_ME_NOT, 1); | |
| 1482 pre_gc_cursor = f->pointer; | |
| 1483 if (POINTER_IMAGE_INSTANCEP (cursor) | |
| 1484 /* don't change if we don't know how to change back. */ | |
| 1485 && POINTER_IMAGE_INSTANCEP (pre_gc_cursor)) | |
| 1486 { | |
| 1487 cursor_changed = 1; | |
| 1488 Fset_frame_pointer (frame, cursor); | |
| 1489 } | |
| 1490 } | |
| 1491 | |
| 1492 /* Don't print messages to the stream device. */ | |
| 1493 if (!cursor_changed && !FRAME_STREAM_P (f)) | |
| 1494 { | |
| 1495 if (garbage_collection_messages) | |
| 1496 { | |
| 1497 Lisp_Object args[2], whole_msg; | |
| 1498 args[0] = (STRINGP (Vgc_message) ? Vgc_message : | |
| 1499 build_msg_string (gc_default_message)); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4934
diff
changeset
|
1500 args[1] = build_ascstring ("..."); |
| 3092 | 1501 whole_msg = Fconcat (2, args); |
| 1502 echo_area_message (f, (Ibyte *) 0, whole_msg, 0, -1, | |
| 1503 Qgarbage_collecting); | |
| 1504 } | |
| 1505 } | |
| 1506 } | |
| 3267 | 1507 } |
| 1508 | |
| 1509 void | |
| 1510 remove_gc_cursor_and_message (void) | |
| 1511 { | |
| 1512 /* Now remove the GC cursor/message */ | |
| 1513 if (!noninteractive) | |
| 1514 { | |
| 1515 if (cursor_changed) | |
| 1516 Fset_frame_pointer (wrap_frame (f), pre_gc_cursor); | |
| 1517 else if (!FRAME_STREAM_P (f)) | |
| 1518 { | |
| 1519 /* Show "...done" only if the echo area would otherwise be empty. */ | |
| 1520 if (NILP (clear_echo_area (selected_frame (), | |
| 1521 Qgarbage_collecting, 0))) | |
| 1522 { | |
| 1523 if (garbage_collection_messages) | |
| 1524 { | |
| 1525 Lisp_Object args[2], whole_msg; | |
| 1526 args[0] = (STRINGP (Vgc_message) ? Vgc_message : | |
| 1527 build_msg_string (gc_default_message)); | |
| 1528 args[1] = build_msg_string ("... done"); | |
| 1529 whole_msg = Fconcat (2, args); | |
| 1530 echo_area_message (selected_frame (), (Ibyte *) 0, | |
| 1531 whole_msg, 0, -1, | |
| 1532 Qgarbage_collecting); | |
| 1533 } | |
| 1534 } | |
| 1535 } | |
| 1536 } | |
| 1537 } | |
| 1538 | |
| 1539 void | |
| 1540 gc_prepare (void) | |
| 1541 { | |
| 1542 #if MAX_SAVE_STACK > 0 | |
| 1543 char stack_top_variable; | |
| 1544 extern char *stack_bottom; | |
| 1545 #endif | |
| 1546 | |
| 1547 #ifdef NEW_GC | |
| 1548 GC_STAT_START_NEW_GC; | |
| 1549 GC_SET_PHASE (INIT_GC); | |
| 1550 #endif /* NEW_GC */ | |
| 1551 | |
| 1552 do_backtrace = profiling_active || backtrace_with_internal_sections; | |
| 1553 | |
| 1554 assert (!gc_in_progress); | |
| 1555 assert (!in_display || gc_currently_forbidden); | |
| 1556 | |
| 1557 PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection); | |
| 1558 | |
| 1559 need_to_signal_post_gc = 0; | |
| 1560 recompute_funcall_allocation_flag (); | |
| 1561 | |
| 1562 if (!gc_hooks_inhibited) | |
| 1563 run_hook_trapping_problems | |
| 1564 (Qgarbage_collecting, Qpre_gc_hook, | |
| 1565 INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION); | |
| 3092 | 1566 |
| 1567 /***** Now we actually start the garbage collection. */ | |
| 1568 | |
| 1569 gc_in_progress = 1; | |
| 1570 #ifndef NEW_GC | |
| 1571 inhibit_non_essential_conversion_operations = 1; | |
| 3263 | 1572 #endif /* not NEW_GC */ |
| 3092 | 1573 |
| 1574 #if MAX_SAVE_STACK > 0 | |
| 1575 | |
| 1576 /* Save a copy of the contents of the stack, for debugging. */ | |
| 1577 if (!purify_flag) | |
| 1578 { | |
| 1579 /* Static buffer in which we save a copy of the C stack at each GC. */ | |
| 1580 static char *stack_copy; | |
| 1581 static Bytecount stack_copy_size; | |
| 1582 | |
| 1583 ptrdiff_t stack_diff = &stack_top_variable - stack_bottom; | |
| 1584 Bytecount stack_size = (stack_diff > 0 ? stack_diff : -stack_diff); | |
| 1585 if (stack_size < MAX_SAVE_STACK) | |
| 1586 { | |
| 1587 if (stack_copy_size < stack_size) | |
| 1588 { | |
| 1589 stack_copy = (char *) xrealloc (stack_copy, stack_size); | |
| 1590 stack_copy_size = stack_size; | |
| 1591 } | |
| 1592 | |
| 1593 memcpy (stack_copy, | |
| 1594 stack_diff > 0 ? stack_bottom : &stack_top_variable, | |
| 1595 stack_size); | |
| 1596 } | |
| 1597 } | |
| 1598 #endif /* MAX_SAVE_STACK > 0 */ | |
| 1599 | |
| 1600 /* Do some totally ad-hoc resource clearing. */ | |
| 1601 /* #### generalize this? */ | |
| 1602 clear_event_resource (); | |
| 1603 cleanup_specifiers (); | |
| 1604 cleanup_buffer_undo_lists (); | |
| 1605 } | |
| 1606 | |
| 1607 void | |
| 1608 gc_mark_root_set ( | |
| 1609 #ifdef NEW_GC | |
| 1610 enum gc_phase phase | |
| 1611 #else /* not NEW_GC */ | |
| 1612 void | |
| 1613 #endif /* not NEW_GC */ | |
| 1614 ) | |
| 1615 { | |
| 1616 #ifdef NEW_GC | |
| 1617 GC_SET_PHASE (phase); | |
| 1618 #endif /* NEW_GC */ | |
| 1619 | |
| 1620 /* Mark all the special slots that serve as the roots of accessibility. */ | |
| 1621 | |
| 1622 #ifdef USE_KKCC | |
| 1623 # define mark_object(obj) kkcc_gc_stack_push_lisp_object (obj, 0, -1) | |
| 1624 #endif /* USE_KKCC */ | |
| 1625 | |
| 1626 { /* staticpro() */ | |
| 1627 Lisp_Object **p = Dynarr_begin (staticpros); | |
|
4934
714f7c9fabb1
make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents:
4502
diff
changeset
|
1628 Elemcount len = Dynarr_length (staticpros); |
| 3092 | 1629 Elemcount count; |
|
4934
714f7c9fabb1
make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents:
4502
diff
changeset
|
1630 for (count = 0; count < len; count++, p++) |
| 3092 | 1631 /* Need to check if the pointer in the staticpro array is not |
| 1632 NULL. A gc can occur after variable is added to the staticpro | |
| 1633 array and _before_ it is correctly initialized. In this case | |
| 1634 its value is NULL, which we have to catch here. */ | |
| 1635 if (*p) | |
| 3486 | 1636 mark_object (**p); |
| 3092 | 1637 } |
| 1638 | |
| 1639 { /* staticpro_nodump() */ | |
| 1640 Lisp_Object **p = Dynarr_begin (staticpros_nodump); | |
|
4934
714f7c9fabb1
make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents:
4502
diff
changeset
|
1641 Elemcount len = Dynarr_length (staticpros_nodump); |
| 3092 | 1642 Elemcount count; |
|
4934
714f7c9fabb1
make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents:
4502
diff
changeset
|
1643 for (count = 0; count < len; count++, p++) |
| 3092 | 1644 /* Need to check if the pointer in the staticpro array is not |
| 1645 NULL. A gc can occur after variable is added to the staticpro | |
| 1646 array and _before_ it is correctly initialized. In this case | |
| 1647 its value is NULL, which we have to catch here. */ | |
| 1648 if (*p) | |
| 3486 | 1649 mark_object (**p); |
| 3092 | 1650 } |
| 1651 | |
| 3263 | 1652 #ifdef NEW_GC |
| 3092 | 1653 { /* mcpro () */ |
| 1654 Lisp_Object *p = Dynarr_begin (mcpros); | |
|
4934
714f7c9fabb1
make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents:
4502
diff
changeset
|
1655 Elemcount len = Dynarr_length (mcpros); |
| 3092 | 1656 Elemcount count; |
|
4934
714f7c9fabb1
make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents:
4502
diff
changeset
|
1657 for (count = 0; count < len; count++, p++) |
|
714f7c9fabb1
make it easier to debug staticpro crashes.
Ben Wing <ben@xemacs.org>
parents:
4502
diff
changeset
|
1658 mark_object (*p); |
| 3092 | 1659 } |
| 3263 | 1660 #endif /* NEW_GC */ |
| 3092 | 1661 |
| 1662 { /* GCPRO() */ | |
| 1663 struct gcpro *tail; | |
| 1664 int i; | |
| 1665 for (tail = gcprolist; tail; tail = tail->next) | |
| 1666 for (i = 0; i < tail->nvars; i++) | |
| 1667 mark_object (tail->var[i]); | |
| 1668 } | |
| 1669 | |
| 1670 { /* specbind() */ | |
| 1671 struct specbinding *bind; | |
| 1672 for (bind = specpdl; bind != specpdl_ptr; bind++) | |
| 1673 { | |
| 1674 mark_object (bind->symbol); | |
| 1675 mark_object (bind->old_value); | |
| 1676 } | |
| 1677 } | |
| 1678 | |
| 1679 { | |
| 1680 struct catchtag *c; | |
| 1681 for (c = catchlist; c; c = c->next) | |
| 1682 { | |
| 1683 mark_object (c->tag); | |
| 1684 mark_object (c->val); | |
| 1685 mark_object (c->actual_tag); | |
| 1686 mark_object (c->backtrace); | |
| 1687 } | |
| 1688 } | |
| 1689 | |
| 1690 { | |
| 1691 struct backtrace *backlist; | |
| 1692 for (backlist = backtrace_list; backlist; backlist = backlist->next) | |
| 1693 { | |
| 1694 int nargs = backlist->nargs; | |
| 1695 int i; | |
| 1696 | |
| 1697 mark_object (*backlist->function); | |
| 1698 if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */ | |
| 1699 /* might be fake (internal profiling entry) */ | |
| 1700 && backlist->args) | |
| 1701 mark_object (backlist->args[0]); | |
| 1702 else | |
| 1703 for (i = 0; i < nargs; i++) | |
| 1704 mark_object (backlist->args[i]); | |
| 1705 } | |
| 1706 } | |
| 1707 | |
| 1708 mark_profiling_info (); | |
| 1709 #ifdef USE_KKCC | |
| 1710 # undef mark_object | |
| 1711 #endif | |
| 1712 } | |
| 1713 | |
| 1714 void | |
| 1715 gc_finish_mark (void) | |
| 1716 { | |
| 1717 #ifdef NEW_GC | |
| 1718 GC_SET_PHASE (FINISH_MARK); | |
| 1719 #endif /* NEW_GC */ | |
| 1720 init_marking_ephemerons (); | |
| 1721 | |
| 1722 while (finish_marking_weak_hash_tables () > 0 || | |
| 1723 finish_marking_weak_lists () > 0 || | |
| 1724 continue_marking_ephemerons () > 0) | |
| 1725 #ifdef USE_KKCC | |
| 1726 { | |
| 1727 kkcc_marking (0); | |
| 1728 } | |
| 1729 #else /* not USE_KKCC */ | |
| 1730 ; | |
| 1731 #endif /* not USE_KKCC */ | |
| 1732 | |
| 1733 /* At this point, we know which objects need to be finalized: we | |
| 1734 still need to resurrect them */ | |
| 1735 | |
| 1736 while (finish_marking_ephemerons () > 0 || | |
| 1737 finish_marking_weak_lists () > 0 || | |
| 1738 finish_marking_weak_hash_tables () > 0) | |
| 1739 #ifdef USE_KKCC | |
| 1740 { | |
| 1741 kkcc_marking (0); | |
| 1742 } | |
| 1743 #else /* not USE_KKCC */ | |
| 1744 ; | |
| 1745 #endif /* not USE_KKCC */ | |
| 1746 | |
| 1747 /* And prune (this needs to be called after everything else has been | |
| 1748 marked and before we do any sweeping). */ | |
| 1749 /* #### this is somewhat ad-hoc and should probably be an object | |
| 1750 method */ | |
| 1751 prune_weak_hash_tables (); | |
| 1752 prune_weak_lists (); | |
| 1753 prune_specifiers (); | |
| 1754 prune_syntax_tables (); | |
| 1755 | |
| 1756 prune_ephemerons (); | |
| 1757 prune_weak_boxes (); | |
| 1758 } | |
| 1759 | |
| 1760 #ifdef NEW_GC | |
| 1761 void | |
| 1762 gc_finalize (void) | |
| 1763 { | |
| 1764 GC_SET_PHASE (FINALIZE); | |
| 3263 | 1765 register_for_finalization (); |
| 3092 | 1766 } |
| 1767 | |
| 1768 void | |
| 1769 gc_sweep (void) | |
| 1770 { | |
| 1771 GC_SET_PHASE (SWEEP); | |
| 1772 mc_sweep (); | |
| 1773 } | |
| 1774 #endif /* NEW_GC */ | |
| 1775 | |
| 1776 | |
| 1777 void | |
| 1778 gc_finish (void) | |
| 1779 { | |
| 1780 #ifdef NEW_GC | |
| 1781 GC_SET_PHASE (FINISH_GC); | |
| 1782 #endif /* NEW_GC */ | |
| 1783 consing_since_gc = 0; | |
| 1784 #ifndef DEBUG_XEMACS | |
| 1785 /* Allow you to set it really fucking low if you really want ... */ | |
| 1786 if (gc_cons_threshold < 10000) | |
| 1787 gc_cons_threshold = 10000; | |
| 1788 #endif | |
| 1789 recompute_need_to_garbage_collect (); | |
| 1790 | |
| 1791 #ifndef NEW_GC | |
| 1792 inhibit_non_essential_conversion_operations = 0; | |
| 1793 #endif /* not NEW_GC */ | |
| 1794 gc_in_progress = 0; | |
| 1795 | |
| 1796 run_post_gc_actions (); | |
| 1797 | |
| 1798 /******* End of garbage collection ********/ | |
| 1799 | |
| 3263 | 1800 #ifndef NEW_GC |
| 3092 | 1801 if (!breathing_space) |
| 1802 { | |
| 1803 breathing_space = malloc (4096 - MALLOC_OVERHEAD); | |
| 1804 } | |
| 3263 | 1805 #endif /* not NEW_GC */ |
| 3092 | 1806 |
| 1807 need_to_signal_post_gc = 1; | |
| 1808 funcall_allocation_flag = 1; | |
| 1809 | |
| 1810 PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection); | |
| 1811 | |
| 1812 #ifdef NEW_GC | |
| 1813 GC_SET_PHASE (NONE); | |
| 1814 #endif /* NEW_GC */ | |
| 1815 } | |
| 1816 | |
| 1817 #ifdef NEW_GC | |
| 1818 void | |
| 1819 gc_suspend_mark_phase (void) | |
| 1820 { | |
| 1821 PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection); | |
| 1822 write_barrier_enabled = 1; | |
| 1823 consing_since_gc = 0; | |
| 1824 vdb_start_dirty_bits_recording (); | |
| 1825 } | |
| 1826 | |
| 1827 int | |
| 1828 gc_resume_mark_phase (void) | |
| 1829 { | |
| 1830 PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection); | |
| 1831 assert (write_barrier_enabled); | |
| 1832 vdb_stop_dirty_bits_recording (); | |
| 1833 write_barrier_enabled = 0; | |
| 1834 return vdb_read_dirty_bits (); | |
| 1835 } | |
| 1836 | |
| 1837 int | |
| 1838 gc_mark (int incremental) | |
| 1839 { | |
| 1840 GC_SET_PHASE (MARK); | |
| 1841 if (!incremental) | |
| 1842 { | |
| 1843 kkcc_marking (0); | |
| 1844 } | |
| 1845 else | |
| 1846 { | |
| 1847 kkcc_marking (gc_incremental_traversal_threshold); | |
| 1848 if (!KKCC_GC_STACK_EMPTY) | |
| 1849 { | |
| 1850 gc_suspend_mark_phase (); | |
| 1851 return 0; | |
| 1852 } | |
| 1853 } | |
| 1854 return 1; | |
| 1855 } | |
| 1856 | |
| 1857 int | |
| 1858 gc_resume_mark (int incremental) | |
| 1859 { | |
| 1860 if (!incremental) | |
| 1861 { | |
| 1862 if (!KKCC_GC_STACK_EMPTY) | |
| 1863 { | |
| 1864 GC_STAT_RESUME_GC; | |
| 1865 /* An incremental garbage collection is already running --- | |
| 1866 now wrap it up and resume it atomically. */ | |
| 1867 gc_resume_mark_phase (); | |
| 1868 gc_mark_root_set (REPUSH_ROOT_SET); | |
| 1869 kkcc_marking (0); | |
| 1870 } | |
| 1871 } | |
| 1872 else | |
| 1873 { | |
| 1874 int repushed_objects; | |
| 1875 int mark_work; | |
| 1876 GC_STAT_RESUME_GC; | |
| 1877 repushed_objects = gc_resume_mark_phase (); | |
| 1878 mark_work = (gc_incremental_traversal_threshold > repushed_objects) ? | |
| 1879 gc_incremental_traversal_threshold : repushed_objects; | |
| 1880 kkcc_marking (mark_work); | |
| 1881 if (KKCC_GC_STACK_EMPTY) | |
| 1882 { | |
| 1883 /* Mark root set again and finish up marking. */ | |
| 1884 gc_mark_root_set (REPUSH_ROOT_SET); | |
| 1885 kkcc_marking (0); | |
| 1886 } | |
| 1887 else | |
| 1888 { | |
| 1889 gc_suspend_mark_phase (); | |
| 1890 return 0; | |
| 1891 } | |
| 1892 } | |
| 1893 return 1; | |
| 1894 } | |
| 1895 | |
| 1896 | |
| 1897 void | |
| 1898 gc_1 (int incremental) | |
| 1899 { | |
| 1900 switch (GC_PHASE) | |
| 1901 { | |
| 1902 case NONE: | |
| 1903 gc_prepare (); | |
| 1904 kkcc_gc_stack_init(); | |
| 1905 #ifdef DEBUG_XEMACS | |
| 1906 kkcc_bt_init (); | |
| 1907 #endif | |
| 1908 case INIT_GC: | |
| 1909 gc_mark_root_set (PUSH_ROOT_SET); | |
| 1910 case PUSH_ROOT_SET: | |
| 1911 if (!gc_mark (incremental)) | |
| 1912 return; /* suspend gc */ | |
| 1913 case MARK: | |
| 1914 if (!KKCC_GC_STACK_EMPTY) | |
| 1915 if (!gc_resume_mark (incremental)) | |
| 1916 return; /* suspend gc */ | |
| 1917 gc_finish_mark (); | |
| 3263 | 1918 case FINISH_MARK: |
| 1919 gc_finalize (); | |
| 3092 | 1920 kkcc_gc_stack_free (); |
| 1921 #ifdef DEBUG_XEMACS | |
| 1922 kkcc_bt_free (); | |
| 1923 #endif | |
| 1924 case FINALIZE: | |
| 1925 gc_sweep (); | |
| 1926 case SWEEP: | |
| 1927 gc_finish (); | |
| 1928 case FINISH_GC: | |
| 1929 break; | |
| 1930 } | |
| 1931 } | |
| 1932 | |
| 1933 void gc (int incremental) | |
| 1934 { | |
| 1935 if (gc_currently_forbidden | |
| 1936 || in_display | |
| 1937 || preparing_for_armageddon) | |
| 1938 return; | |
| 1939 | |
| 1940 /* Very important to prevent GC during any of the following | |
| 1941 stuff that might run Lisp code; otherwise, we'll likely | |
| 1942 have infinite GC recursion. */ | |
| 1943 speccount = begin_gc_forbidden (); | |
| 1944 | |
| 3267 | 1945 show_gc_cursor_and_message (); |
| 1946 | |
| 3092 | 1947 gc_1 (incremental); |
| 1948 | |
| 3267 | 1949 remove_gc_cursor_and_message (); |
| 1950 | |
| 3092 | 1951 /* now stop inhibiting GC */ |
| 1952 unbind_to (speccount); | |
| 1953 } | |
| 1954 | |
| 1955 void | |
| 1956 gc_full (void) | |
| 1957 { | |
| 1958 gc (0); | |
| 1959 } | |
| 1960 | |
| 1961 DEFUN ("gc-full", Fgc_full, 0, 0, "", /* | |
| 1962 This function performs a full garbage collection. If an incremental | |
| 1963 garbage collection is already running, it completes without any | |
| 1964 further interruption. This function guarantees that unused objects | |
| 1965 are freed when it returns. Garbage collection happens automatically if | |
| 1966 the client allocates more than `gc-cons-threshold' bytes of Lisp data | |
| 1967 since the previous garbage collection. | |
| 1968 */ | |
| 1969 ()) | |
| 1970 { | |
| 1971 gc_full (); | |
| 1972 return Qt; | |
| 1973 } | |
| 1974 | |
| 1975 void | |
| 1976 gc_incremental (void) | |
| 1977 { | |
| 1978 gc (allow_incremental_gc); | |
| 1979 } | |
| 1980 | |
| 1981 DEFUN ("gc-incremental", Fgc_incremental, 0, 0, "", /* | |
| 1982 This function starts an incremental garbage collection. If an | |
| 1983 incremental garbage collection is already running, the next cycle | |
| 1984 starts. Note that this function has not necessarily freed any memory | |
| 1985 when it returns. This function only guarantees, that the traversal of | |
| 1986 the heap makes progress. The next cycle of incremental garbage | |
| 1987 collection happens automatically if the client allocates more than | |
| 1988 `gc-incremental-cons-threshold' bytes of Lisp data since previous | |
| 1989 garbage collection. | |
| 1990 */ | |
| 1991 ()) | |
| 1992 { | |
| 1993 gc_incremental (); | |
| 1994 return Qt; | |
| 1995 } | |
| 1996 #else /* not NEW_GC */ | |
| 1997 void garbage_collect_1 (void) | |
| 1998 { | |
| 1999 if (gc_in_progress | |
| 2000 || gc_currently_forbidden | |
| 2001 || in_display | |
| 2002 || preparing_for_armageddon) | |
| 2003 return; | |
| 2004 | |
| 2005 /* Very important to prevent GC during any of the following | |
| 2006 stuff that might run Lisp code; otherwise, we'll likely | |
| 2007 have infinite GC recursion. */ | |
| 2008 speccount = begin_gc_forbidden (); | |
| 2009 | |
| 3267 | 2010 show_gc_cursor_and_message (); |
| 2011 | |
| 3092 | 2012 gc_prepare (); |
| 2013 #ifdef USE_KKCC | |
| 2014 kkcc_gc_stack_init(); | |
| 2015 #ifdef DEBUG_XEMACS | |
| 2016 kkcc_bt_init (); | |
| 2017 #endif | |
| 2018 #endif /* USE_KKCC */ | |
| 2019 gc_mark_root_set (); | |
| 2020 #ifdef USE_KKCC | |
| 2021 kkcc_marking (0); | |
| 2022 #endif /* USE_KKCC */ | |
| 2023 gc_finish_mark (); | |
| 2024 #ifdef USE_KKCC | |
| 2025 kkcc_gc_stack_free (); | |
| 2026 #ifdef DEBUG_XEMACS | |
| 2027 kkcc_bt_free (); | |
| 2028 #endif | |
| 2029 #endif /* USE_KKCC */ | |
| 2030 gc_sweep_1 (); | |
| 2031 gc_finish (); | |
| 2032 | |
| 3267 | 2033 remove_gc_cursor_and_message (); |
| 2034 | |
| 3092 | 2035 /* now stop inhibiting GC */ |
| 2036 unbind_to (speccount); | |
| 2037 } | |
| 2038 #endif /* not NEW_GC */ | |
| 2039 | |
| 2040 | |
| 2041 /************************************************************************/ | |
| 2042 /* Initializations */ | |
| 2043 /************************************************************************/ | |
| 2044 | |
| 2045 /* Initialization */ | |
| 2046 static void | |
| 2047 common_init_gc_early (void) | |
| 2048 { | |
| 2049 Vgc_message = Qzero; | |
| 2050 | |
| 2051 gc_currently_forbidden = 0; | |
| 2052 gc_hooks_inhibited = 0; | |
| 2053 | |
| 2054 need_to_garbage_collect = always_gc; | |
| 2055 | |
| 2056 gc_cons_threshold = GC_CONS_THRESHOLD; | |
| 2057 gc_cons_percentage = 40; /* #### what is optimal? */ | |
| 2058 total_gc_usage_set = 0; | |
| 2059 #ifdef NEW_GC | |
| 2060 gc_cons_incremental_threshold = GC_CONS_INCREMENTAL_THRESHOLD; | |
| 2061 gc_incremental_traversal_threshold = GC_INCREMENTAL_TRAVERSAL_THRESHOLD; | |
| 3263 | 2062 #endif /* NEW_GC */ |
| 3092 | 2063 } |
| 2064 | |
| 2065 void | |
| 2066 init_gc_early (void) | |
| 2067 { | |
| 3263 | 2068 #ifdef NEW_GC |
| 2069 /* Reset the finalizers_to_run list after pdump_load. */ | |
| 2070 Vfinalizers_to_run = Qnil; | |
| 2071 #endif /* NEW_GC */ | |
| 3092 | 2072 } |
| 2073 | |
| 2074 void | |
| 2075 reinit_gc_early (void) | |
| 2076 { | |
| 2077 common_init_gc_early (); | |
| 2078 } | |
| 2079 | |
| 2080 void | |
| 2081 init_gc_once_early (void) | |
| 2082 { | |
| 2083 common_init_gc_early (); | |
| 2084 } | |
| 2085 | |
| 2086 void | |
| 2087 syms_of_gc (void) | |
| 2088 { | |
| 2089 DEFSYMBOL (Qpre_gc_hook); | |
| 2090 DEFSYMBOL (Qpost_gc_hook); | |
| 2091 #ifdef NEW_GC | |
| 2092 DEFSUBR (Fgc_full); | |
| 2093 DEFSUBR (Fgc_incremental); | |
| 2094 #ifdef ERROR_CHECK_GC | |
| 2095 DEFSUBR (Fgc_stats); | |
| 2096 #endif /* not ERROR_CHECK_GC */ | |
| 2097 #endif /* NEW_GC */ | |
| 2098 } | |
| 2099 | |
| 2100 void | |
| 2101 vars_of_gc (void) | |
| 2102 { | |
| 2103 staticpro_nodump (&pre_gc_cursor); | |
| 2104 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4934
diff
changeset
|
2105 QSin_garbage_collection = build_defer_string ("(in garbage collection)"); |
| 3092 | 2106 staticpro (&QSin_garbage_collection); |
| 2107 | |
| 2108 DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold /* | |
| 2109 *Number of bytes of consing between full garbage collections. | |
| 2110 \"Consing\" is a misnomer in that this actually counts allocation | |
| 2111 of all different kinds of objects, not just conses. | |
| 2112 Garbage collection can happen automatically once this many bytes have been | |
| 2113 allocated since the last garbage collection. All data types count. | |
| 2114 | |
| 2115 Garbage collection happens automatically when `eval' or `funcall' are | |
| 2116 called. (Note that `funcall' is called implicitly as part of evaluation.) | |
| 2117 By binding this temporarily to a large number, you can effectively | |
| 2118 prevent garbage collection during a part of the program. | |
| 2119 | |
| 2120 Normally, you cannot set this value less than 10,000 (if you do, it is | |
| 2121 automatically reset during the next garbage collection). However, if | |
| 2122 XEmacs was compiled with DEBUG_XEMACS, this does not happen, allowing | |
| 2123 you to set this value very low to track down problems with insufficient | |
| 2124 GCPRO'ing. If you set this to a negative number, garbage collection will | |
| 2125 happen at *EVERY* call to `eval' or `funcall'. This is an extremely | |
| 2126 effective way to check GCPRO problems, but be warned that your XEmacs | |
| 2127 will be unusable! You almost certainly won't have the patience to wait | |
| 2128 long enough to be able to set it back. | |
| 2129 | |
| 2130 See also `consing-since-gc' and `gc-cons-percentage'. | |
| 2131 */ ); | |
| 2132 | |
| 2133 DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /* | |
| 2134 *Percentage of memory allocated between garbage collections. | |
| 2135 | |
| 2136 Garbage collection will happen if this percentage of the total amount of | |
| 2137 memory used for data (see `lisp-object-memory-usage') has been allocated | |
| 2138 since the last garbage collection. However, it will not happen if less | |
| 2139 than `gc-cons-threshold' bytes have been allocated -- this sets an absolute | |
| 2140 minimum in case very little data has been allocated or the percentage is | |
| 2141 set very low. Set this to 0 to have garbage collection always happen after | |
| 2142 `gc-cons-threshold' bytes have been allocated, regardless of current memory | |
| 2143 usage. | |
| 2144 | |
| 2145 See also `consing-since-gc' and `gc-cons-threshold'. | |
| 2146 */ ); | |
| 2147 | |
| 2148 #ifdef NEW_GC | |
| 2149 DEFVAR_INT ("gc-cons-incremental-threshold", | |
| 2150 &gc_cons_incremental_threshold /* | |
| 2151 *Number of bytes of consing between cycles of incremental garbage | |
| 2152 collections. \"Consing\" is a misnomer in that this actually counts | |
| 2153 allocation of all different kinds of objects, not just conses. The | |
| 2154 next garbage collection cycle can happen automatically once this many | |
| 2155 bytes have been allocated since the last garbage collection cycle. | |
| 2156 All data types count. | |
| 2157 | |
| 2158 See also `gc-cons-threshold'. | |
| 2159 */ ); | |
| 2160 | |
| 2161 DEFVAR_INT ("gc-incremental-traversal-threshold", | |
| 2162 &gc_incremental_traversal_threshold /* | |
| 2163 *Number of elements processed in one cycle of incremental travesal. | |
| 2164 */ ); | |
| 2165 #endif /* NEW_GC */ | |
| 2166 | |
| 2167 DEFVAR_BOOL ("purify-flag", &purify_flag /* | |
| 2168 Non-nil means loading Lisp code in order to dump an executable. | |
| 2169 This means that certain objects should be allocated in readonly space. | |
| 2170 */ ); | |
| 2171 | |
| 2172 DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages /* | |
|
4502
8748a3f7ceb4
Handle varalias chains, custom variables in #'user-variable-p.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
2173 *Non-nil means display messages at start and end of garbage collection. |
| 3092 | 2174 */ ); |
| 2175 garbage_collection_messages = 0; | |
| 2176 | |
| 2177 DEFVAR_LISP ("pre-gc-hook", &Vpre_gc_hook /* | |
| 2178 Function or functions to be run just before each garbage collection. | |
| 2179 Interrupts, garbage collection, and errors are inhibited while this hook | |
| 2180 runs, so be extremely careful in what you add here. In particular, avoid | |
| 2181 consing, and do not interact with the user. | |
| 2182 */ ); | |
| 2183 Vpre_gc_hook = Qnil; | |
| 2184 | |
| 2185 DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook /* | |
| 2186 Function or functions to be run just after each garbage collection. | |
| 2187 Interrupts, garbage collection, and errors are inhibited while this hook | |
| 2188 runs. Each hook is called with one argument which is an alist with | |
| 2189 finalization data. | |
| 2190 */ ); | |
| 2191 Vpost_gc_hook = Qnil; | |
| 2192 | |
| 2193 DEFVAR_LISP ("gc-message", &Vgc_message /* | |
| 2194 String to print to indicate that a garbage collection is in progress. | |
| 2195 This is printed in the echo area. If the selected frame is on a | |
| 2196 window system and `gc-pointer-glyph' specifies a value (i.e. a pointer | |
| 2197 image instance) in the domain of the selected frame, the mouse pointer | |
| 2198 will change instead of this message being printed. | |
| 2199 */ ); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4934
diff
changeset
|
2200 Vgc_message = build_defer_string (gc_default_message); |
| 3092 | 2201 |
| 2202 DEFVAR_LISP ("gc-pointer-glyph", &Vgc_pointer_glyph /* | |
| 2203 Pointer glyph used to indicate that a garbage collection is in progress. | |
| 2204 If the selected window is on a window system and this glyph specifies a | |
| 2205 value (i.e. a pointer image instance) in the domain of the selected | |
| 2206 window, the pointer will be changed as specified during garbage collection. | |
| 2207 Otherwise, a message will be printed in the echo area, as controlled | |
| 2208 by `gc-message'. | |
| 2209 */ ); | |
| 2210 | |
| 2211 #ifdef NEW_GC | |
| 2212 DEFVAR_BOOL ("allow-incremental-gc", &allow_incremental_gc /* | |
| 2213 *Non-nil means to allow incremental garbage collection. Nil prevents | |
| 2214 *incremental garbage collection, the garbage collector then only does | |
| 2215 *full collects (even if (gc-incremental) is called). | |
| 2216 */ ); | |
| 3263 | 2217 |
| 2218 Vfinalizers_to_run = Qnil; | |
| 2219 staticpro_nodump (&Vfinalizers_to_run); | |
| 3092 | 2220 #endif /* NEW_GC */ |
| 2221 } | |
| 2222 | |
| 2223 void | |
| 2224 complex_vars_of_gc (void) | |
| 2225 { | |
| 2226 Vgc_pointer_glyph = Fmake_glyph_internal (Qpointer); | |
| 2227 } |