Marcus Crestani wrote: Marcus, this is awesome! thanks very much for all your work. i especially appreciate the fact that you've done the work to get this working on windows (and mac) as well as unix, provided appropriate versions of gdbinit and such, and taken care of a lot of other little details that really need to be done in order for this to become really usable rather than just an "80%" research project tnat never's quite ready for prime time. you also clearly understand the XEmacs code well and have obviously been very careful in the way you've written and tested your code. i'll take a look at this more extensively later, but a few comments: -- i think we should go ahead and remove the conditionalization on the parts of your patch that convert internal structures to lisp objects. it won't hurt to have the structures be lisp objects always, even with the old gc, and it will make the code much simpler, as well as easier to maintain -- my biggest concern is with gc.c. you just copied a lot of stuff from alloc.c, and this tends to lead to bit-rot. is there a way you could conditionalize it so the functions that you need more or less unchanged remain in alloc.c or are split out into some other file? go ahead and put new code in gc.c, but duplicated code is bad bad bad as it leads to bit-rot and maintenance headaches. -- once you commit this code, i'll start working on stuff you missed, like in file-coding.c/mule-coding.c, where you have non-Lisp struct coding_stream, which contains a DATA pointer to a separate set of instance data, one per type of coding system, which is also a non-Lisp structure often with Lisp elements in it. I'd suggest reworking this to follow the lead of the main coding-system and specifier objects, and incorporate extra data as part of the object itself, making the object stretchy. that reduces greatly the need to create new objects for each new subtype, and simplifies creation of new subtypes. (I'd suggest doing the same for frame, device, etc. for similar reasons, although that can wait.) -- since you are creating a lot of new internal objects, i'd suggest a minor change to the semantics of the object print method. currently if you set it to 0, if calls default_object_printer. for internal objects, which should never escape to Lisp level, we want internal_object_printer instead. currently, even looking among the modules, there is only one object (toolbar-button) that relies on the current behavior by specifying 0 to get default_object_printer, while a number of others (the event-*-data objects -- granted, not currently used) also specify 0 but really want internal_object_printer. your new internal objects do the same. so i'd suggest just changing things in print_internal() to call internal_object_printer when there is no print method, and change the print method for toolbar-button to default_object_printer. overall, thank you very, very much for this work and for your continued commitment to work on generational algorithms and other state-of-the-art stuff! ben

SUPERSEDES <871x1swuzc.fsf(a)informatik.uni-tuebingen.de&gt; I resolved the code duplication in alloc.c and gc.c this way: I moved all garbage collector related code (the old and the new GC) to gc.c. I split up The old collector's main function `garbage_collect_1' in a couple of functions according to the several garbage collection phases to suit the needs of the new collector. So the new collector is able to suspend its work after certain phases, whereas the old collector calls the functions one after another, without interruption. Left in alloc.c are the Lisp object allocation functions (they are where they belong), the definition of lrecords (this can be moved to a more appropriate file once the new allocator is stable and fast enough and the old allocator is removed), the sweep functions of the old garbage collector (need to stay where the definition of lrecords is as long as the old allocator is used), and root-set code like staticpro and mcpro. I have not yet removed the conditionalization from the newly created Lisp objects, because the old allocator has no way to allocate arrays of Lisp objects. This is needed for example by hash tables and dynamic Lisp arrays. Many of the new Lisp objects are based on Lisp arrays. I will remove conditionalization for the ones that are not Lisp arrays after I was able to do more testing. But I added another configuration option `--with-vdb': --with-vdb=TYPE Override auto-detection of virtual-dirty-bit write-barrier implementation for the new garbage collector. TYPE must be one of "auto" (for auto-detection), "posix", "win32", "mach", or "fake" (uses the new garbage collector but disables incremental collections). The default is to use auto-detection. Besides the possibility to test the write barrier on new platforms, the configuration option can be used to test the parts of the patch that convert internal structures to Lisp objects. Configuring with `--with-vdb=fake' disables the write barrier and thus does not allow any incremental collections. The new garbage collector behaves like the old one, thus one can test the new object layout without suffering from crashes caused by the write barrier and/or the incremental collection scheme. For now, top priority is to get my huge workspace committed. Then I'll continue with bug fixing and add enhancements that are more local. I'll commit in a few days to clear the way for Stephen's Xft merge, if nobody objects. ChangeLog addition: 2005-11-21 Marcus Crestani <crestani(a)xemacs.org&gt; Incremental Garbage Collector * configure.ac: Add newgc option; if newgc, turn on kkcc and mc-alloc. Add checks for write barrier, determine which write barrier to use. Add vdb option to override write barrier auto-detection. Generate .gdbinit and .dbxrc. lisp/ChangeLog addition: 2005-11-21 Marcus Crestani <crestani(a)xemacs.org&gt; Incremental Garbage Collector * cus-start.el (all): Add allow-incremental-gc, gc-cons-incremental-threshold, and gc-incremental-traversal-threshold to alloc customization group. * diagnose.el (show-memory-usage): Additionally allocated memory no longer in use, remove. * diagnose.el (show-lrecord-stats): Additionally allocated memory no longer in use, remove. * diagnose.el (show-gc-stats): New. nt/ChangeLog addition: 2005-11-21 Marcus Crestani <crestani(a)xemacs.org&gt; Incremental Garbage Collector * config.inc.samp: Add NEW_GC option. * xemacs.dsp: Add files gc.c, gc.h, vdb.c, vdb.h, and vdb-win32.c. * xemacs.mak: Add NEW_GC option; if NEW_GC, turn on KKCC and MC_ALLOC. src/ChangeLog addition: 2005-11-21 Marcus Crestani <crestani(a)xemacs.org&gt; Incremental Garbage Collector * .cvsignore: Add .dbxrc and .gdbinit. * .dbxrc: Remove. * .dbxrc.in: New, used to generate .dbxrc: If newgc is enabled, do not break on SIGBUS and SIGSEGV. * .gdbinit: Remove. * .gdbinit: New, used to generate .gdbinit: If newgc is enabled, do not break on SIGBUS and SIGSEGV. * Makefile.in.in: Add gc.c, newgc_objs and vdb_objs. * alloc.c: Move the GC related code to gc.c: marking, gc hooks, garbage_collect_1, GC related Lisp functions and variables. Left in alloc.c are the allocation functions, the definition of lrecords, the sweep functions of the old garbage collector, and root-set code like staticpro and mcpro. Remove lrecord_string_data_stats. * alloc.c (DECREMENT_CONS_COUNTER): Remove call to recompute_need_to_garbage_collect. * alloc.c (init_lrecord_stats): Remove additionally allocated memory statistics, i.e. statistics for string data. * alloc.c (alloc_lrecord_array): New. * alloc.c (free_lrecord): Do not explicitly free during gc. Add recompute_need_to_garbage_collect. * alloc.c (make_compiled_function): Field arguments is now a Lisp object, thus init it to Qnil rather than NULL. * alloc.c (struct string_chars_block): * alloc.c (finalize_string): * alloc.c (struct string_chars): * alloc.c (make_uninit_string): * alloc.c (resize_string): * alloc.c (make_string_nocopy): String data is now a Lisp object. Remove code that handled string data specially. * alloc.c (init_lrecord_stats): Remove lrecord_string_data_stats. * alloc.c (common_init_alloc_early): * alloc.c (init_alloc_once_early): * alloc.c (syms_of_alloc): * alloc.c (vars_of_alloc): * alloc.c (complex_vars_of_alloc): Move init code to gc.c's inizializers. * buffer.c: * buffer.c (syms_of_buffer): * buffer.h: * buffer.h (struct buffer_text): Add new Lisp object: buffer_text. * bytecode.c: * bytecode.c (make_compiled_function_args): * bytecode.c (optimize_compiled_function): * bytecode.c (mark_compiled_function): * bytecode.c (finalize_compiled_function): * bytecode.c (syms_of_bytecode): * bytecode.h: * bytecode.h (struct compiled_function_args): * bytecode.h (struct Lisp_Compiled_Function): Add new Lisp object: compiled_function_args. * config.h.in: Add NEW_GC symbol, add VDB_* symbols, and symbols for functions and structs checked for vdb. * console-gtk-impl.h: * console-gtk-impl.h (struct gtk_device): * console-gtk-impl.h (struct gtk_frame): * console-msw-impl.h: * console-msw-impl.h (struct mswindows_device): * console-msw-impl.h (struct msprinter_device): * console-msw-impl.h (struct mswindows_frame): * console-stream-impl.h: * console-stream-impl.h (struct stream_console): * console-stream.c: * console-stream.c (stream_init_console): * console-stream.c (stream_delete_console): * console-stream.h: * console-tty-impl.h: * console-tty-impl.h (struct tty_console): * console-tty-impl.h (struct tty_device): * console-tty.c: * console-tty.c (allocate_tty_console_struct): * console-tty.c (free_tty_console_struct): * console-x-impl.h: * console-x-impl.h (struct x_device): * console-x-impl.h (struct x_frame): * console.c: * console.c (syms_of_console): Add new Lisp objects: tty_console, stream_consle. * device-gtk.c: * device-gtk.c (allocate_gtk_device_struct): * device-gtk.c (free_gtk_device_struct): * device-gtk.c (syms_of_device_gtk): * device-msw.c: * device-msw.c (mswindows_init_device): * device-msw.c (mswindows_delete_device): * device-msw.c (msprinter_init_device): * device-msw.c (msprinter_delete_device): * device-msw.c (syms_of_device_mswindows): * device-tty.c: * device-tty.c (free_tty_device_struct): * device-tty.c (syms_of_device_tty): * device-x.c: * device-x.c (allocate_x_device_struct): * device-x.c (free_x_device_struct): * device-x.c (syms_of_device_x): * device.c: Add new Lisp objects: x_device, gtk_device, tty_device, mswindows_device, msprinter_device. * dumper.c: * dumper.c (pdump_register_sub): Add XD_LISP_OBJECT_PTR. * dumper.c (pdump_register_object_array): New. * dumper.c (pdump_store_new_pointer_offsets): Add XD_LISP_OBJECT_PTR. * dumper.c (pdump_scan_lisp_objects_by_alignment): Remove assert, XD_LISP_OBJECT_PTR may occur as arrays. * dumper.c (pdump_reloc_one_mc): Add XD_LISP_OBJECT_PTR. * dumper.c (pdump_dump_rtables): Dump arrays. * dumper.c (pdump_load_finish): Store and restore state of allow_incremental_gc. Remove lrecord_string_data_stats. * dynarr.c: * dynarr.c (Dynarr_lisp_newf): Special case dynamic Lisp array. * dynarr.c (Dynarr_resize): Special case dynamic Lisp array. * dynarr.c (Dynarr_free): Add dynamic Lisp array. * elhash.c: * elhash.c (htentry): * elhash.c (make_general_lisp_hash_table): * elhash.c (Fcopy_hash_table): * elhash.c (resize_hash_table): * elhash.c (pdump_reorganize_hash_table): * elhash.c (init_elhash_once_early): * elhash.h: Add new Lisp object: hash_table_entry. Make hash_table_entries Lisp objects. * emacs.c (main_1): Install platform's vdb signal handler, add GC init, add syms of GC and vdb, . * emacs.c: Replace garbage_collect_1 calls with gc_full calls. * emacs.c (fatal_error_signal): With vdb enabled, convert SIGSEGV and SIGBUS to SIGABRT. * eval.c (Fsignal): Incremental GC may always run, changes are caught by the write barrier. * eval.c (handle_compiled_function_with_and_rest): * eval.c (funcall_compiled_function): * eval.c (Feval): Invoke incremental GC if need to GC. * eval.c (Ffuncall): Invoke incremental GC if need to GC. * eval.c (run_hook_with_args_in_buffer): Add new Lisp object: compiled_function_args. * event-msw.c (mswindows_wnd_proc): Incremental GC may always run, changes are caught by the write barrier. * events.c (reinit_vars_of_events): Vevent_resource now collectible, staticpro it. * extents.c: * extents.c (gap_array_marker): * extents.c (gap_array): * extents.c (extent_list_marker): * extents.c (extent_list): * extents.c (stack_of_extents): * extents.c (gap_array_make_gap): * extents.c (gap_array_make_marker): * extents.c (gap_array_delete_marker): * extents.c (gap_array_delete_all_markers): * extents.c (make_gap_array): * extents.c (free_gap_array): * extents.c (extent_list_insert): * extents.c (extent_list_make_marker): * extents.c (extent_list_delete_marker): * extents.c (allocate_extent_list): * extents.c (free_extent_list): * extents.c (finalize_extent_info): * extents.c (flush_cached_extent_info): * extents.c (uninit_buffer_extents): * extents.c (allocate_soe): * extents.c (free_soe): * extents.c (syms_of_extents): * extents.h: Add new Lisp object: gap_array_marker, gap_array, extent_list_marker, extent_list, and stack_of_extents. * faces.h: * faces.h (struct face_cachel): Add new Lisp object: face cachel. * frame-gtk.c: * frame-gtk.c (allocate_gtk_frame_struct): * frame-gtk.c (gtk_delete_frame): * frame-gtk.c (syms_of_frame_gtk): * frame-msw.c: * frame-msw.c (mswindows_init_frame_1): * frame-msw.c (mswindows_delete_frame): * frame-msw.c (syms_of_frame_mswindows): * frame-x.c: * frame-x.c (allocate_x_frame_struct): * frame-x.c (x_delete_frame): * frame-x.c (syms_of_frame_x): * frame.c: * frame.c (change_frame_size): * frame.c (syms_of_frame): Add new Lisp object: gtk_console, mswindows_console, and x_console. * glyphs.c (struct expose_ignore_blocktype): * glyphs.c (check_for_ignored_expose): * glyphs.c (register_ignored_expose): * glyphs.c (reinit_vars_of_glyphs): * glyphs.h: * glyphs.h (struct glyph_cachel): * glyphs.h (struct expose_ignore): Add new Lisp object: glyph_cachel and expose_ignore. * lisp.h: Move dynamic array definition down after lrecord inclusion. Add dynamic lisp array macros. Add direct and indirect string data. Add string accessors. Remove lrecord_string_data_stats. * lisp.h (struct Lisp_String_Direct_Data): New. * lisp.h (struct Lisp_String_Indirect_Data): New. * lisp.h (struct Lisp_String): Add indirect flag and Lisp object data. * lrecord.h: Remove lrecord_type numbering. * lrecord.h (enum lrecord_type): Add new Lisp objects. * lrecord.h (MC_ALLOC_CALL_FINALIZER): Add GC statistics. * lrecord.h (enum memory_description_type): Add XD_LISP_OBJECT_BLOCK_PTR. * lrecord.h (XD_LISP_DYNARR_DESC): New. * lrecord.h (alloc_lrecord_array): New. * mc-alloc.c: * mc-alloc.c (MIN_HEAP_INCREASE): * mc-alloc.c (free_link): * mc-alloc.c (page_header): * mc-alloc.c (FREE_HEAP_PAGES): * mc-alloc.c (PH_BLACK_BIT): * mc-alloc.c (get_mark_bit_index): * mc-alloc.c (add_pages_to_lookup_table): * mc-alloc.c (alloc_bit_array): * mc-alloc.c (get_bit): * mc-alloc.c (set_bit): * mc-alloc.c (USE_PNTR_MARK_BITS): * mc-alloc.c (GET_BIT_WORD): * mc-alloc.c (SET_BIT_WORD): * mc-alloc.c (ZERO_MARK_BITS_PNTR): * mc-alloc.c (alloc_mark_bits): * mc-alloc.c (free_mark_bits): * mc-alloc.c (set_mark_bit): * mc-alloc.c (alloc_page_header): * mc-alloc.c (free_page_header): * mc-alloc.c (get_used_list_index): * mc-alloc.c (get_free_list_index): * mc-alloc.c (install_cell_free_list): * mc-alloc.c (install_page_in_used_list): * mc-alloc.c (remove_page_from_used_list): * mc-alloc.c (allocate_new_page): * mc-alloc.c (mc_alloc_1): * mc-alloc.c (mc_alloc_array): * mc-alloc.c (mc_alloc): * mc-alloc.c (mark_free_list): * mc-alloc.c (finalize_page): * mc-alloc.c (finalize_page_for_disksave): * mc-alloc.c (sweep_page): * mc-alloc.c (mc_free): * mc-alloc.c (mc_realloc_1): * mc-alloc.c (mc_realloc_array): * mc-alloc.c (init_mc_allocator): * mc-alloc.c (Fmc_alloc_memory_usage): * mc-alloc.c (maybe_mark_black): * mc-alloc.h: Add incremental garbage collector support, various cleanups. * objects-tty-impl.h: * objects-tty-impl.h (struct tty_color_instance_data): * objects-tty-impl.h (struct tty_font_instance_data): * objects-tty.c: * objects-tty.c (tty_initialize_color_instance): * objects-tty.c (tty_finalize_color_instance): * objects-tty.c (tty_initialize_font_instance): * objects-tty.c (tty_finalize_font_instance): * objects-tty.c (syms_of_objects_tty): * objects.c: New Lisp objects: color_instance_data and font_instance_data. * print.c (print_internal): New Lisp object: string_data. * specifier.c: * specifier.c (finalize_specifier): * specifier.c (set_specifier_caching): * specifier.c (syms_of_specifier): * specifier.h: * specifier.h (struct specifier_caching): New Lisp object: specifier caching. * syntax.c: * syntax.c (init_buffer_syntax_cache): * syntax.c (uninit_buffer_syntax_cache): * syntax.c (syms_of_syntax): * syntax.h: * syntax.h (struct syntax_cache): New Lisp object: syntax_cache. * window.c: * window.c (allocate_window): * window.c (make_dummy_parent): * window.c (syms_of_window): New Lisp objects: face_cachel, fache_cachel_dynarr, glyph_cachel, and glyph_cachel_dynarr. New files: * gc.c: Moved code from alloc.c. Split up garbage_collect_1 in a couple of smaller functions. * gc.h: Incremental Garbage Collector * vdb-fake.c: Virtual dirty bit fake implementation. * vdb-mach.c: Virtual dirty bit implementation for Mach systems. * vdb-posix.c: Virtual dirty bit implementation for POSIX systems. * vdb-win32.c: Virtual dirty bit implementation for Win32 systems. * vdb.c: * vdb.h: Platform independent virtual dirty bit implementation. Remove files: * .dbxrc: * .gdbinit: Now generated by configure script. diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/configure newgc-xemacs-21.5/configure --- xemacs-21.5/configure 2005-11-17 00:28:02.000000000 +0100 +++ newgc-xemacs-21.5/configure 2005-11-22 12:20:53.000000000 +0100 ＠＠ -1154,6 +1154,14 ＠＠ with `mc-alloc'). --with-kkcc Enable experimental new GC algorithms. --with-mc-alloc Enable experimental new allocator. + --with-newgc Enable new incremental garbage collector. + --with-vdb=TYPE Override auto-detection of virtual-dirty-bit + write-barrier implementation for the new garbage + collector. TYPE must be one of "auto" (for + auto-detection), "posix", "win32", "mach", or "fake" + (uses the new garbage collector but disables + incremental collections). The default is to use + auto-detection. Emacs Lisp options ------------------ ＠＠ -3366,6 +3374,105 ＠＠ else enable_mc_alloc=yes fi; +# If --with-newgc or --without-newgc were given then copy the value to the +# equivalent enable_newgc variable. +if test "${with_newgc+set}" = set; then + enable_newgc="$with_newgc" +fi; +# If -enable-newgc or --disable-newgc were given then copy the value to the +# equivalent with_newgc variable. +if test "${enable_newgc+set}" = set; then + with_newgc="$enable_newgc" +fi; +# Check whether --with-newgc or --without-newgc was given. +if test "${with_newgc+set}" = set; then + enableval="$with_newgc" + withval="$with_newgc" + +fi; +_vdb_notfirst="" +with_vdb_auto= +enable_vdb_auto= +with_vdb_posix= +enable_vdb_posix= +with_vdb_win32= +enable_vdb_win32= +with_vdb_mach= +enable_vdb_mach= +with_vdb_fake= +enable_vdb_fake= +with_vdb_no= +enable_vdb_no= + +_vdb_types="auto posix win32 mach fake no" +_vdb_default="auto,posix,win32,mach,fake,no" + + + +# If --with-vdb or --without-vdb were given then copy the value to the +# equivalent enable_vdb variable. +if test "${with_vdb+set}" = set; then + enable_vdb="$with_vdb" +fi; +# If -enable-vdb or --disable-vdb were given then copy the value to the +# equivalent with_vdb variable. +if test "${enable_vdb+set}" = set; then + with_vdb="$enable_vdb" +fi; +# Check whether --with-vdb or --without-vdb was given. +if test "${with_vdb+set}" = set; then + enableval="$with_vdb" + withval="$with_vdb" + for y in $_vdb_types; do + eval "with_vdb_$y=no" + eval "enable_vdb_$y=no" +done +for x in `echo "$with_vdb" | sed -e 's/,/ /g'` ; do + _vdb_all_default="" + _vdb_found="" + case "$x" in + n | no | non | none ) _vdb_all_default=no ;; + a | al | all | both ) _vdb_all_default=yes ;; + esac + + if test -z "$_vdb_all_default"; then + for y in $_vdb_types; do + if test "$x" = "$y"; then + _vdb_found=yes + eval "with_vdb_$y=yes" + eval "enable_vdb_$y=yes" + elif test "$x" = "no$y"; then + _vdb_found=yes + eval "with_vdb_$y=no" + eval "enable_vdb_$y=no" + fi + done + test -z "$_vdb_found" && _vdb_bogus=yes + fi + if test "$_vdb_bogus" = "yes" -o \ + \( -n "$_vdb_all_default" -a -n "$_vdb_notfirst" \) ; then + (echo "$progname: Usage error:" +echo " " "Valid values for the --with-vdb option are: +$_vdb_types. With prefix \"no\", switch it off. +Defaults may be overridden with \`all' or \`none' first in the list. +Hardcoded default is: $_vdb_default." +echo " Use \`$progname --help' to show usage.") >&2 && exit 1 + elif test -n "$_vdb_all_default" ; then + for y in $_vdb_types; do + eval "with_vdb_$y=$_vdb_all_default" + eval "enable_vdb_$y=$_vdb_all_default" + done + fi + _vdb_notfirst=yes +done +unset _vdb_bogus _vdb_found _vdb_notfirst _vdb_types +unset _vdb_default _vdb_all_default x y + + + +else + enable_vdb="auto" +fi; # If --with-modules or --without-modules were given then copy the value to the # equivalent enable_modules variable. ＠＠ -4431,6 +4538,38 ＠＠ esac fi +if test "$enable_newgc" = "yes"; then + if test "$enable_vdb" = "auto"; then + case "$opsys" in + darwin ) cat >>confdefs.h <<\_ACEOF +#define VDB_MACH 1 +_ACEOF + have_vdb_mach=yes ;; + cygwin* ) cat >>confdefs.h <<\_ACEOF +#define VDB_WIN32 1 +_ACEOF + have_vdb_win32=yes ;; + linux* ) check_vdb_posix=yes ;; + freebsd ) check_vdb_posix=yes ;; + * ) check_vdb_posix=yes ;; + esac + else + case "$enable_vdb" in + mach ) cat >>confdefs.h <<\_ACEOF +#define VDB_MACH 1 +_ACEOF + have_vdb_mach=yes ;; + win32 ) cat >>confdefs.h <<\_ACEOF +#define VDB_WIN32 1 +_ACEOF + have_vdb_win32=yes ;; + posix ) check_vdb_posix=yes ;; + fake ) have_vdb_fake=yes ;; + no ) have_vdb_fake=yes ;; + esac + fi +fi + if test -z "$with_dynamic"; then case "$opsys" in hpux* | sunos4* ) with_dynamic=no ;; ＠＠ -8630,6 +8769,11 ＠＠ fi fi +if test "$enable_newgc" = "yes"; then + enable_mc_alloc=yes + enable_kkcc=yes +fi + test "$verbose" = "yes" && \ for var in libs_machine libs_system libs_termcap libs_standard objects_machine objects_system c_switch_machine c_switch_system ld_switch_machine ld_switch_system unexec ld_switch_shared ld lib_gcc ld_text_start_addr start_files ordinary_link have_terminfo mail_use_flock mail_use_lockf; do eval "echo \"$var = '\$$var'\""; done && echo "" ＠＠ -28581,6 +28725,654 ＠＠ esac fi +if test "$check_vdb_posix" = "yes" ; then + echo "$as_me:$LINENO: checking for mprotect" >&5 +echo $ECHO_N "checking for mprotect... $ECHO_C" >&6 +if test "${ac_cv_func_mprotect+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define mprotect to an innocuous variant, in case <limits.h> declares mprotect. + For example, HP-UX 11i <limits.h> declares gettimeofday. */ +#define mprotect innocuous_mprotect + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char mprotect (); below. + Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + <limits.h> exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + +#undef mprotect + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char mprotect (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_mprotect) || defined (__stub___mprotect) +choke me +#else +char (*f) () = mprotect; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != mprotect; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_func_mprotect=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_mprotect=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_mprotect" >&5 +echo "${ECHO_T}$ac_cv_func_mprotect" >&6 +if test $ac_cv_func_mprotect = yes; then + cat >>confdefs.h <<\_ACEOF +#define HAVE_MPROTECT 1 +_ACEOF + have_vdb_mprotect=yes +fi + + + echo "$as_me:$LINENO: checking for sigaction" >&5 +echo $ECHO_N "checking for sigaction... $ECHO_C" >&6 +if test "${ac_cv_func_sigaction+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define sigaction to an innocuous variant, in case <limits.h> declares sigaction. + For example, HP-UX 11i <limits.h> declares gettimeofday. */ +#define sigaction innocuous_sigaction + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char sigaction (); below. + Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + <limits.h> exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + +#undef sigaction + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char sigaction (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_sigaction) || defined (__stub___sigaction) +choke me +#else +char (*f) () = sigaction; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != sigaction; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_func_sigaction=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_sigaction=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_sigaction" >&5 +echo "${ECHO_T}$ac_cv_func_sigaction" >&6 +if test $ac_cv_func_sigaction = yes; then + cat >>confdefs.h <<\_ACEOF +#define HAVE_SIGACTION 1 +_ACEOF + have_vdb_sigaction=yes +else + have_vdb_sigaction=no +fi + + echo "$as_me:$LINENO: checking for struct siginfo.si_addr" >&5 +echo $ECHO_N "checking for struct siginfo.si_addr... $ECHO_C" >&6 +if test "${ac_cv_member_struct_siginfo_si_addr+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <signal.h> + +int +main () +{ +static struct siginfo ac_aggr; +if (ac_aggr.si_addr) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_member_struct_siginfo_si_addr=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <signal.h> + +int +main () +{ +static struct siginfo ac_aggr; +if (sizeof ac_aggr.si_addr) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_member_struct_siginfo_si_addr=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_member_struct_siginfo_si_addr=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_member_struct_siginfo_si_addr" >&5 +echo "${ECHO_T}$ac_cv_member_struct_siginfo_si_addr" >&6 +if test $ac_cv_member_struct_siginfo_si_addr = yes; then + cat >>confdefs.h <<\_ACEOF +#define HAVE_STRUCT_SIGINFO_SI_ADDR 1 +_ACEOF + have_si_addr=yes +fi + + echo "$as_me:$LINENO: checking for siginfo_t.si_addr" >&5 +echo $ECHO_N "checking for siginfo_t.si_addr... $ECHO_C" >&6 +if test "${ac_cv_member_siginfo_t_si_addr+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <signal.h> + +int +main () +{ +static siginfo_t ac_aggr; +if (ac_aggr.si_addr) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_member_siginfo_t_si_addr=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <signal.h> + +int +main () +{ +static siginfo_t ac_aggr; +if (sizeof ac_aggr.si_addr) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_member_siginfo_t_si_addr=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_member_siginfo_t_si_addr=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_member_siginfo_t_si_addr" >&5 +echo "${ECHO_T}$ac_cv_member_siginfo_t_si_addr" >&6 +if test $ac_cv_member_siginfo_t_si_addr = yes; then + cat >>confdefs.h <<\_ACEOF +#define HAVE_SIGINFO_T_SI_ADDR 1 +_ACEOF + have_si_addr=yes +fi + + if test "$have_si_addr" != "yes" ; then + have_vdb_sigaction=no + fi + + echo "$as_me:$LINENO: checking for signal" >&5 +echo $ECHO_N "checking for signal... $ECHO_C" >&6 +if test "${ac_cv_func_signal+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define signal to an innocuous variant, in case <limits.h> declares signal. + For example, HP-UX 11i <limits.h> declares gettimeofday. */ +#define signal innocuous_signal + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char signal (); below. + Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + <limits.h> exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + +#undef signal + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char signal (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_signal) || defined (__stub___signal) +choke me +#else +char (*f) () = signal; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != signal; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_func_signal=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_func_signal=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_func_signal" >&5 +echo "${ECHO_T}$ac_cv_func_signal" >&6 +if test $ac_cv_func_signal = yes; then + cat >>confdefs.h <<\_ACEOF +#define HAVE_SIGNAL 1 +_ACEOF + have_vdb_signal=yes +fi + + echo "$as_me:$LINENO: checking for struct sigcontext.cr2" >&5 +echo $ECHO_N "checking for struct sigcontext.cr2... $ECHO_C" >&6 +if test "${ac_cv_member_struct_sigcontext_cr2+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <signal.h> + +int +main () +{ +static struct sigcontext ac_aggr; +if (ac_aggr.cr2) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_member_struct_sigcontext_cr2=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <signal.h> + +int +main () +{ +static struct sigcontext ac_aggr; +if (sizeof ac_aggr.cr2) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_member_struct_sigcontext_cr2=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_member_struct_sigcontext_cr2=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_member_struct_sigcontext_cr2" >&5 +echo "${ECHO_T}$ac_cv_member_struct_sigcontext_cr2" >&6 +if test $ac_cv_member_struct_sigcontext_cr2 = yes; then + cat >>confdefs.h <<\_ACEOF +#define HAVE_STRUCT_SIGCONTEXT_CR2 1 +_ACEOF + have_cr2=yes +fi + + + if test "$have_cr2" != "yes" ; then + have_vdb_signal=no + fi + + if test "$have_vdb_mprotect" != "yes" ; then + have_vdb_sigaction=no + have_vdb_signal=no + fi + + if test "$have_vdb_sigaction" != "yes" -a "$have_vdb_signal" != "yes" ; then + have_vdb_posix=no + have_vdb_fake=yes + else + have_vdb_posix=yes + have_vdb_fake=no + fi +fi + ＠＠ -37220,14 +38012,14 ＠＠ fi -if test -f "$srcdir/src/.gdbinit" -a ! -f "src/.gdbinit"; then - test "$verbose" = "yes" && echo "creating src/.gdbinit" - echo "source $srcdir/src/.gdbinit" > "src/.gdbinit" +if test -f "$srcdir/src/.gdbinit.in" -a ! -f "src/.gdbinit.in"; then + test "$verbose" = "yes" && echo "creating src/.gdbinit.in" + echo "source $srcdir/src/.gdbinit.in" > "src/.gdbinit.in" fi -if test -f "$srcdir/src/.dbxrc" -a ! -f "src/.dbxrc"; then - test "$verbose" = "yes" && echo "creating src/.dbxrc" - echo ". $srcdir/src/.dbxrc" > "src/.dbxrc" +if test -f "$srcdir/src/.dbxrc.in" -a ! -f "src/.dbxrc.in"; then + test "$verbose" = "yes" && echo "creating src/.dbxrc.in" + echo ". $srcdir/src/.dbxrc.in" > "src/.dbxrc.in" fi if test -f "$srcdir/TAGS" -a ! -f "TAGS"; then ＠＠ -37529,6 +38321,18 ＠＠ #define MC_ALLOC 1 _ACEOF +test "$enable_newgc" = "yes" && cat >>confdefs.h <<\_ACEOF +#define NEW_GC 1 +_ACEOF + +test "$have_vdb_posix" = "yes" && cat >>confdefs.h <<\_ACEOF +#define VDB_POSIX 1 +_ACEOF + +test "$have_vdb_fake" = "yes" && cat >>confdefs.h <<\_ACEOF +#define VDB_FAKE 1 +_ACEOF + test "$enable_quick_build" = "yes" && cat >>confdefs.h <<\_ACEOF #define QUICK_BUILD 1 _ACEOF ＠＠ -37830,6 +38634,32 ＠＠ echo " WARNING: turn it off." echo " WARNING: ---------------------------------------------------------" fi +test "$enable_newgc" = yes && echo " Using the new incremental garbage collector." +if test "$have_vdb_posix" = yes ; then + if test "$have_vdb_sigaction" = yes ; then + echo " Using POSIX sigaction() to install fault handler." + else + echo " Using POSIX signal() to install vdb fault handler." + fi +fi +if test "$have_vdb_win32" = yes ; then + echo " Using special WIN32 vdb fault handler." +fi +if test "$have_vdb_mach" = yes ; then + echo " Using mach exception mechanism as vdb fault handler." +fi +if test "$have_vdb_fake" = yes && test "$enable_vdb" != fake; then + echo " WARNING: ---------------------------------------------------------" + echo " WARNING: The new incremental garbage collector is enabled, but" + echo " WARNING: a virtual dirty bit implementation is not yet available" + echo " WARNING: on this system. XEmacs will crash if you try to switch on" + echo " WARNUNG: incremental garbage collection!" + echo " WARNING: Use \`--disable-newgc' to turn incremental gc off." + echo " WARNING: ---------------------------------------------------------" +fi +if test "$have_vdb_fake" = yes && test "$enable_vdb" == fake; then + echo " Virtual dirty bit write barrier manually disabled." +fi test "$enable_pdump" = yes && echo " Using the new portable dumper." test "$enable_dump_in_exec" = yes && echo " Dumping into executable." test "$enable_debug" = yes && echo " Compiling in support for extra debugging code." ＠＠ -39254,6 +40084,70 ＠＠ chmod 444 Makefile.new mv -f Makefile.new GNUmakefile + if test -r ".gdbinit.in"; then + rm -f junk.c + < .gdbinit.in \ + sed -e '/^# Generated/d' \ + -e 's%/\*\*/#.*%%' \ + -e 's/^ *# */#/' \ + -e '/^##/d' \ + -e '/^#/ { +p +d +}' \ + -e '/./ { +s/\([\"]\)/\\\1/g +s/^/"/ +s/$/"/ +}' > junk.c; + + echo creating $dir/.gdbinit +$CPP -I. -I${srcdir}/src junk.c \ + | sed -e 's/^\#.*//' \ + -e 's/^[ TAB][ TAB]*$//'\ + -e 's/^ / /' \ + -e '/^[ ]*$/d' \ + -e '/^\"/ { + s/\\\([\"]\)/\1/g + s/^[ TAB]*\"// + s/\"[ TAB]*$// +}' > Makefile.new + chmod 444 Makefile.new + mv -f Makefile.new .gdbinit + + fi + if test -r ".dbxrc.in"; then + rm -f junk.c + < .dbxrc.in \ + sed -e '/^# Generated/d' \ + -e 's%/\*\*/#.*%%' \ + -e 's/^ *# */#/' \ + -e '/^##/d' \ + -e '/^#/ { +p +d +}' \ + -e '/./ { +s/\([\"]\)/\\\1/g +s/^/"/ +s/$/"/ +}' > junk.c; + + echo creating $dir/.dbxrc +$CPP -I. -I${srcdir}/src junk.c \ + | sed -e 's/^\#.*//' \ + -e 's/^[ TAB][ TAB]*$//'\ + -e 's/^ / /' \ + -e '/^[ ]*$/d' \ + -e '/^\"/ { + s/\\\([\"]\)/\1/g + s/^[ TAB]*\"// + s/\"[ TAB]*$// +}' > Makefile.new + chmod 444 Makefile.new + mv -f Makefile.new .dbxrc + + fi if test -r "xemacs.def.in"; then rm -f junk.c cp xemacs.def.in junk.c diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/configure.ac newgc-xemacs-21.5/configure.ac --- xemacs-21.5/configure.ac 2005-11-17 00:28:02.000000000 +0100 +++ newgc-xemacs-21.5/configure.ac 2005-11-22 12:20:40.000000000 +0100 ＠＠ -875,6 +875,18 ＠＠ XE_MERGED_ARG([mc-alloc], AC_HELP_STRING([--enable-mc-alloc],[Enable experimental new allocator.]), [], [enable_mc_alloc=yes]) +XE_MERGED_ARG([newgc], + AC_HELP_STRING([--enable-newgc],[Enable new incremental garbage collector.]), + [], []) +XE_COMPLEX_ARG([vdb], + AC_HELP_STRING([--enable-vdb=TYPE],[Override auto-detection of + virtual-dirty-bit write-barrier implementation for the + new garbage collector. TYPE must be one of "auto" (for + auto-detection), "posix", "win32", "mach", or "fake" + (uses the new garbage collector but disables + incremental collections). The default is to + use auto-detection.]), + [], [enable_vdb="auto"],[auto,posix,win32,mach,fake,no]) dnl XE_HELP_SUBSECTION([Emacs Lisp options]) XE_MERGED_ARG([modules], ＠＠ -1683,6 +1695,29 ＠＠ esac fi +if test "$enable_newgc" = "yes"; then + if test "$enable_vdb" = "auto"; then + case "$opsys" in + darwin ) AC_DEFINE(VDB_MACH) have_vdb_mach=yes ;; + cygwin* ) AC_DEFINE(VDB_WIN32) have_vdb_win32=yes ;; + linux* ) check_vdb_posix=yes ;; + freebsd ) check_vdb_posix=yes ;; +dnl bail out immediately +dnl * ) have_vdb_fake=yes ;; +dnl if not sure, try posix first, maybe we are lucky + * ) check_vdb_posix=yes ;; + esac + else + case "$enable_vdb" in + mach ) AC_DEFINE(VDB_MACH) have_vdb_mach=yes ;; + win32 ) AC_DEFINE(VDB_WIN32) have_vdb_win32=yes ;; + posix ) check_vdb_posix=yes ;; + fake ) have_vdb_fake=yes ;; + no ) have_vdb_fake=yes ;; + esac + fi +fi + if test -z "$with_dynamic"; then case "$opsys" in hpux* | sunos4* ) with_dynamic=no ;; ＠＠ -2044,6 +2079,12 ＠＠ fi fi +dnl New incremental garbage collector +if test "$enable_newgc" = "yes"; then + enable_mc_alloc=yes + enable_kkcc=yes +fi + dnl For debugging... test "$verbose" = "yes" && \ PRINT_VAR(libs_machine libs_system libs_termcap libs_standard ＠＠ -4431,6 +4472,48 ＠＠ esac fi +dnl check for vdb-related stuff +if test "$check_vdb_posix" = "yes" ; then + dnl no mprotect, no vdb + AC_CHECK_FUNC(mprotect,AC_DEFINE(HAVE_MPROTECT) have_vdb_mprotect=yes,) + + dnl sigaction needs either struct siginfo or siginfo_t + AC_CHECK_FUNC(sigaction, AC_DEFINE(HAVE_SIGACTION) have_vdb_sigaction=yes, + have_vdb_sigaction=no) + AC_CHECK_MEMBER(struct siginfo.si_addr, + AC_DEFINE(HAVE_STRUCT_SIGINFO_SI_ADDR) have_si_addr=yes,, + [#include <signal.h>]) + AC_CHECK_MEMBER(siginfo_t.si_addr, + AC_DEFINE(HAVE_SIGINFO_T_SI_ADDR) have_si_addr=yes,, + [#include <signal.h>]) + if test "$have_si_addr" != "yes" ; then + have_vdb_sigaction=no + fi + + dnl signal needs struct sigcontext + AC_CHECK_FUNC(signal, AC_DEFINE(HAVE_SIGNAL) have_vdb_signal=yes,) + AC_CHECK_MEMBER(struct sigcontext.cr2, + AC_DEFINE(HAVE_STRUCT_SIGCONTEXT_CR2) have_cr2=yes,, + [#include <signal.h>]) + + if test "$have_cr2" != "yes" ; then + have_vdb_signal=no + fi + + if test "$have_vdb_mprotect" != "yes" ; then + have_vdb_sigaction=no + have_vdb_signal=no + fi + + if test "$have_vdb_sigaction" != "yes" -a "$have_vdb_signal" != "yes" ; then + have_vdb_posix=no + have_vdb_fake=yes + else + have_vdb_posix=yes + have_vdb_fake=no + fi +fi + dnl ---------------------------------------------------------------- dnl Check for Unixoid pty/process support. dnl ---------------------------------------------------------------- ＠＠ -5318,15 +5401,15 ＠＠ dnl ---------------------------------------------- dnl Create a .gdbinit useful for debugging XEmacs -if test -f "$srcdir/src/.gdbinit" -a ! -f "src/.gdbinit"; then - test "$verbose" = "yes" && echo "creating src/.gdbinit" - echo "source $srcdir/src/.gdbinit" > "src/.gdbinit" +if test -f "$srcdir/src/.gdbinit.in" -a ! -f "src/.gdbinit.in"; then + test "$verbose" = "yes" && echo "creating src/.gdbinit.in" + echo "source $srcdir/src/.gdbinit.in" > "src/.gdbinit.in" fi dnl Create a .dbxrc useful for debugging XEmacs -if test -f "$srcdir/src/.dbxrc" -a ! -f "src/.dbxrc"; then - test "$verbose" = "yes" && echo "creating src/.dbxrc" - echo ". $srcdir/src/.dbxrc" > "src/.dbxrc" +if test -f "$srcdir/src/.dbxrc.in" -a ! -f "src/.dbxrc.in"; then + test "$verbose" = "yes" && echo "creating src/.dbxrc.in" + echo ". $srcdir/src/.dbxrc.in" > "src/.dbxrc.in" fi dnl Create a useful TAGS file ＠＠ -5584,6 +5667,9 ＠＠ test "$enable_external_widget" = "yes" && AC_DEFINE(EXTERNAL_WIDGET) test "$enable_kkcc" = "yes" && AC_DEFINE(USE_KKCC) test "$enable_mc_alloc" = "yes" && AC_DEFINE(MC_ALLOC) +test "$enable_newgc" = "yes" && AC_DEFINE(NEW_GC) +test "$have_vdb_posix" = "yes" && AC_DEFINE(VDB_POSIX) +test "$have_vdb_fake" = "yes" && AC_DEFINE(VDB_FAKE) test "$enable_quick_build" = "yes" && AC_DEFINE(QUICK_BUILD) test "$with_purify" = "yes" && AC_DEFINE(PURIFY) test "$with_quantify" = "yes" && AC_DEFINE(QUANTIFY) ＠＠ -5864,6 +5950,32 ＠＠ echo " WARNING: turn it off." echo " WARNING: ---------------------------------------------------------" fi +test "$enable_newgc" = yes && echo " Using the new incremental garbage collector." +if test "$have_vdb_posix" = yes ; then + if test "$have_vdb_sigaction" = yes ; then + echo " Using POSIX sigaction() to install fault handler." + else + echo " Using POSIX signal() to install vdb fault handler." + fi +fi +if test "$have_vdb_win32" = yes ; then + echo " Using special WIN32 vdb fault handler." +fi +if test "$have_vdb_mach" = yes ; then + echo " Using mach exception mechanism as vdb fault handler." +fi +if test "$have_vdb_fake" = yes && test "$enable_vdb" != fake; then + echo " WARNING: ---------------------------------------------------------" + echo " WARNING: The new incremental garbage collector is enabled, but" + echo " WARNING: a virtual dirty bit implementation is not yet available" + echo " WARNING: on this system. XEmacs will crash if you try to switch on" + echo " WARNUNG: incremental garbage collection!" + echo " WARNING: Use \`--disable-newgc' to turn incremental gc off." + echo " WARNING: ---------------------------------------------------------" +fi +if test "$have_vdb_fake" = yes && test "$enable_vdb" == fake; then + echo " Virtual dirty bit write barrier manually disabled." +fi test "$enable_pdump" = yes && echo " Using the new portable dumper." test "$enable_dump_in_exec" = yes && echo " Dumping into executable." test "$enable_debug" = yes && echo " Compiling in support for extra debugging code." ＠＠ -5981,6 +6093,14 ＠＠ MAKE_JUNK_C(Makefile.in) CPP_MAKEFILE(,Makefile) CPP_MAKEFILE(-DUSE_GNU_MAKE,GNUmakefile) + if test -r ".gdbinit.in"; then + MAKE_JUNK_C(.gdbinit.in) + CPP_MAKEFILE(,.gdbinit) + fi + if test -r ".dbxrc.in"; then + MAKE_JUNK_C(.dbxrc.in) + CPP_MAKEFILE(,.dbxrc) + fi if test -r "xemacs.def.in"; then dnl #### We should be using MAKE_JUNK_C instead of the next two lines. dnl #### But the comments in xemacs.def.in need to be converted from C-style diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/lisp/cus-start.el newgc-xemacs-21.5/lisp/cus-start.el --- xemacs-21.5/lisp/cus-start.el 2002-12-12 04:20:36.000000000 +0100 +++ newgc-xemacs-21.5/lisp/cus-start.el 2005-06-14 13:13:37.000000000 +0200 ＠＠ -46,6 +46,7 ＠＠ (let ((all '(;; boolean (abbrev-all-caps abbrev boolean) (allow-deletion-of-last-visible-frame frames boolean) + (allow-incremental-gc alloc boolean) (debug-on-quit debug boolean) (delete-auto-save-files auto-save boolean) (delete-exited-processes processes-basics boolean) ＠＠ -71,6 +72,8 ＠＠ (bell-inhibit-time sound integer) (echo-keystrokes keyboard integer) (gc-cons-threshold alloc integer) + (gc-cons-incremental-threshold alloc integer) + (gc-incremental-traversal-threshold alloc integer) (next-screen-context-lines display integer) (scroll-conservatively display integer) (scroll-step windows integer) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/lisp/diagnose.el newgc-xemacs-21.5/lisp/diagnose.el --- xemacs-21.5/lisp/diagnose.el 2005-11-17 00:28:07.000000000 +0100 +++ newgc-xemacs-21.5/lisp/diagnose.el 2005-11-17 00:08:18.000000000 +0100 ＠＠ -142,7 +142,7 ＠＠ (princ "\n") (map-plist #'(lambda (stat num) (when (string-match - "\\(.*\\)-storage\\(-additional\\)?$" + "\\(.*\\)-storage\\$" (symbol-name stat)) (incf total num) (princ (format fmt ＠＠ -237,10 +237,6 ＠＠ (setq begin (point)) (princ "Allocated with lisp allocator:\n") (show-stats "\\(.*\\)-storage$") - (princ "\n\n") - (setq begin (point)) - (princ "Allocated additionally:\n") - (show-stats "\\(.*\\)-storage-additional$") (princ (format "\n\ngrand total: %s\n" grandtotal))) grandtotal)))) ＠＠ -253,10 +249,9 ＠＠ (page-size (first stats)) (heap-sects (second stats)) (used-plhs (third stats)) - (unmanaged-plhs (fourth stats)) - (free-plhs (fifth stats)) - (globals (sixth stats)) - (mc-malloced-bytes (seventh stats))) + (free-plhs (fourth stats)) + (globals (fifth stats)) + (mc-malloced-bytes (sixth stats))) (with-output-to-temp-buffer "*memory usage*" (flet ((print-used-plhs (text plhs) (let ((sum-n-pages 0) ＠＠ -372,9 +367,6 ＠＠ (print-used-plhs "USED HEAP" used-plhs) (princ "\n\n") - (print-used-plhs "UNMANAGED HEAP" unmanaged-plhs) - (princ "\n\n") - (print-free-plhs "FREE HEAP" free-plhs) (princ "\n\n") ＠＠ -399,3 +391,50 ＠＠ (princ (format fmt "grand total" mc-malloced-bytes))) (+ mc-malloced-bytes))))) + + +(defun show-gc-stats () + "Show statistics about garbage collection cycles." + (interactive) + (let ((buffer "*garbage collection statistics*") + (plist (gc-stats)) + (fmt "%-9s %10s %10s %10s %10s %10s\n")) + (flet ((plist-get-stat (category field) + (or (plist-get plist (intern (concat category field))) + "-")) + (show-stats (category) + (princ (format fmt category + (plist-get-stat category "-total") + (plist-get-stat category "-in-last-gc") + (plist-get-stat category "-in-this-gc") + (plist-get-stat category "-in-last-cycle") + (plist-get-stat category "-in-this-cycle"))))) + (with-output-to-temp-buffer buffer + (save-excursion + (set-buffer buffer) + (princ (format "%s %s\n" "Current phase" (plist-get plist 'phase))) + (princ (make-string 64 ?-)) + (princ "\n") + (princ (format fmt "stat" "total" "last-gc" "this-gc" + "last-cycle" "this-cylce")) + (princ (make-string 64 ?-)) + (princ "\n") + (show-stats "n-gc") + (show-stats "n-cycles") + (show-stats "enqueued") + (show-stats "dequeued") + (show-stats "repushed") + (show-stats "enqueued2") + (show-stats "dequeued2") + (show-stats "finalized") + (show-stats "freed") + (princ (make-string 64 ?-)) + (princ "\n") + (princ (format fmt "explicitly" + "freed:" + (plist-get-stat "explicitly" "-freed") + "tried:" + (plist-get-stat "explicitly" "-tried-freed") + ""))) + + (plist-get plist 'n-gc-total))))) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/nt/config.inc.samp newgc-xemacs-21.5/nt/config.inc.samp --- xemacs-21.5/nt/config.inc.samp 2005-09-26 10:13:00.000000000 +0200 +++ newgc-xemacs-21.5/nt/config.inc.samp 2005-09-27 21:03:09.000000000 +0200 ＠＠ -223,6 +223,9 ＠＠ # Set this to use the new experimental allocator routines MC_ALLOC=1 +# Set this to use the new experimental incremental garbage collector routines +NEW_GC=0 + # Set this to turn on the use of the union type, which gets you improved # type checking of Lisp_Objects -- they're declared as unions instead of # ints, and so places where a Lisp_Object is mistakenly passed to a routine diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/nt/xemacs.dsp newgc-xemacs-21.5/nt/xemacs.dsp --- xemacs-21.5/nt/xemacs.dsp 2005-04-09 01:11:07.000000000 +0200 +++ newgc-xemacs-21.5/nt/xemacs.dsp 2005-06-20 12:18:54.000000000 +0200 ＠＠ -555,6 +555,14 ＠＠ # End Source File # Begin Source File +SOURCE=..\src\gc.c +# End Source File +# Begin Source File + +SOURCE=..\src\gc.h +# End Source File +# Begin Source File + SOURCE=..\src\general.c # End Source File # Begin Source File ＠＠ -1339,6 +1347,18 ＠＠ # End Source File # Begin Source File +SOURCE=..\src\vdb.h +# End Source File +# Begin Source File + +SOURCE=..\src\vdb.c +# End Source File +# Begin Source File + +SOURCE=..\src\vdb-win32.c +# End Source File +# Begin Source File + SOURCE="..\src\vm-limit.c" # End Source File # Begin Source File diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/nt/xemacs.mak newgc-xemacs-21.5/nt/xemacs.mak --- xemacs-21.5/nt/xemacs.mak 2005-11-10 17:41:28.000000000 +0100 +++ newgc-xemacs-21.5/nt/xemacs.mak 2005-11-19 19:05:00.000000000 +0100 ＠＠ -218,6 +218,9 ＠＠ !if !defined(MC_ALLOC) MC_ALLOC=0 !endif +!if !defined(NEW_GC) +NEW_GC=0 +!endif !if !defined(USE_UNION_TYPE) USE_UNION_TYPE=0 !endif ＠＠ -639,9 +642,17 ＠＠ OPT_OBJS=$(OPT_OBJS) $(OUTDIR)\unexnt.obj !endif +!if $(NEW_GC) +OPT_DEFINES=$(OPT_DEFINES) -DNEW_GC +OPT_OBJS=$(OPT_OBJS) $(OUTDIR)\vdb.obj $(OUTDIR)\vdb-win32.obj +USE_KKCC=1 +MC_ALLOC=1 +!endif + !if $(USE_KKCC) OPT_DEFINES=$(OPT_DEFINES) -DUSE_KKCC !endif + !if $(MC_ALLOC) OPT_DEFINES=$(OPT_DEFINES) -DMC_ALLOC OPT_OBJS=$(OPT_OBJS) $(OUTDIR)\mc-alloc.obj ＠＠ -848,6 +859,7 ＠＠ $(OUTDIR)\fns.obj \ $(OUTDIR)\font-lock.obj \ $(OUTDIR)\frame.obj \ + $(OUTDIR)\gc.obj \ $(OUTDIR)\general.obj \ $(OUTDIR)\getloadavg.obj \ $(OUTDIR)\glyphs.obj \ ＠＠ -1259,6 +1271,9 ＠＠ !if $(MC_ALLOC) Using new experimental allocator. !endif +!if $(NEW_GC) + Using new experimental incremental garbage collector. +!endif <<NOKEEP ＠echo -------------------------------------------------------------------- ＠type $(BLDROOT)\Installation diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/alloc.c newgc-xemacs-21.5/src/alloc.c --- xemacs-21.5/src/alloc.c 2005-11-17 00:28:18.000000000 +0100 +++ newgc-xemacs-21.5/src/alloc.c 2005-11-20 17:53:33.000000000 +0100 ＠＠ -52,6 +52,7 ＠＠ #include "extents-impl.h" #include "file-coding.h" #include "frame-impl.h" +#include "gc.h" #include "glyphs.h" #include "opaque.h" #include "lstream.h" ＠＠ -62,6 +63,9 ＠＠ #include "sysfile.h" #include "sysdep.h" #include "window.h" +#ifdef NEW_GC +#include "vdb.h" +#endif /* NEW_GC */ #include "console-stream.h" #ifdef DOUG_LEA_MALLOC ＠＠ -70,8 +74,6 ＠＠ EXFUN (Fgarbage_collect, 0); -static void recompute_need_to_garbage_collect (void); - #if 0 /* this is _way_ too slow to be part of the standard debug options */ #if defined(DEBUG_XEMACS) && defined(MULE) #define VERIFY_STRING_CHARS_INTEGRITY ＠＠ -91,13 +93,6 ＠＠ static Fixnum debug_allocation_backtrace_length; #endif -/* Number of bytes of consing done since the last gc */ -static EMACS_INT consing_since_gc; -EMACS_UINT total_consing; -EMACS_INT total_gc_usage; -int total_gc_usage_set; - -int need_to_garbage_collect; int need_to_check_c_alloca; int need_to_signal_post_gc; int funcall_allocation_flag; ＠＠ -149,6 +144,20 ＠＠ INCREMENT_CONS_COUNTER_1 (size) #endif +#ifdef NEW_GC +/* The call to recompute_need_to_garbage_collect is moved to + free_lrecord, since DECREMENT_CONS_COUNTER is extensively called + during sweep and recomputing need_to_garbage_collect all the time + is not needed. */ +#define DECREMENT_CONS_COUNTER(size) do { \ + consing_since_gc -= (size); \ + total_consing -= (size); \ + if (profiling_active) \ + profile_record_unconsing (size); \ + if (consing_since_gc < 0) \ + consing_since_gc = 0; \ +} while (0) +#else /* not NEW_GC */ #define DECREMENT_CONS_COUNTER(size) do { \ consing_since_gc -= (size); \ total_consing -= (size); \ ＠＠ -158,51 +167,11 ＠＠ consing_since_gc = 0; \ recompute_need_to_garbage_collect (); \ } while (0) - -/* Number of bytes of consing since gc before another gc should be done. */ -static EMACS_INT gc_cons_threshold; - -/* Percentage of consing of total data size before another GC. */ -static EMACS_INT gc_cons_percentage; - -#ifdef ERROR_CHECK_GC -int always_gc; /* Debugging hack; equivalent to - (setq gc-cons-thresold -1) */ -#else -#define always_gc 0 -#endif - -/* Nonzero during gc */ -int gc_in_progress; - -/* Nonzero means display messages at beginning and end of GC. */ - -int garbage_collection_messages; - -/* Number of times GC has happened at this level or below. - * Level 0 is most volatile, contrary to usual convention. - * (Of course, there's only one level at present) */ -EMACS_INT gc_generation_number[1]; +#endif /*not NEW_GC */ /* This is just for use by the printer, to allow things to print uniquely */ int lrecord_uid_counter; -/* Nonzero when calling certain hooks or doing other things where - a GC would be bad */ -int gc_currently_forbidden; - -/* Hooks. */ -Lisp_Object Vpre_gc_hook, Qpre_gc_hook; -Lisp_Object Vpost_gc_hook, Qpost_gc_hook; - -/* "Garbage collecting" */ -Lisp_Object Vgc_message; -Lisp_Object Vgc_pointer_glyph; -static const Ascbyte gc_default_message[] = "Garbage collecting"; -Lisp_Object Qgarbage_collecting; - -static Lisp_Object QSin_garbage_collection; - /* Non-zero means we're in the process of doing the dump */ int purify_flag; ＠＠ -248,7 +217,7 ＠＠  #ifndef MC_ALLOC -static void *breathing_space; +void *breathing_space; void release_breathing_space (void) ＠＠ -282,6 +251,7 ＠＠ DOESNT_RETURN memory_full (void) { + fprintf (stderr, "##### M E M O R Y F U L L #####\n"); /* Force a GC next time eval is called. It's better to loop garbage-collecting (we might reclaim enough to win) than to loop beeping and barfing "Memory exhausted" ＠＠ -521,33 +491,10 ＠＠ } lrecord_stats [countof (lrecord_implementations_table) + MODULE_DEFINABLE_TYPE_COUNT]; -int lrecord_string_data_instances_in_use; -int lrecord_string_data_bytes_in_use; -int lrecord_string_data_bytes_in_use_including_overhead; - void init_lrecord_stats () { xzero (lrecord_stats); - lrecord_string_data_instances_in_use = 0; - lrecord_string_data_bytes_in_use = 0; - lrecord_string_data_bytes_in_use_including_overhead = 0; -} - -void -inc_lrecord_string_data_stats (Bytecount size) -{ - lrecord_string_data_instances_in_use++; - lrecord_string_data_bytes_in_use += size; - lrecord_string_data_bytes_in_use_including_overhead += size; -} - -void -dec_lrecord_string_data_stats (Bytecount size) -{ - lrecord_string_data_instances_in_use--; - lrecord_string_data_bytes_in_use -= size; - lrecord_string_data_bytes_in_use_including_overhead -= size; } void ＠＠ -581,6 +528,17 ＠＠ DECREMENT_CONS_COUNTER (size); } + +int +lrecord_stats_heap_size (void) +{ + int i; + int size = 0; + for (i = 0; i < (countof (lrecord_implementations_table) + + MODULE_DEFINABLE_TYPE_COUNT); i++) + size += lrecord_stats[i].bytes_in_use; + return size; +} #endif /* not (MC_ALLOC && ALLOC_TYPE_STATS) */ #ifndef MC_ALLOC ＠＠ -613,6 +571,7 ＠＠ return lheader; } + void * noseeum_alloc_lrecord (Bytecount size, const struct lrecord_implementation *implementation) ＠＠ -634,15 +593,59 ＠＠ return lheader; } +#ifdef NEW_GC +void * +alloc_lrecord_array (Bytecount size, int elemcount, + const struct lrecord_implementation *implementation) +{ + struct lrecord_header *lheader; + Rawbyte *start, *stop; + + type_checking_assert + ((implementation->static_size == 0 ? + implementation->size_in_bytes_method != NULL : + implementation->static_size == size)); + + lheader = (struct lrecord_header *) mc_alloc_array (size, elemcount); + gc_checking_assert (LRECORD_FREE_P (lheader)); + + for (start = (Rawbyte *) lheader, + stop = ((Rawbyte *) lheader) + (size * elemcount -1); + start < stop; start += size) + { + struct lrecord_header *lh = (struct lrecord_header *) start; + set_lheader_implementation (lh, implementation); + lh->uid = lrecord_uid_counter++; +#ifdef ALLOC_TYPE_STATS + inc_lrecord_stats (size, lh); +#endif /* not ALLOC_TYPE_STATS */ + } + INCREMENT_CONS_COUNTER (size * elemcount, implementation->name); + return lheader; +} +#endif /* NEW_GC */ + void free_lrecord (Lisp_Object lrecord) { +#ifndef NEW_GC gc_checking_assert (!gc_in_progress); +#endif /* not NEW_GC */ gc_checking_assert (!LRECORD_FREE_P (XRECORD_LHEADER (lrecord))); gc_checking_assert (!XRECORD_LHEADER (lrecord)->free); +#ifdef NEW_GC + GC_STAT_EXPLICITLY_TRIED_FREED; + /* Ignore requests to manual free objects while in garbage collection. */ + if (write_barrier_enabled || gc_in_progress) + return; + + GC_STAT_EXPLICITLY_FREED; +#endif /* NEW_GC */ + MC_ALLOC_CALL_FINALIZER (XPNTR (lrecord)); mc_free (XPNTR (lrecord)); + recompute_need_to_garbage_collect (); } #else /* not MC_ALLOC */ ＠＠ -955,16 +958,6 ＠＠ remain free for the next 1000 (or whatever) times that an object of that type is allocated. */ -#ifndef MALLOC_OVERHEAD -#ifdef GNU_MALLOC -#define MALLOC_OVERHEAD 0 -#elif defined (rcheck) -#define MALLOC_OVERHEAD 20 -#else -#define MALLOC_OVERHEAD 8 -#endif -#endif /* MALLOC_OVERHEAD */ - #if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC) /* If we released our reserve (due to running out of memory), and we have a fair amount free once again, ＠＠ -1832,7 +1825,11 ＠＠ f->instructions = Qzero; f->constants = Qzero; f->arglist = Qnil; +#ifdef NEW_GC + f->arguments = Qnil; +#else /* not NEW_GC */ f->args = NULL; +#endif /* not NEW_GC */ f->max_args = f->min_args = f->args_in_array = 0; f->doc_and_interactive = Qnil; #ifdef COMPILED_FUNCTION_ANNOTATION_HACK ＠＠ -2238,8 +2235,12 ＠＠ } static const struct memory_description string_description[] = { +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (Lisp_String, data_object) }, +#else /* not NEW_GC */ { XD_BYTECOUNT, offsetof (Lisp_String, size_) }, { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data_), XD_INDIRECT(0, 1) }, +#endif /* not NEW_GC */ { XD_LISP_OBJECT, offsetof (Lisp_String, plist) }, { XD_END } }; ＠＠ -2310,6 +2311,10 ＠＠ Lisp_String); #endif /* not MC_ALLOC */ +#ifdef NEW_GC +#define STRING_FULLSIZE(size) \ + ALIGN_SIZE (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_String_Direct_Data, Lisp_Object, data, (size) + 1), sizeof (Lisp_Object *)); +#else /* not NEW_GC */ /* String blocks contain this many useful bytes. */ #define STRING_CHARS_BLOCK_SIZE \ ((Bytecount) (8192 - MALLOC_OVERHEAD - \ ＠＠ -2341,8 +2346,10 ＠＠ #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL) #define MARK_STRING_CHARS_AS_FREE(ptr) ((void) ((ptr)->string = NULL)) +#endif /* not NEW_GC */ #ifdef MC_ALLOC +#ifndef NEW_GC static void finalize_string (void *header, int for_disksave) { ＠＠ -2350,9 +2357,6 ＠＠ { Lisp_String *s = (Lisp_String *) header; Bytecount size = s->size_; -#ifdef ALLOC_TYPE_STATS - dec_lrecord_string_data_stats (size); -#endif /* ALLOC_TYPE_STATS */ if (BIG_STRING_SIZE_P (size)) xfree (s->data_, Ibyte *); } ＠＠ -2369,9 +2373,58 ＠＠ string_remprop, string_plist, Lisp_String); +#else /* NEW_GC */ +DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, + 1, /*dumpable-flag*/ + mark_string, print_string, + 0, + string_equal, 0, + string_description, + string_getprop, + string_putprop, + string_remprop, + string_plist, + Lisp_String); + + +static const struct memory_description string_direct_data_description[] = { + { XD_BYTECOUNT, offsetof (Lisp_String_Indirect_Data, size) }, + { XD_END } +}; +static Bytecount +size_string_direct_data (const void *lheader) +{ + return STRING_FULLSIZE (((Lisp_String_Direct_Data *) lheader)->size); +} + + +DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("string-direct-data", + string_direct_data, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + string_direct_data_description, + size_string_direct_data, + Lisp_String_Direct_Data); + + +static const struct memory_description string_indirect_data_description[] = { + { XD_BYTECOUNT, offsetof (Lisp_String_Indirect_Data, size) }, + { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String_Indirect_Data, data), + XD_INDIRECT(0, 1) }, + { XD_END } +}; + +DEFINE_LRECORD_IMPLEMENTATION ("string-indirect-data", + string_indirect_data, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + string_indirect_data_description, + Lisp_String_Indirect_Data); +#endif /* NEW_GC */ #endif /* MC_ALLOC */ +#ifndef NEW_GC struct string_chars { Lisp_String *string; ＠＠ -2438,6 +2491,7 ＠＠ return s_chars; } +#endif /* not NEW_GC */ #ifdef SLEDGEHAMMER_CHECK_ASCII_BEGIN void ＠＠ -2472,9 +2526,6 ＠＠ #ifdef MC_ALLOC s = alloc_lrecord_type (Lisp_String, &lrecord_string); -#ifdef ALLOC_TYPE_STATS - inc_lrecord_string_data_stats (length); -#endif /* ALLOC_TYPE_STATS */ #else /* not MC_ALLOC */ /* Allocate the string header */ ALLOCATE_FIXED_TYPE (string, Lisp_String, s); ＠＠ -2486,10 +2537,16 ＠＠ ascii-length field, to some non-zero value. We need to zero it. */ XSET_STRING_ASCII_BEGIN (wrap_string (s), 0); +#ifdef NEW_GC + STRING_DATA_OBJECT (s) = + wrap_string_direct_data (alloc_lrecord (fullsize, + &lrecord_string_direct_data)); +#else /* not NEW_GC */ set_lispstringp_data (s, BIG_STRING_FULLSIZE_P (fullsize) ? allocate_big_string_chars (length + 1) : allocate_string_chars_struct (wrap_string (s), fullsize)->chars); +#endif /* not NEW_GC */ set_lispstringp_length (s, length); s->plist = Qnil; ＠＠ -2511,7 +2568,11 ＠＠ void resize_string (Lisp_Object s, Bytecount pos, Bytecount delta) { +#ifdef NEW_GC + Bytecount newfullsize, len; +#else /* not NEW_GC */ Bytecount oldfullsize, newfullsize; +#endif /* not NEW_GC */ #ifdef VERIFY_STRING_CHARS_INTEGRITY verify_string_chars_integrity (); #endif ＠＠ -2539,6 +2600,23 ＠＠ so convert this to the appropriate form. */ pos += -delta; +#ifdef NEW_GC + newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta); + + len = XSTRING_LENGTH (s) + 1 - pos; + + if (delta < 0 && pos >= 0) + memmove (XSTRING_DATA (s) + pos + delta, + XSTRING_DATA (s) + pos, len); + + XSTRING_DATA_OBJECT (s) = + wrap_string_direct_data (mc_realloc (XPNTR (XSTRING_DATA_OBJECT (s)), + newfullsize)); + if (delta > 0 && pos >= 0) + memmove (XSTRING_DATA (s) + pos + delta, XSTRING_DATA (s) + pos, + len); + +#else /* NEW_GC */ oldfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s)); newfullsize = STRING_FULLSIZE (XSTRING_LENGTH (s) + delta); ＠＠ -2631,6 +2709,7 ＠＠ } } } +#endif /* not NEW_GC */ XSET_STRING_LENGTH (s, XSTRING_LENGTH (s) + delta); /* If pos < 0, the string won't be zero-terminated. ＠＠ -2852,9 +2931,6 ＠＠ #ifdef MC_ALLOC s = alloc_lrecord_type (Lisp_String, &lrecord_string); -#ifdef ALLOC_TYPE_STATS - inc_lrecord_string_data_stats (length); -#endif /* ALLOC_TYPE_STATS */ mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get collected and static data is tried to be freed. */ ＠＠ -2867,8 +2943,18 ＠＠ /* Don't need to XSET_STRING_ASCII_BEGIN() here because it happens in init_string_ascii_begin(). */ s->plist = Qnil; +#ifdef NEW_GC + set_lispstringp_indirect (s); + STRING_DATA_OBJECT (s) = + wrap_string_indirect_data + (alloc_lrecord_type (Lisp_String_Indirect_Data, + &lrecord_string_indirect_data)); + XSTRING_INDIRECT_DATA_DATA (STRING_DATA_OBJECT (s)) = (Ibyte *) contents; + XSTRING_INDIRECT_DATA_SIZE (STRING_DATA_OBJECT (s)) = length; +#else /* not NEW_GC */ set_lispstringp_data (s, (Ibyte *) contents); set_lispstringp_length (s, length); +#endif /* not NEW_GC */ val = wrap_string (s); init_string_ascii_begin (val); sledgehammer_check_ascii_begin (val); ＠＠ -3337,897 +3423,116 ＠＠ #endif /* not DEBUG_XEMACS */ #endif /* MC_ALLOC */ -#ifdef ERROR_CHECK_GC -#ifdef MC_ALLOC -#define GC_CHECK_LHEADER_INVARIANTS(lheader) do { \ - struct lrecord_header * GCLI_lh = (lheader); \ - assert (GCLI_lh != 0); \ - assert (GCLI_lh->type < (unsigned int) lrecord_type_count); \ -} while (0) -#else /* not MC_ALLOC */ -#define GC_CHECK_LHEADER_INVARIANTS(lheader) do { \ - struct lrecord_header * GCLI_lh = (lheader); \ - assert (GCLI_lh != 0); \ - assert (GCLI_lh->type < (unsigned int) lrecord_type_count); \ - assert (! C_READONLY_RECORD_HEADER_P (GCLI_lh) || \ - (MARKED_RECORD_HEADER_P (GCLI_lh) && \ - LISP_READONLY_RECORD_HEADER_P (GCLI_lh))); \ -} while (0) -#endif /* not MC_ALLOC */ -#else -#define GC_CHECK_LHEADER_INVARIANTS(lheader) -#endif - - -static const struct memory_description lisp_object_description_1[] = { - { XD_LISP_OBJECT, 0 }, - { XD_END } -}; - -const struct sized_memory_description lisp_object_description = { - sizeof (Lisp_Object), - lisp_object_description_1 -}; -#if defined (USE_KKCC) || defined (PDUMP) +#ifndef MC_ALLOC +static int gc_count_num_short_string_in_use; +static Bytecount gc_count_string_total_size; +static Bytecount gc_count_short_string_total_size; -/* This function extracts the value of a count variable described somewhere - else in the description. It is converted corresponding to the type */ -EMACS_INT -lispdesc_indirect_count_1 (EMACS_INT code, - const struct memory_description *idesc, - const void *idata) -{ - EMACS_INT count; - const void *irdata; - - int line = XD_INDIRECT_VAL (code); - int delta = XD_INDIRECT_DELTA (code); - - irdata = ((char *) idata) + - lispdesc_indirect_count (idesc[line].offset, idesc, idata); - switch (idesc[line].type) - { - case XD_BYTECOUNT: - count = * (Bytecount *) irdata; - break; - case XD_ELEMCOUNT: - count = * (Elemcount *) irdata; - break; - case XD_HASHCODE: - count = * (Hashcode *) irdata; - break; - case XD_INT: - count = * (int *) irdata; - break; - case XD_LONG: - count = * (long *) irdata; - break; - default: - stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n", - idesc[line].type, line, (long) code); -#if defined(USE_KKCC) && defined(DEBUG_XEMACS) - if (gc_in_progress) - kkcc_backtrace (); -#endif -#ifdef PDUMP - if (in_pdump) - pdump_backtrace (); -#endif - count = 0; /* warning suppression */ - ABORT (); - } - count += delta; - return count; -} +/* static int gc_count_total_records_used, gc_count_records_total_size; */ -/* SDESC is a "description map" (basically, a list of offsets used for - successive indirections) and OBJ is the first object to indirect off of. - Return the description ultimately found. */ + +/* stats on lcrecords in use - kinda kludgy */ -const struct sized_memory_description * -lispdesc_indirect_description_1 (const void *obj, - const struct sized_memory_description *sdesc) +static struct { - int pos; - - for (pos = 0; sdesc[pos].size >= 0; pos++) - obj = * (const void **) ((const char *) obj + sdesc[pos].size); - - return (const struct sized_memory_description *) obj; -} - -/* Compute the size of the data at RDATA, described by a single entry - DESC1 in a description array. OBJ and DESC are used for - XD_INDIRECT references. */ + int instances_in_use; + int bytes_in_use; + int instances_freed; + int bytes_freed; + int instances_on_free_list; +} lcrecord_stats [countof (lrecord_implementations_table) + + MODULE_DEFINABLE_TYPE_COUNT]; -static Bytecount -lispdesc_one_description_line_size (void *rdata, - const struct memory_description *desc1, - const void *obj, - const struct memory_description *desc) +static void +tick_lcrecord_stats (const struct lrecord_header *h, int free_p) { - union_switcheroo: - switch (desc1->type) - { - case XD_LISP_OBJECT_ARRAY: - { - EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); - return (val * sizeof (Lisp_Object)); - } - case XD_LISP_OBJECT: - case XD_LO_LINK: - return sizeof (Lisp_Object); - case XD_OPAQUE_PTR: - return sizeof (void *); - case XD_BLOCK_PTR: - { - EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); - return val * sizeof (void *); - } - case XD_BLOCK_ARRAY: - { - EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); - - return (val * - lispdesc_block_size - (rdata, - lispdesc_indirect_description (obj, desc1->data2.descr))); - } - case XD_OPAQUE_DATA_PTR: - return sizeof (void *); - case XD_UNION_DYNAMIC_SIZE: - { - /* If an explicit size was given in the first-level structure - description, use it; else compute size based on current union - constant. */ - const struct sized_memory_description *sdesc = - lispdesc_indirect_description (obj, desc1->data2.descr); - if (sdesc->size) - return sdesc->size; - else - { - desc1 = lispdesc_process_xd_union (desc1, desc, obj); - if (desc1) - goto union_switcheroo; - break; - } - } - case XD_UNION: - { - /* If an explicit size was given in the first-level structure - description, use it; else compute size based on maximum of all - possible structures. */ - const struct sized_memory_description *sdesc = - lispdesc_indirect_description (obj, desc1->data2.descr); - if (sdesc->size) - return sdesc->size; - else - { - int count; - Bytecount max_size = -1, size; - - desc1 = sdesc->description; + int type_index = h->type; - for (count = 0; desc1[count].type != XD_END; count++) - { - size = lispdesc_one_description_line_size (rdata, - &desc1[count], - obj, desc); - if (size > max_size) - max_size = size; - } - return max_size; - } - } - case XD_ASCII_STRING: - return sizeof (void *); - case XD_DOC_STRING: - return sizeof (void *); - case XD_INT_RESET: - return sizeof (int); - case XD_BYTECOUNT: - return sizeof (Bytecount); - case XD_ELEMCOUNT: - return sizeof (Elemcount); - case XD_HASHCODE: - return sizeof (Hashcode); - case XD_INT: - return sizeof (int); - case XD_LONG: - return sizeof (long); - default: - stderr_out ("Unsupported dump type : %d\n", desc1->type); - ABORT (); + if (((struct old_lcrecord_header *) h)->free) + { + gc_checking_assert (!free_p); + lcrecord_stats[type_index].instances_on_free_list++; } - - return 0; -} - - -/* Return the size of the memory block (NOT necessarily a structure!) - described by SDESC and pointed to by OBJ. If SDESC records an - explicit size (i.e. non-zero), it is simply returned; otherwise, - the size is calculated by the maximum offset and the size of the - object at that offset, rounded up to the maximum alignment. In - this case, we may need the object, for example when retrieving an - "indirect count" of an inlined array (the count is not constant, - but is specified by one of the elements of the memory block). (It - is generally not a problem if we return an overly large size -- we - will simply end up reserving more space than necessary; but if the - size is too small we could be in serious trouble, in particular - with nested inlined structures, where there may be alignment - padding in the middle of a block. #### In fact there is an (at - least theoretical) problem with an overly large size -- we may - trigger a protection fault when reading from invalid memory. We - need to handle this -- perhaps in a stupid but dependable way, - i.e. by trapping SIGSEGV and SIGBUS.) */ - -Bytecount -lispdesc_block_size_1 (const void *obj, Bytecount size, - const struct memory_description *desc) -{ - EMACS_INT max_offset = -1; - int max_offset_pos = -1; - int pos; - - if (size) - return size; - - for (pos = 0; desc[pos].type != XD_END; pos++) + else { - EMACS_INT offset = lispdesc_indirect_count (desc[pos].offset, desc, obj); - if (offset == max_offset) + Bytecount sz = detagged_lisp_object_size (h); + + if (free_p) { - stderr_out ("Two relocatable elements at same offset?\n"); - ABORT (); + lcrecord_stats[type_index].instances_freed++; + lcrecord_stats[type_index].bytes_freed += sz; } - else if (offset > max_offset) + else { - max_offset = offset; - max_offset_pos = pos; + lcrecord_stats[type_index].instances_in_use++; + lcrecord_stats[type_index].bytes_in_use += sz; } } - - if (max_offset_pos < 0) - return 0; - - { - Bytecount size_at_max; - size_at_max = - lispdesc_one_description_line_size ((char *) obj + max_offset, - &desc[max_offset_pos], obj, desc); - - /* We have no way of knowing the required alignment for this structure, - so just make it maximally aligned. */ - return MAX_ALIGN_SIZE (max_offset + size_at_max); - } } +#endif /* not MC_ALLOC */ -#endif /* defined (USE_KKCC) || defined (PDUMP) */ + +#ifndef MC_ALLOC +/* Free all unmarked records */ +static void +sweep_lcrecords_1 (struct old_lcrecord_header **prev, int *used) +{ + struct old_lcrecord_header *header; + int num_used = 0; + /* int total_size = 0; */ -#ifdef MC_ALLOC -#define GC_CHECK_NOT_FREE(lheader) \ - gc_checking_assert (! LRECORD_FREE_P (lheader)); -#else /* MC_ALLOC */ -#define GC_CHECK_NOT_FREE(lheader) \ - gc_checking_assert (! LRECORD_FREE_P (lheader)); \ - gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || \ - ! ((struct old_lcrecord_header *) lheader)->free) -#endif /* MC_ALLOC */ + xzero (lcrecord_stats); /* Reset all statistics to 0. */ -#ifdef USE_KKCC -/* The following functions implement the new mark algorithm. - They mark objects according to their descriptions. They - are modeled on the corresponding pdumper procedures. */ + /* First go through and call all the finalize methods. + Then go through and free the objects. There used to + be only one loop here, with the call to the finalizer + occurring directly before the xfree() below. That + is marginally faster but much less safe -- if the + finalize method for an object needs to reference any + other objects contained within it (and many do), + we could easily be screwed by having already freed that + other object. */ -#ifdef DEBUG_XEMACS -/* The backtrace for the KKCC mark functions. */ -#define KKCC_INIT_BT_STACK_SIZE 4096 + for (header = *prev; header; header = header->next) + { + struct lrecord_header *h = &(header->lheader); -typedef struct -{ - void *obj; - const struct memory_description *desc; - int pos; -} kkcc_bt_stack_entry; - -static kkcc_bt_stack_entry *kkcc_bt; -static int kkcc_bt_stack_size; -static int kkcc_bt_depth = 0; + GC_CHECK_LHEADER_INVARIANTS (h); -static void -kkcc_bt_init (void) -{ - kkcc_bt_depth = 0; - kkcc_bt_stack_size = KKCC_INIT_BT_STACK_SIZE; - kkcc_bt = (kkcc_bt_stack_entry *) - malloc (kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry)); - if (!kkcc_bt) - { - stderr_out ("KKCC backtrace stack init failed for size %d\n", - kkcc_bt_stack_size); - ABORT (); + if (! MARKED_RECORD_HEADER_P (h) && ! header->free) + { + if (LHEADER_IMPLEMENTATION (h)->finalizer) + LHEADER_IMPLEMENTATION (h)->finalizer (h, 0); + } } -} -void -kkcc_backtrace (void) -{ - int i; - stderr_out ("KKCC mark stack backtrace :\n"); - for (i = kkcc_bt_depth - 1; i >= 0; i--) + for (header = *prev; header; ) { - Lisp_Object obj = wrap_pointer_1 (kkcc_bt[i].obj); - stderr_out (" [%d]", i); -#ifdef MC_ALLOC - if ((XRECORD_LHEADER (obj)->type >= lrecord_type_last_built_in_type) -#else /* not MC_ALLOC */ - if ((XRECORD_LHEADER (obj)->type >= lrecord_type_free) -#endif /* not MC_ALLOC */ - || (!LRECORDP (obj)) - || (!XRECORD_LHEADER_IMPLEMENTATION (obj))) + struct lrecord_header *h = &(header->lheader); + if (MARKED_RECORD_HEADER_P (h)) { - stderr_out (" non Lisp Object"); + if (! C_READONLY_RECORD_HEADER_P (h)) + UNMARK_RECORD_HEADER (h); + num_used++; + /* total_size += n->implementation->size_in_bytes (h);*/ + /* #### May modify header->next on a C_READONLY lcrecord */ + prev = &(header->next); + header = *prev; + tick_lcrecord_stats (h, 0); } else { - stderr_out (" %s", - XRECORD_LHEADER_IMPLEMENTATION (obj)->name); + struct old_lcrecord_header *next = header->next; + *prev = next; + tick_lcrecord_stats (h, 1); + /* used to call finalizer right here. */ + xfree (header, struct old_lcrecord_header *); + header = next; } - stderr_out (" (addr: 0x%x, desc: 0x%x, ", - (int) kkcc_bt[i].obj, - (int) kkcc_bt[i].desc); - if (kkcc_bt[i].pos >= 0) - stderr_out ("pos: %d)\n", kkcc_bt[i].pos); - else - stderr_out ("root set)\n"); - } -} - -static void -kkcc_bt_stack_realloc (void) -{ - kkcc_bt_stack_size *= 2; - kkcc_bt = (kkcc_bt_stack_entry *) - realloc (kkcc_bt, kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry)); - if (!kkcc_bt) - { - stderr_out ("KKCC backtrace stack realloc failed for size %d\n", - kkcc_bt_stack_size); - ABORT (); } -} - -static void -kkcc_bt_free (void) -{ - free (kkcc_bt); - kkcc_bt = 0; - kkcc_bt_stack_size = 0; -} - -static void -kkcc_bt_push (void *obj, const struct memory_description *desc, - int level, int pos) -{ - kkcc_bt_depth = level; - kkcc_bt[kkcc_bt_depth].obj = obj; - kkcc_bt[kkcc_bt_depth].desc = desc; - kkcc_bt[kkcc_bt_depth].pos = pos; - kkcc_bt_depth++; - if (kkcc_bt_depth >= kkcc_bt_stack_size) - kkcc_bt_stack_realloc (); -} - -#else /* not DEBUG_XEMACS */ -#define kkcc_bt_init() -#define kkcc_bt_push(obj, desc, level, pos) -#endif /* not DEBUG_XEMACS */ - -/* Object memory descriptions are in the lrecord_implementation structure. - But copying them to a parallel array is much more cache-friendly. */ -const struct memory_description *lrecord_memory_descriptions[countof (lrecord_implementations_table)]; - -/* the initial stack size in kkcc_gc_stack_entries */ -#define KKCC_INIT_GC_STACK_SIZE 16384 - -typedef struct -{ - void *data; - const struct memory_description *desc; -#ifdef DEBUG_XEMACS - int level; - int pos; -#endif -} kkcc_gc_stack_entry; - -static kkcc_gc_stack_entry *kkcc_gc_stack_ptr; -static kkcc_gc_stack_entry *kkcc_gc_stack_top; -static kkcc_gc_stack_entry *kkcc_gc_stack_last_entry; -static int kkcc_gc_stack_size; - -static void -kkcc_gc_stack_init (void) -{ - kkcc_gc_stack_size = KKCC_INIT_GC_STACK_SIZE; - kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *) - malloc (kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry)); - if (!kkcc_gc_stack_ptr) - { - stderr_out ("stack init failed for size %d\n", kkcc_gc_stack_size); - ABORT (); - } - kkcc_gc_stack_top = kkcc_gc_stack_ptr - 1; - kkcc_gc_stack_last_entry = kkcc_gc_stack_ptr + kkcc_gc_stack_size - 1; -} - -static void -kkcc_gc_stack_free (void) -{ - free (kkcc_gc_stack_ptr); - kkcc_gc_stack_ptr = 0; - kkcc_gc_stack_top = 0; - kkcc_gc_stack_size = 0; -} - -static void -kkcc_gc_stack_realloc (void) -{ - int current_offset = (int)(kkcc_gc_stack_top - kkcc_gc_stack_ptr); - kkcc_gc_stack_size *= 2; - kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *) - realloc (kkcc_gc_stack_ptr, - kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry)); - if (!kkcc_gc_stack_ptr) - { - stderr_out ("stack realloc failed for size %d\n", kkcc_gc_stack_size); - ABORT (); - } - kkcc_gc_stack_top = kkcc_gc_stack_ptr + current_offset; - kkcc_gc_stack_last_entry = kkcc_gc_stack_ptr + kkcc_gc_stack_size - 1; -} - -#define KKCC_GC_STACK_FULL (kkcc_gc_stack_top >= kkcc_gc_stack_last_entry) -#define KKCC_GC_STACK_EMPTY (kkcc_gc_stack_top < kkcc_gc_stack_ptr) - -static void -#ifdef DEBUG_XEMACS -kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc, - int level, int pos) -#else -kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc) -#endif -{ - if (KKCC_GC_STACK_FULL) - kkcc_gc_stack_realloc(); - kkcc_gc_stack_top++; - kkcc_gc_stack_top->data = data; - kkcc_gc_stack_top->desc = desc; -#ifdef DEBUG_XEMACS - kkcc_gc_stack_top->level = level; - kkcc_gc_stack_top->pos = pos; -#endif -} - -#ifdef DEBUG_XEMACS -#define kkcc_gc_stack_push(data, desc, level, pos) \ - kkcc_gc_stack_push_1 (data, desc, level, pos) -#else -#define kkcc_gc_stack_push(data, desc, level, pos) \ - kkcc_gc_stack_push_1 (data, desc) -#endif - -static kkcc_gc_stack_entry * -kkcc_gc_stack_pop (void) -{ - if (KKCC_GC_STACK_EMPTY) - return 0; - kkcc_gc_stack_top--; - return kkcc_gc_stack_top + 1; -} - -void -#ifdef DEBUG_XEMACS -kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos) -#else -kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj) -#endif -{ - if (XTYPE (obj) == Lisp_Type_Record) - { - struct lrecord_header *lheader = XRECORD_LHEADER (obj); - const struct memory_description *desc; - GC_CHECK_LHEADER_INVARIANTS (lheader); - desc = RECORD_DESCRIPTION (lheader); - if (! MARKED_RECORD_HEADER_P (lheader)) - { - MARK_RECORD_HEADER (lheader); - kkcc_gc_stack_push ((void*) lheader, desc, level, pos); - } - } -} - -#ifdef DEBUG_XEMACS -#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ - kkcc_gc_stack_push_lisp_object_1 (obj, level, pos) -#else -#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ - kkcc_gc_stack_push_lisp_object_1 (obj) -#endif - -#ifdef ERROR_CHECK_GC -#define KKCC_DO_CHECK_FREE(obj, allow_free) \ -do \ -{ \ - if (!allow_free && XTYPE (obj) == Lisp_Type_Record) \ - { \ - struct lrecord_header *lheader = XRECORD_LHEADER (obj); \ - GC_CHECK_NOT_FREE (lheader); \ - } \ -} while (0) -#else -#define KKCC_DO_CHECK_FREE(obj, allow_free) -#endif - -#ifdef ERROR_CHECK_GC -#ifdef DEBUG_XEMACS -static void -mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free, - int level, int pos) -#else -static void -mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free) -#endif -{ - KKCC_DO_CHECK_FREE (obj, allow_free); - kkcc_gc_stack_push_lisp_object (obj, level, pos); -} - -#ifdef DEBUG_XEMACS -#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ - mark_object_maybe_checking_free_1 (obj, allow_free, level, pos) -#else -#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ - mark_object_maybe_checking_free_1 (obj, allow_free) -#endif -#else /* not ERROR_CHECK_GC */ -#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ - kkcc_gc_stack_push_lisp_object (obj, level, pos) -#endif /* not ERROR_CHECK_GC */ - - -/* This function loops all elements of a struct pointer and calls - mark_with_description with each element. */ -static void -#ifdef DEBUG_XEMACS -mark_struct_contents_1 (const void *data, - const struct sized_memory_description *sdesc, - int count, int level, int pos) -#else -mark_struct_contents_1 (const void *data, - const struct sized_memory_description *sdesc, - int count) -#endif -{ - int i; - Bytecount elsize; - elsize = lispdesc_block_size (data, sdesc); - - for (i = 0; i < count; i++) - { - kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description, - level, pos); - } -} - -#ifdef DEBUG_XEMACS -#define mark_struct_contents(data, sdesc, count, level, pos) \ - mark_struct_contents_1 (data, sdesc, count, level, pos) -#else -#define mark_struct_contents(data, sdesc, count, level, pos) \ - mark_struct_contents_1 (data, sdesc, count) -#endif - -/* This function implements the KKCC mark algorithm. - Instead of calling mark_object, all the alive Lisp_Objects are pushed - on the kkcc_gc_stack. This function processes all elements on the stack - according to their descriptions. */ -static void -kkcc_marking (void) -{ - kkcc_gc_stack_entry *stack_entry = 0; - void *data = 0; - const struct memory_description *desc = 0; - int pos; -#ifdef DEBUG_XEMACS - int level = 0; - kkcc_bt_init (); -#endif - - while ((stack_entry = kkcc_gc_stack_pop ()) != 0) - { - data = stack_entry->data; - desc = stack_entry->desc; -#ifdef DEBUG_XEMACS - level = stack_entry->level + 1; -#endif - - kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos); - - gc_checking_assert (data); - gc_checking_assert (desc); - - for (pos = 0; desc[pos].type != XD_END; pos++) - { - const struct memory_description *desc1 = &desc[pos]; - const void *rdata = - (const char *) data + lispdesc_indirect_count (desc1->offset, - desc, data); - union_switcheroo: - - /* If the flag says don't mark, then don't mark. */ - if ((desc1->flags) & XD_FLAG_NO_KKCC) - continue; - - switch (desc1->type) - { - case XD_BYTECOUNT: - case XD_ELEMCOUNT: - case XD_HASHCODE: - case XD_INT: - case XD_LONG: - case XD_INT_RESET: - case XD_LO_LINK: - case XD_OPAQUE_PTR: - case XD_OPAQUE_DATA_PTR: - case XD_ASCII_STRING: - case XD_DOC_STRING: - break; - case XD_LISP_OBJECT: - { - const Lisp_Object *stored_obj = (const Lisp_Object *) rdata; - - /* Because of the way that tagged objects work (pointers and - Lisp_Objects have the same representation), XD_LISP_OBJECT - can be used for untagged pointers. They might be NULL, - though. */ - if (EQ (*stored_obj, Qnull_pointer)) - break; -#ifdef MC_ALLOC - mark_object_maybe_checking_free (*stored_obj, 0, level, pos); -#else /* not MC_ALLOC */ - mark_object_maybe_checking_free - (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, - level, pos); -#endif /* not MC_ALLOC */ - break; - } - case XD_LISP_OBJECT_ARRAY: - { - int i; - EMACS_INT count = - lispdesc_indirect_count (desc1->data1, desc, data); - - for (i = 0; i < count; i++) - { - const Lisp_Object *stored_obj = - (const Lisp_Object *) rdata + i; - - if (EQ (*stored_obj, Qnull_pointer)) - break; -#ifdef MC_ALLOC - mark_object_maybe_checking_free (*stored_obj, 0, level, pos); -#else /* not MC_ALLOC */ - mark_object_maybe_checking_free - (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, - level, pos); -#endif /* not MC_ALLOC */ - } - break; - } - case XD_BLOCK_PTR: - { - EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, - data); - const struct sized_memory_description *sdesc = - lispdesc_indirect_description (data, desc1->data2.descr); - const char *dobj = * (const char **) rdata; - if (dobj) - mark_struct_contents (dobj, sdesc, count, level, pos); - break; - } - case XD_BLOCK_ARRAY: - { - EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, - data); - const struct sized_memory_description *sdesc = - lispdesc_indirect_description (data, desc1->data2.descr); - - mark_struct_contents (rdata, sdesc, count, level, pos); - break; - } - case XD_UNION: - case XD_UNION_DYNAMIC_SIZE: - desc1 = lispdesc_process_xd_union (desc1, desc, data); - if (desc1) - goto union_switcheroo; - break; - - default: - stderr_out ("Unsupported description type : %d\n", desc1->type); - kkcc_backtrace (); - ABORT (); - } - } - } -#ifdef DEBUG_XEMACS - kkcc_bt_free (); -#endif -} -#endif /* USE_KKCC */ - -/* Mark reference to a Lisp_Object. If the object referred to has not been - seen yet, recursively mark all the references contained in it. */ - -void -mark_object ( -#ifdef USE_KKCC - Lisp_Object UNUSED (obj) -#else - Lisp_Object obj -#endif - ) -{ -#ifdef USE_KKCC - /* this code should never be reached when configured for KKCC */ - stderr_out ("KKCC: Invalid mark_object call.\n"); - stderr_out ("Replace mark_object with kkcc_gc_stack_push_lisp_object.\n"); - ABORT (); -#else /* not USE_KKCC */ - - tail_recurse: - - /* Checks we used to perform */ - /* if (EQ (obj, Qnull_pointer)) return; */ - /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */ - /* if (PURIFIED (XPNTR (obj))) return; */ - - if (XTYPE (obj) == Lisp_Type_Record) - { - struct lrecord_header *lheader = XRECORD_LHEADER (obj); - - GC_CHECK_LHEADER_INVARIANTS (lheader); - - /* We handle this separately, above, so we can mark free objects */ - GC_CHECK_NOT_FREE (lheader); - - /* All c_readonly objects have their mark bit set, - so that we only need to check the mark bit here. */ - if (! MARKED_RECORD_HEADER_P (lheader)) - { - MARK_RECORD_HEADER (lheader); - - if (RECORD_MARKER (lheader)) - { - obj = RECORD_MARKER (lheader) (obj); - if (!NILP (obj)) goto tail_recurse; - } - } - } -#endif /* not KKCC */ -} - - -#ifndef MC_ALLOC -static int gc_count_num_short_string_in_use; -static Bytecount gc_count_string_total_size; -static Bytecount gc_count_short_string_total_size; - -/* static int gc_count_total_records_used, gc_count_records_total_size; */ - - -/* stats on lcrecords in use - kinda kludgy */ - -static struct -{ - int instances_in_use; - int bytes_in_use; - int instances_freed; - int bytes_freed; - int instances_on_free_list; -} lcrecord_stats [countof (lrecord_implementations_table) - + MODULE_DEFINABLE_TYPE_COUNT]; - -static void -tick_lcrecord_stats (const struct lrecord_header *h, int free_p) -{ - int type_index = h->type; - - if (((struct old_lcrecord_header *) h)->free) - { - gc_checking_assert (!free_p); - lcrecord_stats[type_index].instances_on_free_list++; - } - else - { - Bytecount sz = detagged_lisp_object_size (h); - - if (free_p) - { - lcrecord_stats[type_index].instances_freed++; - lcrecord_stats[type_index].bytes_freed += sz; - } - else - { - lcrecord_stats[type_index].instances_in_use++; - lcrecord_stats[type_index].bytes_in_use += sz; - } - } -} -#endif /* not MC_ALLOC */ - - -#ifndef MC_ALLOC -/* Free all unmarked records */ -static void -sweep_lcrecords_1 (struct old_lcrecord_header **prev, int *used) -{ - struct old_lcrecord_header *header; - int num_used = 0; - /* int total_size = 0; */ - - xzero (lcrecord_stats); /* Reset all statistics to 0. */ - - /* First go through and call all the finalize methods. - Then go through and free the objects. There used to - be only one loop here, with the call to the finalizer - occurring directly before the xfree() below. That - is marginally faster but much less safe -- if the - finalize method for an object needs to reference any - other objects contained within it (and many do), - we could easily be screwed by having already freed that - other object. */ - - for (header = *prev; header; header = header->next) - { - struct lrecord_header *h = &(header->lheader); - - GC_CHECK_LHEADER_INVARIANTS (h); - - if (! MARKED_RECORD_HEADER_P (h) && ! header->free) - { - if (LHEADER_IMPLEMENTATION (h)->finalizer) - LHEADER_IMPLEMENTATION (h)->finalizer (h, 0); - } - } - - for (header = *prev; header; ) - { - struct lrecord_header *h = &(header->lheader); - if (MARKED_RECORD_HEADER_P (h)) - { - if (! C_READONLY_RECORD_HEADER_P (h)) - UNMARK_RECORD_HEADER (h); - num_used++; - /* total_size += n->implementation->size_in_bytes (h);*/ - /* #### May modify header->next on a C_READONLY lcrecord */ - prev = &(header->next); - header = *prev; - tick_lcrecord_stats (h, 0); - } - else - { - struct old_lcrecord_header *next = header->next; - *prev = next; - tick_lcrecord_stats (h, 1); - /* used to call finalizer right here. */ - xfree (header, struct old_lcrecord_header *); - header = next; - } - } - *used = num_used; - /* *total = total_size; */ + *used = num_used; + /* *total = total_size; */ } /* And the Lord said: Thou shalt use the `c-backslash-region' command ＠＠ -4795,9 +4100,10 ＠＠ #endif /* defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) */ +#ifndef NEW_GC /* Compactify string chars, relocating the reference to each -- free any empty string_chars_block we see. */ -static void +void compact_string_chars (void) { struct string_chars_block *to_sb = first_string_chars_block; ＠＠ -4893,6 +4199,7 ＠＠ current_string_chars_block->next = 0; } } +#endif /* not NEW_GC */ #ifndef MC_ALLOC #if 1 /* Hack to debug missing purecopy's */ ＠＠ -4954,28 +4261,9 ＠＠ } #endif /* not MC_ALLOC */ -/* I hate duplicating all this crap! */ -int -marked_p (Lisp_Object obj) -{ - /* Checks we used to perform. */ - /* if (EQ (obj, Qnull_pointer)) return 1; */ - /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */ - /* if (PURIFIED (XPNTR (obj))) return 1; */ - - if (XTYPE (obj) == Lisp_Type_Record) - { - struct lrecord_header *lheader = XRECORD_LHEADER (obj); - - GC_CHECK_LHEADER_INVARIANTS (lheader); - - return MARKED_RECORD_HEADER_P (lheader); - } - return 1; -} - -static void -gc_sweep (void) +#ifndef NEW_GC +void +gc_sweep_1 (void) { #ifdef MC_ALLOC compact_string_chars (); ＠＠ -5064,6 +4352,7 ＠＠ #endif #endif /* not MC_ALLOC */ } +#endif /* not NEW_GC */  /* Clearing for disksave. */ ＠＠ -5101,11 +4390,16 ＠＠ #endif Vshell_file_name = Qnil; +#ifdef NEW_GC + gc_full (); +#else /* not NEW_GC */ garbage_collect_1 (); +#endif /* not NEW_GC */ /* Run the disksave finalization methods of all live objects. */ disksave_object_finalization_1 (); +#ifndef NEW_GC /* Zero out the uninitialized (really, unused) part of the containers for the live strings. */ { ＠＠ -5122,405 +4416,12 ＠＠ } } } +#endif /* not NEW_GC */ /* There, that ought to be enough... */ } - -int -begin_gc_forbidden (void) -{ - return internal_bind_int (&gc_currently_forbidden, 1); -} - -void -end_gc_forbidden (int count) -{ - unbind_to (count); -} - -/* Maybe we want to use this when doing a "panic" gc after memory_full()? */ -static int gc_hooks_inhibited; - -struct post_gc_action -{ - void (*fun) (void *); - void *arg; -}; - -typedef struct post_gc_action post_gc_action; - -typedef struct -{ - Dynarr_declare (post_gc_action); -} post_gc_action_dynarr; - -static post_gc_action_dynarr *post_gc_actions; - -/* Register an action to be called at the end of GC. - gc_in_progress is 0 when this is called. - This is used when it is discovered that an action needs to be taken, - but it's during GC, so it's not safe. (e.g. in a finalize method.) - - As a general rule, do not use Lisp objects here. - And NEVER signal an error. -*/ - -void -register_post_gc_action (void (*fun) (void *), void *arg) -{ - post_gc_action action; - - if (!post_gc_actions) - post_gc_actions = Dynarr_new (post_gc_action); - - action.fun = fun; - action.arg = arg; - - Dynarr_add (post_gc_actions, action); -} - -static void -run_post_gc_actions (void) -{ - int i; - - if (post_gc_actions) - { - for (i = 0; i < Dynarr_length (post_gc_actions); i++) - { - post_gc_action action = Dynarr_at (post_gc_actions, i); - (action.fun) (action.arg); - } - - Dynarr_reset (post_gc_actions); - } -} - - -void -garbage_collect_1 (void) -{ -#if MAX_SAVE_STACK > 0 - char stack_top_variable; - extern char *stack_bottom; -#endif - struct frame *f; - int speccount; - int cursor_changed; - Lisp_Object pre_gc_cursor; - struct gcpro gcpro1; - PROFILE_DECLARE (); - - assert (!in_display || gc_currently_forbidden); - - if (gc_in_progress - || gc_currently_forbidden - || in_display - || preparing_for_armageddon) - return; - - PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection); - - /* We used to call selected_frame() here. - - The following functions cannot be called inside GC - so we move to after the above tests. */ - { - Lisp_Object frame; - Lisp_Object device = Fselected_device (Qnil); - if (NILP (device)) /* Could happen during startup, eg. if always_gc */ - return; - frame = Fselected_frame (device); - if (NILP (frame)) - invalid_state ("No frames exist on device", device); - f = XFRAME (frame); - } - - pre_gc_cursor = Qnil; - cursor_changed = 0; - - GCPRO1 (pre_gc_cursor); - - /* Very important to prevent GC during any of the following - stuff that might run Lisp code; otherwise, we'll likely - have infinite GC recursion. */ - speccount = begin_gc_forbidden (); - - need_to_signal_post_gc = 0; - recompute_funcall_allocation_flag (); - - if (!gc_hooks_inhibited) - run_hook_trapping_problems - (Qgarbage_collecting, Qpre_gc_hook, - INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION); - - /* Now show the GC cursor/message. */ - if (!noninteractive) - { - if (FRAME_WIN_P (f)) - { - Lisp_Object frame = wrap_frame (f); - Lisp_Object cursor = glyph_image_instance (Vgc_pointer_glyph, - FRAME_SELECTED_WINDOW (f), - ERROR_ME_NOT, 1); - pre_gc_cursor = f->pointer; - if (POINTER_IMAGE_INSTANCEP (cursor) - /* don't change if we don't know how to change back. */ - && POINTER_IMAGE_INSTANCEP (pre_gc_cursor)) - { - cursor_changed = 1; - Fset_frame_pointer (frame, cursor); - } - } - - /* Don't print messages to the stream device. */ - if (!cursor_changed && !FRAME_STREAM_P (f)) - { - if (garbage_collection_messages) - { - Lisp_Object args[2], whole_msg; - args[0] = (STRINGP (Vgc_message) ? Vgc_message : - build_msg_string (gc_default_message)); - args[1] = build_string ("..."); - whole_msg = Fconcat (2, args); - echo_area_message (f, (Ibyte *) 0, whole_msg, 0, -1, - Qgarbage_collecting); - } - } - } - - /***** Now we actually start the garbage collection. */ - - gc_in_progress = 1; - inhibit_non_essential_conversion_operations = 1; - - gc_generation_number[0]++; - -#if MAX_SAVE_STACK > 0 - - /* Save a copy of the contents of the stack, for debugging. */ - if (!purify_flag) - { - /* Static buffer in which we save a copy of the C stack at each GC. */ - static char *stack_copy; - static Bytecount stack_copy_size; - - ptrdiff_t stack_diff = &stack_top_variable - stack_bottom; - Bytecount stack_size = (stack_diff > 0 ? stack_diff : -stack_diff); - if (stack_size < MAX_SAVE_STACK) - { - if (stack_copy_size < stack_size) - { - stack_copy = (char *) xrealloc (stack_copy, stack_size); - stack_copy_size = stack_size; - } - - memcpy (stack_copy, - stack_diff > 0 ? stack_bottom : &stack_top_variable, - stack_size); - } - } -#endif /* MAX_SAVE_STACK > 0 */ - - /* Do some totally ad-hoc resource clearing. */ - /* #### generalize this? */ - clear_event_resource (); - cleanup_specifiers (); - cleanup_buffer_undo_lists (); - - /* Mark all the special slots that serve as the roots of accessibility. */ - -#ifdef USE_KKCC - /* initialize kkcc stack */ - kkcc_gc_stack_init(); -#define mark_object(obj) kkcc_gc_stack_push_lisp_object (obj, 0, -1) -#endif /* USE_KKCC */ - - { /* staticpro() */ - Lisp_Object **p = Dynarr_begin (staticpros); - Elemcount count; - for (count = Dynarr_length (staticpros); count; count--) - mark_object (**p++); - } - - { /* staticpro_nodump() */ - Lisp_Object **p = Dynarr_begin (staticpros_nodump); - Elemcount count; - for (count = Dynarr_length (staticpros_nodump); count; count--) - mark_object (**p++); - } - -#ifdef MC_ALLOC - { /* mcpro () */ - Lisp_Object *p = Dynarr_begin (mcpros); - Elemcount count; - for (count = Dynarr_length (mcpros); count; count--) - mark_object (*p++); - } -#endif /* MC_ALLOC */ - - { /* GCPRO() */ - struct gcpro *tail; - int i; - for (tail = gcprolist; tail; tail = tail->next) - for (i = 0; i < tail->nvars; i++) - mark_object (tail->var[i]); - } - - { /* specbind() */ - struct specbinding *bind; - for (bind = specpdl; bind != specpdl_ptr; bind++) - { - mark_object (bind->symbol); - mark_object (bind->old_value); - } - } - - { - struct catchtag *c; - for (c = catchlist; c; c = c->next) - { - mark_object (c->tag); - mark_object (c->val); - mark_object (c->actual_tag); - mark_object (c->backtrace); - } - } - - { - struct backtrace *backlist; - for (backlist = backtrace_list; backlist; backlist = backlist->next) - { - int nargs = backlist->nargs; - int i; - - mark_object (*backlist->function); - if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */ - /* might be fake (internal profiling entry) */ - && backlist->args) - mark_object (backlist->args[0]); - else - for (i = 0; i < nargs; i++) - mark_object (backlist->args[i]); - } - } - - mark_profiling_info (); - - /* OK, now do the after-mark stuff. This is for things that - are only marked when something else is marked (e.g. weak hash tables). - There may be complex dependencies between such objects -- e.g. - a weak hash table might be unmarked, but after processing a later - weak hash table, the former one might get marked. So we have to - iterate until nothing more gets marked. */ -#ifdef USE_KKCC - kkcc_marking (); -#endif /* USE_KKCC */ - init_marking_ephemerons (); - while (finish_marking_weak_hash_tables () > 0 || - finish_marking_weak_lists () > 0 || - continue_marking_ephemerons () > 0) -#ifdef USE_KKCC - { - kkcc_marking (); - } -#else /* NOT USE_KKCC */ - ; -#endif /* USE_KKCC */ - - /* At this point, we know which objects need to be finalized: we - still need to resurrect them */ - - while (finish_marking_ephemerons () > 0 || - finish_marking_weak_lists () > 0 || - finish_marking_weak_hash_tables () > 0) -#ifdef USE_KKCC - { - kkcc_marking (); - } - kkcc_gc_stack_free (); -#undef mark_object -#else /* NOT USE_KKCC */ - ; -#endif /* USE_KKCC */ - - /* And prune (this needs to be called after everything else has been - marked and before we do any sweeping). */ - /* #### this is somewhat ad-hoc and should probably be an object - method */ - prune_weak_hash_tables (); - prune_weak_lists (); - prune_specifiers (); - prune_syntax_tables (); - - prune_ephemerons (); - prune_weak_boxes (); - - gc_sweep (); - - consing_since_gc = 0; -#ifndef DEBUG_XEMACS - /* Allow you to set it really fucking low if you really want ... */ - if (gc_cons_threshold < 10000) - gc_cons_threshold = 10000; -#endif - recompute_need_to_garbage_collect (); - - inhibit_non_essential_conversion_operations = 0; - gc_in_progress = 0; - - run_post_gc_actions (); - - /******* End of garbage collection ********/ - - /* Now remove the GC cursor/message */ - if (!noninteractive) - { - if (cursor_changed) - Fset_frame_pointer (wrap_frame (f), pre_gc_cursor); - else if (!FRAME_STREAM_P (f)) - { - /* Show "...done" only if the echo area would otherwise be empty. */ - if (NILP (clear_echo_area (selected_frame (), - Qgarbage_collecting, 0))) - { - if (garbage_collection_messages) - { - Lisp_Object args[2], whole_msg; - args[0] = (STRINGP (Vgc_message) ? Vgc_message : - build_msg_string (gc_default_message)); - args[1] = build_msg_string ("... done"); - whole_msg = Fconcat (2, args); - echo_area_message (selected_frame (), (Ibyte *) 0, - whole_msg, 0, -1, - Qgarbage_collecting); - } - } - } - } - - /* now stop inhibiting GC */ - unbind_to (speccount); - -#ifndef MC_ALLOC - if (!breathing_space) - { - breathing_space = malloc (4096 - MALLOC_OVERHEAD); - } -#endif /* not MC_ALLOC */ - - UNGCPRO; - - need_to_signal_post_gc = 1; - funcall_allocation_flag = 1; - - PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection); - - return; -} - #ifdef ALLOC_TYPE_STATS static Lisp_Object ＠＠ -5573,13 +4474,6 ＠＠ pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl); } } - pl = gc_plist_hack ("string-data-storage-including-overhead", - lrecord_string_data_bytes_in_use_including_overhead, pl); - pl = gc_plist_hack ("string-data-storage-additional", - lrecord_string_data_bytes_in_use, pl); - pl = gc_plist_hack ("string-data-used", - lrecord_string_data_instances_in_use, pl); - tgu_val += lrecord_string_data_bytes_in_use_including_overhead; #else /* not MC_ALLOC */ ＠＠ -5720,7 +4614,11 ＠＠ ()) { /* Record total usage for purposes of determining next GC */ +#ifdef NEW_GC + gc_full (); +#else /* not NEW_GC */ garbage_collect_1 (); +#endif /* not NEW_GC */ /* This will get set to 1, and total_gc_usage computed, as part of the call to object_memory_usage_stats() -- if ALLOC_TYPE_STATS is enabled. */ ＠＠ -5819,28 +4717,6 ＠＠ need_to_signal_post_gc; } -/* True if it's time to garbage collect now. */ -static void -recompute_need_to_garbage_collect (void) -{ - if (always_gc) - need_to_garbage_collect = 1; - else - need_to_garbage_collect = - (consing_since_gc > gc_cons_threshold - && -#if 0 /* #### implement this better */ - (100 * consing_since_gc) / total_data_usage () >= - gc_cons_percentage -#else - (!total_gc_usage_set || - (100 * consing_since_gc) / total_gc_usage >= - gc_cons_percentage) -#endif - ); - recompute_funcall_allocation_flag (); -} -  int object_dead_p (Lisp_Object obj) ＠＠ -6007,11 +4883,9 ＠＠ Qnull_pointer = wrap_pointer_1 (0); #endif - gc_generation_number[0] = 0; #ifndef MC_ALLOC breathing_space = 0; #endif /* not MC_ALLOC */ - Vgc_message = Qzero; #ifndef MC_ALLOC all_lcrecords = 0; #endif /* not MC_ALLOC */ ＠＠ -6023,7 +4897,9 ＠＠ mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */ #endif #endif +#ifndef NEW_GC init_string_chars_alloc (); +#endif /* not NEW_GC */ #ifndef MC_ALLOC init_string_alloc (); init_string_chars_alloc (); ＠＠ -6081,26 +4957,15 ＠＠ #endif /* MC_ALLOC */ consing_since_gc = 0; - need_to_garbage_collect = always_gc; need_to_check_c_alloca = 0; funcall_allocation_flag = 0; funcall_alloca_count = 0; -#if 1 - gc_cons_threshold = 2000000; /* XEmacs change */ -#else - gc_cons_threshold = 15000; /* debugging */ -#endif - gc_cons_percentage = 40; /* #### what is optimal? */ - total_gc_usage_set = 0; lrecord_uid_counter = 259; #ifndef MC_ALLOC debug_string_purity = 0; #endif /* not MC_ALLOC */ - gc_currently_forbidden = 0; - gc_hooks_inhibited = 0; - #ifdef ERROR_CHECK_TYPES ERROR_ME.really_unlikely_name_to_have_accidentally_in_a_non_errb_structure = 666; ＠＠ -6167,6 +5032,10 ＠＠ INIT_LRECORD_IMPLEMENTATION (cons); INIT_LRECORD_IMPLEMENTATION (vector); INIT_LRECORD_IMPLEMENTATION (string); +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (string_indirect_data); + INIT_LRECORD_IMPLEMENTATION (string_direct_data); +#endif /* NEW_GC */ #ifndef MC_ALLOC INIT_LRECORD_IMPLEMENTATION (lcrecord_list); INIT_LRECORD_IMPLEMENTATION (free); ＠＠ -6200,8 +5069,6 ＠＠ void syms_of_alloc (void) { - DEFSYMBOL (Qpre_gc_hook); - DEFSYMBOL (Qpost_gc_hook); DEFSYMBOL (Qgarbage_collecting); DEFSUBR (Fcons); ＠＠ -6232,49 +5099,6 ＠＠ void vars_of_alloc (void) { - QSin_garbage_collection = build_msg_string ("(in garbage collection)"); - staticpro (&QSin_garbage_collection); - - DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold /* -*Number of bytes of consing between garbage collections. -\"Consing\" is a misnomer in that this actually counts allocation -of all different kinds of objects, not just conses. -Garbage collection can happen automatically once this many bytes have been -allocated since the last garbage collection. All data types count. - -Garbage collection happens automatically when `eval' or `funcall' are -called. (Note that `funcall' is called implicitly as part of evaluation.) -By binding this temporarily to a large number, you can effectively -prevent garbage collection during a part of the program. - -Normally, you cannot set this value less than 10,000 (if you do, it is -automatically reset during the next garbage collection). However, if -XEmacs was compiled with DEBUG_XEMACS, this does not happen, allowing -you to set this value very low to track down problems with insufficient -GCPRO'ing. If you set this to a negative number, garbage collection will -happen at *EVERY* call to `eval' or `funcall'. This is an extremely -effective way to check GCPRO problems, but be warned that your XEmacs -will be unusable! You almost certainly won't have the patience to wait -long enough to be able to set it back. - -See also `consing-since-gc' and `gc-cons-percentage'. -*/ ); - - DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /* -*Percentage of memory allocated between garbage collections. - -Garbage collection will happen if this percentage of the total amount of -memory used for data (see `lisp-object-memory-usage') has been allocated -since the last garbage collection. However, it will not happen if less -than `gc-cons-threshold' bytes have been allocated -- this sets an absolute -minimum in case very little data has been allocated or the percentage is -set very low. Set this to 0 to have garbage collection always happen after -`gc-cons-threshold' bytes have been allocated, regardless of current memory -usage. - -See also `consing-since-gc' and `gc-cons-threshold'. -*/ ); - #ifdef DEBUG_XEMACS DEFVAR_INT ("debug-allocation", &debug_allocation /* If non-zero, print out information to stderr about all objects allocated. ＠＠ -6293,49 +5117,4 ＠＠ Non-nil means loading Lisp code in order to dump an executable. This means that certain objects should be allocated in readonly space. */ ); - - DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages /* - Non-nil means display messages at start and end of garbage collection. -*/ ); - garbage_collection_messages = 0; - - DEFVAR_LISP ("pre-gc-hook", &Vpre_gc_hook /* -Function or functions to be run just before each garbage collection. -Interrupts, garbage collection, and errors are inhibited while this hook -runs, so be extremely careful in what you add here. In particular, avoid -consing, and do not interact with the user. -*/ ); - Vpre_gc_hook = Qnil; - - DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook /* -Function or functions to be run just after each garbage collection. -Interrupts, garbage collection, and errors are inhibited while this hook -runs. Each hook is called with one argument which is an alist with -finalization data. -*/ ); - Vpost_gc_hook = Qnil; - - DEFVAR_LISP ("gc-message", &Vgc_message /* -String to print to indicate that a garbage collection is in progress. -This is printed in the echo area. If the selected frame is on a -window system and `gc-pointer-glyph' specifies a value (i.e. a pointer -image instance) in the domain of the selected frame, the mouse pointer -will change instead of this message being printed. -*/ ); - Vgc_message = build_string (gc_default_message); - - DEFVAR_LISP ("gc-pointer-glyph", &Vgc_pointer_glyph /* -Pointer glyph used to indicate that a garbage collection is in progress. -If the selected window is on a window system and this glyph specifies a -value (i.e. a pointer image instance) in the domain of the selected -window, the pointer will be changed as specified during garbage collection. -Otherwise, a message will be printed in the echo area, as controlled -by `gc-message'. -*/ ); -} - -void -complex_vars_of_alloc (void) -{ - Vgc_pointer_glyph = Fmake_glyph_internal (Qpointer); } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/buffer.c newgc-xemacs-21.5/src/buffer.c --- xemacs-21.5/src/buffer.c 2005-10-25 10:32:47.000000000 +0200 +++ newgc-xemacs-21.5/src/buffer.c 2005-11-20 18:02:59.000000000 +0100 ＠＠ -233,6 +233,14 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("buffer-text", buffer_text, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + buffer_text_description_1, + Lisp_Buffer_Text); +#endif /* NEW_GC */ + static const struct sized_memory_description buffer_text_description = { sizeof (struct buffer_text), buffer_text_description_1 ＠＠ -244,10 +252,16 ＠＠ { XD_LISP_OBJECT, offsetof (struct buffer, extent_info) }, +#ifdef NEW_GC + { XD_BLOCK_PTR, offsetof (struct buffer, text), + 1, { &buffer_text_description } }, + { XD_LISP_OBJECT, offsetof (struct buffer, syntax_cache) }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, offsetof (struct buffer, text), 1, { &buffer_text_description } }, { XD_BLOCK_PTR, offsetof (struct buffer, syntax_cache), 1, { &syntax_cache_description } }, +#endif /* not NEW_GC */ { XD_LISP_OBJECT, offsetof (struct buffer, indirect_children) }, { XD_LISP_OBJECT, offsetof (struct buffer, base_buffer) }, ＠＠ -1889,6 +1903,9 ＠＠ syms_of_buffer (void) { INIT_LRECORD_IMPLEMENTATION (buffer); +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (buffer_text); +#endif /* NEW_GC */ DEFSYMBOL (Qbuffer_live_p); DEFSYMBOL (Qbuffer_or_string_p); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/buffer.h newgc-xemacs-21.5/src/buffer.h --- xemacs-21.5/src/buffer.h 2005-10-24 12:07:34.000000000 +0200 +++ newgc-xemacs-21.5/src/buffer.h 2005-10-29 13:53:27.000000000 +0200 ＠＠ -79,6 +79,9 ＠＠ struct buffer_text { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ Ibyte *beg; /* Actual address of buffer contents. */ Bytebpos gpt; /* Index of gap in buffer. */ Charbpos bufgpt; /* Equivalent as a Charbpos. */ ＠＠ -138,6 +141,20 ＠＠ struct buffer_text_change_data *changes; }; +#ifdef NEW_GC +typedef struct buffer_text Lisp_Buffer_Text; + +DECLARE_LRECORD (buffer_text, Lisp_Buffer_Text); + +#define XBUFFER_TEXT(x) \ + XRECORD (x, buffer_text, Lisp_Buffer_Text) +#define wrap_buffer_text(p) wrap_record (p, buffer_text) +#define BUFFER_TEXT_P(x) RECORDP (x, buffer_text) +#define CHECK_BUFFER_TEXT(x) CHECK_RECORD (x, buffer_text) +#define CONCHECK_BUFFER_TEXT(x) CONCHECK_RECORD (x, buffer_text) +#endif /* NEW_GC */ + + struct buffer { struct LCRECORD_HEADER header; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/bytecode.c newgc-xemacs-21.5/src/bytecode.c --- xemacs-21.5/src/bytecode.c 2005-04-09 01:11:19.000000000 +0200 +++ newgc-xemacs-21.5/src/bytecode.c 2005-11-02 10:34:13.000000000 +0100 ＠＠ -58,6 +58,45 ＠＠ #include "syntax.h" #include "window.h" +#ifdef NEW_GC +static Lisp_Object +make_compiled_function_args (int totalargs) +{ + Lisp_Compiled_Function_Args *args; + args = (Lisp_Compiled_Function_Args *) + alloc_lrecord + (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args, + Lisp_Object, args, totalargs), + &lrecord_compiled_function_args); + args->size = totalargs; + return wrap_compiled_function_args (args); +} + +static Bytecount +size_compiled_function_args (const void *lheader) +{ + return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args, + Lisp_Object, args, + ((Lisp_Compiled_Function_Args *) + lheader)->size); +} + +static const struct memory_description compiled_function_args_description[] = { + { XD_LONG, offsetof (Lisp_Compiled_Function_Args, size) }, + { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Compiled_Function_Args, args), + XD_INDIRECT(0, 0) }, + { XD_END } +}; + +DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("compiled-function-args", + compiled_function_args, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + compiled_function_args_description, + size_compiled_function_args, + Lisp_Compiled_Function_Args); +#endif /* NEW_GC */ + EXFUN (Ffetch_bytecode, 1); Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code; ＠＠ -2022,13 +2061,21 ＠＠ } if (totalargs) +#ifdef NEW_GC + f->arguments = make_compiled_function_args (totalargs); +#else /* not NEW_GC */ f->args = xnew_array (Lisp_Object, totalargs); +#endif /* not NEW_GC */ { LIST_LOOP_2 (arg, f->arglist) { if (!EQ (arg, Qand_optional) && !EQ (arg, Qand_rest)) +#ifdef NEW_GC + XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i++] = arg; +#else /* not NEW_GC */ f->args[i++] = arg; +#endif /* not NEW_GC */ } } ＠＠ -2061,6 +2108,7 ＠＠ /************************************************************************/ /* The compiled-function object type */ /************************************************************************/ + static void print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) ＠＠ -2143,7 +2191,11 ＠＠ mark_object (f->annotated); #endif for (i = 0; i < f->args_in_array; i++) +#ifdef NEW_GC + mark_object (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i]); +#else /* not NEW_GC */ mark_object (f->args[i]); +#endif /* not NEW_GC */ /* tail-recurse on constants */ return f->constants; ＠＠ -2179,8 +2231,12 ＠＠ static const struct memory_description compiled_function_description[] = { { XD_INT, offsetof (Lisp_Compiled_Function, args_in_array) }, - { XD_BLOCK_PTR, offsetof (Lisp_Compiled_Function, args), +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arguments) }, +#else /* not NEW_GC */ + { XD_BLOCK_PTR, offsetof (Lisp_Compiled_Function, args), XD_INDIRECT (0, 0), { &lisp_object_description } }, +#endif /* not NEW_GC */ { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, instructions) }, { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, constants) }, { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arglist) }, ＠＠ -2191,7 +2247,7 ＠＠ { XD_END } }; -#ifdef MC_ALLOC +#if defined(MC_ALLOC) && !defined(NEW_GC) static void finalize_compiled_function (void *header, int for_disksave) { ＠＠ -2213,7 +2269,7 ＠＠ compiled_function_hash, compiled_function_description, Lisp_Compiled_Function); -#else /* not MC_ALLOC */ +#else /* !MC_ALLOC || NEW_GC */ DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function, 1, /*dumpable_flag*/ mark_compiled_function, ＠＠ -2222,7 +2278,8 ＠＠ compiled_function_hash, compiled_function_description, Lisp_Compiled_Function); -#endif /* not MC_ALLOC */ +#endif /* !MC_ALLOC || NEW_GC */ +  DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /* Return t if OBJECT is a byte-compiled function object. ＠＠ -2594,6 +2651,9 ＠＠ syms_of_bytecode (void) { INIT_LRECORD_IMPLEMENTATION (compiled_function); +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (compiled_function_args); +#endif /* NEW_GC */ DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state); DEFSYMBOL (Qbyte_code); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/bytecode.h newgc-xemacs-21.5/src/bytecode.h --- xemacs-21.5/src/bytecode.h 2002-04-14 14:42:14.000000000 +0200 +++ newgc-xemacs-21.5/src/bytecode.h 2005-05-23 14:52:49.000000000 +0200 ＠＠ -31,6 +31,32 ＠＠ #ifndef INCLUDED_bytecode_h_ #define INCLUDED_bytecode_h_ +#ifdef NEW_GC +struct compiled_function_args +{ + struct lrecord_header header; + long size; + Lisp_Object args[1]; +}; + +typedef struct compiled_function_args Lisp_Compiled_Function_Args; + +DECLARE_LRECORD (compiled_function_args, Lisp_Compiled_Function_Args); + +#define XCOMPILED_FUNCTION_ARGS(x) \ + XRECORD (x, compiled_function_args, Lisp_Compiled_Function_Args) +#define wrap_compiled_function_args(p) wrap_record (p, compiled_function_args) +#define COMPILED_FUNCTION_ARGS_P(x) RECORDP (x, compiled_function_args) +#define CHECK_COMPILED_FUNCTION_ARGS(x) \ + CHECK_RECORD (x, compiled_function_args) +#define CONCHECK_COMPILED_FUNCTION_ARGS(x) \ + CONCHECK_RECORD (x, compiled_function_args) + +#define compiled_function_args_data(v) ((v)->args) +#define XCOMPILED_FUNCTION_ARGS_DATA(s) \ + compiled_function_args_data (XCOMPILED_FUNCTION_ARGS (s)) +#endif /* not NEW_GC */ + /* Meanings of slots in a Lisp_Compiled_Function. Don't use these! For backward compatibility only. */ #define COMPILED_ARGLIST 0 ＠＠ -64,7 +90,11 ＠＠ Lisp_Object arglist; /* For speed, we unroll arglist into an array of argument symbols, so we don't have to process arglist every time we make a function call. */ +#ifdef NEW_GC + Lisp_Object arguments; +#else /* not NEW_GC */ Lisp_Object *args; +#endif /* not NEW_GC */ /* Minimum and maximum number of arguments. If MAX_ARGS == MANY, the function was declared with &rest, and (args_in_array - 1) indicates how many arguments there are before the &rest argument. (We could diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/config.h.in newgc-xemacs-21.5/src/config.h.in --- xemacs-21.5/src/config.h.in 2005-10-25 13:19:58.000000000 +0200 +++ newgc-xemacs-21.5/src/config.h.in 2005-10-29 13:53:27.000000000 +0200 ＠＠ -414,6 +414,14 ＠＠ #undef HAVE_WCSCMP #undef HAVE_WCSLEN +/* Functions and structs checked for vdb. */ +#undef HAVE_MPROTECT +#undef HAVE_SIGACTION +#undef HAVE_STRUCT_SIGINFO_SI_ADDR +#undef HAVE_SIGINFO_T_SI_ADDR +#undef HAVE_SIGNAL +#undef HAVE_STRUCT_SIGCONTEXT_CR2 + #undef HAVE_UTIME #undef HAVE_UTIMES #undef HAVE_SIGSETJMP ＠＠ -681,6 +689,15 ＠＠ /* If defined, use experimental allocator. */ #undef MC_ALLOC +/* If defined, use experimental incremental garbage collector. */ +#undef NEW_GC + +/* Virtual dirty bit implementation for incremental gc. */ +#undef VDB_POSIX +#undef VDB_MACH +#undef VDB_WIN32 +#undef VDB_FAKE + /* Enable special GNU Make features in the Makefiles. */ #undef USE_GNU_MAKE diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console.c newgc-xemacs-21.5/src/console.c --- xemacs-21.5/src/console.c 2005-10-25 13:16:21.000000000 +0200 +++ newgc-xemacs-21.5/src/console.c 2005-11-02 00:22:32.000000000 +0100 ＠＠ -115,9 +115,17 ＠＠ static const struct memory_description console_data_description_1 []= { #ifdef HAVE_TTY +#ifdef NEW_GC + { XD_LISP_OBJECT, tty_console }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, tty_console, 1, { &tty_console_data_description} }, +#endif /* not NEW_GC */ #endif +#ifdef NEW_GC + { XD_LISP_OBJECT, stream_console }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, stream_console, 1, { &stream_console_data_description} }, +#endif /* not NEW_GC */ { XD_END } }; ＠＠ -1189,6 +1197,12 ＠＠ syms_of_console (void) { INIT_LRECORD_IMPLEMENTATION (console); +#ifdef NEW_GC +#ifdef HAVE_TTY + INIT_LRECORD_IMPLEMENTATION (tty_console); +#endif + INIT_LRECORD_IMPLEMENTATION (stream_console); +#endif /* not NEW_GC */ DEFSUBR (Fvalid_console_type_p); DEFSUBR (Fconsole_type_list); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console-gtk-impl.h newgc-xemacs-21.5/src/console-gtk-impl.h --- xemacs-21.5/src/console-gtk-impl.h 2004-07-07 14:01:06.000000000 +0200 +++ newgc-xemacs-21.5/src/console-gtk-impl.h 2005-11-02 01:10:28.000000000 +0100 ＠＠ -49,6 +49,9 ＠＠ struct gtk_device { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ /* Gtk application info. */ GtkWidget *gtk_app_shell; ＠＠ -109,6 +112,17 ＠＠ #endif }; +#ifdef NEW_GC +typedef struct gtk_device Lisp_Gtk_Device; + +DECLARE_LRECORD (gtk_device, Lisp_Gtk_Device); + +#define XGTK_DEVICE(x) \ + XRECORD (x, gtk_device, Lisp_Gtk_Device) +#define wrap_gtk_device(p) wrap_record (p, gtk_device) +#define GTK_DEVICE_P(x) RECORDP (x, gtk_device) +#endif /* NEW_GC */ + #define DEVICE_GTK_DATA(d) DEVICE_TYPE_DATA (d, gtk) #define DEVICE_GTK_VISUAL(d) (DEVICE_GTK_DATA (d)->visual) ＠＠ -129,6 +143,10 ＠＠ struct gtk_frame { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ + /* The widget of this frame. */ GtkWidget *widget; /* This is really a GtkWindow */ ＠＠ -182,6 +200,17 ＠＠ Lisp_Object widget_callback_ex_hash_table; }; +#ifdef NEW_GC +typedef struct gtk_frame Lisp_Gtk_Frame; + +DECLARE_LRECORD (gtk_frame, Lisp_Gtk_Frame); + +#define XGTK_FRAME(x) \ + XRECORD (x, gtk_frame, Lisp_Gtk_Frame) +#define wrap_gtk_frame(p) wrap_record (p, gtk_frame) +#define GTK_FRAME_P(x) RECORDP (x, gtk_frame) +#endif /* NEW_GC */ + #define FRAME_GTK_DATA(f) FRAME_TYPE_DATA (f, gtk) #define FRAME_GTK_SHELL_WIDGET(f) (FRAME_GTK_DATA (f)->widget) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console-msw-impl.h newgc-xemacs-21.5/src/console-msw-impl.h --- xemacs-21.5/src/console-msw-impl.h 2005-10-24 12:07:34.000000000 +0200 +++ newgc-xemacs-21.5/src/console-msw-impl.h 2005-11-02 01:10:28.000000000 +0100 ＠＠ -81,6 +81,9 ＠＠ struct mswindows_device { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ Lisp_Object fontlist; /* List of (STRING . FIXED-P), device fonts */ HDC hcdc; /* Compatible DC */ DWORD update_tick; /* Used when device is modified through ＠＠ -88,6 +91,17 ＠＠ in event-msw.c */ }; +#ifdef NEW_GC +typedef struct mswindows_device Lisp_Mswindows_Device; + +DECLARE_LRECORD (mswindows_device, Lisp_Mswindows_Device); + +#define XMSWINDOWS_DEVICE(x) \ + XRECORD (x, mswindows_device, Lisp_Mswindows_Device) +#define wrap_mswindows_device(p) wrap_record (p, mswindows_device) +#define MSWINDOWS_DEVICE_P(x) RECORDP (x, mswindows_device) +#endif /* NEW_GC */ + #define DEVICE_MSWINDOWS_DATA(d) DEVICE_TYPE_DATA (d, mswindows) #define DEVICE_MSWINDOWS_FONTLIST(d) (DEVICE_MSWINDOWS_DATA (d)->fontlist) #define DEVICE_MSWINDOWS_HCDC(d) (DEVICE_MSWINDOWS_DATA (d)->hcdc) ＠＠ -95,6 +109,9 ＠＠ struct msprinter_device { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ HDC hdc, hcdc; /* Printer and the comp. DCs */ HANDLE hprinter; Lisp_Object name; ＠＠ -102,6 +119,17 ＠＠ Lisp_Object fontlist; }; +#ifdef NEW_GC +typedef struct msprinter_device Lisp_Msprinter_Device; + +DECLARE_LRECORD (msprinter_device, Lisp_Msprinter_Device); + +#define XMSPRINTER_DEVICE(x) \ + XRECORD (x, msprinter_device, Lisp_Msprinter_Device) +#define wrap_msprinter_device(p) wrap_record (p, msprinter_device) +#define MSPRINTER_DEVICE_P(x) RECORDP (x, msprinter_device) +#endif /* NEW_GC */ + #define DEVICE_MSPRINTER_DATA(d) DEVICE_TYPE_DATA (d, msprinter) #define DEVICE_MSPRINTER_HDC(d) (DEVICE_MSPRINTER_DATA (d)->hdc) #define DEVICE_MSPRINTER_HCDC(d) (DEVICE_MSPRINTER_DATA (d)->hcdc) ＠＠ -139,6 +167,10 ＠＠ struct mswindows_frame { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ + /* win32 window handle */ HWND hwnd; ＠＠ -199,6 +231,17 ＠＠ XEMACS_RECT_WH *target_rect; }; +#ifdef NEW_GC +typedef struct mswindows_frame Lisp_Mswindows_Frame; + +DECLARE_LRECORD (mswindows_frame, Lisp_Mswindows_Frame); + +#define XMSWINDOWS_FRAME(x) \ + XRECORD (x, mswindows_frame, Lisp_Mswindows_Frame) +#define wrap_mswindows_frame(p) wrap_record (p, mswindows_frame) +#define MSWINDOWS_FRAME_P(x) RECORDP (x, mswindows_frame) +#endif /* NEW_GC */ + #define FRAME_MSWINDOWS_DATA(f) FRAME_TYPE_DATA (f, mswindows) #define FRAME_MSWINDOWS_HANDLE(f) (FRAME_MSWINDOWS_DATA (f)->hwnd) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console-stream.c newgc-xemacs-21.5/src/console-stream.c --- xemacs-21.5/src/console-stream.c 2005-01-25 00:33:48.000000000 +0100 +++ newgc-xemacs-21.5/src/console-stream.c 2005-06-14 12:39:10.000000000 +0200 ＠＠ -53,9 +53,17 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("stream-console", stream_console, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + stream_console_data_description_1, + Lisp_Stream_Console); +#else /* not NEW_GC */ const struct sized_memory_description stream_console_data_description = { sizeof (struct stream_console), stream_console_data_description_1 }; +#endif /* not NEW_GC */ static void stream_init_console (struct console *con, Lisp_Object UNUSED (params)) ＠＠ -63,8 +71,14 ＠＠ Lisp_Object tty = CONSOLE_CONNECTION (con); struct stream_console *stream_con; +#ifdef NEW_GC + if (CONSOLE_STREAM_DATA (con) == NULL) + CONSOLE_STREAM_DATA (con) = alloc_lrecord_type (struct stream_console, + &lrecord_stream_console); +#else /* not NEW_GC */ if (CONSOLE_STREAM_DATA (con) == NULL) CONSOLE_STREAM_DATA (con) = xnew_and_zero (struct stream_console); +#endif /* not NEW_GC */ stream_con = CONSOLE_STREAM_DATA (con); ＠＠ -123,7 +137,11 ＠＠ if (stream_con->in != stdin) retry_fclose (stream_con->in); +#ifdef NEW_GC + mc_free (stream_con); +#else /* not NEW_GC */ xfree (stream_con, struct stream_console *); +#endif /* not NEW_GC */ CONSOLE_STREAM_DATA (con) = NULL; } } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console-stream.h newgc-xemacs-21.5/src/console-stream.h --- xemacs-21.5/src/console-stream.h 2003-01-12 12:08:09.000000000 +0100 +++ newgc-xemacs-21.5/src/console-stream.h 2005-06-10 01:27:48.000000000 +0200 ＠＠ -29,7 +29,9 ＠＠ #include "console.h" +#ifndef NEW_GC extern const struct sized_memory_description stream_console_data_description; +#endif /* not NEW_GC */ extern Lisp_Object Vterminal_console, Vterminal_frame, Vterminal_device; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console-stream-impl.h newgc-xemacs-21.5/src/console-stream-impl.h --- xemacs-21.5/src/console-stream-impl.h 2003-01-12 12:08:09.000000000 +0100 +++ newgc-xemacs-21.5/src/console-stream-impl.h 2005-06-06 17:08:32.000000000 +0200 ＠＠ -34,6 +34,9 ＠＠ struct stream_console { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ FILE *in; FILE *out; FILE *err; ＠＠ -41,6 +44,17 ＠＠ Lisp_Object instream; }; +#ifdef NEW_GC +typedef struct stream_console Lisp_Stream_Console; + +DECLARE_LRECORD (stream_console, Lisp_Stream_Console); + +#define XSTREAM_CONSOLE(x) \ + XRECORD (x, stream_console, Lisp_Stream_Console) +#define wrap_stream_console(p) wrap_record (p, stream_console) +#define STREAM_CONSOLE_P(x) RECORDP (x, stream_console) +#endif /* NEW_GC */ + #define CONSOLE_STREAM_DATA(con) CONSOLE_TYPE_DATA (con, stream) #endif /* INCLUDED_console_stream_impl_h_ */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console-tty.c newgc-xemacs-21.5/src/console-tty.c --- xemacs-21.5/src/console-tty.c 2005-07-08 10:27:34.000000000 +0200 +++ newgc-xemacs-21.5/src/console-tty.c 2005-07-13 21:56:25.000000000 +0200 ＠＠ -59,16 +59,29 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("tty-console", tty_console, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + tty_console_data_description_1, + Lisp_Tty_Console); +#else /* not NEW_GC */ const struct sized_memory_description tty_console_data_description = { sizeof (struct tty_console), tty_console_data_description_1 }; +#endif /* not NEW_GC */  static void allocate_tty_console_struct (struct console *con) { /* zero out all slots except the lisp ones ... */ +#ifdef NEW_GC + CONSOLE_TTY_DATA (con) = alloc_lrecord_type (struct tty_console, + &lrecord_tty_console); +#else /* not NEW_GC */ CONSOLE_TTY_DATA (con) = xnew_and_zero (struct tty_console); +#endif /* not NEW_GC */ CONSOLE_TTY_DATA (con)->terminal_type = Qnil; CONSOLE_TTY_DATA (con)->instream = Qnil; CONSOLE_TTY_DATA (con)->outstream = Qnil; ＠＠ -202,7 +215,11 ＠＠ xfree (tty_con->term_entry_buffer, char *); tty_con->term_entry_buffer = NULL; } +#ifdef NEW_GC + mc_free (tty_con); +#else /* not NEW_GC */ xfree (tty_con, struct tty_console *); +#endif /* not NEW_GC */ CONSOLE_TTY_DATA (con) = NULL; } } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console-tty-impl.h newgc-xemacs-21.5/src/console-tty-impl.h --- xemacs-21.5/src/console-tty-impl.h 2002-06-20 23:18:24.000000000 +0200 +++ newgc-xemacs-21.5/src/console-tty-impl.h 2005-11-02 01:00:50.000000000 +0100 ＠＠ -39,6 +39,9 ＠＠ struct tty_console { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ int infd, outfd; Lisp_Object instream, outstream; Lisp_Object terminal_type; ＠＠ -199,6 +202,17 ＠＠ unsigned int is_stdio :1; }; +#ifdef NEW_GC +typedef struct tty_console Lisp_Tty_Console; + +DECLARE_LRECORD (tty_console, Lisp_Tty_Console); + +#define XTTY_CONSOLE(x) \ + XRECORD (x, tty_console, Lisp_Tty_Console) +#define wrap_tty_console(p) wrap_record (p, tty_console) +#define TTY_CONSOLE_P(x) RECORDP (x, tty_console) +#endif /* NEW_GC */ + #define CONSOLE_TTY_DATA(c) CONSOLE_TYPE_DATA (c, tty) #define CONSOLE_TTY_CURSOR_X(c) (CONSOLE_TTY_DATA (c)->cursor_x) #define CONSOLE_TTY_CURSOR_Y(c) (CONSOLE_TTY_DATA (c)->cursor_y) ＠＠ -228,6 +242,9 ＠＠ struct tty_device { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ #ifdef HAVE_TERMIOS speed_t ospeed; /* Output speed (from sg_ospeed) */ #else ＠＠ -235,6 +252,17 ＠＠ #endif }; +#ifdef NEW_GC +typedef struct tty_device Lisp_Tty_Device; + +DECLARE_LRECORD (tty_device, Lisp_Tty_Device); + +#define XTTY_DEVICE(x) \ + XRECORD (x, tty_device, Lisp_Tty_Device) +#define wrap_tty_device(p) wrap_record (p, tty_device) +#define TTY_DEVICE_P(x) RECORDP (x, tty_device) +#endif /* NEW_GC */ + #define DEVICE_TTY_DATA(d) DEVICE_TYPE_DATA (d, tty) /* termcap requires this to be global */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/console-x-impl.h newgc-xemacs-21.5/src/console-x-impl.h --- xemacs-21.5/src/console-x-impl.h 2004-11-05 00:06:18.000000000 +0100 +++ newgc-xemacs-21.5/src/console-x-impl.h 2005-11-02 01:10:28.000000000 +0100 ＠＠ -42,6 +42,9 ＠＠ struct x_device { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ /* The X connection of this device. */ Display *display; ＠＠ -159,6 +162,17 ＠＠ Time modifier_release_time; }; +#ifdef NEW_GC +typedef struct x_device Lisp_X_Device; + +DECLARE_LRECORD (x_device, Lisp_X_Device); + +#define XX_DEVICE(x) \ + XRECORD (x, x_device, Lisp_X_Device) +#define wrap_x_device(p) wrap_record (p, x_device) +#define X_DEVICE_P(x) RECORDP (x, x_device) +#endif /* NEW_GC */ + #define DEVICE_X_DATA(d) DEVICE_TYPE_DATA (d, x) #define FRAME_X_DISPLAY(f) (DEVICE_X_DISPLAY (XDEVICE (f->device))) ＠＠ -225,6 +239,10 ＠＠ struct x_frame { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ + /* The widget of this frame. This is an EmacsShell or an ExternalShell. */ Widget widget; ＠＠ -311,6 +329,16 ＠＠ #endif /* EXTERNAL_WIDGET */ }; +#ifdef NEW_GC +typedef struct x_frame Lisp_X_Frame; + +DECLARE_LRECORD (x_frame, Lisp_X_Frame); + +#define XX_FRAME(x) \ + XRECORD (x, x_frame, Lisp_X_Frame) +#define wrap_x_frame(p) wrap_record (p, x_frame) +#define X_FRAME_P(x) RECORDP (x, x_frame) +#endif /* NEW_GC */ #define FRAME_X_DATA(f) FRAME_TYPE_DATA (f, x) #define FRAME_X_SHELL_WIDGET(f) (FRAME_X_DATA (f)->widget) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/.cvsignore newgc-xemacs-21.5/src/.cvsignore --- xemacs-21.5/src/.cvsignore 2005-06-28 14:02:42.000000000 +0200 +++ newgc-xemacs-21.5/src/.cvsignore 2005-11-02 12:10:08.000000000 +0100 ＠＠ -30,3 +30,5 ＠＠ dump-size xemacs.def xemacs.def.in +.dbxrc +.gdbinit diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/.dbxrc.in newgc-xemacs-21.5/src/.dbxrc.in --- xemacs-21.5/src/.dbxrc.in 1970-01-01 01:00:00.000000000 +0100 +++ newgc-xemacs-21.5/src/.dbxrc.in 2005-07-28 21:02:23.000000000 +0200 ＠＠ -0,0 +1,395 ＠＠ +## -*- ksh -*- +## Copyright (C) 1998 Free Software Foundation, Inc. + +## This file is part of XEmacs. + +## XEmacs is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by the +## Free Software Foundation; either version 2, or (at your option) any +## later version. + +## XEmacs is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +## for more details. + +## You should have received a copy of the GNU General Public License +## along with XEmacs; see the file COPYING. If not, write to +## the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +## Boston, MA 02111-1307, USA. + +## Author: Martin Buchholz + +## You can use this file to debug XEmacs using Sun WorkShop's dbx. + +## Some functions defined here require a running process, but most +## don't. Considerable effort has been expended to this end. + +## Since this file is called `.dbxrc', it will be read by dbx +## automatically when dbx is run in the build directory, which is where +## developers usually debug their xemacs. + +## See also the comments in .gdbinit. + +## See also the question of the XEmacs FAQ, titled +## "How to Debug an XEmacs problem with a debugger". + +## gdb sources the ./.gdbinit in _addition_ to ~/.gdbinit. +## But dbx does _not_ source ~/.dbxrc if it found ./.dbxrc. +## So we simulate the gdb algorithm by doing it ourselves here. + +#define NOT_C_CODE +#include "config.h" + +if test -r $HOME/.dbxrc; then . $HOME/.dbxrc; fi + +dbxenv language_mode ansic + +ignore POLL +ignore IO + +#ifdef VDB_POSIX +ignore SIGSEGV SIGBUS +#endif + +document lbt << 'end' +Usage: lbt +Print the current Lisp stack trace. +Requires a running xemacs process. +end + +function lbt { + call debug_backtrace() +} + +document ldp << 'end' +Usage: ldp lisp_object +Print a Lisp Object value using the Lisp printer. +Requires a running xemacs process. +end + +function ldp { + call debug_print ($1); +} + +Lisp_Type_Int=-2 + +## A bug in dbx prevents string variables from having values beginning with `-'!! +function XEmacsInit { + function ToInt { eval "$1=\$[(int) \`alloc.c\`$1]"; } + ToInt dbg_USE_UNION_TYPE + ToInt Lisp_Type_Char + ToInt Lisp_Type_Record + ToInt dbg_valbits + ToInt dbg_gctypebits + function ToLong { eval "$1=\$[(\`alloc.c\`unsigned long) \`alloc.c\`$1]"; } + ToLong dbg_valmask + ToLong dbg_typemask + xemacs_initted=yes +} + +function printvar { + for i in $*; do eval "echo $i=\$$i"; done +} + +document decode_object << 'end' +Usage: decode_object lisp_object +Extract implementation information from a Lisp Object. +Defines variables $val, $type and $imp. +end + +## Various dbx bugs cause ugliness in following code +function decode_object { + if test -z "$xemacs_initted"; then XEmacsInit; fi; + if test $dbg_USE_UNION_TYPE = 1; then + ## Repeat after me... dbx sux, dbx sux, dbx sux... + ## Allow both `pobj Qnil' and `pobj 0x82746834' to work + case $(whatis $1) in + *Lisp_Object*) obj="$[(`alloc.c`unsigned long)(($1).i)]";; + *) obj="$[(`alloc.c`unsigned long)($1)]";; + esac + else + obj="$[(`alloc.c`unsigned long)($1)]"; + fi + if test $[(int)($obj & 1)] = 1; then + ## It's an int + val=$[(long)(((unsigned long long)$obj) >> 1)] + type=$Lisp_Type_Int + else + type=$[(int)(((void*)$obj) & $dbg_typemask)] + if test $type = $Lisp_Type_Char; then + val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)] + else + ## It's a record pointer + val=$[(void*)$obj] + if test "$val" = "(nil)"; then type=null_pointer; fi + fi + fi + + if test $type = $Lisp_Type_Record; then + lheader="((struct lrecord_header *) $val)" + lrecord_type=$[(enum lrecord_type) $lheader->type] + imp=$[(void*)(`alloc.c`lrecord_implementations_table[$lheader->type])] + else + lheader="((struct lrecord_header *) -1)" + lrecord_type=-1 + imp="0xdeadbeef" + fi + ## printvar obj val type imp +} + +function xint { + decode_object "$*" + print (long) ($val) +} + +document xtype << 'end' +Usage: xtype lisp_object +Print the Lisp type of a lisp object. +end + +function xtype { + decode_object "$*" + if test $type = $Lisp_Type_Int; then echo "int" + elif test $type = $Lisp_Type_Char; then echo "char" + elif test $type = null_pointer; then echo "null_pointer" + else + echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]" + fi +} + +function lisp-shadows { + run -batch -vanilla -f list-load-path-shadows +} + +function environment-to-run-temacs { + unset EMACSLOADPATH + export EMACSBOOTSTRAPLOADPATH=../lisp/:.. + export EMACSBOOTSTRAPMODULEPATH=../modules/:.. +} + +document run-temacs << 'end' +Usage: run-temacs +Run temacs interactively, like xemacs. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. +end + +function run-temacs { + environment-to-run-temacs + run -nd -batch -l ../lisp/loadup.el run-temacs -q ${1+"$＠"} +} + +document check-xemacs << 'end' +Usage: check-xemacs +Run the test suite. Equivalent to 'make check'. +end + +function check-xemacs { + run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated +} + +document check-temacs << 'end' +Usage: check-temacs +Run the test suite on temacs. Equivalent to 'make check-temacs'. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. +end + +function check-temacs { + run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated +} + +document update-elc << 'end' +Usage: update-elc +Run the core lisp byte compilation part of the build procedure. +Use when debugging temacs, not xemacs! +Use this when temacs builds successfully, but xemacs does not. +end + +function update-elc { + environment-to-run-temacs + run -nd -batch -l ../lisp/update-elc.el +} + +document dmp << 'end' +Usage: dmp +Run the dumping part of the build procedure. +Use when debugging temacs, not xemacs! +Use this when temacs builds successfully, but xemacs does not. +end + +function dmp { + environment-to-run-temacs + run -nd -batch -l ../lisp/loadup.el dump +} + +function pstruct { ## pstruct foo.c struct-name + module "$1" > /dev/null + type_ptr="((struct $2 *) $val)" + print $type_ptr + print *$type_ptr +} + +document pobj << 'end' +Usage: pobj lisp_object +Print the internal C representation of a Lisp Object. +end + +function pobj { + decode_object $1 + if test $type = $Lisp_Type_Int; then + print -f"Integer: %d" $val + elif test $type = $Lisp_Type_Char; then + if test $[$val > 32 && $val < 128] = 1; then + print -f"Char: %c" $val + else + print -f"Char: %d" $val + fi + elif test $lrecord_type = lrecord_type_string; then + pstruct alloc.c Lisp_String + elif test $lrecord_type = lrecord_type_cons; then + pstruct alloc.c Lisp_Cons + elif test $lrecord_type = lrecord_type_symbol; then + pstruct symbols.c Lisp_Symbol + echo "Symbol name: $[(char *)($type_ptr->name->data)]" + elif test $lrecord_type = lrecord_type_vector; then + pstruct alloc.c Lisp_Vector + echo "Vector of length $[$type_ptr->size]" + elif test $lrecord_type = lrecord_type_bit_vector; then + pstruct fns.c Lisp_Bit_Vector + elif test $lrecord_type = lrecord_type_buffer; then + pstruct buffer.c buffer + elif test $lrecord_type = lrecord_type_char_table; then + pstruct chartab.c Lisp_Char_Table + elif test $lrecord_type = lrecord_type_char_table_entry; then + pstruct chartab.c Lisp_Char_Table_Entry + elif test $lrecord_type = lrecord_type_charset; then + pstruct mule-charset.c Lisp_Charset + elif test $lrecord_type = lrecord_type_coding_system; then + pstruct file-coding.c Lisp_Coding_System + elif test $lrecord_type = lrecord_type_color_instance; then + pstruct objects.c Lisp_Color_Instance + elif test $lrecord_type = lrecord_type_command_builder; then + pstruct event-stream.c command_builder + elif test $lrecord_type = lrecord_type_compiled_function; then + pstruct bytecode.c Lisp_Compiled_Function + elif test $lrecord_type = lrecord_type_console; then + pstruct console.c console + elif test $lrecord_type = lrecord_type_database; then + pstruct database.c Lisp_Database + elif test $lrecord_type = lrecord_type_device; then + pstruct device.c device + elif test $lrecord_type = lrecord_type_event; then + pstruct events.c Lisp_Event + elif test $lrecord_type = lrecord_type_extent; then + pstruct extents.c extent + elif test $lrecord_type = lrecord_type_extent_auxiliary; then + pstruct extents.c extent_auxiliary + elif test $lrecord_type = lrecord_type_extent_info; then + pstruct extents.c extent_info + elif test $lrecord_type = lrecord_type_face; then + pstruct faces.c Lisp_Face + elif test $lrecord_type = lrecord_type_float; then + pstruct floatfns.c Lisp_Float + elif test $lrecord_type = lrecord_type_font_instance; then + pstruct objects.c Lisp_Font_Instance + elif test $lrecord_type = lrecord_type_frame; then + pstruct frame.c frame + elif test $lrecord_type = lrecord_type_glyph; then + pstruct glyph.c Lisp_Glyph + elif test $lrecord_type = lrecord_type_gui_item; then + pstruct gui.c Lisp_Gui_Item + elif test $lrecord_type = lrecord_type_hash_table; then + pstruct elhash.c Lisp_Hash_Table + elif test $lrecord_type = lrecord_type_image_instance; then + pstruct glyphs.c Lisp_Image_Instance + elif test $lrecord_type = lrecord_type_keymap; then + pstruct keymap.c Lisp_Keymap + elif test $lrecord_type = lrecord_type_lcrecord_list; then + pstruct alloc.c lcrecord_list + elif test $lrecord_type = lrecord_type_ldap; then + pstruct ldap.c Lisp_LDAP + elif test $lrecord_type = lrecord_type_lstream; then + pstruct lstream.c lstream + elif test $lrecord_type = lrecord_type_marker; then + pstruct marker.c Lisp_Marker + elif test $lrecord_type = lrecord_type_opaque; then + pstruct opaque.c Lisp_Opaque + elif test $lrecord_type = lrecord_type_opaque_ptr; then + pstruct opaque.c Lisp_Opaque_Ptr + elif test $lrecord_type = lrecord_type_popup_data; then + pstruct gui-x.c popup_data + elif test $lrecord_type = lrecord_type_process; then + pstruct process.c Lisp_Process + elif test $lrecord_type = lrecord_type_range_table; then + pstruct rangetab.c Lisp_Range_Table + elif test $lrecord_type = lrecord_type_specifier; then + pstruct specifier.c Lisp_Specifier + elif test $lrecord_type = lrecord_type_subr; then + pstruct eval.c Lisp_Subr + elif test $lrecord_type = lrecord_type_symbol_value_buffer_local; then + pstruct symbols.c symbol_value_buffer_local + elif test $lrecord_type = lrecord_type_symbol_value_forward; then + pstruct symbols.c symbol_value_forward + elif test $lrecord_type = lrecord_type_symbol_value_lisp_magic; then + pstruct symbols.c symbol_value_lisp_magic + elif test $lrecord_type = lrecord_type_symbol_value_varalias; then + pstruct symbols.c symbol_value_varalias + elif test $lrecord_type = lrecord_type_timeout; then + pstruct event-stream.c Lisp_Timeout + elif test $lrecord_type = lrecord_type_toolbar_button; then + pstruct toolbar.c toolbar_button + elif test $lrecord_type = lrecord_type_tooltalk_message; then + pstruct tooltalk.c Lisp_Tooltalk_Message + elif test $lrecord_type = lrecord_type_tooltalk_pattern; then + pstruct tooltalk.c Lisp_Tooltalk_Pattern + elif test $lrecord_type = lrecord_type_weak_list; then + pstruct data.c weak_list + elif test $lrecord_type = lrecord_type_window; then + pstruct window.c window + elif test $lrecord_type = lrecord_type_window_configuration; then + pstruct window.c window_config + elif test "$type" = "null_pointer"; then + echo "Lisp Object is a null pointer!!" + else + echo "Unknown Lisp Object type" + print $1 + fi +} + +dbxenv suppress_startup_message 4.0 +## dbxenv mt_watchpoints on + +function dp_core { + print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core +} + +## Barf! +function print_shell { + print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget) +} + +## ------------------------------------------------------------- +## functions to test the debugging support itself. +## If you change this file, make sure the following still work... +## ------------------------------------------------------------- +function test_xtype { + function doit { echo -n "$1: "; xtype "$1"; } + test_various_objects +} + +function test_pobj { + function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; } + test_various_objects +} + +function test_various_objects { + doit Vemacs_major_version + doit Vhelp_char + doit Qnil + doit Qunbound + doit Vobarray + doit Vall_weak_lists + doit Vxemacs_codename +} diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/depend newgc-xemacs-21.5/src/depend --- xemacs-21.5/src/depend 2005-10-04 23:51:35.000000000 +0200 +++ newgc-xemacs-21.5/src/depend 2005-11-01 14:01:41.000000000 +0100 ＠＠ -11,7 +11,7 ＠＠ LISP_H= #else CONFIG_H=config.h -LISP_H=lisp.h compiler.h config.h dumper.h general-slots.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h $(LISP_UNION_H) +LISP_H=lisp.h compiler.h config.h dumper.h gc.h general-slots.h lisp.h lrecord.h mc-alloc.h number-gmp.h number-mp.h number.h symeval.h symsinit.h text.h vdb.h $(LISP_UNION_H) #endif #if defined(HAVE_MS_WINDOWS) ＠＠ -152,6 +152,7 ＠＠ font-lock.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h insdel.h syntax.h frame.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h events.h extents.h faces.h frame-impl.h frame.h frameslots.h glyphs.h gui.h gutter.h menubar.h process.h redisplay.h scrollbar.h specifier.h systime.h toolbar.h window-impl.h window.h winslots.h free-hook.o: $(LISP_H) hash.h +gc.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h casetab.h charset.h chartab.h coding-system-slots.h conslots.h console-impl.h console-stream.h console.h device.h elhash.h events.h extents-impl.h extents.h file-coding.h frame-impl.h frame.h frameslots.h glyphs.h lstream.h opaque.h process.h profile.h redisplay.h scrollbar.h specifier.h sysdep.h sysfile.h systime.h window-impl.h window.h winslots.h general.o: $(LISP_H) general-slots.h getloadavg.o: $(LISP_H) sysfile.h syssignal.h gif_io.o: $(LISP_H) gifrlib.h sysfile.h ＠＠ -187,7 +188,7 ＠＠ macros.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console.h device.h events.h frame.h keymap.h macros.h redisplay.h scrollbar.h systime.h window.h malloc.o: $(CONFIG_H) getpagesize.h syssignal.h marker.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h -mc-alloc.o: $(LISP_H) +mc-alloc.o: $(LISP_H) blocktype.h getpagesize.h md5.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h coding-system-slots.h file-coding.h lstream.h menubar.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h conslots.h console-impl.h console.h device-impl.h device.h devslots.h frame-impl.h frame.h frameslots.h gui.h keymap.h menubar.h redisplay.h scrollbar.h specifier.h window-impl.h window.h winslots.h minibuf.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h commands.h conslots.h console-impl.h console-stream.h console.h events.h frame-impl.h frame.h frameslots.h insdel.h redisplay.h scrollbar.h systime.h window-impl.h window.h winslots.h ＠＠ -261,6 +262,11 ＠＠ unexsol2.o: compiler.h unexsunos4.o: $(CONFIG_H) compiler.h unicode.o: $(LISP_H) charset.h coding-system-slots.h file-coding.h opaque.h sysfile.h +vdb-fake.o: $(LISP_H) +vdb-mach.o: $(LISP_H) +vdb-posix.o: $(LISP_H) +vdb-win32.o: $(LISP_H) intl-auto-encap-win32.h syswindows.h +vdb.o: $(LISP_H) vm-limit.o: $(LISP_H) mem-limits.h widget.o: $(LISP_H) buffer.h bufslots.h casetab.h charset.h chartab.h win32.o: $(LISP_H) backtrace.h buffer.h bufslots.h casetab.h charset.h chartab.h console-msw.h console.h hash.h intl-auto-encap-win32.h profile.h sysfile.h sysproc.h syssignal.h systime.h syswindows.h diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/device.c newgc-xemacs-21.5/src/device.c --- xemacs-21.5/src/device.c 2005-10-25 13:16:22.000000000 +0200 +++ newgc-xemacs-21.5/src/device.c 2005-11-02 01:01:23.000000000 +0100 ＠＠ -86,12 +86,26 ＠＠  +#ifndef NEW_GC extern const struct sized_memory_description gtk_device_data_description; extern const struct sized_memory_description mswindows_device_data_description; extern const struct sized_memory_description msprinter_device_data_description; extern const struct sized_memory_description x_device_data_description; +#endif /* not NEW_GC */ static const struct memory_description device_data_description_1 []= { +#ifdef NEW_GC +#ifdef HAVE_GTK + { XD_LISP_OBJECT, gtk_console }, +#endif +#ifdef HAVE_MS_WINDOWS + { XD_LISP_OBJECT, mswindows_console }, + { XD_LISP_OBJECT, msprinter_console }, +#endif +#ifdef HAVE_X_WINDOWS + { XD_LISP_OBJECT, x_console }, +#endif +#else /* not NEW_GC */ #ifdef HAVE_GTK { XD_BLOCK_PTR, gtk_console, 1, { &gtk_device_data_description} }, #endif ＠＠ -102,6 +116,7 ＠＠ #ifdef HAVE_X_WINDOWS { XD_BLOCK_PTR, x_console, 1, { &x_device_data_description} }, #endif +#endif /* not NEW_GC */ { XD_END } }; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/device-gtk.c newgc-xemacs-21.5/src/device-gtk.c --- xemacs-21.5/src/device-gtk.c 2005-06-26 20:05:03.000000000 +0200 +++ newgc-xemacs-21.5/src/device-gtk.c 2005-11-02 00:58:48.000000000 +0100 ＠＠ -75,11 +75,19 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("gtk-device", gtk_device, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + gtk_device_data_description_1, + Lisp_Gtk_Device); +#else /* not NEW_GC */ extern const struct sized_memory_description gtk_device_data_description; const struct sized_memory_description gtk_device_data_description = { sizeof (struct gtk_device), gtk_device_data_description_1 }; +#endif /* not NEW_GC */  /************************************************************************/ ＠＠ -108,7 +116,11 ＠＠ static void allocate_gtk_device_struct (struct device *d) { +#ifdef NEW_GC + d->device_data = alloc_lrecord_type (struct gtk_device, &lrecord_gtk_device); +#else /* not NEW_GC */ d->device_data = xnew_and_zero (struct gtk_device); +#endif /* not NEW_GC */ DEVICE_GTK_DATA (d)->x_keysym_map_hashtable = Qnil; } ＠＠ -350,7 +362,11 ＠＠ static void free_gtk_device_struct (struct device *d) { +#ifdef NEW_GC + mc_free (d->device_data); +#else /* not NEW_GC */ xfree (d->device_data, void *); +#endif /* not NEW_GC */ } static void ＠＠ -681,6 +697,10 ＠＠ void syms_of_device_gtk (void) { +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (gtk_device); +#endif /* NEW_GC */ + DEFSUBR (Fgtk_keysym_on_keyboard_p); DEFSUBR (Fgtk_display_visual_class); DEFSUBR (Fgtk_display_visual_depth); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/device-msw.c newgc-xemacs-21.5/src/device-msw.c --- xemacs-21.5/src/device-msw.c 2005-10-25 13:16:22.000000000 +0200 +++ newgc-xemacs-21.5/src/device-msw.c 2005-11-02 11:43:51.000000000 +0100 ＠＠ -73,11 +73,19 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("mswindows-device", mswindows_device, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + mswindows_device_data_description_1, + Lisp_Mswindows_Device); +#else /* not NEW_GC */ extern const struct sized_memory_description mswindows_device_data_description; const struct sized_memory_description mswindows_device_data_description = { sizeof (struct mswindows_device), mswindows_device_data_description_1 }; +#endif /* not NEW_GC */ static const struct memory_description msprinter_device_data_description_1 [] = { { XD_LISP_OBJECT, offsetof (struct msprinter_device, name) }, ＠＠ -86,11 +94,19 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("msprinter-device", msprinter_device, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + msprinter_device_data_description_1, + Lisp_Msprinter_Device); +#else /* not NEW_GC */ extern const struct sized_memory_description msprinter_device_data_description; const struct sized_memory_description msprinter_device_data_description = { sizeof (struct msprinter_device), msprinter_device_data_description_1 }; +#endif /* not NEW_GC */ static Lisp_Object allocate_devmode (DEVMODEW *src_devmode, int do_copy, Lisp_Object src_name, struct device *d); ＠＠ -146,7 +162,12 ＠＠ init_baud_rate (d); init_one_device (d); +#ifdef NEW_GC + d->device_data = alloc_lrecord_type (struct mswindows_device, + &lrecord_mswindows_device); +#else /* not NEW_GC */ d->device_data = xnew_and_zero (struct mswindows_device); +#endif /* not NEW_GC */ hdc = CreateCompatibleDC (NULL); assert (hdc != NULL); DEVICE_MSWINDOWS_HCDC (d) = hdc; ＠＠ -279,7 +300,11 ＠＠ #endif DeleteDC (DEVICE_MSWINDOWS_HCDC (d)); +#ifdef NEW_GC + mc_free (d->device_data); +#else /* not NEW_GC */ xfree (d->device_data, void *); +#endif /* not NEW_GC */ } void ＠＠ -495,7 +520,12 ＠＠ LONG dm_size; Extbyte *printer_name; +#ifdef NEW_GC + d->device_data = alloc_lrecord_type (struct msprinter_device, + &lrecord_msprinter_device); +#else /* not NEW_GC */ d->device_data = xnew_and_zero (struct msprinter_device); +#endif /* not NEW_GC */ DEVICE_INFD (d) = DEVICE_OUTFD (d) = -1; DEVICE_MSPRINTER_DEVMODE (d) = Qnil; ＠＠ -546,7 +576,11 ＠＠ DEVICE_MSPRINTER_DEVMODE (d) = Qnil; } +#ifdef NEW_GC + mc_free (d->device_data); +#else /* not NEW_GC */ xfree (d->device_data, void *); +#endif /* not NEW_GC */ } } ＠＠ -1345,6 +1379,11 ＠＠ { INIT_LRECORD_IMPLEMENTATION (devmode); +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (mswindows_device); + INIT_LRECORD_IMPLEMENTATION (msprinter_device); +#endif /* NEW_GC */ + DEFSUBR (Fmsprinter_get_settings); DEFSUBR (Fmsprinter_select_settings); DEFSUBR (Fmsprinter_apply_settings); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/device-tty.c newgc-xemacs-21.5/src/device-tty.c --- xemacs-21.5/src/device-tty.c 2005-01-25 00:33:49.000000000 +0100 +++ newgc-xemacs-21.5/src/device-tty.c 2005-11-02 00:59:29.000000000 +0100 ＠＠ -44,10 +44,26 ＠＠ Lisp_Object Qinit_pre_tty_win, Qinit_post_tty_win;  +#ifdef NEW_GC +static const struct memory_description tty_device_data_description_1 [] = { + { XD_END } +}; + +DEFINE_LRECORD_IMPLEMENTATION ("tty-device", tty_device, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + tty_device_data_description_1, + Lisp_Tty_Device); +#endif /* NEW_GC */ + static void allocate_tty_device_struct (struct device *d) { +#ifdef NEW_GC + d->device_data = alloc_lrecord_type (struct tty_device, &lrecord_tty_device); +#else /* not NEW_GC */ d->device_data = xnew_and_zero (struct tty_device); +#endif /* not NEW_GC */ } static void ＠＠ -97,6 +113,7 ＠＠ call0 (Qinit_pre_tty_win); } +#ifndef NEW_GC static void free_tty_device_struct (struct device *d) { ＠＠ -109,6 +126,7 ＠＠ { free_tty_device_struct (d); } +#endif /* not NEW_GC */ #ifdef SIGWINCH ＠＠ -189,6 +207,10 ＠＠ void syms_of_device_tty (void) { +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (tty_device); +#endif /* NEW_GC */ + DEFSYMBOL (Qinit_pre_tty_win); DEFSYMBOL (Qinit_post_tty_win); } ＠＠ -198,7 +220,9 ＠＠ { /* device methods */ CONSOLE_HAS_METHOD (tty, init_device); +#ifndef NEW_GC CONSOLE_HAS_METHOD (tty, delete_device); +#endif /* not NEW_GC */ #ifdef SIGWINCH CONSOLE_HAS_METHOD (tty, asynch_device_change); #endif /* SIGWINCH */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/device-x.c newgc-xemacs-21.5/src/device-x.c --- xemacs-21.5/src/device-x.c 2005-10-25 13:16:22.000000000 +0200 +++ newgc-xemacs-21.5/src/device-x.c 2005-11-02 00:59:38.000000000 +0100 ＠＠ -109,11 +109,19 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("x-device", x_device, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + x_device_data_description_1, + Lisp_X_Device); +#else /* not NEW_GC */ extern const struct sized_memory_description x_device_data_description; const struct sized_memory_description x_device_data_description = { sizeof (struct x_device), x_device_data_description_1 }; +#endif /* not NEW_GC */ /* Functions to synchronize mirroring resources and specifiers */ int in_resource_setting; ＠＠ -202,7 +210,11 ＠＠ static void allocate_x_device_struct (struct device *d) { +#ifdef NEW_GC + d->device_data = alloc_lrecord_type (struct x_device, &lrecord_x_device); +#else /* not NEW_GC */ d->device_data = xnew_and_zero (struct x_device); +#endif /* not NEW_GC */ } static void ＠＠ -885,7 +897,11 ＠＠ static void free_x_device_struct (struct device *d) { +#ifdef NEW_GC + mc_free (d->device_data); +#else /* not NEW_GC */ xfree (d->device_data, void *); +#endif /* not NEW_GC */ } static void ＠＠ -2037,6 +2053,10 ＠＠ void syms_of_device_x (void) { +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (x_device); +#endif /* NEW_GC */ + DEFSUBR (Fx_debug_mode); DEFSUBR (Fx_get_resource); DEFSUBR (Fx_get_resource_prefix); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/dumper.c newgc-xemacs-21.5/src/dumper.c --- xemacs-21.5/src/dumper.c 2005-10-14 03:22:00.000000000 +0200 +++ newgc-xemacs-21.5/src/dumper.c 2005-11-20 16:53:57.000000000 +0100 ＠＠ -686,6 +686,12 ＠＠ } static void pdump_register_object (Lisp_Object obj); +#ifdef NEW_GC +static void pdump_register_object_array (Lisp_Object data, + Bytecount size, + const struct memory_description *desc, + int count); +#endif /* NEW_GC */ static void pdump_register_block_contents (const void *data, Bytecount size, const struct memory_description * ＠＠ -781,6 +787,20 ＠＠ } break; } +#ifdef NEW_GC + case XD_LISP_OBJECT_BLOCK_PTR: + { + EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, + data); + const struct sized_memory_description *sdesc = + lispdesc_indirect_description (data, desc1->data2.descr); + const Lisp_Object *pobj = (const Lisp_Object *) rdata; + if (pobj) + pdump_register_object_array + (*pobj, sdesc->size, sdesc->description, count); + break; + } +#endif /* NEW_GC */ case XD_BLOCK_PTR: { EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, ＠＠ -876,6 +896,47 ＠＠ } } +#ifdef NEW_GC +static void +pdump_register_object_array (Lisp_Object obj, + Bytecount size, + const struct memory_description *desc, + int count) +{ + struct lrecord_header *objh; + const struct lrecord_implementation *imp; + + if (!POINTER_TYPE_P (XTYPE (obj))) + return; + + objh = XRECORD_LHEADER (obj); + if (!objh) + return; + + if (pdump_get_block (objh)) + return; + + imp = LHEADER_IMPLEMENTATION (objh); + + if (imp->description + && RECORD_DUMPABLE (objh)) + { + pdump_bump_depth (); + backtrace[pdump_depth - 1].obj = objh; + pdump_add_block (pdump_object_table + objh->type, + objh, lispdesc_block_size_1 (objh, size, desc), count); + pdump_register_block_contents (objh, size, desc, count); + --pdump_depth; + } + else + { + pdump_alert_undump_object[objh->type]++; + stderr_out ("Undumpable object type : %s\n", imp->name); + pdump_backtrace (); + } +} +#endif /* NEW_GC */ + /* Register the referenced objects in the array of COUNT blocks located at DATA; each block is described by SIZE and DESC. "Block" here simply means any block of memory. ＠＠ -994,6 +1055,9 ＠＠ * (int *) rdata = val; break; } +#ifdef NEW_GC + case XD_LISP_OBJECT_BLOCK_PTR: +#endif /* NEW_GC */ case XD_OPAQUE_DATA_PTR: case XD_ASCII_STRING: case XD_BLOCK_PTR: ＠＠ -1173,7 +1237,9 ＠＠ if (pdump_object_table[i].align == align) for (elt = pdump_object_table[i].first; elt; elt = elt->next) { +#ifndef NEW_GC assert (elt->count == 1); +#endif /* not NEW_GC */ f (elt, lrecord_implementations_table[i]->description); } } ＠＠ -1234,6 +1300,9 ＠＠ case XD_LONG: case XD_INT_RESET: break; +#ifdef NEW_GC + case XD_LISP_OBJECT_BLOCK_PTR: +#endif /* NEW_GC */ case XD_OPAQUE_DATA_PTR: case XD_ASCII_STRING: case XD_BLOCK_PTR: ＠＠ -1252,7 +1321,7 ＠＠ if (POINTER_TYPE_P (XTYPE (*pobj)) && ! EQ (*pobj, Qnull_pointer)) - *pobj = wrap_pointer_1 ((char *) pdump_get_mc_addr + *pobj = wrap_pointer_1 ((Rawbyte *) pdump_get_mc_addr (XPNTR (*pobj))); break; } ＠＠ -1268,7 +1337,7 ＠＠ if (POINTER_TYPE_P (XTYPE (*pobj)) && ! EQ (*pobj, Qnull_pointer)) - *pobj = wrap_pointer_1 ((char *) pdump_get_mc_addr + *pobj = wrap_pointer_1 ((Rawbyte *) pdump_get_mc_addr (XPNTR (*pobj))); } break; ＠＠ -1687,7 +1756,16 ＠＠ while (elt) { EMACS_INT rdata = pdump_get_block (elt->obj)->save_offset; +#ifdef NEW_GC + int j; + for (j=0; j<elt->count; j++) + { + PDUMP_WRITE_ALIGNED (EMACS_INT, rdata); + rdata += elt->size; + } +#else /* not NEW_GC */ PDUMP_WRITE_ALIGNED (EMACS_INT, rdata); +#endif /* not NEW_GC */ elt = elt->next; } } ＠＠ -2136,6 +2214,14 ＠＠ EMACS_INT count; pdump_header *header = (pdump_header *) pdump_start; +#ifdef NEW_GC + /* This is a DEFVAR_BOOL and gets dumped, but the actual value was + already determined by vdb_install_signal_handler () in + vdb-mprotect.c, which could be different from the value in the + dump file. So store it here and restore it after loading the dump + file. */ + int allow_inc_gc = allow_incremental_gc; +#endif /* NEW_GC */ pdump_end = pdump_start + pdump_length; delta = ((EMACS_INT) pdump_start) - header->reloc_address; ＠＠ -2163,16 +2249,16 ＠＠ Bytecount real_size = size * elt_count; if (count == 2) { - mc_addr = (Rawbyte *) mc_alloc (real_size); + if (elt_count <= 1) + mc_addr = (Rawbyte *) mc_alloc (real_size); +#ifdef NEW_GC + else + mc_addr = (Rawbyte *) mc_alloc_array (size, elt_count); +#endif /* NEW_GC */ #ifdef ALLOC_TYPE_STATS inc_lrecord_stats (real_size, (const struct lrecord_header *) - ((char *) rdata + delta)); - if (((const struct lrecord_header *) - ((char *) rdata + delta))->type - == lrecord_type_string) - inc_lrecord_string_data_stats - (((Lisp_String *) ((char *) rdata + delta))->size_); + ((Rawbyte *) rdata + delta)); #endif /* ALLOC_TYPE_STATS */ } else ＠＠ -2182,7 +2268,7 ＠＠ mc_addr += size; pdump_put_mc_addr ((void *) rdata, (EMACS_INT) mc_addr); - memcpy (mc_addr, (char *) rdata + delta, size); + memcpy (mc_addr, (Rawbyte *) rdata + delta, size); } } else if (!(--count)) ＠＠ -2217,13 +2303,13 ＠＠ p = (Rawbyte *) ALIGN_PTR (p, Rawbyte *); if (rt.desc) { - char **reloc = (char **) p; + Rawbyte **reloc = (Rawbyte **) p; for (i = 0; i < rt.count; i++) { - reloc[i] = (char *) pdump_get_mc_addr (reloc[i]); + reloc[i] = (Rawbyte *) pdump_get_mc_addr (reloc[i]); pdump_reloc_one_mc (reloc[i], rt.desc); } - p += rt.count * sizeof (char *); + p += rt.count * sizeof (Rawbyte *); } else if (!(--count)) break; ＠＠ -2320,6 +2406,10 ＠＠ xfree (pdump_mc_hash, mc_addr_elt *); #endif /* MC_ALLOC */ +#ifdef NEW_GC + allow_incremental_gc = allow_inc_gc; +#endif /* NEW_GC */ + return 1; } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/dynarr.c newgc-xemacs-21.5/src/dynarr.c --- xemacs-21.5/src/dynarr.c 2005-01-25 00:33:50.000000000 +0100 +++ newgc-xemacs-21.5/src/dynarr.c 2005-11-02 00:51:32.000000000 +0100 ＠＠ -150,6 +150,39 ＠＠ return d; } +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("dynarr", dynarr, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + 0, + Dynarr); + +static void +Dynarr_lisp_realloc (Dynarr *dy, Elemcount new_size) +{ + void *new_base = alloc_lrecord_array (dy->elsize, new_size, dy->lisp_imp); + void *old_base = dy->base; + if (dy->base) + memcpy (new_base, dy->base, + (dy->max > new_size ? dy->max : new_size) * dy->elsize); + dy->base = new_base; + if (old_base) + mc_free (old_base); +} + +void * +Dynarr_lisp_newf (int elsize, + const struct lrecord_implementation *dynarr_imp, + const struct lrecord_implementation *imp) +{ + Dynarr *d = (Dynarr *) alloc_lrecord (sizeof (Dynarr), dynarr_imp); + d->elsize = elsize; + d->lisp_imp = imp; + + return d; +} +#endif /* not NEW_GC */ + void Dynarr_resize (void *d, Elemcount size) { ＠＠ -168,7 +201,14 ＠＠ /* Don't do anything if the array is already big enough. */ if (newsize > dy->max) { +#ifdef NEW_GC + if (dy->lisp_imp) + Dynarr_lisp_realloc (dy, newsize); + else + Dynarr_realloc (dy, newsize*dy->elsize); +#else /* not NEW_GC */ Dynarr_realloc (dy, newsize*dy->elsize); +#endif /* not NEW_GC */ dy->max = newsize; } } ＠＠ -222,10 +262,27 ＠＠ { Dynarr *dy = (Dynarr *) d; +#ifdef NEW_GC + if (dy->base && !DUMPEDP (dy->base)) + { + if (dy->lisp_imp) + mc_free (dy->base); + else + xfree (dy->base, void *); + } + if(!DUMPEDP (dy)) + { + if (dy->lisp_imp) + mc_free (dy); + else + xfree (dy, Dynarr *); + } +#else /* not NEW_GC */ if (dy->base && !DUMPEDP (dy->base)) xfree (dy->base, void *); if(!DUMPEDP (dy)) xfree (dy, Dynarr *); +#endif /* not NEW_GC */ } #ifdef MEMORY_USAGE_STATS diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/elhash.c newgc-xemacs-21.5/src/elhash.c --- xemacs-21.5/src/elhash.c 2005-10-24 12:07:35.000000000 +0200 +++ newgc-xemacs-21.5/src/elhash.c 2005-11-07 23:11:16.000000000 +0100 ＠＠ -96,6 +96,9 ＠＠ typedef struct htentry { +#ifdef NEW_GC + struct lrecord_header lheader; +#endif /* NEW_GC */ Lisp_Object key; Lisp_Object value; } htentry; ＠＠ -406,7 +409,12 ＠＠ } static void -free_hentries (htentry *hentries, +free_hentries ( +#if defined (NEW_GC) && !defined (ERROR_CHECK_STRUCTURES) + htentry *UNUSED (hentries), +#else + htentry *hentries, +#endif #ifdef ERROR_CHECK_STRUCTURES size_t size #else ＠＠ -414,6 +422,14 ＠＠ #endif ) { +#ifdef NEW_GC +#ifdef ERROR_CHECK_STRUCTURES + htentry *e, *sentinel; + + for (e = hentries, sentinel = e + size; e < sentinel; e++) + mc_free (e); +#endif +#else /* not NEW_GC */ #ifdef ERROR_CHECK_STRUCTURES /* Ensure a crash if other code uses the discarded entries afterwards. */ htentry *e, *sentinel; ＠＠ -424,6 +440,7 ＠＠ if (!DUMPEDP (hentries)) xfree (hentries, htentry *); +#endif /* not NEW_GC */ } static void ＠＠ -448,13 +465,39 ＠＠ htentry_description_1 }; +#ifdef NEW_GC +static const struct memory_description htentry_weak_description_1[] = { + { XD_LISP_OBJECT, offsetof (htentry, key), 0, { 0 }, XD_FLAG_NO_KKCC}, + { XD_LISP_OBJECT, offsetof (htentry, value), 0, { 0 }, XD_FLAG_NO_KKCC}, + { XD_END } +}; + +static const struct sized_memory_description htentry_weak_description = { + sizeof (htentry), + htentry_weak_description_1 +}; + +DEFINE_LRECORD_IMPLEMENTATION ("hash-table-entry", hash_table_entry, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + htentry_description_1, + Lisp_Hash_Table_Entry); +#endif /* NEW_GC */ + static const struct memory_description htentry_union_description_1[] = { /* Note: XD_INDIRECT in this table refers to the surrounding table, and so this will work. */ +#ifdef NEW_GC + { XD_LISP_OBJECT_BLOCK_PTR, HASH_TABLE_NON_WEAK, + XD_INDIRECT (0, 1), { &htentry_description } }, + { XD_LISP_OBJECT_BLOCK_PTR, 0, XD_INDIRECT (0, 1), + { &htentry_weak_description }, XD_FLAG_UNION_DEFAULT_ENTRY }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, HASH_TABLE_NON_WEAK, XD_INDIRECT (0, 1), { &htentry_description } }, { XD_BLOCK_PTR, 0, XD_INDIRECT (0, 1), { &htentry_description }, XD_FLAG_UNION_DEFAULT_ENTRY | XD_FLAG_NO_KKCC }, +#endif /* not NEW_GC */ { XD_END } }; ＠＠ -572,7 +615,13 ＠＠ compute_hash_table_derived_values (ht); /* We leave room for one never-occupied sentinel htentry at the end. */ +#ifdef NEW_GC + ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), + ht->size + 1, + &lrecord_hash_table_entry); +#else /* not NEW_GC */ ht->hentries = xnew_array_and_zero (htentry, ht->size + 1); +#endif /* not NEW_GC */ hash_table = wrap_hash_table (ht); ＠＠ -970,7 +1019,13 ＠＠ Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table); COPY_LCRECORD (ht, ht_old); +#ifdef NEW_GC + ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), + ht_old->size + 1, + &lrecord_hash_table_entry); +#else /* not NEW_GC */ ht->hentries = xnew_array (htentry, ht_old->size + 1); +#endif /* not NEW_GC */ memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (htentry)); hash_table = wrap_hash_table (ht); ＠＠ -995,7 +1050,13 ＠＠ old_entries = ht->hentries; +#ifdef NEW_GC + ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry), + new_size + 1, + &lrecord_hash_table_entry); +#else /* not NEW_GC */ ht->hentries = xnew_array_and_zero (htentry, new_size + 1); +#endif /* not NEW_GC */ new_entries = ht->hentries; compute_hash_table_derived_values (ht); ＠＠ -1019,7 +1080,13 ＠＠ pdump_reorganize_hash_table (Lisp_Object hash_table) { const Lisp_Hash_Table *ht = xhash_table (hash_table); +#ifdef NEW_GC + htentry *new_entries = + (htentry *) alloc_lrecord_array (sizeof (htentry), ht->size + 1, + &lrecord_hash_table_entry); +#else /* not NEW_GC */ htentry *new_entries = xnew_array_and_zero (htentry, ht->size + 1); +#endif /* not NEW_GC */ htentry *e, *sentinel; for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) ＠＠ -1033,7 +1100,11 ＠＠ memcpy (ht->hentries, new_entries, ht->size * sizeof (htentry)); +#ifdef NEW_GC + mc_free (new_entries); +#else /* not NEW_GC */ xfree (new_entries, htentry *); +#endif /* not NEW_GC */ } static void ＠＠ -1761,6 +1832,9 ＠＠ init_elhash_once_early (void) { INIT_LRECORD_IMPLEMENTATION (hash_table); +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (hash_table_entry); +#endif /* NEW_GC */ /* This must NOT be staticpro'd */ Vall_weak_hash_tables = Qnil; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/elhash.h newgc-xemacs-21.5/src/elhash.h --- xemacs-21.5/src/elhash.h 2005-01-26 11:22:25.000000000 +0100 +++ newgc-xemacs-21.5/src/elhash.h 2005-05-18 09:25:53.000000000 +0200 ＠＠ -33,6 +33,19 ＠＠ #define CHECK_HASH_TABLE(x) CHECK_RECORD (x, hash_table) #define CONCHECK_HASH_TABLE(x) CONCHECK_RECORD (x, hash_table) +#ifdef NEW_GC +typedef struct htentry Lisp_Hash_Table_Entry; + +DECLARE_LRECORD (hash_table_entry, Lisp_Hash_Table_Entry); + +#define XHASH_TABLE_ENTRY(x) \ + XRECORD (x, hash_table_entry, Lisp_Hash_Table_Entry) +#define wrap_hash_table_entry(p) wrap_record (p, hash_table_entry) +#define HASH_TABLE_ENTRYP(x) RECORDP (x, hash_table_entry) +#define CHECK_HASH_TABLE_ENTRY(x) CHECK_RECORD (x, hash_table_entry) +#define CONCHECK_HASH_TABLE_ENTRY(x) CONCHECK_RECORD (x, hash_table_entry) +#endif /* NEW_GC */ + enum hash_table_weakness { HASH_TABLE_NON_WEAK, diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/emacs.c newgc-xemacs-21.5/src/emacs.c --- xemacs-21.5/src/emacs.c 2005-10-25 10:32:47.000000000 +0200 +++ newgc-xemacs-21.5/src/emacs.c 2005-11-20 13:06:16.000000000 +0100 ＠＠ -1312,6 +1312,9 ＠＠ the Lisp engine and need to be done both at dump time and at run time. */ init_signals_very_early (); +#ifdef NEW_GC + vdb_install_signal_handler (); +#endif init_data_very_early (); /* Catch math errors. */ init_floatfns_very_early (); /* Catch floating-point math errors. */ init_process_times_very_early (); /* Initialize our process timers. ＠＠ -1397,6 +1400,8 ＠＠ init_alloc_early (); + init_gc_early (); + if (!initialized) { /* Initialize things so that new Lisp objects ＠＠ -1406,6 +1411,8 ＠＠ routines below create new objects. */ init_alloc_once_early (); + init_gc_once_early (); + /* Initialize Qnil, Qt, Qunbound, and the obarray. After this, symbols can be interned. This depends on init_alloc_once_early(). */ ＠＠ -1444,6 +1451,10 ＠＠ #ifdef MC_ALLOC syms_of_mc_alloc (); #endif /* MC_ALLOC */ + syms_of_gc (); +#ifdef NEW_GC + syms_of_vdb (); +#endif /* NEW_GC */ syms_of_buffer (); syms_of_bytecode (); syms_of_callint (); ＠＠ -1850,6 +1861,7 ＠＠ (note, we are inside ifdef PDUMP) */ { reinit_alloc_early (); + reinit_gc_early (); reinit_symbols_early (); #ifndef MC_ALLOC reinit_opaque_early (); ＠＠ -2054,6 +2066,7 ＠＠ vars_of_font_lock (); #endif /* USE_C_FONT_LOCK */ vars_of_frame (); + vars_of_gc (); vars_of_glyphs (); vars_of_glyphs_eimage (); vars_of_glyphs_widget (); ＠＠ -2394,9 +2407,6 ＠＠ #endif /* This calls Fmake_glyph_internal(). */ - complex_vars_of_alloc (); - - /* This calls Fmake_glyph_internal(). */ #ifdef HAVE_MENUBARS complex_vars_of_menubar (); #endif ＠＠ -2439,6 +2449,8 ＠＠ might depend on all sorts of things; I'm not sure. */ complex_vars_of_emacs (); + complex_vars_of_gc (); + /* This creates a couple of basic keymaps and depends on Lisp hash tables and Ffset() (both of which depend on some variables initialized in the vars_of_*() section) and possibly other ＠＠ -2449,7 +2461,11 ＠＠ { extern int always_gc; if (always_gc) /* purification debugging hack */ +#ifdef NEW_GC + gc_full (); +#else /* not NEW_GC */ garbage_collect_1 (); +#endif /* not NEW_GC */ } #endif } ＠＠ -2928,7 +2944,11 ＠＠ { int i; +#ifdef NEW_GC + if (gc_in_progress) gc_full (); +#else /* not NEW_GC */ assert (!gc_in_progress); +#endif /* not NEW_GC */ if (run_temacs_argc < 0) invalid_operation ("I've lost my temacs-hood", Qunbound); ＠＠ -3204,7 +3224,11 ＠＠ memory_warnings (my_edata, malloc_warning); #endif +#ifdef NEW_GC + gc_full (); +#else /* not NEW_GC */ garbage_collect_1 (); +#endif /* not NEW_GC */ #ifdef PDUMP pdump (); ＠＠ -3728,12 +3752,28 ＠＠ guts_of_fatal_error_signal (sig); +#ifdef NEW_GC + /* This time the signal will really be fatal. To be able to debug + SIGSEGV and SIGBUS also during write barrier, send SIGABRT. */ +#ifdef WIN32_NATIVE + if (sig == SIGSEGV) + raise (SIGABRT); + else + raise (sig); +#else + if ((sig == SIGSEGV) || (sig == SIGBUS)) + kill (qxe_getpid (), SIGABRT); + else + kill (qxe_getpid (), sig); +#endif +#else /* not NEW_GC */ /* Signal the same code; this time it will really be fatal. */ #ifdef WIN32_NATIVE raise (sig); #else kill (qxe_getpid (), sig); #endif +#endif /* not NEW_GC */ SIGRETURN; } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/eval.c newgc-xemacs-21.5/src/eval.c --- xemacs-21.5/src/eval.c 2005-10-25 13:16:23.000000000 +0200 +++ newgc-xemacs-21.5/src/eval.c 2005-11-02 11:53:44.000000000 +0100 ＠＠ -2238,7 +2238,9 ＠＠ ABORT (); } +#ifndef NEW_GC assert (!gc_in_progress); +#endif /* not NEW_GC */ /* We abort if in_display and we are not protected, as garbage collections and non-local exits will invariably be fatal, but in ＠＠ -3371,14 +3373,32 ＠＠ int bindargs = min (nargs, max_non_rest_args); for (i = 0; i < bindargs; i++) +#ifdef NEW_GC + SPECBIND_FAST_UNSAFE (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i], + args[i]); +#else /* not NEW_GC */ SPECBIND_FAST_UNSAFE (f->args[i], args[i]); +#endif /* not NEW_GC */ for (i = bindargs; i < max_non_rest_args; i++) +#ifdef NEW_GC + SPECBIND_FAST_UNSAFE (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i], + Qnil); +#else /* not NEW_GC */ SPECBIND_FAST_UNSAFE (f->args[i], Qnil); +#endif /* not NEW_GC */ +#ifdef NEW_GC + SPECBIND_FAST_UNSAFE + (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[max_non_rest_args], + nargs > max_non_rest_args ? + Flist (nargs - max_non_rest_args, &args[max_non_rest_args]) : + Qnil); +#else /* not NEW_GC */ SPECBIND_FAST_UNSAFE (f->args[max_non_rest_args], nargs > max_non_rest_args ? Flist (nargs - max_non_rest_args, &args[max_non_rest_args]) : Qnil); +#endif /* not NEW_GC */ } /* Apply compiled-function object FUN to the NARGS evaluated arguments ＠＠ -3405,7 +3425,12 ＠＠ { #if 1 for (i = 0; i < nargs; i++) +#ifdef NEW_GC + SPECBIND_FAST_UNSAFE (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i], + args[i]); +#else /* not NEW_GC */ SPECBIND_FAST_UNSAFE (f->args[i], args[i]); +#endif /* not NEW_GC */ #else /* Here's an alternate way to write the loop that tries to further optimize funcalls for functions with few arguments by partially ＠＠ -3436,9 +3461,19 ＠＠ else if (nargs < f->max_args) { for (i = 0; i < nargs; i++) +#ifdef NEW_GC + SPECBIND_FAST_UNSAFE (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i], + args[i]); +#else /* not NEW_GC */ SPECBIND_FAST_UNSAFE (f->args[i], args[i]); +#endif /* not NEW_GC */ for (i = nargs; i < f->max_args; i++) +#ifdef NEW_GC + SPECBIND_FAST_UNSAFE (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i], + Qnil); +#else /* not NEW_GC */ SPECBIND_FAST_UNSAFE (f->args[i], Qnil); +#endif /* not NEW_GC */ } else if (f->max_args == MANY) handle_compiled_function_with_and_rest (f, nargs, args); ＠＠ -3527,7 +3562,11 ＠＠ { struct gcpro gcpro1; GCPRO1 (form); +#ifdef NEW_GC + gc_incremental (); +#else /* not NEW_GC */ garbage_collect_1 (); +#endif /* not NEW_GC */ UNGCPRO; } ＠＠ -3779,7 +3818,11 ＠＠ { if (need_to_garbage_collect) /* Callers should gcpro lexpr args */ +#ifdef NEW_GC + gc_incremental (); +#else /* not NEW_GC */ garbage_collect_1 (); +#endif /* not NEW_GC */ if (need_to_check_c_alloca) { if (++funcall_alloca_count >= MAX_FUNCALLS_BETWEEN_ALLOCA_CLEANUP) ＠＠ -4305,9 +4348,11 ＠＠ /* We need to bail out of here pronto. */ return Qnil; +#ifndef NEW_GC /* Whenever gc_in_progress is true, preparing_for_armageddon will also be true unless something is really hosed. */ assert (!gc_in_progress); +#endif /* not NEW_GC */ sym = args[0]; val = symbol_value_in_buffer (sym, wrap_buffer (buf)); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/event-msw.c newgc-xemacs-21.5/src/event-msw.c --- xemacs-21.5/src/event-msw.c 2005-10-25 13:16:23.000000000 +0200 +++ newgc-xemacs-21.5/src/event-msw.c 2005-10-29 13:53:29.000000000 +0200 ＠＠ -2498,9 +2498,11 ＠＠ struct frame *frame; struct mswindows_frame *msframe; +#ifndef NEW_GC /* If you hit this, rewrite the offending API call to occur after GC, using register_post_gc_action(). */ assert (!gc_in_progress); +#endif /* NEW_GC */ #ifdef DEBUG_XEMACS if (debug_mswindows_events) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/events.c newgc-xemacs-21.5/src/events.c --- xemacs-21.5/src/events.c 2005-11-17 00:28:18.000000000 +0100 +++ newgc-xemacs-21.5/src/events.c 2005-11-17 00:08:41.000000000 +0100 ＠＠ -2650,6 +2650,9 ＠＠ reinit_vars_of_events (void) { Vevent_resource = Qnil; +#ifdef NEW_GC + staticpro (&Vevent_resource); +#endif /* NEW_GC */ } void diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/extents.c newgc-xemacs-21.5/src/extents.c --- xemacs-21.5/src/extents.c 2005-10-25 13:16:23.000000000 +0200 +++ newgc-xemacs-21.5/src/extents.c 2005-11-02 01:05:42.000000000 +0100 ＠＠ -242,6 +242,9 ＠＠ typedef struct gap_array_marker { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ int pos; struct gap_array_marker *next; } Gap_Array_Marker; ＠＠ -269,6 +272,9 ＠＠ typedef struct gap_array { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ Elemcount gap; Elemcount gapsize; Elemcount numels; ＠＠ -281,7 +287,9 ＠＠ char array[1]; } Gap_Array; +#ifndef NEW_GC static Gap_Array_Marker *gap_array_marker_freelist; +#endif /* not NEW_GC */ /* Convert a "memory position" (i.e. taking the gap into account) into the address of the element at (i.e. after) that position. "Memory ＠＠ -310,6 +318,9 ＠＠ typedef struct extent_list_marker { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ Gap_Array_Marker *m; int endp; struct extent_list_marker *next; ＠＠ -317,12 +328,17 ＠＠ typedef struct extent_list { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ Gap_Array *start; Gap_Array *end; Extent_List_Marker *markers; } Extent_List; +#ifndef NEW_GC static Extent_List_Marker *extent_list_marker_freelist; +#endif /* not NEW_GC */ #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \ ((extent_start (e) == (st)) && \ ＠＠ -377,6 +393,9 ＠＠ typedef struct stack_of_extents { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ Extent_List *extents; Memxpos pos; /* Position of stack of extents. EXTENTS is the list of all extents that overlap this position. This position ＠＠ -569,10 +588,17 ＠＠ a geometric progression that saves on realloc space. */ increment += 100 + ga->numels / 8; +#ifdef NEW_GC + ga = (Gap_Array *) mc_realloc (ga, + offsetof (Gap_Array, array) + + (ga->numels + ga->gapsize + increment) * + ga->elsize); +#else /* not NEW_GC */ ga = (Gap_Array *) xrealloc (ga, offsetof (Gap_Array, array) + (ga->numels + ga->gapsize + increment) * ga->elsize); +#endif /* not NEW_GC */ if (ga == 0) memory_full (); ＠＠ -664,6 +690,9 ＠＠ Gap_Array_Marker *m; assert (pos >= 0 && pos <= ga->numels); +#ifdef NEW_GC + m = alloc_lrecord_type (Gap_Array_Marker, &lrecord_gap_array_marker); +#else /* not NEW_GC */ if (gap_array_marker_freelist) { m = gap_array_marker_freelist; ＠＠ -671,6 +700,7 ＠＠ } else m = xnew (Gap_Array_Marker); +#endif /* not NEW_GC */ m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); m->next = ga->markers; ＠＠ -690,11 +720,16 ＠＠ prev->next = p->next; else ga->markers = p->next; +#ifdef NEW_GC + mc_free (m); +#else /* not NEW_GC */ m->next = gap_array_marker_freelist; m->pos = 0xDEADBEEF; /* -559038737 base 10 */ gap_array_marker_freelist = m; +#endif /* not NEW_GC */ } +#ifndef NEW_GC static void gap_array_delete_all_markers (Gap_Array *ga) { ＠＠ -708,6 +743,7 ＠＠ gap_array_marker_freelist = p; } } +#endif /* not NEW_GC */ static void gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, Elemcount pos) ＠＠ -722,17 +758,23 ＠＠ static Gap_Array * make_gap_array (Elemcount elsize) { +#ifdef NEW_GC + Gap_Array *ga = alloc_lrecord_type (Gap_Array, &lrecord_gap_array); +#else /* not NEW_GC */ Gap_Array *ga = xnew_and_zero (Gap_Array); +#endif /* not NEW_GC */ ga->elsize = elsize; return ga; } +#ifndef NEW_GC static void free_gap_array (Gap_Array *ga) { gap_array_delete_all_markers (ga); xfree (ga, Gap_Array *); } +#endif /* not NEW_GC */  /************************************************************************/ ＠＠ -887,6 +929,9 ＠＠ { Extent_List_Marker *m; +#ifdef NEW_GC + m = alloc_lrecord_type (Extent_List_Marker, &lrecord_extent_list_marker); +#else /* not NEW_GC */ if (extent_list_marker_freelist) { m = extent_list_marker_freelist; ＠＠ -894,6 +939,7 ＠＠ } else m = xnew (Extent_List_Marker); +#endif /* not NEW_GC */ m->m = gap_array_make_marker (endp ? el->end : el->start, pos); m->endp = endp; ＠＠ -917,9 +963,13 ＠＠ prev->next = p->next; else el->markers = p->next; +#ifdef NEW_GC + gap_array_delete_marker (m->endp ? el->end : el->start, m->m); +#else /* not NEW_GC */ m->next = extent_list_marker_freelist; extent_list_marker_freelist = m; gap_array_delete_marker (m->endp ? el->end : el->start, m->m); +#endif /* not NEW_GC */ } #define extent_list_marker_pos(el, mkr) \ ＠＠ -928,13 +978,18 ＠＠ static Extent_List * allocate_extent_list (void) { +#ifdef NEW_GC + Extent_List *el = alloc_lrecord_type (Extent_List, &lrecord_extent_list); +#else /* not NEW_GC */ Extent_List *el = xnew (Extent_List); +#endif /* not NEW_GC */ el->start = make_gap_array (sizeof (EXTENT)); el->end = make_gap_array (sizeof (EXTENT)); el->markers = 0; return el; } +#ifndef NEW_GC static void free_extent_list (Extent_List *el) { ＠＠ -942,6 +997,7 ＠＠ free_gap_array (el->end); xfree (el, Extent_List *); } +#endif /* not NEW_GC */  /************************************************************************/ ＠＠ -1021,28 +1077,46 ＠＠ structure to be there. */ static struct stack_of_extents *allocate_soe (void); +#ifndef NEW_GC static void free_soe (struct stack_of_extents *soe); +#endif /* not NEW_GC */ static void soe_invalidate (Lisp_Object obj); extern const struct sized_memory_description gap_array_marker_description; static const struct memory_description gap_array_marker_description_1[] = { +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (Gap_Array_Marker, next) }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, offsetof (Gap_Array_Marker, next), 1, { &gap_array_marker_description } }, +#endif /* not NEW_GC */ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("gap-array-marker", gap_array_marker, + 0, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + gap_array_marker_description_1, + struct gap_array_marker); +#else /* not NEW_GC */ const struct sized_memory_description gap_array_marker_description = { sizeof (Gap_Array_Marker), gap_array_marker_description_1 }; +#endif /* not NEW_GC */ static const struct memory_description lispobj_gap_array_description_1[] = { { XD_ELEMCOUNT, offsetof (Gap_Array, gap) }, { XD_BYTECOUNT, offsetof (Gap_Array, offset_past_gap) }, { XD_ELEMCOUNT, offsetof (Gap_Array, els_past_gap) }, +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (Gap_Array, markers) }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, offsetof (Gap_Array, markers), 1, { &gap_array_marker_description }, XD_FLAG_NO_KKCC }, +#endif /* not NEW_GC */ { XD_BLOCK_ARRAY, offsetof (Gap_Array, array), XD_INDIRECT (0, 0), { &lisp_object_description } }, { XD_BLOCK_ARRAY, XD_INDIRECT (1, offsetof (Gap_Array, array)), ＠＠ -1050,57 +1124,118 ＠＠ { XD_END } }; +#ifdef NEW_GC + +static Bytecount +size_gap_array (const void *lheader) +{ + Gap_Array *ga = (Gap_Array *) lheader; + return offsetof (Gap_Array, array) + (ga->numels + ga->gapsize) * ga->elsize; +} + +DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("gap-array", gap_array, + 0, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + lispobj_gap_array_description_1, + size_gap_array, + struct gap_array); +#else /* not NEW_GC */ static const struct sized_memory_description lispobj_gap_array_description = { sizeof (Gap_Array), lispobj_gap_array_description_1 }; extern const struct sized_memory_description extent_list_marker_description; +#endif /* not NEW_GC */ static const struct memory_description extent_list_marker_description_1[] = { +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (Extent_List_Marker, m) }, + { XD_LISP_OBJECT, offsetof (Extent_List_Marker, next) }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, offsetof (Extent_List_Marker, m), 1, { &gap_array_marker_description } }, { XD_BLOCK_PTR, offsetof (Extent_List_Marker, next), 1, { &extent_list_marker_description } }, +#endif /* not NEW_GC */ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("extent-list-marker", extent_list_marker, + 0, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + extent_list_marker_description_1, + struct extent_list_marker); +#else /* not NEW_GC */ const struct sized_memory_description extent_list_marker_description = { sizeof (Extent_List_Marker), extent_list_marker_description_1 }; +#endif /* not NEW_GC */ static const struct memory_description extent_list_description_1[] = { +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (Extent_List, start) }, + { XD_LISP_OBJECT, offsetof (Extent_List, end) }, + { XD_LISP_OBJECT, offsetof (Extent_List, markers) }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, offsetof (Extent_List, start), 1, { &lispobj_gap_array_description } }, { XD_BLOCK_PTR, offsetof (Extent_List, end), 1, { &lispobj_gap_array_description }, XD_FLAG_NO_KKCC }, { XD_BLOCK_PTR, offsetof (Extent_List, markers), 1, { &extent_list_marker_description }, XD_FLAG_NO_KKCC }, +#endif /* not NEW_GC */ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("extent-list", extent_list, + 0, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + extent_list_description_1, + struct extent_list); +#else /* not NEW_GC */ static const struct sized_memory_description extent_list_description = { sizeof (Extent_List), extent_list_description_1 }; +#endif /* not NEW_GC */ static const struct memory_description stack_of_extents_description_1[] = { +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (Stack_Of_Extents, extents) }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, offsetof (Stack_Of_Extents, extents), 1, { &extent_list_description } }, +#endif /* not NEW_GC */ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("stack-of-extents", stack_of_extents, + 0, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + stack_of_extents_description_1, + struct stack_of_extents); +#else /* not NEW_GC */ static const struct sized_memory_description stack_of_extents_description = { sizeof (Stack_Of_Extents), stack_of_extents_description_1 }; +#endif /* not NEW_GC */ static const struct memory_description extent_info_description [] = { +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (struct extent_info, extents) }, + { XD_LISP_OBJECT, offsetof (struct extent_info, soe) }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, offsetof (struct extent_info, extents), 1, { &extent_list_description } }, { XD_BLOCK_PTR, offsetof (struct extent_info, soe), 1, { &stack_of_extents_description }, XD_FLAG_NO_KKCC }, +#endif /* not NEW_GC */ { XD_END } }; ＠＠ -1142,6 +1277,10 ＠＠ if (for_disksave) return; +#ifdef NEW_GC + data->soe = 0; + data->extents = 0; +#else /* not NEW_GC */ if (data->soe) { free_soe (data->soe); ＠＠ -1152,6 +1291,7 ＠＠ free_extent_list (data->extents); data->extents = 0; } +#endif /* not NEW_GC */ } DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, ＠＠ -1181,7 +1321,9 ＠＠ if (data->soe) { +#ifndef NEW_GC free_soe (data->soe); +#endif /* not NEW_GC */ data->soe = 0; } } ＠＠ -1326,12 +1468,16 ＠＠ void uninit_buffer_extents (struct buffer *b) { +#ifndef NEW_GC struct extent_info *data = XEXTENT_INFO (b->extent_info); +#endif /* not NEW_GC */ /* Don't destroy the extents here -- there may still be children extents pointing to the extents. */ detach_all_extents (wrap_buffer (b)); +#ifndef NEW_GC finalize_extent_info (data, 0); +#endif /* not NEW_GC */ } /* Retrieve the extent list that an extent is a member of; the ＠＠ -1649,18 +1795,25 ＠＠ static struct stack_of_extents * allocate_soe (void) { +#ifdef NEW_GC + struct stack_of_extents *soe = + alloc_lrecord_type (struct stack_of_extents, &lrecord_stack_of_extents); +#else /* not NEW_GC */ struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents); +#endif /* not NEW_GC */ soe->extents = allocate_extent_list (); soe->pos = -1; return soe; } +#ifndef NEW_GC static void free_soe (struct stack_of_extents *soe) { free_extent_list (soe->extents); xfree (soe, struct stack_of_extents *); } +#endif /* not NEW_GC */ /* ------------------------------- */ /* other primitives */ ＠＠ -7299,6 +7452,13 ＠＠ INIT_LRECORD_IMPLEMENTATION (extent); INIT_LRECORD_IMPLEMENTATION (extent_info); INIT_LRECORD_IMPLEMENTATION (extent_auxiliary); +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (gap_array_marker); + INIT_LRECORD_IMPLEMENTATION (gap_array); + INIT_LRECORD_IMPLEMENTATION (extent_list_marker); + INIT_LRECORD_IMPLEMENTATION (extent_list); + INIT_LRECORD_IMPLEMENTATION (stack_of_extents); +#endif /* not NEW_GC */ DEFSYMBOL (Qextentp); DEFSYMBOL (Qextent_live_p); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/extents.h newgc-xemacs-21.5/src/extents.h --- xemacs-21.5/src/extents.h 2005-01-26 06:11:12.000000000 +0100 +++ newgc-xemacs-21.5/src/extents.h 2005-11-02 01:06:01.000000000 +0100 ＠＠ -49,6 +49,56 ＠＠ #define CHECK_EXTENT_INFO(x) CHECK_RECORD (x, extent_info) #define CONCHECK_EXTENT_INFO(x) CONCHECK_RECORD (x, extent_info) +#ifdef NEW_GC +struct gap_array_marker; + +DECLARE_LRECORD (gap_array_marker, struct gap_array_marker); +#define XGAP_ARRAY_MARKER(x) \ + XRECORD (x, gap_array_marker, struct gap_array_marker) +#define wrap_gap_array_marker(p) wrap_record (p, gap_array_marker) +#define GAP_ARRAY_MARKERP(x) RECORDP (x, gap_array_marker) +#define CHECK_GAP_ARRAY_MARKER(x) CHECK_RECORD (x, gap_array_marker) +#define CONCHECK_GAP_ARRAY_MARKER(x) CONCHECK_RECORD (x, gap_array_marker) + +struct gap_array; + +DECLARE_LRECORD (gap_array, struct gap_array); +#define XGAP_ARRAY(x) XRECORD (x, gap_array, struct gap_array) +#define wrap_gap_array(p) wrap_record (p, gap_array) +#define GAP_ARRAYP(x) RECORDP (x, gap_array) +#define CHECK_GAP_ARRAY(x) CHECK_RECORD (x, gap_array) +#define CONCHECK_GAP_ARRAY(x) CONCHECK_RECORD (x, gap_array) + +struct extent_list_marker; + +DECLARE_LRECORD (extent_list_marker, struct extent_list_marker); +#define XEXTENT_LIST_MARKER(x) \ + XRECORD (x, extent_list_marker, struct extent_list_marker) +#define wrap_extent_list_marker(p) wrap_record (p, extent_list_marker) +#define EXTENT_LIST_MARKERP(x) RECORDP (x, extent_list_marker) +#define CHECK_EXTENT_LIST_MARKER(x) CHECK_RECORD (x, extent_list_marker) +#define CONCHECK_EXTENT_LIST_MARKER(x) CONCHECK_RECORD (x, extent_list_marker) + +struct extent_list; + +DECLARE_LRECORD (extent_list, struct extent_list); +#define XEXTENT_LIST(x) XRECORD (x, extent_list, struct extent_list) +#define wrap_extent_list(p) wrap_record (p, extent_list) +#define EXTENT_LISTP(x) RECORDP (x, extent_list) +#define CHECK_EXTENT_LIST(x) CHECK_RECORD (x, extent_list) +#define CONCHECK_EXTENT_LIST(x) CONCHECK_RECORD (x, extent_list) + +struct stack_of_extents; + +DECLARE_LRECORD (stack_of_extents, struct stack_of_extents); +#define XSTACK_OF_EXTENTS(x) \ + XRECORD (x, stack_of_extents, struct stack_of_extents) +#define wrap_stack_of_extents(p) wrap_record (p, stack_of_extents) +#define STACK_OF_EXTENTSP(x) RECORDP (x, stack_of_extents) +#define CHECK_STACK_OF_EXTENTS(x) CHECK_RECORD (x, stack_of_extents) +#define CONCHECK_STACK_OF_EXTENTS(x) CONCHECK_RECORD (x, stack_of_extents) +#endif /* NEW_GC */ + /* the layouts for glyphs (extent->flags.glyph_layout). Must fit in 2 bits. */ typedef enum glyph_layout { diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/faces.h newgc-xemacs-21.5/src/faces.h --- xemacs-21.5/src/faces.h 2005-10-24 12:07:36.000000000 +0200 +++ newgc-xemacs-21.5/src/faces.h 2005-11-02 00:54:44.000000000 +0100 ＠＠ -117,6 +117,9 ＠＠ typedef struct face_cachel face_cachel; struct face_cachel { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* not NEW_GC */ /* There are two kinds of cachels; those created from a single face and those created by merging more than one face. In the former case, the FACE element specifies the face used. In the latter ＠＠ -222,6 +225,19 ＠＠ unsigned char font_updated[NUM_LEADING_BYTES]; }; +#ifdef NEW_GC +typedef struct face_cachel Lisp_Face_Cachel; + +DECLARE_LRECORD (face_cachel, Lisp_Face_Cachel); + +#define XFACE_CACHEL(x) \ + XRECORD (x, face_cachel, Lisp_Face_Cachel) +#define wrap_face_cachel(p) wrap_record (p, face_cachel) +#define FACE_CACHEL_P(x) RECORDP (x, face_cachel) +#define CHECK_FACE_CACHEL(x) CHECK_RECORD (x, face_cachel) +#define CONCHECK_FACE_CACHEL(x) CONCHECK_RECORD (x, face_cachel) +#endif /* NEW_GC */ + DECLARE_LRECORD (face, Lisp_Face); #define XFACE(x) XRECORD (x, face, Lisp_Face) #define wrap_face(p) wrap_record (p, face) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/frame.c newgc-xemacs-21.5/src/frame.c --- xemacs-21.5/src/frame.c 2005-10-25 13:16:24.000000000 +0200 +++ newgc-xemacs-21.5/src/frame.c 2005-11-02 01:09:04.000000000 +0100 ＠＠ -139,11 +139,24 ＠＠  +#ifndef NEW_GC extern const struct sized_memory_description gtk_frame_data_description; extern const struct sized_memory_description mswindows_frame_data_description; extern const struct sized_memory_description x_frame_data_description; +#endif /* not NEW_GC */ static const struct memory_description frame_data_description_1 []= { +#ifdef NEW_GC +#ifdef HAVE_GTK + { XD_LISP_OBJECT, gtk_console }, +#endif +#ifdef HAVE_MS_WINDOWS + { XD_LISP_OBJECT, mswindows_console }, +#endif +#ifdef HAVE_X_WINDOWS + { XD_LISP_OBJECT, x_console }, +#endif +#else /* not NEW_GC */ #ifdef HAVE_GTK { XD_BLOCK_PTR, gtk_console, 1, { &gtk_frame_data_description} }, #endif ＠＠ -153,6 +166,7 ＠＠ #ifdef HAVE_X_WINDOWS { XD_BLOCK_PTR, x_console, 1, { &x_frame_data_description} }, #endif +#endif /* not NEW_GC */ { XD_END } }; ＠＠ -160,6 +174,19 ＠＠ sizeof (void *), frame_data_description_1 }; +#ifdef NEW_GC +static const struct memory_description expose_ignore_description_1 [] = { + { XD_LISP_OBJECT, offsetof (struct expose_ignore, next) }, + { XD_END } +}; + +DEFINE_LRECORD_IMPLEMENTATION ("expose-ignore", + expose_ignore, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + expose_ignore_description_1, + struct expose_ignore); +#else /* not NEW_GC */ extern const struct sized_memory_description expose_ignore_description; static const struct memory_description expose_ignore_description_1 [] = { ＠＠ -172,6 +199,7 ＠＠ sizeof (struct expose_ignore), expose_ignore_description_1 }; +#endif /* not NEW_GC */ static const struct memory_description display_line_dynarr_pointer_description_1 []= { { XD_BLOCK_PTR, 0, 1, { &display_line_dynarr_description} }, ＠＠ -189,10 +217,15 ＠＠ { XD_LISP_OBJECT_ARRAY, offsetof (struct frame, slot), size }, #include "frameslots.h" +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (struct frame, subwindow_exposures) }, + { XD_LISP_OBJECT, offsetof (struct frame, subwindow_exposures_tail) }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, offsetof (struct frame, subwindow_exposures), 1, { &expose_ignore_description } }, { XD_BLOCK_PTR, offsetof (struct frame, subwindow_exposures_tail), 1, { &expose_ignore_description } }, +#endif /* not NEW_GC */ #ifdef HAVE_SCROLLBARS { XD_LISP_OBJECT, offsetof (struct frame, sb_vcache) }, ＠＠ -3406,7 +3439,11 ＠＠ --andy. */ MARK_FRAME_SIZE_CHANGED (f); +#ifdef NEW_GC + if (delay || hold_frame_size_changes) +#else /* not NEW_GC */ if (delay || hold_frame_size_changes || gc_in_progress) +#endif /* not NEW_GC */ { f->new_width = newwidth; f->new_height = newheight; ＠＠ -3576,6 +3613,9 ＠＠ syms_of_frame (void) { INIT_LRECORD_IMPLEMENTATION (frame); +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (expose_ignore); +#endif /* NEW_GC */ DEFSYMBOL (Qdelete_frame_hook); DEFSYMBOL (Qselect_frame_hook); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/frame-gtk.c newgc-xemacs-21.5/src/frame-gtk.c --- xemacs-21.5/src/frame-gtk.c 2005-11-22 13:00:33.000000000 +0100 +++ newgc-xemacs-21.5/src/frame-gtk.c 2005-11-22 13:03:52.000000000 +0100 ＠＠ -102,11 +102,19 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("gtk-frame", gtk_frame, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + gtk_frame_data_description_1, + Lisp_Gtk_Frame); +#else /* not NEW_GC */ extern const struct sized_memory_description gtk_frame_data_description; const struct sized_memory_description gtk_frame_data_description = { sizeof (struct gtk_frame), gtk_frame_data_description_1 }; +#endif /* not NEW_GC */  /************************************************************************/ ＠＠ -966,7 +974,11 ＠＠ int i; /* zero out all slots. */ +#ifdef NEW_GC + f->frame_data = alloc_lrecord_type (struct gtk_frame, &lrecord_gtk_frame); +#else /* not NEW_GC */ f->frame_data = xnew_and_zero (struct gtk_frame); +#endif /* not NEW_GC */ /* yeah, except the lisp ones */ FRAME_GTK_ICON_PIXMAP (f) = Qnil; ＠＠ -1342,7 +1354,11 ＠＠ if (FRAME_GTK_GEOM_FREE_ME_PLEASE (f)) xfree (FRAME_GTK_GEOM_FREE_ME_PLEASE (f), char *); +#ifdef NEW_GC + mc_free (f->frame_data); +#else /* not NEW_GC */ xfree (f->frame_data, void *); +#endif /* not NEW_GC */ f->frame_data = 0; } ＠＠ -1447,6 +1463,10 ＠＠ void syms_of_frame_gtk (void) { +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (gtk_frame); +#endif /* NEW_GC */ + DEFSYMBOL (Qtext_widget); DEFSYMBOL (Qcontainer_widget); DEFSYMBOL (Qshell_widget); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/frame-msw.c newgc-xemacs-21.5/src/frame-msw.c --- xemacs-21.5/src/frame-msw.c 2005-10-25 09:30:42.000000000 +0200 +++ newgc-xemacs-21.5/src/frame-msw.c 2005-11-02 01:03:12.000000000 +0100 ＠＠ -92,11 +92,19 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("mswindows-frame", mswindows_frame, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + mswindows_frame_data_description_1, + Lisp_Mswindows_Frame); +#else /* not NEW_GC */ extern const struct sized_memory_description mswindows_frame_data_description; const struct sized_memory_description mswindows_frame_data_description = { sizeof (struct mswindows_frame), mswindows_frame_data_description_1 }; +#endif /* not NEW_GC */ /*---------------------------------------------------------------------*/ /*----- DISPLAY FRAME -----*/ ＠＠ -165,7 +173,12 ＠＠ if (!NILP (height)) CHECK_INT (height); +#ifdef NEW_GC + f->frame_data = alloc_lrecord_type (struct mswindows_frame, + &lrecord_mswindows_frame); +#else /* not NEW_GC */ f->frame_data = xnew_and_zero (struct mswindows_frame); +#endif /* not NEW_GC */ FRAME_MSWINDOWS_TARGET_RECT (f) = xnew_and_zero (XEMACS_RECT_WH); FRAME_MSWINDOWS_TARGET_RECT (f)->left = NILP (left) ? -1 : abs (XINT (left)); ＠＠ -340,7 +353,11 ＠＠ #endif ReleaseDC (FRAME_MSWINDOWS_HANDLE (f), FRAME_MSWINDOWS_DC (f)); DestroyWindow (FRAME_MSWINDOWS_HANDLE (f)); +#ifdef NEW_GC + mc_free (f->frame_data); +#else /* not NEW_GC */ xfree (f->frame_data, void *); +#endif /* not NEW_GC */ } f->frame_data = 0; } ＠＠ -1185,6 +1202,9 ＠＠ void syms_of_frame_mswindows (void) { +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (mswindows_frame); +#endif /* NEW_GC */ } void diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/frame-x.c newgc-xemacs-21.5/src/frame-x.c --- xemacs-21.5/src/frame-x.c 2005-04-27 11:01:48.000000000 +0200 +++ newgc-xemacs-21.5/src/frame-x.c 2005-11-02 01:03:24.000000000 +0100 ＠＠ -77,11 +77,19 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("x-frame", x_frame, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + x_frame_data_description_1, + Lisp_X_Frame); +#else /* not NEW_GC */ extern const struct sized_memory_description x_frame_data_description; const struct sized_memory_description x_frame_data_description = { sizeof (struct x_frame), x_frame_data_description_1 }; +#endif /* not NEW_GC */ EXFUN (Fx_window_id, 1); ＠＠ -2073,7 +2081,11 ＠＠ allocate_x_frame_struct (struct frame *f) { /* zero out all slots. */ +#ifdef NEW_GC + f->frame_data = alloc_lrecord_type (struct x_frame, &lrecord_x_frame); +#else /* not NEW_GC */ f->frame_data = xnew_and_zero (struct x_frame); +#endif /* not NEW_GC */ /* yeah, except the lisp ones */ FRAME_X_LAST_MENUBAR_BUFFER (f) = Qnil; ＠＠ -2642,7 +2654,11 ＠＠ if (f->frame_data) { +#ifdef NEW_GC + mc_free (f->frame_data); +#else /* not NEW_GC */ xfree (f->frame_data, void *); +#endif /* not NEW_GC */ f->frame_data = 0; } } ＠＠ -2720,6 +2736,10 ＠＠ void syms_of_frame_x (void) { +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (x_frame); +#endif /* NEW_GC */ + DEFSYMBOL (Qoverride_redirect); DEFSYMBOL (Qx_resource_name); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/gc.c newgc-xemacs-21.5/src/gc.c --- xemacs-21.5/src/gc.c 1970-01-01 01:00:00.000000000 +0100 +++ newgc-xemacs-21.5/src/gc.c 2005-11-20 14:06:06.000000000 +0100 ＠＠ -0,0 +1,2184 ＠＠ +/* New incremental garbage collector for XEmacs. + Copyright (C) 2005 Marcus Crestani. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#include <config.h> +#include "lisp.h" + +#include "backtrace.h" +#include "buffer.h" +#include "bytecode.h" +#include "chartab.h" +#include "console-stream.h" +#include "device.h" +#include "elhash.h" +#include "events.h" +#include "extents-impl.h" +#include "file-coding.h" +#include "frame-impl.h" +#include "gc.h" +#include "glyphs.h" +#include "opaque.h" +#include "lrecord.h" +#include "lstream.h" +#include "process.h" +#include "profile.h" +#include "redisplay.h" +#include "specifier.h" +#include "sysfile.h" +#include "sysdep.h" +#include "window.h" +#include "vdb.h" + + +#define GC_CONS_THRESHOLD 2000000 +#define GC_CONS_INCREMENTAL_THRESHOLD 200000 +#define GC_INCREMENTAL_TRAVERSAL_THRESHOLD 100000 + +/* Number of bytes of consing done since the last GC. */ +EMACS_INT consing_since_gc; + +/* Number of bytes of consing done since startup. */ +EMACS_UINT total_consing; + +/* Number of bytes of current allocated heap objects. */ +EMACS_INT total_gc_usage; + +/* If the above is set. */ +int total_gc_usage_set; + +/* Number of bytes of consing since gc before another gc should be done. */ +EMACS_INT gc_cons_threshold; + +/* Nonzero during gc */ +int gc_in_progress; + +/* Percentage of consing of total data size before another GC. */ +EMACS_INT gc_cons_percentage; + +#ifdef NEW_GC +/* Number of bytes of consing since gc before another cycle of the gc + should be done in incremental mode. */ +EMACS_INT gc_cons_incremental_threshold; + +/* Number of elements marked in one cycle of incremental GC. */ +EMACS_INT gc_incremental_traversal_threshold; + +/* Nonzero during write barrier */ +int write_barrier_enabled; +#endif /* NEW_GC */ + + + +#ifdef NEW_GC +/************************************************************************/ +/* Incremental State and Statistics */ +/************************************************************************/ + +enum gc_phase +{ + NONE, + INIT_GC, + PUSH_ROOT_SET, + MARK, + REPUSH_ROOT_SET, + FINISH_MARK, + FINALIZE, + SWEEP, + FINISH_GC +}; + +#ifndef ERROR_CHECK_GC +struct +{ + enum gc_phase phase; +} gc_state; +#else /* ERROR_CHECK_GC */ +enum gc_stat_id +{ + GC_STAT_TOTAL, + GC_STAT_IN_LAST_GC, + GC_STAT_IN_THIS_GC, + GC_STAT_IN_LAST_CYCLE, + GC_STAT_IN_THIS_CYCLE, + GC_STAT_COUNT /* has to be last */ +}; + +struct +{ + enum gc_phase phase; + EMACS_INT n_gc[GC_STAT_COUNT]; + EMACS_INT n_cycles[GC_STAT_COUNT]; + EMACS_INT enqueued[GC_STAT_COUNT]; + EMACS_INT dequeued[GC_STAT_COUNT]; + EMACS_INT repushed[GC_STAT_COUNT]; + EMACS_INT enqueued2[GC_STAT_COUNT]; + EMACS_INT dequeued2[GC_STAT_COUNT]; + EMACS_INT finalized[GC_STAT_COUNT]; + EMACS_INT freed[GC_STAT_COUNT]; + EMACS_INT explicitly_freed; + EMACS_INT explicitly_tried_freed; +} gc_state; +#endif /* ERROR_CHECK_GC */ + +#define GC_PHASE gc_state.phase +#define GC_SET_PHASE(p) GC_PHASE = p + +#ifdef ERROR_CHECK_GC +# define GC_STAT_START_NEW_GC gc_stat_start_new_gc () +# define GC_STAT_RESUME_GC gc_stat_resume_gc () + +#define GC_STAT_TICK(STAT) \ + gc_state.STAT[GC_STAT_TOTAL]++; \ + gc_state.STAT[GC_STAT_IN_THIS_GC]++; \ + gc_state.STAT[GC_STAT_IN_THIS_CYCLE]++ + +# define GC_STAT_ENQUEUED \ + if (GC_PHASE == REPUSH_ROOT_SET) \ + { \ + GC_STAT_TICK (enqueued2); \ + } \ + else \ + { \ + GC_STAT_TICK (enqueued); \ + } + +# define GC_STAT_DEQUEUED \ + if (gc_state.phase == REPUSH_ROOT_SET) \ + { \ + GC_STAT_TICK (dequeued2); \ + } \ + else \ + { \ + GC_STAT_TICK (dequeued); \ + } +# define GC_STAT_REPUSHED GC_STAT_TICK (repushed) + +#define GC_STAT_RESUME(stat) \ + gc_state.stat[GC_STAT_IN_LAST_CYCLE] = \ + gc_state.stat[GC_STAT_IN_THIS_CYCLE]; \ + gc_state.stat[GC_STAT_IN_THIS_CYCLE] = 0 + +#define GC_STAT_RESTART(stat) \ + gc_state.stat[GC_STAT_IN_LAST_GC] = \ + gc_state.stat[GC_STAT_IN_THIS_GC]; \ + gc_state.stat[GC_STAT_IN_THIS_GC] = 0; \ + GC_STAT_RESUME (stat) + +void +gc_stat_start_new_gc (void) +{ + gc_state.n_gc[GC_STAT_TOTAL]++; + gc_state.n_cycles[GC_STAT_TOTAL]++; + gc_state.n_cycles[GC_STAT_IN_LAST_GC] = gc_state.n_cycles[GC_STAT_IN_THIS_GC]; + gc_state.n_cycles[GC_STAT_IN_THIS_GC] = 1; + + GC_STAT_RESTART (enqueued); + GC_STAT_RESTART (dequeued); + GC_STAT_RESTART (repushed); + GC_STAT_RESTART (finalized); + GC_STAT_RESTART (enqueued2); + GC_STAT_RESTART (dequeued2); + GC_STAT_RESTART (freed); +} + +void +gc_stat_resume_gc (void) +{ + gc_state.n_cycles[GC_STAT_TOTAL]++; + gc_state.n_cycles[GC_STAT_IN_THIS_GC]++; + GC_STAT_RESUME (enqueued); + GC_STAT_RESUME (dequeued); + GC_STAT_RESUME (repushed); + GC_STAT_RESUME (finalized); + GC_STAT_RESUME (enqueued2); + GC_STAT_RESUME (dequeued2); + GC_STAT_RESUME (freed); +} + +void +gc_stat_finalized (void) +{ + GC_STAT_TICK (finalized); +} + +void +gc_stat_freed (void) +{ + GC_STAT_TICK (freed); +} + +void +gc_stat_explicitly_freed (void) +{ + gc_state.explicitly_freed++; +} + +void +gc_stat_explicitly_tried_freed (void) +{ + gc_state.explicitly_tried_freed++; +} + +#define GC_STAT_PRINT_ONE(stat) \ + printf (" | %9s %10d %10d %10d %10d %10d\n", \ + #stat, \ + (int) gc_state.stat[GC_STAT_TOTAL], \ + (int) gc_state.stat[GC_STAT_IN_LAST_GC], \ + (int) gc_state.stat[GC_STAT_IN_THIS_GC], \ + (int) gc_state.stat[GC_STAT_IN_LAST_CYCLE], \ + (int) gc_state.stat[GC_STAT_IN_THIS_CYCLE]) + +void +gc_stat_print_stats (void) +{ + printf (" | PHASE %d TOTAL_GC %d\n", + (int) GC_PHASE, + (int) gc_state.n_gc[GC_STAT_TOTAL]); + printf (" | %9s %10s %10s %10s %10s %10s\n", + "stat", "total", "last_gc", "this_gc", + "last_cycle", "this_cycle"); + printf (" | %9s %10d %10d %10d \n", + "cycle", (int) gc_state.n_cycles[GC_STAT_TOTAL], + (int) gc_state.n_cycles[GC_STAT_IN_LAST_GC], + (int) gc_state.n_cycles[GC_STAT_IN_THIS_GC]); + + GC_STAT_PRINT_ONE (enqueued); + GC_STAT_PRINT_ONE (dequeued); + GC_STAT_PRINT_ONE (repushed); + GC_STAT_PRINT_ONE (enqueued2); + GC_STAT_PRINT_ONE (dequeued2); + GC_STAT_PRINT_ONE (finalized); + GC_STAT_PRINT_ONE (freed); + + printf (" | explicitly freed %d tried %d\n", + (int) gc_state.explicitly_freed, + (int) gc_state.explicitly_tried_freed); +} + +DEFUN("gc-stats", Fgc_stats, 0, 0 ,"", /* +Return statistics about garbage collection cycles in a property list. +*/ + ()) +{ + Lisp_Object pl = Qnil; +#define PL(name,value) \ + pl = cons3 (intern (name), make_int ((int) gc_state.value), pl) + + PL ("explicitly-tried-freed", explicitly_tried_freed); + PL ("explicitly-freed", explicitly_freed); + PL ("freed-in-this-cycle", freed[GC_STAT_IN_THIS_CYCLE]); + PL ("freed-in-this-gc", freed[GC_STAT_IN_THIS_GC]); + PL ("freed-in-last-cycle", freed[GC_STAT_IN_LAST_CYCLE]); + PL ("freed-in-last-gc", freed[GC_STAT_IN_LAST_GC]); + PL ("freed-total", freed[GC_STAT_TOTAL]); + PL ("finalized-in-this-cycle", finalized[GC_STAT_IN_THIS_CYCLE]); + PL ("finalized-in-this-gc", finalized[GC_STAT_IN_THIS_GC]); + PL ("finalized-in-last-cycle", finalized[GC_STAT_IN_LAST_CYCLE]); + PL ("finalized-in-last-gc", finalized[GC_STAT_IN_LAST_GC]); + PL ("finalized-total", finalized[GC_STAT_TOTAL]); + PL ("repushed-in-this-cycle", repushed[GC_STAT_IN_THIS_CYCLE]); + PL ("repushed-in-this-gc", repushed[GC_STAT_IN_THIS_GC]); + PL ("repushed-in-last-cycle", repushed[GC_STAT_IN_LAST_CYCLE]); + PL ("repushed-in-last-gc", repushed[GC_STAT_IN_LAST_GC]); + PL ("repushed-total", repushed[GC_STAT_TOTAL]); + PL ("dequeued2-in-this-cycle", dequeued2[GC_STAT_IN_THIS_CYCLE]); + PL ("dequeued2-in-this-gc", dequeued2[GC_STAT_IN_THIS_GC]); + PL ("dequeued2-in-last-cycle", dequeued2[GC_STAT_IN_LAST_CYCLE]); + PL ("dequeued2-in-last-gc", dequeued2[GC_STAT_IN_LAST_GC]); + PL ("dequeued2-total", dequeued2[GC_STAT_TOTAL]); + PL ("enqueued2-in-this-cycle", enqueued2[GC_STAT_IN_THIS_CYCLE]); + PL ("enqueued2-in-this-gc", enqueued2[GC_STAT_IN_THIS_GC]); + PL ("enqueued2-in-last-cycle", enqueued2[GC_STAT_IN_LAST_CYCLE]); + PL ("enqueued2-in-last-gc", enqueued2[GC_STAT_IN_LAST_GC]); + PL ("enqueued2-total", enqueued2[GC_STAT_TOTAL]); + PL ("dequeued-in-this-cycle", dequeued[GC_STAT_IN_THIS_CYCLE]); + PL ("dequeued-in-this-gc", dequeued[GC_STAT_IN_THIS_GC]); + PL ("dequeued-in-last-cycle", dequeued[GC_STAT_IN_LAST_CYCLE]); + PL ("dequeued-in-last-gc", dequeued[GC_STAT_IN_LAST_GC]); + PL ("dequeued-total", dequeued[GC_STAT_TOTAL]); + PL ("enqueued-in-this-cycle", enqueued[GC_STAT_IN_THIS_CYCLE]); + PL ("enqueued-in-this-gc", enqueued[GC_STAT_IN_THIS_GC]); + PL ("enqueued-in-last-cycle", enqueued[GC_STAT_IN_LAST_CYCLE]); + PL ("enqueued-in-last-gc", enqueued[GC_STAT_IN_LAST_GC]); + PL ("enqueued-total", enqueued[GC_STAT_TOTAL]); + PL ("n-cycles-in-this-gc", n_cycles[GC_STAT_IN_THIS_GC]); + PL ("n-cycles-in-last-gc", n_cycles[GC_STAT_IN_LAST_GC]); + PL ("n-cycles-total", n_cycles[GC_STAT_TOTAL]); + PL ("n-gc-total", n_gc[GC_STAT_TOTAL]); + PL ("phase", phase); + return pl; +} +#else /* not ERROR_CHECK_GC */ +# define GC_STAT_START_NEW_GC +# define GC_STAT_RESUME_GC +# define GC_STAT_ENQUEUED +# define GC_STAT_DEQUEUED +# define GC_STAT_REPUSHED +# define GC_STAT_REMOVED +#endif /* not ERROR_CHECK_GC */ +#endif /* NEW_GC */ + + +/************************************************************************/ +/* Recompute need to garbage collect */ +/************************************************************************/ + +int need_to_garbage_collect; + +#ifdef ERROR_CHECK_GC +int always_gc = 0; /* Debugging hack; equivalent to + (setq gc-cons-thresold -1) */ +#else +#define always_gc 0 +#endif + +/* True if it's time to garbage collect now. */ +void +recompute_need_to_garbage_collect (void) +{ + if (always_gc) + need_to_garbage_collect = 1; + else + need_to_garbage_collect = +#ifdef NEW_GC + write_barrier_enabled ? + (consing_since_gc > gc_cons_incremental_threshold) : +#endif /* NEW_GC */ + (consing_since_gc > gc_cons_threshold + && +#if 0 /* #### implement this better */ + (100 * consing_since_gc) / total_data_usage () >= + gc_cons_percentage +#else + (!total_gc_usage_set || + (100 * consing_since_gc) / total_gc_usage >= + gc_cons_percentage) +#endif + ); + recompute_funcall_allocation_flag (); +} + + + +/************************************************************************/ +/* Mark Phase */ +/************************************************************************/ + +static const struct memory_description lisp_object_description_1[] = { + { XD_LISP_OBJECT, 0 }, + { XD_END } +}; + +const struct sized_memory_description lisp_object_description = { + sizeof (Lisp_Object), + lisp_object_description_1 +}; + +#if defined (USE_KKCC) || defined (PDUMP) + +/* This function extracts the value of a count variable described somewhere + else in the description. It is converted corresponding to the type */ +EMACS_INT +lispdesc_indirect_count_1 (EMACS_INT code, + const struct memory_description *idesc, + const void *idata) +{ + EMACS_INT count; + const void *irdata; + + int line = XD_INDIRECT_VAL (code); + int delta = XD_INDIRECT_DELTA (code); + + irdata = ((char *) idata) + + lispdesc_indirect_count (idesc[line].offset, idesc, idata); + switch (idesc[line].type) + { + case XD_BYTECOUNT: + count = * (Bytecount *) irdata; + break; + case XD_ELEMCOUNT: + count = * (Elemcount *) irdata; + break; + case XD_HASHCODE: + count = * (Hashcode *) irdata; + break; + case XD_INT: + count = * (int *) irdata; + break; + case XD_LONG: + count = * (long *) irdata; + break; + default: + stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n", + idesc[line].type, line, (long) code); +#if defined(USE_KKCC) && defined(DEBUG_XEMACS) + if (gc_in_progress) + kkcc_backtrace (); +#endif +#ifdef PDUMP + if (in_pdump) + pdump_backtrace (); +#endif + count = 0; /* warning suppression */ + ABORT (); + } + count += delta; + return count; +} + +/* SDESC is a "description map" (basically, a list of offsets used for + successive indirections) and OBJ is the first object to indirect off of. + Return the description ultimately found. */ + +const struct sized_memory_description * +lispdesc_indirect_description_1 (const void *obj, + const struct sized_memory_description *sdesc) +{ + int pos; + + for (pos = 0; sdesc[pos].size >= 0; pos++) + obj = * (const void **) ((const char *) obj + sdesc[pos].size); + + return (const struct sized_memory_description *) obj; +} + +/* Compute the size of the data at RDATA, described by a single entry + DESC1 in a description array. OBJ and DESC are used for + XD_INDIRECT references. */ + +static Bytecount +lispdesc_one_description_line_size (void *rdata, + const struct memory_description *desc1, + const void *obj, + const struct memory_description *desc) +{ + union_switcheroo: + switch (desc1->type) + { + case XD_LISP_OBJECT_ARRAY: + { + EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); + return (val * sizeof (Lisp_Object)); + } + case XD_LISP_OBJECT: + case XD_LO_LINK: + return sizeof (Lisp_Object); + case XD_OPAQUE_PTR: + return sizeof (void *); +#ifdef NEW_GC + case XD_LISP_OBJECT_BLOCK_PTR: +#endif /* NEW_GC */ + case XD_BLOCK_PTR: + { + EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); + return val * sizeof (void *); + } + case XD_BLOCK_ARRAY: + { + EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); + + return (val * + lispdesc_block_size + (rdata, + lispdesc_indirect_description (obj, desc1->data2.descr))); + } + case XD_OPAQUE_DATA_PTR: + return sizeof (void *); + case XD_UNION_DYNAMIC_SIZE: + { + /* If an explicit size was given in the first-level structure + description, use it; else compute size based on current union + constant. */ + const struct sized_memory_description *sdesc = + lispdesc_indirect_description (obj, desc1->data2.descr); + if (sdesc->size) + return sdesc->size; + else + { + desc1 = lispdesc_process_xd_union (desc1, desc, obj); + if (desc1) + goto union_switcheroo; + break; + } + } + case XD_UNION: + { + /* If an explicit size was given in the first-level structure + description, use it; else compute size based on maximum of all + possible structures. */ + const struct sized_memory_description *sdesc = + lispdesc_indirect_description (obj, desc1->data2.descr); + if (sdesc->size) + return sdesc->size; + else + { + int count; + Bytecount max_size = -1, size; + + desc1 = sdesc->description; + + for (count = 0; desc1[count].type != XD_END; count++) + { + size = lispdesc_one_description_line_size (rdata, + &desc1[count], + obj, desc); + if (size > max_size) + max_size = size; + } + return max_size; + } + } + case XD_ASCII_STRING: + return sizeof (void *); + case XD_DOC_STRING: + return sizeof (void *); + case XD_INT_RESET: + return sizeof (int); + case XD_BYTECOUNT: + return sizeof (Bytecount); + case XD_ELEMCOUNT: + return sizeof (Elemcount); + case XD_HASHCODE: + return sizeof (Hashcode); + case XD_INT: + return sizeof (int); + case XD_LONG: + return sizeof (long); + default: + stderr_out ("Unsupported dump type : %d\n", desc1->type); + ABORT (); + } + + return 0; +} + + +/* Return the size of the memory block (NOT necessarily a structure!) + described by SDESC and pointed to by OBJ. If SDESC records an + explicit size (i.e. non-zero), it is simply returned; otherwise, + the size is calculated by the maximum offset and the size of the + object at that offset, rounded up to the maximum alignment. In + this case, we may need the object, for example when retrieving an + "indirect count" of an inlined array (the count is not constant, + but is specified by one of the elements of the memory block). (It + is generally not a problem if we return an overly large size -- we + will simply end up reserving more space than necessary; but if the + size is too small we could be in serious trouble, in particular + with nested inlined structures, where there may be alignment + padding in the middle of a block. #### In fact there is an (at + least theoretical) problem with an overly large size -- we may + trigger a protection fault when reading from invalid memory. We + need to handle this -- perhaps in a stupid but dependable way, + i.e. by trapping SIGSEGV and SIGBUS.) */ + +Bytecount +lispdesc_block_size_1 (const void *obj, Bytecount size, + const struct memory_description *desc) +{ + EMACS_INT max_offset = -1; + int max_offset_pos = -1; + int pos; + + if (size) + return size; + + for (pos = 0; desc[pos].type != XD_END; pos++) + { + EMACS_INT offset = lispdesc_indirect_count (desc[pos].offset, desc, obj); + if (offset == max_offset) + { + stderr_out ("Two relocatable elements at same offset?\n"); + ABORT (); + } + else if (offset > max_offset) + { + max_offset = offset; + max_offset_pos = pos; + } + } + + if (max_offset_pos < 0) + return 0; + + { + Bytecount size_at_max; + size_at_max = + lispdesc_one_description_line_size ((char *) obj + max_offset, + &desc[max_offset_pos], obj, desc); + + /* We have no way of knowing the required alignment for this structure, + so just make it maximally aligned. */ + return MAX_ALIGN_SIZE (max_offset + size_at_max); + } +} +#endif /* defined (USE_KKCC) || defined (PDUMP) */ + +#ifdef MC_ALLOC +#define GC_CHECK_NOT_FREE(lheader) \ + gc_checking_assert (! LRECORD_FREE_P (lheader)); +#else /* MC_ALLOC */ +#define GC_CHECK_NOT_FREE(lheader) \ + gc_checking_assert (! LRECORD_FREE_P (lheader)); \ + gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || \ + ! ((struct old_lcrecord_header *) lheader)->free) +#endif /* MC_ALLOC */ + +#ifdef USE_KKCC +/* The following functions implement the new mark algorithm. + They mark objects according to their descriptions. They + are modeled on the corresponding pdumper procedures. */ + +#if 0 +# define KKCC_STACK_AS_QUEUE 1 +#endif + +#ifdef DEBUG_XEMACS +/* The backtrace for the KKCC mark functions. */ +#define KKCC_INIT_BT_STACK_SIZE 4096 + +typedef struct +{ + void *obj; + const struct memory_description *desc; + int pos; +} kkcc_bt_stack_entry; + +static kkcc_bt_stack_entry *kkcc_bt; +static int kkcc_bt_stack_size; +static int kkcc_bt_depth = 0; + +static void +kkcc_bt_init (void) +{ + kkcc_bt_depth = 0; + kkcc_bt_stack_size = KKCC_INIT_BT_STACK_SIZE; + kkcc_bt = (kkcc_bt_stack_entry *) + xmalloc_and_zero (kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry)); + if (!kkcc_bt) + { + stderr_out ("KKCC backtrace stack init failed for size %d\n", + kkcc_bt_stack_size); + ABORT (); + } +} + +void +kkcc_backtrace (void) +{ + int i; + stderr_out ("KKCC mark stack backtrace :\n"); + for (i = kkcc_bt_depth - 1; i >= 0; i--) + { + Lisp_Object obj = wrap_pointer_1 (kkcc_bt[i].obj); + stderr_out (" [%d]", i); + if ((XRECORD_LHEADER (obj)->type >= lrecord_type_last_built_in_type) + || (!LRECORDP (obj)) + || (!XRECORD_LHEADER_IMPLEMENTATION (obj))) + { + stderr_out (" non Lisp Object"); + } + else + { + stderr_out (" %s", + XRECORD_LHEADER_IMPLEMENTATION (obj)->name); + } + stderr_out (" (addr: 0x%x, desc: 0x%x, ", + (int) kkcc_bt[i].obj, + (int) kkcc_bt[i].desc); + if (kkcc_bt[i].pos >= 0) + stderr_out ("pos: %d)\n", kkcc_bt[i].pos); + else + if (kkcc_bt[i].pos == -1) + stderr_out ("root set)\n"); + else if (kkcc_bt[i].pos == -2) + stderr_out ("dirty object)\n"); + } +} + +static void +kkcc_bt_stack_realloc (void) +{ + kkcc_bt_stack_size *= 2; + kkcc_bt = (kkcc_bt_stack_entry *) + xrealloc (kkcc_bt, kkcc_bt_stack_size * sizeof (kkcc_bt_stack_entry)); + if (!kkcc_bt) + { + stderr_out ("KKCC backtrace stack realloc failed for size %d\n", + kkcc_bt_stack_size); + ABORT (); + } +} + +static void +kkcc_bt_free (void) +{ + xfree_1 (kkcc_bt); + kkcc_bt = 0; + kkcc_bt_stack_size = 0; +} + +static void +kkcc_bt_push (void *obj, const struct memory_description *desc, + int level, int pos) +{ + kkcc_bt_depth = level; + kkcc_bt[kkcc_bt_depth].obj = obj; + kkcc_bt[kkcc_bt_depth].desc = desc; + kkcc_bt[kkcc_bt_depth].pos = pos; + kkcc_bt_depth++; + if (kkcc_bt_depth >= kkcc_bt_stack_size) + kkcc_bt_stack_realloc (); +} + +#else /* not DEBUG_XEMACS */ +#define kkcc_bt_init() +#define kkcc_bt_push(obj, desc, level, pos) +#endif /* not DEBUG_XEMACS */ + +/* Object memory descriptions are in the lrecord_implementation structure. + But copying them to a parallel array is much more cache-friendly. */ +const struct memory_description *lrecord_memory_descriptions[countof (lrecord_implementations_table)]; + +/* the initial stack size in kkcc_gc_stack_entries */ +#define KKCC_INIT_GC_STACK_SIZE 16384 + +typedef struct +{ + void *data; + const struct memory_description *desc; +#ifdef DEBUG_XEMACS + int level; + int pos; +#endif +} kkcc_gc_stack_entry; + + +static kkcc_gc_stack_entry *kkcc_gc_stack_ptr; +static int kkcc_gc_stack_front; +static int kkcc_gc_stack_rear; +static int kkcc_gc_stack_size; + +#define KKCC_INC(i) ((i + 1) % kkcc_gc_stack_size) +#define KKCC_INC2(i) ((i + 2) % kkcc_gc_stack_size) + +#define KKCC_GC_STACK_FULL (KKCC_INC2 (kkcc_gc_stack_rear) == kkcc_gc_stack_front) +#define KKCC_GC_STACK_EMPTY (KKCC_INC (kkcc_gc_stack_rear) == kkcc_gc_stack_front) + +static void +kkcc_gc_stack_init (void) +{ + kkcc_gc_stack_size = KKCC_INIT_GC_STACK_SIZE; + kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *) + xmalloc_and_zero (kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry)); + if (!kkcc_gc_stack_ptr) + { + stderr_out ("stack init failed for size %d\n", kkcc_gc_stack_size); + ABORT (); + } + kkcc_gc_stack_front = 0; + kkcc_gc_stack_rear = kkcc_gc_stack_size - 1; +} + +static void +kkcc_gc_stack_free (void) +{ + xfree_1 (kkcc_gc_stack_ptr); + kkcc_gc_stack_ptr = 0; + kkcc_gc_stack_front = 0; + kkcc_gc_stack_rear = 0; + kkcc_gc_stack_size = 0; +} + +static void +kkcc_gc_stack_realloc (void) +{ + kkcc_gc_stack_entry *old_ptr = kkcc_gc_stack_ptr; + int old_size = kkcc_gc_stack_size; + kkcc_gc_stack_size *= 2; + kkcc_gc_stack_ptr = (kkcc_gc_stack_entry *) + xmalloc_and_zero (kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry)); + if (!kkcc_gc_stack_ptr) + { + stderr_out ("stack realloc failed for size %d\n", kkcc_gc_stack_size); + ABORT (); + } + if (kkcc_gc_stack_rear >= kkcc_gc_stack_front) + { + int number_elements = kkcc_gc_stack_rear - kkcc_gc_stack_front + 1; + memcpy (kkcc_gc_stack_ptr, &old_ptr[kkcc_gc_stack_front], + number_elements * sizeof (kkcc_gc_stack_entry)); + kkcc_gc_stack_front = 0; + kkcc_gc_stack_rear = number_elements - 1; + } + else + { + int number_elements = old_size - kkcc_gc_stack_front; + memcpy (kkcc_gc_stack_ptr, &old_ptr[kkcc_gc_stack_front], + number_elements * sizeof (kkcc_gc_stack_entry)); + memcpy (&kkcc_gc_stack_ptr[number_elements], &old_ptr[0], + (kkcc_gc_stack_rear + 1) * sizeof (kkcc_gc_stack_entry)); + kkcc_gc_stack_front = 0; + kkcc_gc_stack_rear = kkcc_gc_stack_rear + number_elements; + } + xfree_1 (old_ptr); +} + +static void +#ifdef DEBUG_XEMACS +kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc, + int level, int pos) +#else +kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc) +#endif +{ +#ifdef NEW_GC + GC_STAT_ENQUEUED; +#endif /* NEW_GC */ + if (KKCC_GC_STACK_FULL) + kkcc_gc_stack_realloc(); + kkcc_gc_stack_rear = KKCC_INC (kkcc_gc_stack_rear); + kkcc_gc_stack_ptr[kkcc_gc_stack_rear].data = data; + kkcc_gc_stack_ptr[kkcc_gc_stack_rear].desc = desc; +#ifdef DEBUG_XEMACS + kkcc_gc_stack_ptr[kkcc_gc_stack_rear].level = level; + kkcc_gc_stack_ptr[kkcc_gc_stack_rear].pos = pos; +#endif +} + +#ifdef DEBUG_XEMACS +#define kkcc_gc_stack_push(data, desc, level, pos) \ + kkcc_gc_stack_push_1 (data, desc, level, pos) +#else +#define kkcc_gc_stack_push(data, desc, level, pos) \ + kkcc_gc_stack_push_1 (data, desc) +#endif + +static kkcc_gc_stack_entry * +kkcc_gc_stack_pop (void) +{ + if (KKCC_GC_STACK_EMPTY) + return 0; +#ifdef NEW_GC + GC_STAT_DEQUEUED; +#endif /* NEW_GC */ +#ifndef KKCC_STACK_AS_QUEUE + /* stack behaviour */ + return &kkcc_gc_stack_ptr[kkcc_gc_stack_rear--]; +#else + /* queue behaviour */ + { + int old_front = kkcc_gc_stack_front; + kkcc_gc_stack_front = KKCC_INC (kkcc_gc_stack_front); + return &kkcc_gc_stack_ptr[old_front]; + } +#endif +} + +void +#ifdef DEBUG_XEMACS +kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos) +#else +kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj) +#endif +{ + if (XTYPE (obj) == Lisp_Type_Record) + { + struct lrecord_header *lheader = XRECORD_LHEADER (obj); + const struct memory_description *desc; + GC_CHECK_LHEADER_INVARIANTS (lheader); + desc = RECORD_DESCRIPTION (lheader); + if (! MARKED_RECORD_HEADER_P (lheader)) + { +#ifdef NEW_GC + MARK_GREY (lheader); +#else /* not NEW_GC */ + MARK_RECORD_HEADER (lheader); +#endif /* not NEW_GC */ + kkcc_gc_stack_push ((void *) lheader, desc, level, pos); + } + } +} + +#ifdef NEW_GC +#ifdef DEBUG_XEMACS +#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ + kkcc_gc_stack_push_lisp_object_1 (obj, level, pos) +#else +#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ + kkcc_gc_stack_push_lisp_object_1 (obj) +#endif + +void +#ifdef DEBUG_XEMACS +kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj, int level, int pos) +#else +kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj) +#endif +{ + if (XTYPE (obj) == Lisp_Type_Record) + { + struct lrecord_header *lheader = XRECORD_LHEADER (obj); + const struct memory_description *desc; + GC_STAT_REPUSHED; + GC_CHECK_LHEADER_INVARIANTS (lheader); + desc = RECORD_DESCRIPTION (lheader); + MARK_GREY (lheader); + kkcc_gc_stack_push ((void*) lheader, desc, level, pos); + } +} +#endif /* NEW_GC */ + +#ifdef ERROR_CHECK_GC +#define KKCC_DO_CHECK_FREE(obj, allow_free) \ +do \ +{ \ + if (!allow_free && XTYPE (obj) == Lisp_Type_Record) \ + { \ + struct lrecord_header *lheader = XRECORD_LHEADER (obj); \ + GC_CHECK_NOT_FREE (lheader); \ + } \ +} while (0) +#else +#define KKCC_DO_CHECK_FREE(obj, allow_free) +#endif + +#ifdef ERROR_CHECK_GC +#ifdef DEBUG_XEMACS +static void +mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free, + int level, int pos) +#else +static void +mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free) +#endif +{ + KKCC_DO_CHECK_FREE (obj, allow_free); + kkcc_gc_stack_push_lisp_object (obj, level, pos); +} + +#ifdef DEBUG_XEMACS +#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ + mark_object_maybe_checking_free_1 (obj, allow_free, level, pos) +#else +#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ + mark_object_maybe_checking_free_1 (obj, allow_free) +#endif +#else /* not ERROR_CHECK_GC */ +#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ + kkcc_gc_stack_push_lisp_object (obj, level, pos) +#endif /* not ERROR_CHECK_GC */ + + +/* This function loops all elements of a struct pointer and calls + mark_with_description with each element. */ +static void +#ifdef DEBUG_XEMACS +mark_struct_contents_1 (const void *data, + const struct sized_memory_description *sdesc, + int count, int level, int pos) +#else +mark_struct_contents_1 (const void *data, + const struct sized_memory_description *sdesc, + int count) +#endif +{ + int i; + Bytecount elsize; + elsize = lispdesc_block_size (data, sdesc); + + for (i = 0; i < count; i++) + { + kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description, + level, pos); + } +} + +#ifdef DEBUG_XEMACS +#define mark_struct_contents(data, sdesc, count, level, pos) \ + mark_struct_contents_1 (data, sdesc, count, level, pos) +#else +#define mark_struct_contents(data, sdesc, count, level, pos) \ + mark_struct_contents_1 (data, sdesc, count) +#endif + + +#ifdef NEW_GC +/* This function loops all elements of a struct pointer and calls + mark_with_description with each element. */ +static void +#ifdef DEBUG_XEMACS +mark_lisp_object_block_contents_1 (const void *data, + const struct sized_memory_description *sdesc, + int count, int level, int pos) +#else +mark_lisp_object_block_contents_1 (const void *data, + const struct sized_memory_description *sdesc, + int count) +#endif +{ + int i; + Bytecount elsize; + elsize = lispdesc_block_size (data, sdesc); + + for (i = 0; i < count; i++) + { + const Lisp_Object obj = wrap_pointer_1 (((char *) data) + elsize * i); + if (XTYPE (obj) == Lisp_Type_Record) + { + struct lrecord_header *lheader = XRECORD_LHEADER (obj); + const struct memory_description *desc; + GC_CHECK_LHEADER_INVARIANTS (lheader); + desc = sdesc->description; + if (! MARKED_RECORD_HEADER_P (lheader)) + { + MARK_GREY (lheader); + kkcc_gc_stack_push ((void *) lheader, desc, level, pos); + } + } + } +} + +#ifdef DEBUG_XEMACS +#define mark_lisp_object_block_contents(data, sdesc, count, level, pos) \ + mark_lisp_object_block_contents_1 (data, sdesc, count, level, pos) +#else +#define mark_lisp_object_block_contents(data, sdesc, count, level, pos) \ + mark_lisp_object_block_contents_1 (data, sdesc, count) +#endif +#endif /* not NEW_GC */ + +/* This function implements the KKCC mark algorithm. + Instead of calling mark_object, all the alive Lisp_Objects are pushed + on the kkcc_gc_stack. This function processes all elements on the stack + according to their descriptions. */ +static void +kkcc_marking ( +#ifdef NEW_GC + int cnt +#else /* not NEW_GC */ + int UNUSED(cnt) +#endif /* not NEW_GC */ + ) +{ + kkcc_gc_stack_entry *stack_entry = 0; + void *data = 0; + const struct memory_description *desc = 0; + int pos; +#ifdef NEW_GC + int count = cnt; +#endif /* NEW_GC */ +#ifdef DEBUG_XEMACS + int level = 0; +#endif + + while ((stack_entry = kkcc_gc_stack_pop ()) != 0) + { + data = stack_entry->data; + desc = stack_entry->desc; +#ifdef DEBUG_XEMACS + level = stack_entry->level + 1; +#endif + kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos); + +#ifdef NEW_GC + /* Mark black if object is currently grey. This first checks, + if the object is really allocated on the mc-heap. If it is, + it can be marked black; if it is not, it cannot be marked. */ + maybe_mark_black (data); +#endif /* NEW_GC */ + + if (!data) continue; + + gc_checking_assert (data); + gc_checking_assert (desc); + + for (pos = 0; desc[pos].type != XD_END; pos++) + { + const struct memory_description *desc1 = &desc[pos]; + const void *rdata = + (const char *) data + lispdesc_indirect_count (desc1->offset, + desc, data); + union_switcheroo: + + /* If the flag says don't mark, then don't mark. */ + if ((desc1->flags) & XD_FLAG_NO_KKCC) + continue; + + switch (desc1->type) + { + case XD_BYTECOUNT: + case XD_ELEMCOUNT: + case XD_HASHCODE: + case XD_INT: + case XD_LONG: + case XD_INT_RESET: + case XD_LO_LINK: + case XD_OPAQUE_PTR: + case XD_OPAQUE_DATA_PTR: + case XD_ASCII_STRING: + case XD_DOC_STRING: + break; + case XD_LISP_OBJECT: + { + const Lisp_Object *stored_obj = (const Lisp_Object *) rdata; + + /* Because of the way that tagged objects work (pointers and + Lisp_Objects have the same representation), XD_LISP_OBJECT + can be used for untagged pointers. They might be NULL, + though. */ + if (EQ (*stored_obj, Qnull_pointer)) + break; +#ifdef MC_ALLOC + mark_object_maybe_checking_free (*stored_obj, 0, level, pos); +#else /* not MC_ALLOC */ + mark_object_maybe_checking_free + (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, + level, pos); +#endif /* not MC_ALLOC */ + break; + } + case XD_LISP_OBJECT_ARRAY: + { + int i; + EMACS_INT count = + lispdesc_indirect_count (desc1->data1, desc, data); + + for (i = 0; i < count; i++) + { + const Lisp_Object *stored_obj = + (const Lisp_Object *) rdata + i; + + if (EQ (*stored_obj, Qnull_pointer)) + break; +#ifdef MC_ALLOC + mark_object_maybe_checking_free + (*stored_obj, 0, level, pos); +#else /* not MC_ALLOC */ + mark_object_maybe_checking_free + (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, + level, pos); +#endif /* not MC_ALLOC */ + } + break; + } +#ifdef NEW_GC + case XD_LISP_OBJECT_BLOCK_PTR: + { + EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, + data); + const struct sized_memory_description *sdesc = + lispdesc_indirect_description (data, desc1->data2.descr); + const char *dobj = * (const char **) rdata; + if (dobj) + mark_lisp_object_block_contents + (dobj, sdesc, count, level, pos); + break; + } +#endif /* NEW_GC */ + case XD_BLOCK_PTR: + { + EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, + data); + const struct sized_memory_description *sdesc = + lispdesc_indirect_description (data, desc1->data2.descr); + const char *dobj = * (const char **) rdata; + if (dobj) + mark_struct_contents (dobj, sdesc, count, level, pos); + break; + } + case XD_BLOCK_ARRAY: + { + EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, + data); + const struct sized_memory_description *sdesc = + lispdesc_indirect_description (data, desc1->data2.descr); + + mark_struct_contents (rdata, sdesc, count, level, pos); + break; + } + case XD_UNION: + case XD_UNION_DYNAMIC_SIZE: + desc1 = lispdesc_process_xd_union (desc1, desc, data); + if (desc1) + goto union_switcheroo; + break; + + default: + stderr_out ("Unsupported description type : %d\n", desc1->type); + kkcc_backtrace (); + ABORT (); + } + } + +#ifdef NEW_GC + if (cnt) + if (!--count) + break; +#endif /* NEW_GC */ + } +} +#endif /* USE_KKCC */ + +/* I hate duplicating all this crap! */ +int +marked_p (Lisp_Object obj) +{ + /* Checks we used to perform. */ + /* if (EQ (obj, Qnull_pointer)) return 1; */ + /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */ + /* if (PURIFIED (XPNTR (obj))) return 1; */ + + if (XTYPE (obj) == Lisp_Type_Record) + { + struct lrecord_header *lheader = XRECORD_LHEADER (obj); + + GC_CHECK_LHEADER_INVARIANTS (lheader); + + return MARKED_RECORD_HEADER_P (lheader); + } + return 1; +} + + +/* Mark reference to a Lisp_Object. If the object referred to has not been + seen yet, recursively mark all the references contained in it. */ +void +mark_object ( +#ifdef USE_KKCC + Lisp_Object UNUSED (obj) +#else + Lisp_Object obj +#endif + ) +{ +#ifdef USE_KKCC + /* this code should never be reached when configured for KKCC */ + stderr_out ("KKCC: Invalid mark_object call.\n"); + stderr_out ("Replace mark_object with kkcc_gc_stack_push_lisp_object.\n"); + ABORT (); +#else /* not USE_KKCC */ + + tail_recurse: + + /* Checks we used to perform */ + /* if (EQ (obj, Qnull_pointer)) return; */ + /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */ + /* if (PURIFIED (XPNTR (obj))) return; */ + + if (XTYPE (obj) == Lisp_Type_Record) + { + struct lrecord_header *lheader = XRECORD_LHEADER (obj); + + GC_CHECK_LHEADER_INVARIANTS (lheader); + + /* We handle this separately, above, so we can mark free objects */ + GC_CHECK_NOT_FREE (lheader); + + /* All c_readonly objects have their mark bit set, + so that we only need to check the mark bit here. */ + if (! MARKED_RECORD_HEADER_P (lheader)) + { + MARK_RECORD_HEADER (lheader); + + if (RECORD_MARKER (lheader)) + { + obj = RECORD_MARKER (lheader) (obj); + if (!NILP (obj)) goto tail_recurse; + } + } + } +#endif /* not KKCC */ +} + + +/************************************************************************/ +/* Hooks */ +/************************************************************************/ + +/* Nonzero when calling certain hooks or doing other things where a GC + would be bad. It prevents infinite recursive calls to gc. */ +int gc_currently_forbidden; + +int +begin_gc_forbidden (void) +{ + return internal_bind_int (&gc_currently_forbidden, 1); +} + +void +end_gc_forbidden (int count) +{ + unbind_to (count); +} + +/* Hooks. */ +Lisp_Object Vpre_gc_hook, Qpre_gc_hook; +Lisp_Object Vpost_gc_hook, Qpost_gc_hook; + +/* Maybe we want to use this when doing a "panic" gc after memory_full()? */ +static int gc_hooks_inhibited; + +struct post_gc_action +{ + void (*fun) (void *); + void *arg; +}; + +typedef struct post_gc_action post_gc_action; + +typedef struct +{ + Dynarr_declare (post_gc_action); +} post_gc_action_dynarr; + +static post_gc_action_dynarr *post_gc_actions; + +/* Register an action to be called at the end of GC. + gc_in_progress is 0 when this is called. + This is used when it is discovered that an action needs to be taken, + but it's during GC, so it's not safe. (e.g. in a finalize method.) + + As a general rule, do not use Lisp objects here. + And NEVER signal an error. +*/ + +void +register_post_gc_action (void (*fun) (void *), void *arg) +{ + post_gc_action action; + + if (!post_gc_actions) + post_gc_actions = Dynarr_new (post_gc_action); + + action.fun = fun; + action.arg = arg; + + Dynarr_add (post_gc_actions, action); +} + +static void +run_post_gc_actions (void) +{ + int i; + + if (post_gc_actions) + { + for (i = 0; i < Dynarr_length (post_gc_actions); i++) + { + post_gc_action action = Dynarr_at (post_gc_actions, i); + (action.fun) (action.arg); + } + + Dynarr_reset (post_gc_actions); + } +} + + + +/************************************************************************/ +/* Garbage Collection */ +/************************************************************************/ + +/* Enable/disable incremental garbage collection during runtime. */ +int allow_incremental_gc; + +/* For profiling. */ +static Lisp_Object QSin_garbage_collection; + +/* Nonzero means display messages at beginning and end of GC. */ +int garbage_collection_messages; + +/* "Garbage collecting" */ +Lisp_Object Vgc_message; +Lisp_Object Vgc_pointer_glyph; +static const Ascbyte gc_default_message[] = "Garbage collecting"; +Lisp_Object Qgarbage_collecting; + +/* "Locals" during GC. */ +struct frame *f; +int speccount; +int cursor_changed; +Lisp_Object pre_gc_cursor; + +/* PROFILE_DECLARE */ +int do_backtrace; +struct backtrace backtrace; + +/* Maximum amount of C stack to save when a GC happens. */ +#ifndef MAX_SAVE_STACK +#define MAX_SAVE_STACK 0 /* 16000 */ +#endif + +void +gc_prepare (void) +{ +#if MAX_SAVE_STACK > 0 + char stack_top_variable; + extern char *stack_bottom; +#endif + +#ifdef NEW_GC + GC_STAT_START_NEW_GC; + GC_SET_PHASE (INIT_GC); +#endif /* NEW_GC */ + + do_backtrace = profiling_active || backtrace_with_internal_sections; + + assert (!gc_in_progress); + assert (!in_display || gc_currently_forbidden); + + PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection); + + /* We used to call selected_frame() here. + + The following functions cannot be called inside GC + so we move to after the above tests. */ + { + Lisp_Object frame; + Lisp_Object device = Fselected_device (Qnil); + if (NILP (device)) /* Could happen during startup, eg. if always_gc */ + return; + frame = Fselected_frame (device); + if (NILP (frame)) + invalid_state ("No frames exist on device", device); + f = XFRAME (frame); + } + + pre_gc_cursor = Qnil; + cursor_changed = 0; + + need_to_signal_post_gc = 0; + recompute_funcall_allocation_flag (); + + if (!gc_hooks_inhibited) + run_hook_trapping_problems + (Qgarbage_collecting, Qpre_gc_hook, + INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION); + + /* Now show the GC cursor/message. */ + if (!noninteractive) + { + if (FRAME_WIN_P (f)) + { + Lisp_Object frame = wrap_frame (f); + Lisp_Object cursor = glyph_image_instance (Vgc_pointer_glyph, + FRAME_SELECTED_WINDOW (f), + ERROR_ME_NOT, 1); + pre_gc_cursor = f->pointer; + if (POINTER_IMAGE_INSTANCEP (cursor) + /* don't change if we don't know how to change back. */ + && POINTER_IMAGE_INSTANCEP (pre_gc_cursor)) + { + cursor_changed = 1; + Fset_frame_pointer (frame, cursor); + } + } + + /* Don't print messages to the stream device. */ + if (!cursor_changed && !FRAME_STREAM_P (f)) + { + if (garbage_collection_messages) + { + Lisp_Object args[2], whole_msg; + args[0] = (STRINGP (Vgc_message) ? Vgc_message : + build_msg_string (gc_default_message)); + args[1] = build_string ("..."); + whole_msg = Fconcat (2, args); + echo_area_message (f, (Ibyte *) 0, whole_msg, 0, -1, + Qgarbage_collecting); + } + } + } + + /***** Now we actually start the garbage collection. */ + + gc_in_progress = 1; +#ifndef NEW_GC + inhibit_non_essential_conversion_operations = 1; +#endif /* NEW_GC */ + +#if MAX_SAVE_STACK > 0 + + /* Save a copy of the contents of the stack, for debugging. */ + if (!purify_flag) + { + /* Static buffer in which we save a copy of the C stack at each GC. */ + static char *stack_copy; + static Bytecount stack_copy_size; + + ptrdiff_t stack_diff = &stack_top_variable - stack_bottom; + Bytecount stack_size = (stack_diff > 0 ? stack_diff : -stack_diff); + if (stack_size < MAX_SAVE_STACK) + { + if (stack_copy_size < stack_size) + { + stack_copy = (char *) xrealloc (stack_copy, stack_size); + stack_copy_size = stack_size; + } + + memcpy (stack_copy, + stack_diff > 0 ? stack_bottom : &stack_top_variable, + stack_size); + } + } +#endif /* MAX_SAVE_STACK > 0 */ + + /* Do some totally ad-hoc resource clearing. */ + /* #### generalize this? */ + clear_event_resource (); + cleanup_specifiers (); + cleanup_buffer_undo_lists (); +} + +void +gc_mark_root_set ( +#ifdef NEW_GC + enum gc_phase phase +#else /* not NEW_GC */ + void +#endif /* not NEW_GC */ + ) +{ +#ifdef NEW_GC + GC_SET_PHASE (phase); +#endif /* NEW_GC */ + + /* Mark all the special slots that serve as the roots of accessibility. */ + +#ifdef USE_KKCC +# define mark_object(obj) kkcc_gc_stack_push_lisp_object (obj, 0, -1) +#endif /* USE_KKCC */ + + { /* staticpro() */ + Lisp_Object **p = Dynarr_begin (staticpros); + Elemcount count; + for (count = Dynarr_length (staticpros); count; count--) + /* Need to check if the pointer in the staticpro array is not + NULL. A gc can occur after variable is added to the staticpro + array and _before_ it is correctly initialized. In this case + its value is NULL, which we have to catch here. */ + if (*p) + mark_object (**p++); + else + **p++; + } + + { /* staticpro_nodump() */ + Lisp_Object **p = Dynarr_begin (staticpros_nodump); + Elemcount count; + for (count = Dynarr_length (staticpros_nodump); count; count--) + /* Need to check if the pointer in the staticpro array is not + NULL. A gc can occur after variable is added to the staticpro + array and _before_ it is correctly initialized. In this case + its value is NULL, which we have to catch here. */ + if (*p) + mark_object (**p++); + else + **p++; + } + +#ifdef MC_ALLOC + { /* mcpro () */ + Lisp_Object *p = Dynarr_begin (mcpros); + Elemcount count; + for (count = Dynarr_length (mcpros); count; count--) + mark_object (*p++); + } +#endif /* MC_ALLOC */ + + { /* GCPRO() */ + struct gcpro *tail; + int i; + for (tail = gcprolist; tail; tail = tail->next) + for (i = 0; i < tail->nvars; i++) + mark_object (tail->var[i]); + } + + { /* specbind() */ + struct specbinding *bind; + for (bind = specpdl; bind != specpdl_ptr; bind++) + { + mark_object (bind->symbol); + mark_object (bind->old_value); + } + } + + { + struct catchtag *c; + for (c = catchlist; c; c = c->next) + { + mark_object (c->tag); + mark_object (c->val); + mark_object (c->actual_tag); + mark_object (c->backtrace); + } + } + + { + struct backtrace *backlist; + for (backlist = backtrace_list; backlist; backlist = backlist->next) + { + int nargs = backlist->nargs; + int i; + + mark_object (*backlist->function); + if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */ + /* might be fake (internal profiling entry) */ + && backlist->args) + mark_object (backlist->args[0]); + else + for (i = 0; i < nargs; i++) + mark_object (backlist->args[i]); + } + } + + mark_profiling_info (); +#ifdef USE_KKCC +# undef mark_object +#endif +} + +void +gc_finish_mark (void) +{ +#ifdef NEW_GC + GC_SET_PHASE (FINISH_MARK); +#endif /* NEW_GC */ + init_marking_ephemerons (); + + while (finish_marking_weak_hash_tables () > 0 || + finish_marking_weak_lists () > 0 || + continue_marking_ephemerons () > 0) +#ifdef USE_KKCC + { + kkcc_marking (0); + } +#else /* not USE_KKCC */ + ; +#endif /* not USE_KKCC */ + + /* At this point, we know which objects need to be finalized: we + still need to resurrect them */ + + while (finish_marking_ephemerons () > 0 || + finish_marking_weak_lists () > 0 || + finish_marking_weak_hash_tables () > 0) +#ifdef USE_KKCC + { + kkcc_marking (0); + } +#else /* not USE_KKCC */ + ; +#endif /* not USE_KKCC */ + + /* And prune (this needs to be called after everything else has been + marked and before we do any sweeping). */ + /* #### this is somewhat ad-hoc and should probably be an object + method */ + prune_weak_hash_tables (); + prune_weak_lists (); + prune_specifiers (); + prune_syntax_tables (); + + prune_ephemerons (); + prune_weak_boxes (); +} + +#ifdef NEW_GC +void +gc_finalize (void) +{ + GC_SET_PHASE (FINALIZE); + mc_finalize (); +} + +void +gc_sweep (void) +{ + GC_SET_PHASE (SWEEP); + mc_sweep (); +} +#endif /* NEW_GC */ + + +void +gc_finish (void) +{ +#ifdef NEW_GC + GC_SET_PHASE (FINISH_GC); +#endif /* NEW_GC */ + consing_since_gc = 0; +#ifndef DEBUG_XEMACS + /* Allow you to set it really fucking low if you really want ... */ + if (gc_cons_threshold < 10000) + gc_cons_threshold = 10000; +#endif + recompute_need_to_garbage_collect (); + +#ifndef NEW_GC + inhibit_non_essential_conversion_operations = 0; +#endif /* not NEW_GC */ + gc_in_progress = 0; + + run_post_gc_actions (); + + /******* End of garbage collection ********/ + + /* Now remove the GC cursor/message */ + if (!noninteractive) + { + if (cursor_changed) + Fset_frame_pointer (wrap_frame (f), pre_gc_cursor); + else if (!FRAME_STREAM_P (f)) + { + /* Show "...done" only if the echo area would otherwise be empty. */ + if (NILP (clear_echo_area (selected_frame (), + Qgarbage_collecting, 0))) + { + if (garbage_collection_messages) + { + Lisp_Object args[2], whole_msg; + args[0] = (STRINGP (Vgc_message) ? Vgc_message : + build_msg_string (gc_default_message)); + args[1] = build_msg_string ("... done"); + whole_msg = Fconcat (2, args); + echo_area_message (selected_frame (), (Ibyte *) 0, + whole_msg, 0, -1, + Qgarbage_collecting); + } + } + } + } + +#ifndef MC_ALLOC + if (!breathing_space) + { + breathing_space = malloc (4096 - MALLOC_OVERHEAD); + } +#endif /* not MC_ALLOC */ + + need_to_signal_post_gc = 1; + funcall_allocation_flag = 1; + + PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection); + +#ifdef NEW_GC + GC_SET_PHASE (NONE); +#endif /* NEW_GC */ +} + +#ifdef NEW_GC +void +gc_suspend_mark_phase (void) +{ + PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection); + write_barrier_enabled = 1; + consing_since_gc = 0; + vdb_start_dirty_bits_recording (); +} + +int +gc_resume_mark_phase (void) +{ + PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection); + assert (write_barrier_enabled); + vdb_stop_dirty_bits_recording (); + write_barrier_enabled = 0; + return vdb_read_dirty_bits (); +} + +int +gc_mark (int incremental) +{ + GC_SET_PHASE (MARK); + if (!incremental) + { + kkcc_marking (0); + } + else + { + kkcc_marking (gc_incremental_traversal_threshold); + if (!KKCC_GC_STACK_EMPTY) + { + gc_suspend_mark_phase (); + return 0; + } + } + return 1; +} + +int +gc_resume_mark (int incremental) +{ + if (!incremental) + { + if (!KKCC_GC_STACK_EMPTY) + { + GC_STAT_RESUME_GC; + /* An incremental garbage collection is already running --- + now wrap it up and resume it atomically. */ + gc_resume_mark_phase (); + gc_mark_root_set (REPUSH_ROOT_SET); + kkcc_marking (0); + } + } + else + { + int repushed_objects; + int mark_work; + GC_STAT_RESUME_GC; + repushed_objects = gc_resume_mark_phase (); + mark_work = (gc_incremental_traversal_threshold > repushed_objects) ? + gc_incremental_traversal_threshold : repushed_objects; + kkcc_marking (mark_work); + if (KKCC_GC_STACK_EMPTY) + { + /* Mark root set again and finish up marking. */ + gc_mark_root_set (REPUSH_ROOT_SET); + kkcc_marking (0); + } + else + { + gc_suspend_mark_phase (); + return 0; + } + } + return 1; +} + + +void +gc_1 (int incremental) +{ + switch (GC_PHASE) + { + case NONE: + gc_prepare (); + kkcc_gc_stack_init(); +#ifdef DEBUG_XEMACS + kkcc_bt_init (); +#endif + case INIT_GC: + gc_mark_root_set (PUSH_ROOT_SET); + case PUSH_ROOT_SET: + if (!gc_mark (incremental)) + return; /* suspend gc */ + case MARK: + if (!KKCC_GC_STACK_EMPTY) + if (!gc_resume_mark (incremental)) + return; /* suspend gc */ + gc_finish_mark (); + kkcc_gc_stack_free (); +#ifdef DEBUG_XEMACS + kkcc_bt_free (); +#endif + case FINISH_MARK: + gc_finalize (); + case FINALIZE: + gc_sweep (); + case SWEEP: + gc_finish (); + case FINISH_GC: + break; + } +} + +void gc (int incremental) +{ + if (gc_currently_forbidden + || in_display + || preparing_for_armageddon) + return; + + /* Very important to prevent GC during any of the following + stuff that might run Lisp code; otherwise, we'll likely + have infinite GC recursion. */ + speccount = begin_gc_forbidden (); + + gc_1 (incremental); + + /* now stop inhibiting GC */ + unbind_to (speccount); +} + +void +gc_full (void) +{ + gc (0); +} + +DEFUN ("gc-full", Fgc_full, 0, 0, "", /* +This function performs a full garbage collection. If an incremental +garbage collection is already running, it completes without any +further interruption. This function guarantees that unused objects +are freed when it returns. Garbage collection happens automatically if +the client allocates more than `gc-cons-threshold' bytes of Lisp data +since the previous garbage collection. +*/ + ()) +{ + gc_full (); + return Qt; +} + +void +gc_incremental (void) +{ + gc (allow_incremental_gc); +} + +DEFUN ("gc-incremental", Fgc_incremental, 0, 0, "", /* +This function starts an incremental garbage collection. If an +incremental garbage collection is already running, the next cycle +starts. Note that this function has not necessarily freed any memory +when it returns. This function only guarantees, that the traversal of +the heap makes progress. The next cycle of incremental garbage +collection happens automatically if the client allocates more than +`gc-incremental-cons-threshold' bytes of Lisp data since previous +garbage collection. +*/ + ()) +{ + gc_incremental (); + return Qt; +} +#else /* not NEW_GC */ +void garbage_collect_1 (void) +{ + if (gc_in_progress + || gc_currently_forbidden + || in_display + || preparing_for_armageddon) + return; + + /* Very important to prevent GC during any of the following + stuff that might run Lisp code; otherwise, we'll likely + have infinite GC recursion. */ + speccount = begin_gc_forbidden (); + + gc_prepare (); +#ifdef USE_KKCC + kkcc_gc_stack_init(); +#ifdef DEBUG_XEMACS + kkcc_bt_init (); +#endif +#endif /* USE_KKCC */ + gc_mark_root_set (); +#ifdef USE_KKCC + kkcc_marking (0); +#endif /* USE_KKCC */ + gc_finish_mark (); +#ifdef USE_KKCC + kkcc_gc_stack_free (); +#ifdef DEBUG_XEMACS + kkcc_bt_free (); +#endif +#endif /* USE_KKCC */ + gc_sweep_1 (); + gc_finish (); + + /* now stop inhibiting GC */ + unbind_to (speccount); +} +#endif /* not NEW_GC */ + + +/************************************************************************/ +/* Initializations */ +/************************************************************************/ + +/* Initialization */ +static void +common_init_gc_early (void) +{ + Vgc_message = Qzero; + + gc_currently_forbidden = 0; + gc_hooks_inhibited = 0; + + need_to_garbage_collect = always_gc; + + gc_cons_threshold = GC_CONS_THRESHOLD; + gc_cons_percentage = 40; /* #### what is optimal? */ + total_gc_usage_set = 0; +#ifdef NEW_GC + gc_cons_incremental_threshold = GC_CONS_INCREMENTAL_THRESHOLD; + gc_incremental_traversal_threshold = GC_INCREMENTAL_TRAVERSAL_THRESHOLD; +#endif /* not NEW_GC */ +} + +void +init_gc_early (void) +{ +} + +void +reinit_gc_early (void) +{ + common_init_gc_early (); +} + +void +init_gc_once_early (void) +{ + common_init_gc_early (); +} + +void +syms_of_gc (void) +{ + DEFSYMBOL (Qpre_gc_hook); + DEFSYMBOL (Qpost_gc_hook); +#ifdef NEW_GC + DEFSUBR (Fgc_full); + DEFSUBR (Fgc_incremental); +#ifdef ERROR_CHECK_GC + DEFSUBR (Fgc_stats); +#endif /* not ERROR_CHECK_GC */ +#endif /* NEW_GC */ +} + +void +vars_of_gc (void) +{ + staticpro_nodump (&pre_gc_cursor); + + QSin_garbage_collection = build_msg_string ("(in garbage collection)"); + staticpro (&QSin_garbage_collection); + + DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold /* +*Number of bytes of consing between full garbage collections. +\"Consing\" is a misnomer in that this actually counts allocation +of all different kinds of objects, not just conses. +Garbage collection can happen automatically once this many bytes have been +allocated since the last garbage collection. All data types count. + +Garbage collection happens automatically when `eval' or `funcall' are +called. (Note that `funcall' is called implicitly as part of evaluation.) +By binding this temporarily to a large number, you can effectively +prevent garbage collection during a part of the program. + +Normally, you cannot set this value less than 10,000 (if you do, it is +automatically reset during the next garbage collection). However, if +XEmacs was compiled with DEBUG_XEMACS, this does not happen, allowing +you to set this value very low to track down problems with insufficient +GCPRO'ing. If you set this to a negative number, garbage collection will +happen at *EVERY* call to `eval' or `funcall'. This is an extremely +effective way to check GCPRO problems, but be warned that your XEmacs +will be unusable! You almost certainly won't have the patience to wait +long enough to be able to set it back. + +See also `consing-since-gc' and `gc-cons-percentage'. +*/ ); + + DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /* +*Percentage of memory allocated between garbage collections. + +Garbage collection will happen if this percentage of the total amount of +memory used for data (see `lisp-object-memory-usage') has been allocated +since the last garbage collection. However, it will not happen if less +than `gc-cons-threshold' bytes have been allocated -- this sets an absolute +minimum in case very little data has been allocated or the percentage is +set very low. Set this to 0 to have garbage collection always happen after +`gc-cons-threshold' bytes have been allocated, regardless of current memory +usage. + +See also `consing-since-gc' and `gc-cons-threshold'. +*/ ); + +#ifdef NEW_GC + DEFVAR_INT ("gc-cons-incremental-threshold", + &gc_cons_incremental_threshold /* +*Number of bytes of consing between cycles of incremental garbage +collections. \"Consing\" is a misnomer in that this actually counts +allocation of all different kinds of objects, not just conses. The +next garbage collection cycle can happen automatically once this many +bytes have been allocated since the last garbage collection cycle. +All data types count. + +See also `gc-cons-threshold'. +*/ ); + + DEFVAR_INT ("gc-incremental-traversal-threshold", + &gc_incremental_traversal_threshold /* +*Number of elements processed in one cycle of incremental travesal. +*/ ); +#endif /* NEW_GC */ + + DEFVAR_BOOL ("purify-flag", &purify_flag /* +Non-nil means loading Lisp code in order to dump an executable. +This means that certain objects should be allocated in readonly space. +*/ ); + + DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages /* + Non-nil means display messages at start and end of garbage collection. +*/ ); + garbage_collection_messages = 0; + + DEFVAR_LISP ("pre-gc-hook", &Vpre_gc_hook /* +Function or functions to be run just before each garbage collection. +Interrupts, garbage collection, and errors are inhibited while this hook +runs, so be extremely careful in what you add here. In particular, avoid +consing, and do not interact with the user. +*/ ); + Vpre_gc_hook = Qnil; + + DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook /* +Function or functions to be run just after each garbage collection. +Interrupts, garbage collection, and errors are inhibited while this hook +runs. Each hook is called with one argument which is an alist with +finalization data. +*/ ); + Vpost_gc_hook = Qnil; + + DEFVAR_LISP ("gc-message", &Vgc_message /* +String to print to indicate that a garbage collection is in progress. +This is printed in the echo area. If the selected frame is on a +window system and `gc-pointer-glyph' specifies a value (i.e. a pointer +image instance) in the domain of the selected frame, the mouse pointer +will change instead of this message being printed. +*/ ); + Vgc_message = build_string (gc_default_message); + + DEFVAR_LISP ("gc-pointer-glyph", &Vgc_pointer_glyph /* +Pointer glyph used to indicate that a garbage collection is in progress. +If the selected window is on a window system and this glyph specifies a +value (i.e. a pointer image instance) in the domain of the selected +window, the pointer will be changed as specified during garbage collection. +Otherwise, a message will be printed in the echo area, as controlled +by `gc-message'. +*/ ); + +#ifdef NEW_GC + DEFVAR_BOOL ("allow-incremental-gc", &allow_incremental_gc /* +*Non-nil means to allow incremental garbage collection. Nil prevents +*incremental garbage collection, the garbage collector then only does +*full collects (even if (gc-incremental) is called). +*/ ); +#endif /* NEW_GC */ +} + +void +complex_vars_of_gc (void) +{ + Vgc_pointer_glyph = Fmake_glyph_internal (Qpointer); +} diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/gc.h newgc-xemacs-21.5/src/gc.h --- xemacs-21.5/src/gc.h 1970-01-01 01:00:00.000000000 +0100 +++ newgc-xemacs-21.5/src/gc.h 2005-11-20 13:16:56.000000000 +0100 ＠＠ -0,0 +1,179 ＠＠ +/* New incremental garbage collector for XEmacs. + Copyright (C) 2005 Marcus Crestani. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#ifndef INCLUDED_gc_h_ +#define INCLUDED_gc_h_ + +BEGIN_C_DECLS + + +#ifdef NEW_GC +/************************************************************************/ +/* Incremental Statistics */ +/************************************************************************/ +#ifdef ERROR_CHECK_GC +void gc_stat_print_stats (void); +void gc_stat_finalized (void); +void gc_stat_freed (void); +void gc_stat_explicitly_freed (void); +void gc_stat_explicitly_tried_freed (void); +# define GC_STAT_FINALIZED gc_stat_finalized () +# define GC_STAT_FREED gc_stat_freed () +# define GC_STAT_EXPLICITLY_FREED gc_stat_explicitly_freed () +# define GC_STAT_EXPLICITLY_TRIED_FREED gc_stat_explicitly_tried_freed () +#else /* not ERROR_CHECK_GC */ +# define GC_STAT_FINALIZED +# define GC_STAT_FREED +# define GC_STAT_EXPLICITLY_FREED +# define GC_STAT_EXPLICITLY_TRIED_FREED +#endif /* not ERROR_CHECK_GC */ +#endif /* not NEW_GC */ + + +/************************************************************************/ +/* Global Variables */ +/************************************************************************/ +/* Number of bytes of consing done since the last GC. */ +extern EMACS_INT consing_since_gc; + +/* Number of bytes of consing done since startup. */ +extern EMACS_UINT total_consing; + +/* Number of bytes of current allocated heap objects. */ +extern EMACS_INT total_gc_usage; + +/* If the above is set. */ +extern int total_gc_usage_set; + +/* Number of bytes of consing since gc before another gc should be done. */ +extern EMACS_INT gc_cons_threshold; + +/* Percentage of consing of total data size before another GC. */ +extern EMACS_INT gc_cons_percentage; + +#ifdef NEW_GC +/* Number of bytes of consing since gc before another cycle of the gc + should be done in incremental mode. */ +extern EMACS_INT gc_cons_incremental_threshold; + +/* Nonzero during gc */ +extern int gc_in_progress; + +/* Nonzero during write barrier */ +extern int write_barrier_enabled; + +/* Enable/disable incremental garbage collection during runtime. */ +extern int allow_incremental_gc; +#endif /* NEW_GC */ + + +/************************************************************************/ +/* Prototypes */ +/************************************************************************/ + +#ifndef MALLOC_OVERHEAD +#ifdef GNU_MALLOC +#define MALLOC_OVERHEAD 0 +#elif defined (rcheck) +#define MALLOC_OVERHEAD 20 +#else +#define MALLOC_OVERHEAD 8 +#endif +#endif /* MALLOC_OVERHEAD */ + +#ifdef ERROR_CHECK_GC +#define GC_CHECK_LHEADER_INVARIANTS(lheader) do { \ + struct lrecord_header * GCLI_lh = (lheader); \ + assert (GCLI_lh != 0); \ + assert (GCLI_lh->type < (unsigned int) lrecord_type_count); \ +} while (0) +#else +#define GC_CHECK_LHEADER_INVARIANTS(lheader) +#endif + +void recompute_need_to_garbage_collect (void); + + +/* KKCC mark algorithm. */ +#ifdef DEBUG_XEMACS +void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos); +#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ + kkcc_gc_stack_push_lisp_object_1 (obj, level, pos) +void kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj, int level, int pos); +#define kkcc_gc_stack_repush_dirty_object(obj) \ + kkcc_gc_stack_repush_dirty_object_1 (obj, 0, -2) +void kkcc_backtrace (void); +#else +void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj); +#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \ + kkcc_gc_stack_push_lisp_object_1 (obj) +void kkcc_gc_stack_repush_dirty_object_1 (Lisp_Object obj); +#define kkcc_gc_stack_repush_dirty_object(obj) \ + kkcc_gc_stack_repush_dirty_object_1 (obj) +#define kkcc_backtrace() +#endif + +#ifdef NEW_GC + +/* Repush objects that are caught by the write barrier. */ +#define gc_write_barrier(obj) kkcc_gc_stack_repush_dirty_object (obj); + + +/* GC functions: */ + +/* Perform a full garbage collection without interruption. If an + incremental garbage collection is already running it is completed + without further interruption. This function calls gc() with a + negative or zero argument. */ +void gc_full (void); + +/* This function starts an incremental garbage collection. If an + incremental garbage collection is already running, the next cycle + of traversal work is done, or the garbage collection is completed + when no more traversal work has to be done. This function calls gc + with a positive argument, indicating how many objects can be + traversed in this cycle. */ +void gc_incremental (void); +#endif /* NEW_GC */ + +/* Initializers */ +void init_gc_early (void); +void reinit_gc_early (void); +void init_gc_once_early (void); + +void syms_of_gc (void); +void vars_of_gc (void); +void complex_vars_of_gc (void); + +#ifndef NEW_GC +/* Needed prototypes due to the garbage collector code move from + alloc.c to gc.c. */ +void gc_sweep_1 (void); + +#ifndef MC_ALLOC +extern void *breathing_space; +#endif /* not MC_ALLOC */ +#endif /* not NEW_GC */ + +END_C_DECLS + +#endif /* INCLUDED_gc_h_ */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/.gdbinit.in newgc-xemacs-21.5/src/.gdbinit.in --- xemacs-21.5/src/.gdbinit.in 1970-01-01 01:00:00.000000000 +0100 +++ newgc-xemacs-21.5/src/.gdbinit.in 2005-07-28 21:02:35.000000000 +0200 ＠＠ -0,0 +1,529 ＠＠ +## -*- ksh -*- +## Copyright (C) 1998 Free Software Foundation, Inc. + +## This file is part of XEmacs. + +## XEmacs is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by the +## Free Software Foundation; either version 2, or (at your option) any +## later version. + +## XEmacs is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +## for more details. + +## You should have received a copy of the GNU General Public License +## along with XEmacs; see the file COPYING. If not, write to +## the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +## Boston, MA 02111-1307, USA. + +## Author: Martin Buchholz + +## Some useful commands for debugging emacs with gdb 4.16 or better. +## +## Since this file is called `.gdbinit', it will be read by gdb +## automatically when gdb is run in the build directory, which is where +## developers usually debug their xemacs. You can also source this +## file from your ~/.gdbinit, if you like. +## +## Configure xemacs with --debug, and compile with -g. +## +## See also the question of the XEmacs FAQ, titled +## "How to Debug an XEmacs problem with a debugger". +## +## This can be used to debug XEmacs no matter how the following are +## specified: + +## USE_UNION_TYPE + +## (the above all have configure equivalents) + +## Some functions defined here require a running process, but most +## don't. Considerable effort has been expended to this end. + +## See the dbg_ C support code in src/alloc.c that allows the functions +## defined in this file to work correctly. + +#define NOT_C_CODE +#include "config.h" + +set print union off +set print pretty off + +#ifdef VDB_POSIX +handle SIGSEGV SIGBUS nostop noprint +#endif + +set $Lisp_Type_Int = -2 + +define decode_object + set $obj = (unsigned long) $arg0 + if $obj & 1 + ## It's an int + set $val = $obj >> 1 + set $type = $Lisp_Type_Int + else + set $type = $obj & dbg_typemask + if $type == Lisp_Type_Char + set $val = ($obj & dbg_valmask) >> dbg_gctypebits + else + ## It's a record pointer + set $val = $obj + end + end + + if $type == Lisp_Type_Record + set $lheader = ((struct lrecord_header *) $val) + set $lrecord_type = ($lheader->type) + set $imp = ((struct lrecord_implementation *) lrecord_implementations_table[(int) $lrecord_type]) + else + set $lrecord_type = -1 + set $lheader = -1 + set $imp = -1 + end +end + +document decode_object +Usage: decode_object lisp_object +Extract implementation information from a Lisp Object. +Defines variables $val, $type and $imp. +end + +define xint +decode_object $arg0 +print ((long) $val) +end + +define xtype + decode_object $arg0 + if $type == $Lisp_Type_Int + echo int\n + else + if $type == Lisp_Type_Char + echo char\n + else + printf "record type: %s\n", $imp->name + end + end +end + +document xtype +Usage: xtype lisp_object +Print the Lisp type of a lisp object. +end + +define lisp-shadows + run -batch -vanilla -f list-load-path-shadows +end + +document lisp-shadows +Usage: lisp-shadows +Run xemacs to check for lisp shadows +end + +define environment-to-run-temacs + unset env EMACSLOADPATH + set env EMACSBOOTSTRAPLOADPATH=../lisp/:.. + set env EMACSBOOTSTRAPMODULEPATH=../modules/:.. +end + +define run-temacs + environment-to-run-temacs + run -nd -batch -l ../lisp/loadup.el run-temacs -q +end + +document run-temacs +Usage: run-temacs +Run temacs interactively, like xemacs. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. +end + +define check-xemacs + run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated +end + +document check-xemacs +Usage: check-xemacs +Run the test suite. Equivalent to 'make check'. +end + +define check-temacs + environment-to-run-temacs + run -nd -batch -l ../lisp/loadup.el run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated +end + +document check-temacs +Usage: check-temacs +Run the test suite on temacs. Equivalent to 'make check-temacs'. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. +end + +define update-elc + environment-to-run-temacs + run -nd -batch -l ../lisp/update-elc.el +end + +document update-elc +Usage: update-elc +Run the core lisp byte compilation part of the build procedure. +Use when debugging temacs, not xemacs! +Use this when temacs builds successfully, but xemacs does not. +end + +define dmp + environment-to-run-temacs + run -nd -batch -l ../lisp/loadup.el dump +end + +document dmp +Usage: dmp +Run the dumping part of the build procedure. +Use when debugging temacs, not xemacs! +Use this when temacs builds successfully, but xemacs does not. +end + +define ldp + printf "%s", "Lisp => " + call debug_print($arg0) +end + +document ldp +Usage: ldp lisp_object +Print a Lisp Object value using the Lisp printer. +Requires a running xemacs process. +end + +define lbt +call debug_backtrace() +end + +document lbt +Usage: lbt +Print the current Lisp stack trace. +Requires a running xemacs process. +end + + +define leval +ldp Feval(Fcar(Fread_from_string(build_string($arg0),Qnil,Qnil))) +end + +document leval +Usage: leval "SEXP" +Eval a lisp expression. +Requires a running xemacs process. + +Example: +(gdb) leval "(+ 1 2)" +Lisp ==> 3 +end + + +define wtype +print $arg0->core.widget_class->core_class.class_name +end + +define xtname +print XrmQuarkToString(((Object)($arg0))->object.xrm_name) +end + +## GDB's command language makes you want to ... + +define pptype + set $type_ptr = ($arg0 *) $val + print $type_ptr + print *$type_ptr +end + +define pstructtype + set $type_ptr = (struct $arg0 *) $val + print $type_ptr + print *$type_ptr +end + +define pobj + decode_object $arg0 + if $type == $Lisp_Type_Int + printf "Integer: %d\n", $val + else + if $type == Lisp_Type_Char + if $val > 32 && $val < 128 + printf "Char: %c\n", $val + else + printf "Char: %d\n", $val + end + else + if $lrecord_type == lrecord_type_string + pptype Lisp_String + else + if $lrecord_type == lrecord_type_cons + pptype Lisp_Cons + else + if $lrecord_type == lrecord_type_symbol + pptype Lisp_Symbol + printf "Symbol name: %s\n", ((Lisp_String *)$type_ptr->name)->data_ + else + if $lrecord_type == lrecord_type_vector + pptype Lisp_Vector + printf "Vector of length %d\n", $type_ptr->size + ##print *($type_ptr->data) ＠ $type_ptr->size + else + if $lrecord_type == lrecord_type_bit_vector + pptype Lisp_Bit_Vector + else + if $lrecord_type == lrecord_type_buffer + pstructtype buffer + else + if $lrecord_type == lrecord_type_char_table + pptype Lisp_Char_Table + else + if $lrecord_type == lrecord_type_char_table_entry + pptype Lisp_Char_Table_Entry + else + if $lrecord_type == lrecord_type_charset + pptype Lisp_Charset + else + if $lrecord_type == lrecord_type_coding_system + pptype Lisp_Coding_System + else + if $lrecord_type == lrecord_type_color_instance + pptype Lisp_Color_Instance + else + if $lrecord_type == lrecord_type_command_builder + pptype command_builder + else + if $lrecord_type == lrecord_type_compiled_function + pptype Lisp_Compiled_Function + else + if $lrecord_type == lrecord_type_console + pstructtype console + else + if $lrecord_type == lrecord_type_database + pptype Lisp_Database + else + if $lrecord_type == lrecord_type_device + pstructtype device + else + if $lrecord_type == lrecord_type_event + pptype Lisp_Event + else + if $lrecord_type == lrecord_type_extent + pstructtype extent + else + if $lrecord_type == lrecord_type_extent_auxiliary + pstructtype extent_auxiliary + else + if $lrecord_type == lrecord_type_extent_info + pstructtype extent_info + else + if $lrecord_type == lrecord_type_face + pptype Lisp_Face + else + if $lrecord_type == lrecord_type_float + pptype Lisp_Float + else + if $lrecord_type == lrecord_type_font_instance + pptype Lisp_Font_Instance + else + if $lrecord_type == lrecord_type_frame + pstructtype frame + else + if $lrecord_type == lrecord_type_glyph + pptype Lisp_Glyph + else + if $lrecord_type == lrecord_type_gui_item + pptype Lisp_Gui_Item + else + if $lrecord_type == lrecord_type_hash_table + pptype Lisp_Hash_Table + else + if $lrecord_type == lrecord_type_image_instance + pptype Lisp_Image_Instance + else + if $lrecord_type == lrecord_type_keymap + pptype Lisp_Keymap + else + if $lrecord_type == lrecord_type_lcrecord_list + pstructtype lcrecord_list + else + if $lrecord_type == lrecord_type_ldap + pptype Lisp_LDAP + else + if $lrecord_type == lrecord_type_lstream + pstructtype lstream + else + if $lrecord_type == lrecord_type_marker + pptype Lisp_Marker + else + if $lrecord_type == lrecord_type_opaque + pptype Lisp_Opaque + else + if $lrecord_type == lrecord_type_opaque_ptr + pptype Lisp_Opaque_Ptr + else + if $lrecord_type == lrecord_type_popup_data + pptype popup_data + else + if $lrecord_type == lrecord_type_process + pptype Lisp_Process + else + if $lrecord_type == lrecord_type_range_table + pptype Lisp_Range_Table + else + if $lrecord_type == lrecord_type_specifier + pptype Lisp_Specifier + else + if $lrecord_type == lrecord_type_subr + pptype Lisp_Subr + else + if $lrecord_type == lrecord_type_symbol_value_buffer_local + pstructtype symbol_value_buffer_local + else + if $lrecord_type == lrecord_type_symbol_value_forward + pstructtype symbol_value_forward + else + if $lrecord_type == lrecord_type_symbol_value_lisp_magic + pstructtype symbol_value_lisp_magic + else + if $lrecord_type == lrecord_type_symbol_value_varalias + pstructtype symbol_value_varalias + else + if $lrecord_type == lrecord_type_timeout + pptype Lisp_Timeout + else + if $lrecord_type == lrecord_type_toolbar_button + pstructtype toolbar_button + else + if $lrecord_type == lrecord_type_tooltalk_message + pptype Lisp_Tooltalk_Message + else + if $lrecord_type == lrecord_type_tooltalk_pattern + pptype Lisp_Tooltalk_Pattern + else + if $lrecord_type == lrecord_type_weak_list + pstructtype weak_list + else + if $lrecord_type == lrecord_type_window + pstructtype window + else + if $lrecord_type == lrecord_type_window_configuration + pstructtype window_config + else + if $lrecord_type == lrecord_type_fc_pattern + pstructtype fc_pattern + else + if $lrecord_type == lrecord_type_fc_objectset + pstructtype fc_objectset + else + if $lrecord_type == lrecord_type_fc_fontset + pstructtype fc_fontset + else + echo Unknown Lisp Object type\n + print $arg0 + ## Barf, gag, retch + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + ## Repeat after me... gdb sux, gdb sux, gdb sux... + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + ## Are we having fun yet?? + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end +end + +document pobj +Usage: pobj lisp_object +Print the internal C representation of a Lisp Object. +end + +## ------------------------------------------------------------- +## functions to test the debugging support itself. +## If you change this file, make sure the following still work... +## ------------------------------------------------------------- +define test_xtype + printf "Vemacs_major_version: " + xtype Vemacs_major_version + printf "Vhelp_char: " + xtype Vhelp_char + printf "Qnil: " + xtype Qnil + printf "Qunbound: " + xtype Qunbound + printf "Vobarray: " + xtype Vobarray + printf "Vall_weak_lists: " + xtype Vall_weak_lists + printf "Vxemacs_codename: " + xtype Vxemacs_codename +end + +define test_pobj + printf "Vemacs_major_version: " + pobj Vemacs_major_version + printf "Vhelp_char: " + pobj Vhelp_char + printf "Qnil: " + pobj Qnil + printf "Qunbound: " + pobj Qunbound + printf "Vobarray: " + pobj Vobarray + printf "Vall_weak_lists: " + pobj Vall_weak_lists + printf "Vxemacs_codename: " + pobj Vxemacs_codename +end + diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/glyphs.c newgc-xemacs-21.5/src/glyphs.c --- xemacs-21.5/src/glyphs.c 2005-10-24 12:07:37.000000000 +0200 +++ newgc-xemacs-21.5/src/glyphs.c 2005-11-02 01:09:31.000000000 +0100 ＠＠ -4540,10 +4540,12 ＠＠ expose events that are going to come and ignore them as required. */ +#ifndef NEW_GC struct expose_ignore_blocktype { Blocktype_declare (struct expose_ignore); } *the_expose_ignore_blocktype; +#endif /* not NEW_GC */ int check_for_ignored_expose (struct frame* f, int x, int y, int width, int height) ＠＠ -4574,7 +4576,11 ＠＠ if (ei == f->subwindow_exposures_tail) f->subwindow_exposures_tail = prev; +#ifdef NEW_GC + mc_free (ei); +#else /* not NEW_GC */ Blocktype_free (the_expose_ignore_blocktype, ei); +#endif /* not NEW_GC */ return 1; } prev = ei; ＠＠ -4589,7 +4595,11 ＠＠ { struct expose_ignore *ei; +#ifdef NEW_GC + ei = alloc_lrecord_type (struct expose_ignore, &lrecord_expose_ignore); +#else /* not NEW_GC */ ei = Blocktype_alloc (the_expose_ignore_blocktype); +#endif /* not NEW_GC */ ei->next = NULL; ei->x = x; ＠＠ -5430,8 +5440,10 ＠＠ void reinit_vars_of_glyphs (void) { +#ifndef NEW_GC the_expose_ignore_blocktype = Blocktype_new (struct expose_ignore_blocktype); +#endif /* not NEW_GC */ hold_ignored_expose_registration = 0; } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/glyphs.h newgc-xemacs-21.5/src/glyphs.h --- xemacs-21.5/src/glyphs.h 2005-10-24 12:07:37.000000000 +0200 +++ newgc-xemacs-21.5/src/glyphs.h 2005-11-02 01:10:04.000000000 +0100 ＠＠ -1067,6 +1067,9 ＠＠ typedef struct glyph_cachel glyph_cachel; struct glyph_cachel { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* not NEW_GC */ Lisp_Object glyph; unsigned int dirty :1; /* I'm copying faces here. I'm not ＠＠ -1082,6 +1085,19 ＠＠ unsigned short descent; }; +#ifdef NEW_GC +typedef struct glyph_cachel Lisp_Glyph_Cachel; + +DECLARE_LRECORD (glyph_cachel, Lisp_Glyph_Cachel); + +#define XGLYPH_CACHEL(x) \ + XRECORD (x, glyph_cachel, Lisp_Glyph_Cachel) +#define wrap_glyph_cachel(p) wrap_record (p, glyph_cachel) +#define GLYPH_CACHEL_P(x) RECORDP (x, glyph_cachel) +#define CHECK_GLYPH_CACHEL(x) CHECK_RECORD (x, glyph_cachel) +#define CONCHECK_GLYPH_CACHEL(x) CONCHECK_RECORD (x, glyph_cachel) +#endif /* NEW_GC */ + #define CONT_GLYPH_INDEX (glyph_index) 0 #define TRUN_GLYPH_INDEX (glyph_index) 1 #define HSCROLL_GLYPH_INDEX (glyph_index) 2 ＠＠ -1179,11 +1195,23 ＠＠ struct expose_ignore { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ int x, y; int width, height; struct expose_ignore *next; }; +#ifdef NEW_GC +DECLARE_LRECORD (expose_ignore, struct expose_ignore); +#define XEXPOSE_IGNORE(x) XRECORD (x, expose_ignore, struct expose_ignore) +#define wrap_expose_ignore(p) wrap_record (p, expose_ignore) +#define EXPOSE_IGNOREP(x) RECORDP (x, expose_ignore) +#define CHECK_EXPOSE_IGNORE(x) CHECK_RECORD (x, expose_ignore) +#define CONCHECK_EXPOSE_IGNORE(x) CONCHECK_RECORD (x, expose_ignore) +#endif /* NEW_GC */ + int check_for_ignored_expose (struct frame* f, int x, int y, int width, int height); extern int hold_ignored_expose_registration; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/lisp.h newgc-xemacs-21.5/src/lisp.h --- xemacs-21.5/src/lisp.h 2005-11-20 16:26:22.000000000 +0100 +++ newgc-xemacs-21.5/src/lisp.h 2005-11-22 10:06:52.000000000 +0100 ＠＠ -1253,6 +1253,7 ＠＠ /* ------------------------ dynamic arrays ------------------- */ +#ifndef NEW_GC #ifdef ERROR_CHECK_STRUCTURES #define Dynarr_declare(type) \ type *base; \ ＠＠ -1380,6 +1381,7 ＠＠ void *stack_like_malloc (Bytecount size); void stack_like_free (void *val); +#endif /* not NEW_GC */ /************************************************************************/ /** Definitions of more complex types **/ ＠＠ -1466,6 +1468,7 ＠＠ typedef struct Lisp_Image_Instance Lisp_Image_Instance; /* glyphs.h */ typedef struct Lisp_Gui_Item Lisp_Gui_Item; +#ifndef NEW_GC /* ------------------------------- */ /* Dynarr typedefs */ /* ------------------------------- */ ＠＠ -1550,6 +1553,7 ＠＠ { Dynarr_declare (struct console_type_entry); } console_type_entry_dynarr; +#endif /* not NEW_GC */ /* ------------------------------- */ /* enum typedefs */ ＠＠ -1666,6 +1670,7 ＠＠ #define XPNTR(x) ((void *) XPNTRVAL(x)) +#ifndef NEW_GC /* WARNING WARNING WARNING. You must ensure on your own that proper GC protection is provided for the elements in this array. */ typedef struct ＠＠ -1677,6 +1682,7 ＠＠ { Dynarr_declare (Lisp_Object *); } Lisp_Object_ptr_dynarr; +#endif /* not NEW_GC */ /* Close your eyes now lest you vomit or spontaneously combust ... */ ＠＠ -1707,6 +1713,284 ＠＠ BEGIN_C_DECLS +#ifdef NEW_GC +/* ------------------------ dynamic arrays ------------------- */ + +#ifdef ERROR_CHECK_STRUCTURES +#define Dynarr_declare(type) \ + struct lrecord_header header; \ + type *base; \ + const struct lrecord_implementation *lisp_imp; \ + int locked; \ + int elsize; \ + int cur; \ + int largest; \ + int max +#else +#define Dynarr_declare(type) \ + struct lrecord_header header; \ + type *base; \ + const struct lrecord_implementation *lisp_imp; \ + int elsize; \ + int cur; \ + int largest; \ + int max +#endif /* ERROR_CHECK_STRUCTURES */ + +typedef struct dynarr +{ + Dynarr_declare (void); +} Dynarr; + +MODULE_API void *Dynarr_newf (int elsize); +MODULE_API void Dynarr_resize (void *dy, Elemcount size); +MODULE_API void Dynarr_insert_many (void *d, const void *el, int len, int start); +MODULE_API void Dynarr_delete_many (void *d, int start, int len); +MODULE_API void Dynarr_free (void *d); + +MODULE_API void *Dynarr_lisp_newf (int elsize, + const struct lrecord_implementation + *dynarr_imp, + const struct lrecord_implementation *imp); + +#define Dynarr_lisp_new(type, dynarr_imp, imp) \ + ((type##_dynarr *) Dynarr_lisp_newf (sizeof (type), dynarr_imp, imp)) +#define Dynarr_lisp_new2(dynarr_type, type, dynarr_imp, imp) \ + ((dynarr_type *) Dynarr_lisp_newf (sizeof (type)), dynarr_imp, imp) +#define Dynarr_new(type) ((type##_dynarr *) Dynarr_newf (sizeof (type))) +#define Dynarr_new2(dynarr_type, type) \ + ((dynarr_type *) Dynarr_newf (sizeof (type))) +#define Dynarr_at(d, pos) ((d)->base[pos]) +#define Dynarr_atp(d, pos) (&Dynarr_at (d, pos)) +#define Dynarr_begin(d) Dynarr_atp (d, 0) +#define Dynarr_end(d) Dynarr_atp (d, Dynarr_length (d) - 1) +#define Dynarr_sizeof(d) ((d)->cur * (d)->elsize) + +#ifdef ERROR_CHECK_STRUCTURES +DECLARE_INLINE_HEADER ( +Dynarr * +Dynarr_verify_1 (void *d, const Ascbyte *file, int line) +) +{ + Dynarr *dy = (Dynarr *) d; + assert_at_line (dy->cur >= 0 && dy->cur <= dy->largest && + dy->largest <= dy->max, file, line); + return dy; +} + +DECLARE_INLINE_HEADER ( +Dynarr * +Dynarr_verify_mod_1 (void *d, const Ascbyte *file, int line) +) +{ + Dynarr *dy = (Dynarr *) d; + assert_at_line (!dy->locked, file, line); + assert_at_line (dy->cur >= 0 && dy->cur <= dy->largest && + dy->largest <= dy->max, file, line); + return dy; +} + +#define Dynarr_verify(d) Dynarr_verify_1 (d, __FILE__, __LINE__) +#define Dynarr_verify_mod(d) Dynarr_verify_mod_1 (d, __FILE__, __LINE__) +#define Dynarr_lock(d) (Dynarr_verify_mod (d)->locked = 1) +#define Dynarr_unlock(d) ((d)->locked = 0) +#else +#define Dynarr_verify(d) (d) +#define Dynarr_verify_mod(d) (d) +#define Dynarr_lock(d) +#define Dynarr_unlock(d) +#endif /* ERROR_CHECK_STRUCTURES */ + +#define Dynarr_length(d) (Dynarr_verify (d)->cur) +#define Dynarr_largest(d) (Dynarr_verify (d)->largest) +#define Dynarr_reset(d) (Dynarr_verify_mod (d)->cur = 0) +#define Dynarr_add_many(d, el, len) Dynarr_insert_many (d, el, len, (d)->cur) +#define Dynarr_insert_many_at_start(d, el, len) \ + Dynarr_insert_many (d, el, len, 0) +#define Dynarr_add_literal_string(d, s) Dynarr_add_many (d, s, sizeof (s) - 1) +#define Dynarr_add_lisp_string(d, s, codesys) \ +do { \ + Lisp_Object dyna_ls_s = (s); \ + Lisp_Object dyna_ls_cs = (codesys); \ + Extbyte *dyna_ls_eb; \ + Bytecount dyna_ls_bc; \ + \ + LISP_STRING_TO_SIZED_EXTERNAL (dyna_ls_s, dyna_ls_eb, \ + dyna_ls_bc, dyna_ls_cs); \ + Dynarr_add_many (d, dyna_ls_eb, dyna_ls_bc); \ +} while (0) + +#if 1 +#define Dynarr_add(d, el) \ +do { \ + if (Dynarr_verify_mod (d)->cur >= (d)->max) \ + Dynarr_resize ((d), (d)->cur+1); \ + ((d)->base)[(d)->cur] = (el); \ + \ + if ((d)->lisp_imp) \ + set_lheader_implementation \ + ((struct lrecord_header *)&(((d)->base)[(d)->cur]), \ + (d)->lisp_imp); \ + \ + (d)->cur++; \ + if ((d)->cur > (d)->largest) \ + (d)->largest = (d)->cur; \ +} while (0) +#else +#define Dynarr_add(d, el) ( \ + Dynarr_verify_mod (d)->cur >= (d)->max ? Dynarr_resize ((d), (d)->cur+1) : \ + (void) 0, \ + ((d)->base)[(d)->cur++] = (el), \ + (d)->cur > (d)->largest ? (d)->largest = (d)->cur : (int) 0) +#endif + + +/* The following defines will get you into real trouble if you aren't + careful. But they can save a lot of execution time when used wisely. */ +#define Dynarr_increment(d) (Dynarr_verify_mod (d)->cur++) +#define Dynarr_set_size(d, n) (Dynarr_verify_mod (d)->cur = n) + +#define Dynarr_pop(d) \ + (assert ((d)->cur > 0), Dynarr_verify_mod (d)->cur--, \ + Dynarr_at (d, (d)->cur)) +#define Dynarr_delete(d, i) Dynarr_delete_many (d, i, 1) +#define Dynarr_delete_by_pointer(d, p) \ + Dynarr_delete_many (d, (p) - ((d)->base), 1) + +#define Dynarr_delete_object(d, el) \ +do \ +{ \ + REGISTER int i; \ + for (i = Dynarr_length (d) - 1; i >= 0; i--) \ + { \ + if (el == Dynarr_at (d, i)) \ + Dynarr_delete_many (d, i, 1); \ + } \ +} while (0) + +#ifdef MEMORY_USAGE_STATS +struct overhead_stats; +Bytecount Dynarr_memory_usage (void *d, struct overhead_stats *stats); +#endif + +void *stack_like_malloc (Bytecount size); +void stack_like_free (void *val); + +/* ------------------------------- */ +/* Dynarr typedefs */ +/* ------------------------------- */ + +/* Dynarr typedefs -- basic types first */ + +typedef struct +{ + Dynarr_declare (Ibyte); +} Ibyte_dynarr; + +typedef struct +{ + Dynarr_declare (Extbyte); +} Extbyte_dynarr; + +typedef struct +{ + Dynarr_declare (Ichar); +} Ichar_dynarr; + +typedef struct +{ + Dynarr_declare (char); +} char_dynarr; + +typedef struct +{ + Dynarr_declare (char *); +} char_ptr_dynarr; + +typedef unsigned char unsigned_char; +typedef struct +{ + Dynarr_declare (unsigned char); +} unsigned_char_dynarr; + +typedef unsigned long unsigned_long; +typedef struct +{ + Dynarr_declare (unsigned long); +} unsigned_long_dynarr; + +typedef struct +{ + Dynarr_declare (int); +} int_dynarr; + +typedef struct +{ + Dynarr_declare (Charbpos); +} Charbpos_dynarr; + +typedef struct +{ + Dynarr_declare (Bytebpos); +} Bytebpos_dynarr; + +typedef struct +{ + Dynarr_declare (Charcount); +} Charcount_dynarr; + +typedef struct +{ + Dynarr_declare (Bytecount); +} Bytecount_dynarr; + +/* Dynarr typedefs -- more complex types */ + +typedef struct +{ + Dynarr_declare (struct face_cachel); +} face_cachel_dynarr; + +DECLARE_LRECORD (face_cachel_dynarr, face_cachel_dynarr); +#define XFACE_CACHEL_DYNARR(x) \ + XRECORD (x, face_cachel_dynarr, face_cachel_dynarr) +#define wrap_face_cachel_dynarr(p) wrap_record (p, face_cachel_dynarr) +#define FACE_CACHEL_DYNARRP(x) RECORDP (x, face_cachel_dynarr) +#define CHECK_FACE_CACHEL_DYNARR(x) CHECK_RECORD (x, face_cachel_dynarr) +#define CONCHECK_FACE_CACHEL_DYNARR(x) CONCHECK_RECORD (x, face_cachel_dynarr) + +typedef struct +{ + Dynarr_declare (struct glyph_cachel); +} glyph_cachel_dynarr; + +DECLARE_LRECORD (glyph_cachel_dynarr, glyph_cachel_dynarr); +#define XGLYPH_CACHEL_DYNARR(x) \ + XRECORD (x, glyph_cachel_dynarr, glyph_cachel_dynarr) +#define wrap_glyph_cachel_dynarr(p) wrap_record (p, glyph_cachel_dynarr) +#define GLYPH_CACHEL_DYNARRP(x) RECORDP (x, glyph_cachel_dynarr) +#define CHECK_GLYPH_CACHEL_DYNARR(x) CHECK_RECORD (x, glyph_cachel_dynarr) +#define CONCHECK_GLYPH_CACHEL_DYNARR(x) \ + CONCHECK_RECORD (x, glyph_cachel_dynarr) + +typedef struct +{ + Dynarr_declare (struct console_type_entry); +} console_type_entry_dynarr; + +/* WARNING WARNING WARNING. You must ensure on your own that proper + GC protection is provided for the elements in this array. */ +typedef struct +{ + Dynarr_declare (Lisp_Object); +} Lisp_Object_dynarr; + +typedef struct +{ + Dynarr_declare (Lisp_Object *); +} Lisp_Object_ptr_dynarr; +#endif /* NEW_GC */ + /*------------------------------ unbound -------------------------------*/ /* Qunbound is a special Lisp_Object (actually of type ＠＠ -2282,6 +2566,67 ＠＠ /*------------------------------ string --------------------------------*/ +#ifdef NEW_GC +struct Lisp_String_Direct_Data +{ + struct lrecord_header header; + Bytecount size; + Ibyte data[1]; +}; +typedef struct Lisp_String_Direct_Data Lisp_String_Direct_Data; + +DECLARE_MODULE_API_LRECORD (string_direct_data, Lisp_String_Direct_Data); +#define XSTRING_DIRECT_DATA(x) \ + XRECORD (x, string_direct_data, Lisp_String_Direct_Data) +#define wrap_string_direct_data(p) wrap_record (p, string_direct_data) +#define STRING_DIRECT_DATAP(x) RECORDP (x, string_direct_data) +#define CHECK_STRING_DIRECT_DATA(x) CHECK_RECORD (x, string_direct_data) +#define CONCHECK_STRING_DIRECT_DATA(x) CONCHECK_RECORD (x, string_direct_data) + +#define XSTRING_DIRECT_DATA_SIZE(x) XSTRING_DIRECT_DATA (x)->size +#define XSTRING_DIRECT_DATA_DATA(x) XSTRING_DIRECT_DATA (x)->data + + +struct Lisp_String_Indirect_Data +{ + struct lrecord_header header; + Bytecount size; + Ibyte *data; +}; +typedef struct Lisp_String_Indirect_Data Lisp_String_Indirect_Data; + +DECLARE_MODULE_API_LRECORD (string_indirect_data, Lisp_String_Indirect_Data); +#define XSTRING_INDIRECT_DATA(x) \ + XRECORD (x, string_indirect_data, Lisp_String_Indirect_Data) +#define wrap_string_indirect_data(p) wrap_record (p, string_indirect_data) +#define STRING_INDIRECT_DATAP(x) RECORDP (x, string_indirect_data) +#define CHECK_STRING_INDIRECT_DATA(x) CHECK_RECORD (x, string_indirect_data) +#define CONCHECK_STRING_INDIRECT_DATA(x) \ + CONCHECK_RECORD (x, string_indirect_data) + +#define XSTRING_INDIRECT_DATA_SIZE(x) XSTRING_INDIRECT_DATA (x)->size +#define XSTRING_INDIRECT_DATA_DATA(x) XSTRING_INDIRECT_DATA (x)->data + + +#define XSTRING_DATA_SIZE(s) ((s)->indirect)? \ + XSTRING_INDIRECT_DATA_SIZE ((s)->data_object): \ + XSTRING_DIRECT_DATA_SIZE ((s)->data_object) +#define XSTRING_DATA_DATA(s) ((s)->indirect)? \ + XSTRING_INDIRECT_DATA_DATA ((s)->data_object): \ + XSTRING_DIRECT_DATA_DATA ((s)->data_object) + +#define XSET_STRING_DATA_SIZE(s, len) \ + if ((s)->indirect) \ + XSTRING_INDIRECT_DATA_SIZE ((s)->data_object) = len; \ + else \ + XSTRING_DIRECT_DATA_SIZE ((s)->data_object) = len +#define XSET_STRING_DATA_DATA(s, ptr) \ + if ((s)->indirect) \ + XSTRING_INDIRECT_DATA_DATA ((s)->data_object) = ptr; \ + else \ + XSTRING_DIRECT_DATA_DATA ((s)->data_object) = ptr +#endif /* NEW_GC */ + struct Lisp_String { union ＠＠ -2308,8 +2653,13 ＠＠ #endif /* not MC_ALLOC */ } v; } u; +#ifdef NEW_GC + int indirect; + Lisp_Object data_object; +#else /* not NEW_GC */ Bytecount size_; Ibyte *data_; +#endif /* not NEW_GC */ Lisp_Object plist; }; typedef struct Lisp_String Lisp_String; ＠＠ -2332,14 +2682,30 ＠＠ stuff there. */ /* Operations on Lisp_String *'s; only ones left */ +#ifdef NEW_GC +#define set_lispstringp_indirect(s) ((s)->indirect = 1) +#define set_lispstringp_length(s, len) XSET_STRING_DATA_SIZE (s, len) +#define set_lispstringp_data(s, ptr) XSET_STRING_DATA_DATA (s, ptr) +#else /* not NEW_GC */ #define set_lispstringp_length(s, len) ((void) ((s)->size_ = (len))) #define set_lispstringp_data(s, ptr) ((void) ((s)->data_ = (ptr))) +#endif /* not NEW_GC */ /* Operations on strings as Lisp_Objects. Don't manipulate Lisp_String *'s in any new code. */ +#ifdef NEW_GC +#define STRING_DATA_OBJECT(s) ((s)->data_object) +#define XSTRING_DATA_OBJECT(s) (STRING_DATA_OBJECT (XSTRING (s))) +#define XSTRING_LENGTH(s) (XSTRING_DATA_SIZE (XSTRING (s))) +#else /* not NEW_GC */ #define XSTRING_LENGTH(s) (XSTRING (s)->size_) +#endif /* not NEW_GC */ #define XSTRING_PLIST(s) (XSTRING (s)->plist) +#ifdef NEW_GC +#define XSTRING_DATA(s) (XSTRING_DATA_DATA (XSTRING (s))) +#else /* not NEW_GC */ #define XSTRING_DATA(s) (XSTRING (s)->data_ + 0) +#endif /* not NEW_GC */ #define XSTRING_ASCII_BEGIN(s) (XSTRING (s)->u.v.ascii_begin + 0) #define XSET_STRING_LENGTH(s, ptr) set_lispstringp_length (XSTRING (s), ptr) #define XSET_STRING_DATA(s, ptr) set_lispstringp_data (XSTRING (s), ptr) ＠＠ -3624,7 +3990,7 ＠＠ } while (0) extern Lisp_Object_ptr_dynarr *staticpros; - +extern Lisp_Object_ptr_dynarr *staticpros_nodump; #ifdef DEBUG_XEMACS /* Help debug crashes gc-marking a staticpro'ed object. */ ＠＠ -3734,7 +4100,9 ＠＠ Lisp_Object make_bit_vector (Elemcount, Lisp_Object); Lisp_Object make_bit_vector_from_byte_vector (unsigned char *, Elemcount); Lisp_Object noseeum_make_marker (void); +#ifndef NEW_GC void garbage_collect_1 (void); +#endif /* not NEW_GC */ MODULE_API Lisp_Object acons (Lisp_Object, Lisp_Object, Lisp_Object); MODULE_API Lisp_Object cons3 (Lisp_Object, Lisp_Object, Lisp_Object); MODULE_API Lisp_Object list1 (Lisp_Object); ＠＠ -3749,7 +4117,9 ＠＠ DECLARE_DOESNT_RETURN (memory_full (void)); void disksave_object_finalization (void); extern int purify_flag; +#ifndef NEW_GC extern EMACS_INT gc_generation_number[1]; +#endif /* not NEW_GC */ int c_readonly (Lisp_Object); int lisp_readonly (Lisp_Object); MODULE_API void copy_lisp_object (Lisp_Object dst, Lisp_Object src); ＠＠ -3770,6 +4140,7 ＠＠ void free_marker (Lisp_Object); int object_dead_p (Lisp_Object); void mark_object (Lisp_Object obj); +#ifndef NEW_GC #ifdef USE_KKCC #ifdef DEBUG_XEMACS void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos); ＠＠ -3783,6 +4154,7 ＠＠ #define kkcc_backtrace() #endif #endif /* USE_KKCC */ +#endif /* not NEW_GC */ int marked_p (Lisp_Object obj); extern int funcall_allocation_flag; extern int need_to_garbage_collect; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/lrecord.h newgc-xemacs-21.5/src/lrecord.h --- xemacs-21.5/src/lrecord.h 2005-11-17 00:28:19.000000000 +0100 +++ newgc-xemacs-21.5/src/lrecord.h 2005-11-20 16:54:06.000000000 +0100 ＠＠ -1,3 +1,5 ＠＠ +#define NEW_GC_REMOVE + /* The "lrecord" structure (header of a compound lisp object). Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1996, 2001, 2002, 2004, 2005 Ben Wing. ＠＠ -217,38 +219,38 ＠＠ #### This should be replaced by a symbol_value_magic_p flag in the Lisp_Symbol lrecord_header. */ lrecord_type_symbol_value_forward, /* 0 */ - lrecord_type_symbol_value_varalias, /* 1 */ - lrecord_type_symbol_value_lisp_magic, /* 2 */ - lrecord_type_symbol_value_buffer_local, /* 3 */ + lrecord_type_symbol_value_varalias, + lrecord_type_symbol_value_lisp_magic, + lrecord_type_symbol_value_buffer_local, lrecord_type_max_symbol_value_magic = lrecord_type_symbol_value_buffer_local, - lrecord_type_symbol, /* 4 */ - lrecord_type_subr, /* 5 */ - lrecord_type_cons, /* 6 */ - lrecord_type_vector, /* 7 */ - lrecord_type_string, /* 8 */ + lrecord_type_symbol, + lrecord_type_subr, + lrecord_type_cons, + lrecord_type_vector, + lrecord_type_string, #ifndef MC_ALLOC lrecord_type_lcrecord_list, #endif /* not MC_ALLOC */ - lrecord_type_compiled_function, /* 9 */ - lrecord_type_weak_list, /* 10 */ - lrecord_type_bit_vector, /* 11 */ - lrecord_type_float, /* 12 */ - lrecord_type_hash_table, /* 13 */ - lrecord_type_lstream, /* 14 */ - lrecord_type_process, /* 15 */ - lrecord_type_charset, /* 16 */ - lrecord_type_coding_system, /* 17 */ - lrecord_type_char_table, /* 18 */ - lrecord_type_char_table_entry, /* 19 */ - lrecord_type_range_table, /* 20 */ - lrecord_type_opaque, /* 21 */ - lrecord_type_opaque_ptr, /* 22 */ - lrecord_type_buffer, /* 23 */ - lrecord_type_extent, /* 24 */ - lrecord_type_extent_info, /* 25 */ - lrecord_type_extent_auxiliary, /* 26 */ - lrecord_type_marker, /* 27 */ - lrecord_type_event, /* 28 */ + lrecord_type_compiled_function, + lrecord_type_weak_list, + lrecord_type_bit_vector, + lrecord_type_float, + lrecord_type_hash_table, + lrecord_type_lstream, + lrecord_type_process, + lrecord_type_charset, + lrecord_type_coding_system, + lrecord_type_char_table, + lrecord_type_char_table_entry, + lrecord_type_range_table, + lrecord_type_opaque, + lrecord_type_opaque_ptr, + lrecord_type_buffer, + lrecord_type_extent, + lrecord_type_extent_info, + lrecord_type_extent_auxiliary, + lrecord_type_marker, + lrecord_type_event, #ifdef EVENT_DATA_AS_OBJECTS /* not defined */ lrecord_type_key_data, lrecord_type_button_data, ＠＠ -260,47 +262,79 ＠＠ lrecord_type_magic_eval_data, lrecord_type_magic_data, #endif /* EVENT_DATA_AS_OBJECTS */ - lrecord_type_keymap, /* 29 */ - lrecord_type_command_builder, /* 30 */ - lrecord_type_timeout, /* 31 */ - lrecord_type_specifier, /* 32 */ - lrecord_type_console, /* 33 */ - lrecord_type_device, /* 34 */ - lrecord_type_frame, /* 35 */ - lrecord_type_window, /* 36 */ - lrecord_type_window_mirror, /* 37 */ - lrecord_type_window_configuration, /* 38 */ - lrecord_type_gui_item, /* 39 */ - lrecord_type_popup_data, /* 40 */ - lrecord_type_toolbar_button, /* 41 */ - lrecord_type_scrollbar_instance, /* 42 */ - lrecord_type_color_instance, /* 43 */ - lrecord_type_font_instance, /* 44 */ - lrecord_type_image_instance, /* 45 */ - lrecord_type_glyph, /* 46 */ - lrecord_type_face, /* 47 */ - lrecord_type_database, /* 48 */ - lrecord_type_tooltalk_message, /* 49 */ - lrecord_type_tooltalk_pattern, /* 50 */ - lrecord_type_ldap, /* 51 */ - lrecord_type_pgconn, /* 52 */ - lrecord_type_pgresult, /* 53 */ - lrecord_type_devmode, /* 54 */ - lrecord_type_mswindows_dialog_id, /* 55 */ - lrecord_type_case_table, /* 56 */ - lrecord_type_emacs_ffi, /* 57 */ - lrecord_type_emacs_gtk_object, /* 58 */ - lrecord_type_emacs_gtk_boxed, /* 59 */ - lrecord_type_weak_box, /* 60 */ - lrecord_type_ephemeron, /* 61 */ - lrecord_type_bignum, /* 62 */ - lrecord_type_ratio, /* 63 */ - lrecord_type_bigfloat, /* 64 */ + lrecord_type_keymap, + lrecord_type_command_builder, + lrecord_type_timeout, + lrecord_type_specifier, + lrecord_type_console, + lrecord_type_device, + lrecord_type_frame, + lrecord_type_window, + lrecord_type_window_mirror, + lrecord_type_window_configuration, + lrecord_type_gui_item, + lrecord_type_popup_data, + lrecord_type_toolbar_button, + lrecord_type_scrollbar_instance, + lrecord_type_color_instance, + lrecord_type_font_instance, + lrecord_type_image_instance, + lrecord_type_glyph, + lrecord_type_face, + lrecord_type_database, + lrecord_type_tooltalk_message, + lrecord_type_tooltalk_pattern, + lrecord_type_ldap, + lrecord_type_pgconn, + lrecord_type_pgresult, + lrecord_type_devmode, + lrecord_type_mswindows_dialog_id, + lrecord_type_case_table, + lrecord_type_emacs_ffi, + lrecord_type_emacs_gtk_object, + lrecord_type_emacs_gtk_boxed, + lrecord_type_weak_box, + lrecord_type_ephemeron, + lrecord_type_bignum, + lrecord_type_ratio, + lrecord_type_bigfloat, #ifndef MC_ALLOC lrecord_type_free, /* only used for "free" lrecords */ lrecord_type_undefined, /* only used for debugging */ #endif /* not MC_ALLOC */ - lrecord_type_last_built_in_type /* 65 */ /* must be last */ +#ifdef NEW_GC + lrecord_type_string_indirect_data, + lrecord_type_string_direct_data, + lrecord_type_hash_table_entry, + lrecord_type_syntax_cache, + lrecord_type_buffer_text, + lrecord_type_compiled_function_args, + lrecord_type_tty_console, + lrecord_type_stream_console, + lrecord_type_dynarr, + lrecord_type_face_cachel, + lrecord_type_face_cachel_dynarr, + lrecord_type_glyph_cachel, + lrecord_type_glyph_cachel_dynarr, + lrecord_type_x_device, + lrecord_type_gtk_device, + lrecord_type_tty_device, + lrecord_type_mswindows_device, + lrecord_type_msprinter_device, + lrecord_type_x_frame, + lrecord_type_gtk_frame, + lrecord_type_mswindows_frame, + lrecord_type_gap_array_marker, + lrecord_type_gap_array, + lrecord_type_extent_list_marker, + lrecord_type_extent_list, + lrecord_type_stack_of_extents, + lrecord_type_tty_color_instance_data, + lrecord_type_tty_font_instance_data, + lrecord_type_specifier_caching, + lrecord_type_expose_ignore, +#endif /* NEW_GC */ + lrecord_type_last_built_in_type /* must be last */ }; extern MODULE_API int lrecord_type_count; ＠＠ -400,6 +434,12 ＠＠ LHEADER_IMPLEMENTATION (XRECORD_LHEADER (obj)) #define LHEADER_IMPLEMENTATION(lh) lrecord_implementations_table[(lh)->type] +#include "gc.h" + +#ifdef NEW_GC +#include "vdb.h" +#endif /* NEW_GC */ + extern int gc_in_progress; #ifdef MC_ALLOC ＠＠ -407,14 +447,31 ＠＠ #ifdef ALLOC_TYPE_STATS void init_lrecord_stats (void); -void inc_lrecord_string_data_stats (Bytecount size); -void dec_lrecord_string_data_stats (Bytecount size); void inc_lrecord_stats (Bytecount size, const struct lrecord_header *h); void dec_lrecord_stats (Bytecount size_including_overhead, const struct lrecord_header *h); +int lrecord_stats_heap_size (void); #endif /* ALLOC_TYPE_STATS */ /* Tell mc-alloc how to call a finalizer. */ +#ifdef NEW_GC +#define MC_ALLOC_CALL_FINALIZER(ptr) \ +{ \ + Lisp_Object MCACF_obj = wrap_pointer_1 (ptr); \ + struct lrecord_header *MCACF_lheader = XRECORD_LHEADER (MCACF_obj); \ + if (XRECORD_LHEADER (MCACF_obj) && LRECORDP (MCACF_obj) \ + && !LRECORD_FREE_P (MCACF_lheader) ) \ + { \ + const struct lrecord_implementation *MCACF_implementation \ + = LHEADER_IMPLEMENTATION (MCACF_lheader); \ + if (MCACF_implementation && MCACF_implementation->finalizer) \ + { \ + GC_STAT_FINALIZED; \ + MCACF_implementation->finalizer (ptr, 0); \ + } \ + } \ +} while (0) +#else /* not NEW_GC */ #define MC_ALLOC_CALL_FINALIZER(ptr) \ { \ Lisp_Object MCACF_obj = wrap_pointer_1 (ptr); \ ＠＠ -428,6 +485,7 ＠＠ MCACF_implementation->finalizer (ptr, 0); \ } \ } while (0) +#endif /* not NEW_GC */ /* Tell mc-alloc how to call a finalizer for disksave. */ #define MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE(ptr) \ ＠＠ -952,6 +1010,9 ＠＠ { XD_LISP_OBJECT_ARRAY, XD_LISP_OBJECT, +#ifdef NEW_GC + XD_LISP_OBJECT_BLOCK_PTR, +#endif /* NEW_GC */ XD_LO_LINK, XD_OPAQUE_PTR, XD_OPAQUE_PTR_CONVERTIBLE, ＠＠ -1088,6 +1149,14 ＠＠ { XD_INT, offsetof (base_type, cur) }, \ { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } \ +#ifdef NEW_GC +#define XD_LISP_DYNARR_DESC(base_type, sub_desc) \ + { XD_LISP_OBJECT_BLOCK_PTR, offsetof (base_type, base), \ + XD_INDIRECT(1, 0), {sub_desc} }, \ + { XD_INT, offsetof (base_type, cur) }, \ + { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } +#endif /* not NEW_GC */ + /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size. DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies. */ ＠＠ -1674,6 +1743,9 ＠＠ void *alloc_lrecord (Bytecount size, const struct lrecord_implementation *); +void *alloc_lrecord_array (Bytecount size, int elemcount, + const struct lrecord_implementation *); + #define alloc_lrecord_type(type, lrecord_implementation) \ ((type *) alloc_lrecord (sizeof (type), lrecord_implementation)) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/Makefile.in.in newgc-xemacs-21.5/src/Makefile.in.in --- xemacs-21.5/src/Makefile.in.in 2005-11-22 09:24:26.000000000 +0100 +++ newgc-xemacs-21.5/src/Makefile.in.in 2005-11-22 10:06:50.000000000 +0100 ＠＠ -255,6 +255,19 ＠＠ mc_alloc_objs=mc-alloc.o #endif +#ifdef NEW_GC +new_gc_objs=vdb.o +# if defined (WIN32_ANY) || defined (VDB_WIN32) +vdb_objs=vdb-win32.o +# elif defined (VDB_MACH) +vdb_objs=vdb-mach.o +# elif defined (VDB_POSIX) +vdb_objs=vdb-posix.o +# else /* VDB_FAKE */ +vdb_objs=vdb-fake.o +# endif +#endif /* NEW_GC */ + ## lastfile must follow all files whose initialized data areas should ## be dumped as pure by dump-emacs. ＠＠ -273,12 +286,12 ＠＠ event-stream.o $(event_unixoid_objs) $(extra_objs) extents.o\ faces.o file-coding.o fileio.o $(LOCK_OBJ) filemode.o floatfns.o fns.o \ font-lock.o frame.o\ - general.o $(gif_objs) glyphs.o glyphs-eimage.o glyphs-shared.o\ + gc.o general.o $(gif_objs) glyphs.o glyphs-eimage.o glyphs-shared.o\ glyphs-widget.o $(gpm_objs) $(gtk_objs) $(gtk_gui_objs) $(gui_objs) \ gutter.o\ hash.o imgproc.o indent.o insdel.o intl.o\ keymap.o $(RTC_patch_objs) line-number.o $(ldap_objs) lread.o lstream.o\ - $(mc_alloc_objs) \ + $(mc_alloc_objs) $(new_gc_objs) $(vdb_objs) \ macros.o marker.o md5.o minibuf.o $(mswindows_objs) $(mswindows_gui_objs)\ $(mule_objs) $(mule_canna_objs) $(mule_wnn_objs) $(number_objs) objects.o\ opaque.o $(postgresql_objs) print.o process.o $(process_objs) $(profile_objs)\ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/mc-alloc.c newgc-xemacs-21.5/src/mc-alloc.c --- xemacs-21.5/src/mc-alloc.c 2005-10-14 03:22:01.000000000 +0200 +++ newgc-xemacs-21.5/src/mc-alloc.c 2005-11-20 14:32:23.000000000 +0100 ＠＠ -21,17 +21,43 ＠＠ /* Synched up with: Not in FSF. */ #include <config.h> + #include "lisp.h" #include "mc-alloc.h" +#include "getpagesize.h" -/*--- configurable values ----------------------------------------------*/ +#if 0 +# define USE_MARK_BITS_FREE_LIST 1 +#endif +#if 1 +# define BLOCKTYPE_ALLOC_PAGE_HEADER 1 +#endif -/* Valid page sizes are powers of 2. */ -#undef PAGE_SIZE /* for FreeBSD */ -#define PAGE_SIZE 2048 +/* Memory protection needs the real system-dependent pagesize. */ +#ifndef WIN32_NATIVE +#include <unistd.h> /* for getpagesize () */ +#endif +#if defined (HAVE_GETPAGESIZE) +# define SYS_PAGE_SIZE getpagesize () +#elif defined (_SC_PAGESIZE) +# define SYS_PAGE_SIZE sysconf (_SC_PAGESIZE) +#elif defined (_SC_PAGE_SIZE) +# define SYS_PAGE_SIZE sysconf (_SC_PAGE_SIZE) +#elif defined(get_page_size) +# define SYS_PAGE_SIZE get_page_size () +#elif defined(PAGESIZE) +# define SYS_PAGE_SIZE PAGESIZE +#elif defined(PAGE_SIZE) +# define SYS_PAGE_SIZE PAGE_SIZE +#else + /* Valid page sizes are powers of 2. */ +# define SYS_PAGE_SIZE 4096 +#endif +/*--- configurable values ----------------------------------------------*/ + /* Definition of size classes */ /* Heap used list constants: In the used heap, it is important to ＠＠ -41,11 +67,19 ＠＠ avoid wasting memory. */ /* Minimum object size in bytes. */ -#define USED_LIST_MIN_OBJECT_SIZE 8 +#if BITS_PER_EMACS_INT > 32 +# define USED_LIST_MIN_OBJECT_SIZE 16 +#else +# define USED_LIST_MIN_OBJECT_SIZE 8 +#endif /* The step size by which the size classes increase (up to upper threshold). This many bytes are mapped to a single used list: */ -#define USED_LIST_LIN_STEP 4 +#if BITS_PER_EMACS_INT > 32 +# define USED_LIST_LIN_STEP 8 +#else +# define USED_LIST_LIN_STEP 4 +#endif /* The upper threshold should always be set to PAGE_SIZE/2, because if a object is larger than PAGE_SIZE/2 there is no room for any other ＠＠ -53,26 +87,7 ＠＠ the multiple pages, since a quick search for free spots is not needed for this kind of pages (because there are no free spots). PAGE_SIZES_DIV_2 defines maximum size of a used space list. */ -#define USED_LIST_UPPER_THRESHOLD PAGE_SIZE_DIV_2 - - -/* Unmanaged memory used list constants: Like in the used heap, it is - important to quickly find a free spot for a new object. Therefore - the size classes of the unmanaged heap are defined by the size of - the cells on the pages. The size classes should match common object - sizes, to avoid wasting memory. */ -/* Minimum object size in bytes. */ -#define UNMANAGED_LIST_MIN_OBJECT_SIZE 8 -/* The step size by which the size classes increase (up to upper - threshold). This many bytes are mapped to a single unmanaged list: */ -#define UNMANAGED_LIST_LIN_STEP 4 -/* The upper threshold should always be set to PAGE_SIZE/2, because if - a object is larger than PAGE_SIZE/2 there is no room for any other - object on this page. Objects this big are kept in the page list of - the multiple pages, since a quick search for free spots is not - needed for this kind of pages (because there are no free spots). - PAGE_SIZES defines maximum size of a unmanaged space list. */ -#define UNMANAGED_LIST_UPPER_THRESHOLD PAGE_SIZE_DIV_2 +#define USED_LIST_UPPER_THRESHOLD PAGE_SIZE_DIV_2 /* Heap free list constants: In the unused heap, the size of ＠＠ -93,6 +108,18 ＠＠ #define FREE_LIST_UPPER_THRESHOLD 256 +/* used heap list count */ +#define N_USED_PAGE_LISTS (((USED_LIST_UPPER_THRESHOLD \ + - USED_LIST_MIN_OBJECT_SIZE) \ + / USED_LIST_LIN_STEP) + 1 ) + 1 + +/* free heap list count */ +#define N_FREE_PAGE_LISTS (((FREE_LIST_UPPER_THRESHOLD \ + - FREE_LIST_LOWER_THRESHOLD) \ + / FREE_LIST_LIN_STEP) \ + + FREE_LIST_LOWER_THRESHOLD) + + /* Maximum number of separately added heap sections. */ #if BITS_PER_EMACS_INT > 32 # define MAX_HEAP_SECTS 2048 ＠＠ -103,7 +130,7 ＠＠ /* Heap growth constants. Heap increases by any number between the boundaries (unit is PAGE_SIZE). */ -#define MIN_HEAP_INCREASE 32 +#define MIN_HEAP_INCREASE 256 #define MAX_HEAP_INCREASE 256 /* not used */ /* Every heap growth is calculated like this: ＠＠ -120,96 +147,22 ＠＠ #define ZERO_MEM 1 - - -/*--- calculations done by macros --------------------------------------*/ - #ifndef CHAR_BIT /* should be included by limits.h */ # define CHAR_BIT BITS_PER_CHAR #endif -#if PAGE_SIZE == 512 -# define CPP_LOG_PAGE_SIZE 9 -#endif -#if PAGE_SIZE == 1024 -# define CPP_LOG_PAGE_SIZE 10 -#endif -#if PAGE_SIZE == 2048 -# define CPP_LOG_PAGE_SIZE 11 -#endif -#if PAGE_SIZE == 4096 -# define CPP_LOG_PAGE_SIZE 12 -#endif -#if PAGE_SIZE == 8192 -# define CPP_LOG_PAGE_SIZE 13 -#endif -#if PAGE_SIZE == 16384 -# define CPP_LOG_PAGE_SIZE 14 -#endif -#ifndef CPP_LOG_PAGE_SIZE ---> fix PAGE_SIZE -#endif -#undef PAGE_SIZE -#define CPP_PAGE_SIZE (1 << CPP_LOG_PAGE_SIZE) -#define LOG_PAGE_SIZE ((EMACS_INT) CPP_LOG_PAGE_SIZE) -#define PAGE_SIZE ((EMACS_INT) CPP_PAGE_SIZE) -#define PAGE_SIZE_DIV_2 (PAGE_SIZE >> 1) - - -/* NOT USED ANYMORE */ -#ifdef USE_EXPONENTIAL_USED_LIST_GROWTH -/* used heap list logarithms */ -#if USED_LIST_LOWER_THRESHOLD == 8 -# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 3 -#endif -#if USED_LIST_LOWER_THRESHOLD == 16 -# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 4 -#endif -#if USED_LIST_LOWER_THRESHOLD == 32 -# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 5 -#endif -#if USED_LIST_LOWER_THRESHOLD == 64 -# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 6 -#endif -#if USED_LIST_LOWER_THRESHOLD == 128 -# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 7 -#endif -#if USED_LIST_LOWER_THRESHOLD == 256 -# define CPP_LOG_USED_LIST_LOWER_THRESHOLD 8 -#endif -#ifndef CPP_LOG_USED_LIST_LOWER_THRESHOLD ---> fix USED_LIST_LOWER_THRESHOLD -#endif -#define LOG_USED_LIST_LOWER_THRESHOLD CPP_LOG_USED_LIST_LOWER_THRESHOLD -#endif /* USE_EXPONENTIAL_USED_LIST_GROWTH */ -/* used heap list count */ -#define N_USED_PAGE_LISTS (((USED_LIST_UPPER_THRESHOLD \ - - USED_LIST_MIN_OBJECT_SIZE) \ - / USED_LIST_LIN_STEP) + 1 ) + 1 + +/*--- values depending on PAGE_SIZE ------------------------------------*/ -/* unmanaged memory list count */ -#define N_UNMANAGED_PAGE_LISTS (((UNMANAGED_LIST_UPPER_THRESHOLD \ - - UNMANAGED_LIST_MIN_OBJECT_SIZE) \ - / UNMANAGED_LIST_LIN_STEP) + 1 ) + 1 - -/* NOT USED ANYMORE */ -#ifdef USE_EXPONENTIAL_USED_LIST_GROWTH -#define N_USED_PAGE_LISTS_LIN (((USED_LIST_LOWER_THRESHOLD \ - - USED_LIST_MIN_OBJECT_SIZE) \ - / USED_LIST_LIN_STEP) + 1 ) -#define N_USED_PAGE_LISTS_EXP \ - (LOG_PAGE_SIZE - LOG_USED_LIST_LOWER_THRESHOLD) - -#define N_USED_PAGE_LISTS \ - (N_USED_PAGE_LISTS_LIN + N_USED_PAGE_LISTS_EXP + 1) -#endif /* USE_EXPONENTIAL_USED_LIST_GROWTH */ +/* initialized in init_mc_allocator () */ +static EMACS_INT log_page_size; +static EMACS_INT page_size_div_2; -/* free heap list count */ -#define N_FREE_PAGE_LISTS (((FREE_LIST_UPPER_THRESHOLD \ - - FREE_LIST_LOWER_THRESHOLD) \ - / FREE_LIST_LIN_STEP) \ - + FREE_LIST_LOWER_THRESHOLD) +#undef PAGE_SIZE +#define PAGE_SIZE SYS_PAGE_SIZE +#define LOG_PAGE_SIZE log_page_size +#define PAGE_SIZE_DIV_2 page_size_div_2 /* Constants for heap address to page header mapping. */ ＠＠ -237,8 +190,7 ＠＠  /*--- structs and typedefs ---------------------------------------------*/ -/* Links the free lists (mark_bit_free_list, page_header_free_list, - cell free list). */ +/* Links the free lists (mark_bit_free_list and cell free list). */ typedef struct free_link { struct lrecord_header lheader; ＠＠ -246,7 +198,7 ＠＠ } free_link; -/* Header for pages. They are hold in a doubly linked list. */ +/* Header for pages. They are held in a doubly linked list. */ typedef struct page_header { struct page_header *next; /* next page_header */ ＠＠ -263,7 +215,11 ＠＠ mark_bits holds the pointer to this area. Is the number of objects smaller than BITS_PER_EMACS_INT, the mark bits are held in the mark_bit EMACS_INT directly, without an additional indirection. */ - char *mark_bits; /* pointer to mark bits */ + unsigned int black_bit:1; /* objects on page are black */ + unsigned int dirty_bit:1; /* page is dirty */ + unsigned int protection_bit:1; /* page is write protected */ + unsigned int array_bit:1; /* page holds arrays */ + Rawbyte *mark_bits; /* pointer to mark bits */ void *heap_space; /* pointer to heap, where objects are stored */ } page_header; ＠＠ -272,7 +228,6 ＠＠ /* Different list types. */ enum list_type_enum { USED_LIST, - UNMANAGED_LIST, FREE_LIST }; ＠＠ -339,20 +294,19 ＠＠ /* Holds all allocated pages, each object size class in its separate list, to guarantee fast allocation on partially filled pages. */ - page_list_header used_heap_pages[N_USED_PAGE_LISTS]; - - /* Holds all unmanaged pages. */ - page_list_header unmanaged_heap_pages[N_UNMANAGED_PAGE_LISTS]; + page_list_header *used_heap_pages; /* Holds all free pages in the heap. N multiples of PAGE_SIZE are kept on the Nth free list. Contiguos pages are coalesced. */ page_list_header free_heap_pages[N_FREE_PAGE_LISTS]; /* ptr lookup table */ - level_2_lookup_tree *ptr_lookup_table[LEVEL1_SIZE]; + level_2_lookup_tree **ptr_lookup_table; +#ifndef BLOCKTYPE_ALLOC_PAGE_HEADER /* page header free list */ free_link *page_header_free_list; +#endif /* not BLOCKTYPE_ALLOC_PAGE_HEADER */ #ifdef MEMORY_USAGE_STATS EMACS_INT malloced_bytes; ＠＠ -369,9 +323,6 ＠＠ #define USED_HEAP_PAGES(i) \ ((page_list_header*) &mc_allocator_globals.used_heap_pages[i]) -#define UNMANAGED_HEAP_PAGES(i) \ - ((page_list_header*) &mc_allocator_globals.unmanaged_heap_pages[i]) - #define FREE_HEAP_PAGES(i) \ ((page_list_header*) &mc_allocator_globals.free_heap_pages[i]) ＠＠ -398,6 +349,10 ＠＠ # define PH_CELL_SIZE(ph) PH (ph)->cell_size # define PH_CELLS_ON_PAGE(ph) PH (ph)->cells_on_page # define PH_CELLS_USED(ph) PH (ph)->cells_used +# define PH_BLACK_BIT(ph) PH (ph)->black_bit +# define PH_DIRTY_BIT(ph) PH (ph)->dirty_bit +# define PH_PROTECTION_BIT(ph) PH (ph)->protection_bit +# define PH_ARRAY_BIT(ph) PH (ph)->array_bit # define PH_MARK_BITS(ph) PH (ph)->mark_bits # define PH_HEAP_SPACE(ph) PH (ph)->heap_space #define PH_LIST_TYPE(ph) PLH_LIST_TYPE (PH_PLH (ph)) ＠＠ -412,7 +367,9 ＠＠ #define HEAP_SECTION(index) mc_allocator_globals.heap_sections[index] #define N_HEAP_SECTIONS mc_allocator_globals.n_heap_sections +#ifndef BLOCKTYPE_ALLOC_PAGE_HEADER #define PAGE_HEADER_FREE_LIST mc_allocator_globals.page_header_free_list +#endif /* not BLOCKTYPE_ALLOC_PAGE_HEADER */ #define NEXT_FREE(free_list) ((free_link*) free_list)->next_free #define FREE_LIST(free_list) (free_link*) (free_list) ＠＠ -444,9 +401,13 ＠＠ #define PH_ON_USED_LIST_P(ph) \ (ph && PH_PLH (ph) && (PLH_LIST_TYPE (PH_PLH (ph)) == USED_LIST)) -#define PH_ON_UNMANAGED_LIST_P(ph) \ - (ph && PH_PLH (ph) && (PLH_LIST_TYPE (PH_PLH (ph)) == UNMANAGED_LIST)) +/* Number of mark bits: minimum 1, maximum 8. */ +#ifdef NEW_GC +#define N_MARK_BITS 2 +#else /* not NEW_GC */ +#define N_MARK_BITS 1 +#endif /* not NEW_GC */  ＠＠ -455,12 +416,6 ＠＠ /************************************************************************/ -/* ###TODO### */ -#if 1 -# define ALLOC_MB_UNMANAGED 1 -#endif - - /*--- misc functions ---------------------------------------------------*/ /* moved here from alloc.c */ ＠＠ -483,7 +438,7 ＠＠ static void visit_all_used_page_headers (void (*f) (page_header *ph)) { - int i; + EMACS_INT i; for (i = 0; i < N_USED_PAGE_LISTS; i++) if (PLH_FIRST (USED_HEAP_PAGES (i))) { ＠＠ -507,7 +462,7 ＠＠ static void set_lookup_table (void *ptr, page_header *ph) { - int l1_index = L1_INDEX (ptr); + EMACS_INT l1_index = L1_INDEX (ptr); level_2_lookup_tree *l2 = PTR_LOOKUP_TABLE (l1_index); #ifdef USE_HASH_TABLE while ((l2) && (LEVEL2_KEY (l2) != l1_index)) ＠＠ -537,7 +492,7 ＠＠ static void unset_lookup_table (void *ptr) { - int l1_index = L1_INDEX (ptr); + EMACS_INT l1_index = L1_INDEX (ptr); level_2_lookup_tree *l2 = PTR_LOOKUP_TABLE (l1_index); #ifdef USE_HASH_TABLE while ((l2) && (LEVEL2_KEY (l2) != l1_index)) ＠＠ -554,7 +509,7 ＠＠ static page_header * get_page_header_internal (void *ptr) { - int l1_index = L1_INDEX (ptr); + EMACS_INT l1_index = L1_INDEX (ptr); level_2_lookup_tree *l2 = PTR_LOOKUP_TABLE (l1_index); #ifdef USE_HASH_TABLE while ((l2) && (LEVEL2_KEY (l2) != l1_index)) ＠＠ -569,7 +524,7 ＠＠ static page_header * get_page_header (void *ptr) { - int l1_index = L1_INDEX (ptr); + EMACS_INT l1_index = L1_INDEX (ptr); level_2_lookup_tree *l2 = PTR_LOOKUP_TABLE (l1_index); assert (l2); #ifdef USE_HASH_TABLE ＠＠ -580,14 +535,14 ＠＠ return LEVEL2 (l2, L2_INDEX (ptr)); } - /* Returns the mark bit index of a given heap address. */ static EMACS_INT get_mark_bit_index (void *ptr, page_header *ph) { EMACS_INT cell_size = PH_CELL_SIZE (ph); if (cell_size) - return (((EMACS_INT) ptr - (EMACS_INT)(PH_HEAP_SPACE (ph))) / cell_size); + return (((EMACS_INT) ptr - (EMACS_INT)(PH_HEAP_SPACE (ph))) / cell_size) + * N_MARK_BITS; else /* only one object on page */ return 0; } ＠＠ -597,9 +552,9 ＠＠ static void add_pages_to_lookup_table (page_header *ph, EMACS_INT n_pages) { - char *p = (char*) PH_HEAP_SPACE (ph); + Rawbyte *p = (Rawbyte *) PH_HEAP_SPACE (ph); EMACS_INT end_of_section = (EMACS_INT) p + (PAGE_SIZE * n_pages); - for (p = (char*) PH_HEAP_SPACE (ph); + for (p = (Rawbyte *) PH_HEAP_SPACE (ph); (EMACS_INT) p < end_of_section; p += PAGE_SIZE) set_lookup_table (p, ph); } ＠＠ -609,7 +564,7 ＠＠ static void init_lookup_table (void) { - int i; + EMACS_INT i; for (i = 0; i < LEVEL1_SIZE; i++) PTR_LOOKUP_TABLE (i) = 0; } ＠＠ -619,35 +574,32 ＠＠  /*--- mark bits --------------------------------------------------------*/ -/* Number of mark bits: minimum 1, maximum 8. */ -#define N_MARK_BITS 1 - /*--- bit operations --- */ /* Allocates a bit array of length bits. */ -static char * +static Rawbyte * alloc_bit_array(size_t bits) { -#ifdef ALLOC_MB_UNMANAGED - size_t size = ((bits + CHAR_BIT - 1) / CHAR_BIT) * sizeof(char); + Rawbyte *bit_array; +#ifdef USE_MARK_BITS_FREE_LIST + size_t size = ((bits + CHAR_BIT - 1) / CHAR_BIT) * sizeof (Rawbyte); +#else /* not USE_MARK_BITS_FREE_LIST */ + size_t size = + ALIGN_FOR_TYPE (((bits + CHAR_BIT - 1) / CHAR_BIT) * sizeof (Rawbyte), + Rawbyte *); +#endif /* not USE_MARK_BITS_FREE_LIST */ if (size < sizeof (free_link)) size = sizeof (free_link); - return (char *) mc_alloc_unmanaged (size); -#else /* not ALLOC_MB_UNMANAGED */ - size_t size = ((bits + CHAR_BIT - 1) / CHAR_BIT) * sizeof(char); - char *bit_array; - if (size < sizeof (free_link)) size = sizeof (free_link); - bit_array = (char*) xmalloc_and_zero (size); #ifdef MEMORY_USAGE_STATS MC_MALLOCED_BYTES += malloced_storage_size (0, size, 0); #endif + bit_array = (Rawbyte *) xmalloc_and_zero (size); return bit_array; -#endif /* not ALLOC_MB_UNMANAGED */ } /* Returns the bit value at pos. */ static EMACS_INT -get_bit (char *bit_array, EMACS_INT pos) +get_bit (Rawbyte *bit_array, EMACS_INT pos) { #if N_MARK_BITS > 1 EMACS_INT result = 0; ＠＠ -656,8 +608,8 ＠＠ bit_array += pos / CHAR_BIT; #if N_MARK_BITS > 1 for (i = 0; i < N_MARK_BITS; i++) - result |= (*bit_array & (1 << ((pos + i) % CHAR_BIT))); - return result >> pos; + result |= ((*bit_array & (1 << ((pos + i) % CHAR_BIT))) != 0) << i; + return result; #else return (*bit_array & (1 << (pos % CHAR_BIT))) != 0; #endif ＠＠ -666,10 +618,9 ＠＠ /* Bit_Arrays bit at pos to val. */ static void -set_bit(char *bit_array, EMACS_INT pos, EMACS_INT val) +set_bit (Rawbyte *bit_array, EMACS_INT pos, EMACS_INT val) { #if N_MARK_BITS > 1 - EMACS_INT result = 0; EMACS_INT i; #endif bit_array += pos / CHAR_BIT; ＠＠ -689,21 +640,23 ＠＠ /*--- mark bit functions ---*/ -#define USE_PNTR_MARK_BITS(ph) (PH_CELLS_ON_PAGE (ph) > BITS_PER_EMACS_INT) -#define USE_WORD_MARK_BITS(ph) (PH_CELLS_ON_PAGE (ph) <= BITS_PER_EMACS_INT) +#define USE_PNTR_MARK_BITS(ph) \ + ((PH_CELLS_ON_PAGE (ph) * N_MARK_BITS) > BITS_PER_EMACS_INT) +#define USE_WORD_MARK_BITS(ph) \ + ((PH_CELLS_ON_PAGE (ph) * N_MARK_BITS) <= BITS_PER_EMACS_INT) -#define GET_BIT_WORD(b, p) get_bit ((char*) &b, p) +#define GET_BIT_WORD(b, p) get_bit ((Rawbyte *) &b, p) #define GET_BIT_PNTR(b, p) get_bit (b, p) -#define SET_BIT_WORD(b, p, v) set_bit ((char*) &b, p, v) +#define SET_BIT_WORD(b, p, v) set_bit ((Rawbyte *) &b, p, v) #define SET_BIT_PNTR(b, p, v) set_bit (b, p, v) #define ZERO_MARK_BITS_WORD(ph) PH_MARK_BITS (ph) = 0 -#define ZERO_MARK_BITS_PNTR(ph) \ -do { \ - memset (PH_MARK_BITS (ph), '\0', \ - (PH_CELLS_ON_PAGE (ph) + CHAR_BIT - 1) \ - / CHAR_BIT * sizeof(char)); \ +#define ZERO_MARK_BITS_PNTR(ph) \ +do { \ + memset (PH_MARK_BITS (ph), '\0', \ + ((PH_CELLS_ON_PAGE (ph) * N_MARK_BITS) \ + + CHAR_BIT - 1) / CHAR_BIT * sizeof (Rawbyte)); \ } while (0) #define GET_BIT(bit, ph, p) \ ＠＠ -733,17 +686,21 ＠＠ /* Allocates mark-bit space either from a free list or from the OS for the given page header. */ -static char * +static Rawbyte * alloc_mark_bits (page_header *ph) { - char *result; + Rawbyte *result; +#ifdef USE_MARK_BITS_FREE_LIST if (PH_MARK_BIT_FREE_LIST (ph) == 0) - result = (char*) alloc_bit_array (PH_CELLS_ON_PAGE (ph) * N_MARK_BITS); + result = (Rawbyte *) alloc_bit_array (PH_CELLS_ON_PAGE (ph) * N_MARK_BITS); else { - result = (char*) PH_MARK_BIT_FREE_LIST (ph); + result = (Rawbyte *) PH_MARK_BIT_FREE_LIST (ph); PH_MARK_BIT_FREE_LIST (ph) = NEXT_FREE (result); } +#else /* not USE_MARK_BITS_FREE_LIST */ + result = (Rawbyte *) alloc_bit_array (PH_CELLS_ON_PAGE (ph) * N_MARK_BITS); +#endif /* not USE_MARK_BITS_FREE_LIST */ return result; } ＠＠ -752,15 +709,13 ＠＠ static void free_mark_bits (page_header *ph) { -#ifdef ALLOC_MB_UNMANAGED +#ifdef USE_MARK_BITS_FREE_LIST + NEXT_FREE (PH_MARK_BITS (ph)) = PH_MARK_BIT_FREE_LIST (ph); + PH_MARK_BIT_FREE_LIST (ph) = FREE_LIST (PH_MARK_BITS (ph)); +#else /* not USE_MARK_BITS_FREE_LIST */ if (PH_MARK_BITS (ph)) - mc_free (PH_MARK_BITS (ph)); -#else /* not ALLOC_MB_UNMANAGED */ - if (PH_MARK_BITS (ph)) { - NEXT_FREE (PH_MARK_BITS (ph)) = PH_MARK_BIT_FREE_LIST (ph); - PH_MARK_BIT_FREE_LIST (ph) = FREE_LIST (PH_MARK_BITS (ph)); - } -#endif /* not ALLOC_MB_UNMANAGED */ + free (PH_MARK_BITS (ph)); +#endif /* not USE_MARK_BITS_FREE_LIST */ } ＠＠ -818,6 +773,11 ＠＠ assert (ph && PH_ON_USED_LIST_P (ph)); if (ph) { +#ifdef NEW_GC + if (value == BLACK) + if (!PH_BLACK_BIT (ph)) + PH_BLACK_BIT (ph) = 1; +#endif /* NEW_GC */ SET_BIT (ph, get_mark_bit_index (ptr, ph), value); } } ＠＠ -827,10 +787,28 ＠＠  /*--- page header functions --------------------------------------------*/ +#ifdef BLOCKTYPE_ALLOC_PAGE_HEADER +#include "blocktype.h" + +struct page_header_blocktype +{ + Blocktype_declare (page_header); +} *the_page_header_blocktype; +#endif /* BLOCKTYPE_ALLOC_PAGE_HEADER */ + /* Allocates a page header either from a free list or from the OS. */ static page_header * alloc_page_header (void) { +#ifdef BLOCKTYPE_ALLOC_PAGE_HEADER + page_header *result; +#ifdef MEMORY_USAGE_STATS + MC_MALLOCED_BYTES += malloced_storage_size (0, sizeof (page_header), 0); +#endif + result = Blocktype_alloc (the_page_header_blocktype); + ZERO_PAGE_HEADER (result); + return result; +#else /* not BLOCKTYPE_ALLOC_PAGE_HEADER */ page_header *result; if (PAGE_HEADER_FREE_LIST == 0) { ＠＠ -839,7 +817,6 ＠＠ #ifdef MEMORY_USAGE_STATS MC_MALLOCED_BYTES += malloced_storage_size (0, sizeof (page_header), 0); #endif - } else { ＠＠ -847,6 +824,7 ＠＠ PAGE_HEADER_FREE_LIST = NEXT_FREE (result); } return result; +#endif /* not BLOCKTYPE_ALLOC_PAGE_HEADER */ } ＠＠ -854,11 +832,15 ＠＠ static void free_page_header (page_header *ph) { +#ifdef BLOCKTYPE_ALLOC_PAGE_HEADER + Blocktype_free (the_page_header_blocktype, ph); +#else /* not BLOCKTYPE_ALLOC_PAGE_HEADER */ #if ZERO_MEM ZERO_PAGE_HEADER (ph); #endif NEXT_FREE (ph) = PAGE_HEADER_FREE_LIST; PAGE_HEADER_FREE_LIST = FREE_LIST (ph); +#endif /* not BLOCKTYPE_ALLOC_PAGE_HEADER */ } ＠＠ -940,14 +922,22 ＠＠ get_used_list_index (size_t size) { if (size <= USED_LIST_MIN_OBJECT_SIZE) - return 0; - if (size <= USED_LIST_UPPER_THRESHOLD) - return ((size - USED_LIST_MIN_OBJECT_SIZE - 1) - / USED_LIST_LIN_STEP) + 1; + { + // printf ("size %d -> index %d\n", size, 0); + return 0; + } + if (size <= (size_t) USED_LIST_UPPER_THRESHOLD) + { + // printf ("size %d -> index %d\n", size, + // ((size - USED_LIST_MIN_OBJECT_SIZE - 1) + // / USED_LIST_LIN_STEP) + 1); + return ((size - USED_LIST_MIN_OBJECT_SIZE - 1) + / USED_LIST_LIN_STEP) + 1; + } + // printf ("size %d -> index %d\n", size, N_USED_PAGE_LISTS - 1); return N_USED_PAGE_LISTS - 1; } - /* Returns the size of the used heap list according to given index. */ static size_t get_used_list_size_value (int used_index) ＠＠ -958,32 +948,8 ＠＠ } -/* Returns the index of the used heap list according to given size. */ -static int -get_unmanaged_list_index (size_t size) -{ - if (size <= UNMANAGED_LIST_MIN_OBJECT_SIZE) - return 0; - if (size <= UNMANAGED_LIST_UPPER_THRESHOLD) - return ((size - UNMANAGED_LIST_MIN_OBJECT_SIZE - 1) - / UNMANAGED_LIST_LIN_STEP) + 1; - return N_UNMANAGED_PAGE_LISTS - 1; -} - - -/* Returns the size of the unmanaged heap list according to given index. */ -static size_t -get_unmanaged_list_size_value (int unmanaged_index) -{ - if (unmanaged_index < N_UNMANAGED_PAGE_LISTS - 1) - return (unmanaged_index * UNMANAGED_LIST_LIN_STEP) - + UNMANAGED_LIST_MIN_OBJECT_SIZE; - return 0; -} - - /* Returns the index of the free heap list according to given size. */ -static int +static EMACS_INT get_free_list_index (EMACS_INT n_pages) { if (n_pages == 0) ＠＠ -1000,7 +966,7 ＠＠ /* Returns the size in number of pages of the given free list at index. */ static size_t -get_free_list_size_value (int free_index) +get_free_list_size_value (EMACS_INT free_index) { if (free_index < FREE_LIST_LOWER_THRESHOLD) return free_index + 1; ＠＠ -1038,8 +1004,8 ＠＠ static EMACS_INT free_heap_section (page_header *ph) { - int i; - int removed = 0; + EMACS_INT i; + EMACS_INT removed = 0; for (i = 0; i < N_HEAP_SECTIONS; i++) if (!removed) { ＠＠ -1220,22 +1186,23 ＠＠ /*--- used heap functions ----------------------------------------------*/ /* Installs initial free list. */ static void -install_cell_free_list (page_header *ph) +install_cell_free_list (page_header *ph, EMACS_INT elemcount) { - char *p; - int i; + Rawbyte *p; + EMACS_INT i; EMACS_INT cell_size = PH_CELL_SIZE (ph); /* write initial free list if cell_size is < PAGE_SIZE */ - p = (char *) PH_HEAP_SPACE (ph); + p = (Rawbyte *) PH_HEAP_SPACE (ph); for (i = 0; i < PH_CELLS_ON_PAGE (ph) - 1; i++) { #ifdef ERROR_CHECK_GC assert (!LRECORD_FREE_P (p)); MARK_LRECORD_AS_FREE (p); #endif - NEXT_FREE (p) = FREE_LIST (p + cell_size); + if (elemcount == 1) + NEXT_FREE (p) = FREE_LIST (p + cell_size); set_lookup_table (p, ph); - p += cell_size; + p += cell_size; } #ifdef ERROR_CHECK_GC assert (!LRECORD_FREE_P (p)); ＠＠ -1263,7 +1230,7 ＠＠ /* Installs a new page and hooks it into given page_list_header. */ static page_header * install_page_in_used_list (page_header *ph, page_list_header *plh, - size_t size, int managed) + size_t size, EMACS_INT elemcount) { /* add to list */ add_page_header_to_plh (ph, plh); ＠＠ -1273,16 +1240,21 ＠＠ PH_CELL_SIZE (ph) = PLH_SIZE (plh); else PH_CELL_SIZE (ph) = size; - PH_CELLS_ON_PAGE (ph) = (PAGE_SIZE * PH_N_PAGES (ph)) / PH_CELL_SIZE (ph); + if (elemcount == 1) + PH_CELLS_ON_PAGE (ph) = (PAGE_SIZE * PH_N_PAGES (ph)) / PH_CELL_SIZE (ph); + else + { + PH_CELLS_ON_PAGE (ph) = elemcount; + PH_ARRAY_BIT (ph) = 1; + } /* init cell count */ PH_CELLS_USED (ph) = 0; /* install mark bits and initialize cell free list */ - if (managed) - install_mark_bits (ph); + install_mark_bits (ph); - install_cell_free_list (ph); + install_cell_free_list (ph, elemcount); #ifdef MEMORY_USAGE_STATS PLH_TOTAL_CELLS (plh) += PH_CELLS_ON_PAGE (ph); ＠＠ -1299,6 +1271,11 ＠＠ { page_list_header *plh = PH_PLH (ph); +#ifdef NEW_GC + if (gc_in_progress && PH_PROTECTION_BIT (ph)) ABORT(); + /* cleanup: remove memory protection, zero page_header bits. */ +#endif /* not NEW_GC */ + #ifdef MEMORY_USAGE_STATS PLH_TOTAL_CELLS (plh) -= PH_CELLS_ON_PAGE (ph); PLH_TOTAL_SPACE (plh) -= PAGE_SIZE * PH_N_PAGES (ph); ＠＠ -1377,7 +1354,7 ＠＠ allocate_page_from_free_list (EMACS_INT needed_pages) { page_header *ph = 0; - int i; + EMACS_INT i; for (i = get_free_list_index (needed_pages); i < N_FREE_PAGE_LISTS; i++) if ((ph = find_free_page_first_fit (needed_pages, PLH_FIRST (FREE_HEAP_PAGES (i)))) != 0) ＠＠ -1396,15 +1373,15 ＠＠ /* Allocates a new page, either from free list or by expanding the heap. */ static page_header * -allocate_new_page (page_list_header *plh, size_t size, int managed) +allocate_new_page (page_list_header *plh, size_t size, EMACS_INT elemcount) { - EMACS_INT needed_pages = BYTES_TO_PAGES (size); + EMACS_INT needed_pages = BYTES_TO_PAGES (size * elemcount); /* first check free list */ page_header *result = allocate_page_from_free_list (needed_pages); if (!result) /* expand heap */ result = expand_heap (needed_pages); - install_page_in_used_list (result, plh, size, managed); + install_page_in_used_list (result, plh, size, elemcount); return result; } ＠＠ -1412,63 +1389,56 ＠＠ /* Selects the correct size class, tries to allocate a cell of this size from the free list, if this fails, a new page is allocated. */ static void * -mc_alloc_1 (size_t size, int managed) +mc_alloc_1 (size_t size, EMACS_INT elemcount) { page_list_header *plh = 0; page_header *ph = 0; void *result = 0; - if (managed) - plh = USED_HEAP_PAGES (get_used_list_index (size)); - else - plh = UNMANAGED_HEAP_PAGES (get_unmanaged_list_index (size)); + plh = USED_HEAP_PAGES (get_used_list_index (size)); if (size == 0) return 0; - if (size < PAGE_SIZE_DIV_2) + if ((elemcount == 1) && (size < (size_t) PAGE_SIZE_DIV_2)) /* first check any free cells */ ph = allocate_cell (plh); if (!ph) /* allocate a new page */ - ph = allocate_new_page (plh, size, managed); + ph = allocate_new_page (plh, size, elemcount); /* return first element of free list and remove it from the list */ result = (void*) PH_FREE_LIST (ph); PH_FREE_LIST (ph) = NEXT_FREE (PH_FREE_LIST (ph)); - memset (result, '\0', size); - if (managed) - MARK_LRECORD_AS_FREE (result); + memset (result, '\0', (size * elemcount)); + MARK_LRECORD_AS_FREE (result); /* bump used cells counter */ - PH_CELLS_USED (ph)++; + PH_CELLS_USED (ph) += elemcount; #ifdef MEMORY_USAGE_STATS - PLH_USED_CELLS (plh)++; - if (managed) - PLH_USED_SPACE (plh) += size; - else - PLH_USED_SPACE (plh) += PLH_SIZE (plh); + PLH_USED_CELLS (plh) += elemcount; + PLH_USED_SPACE (plh) += size * elemcount; #endif return result; } +/* Array allocation. */ void * -mc_alloc (size_t size) +mc_alloc_array (size_t size, EMACS_INT elemcount) { - return mc_alloc_1 (size, 1); + return mc_alloc_1 (size, elemcount); } void * -mc_alloc_unmanaged (size_t size) +mc_alloc (size_t size) { - return mc_alloc_1 (size, 0); + return mc_alloc_1 (size, 1); } -  /*--- sweep & free & finalize-------------------------------------------*/ ＠＠ -1512,7 +1482,11 ＠＠ free_link *fl = PH_FREE_LIST (ph); while (fl) { +#ifdef NEW_GC + SET_BIT (ph, get_mark_bit_index (fl, ph), BLACK); +#else /* not NEW_GC */ SET_BIT (ph, get_mark_bit_index (fl, ph), 1); +#endif /* not NEW_GC */ fl = NEXT_FREE (fl); } } ＠＠ -1529,14 +1503,31 ＠＠ EMACS_INT heap_space_step = PH_CELL_SIZE (ph); EMACS_INT mark_bit = 0; EMACS_INT mark_bit_max_index = PH_CELLS_ON_PAGE (ph); - int bit = 0; + unsigned int bit = 0; mark_free_list (ph); +#ifdef NEW_GC + /* ARRAY_BIT_HACK */ + if (PH_ARRAY_BIT (ph)) + for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++) + { + GET_BIT (bit, ph, mark_bit * N_MARK_BITS); + if (bit) + { + return; + } + } +#endif /* NEW_GC */ + for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++) { - GET_BIT (bit, ph, mark_bit); - if (!bit) + GET_BIT (bit, ph, mark_bit * N_MARK_BITS); +#ifdef NEW_GC + if (bit == WHITE) +#else /* not NEW_GC */ + if (bit == 0) +#endif /* not NEW_GC */ { EMACS_INT ptr = (heap_space + (heap_space_step * mark_bit)); MC_ALLOC_CALL_FINALIZER ((void *) ptr); ＠＠ -1559,8 +1550,6 ＠＠ EMACS_INT mark_bit = 0; EMACS_INT mark_bit_max_index = PH_CELLS_ON_PAGE (ph); - mark_free_list (ph); - for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++) { EMACS_INT ptr = (heap_space + (heap_space_step * mark_bit)); ＠＠ -1591,23 +1580,46 ＠＠ static void sweep_page (page_header *ph) { - char *heap_space = (char *) PH_HEAP_SPACE (ph); + Rawbyte *heap_space = (Rawbyte *) PH_HEAP_SPACE (ph); EMACS_INT heap_space_step = PH_CELL_SIZE (ph); EMACS_INT mark_bit = 0; EMACS_INT mark_bit_max_index = PH_CELLS_ON_PAGE (ph); - int bit = 0; + unsigned int bit = 0; mark_free_list (ph); +#ifdef NEW_GC + /* ARRAY_BIT_HACK */ + if (PH_ARRAY_BIT (ph)) + for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++) + { + GET_BIT (bit, ph, mark_bit * N_MARK_BITS); + if (bit) + { + zero_mark_bits (ph); + PH_BLACK_BIT (ph) = 0; + return; + } + } +#endif /* NEW_GC */ + for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++) { - GET_BIT (bit, ph, mark_bit); - if (!bit) + GET_BIT (bit, ph, mark_bit * N_MARK_BITS); +#ifdef NEW_GC + if (bit == WHITE) +#else /* not NEW_GC */ + if (bit == 0) +#endif /* not NEW_GC */ { +#ifdef NEW_GC + GC_STAT_FREED; +#endif /* NEW_GC */ remove_cell (heap_space + (heap_space_step * mark_bit), ph); } } zero_mark_bits (ph); + PH_BLACK_BIT (ph) = 0; if (PH_CELLS_USED (ph) == 0) remove_page_from_used_list (ph); else if (PH_CELLS_USED (ph) < PH_CELLS_ON_PAGE (ph)) ＠＠ -1627,9 +1639,24 ＠＠ void mc_free (void *ptr) { - page_header *ph = get_page_header (ptr); - assert (!PH_ON_FREE_LIST_P (ph)); + page_header *ph; + +#ifdef NEW_GC + /* Do not allow manual freeing while a gc is running. Data is going + to be freed next gc cycle. */ + if (write_barrier_enabled || gc_in_progress) + return; +#endif /* NEW_GC */ + + ph = get_page_header (ptr); + assert (ph); + assert (PH_PLH (ph)); + assert (PLH_LIST_TYPE (PH_PLH (ph)) != FREE_LIST); +#ifdef NEW_GC + if (PH_ON_USED_LIST_P (ph)) + SET_BIT (ph, get_mark_bit_index (ptr, ph), WHITE); +#endif /* NEW_GC */ remove_cell (ptr, ph); if (PH_CELLS_USED (ph) == 0) ＠＠ -1642,29 +1669,32 ＠＠ /* Changes the size of the cell pointed to by ptr. Returns the new address of the new cell with new size. */ void * -mc_realloc_1 (void *ptr, size_t size, int managed) +mc_realloc_1 (void *ptr, size_t size, int elemcount) { if (ptr) { - if (size) + if (size * elemcount) { - void *result = mc_alloc_1 (size, managed); + void *result = mc_alloc_1 (size, elemcount); size_t from_size = PH_CELL_SIZE (get_page_header (ptr)); - size_t cpy_size = size; - if (size > from_size) + size_t cpy_size = size * elemcount; + if (cpy_size > from_size) cpy_size = from_size; memcpy (result, ptr, cpy_size); - mc_free (ptr); +#ifdef ALLOC_TYPE_STATS + inc_lrecord_stats (size, (struct lrecord_header *) result); +#endif /* not ALLOC_TYPE_STATS */ + /* mc_free (ptr); not needed, will be collected next gc */ return result; } else { - mc_free (ptr); + /* mc_free (ptr); not needed, will be collected next gc */ return 0; } } else - return mc_alloc_1 (size, managed); + return mc_alloc_1 (size, elemcount); } void * ＠＠ -1674,13 +1704,12 ＠＠ } void * -mc_realloc_unmanaged (void *ptr, size_t size) +mc_realloc_array (void *ptr, size_t size, EMACS_INT elemcount) { - return mc_realloc_1 (ptr, size, 0); + return mc_realloc_1 (ptr, size, elemcount); } -  /*--- initialization ---------------------------------------------------*/ ＠＠ -1688,32 +1717,49 ＠＠ void init_mc_allocator (void) { - int i; + EMACS_INT i; - memset (&mc_allocator_globals, '\0', sizeof (mc_allocator_globals_type)); +#ifdef MEMORY_USAGE_STATS + MC_MALLOCED_BYTES = 0; +#endif - for (i = 0; i < N_USED_PAGE_LISTS; i++) + /* init of pagesize dependent values */ + switch (SYS_PAGE_SIZE) { - page_list_header *plh = USED_HEAP_PAGES (i); - PLH_LIST_TYPE (plh) = USED_LIST; - PLH_SIZE (plh) = get_used_list_size_value (i); - PLH_FIRST (plh) = 0; - PLH_LAST (plh) = 0; - PLH_MARK_BIT_FREE_LIST (plh) = 0; + case 512: log_page_size = 9; break; + case 1024: log_page_size = 10; break; + case 2048: log_page_size = 11; break; + case 4096: log_page_size = 12; break; + case 8192: log_page_size = 13; break; + case 16384: log_page_size = 14; break; + default: ABORT (); + } + + page_size_div_2 = (EMACS_INT) SYS_PAGE_SIZE >> 1; + + mc_allocator_globals.used_heap_pages = + (page_list_header *) xmalloc_and_zero ((N_USED_PAGE_LISTS + 1) + * sizeof (page_list_header)); #ifdef MEMORY_USAGE_STATS - PLH_PAGE_COUNT (plh) = 0; - PLH_USED_CELLS (plh) = 0; - PLH_USED_SPACE (plh) = 0; - PLH_TOTAL_CELLS (plh) = 0; - PLH_TOTAL_SPACE (plh) = 0; + MC_MALLOCED_BYTES += (N_USED_PAGE_LISTS + 1) * sizeof (page_list_header); #endif - } - for (i = 0; i < N_UNMANAGED_PAGE_LISTS; i++) + mc_allocator_globals.ptr_lookup_table = + (level_2_lookup_tree **) + xmalloc_and_zero ((LEVEL1_SIZE + 1) * sizeof (level_2_lookup_tree *)); +#ifdef MEMORY_USAGE_STATS + MC_MALLOCED_BYTES += (LEVEL1_SIZE + 1) * sizeof (level_2_lookup_tree *); +#endif + +#ifdef BLOCKTYPE_ALLOC_PAGE_HEADER + the_page_header_blocktype = Blocktype_new (struct page_header_blocktype); +#endif /* BLOCKTYPE_ALLOC_PAGE_HEADER */ + + for (i = 0; i < N_USED_PAGE_LISTS; i++) { - page_list_header *plh = UNMANAGED_HEAP_PAGES (i); - PLH_LIST_TYPE (plh) = UNMANAGED_LIST; - PLH_SIZE (plh) = get_unmanaged_list_size_value (i); + page_list_header *plh = USED_HEAP_PAGES (i); + PLH_LIST_TYPE (plh) = USED_LIST; + PLH_SIZE (plh) = get_used_list_size_value (i); PLH_FIRST (plh) = 0; PLH_LAST (plh) = 0; PLH_MARK_BIT_FREE_LIST (plh) = 0; ＠＠ -1743,10 +1789,12 ＠＠ #endif } +#ifndef BLOCKTYPE_ALLOC_PAGE_HEADER PAGE_HEADER_FREE_LIST = 0; +#endif /* not BLOCKTYPE_ALLOC_PAGE_HEADER */ #ifdef MEMORY_USAGE_STATS - MC_MALLOCED_BYTES = sizeof (mc_allocator_globals); + MC_MALLOCED_BYTES += sizeof (mc_allocator_globals); #endif init_lookup_table (); ＠＠ -1765,12 +1813,11 ＠＠ { Lisp_Object free_plhs = Qnil; Lisp_Object used_plhs = Qnil; - Lisp_Object unmanaged_plhs = Qnil; Lisp_Object heap_sects = Qnil; - int used_size = 0; - int real_size = 0; + EMACS_INT used_size = 0; + EMACS_INT real_size = 0; - int i; + EMACS_INT i; for (i = 0; i < N_FREE_PAGE_LISTS; i++) if (PLH_PAGE_COUNT (FREE_HEAP_PAGES(i)) > 0) ＠＠ -1779,17 +1826,6 ＠＠ list1 (make_int (PLH_PAGE_COUNT (FREE_HEAP_PAGES(i)))), free_plhs); - for (i = 0; i < N_UNMANAGED_PAGE_LISTS; i++) - if (PLH_PAGE_COUNT (UNMANAGED_HEAP_PAGES(i)) > 0) - unmanaged_plhs = - acons (make_int (PLH_SIZE (UNMANAGED_HEAP_PAGES(i))), - list5 (make_int (PLH_PAGE_COUNT (UNMANAGED_HEAP_PAGES(i))), - make_int (PLH_USED_CELLS (UNMANAGED_HEAP_PAGES(i))), - make_int (PLH_USED_SPACE (UNMANAGED_HEAP_PAGES(i))), - make_int (PLH_TOTAL_CELLS (UNMANAGED_HEAP_PAGES(i))), - make_int (PLH_TOTAL_SPACE (UNMANAGED_HEAP_PAGES(i)))), - unmanaged_plhs); - for (i = 0; i < N_USED_PAGE_LISTS; i++) if (PLH_PAGE_COUNT (USED_HEAP_PAGES(i)) > 0) used_plhs = ＠＠ -1813,9 +1849,8 ＠＠ make_int (real_size)); return Fcons (make_int (PAGE_SIZE), - list6 (heap_sects, + list5 (heap_sects, Fnreverse (used_plhs), - Fnreverse (unmanaged_plhs), Fnreverse (free_plhs), make_int (sizeof (mc_allocator_globals)), make_int (MC_MALLOCED_BYTES))); ＠＠ -1829,3 +1864,198 ＠＠ DEFSUBR (Fmc_alloc_memory_usage); #endif /* MEMORY_USAGE_STATS */ } + + +#ifdef NEW_GC +/*--- incremental garbage collector ----------------------------------*/ + +/* access dirty bit of page header */ +void +set_dirty_bit (page_header *ph, unsigned int value) +{ + PH_DIRTY_BIT (ph) = value; +} + +void +set_dirty_bit_for_address (void *ptr, unsigned int value) +{ + set_dirty_bit (get_page_header (ptr), value); +} + +unsigned int +get_dirty_bit (page_header *ph) +{ + return PH_DIRTY_BIT (ph); +} + +unsigned int +get_dirty_bit_for_address (void *ptr) +{ + return get_dirty_bit (get_page_header (ptr)); +} + + +/* access protection bit of page header */ +void +set_protection_bit (page_header *ph, unsigned int value) +{ + PH_PROTECTION_BIT (ph) = value; +} + +void +set_protection_bit_for_address (void *ptr, unsigned int value) +{ + set_protection_bit (get_page_header (ptr), value); +} + +unsigned int +get_protection_bit (page_header *ph) +{ + return PH_PROTECTION_BIT (ph); +} + +unsigned int +get_protection_bit_for_address (void *ptr) +{ + return get_protection_bit (get_page_header (ptr)); +} + + +/* Returns the start of the page of the object pointed to by ptr. */ +void * +get_page_start (void *ptr) +{ + return PH_HEAP_SPACE (get_page_header (ptr)); +} + +/* Make PAGE_SIZE globally available. */ +EMACS_INT +mc_get_page_size () +{ + return PAGE_SIZE; +} + +/* Is the fault at ptr on a protected page? */ +EMACS_INT +fault_on_protected_page (void *ptr) +{ + page_header *ph = get_page_header_internal (ptr); + return (ph + && PH_HEAP_SPACE (ph) + && (PH_HEAP_SPACE (ph) <= ptr) + && ((void *) ((EMACS_INT) PH_HEAP_SPACE (ph) + + PH_N_PAGES (ph) * PAGE_SIZE) > ptr) + && (PH_PROTECTION_BIT (ph) == 1)); +} + + +/* Protect the heap page of given page header ph if black objects are + on the page. */ +static void +protect_heap_page (page_header *ph) +{ + if (PH_BLACK_BIT (ph)) + { + void *heap_space = PH_HEAP_SPACE (ph); + EMACS_INT heap_space_size = PH_N_PAGES (ph) * PAGE_SIZE; + vdb_protect ((void *) heap_space, heap_space_size); + PH_PROTECTION_BIT (ph) = 1; + } +} + +/* Protect all heap pages with black objects. */ +void +protect_heap_pages (void) +{ + visit_all_used_page_headers (protect_heap_page); +} + + +/* Remove protection (if there) of heap page of given page header + ph. */ +static void +unprotect_heap_page (page_header *ph) +{ + if (PH_PROTECTION_BIT (ph)) + { + void *heap_space = PH_HEAP_SPACE (ph); + EMACS_INT heap_space_size = PH_N_PAGES (ph) * PAGE_SIZE; + vdb_unprotect (heap_space, heap_space_size); + PH_PROTECTION_BIT (ph) = 0; + } +} + +/* Remove protection for all heap pages which are protected. */ +void +unprotect_heap_pages (void) +{ + visit_all_used_page_headers (unprotect_heap_page); +} + +/* Remove protection and mark page dirty. */ +void +unprotect_page_and_mark_dirty (void *ptr) +{ + page_header *ph = get_page_header (ptr); + unprotect_heap_page (ph); + PH_DIRTY_BIT (ph) = 1; +} + +/* Repush all objects on dirty pages onto the mark stack. */ +int +repush_all_objects_on_page (void *ptr) +{ + int repushed_objects = 0; + page_header *ph = get_page_header (ptr); + Rawbyte *heap_space = (Rawbyte *) PH_HEAP_SPACE (ph); + EMACS_INT heap_space_step = PH_CELL_SIZE (ph); + EMACS_INT mark_bit = 0; + EMACS_INT mark_bit_max_index = PH_CELLS_ON_PAGE (ph); + unsigned int bit = 0; + for (mark_bit = 0; mark_bit < mark_bit_max_index; mark_bit++) + { + GET_BIT (bit, ph, mark_bit * N_MARK_BITS); + if (bit == BLACK) + { + repushed_objects++; + gc_write_barrier + (wrap_pointer_1 ((heap_space + (heap_space_step * mark_bit)))); + } + } + PH_BLACK_BIT (ph) = 0; + PH_DIRTY_BIT (ph) = 0; + return repushed_objects; +} + +/* Mark black if object is currently grey. This first checks, if the + object is really allocated on the mc-heap. If it is, it can be + marked black; if it is not, it cannot be marked. */ +EMACS_INT +maybe_mark_black (void *ptr) +{ + page_header *ph = get_page_header_internal (ptr); + unsigned int bit = 0; + + if (ph && PH_PLH (ph) && PH_ON_USED_LIST_P (ph)) + { + GET_BIT (bit, ph, get_mark_bit_index (ptr, ph)); + if (bit == GREY) + { + if (!PH_BLACK_BIT (ph)) + PH_BLACK_BIT (ph) = 1; + SET_BIT (ph, get_mark_bit_index (ptr, ph), BLACK); + } + return 1; + } + return 0; +} + +/* Only for debugging --- not used anywhere in the sources. */ +EMACS_INT +object_on_heap_p (void *ptr) +{ + page_header *ph = get_page_header_internal (ptr); + return (ph && PH_ON_USED_LIST_P (ph)); +} + +#endif /* NEW_GC */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/mc-alloc.h newgc-xemacs-21.5/src/mc-alloc.h --- xemacs-21.5/src/mc-alloc.h 2005-10-14 03:22:01.000000000 +0200 +++ newgc-xemacs-21.5/src/mc-alloc.h 2005-11-20 11:17:38.000000000 +0100 ＠＠ -23,43 +23,87 ＠＠ #ifndef INCLUDED_mc_alloc_h_ #define INCLUDED_mc_alloc_h_ - -/* This is moved here from alloc.c. */ -#ifndef MALLOC_OVERHEAD -# ifdef GNU_MALLOC -# define MALLOC_OVERHEAD 0 -# elif defined (rcheck) -# define MALLOC_OVERHEAD 20 -# else -# define MALLOC_OVERHEAD 8 -# endif -#endif /* MALLOC_OVERHEAD */ - /*--- prototypes -------------------------------------------------------*/ BEGIN_C_DECLS -/* Allocation related functions and macros: */ +/* Internal Allocator Functions: */ -/* Builds and initializes all needed datastructures of the new allocator. */ +/* Initialize the allocator. This has to be called prior to + requesting memory. */ void init_mc_allocator (void); -/* Returns a pointer to a block of memory of given size on the used heap. */ +/* Allocate a block of memory of given size and return the pointer to + it. */ void *mc_alloc (size_t size); -/* Frees the object pointed to by pointer. */ +/* Allocate a block of memory as an array with elemcount elements of + given size and return the pointer to it. Arrays contain several + objects that are allocated in one consecutive block of memory with + each element being a fully qualified object---that is, it has a + Lisp object header and a mark bit. Objects like hash tables and + dynamic arrays use this function. */ +void *mc_alloc_array (size_t size, EMACS_INT elemcount); + +/* Free the object pointed to by ptr and make its memory re-usable + again. The memory must have been returned by a previous call to + mc_alloc(). This can be used to free memory explicitly, outside a + garbage collection. */ void mc_free (void *ptr); -/* Modifies the size of the memory block pointed to by ptr. The - Address of the new block of given size is returned. */ +/* Modify the size of the memory block pointed to by ptr. Return the + address of the new block of given size. The content of the memory + block will be unchanged to the minimum of the old and new sizes: if + the new size is smaller, the overlaying data is cut off; if the new + size is bigger, the newly allocated memory will be uninitialized.*/ void *mc_realloc (void *ptr, size_t size); +/* Modify the size of the array pointed to by ptr. Return the address + of the new array block with elemcount elements of given size. The + content of the memory block will be unchanged to the minimum of the + old and new sizes: if the new size is smaller, the overlaying data + is cut off; if the new size is bigger, the newly allocated memory + will be uninitialized.*/ +void *mc_realloc_array (void *ptr, size_t size, EMACS_INT elemcount); + /* Garbage collection related functions and macros: */ +#ifdef NEW_GC +enum mark_bit_colors +{ + WHITE = 0, + BLACK = 1, + GREY = 2 +}; + +/* Set the mark bit of the object pointed to by ptr to value.*/ +void set_mark_bit (void *ptr, EMACS_INT value); + +/* Return the mark bit of the object pointed to by ptr. */ +EMACS_INT get_mark_bit (void *ptr); + +/* mark bit macros */ +/* Returns true if the mark bit of the object pointed to by ptr is set. */ +#define MARKED_P(ptr) (get_mark_bit (ptr) != WHITE) + +/* Marks the object pointed to by ptr (sets the mark bit to 1). */ +#define MARK(ptr) set_mark_bit (ptr, BLACK) + +/* Unmarks the object pointed to by ptr (sets the mark bit to 0). */ +#define UNMARK(ptr) set_mark_bit (ptr, WHITE) + +#define MARK_WHITE(ptr) set_mark_bit (ptr, WHITE) +#define MARK_GREY(ptr) set_mark_bit (ptr, GREY) +#define MARK_BLACK(ptr) set_mark_bit (ptr, BLACK) + +#define MARKED_WHITE_P(ptr) (get_mark_bit (ptr) == WHITE) +#define MARKED_GREY_P(ptr) (get_mark_bit (ptr) == GREY) +#define MARKED_BLACK_P(ptr) (get_mark_bit (ptr) == BLACK) +#else /* not NEW_GC */ /* Set the mark bit of the object pointed to by ptr to value.*/ void set_mark_bit (void *ptr, EMACS_INT value); ＠＠ -75,8 +119,9 ＠＠ /* Unmarks the object pointed to by ptr (sets the mark bit to 0). */ #define UNMARK(ptr) set_mark_bit (ptr, 0) +#endif /* not NEW_GC */ -/* The finalizer of every not marked object is called. The macro +/* The finalizer of every not marked object is called. The macro MC_ALLOC_CALL_FINALIZER has to be defined and call the finalizer of the object. */ void mc_finalize (void); ＠＠ -89,24 +134,12 ＠＠ /* Portable dumper related functions and macros: */ /* The finalizer for disksave of every object is called to shrink the - dump image. The macro MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE has to + dump image. The macro MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE has to be defined and call the finalizer for disksave of the object. */ void mc_finalize_for_disksave (void); -/* Allocation function for the unmanaged heap: */ - -/* Returns a pointer to a block of memory of given size on the - unmanaged heap. */ -void *mc_alloc_unmanaged (size_t size); - -/* Modifies the size of the memory block pointed to by ptr. The - Address of the new block of given size is returned. */ -void *mc_realloc_unmanaged (void *ptr, size_t size); - - - /* Functions and macros related with allocation statistics: */ #ifdef MEMORY_USAGE_STATS ＠＠ -116,6 +149,39 ＠＠ struct overhead_stats *stats); #endif /* MEMORY_USAGE_STATS */ + +#ifdef NEW_GC +/* Incremental Garbage Collector / Write Barrier Support: */ + +/* Return the PAGESIZE the allocator uses. Generally equals to the + system's PAGESIZE. */ +EMACS_INT mc_get_page_size (void); + +/* Is the fault at ptr on a protected page? */ +EMACS_INT fault_on_protected_page (void *ptr); + +/* Remove protection (if there) of heap page of given page header + ph. */ +void protect_heap_pages (void); + +/* Remove protection for all heap pages which are protected. */ +void unprotect_heap_pages (void); + +/* Remove protection and mark page dirty. */ +void unprotect_page_and_mark_dirty (void *ptr); + +/* Repush all objects on dirty pages onto the mark stack. Return + number of repushed objects. */ +int repush_all_objects_on_page (void *ptr); + +/* Mark black if object is currently grey. */ +EMACS_INT maybe_mark_black (void *ptr); + +/* Only for debugging---not used anywhere in the sources. */ +EMACS_INT object_on_heap_p (void *ptr); + +#endif /* NEW_GC */ + END_C_DECLS #endif /* INCLUDED_mc_alloc_h_ */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/objects.c newgc-xemacs-21.5/src/objects.c --- xemacs-21.5/src/objects.c 2005-10-24 12:07:39.000000000 +0200 +++ newgc-xemacs-21.5/src/objects.c 2005-11-02 12:01:31.000000000 +0100 ＠＠ -63,7 +63,11 ＠＠ static const struct memory_description color_instance_data_description_1 []= { #ifdef HAVE_TTY +#ifdef NEW_GC + { XD_LISP_OBJECT, tty_console }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, tty_console, 1, { &tty_color_instance_data_description } }, +#endif /* not NEW_GC */ #endif { XD_END } }; ＠＠ -272,7 +276,11 ＠＠ static const struct memory_description font_instance_data_description_1 []= { #ifdef HAVE_TTY - { XD_BLOCK_PTR, tty_console, 1, { &tty_font_instance_data_description} }, +#ifdef NEW_GC + { XD_LISP_OBJECT, tty_console }, +#else /* not NEW_GC */ + { XD_BLOCK_PTR, tty_console, 1, { &tty_font_instance_data_description } }, +#endif /* not NEW_GC */ #endif { XD_END } }; diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/objects-tty.c newgc-xemacs-21.5/src/objects-tty.c --- xemacs-21.5/src/objects-tty.c 2005-01-28 03:58:51.000000000 +0100 +++ newgc-xemacs-21.5/src/objects-tty.c 2005-11-02 01:06:54.000000000 +0100 ＠＠ -42,18 +42,36 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("tty-color-instance-data", + tty_color_instance_data, + 0, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + tty_color_instance_data_description_1, + struct tty_color_instance_data); +#else /* not NEW_GC */ const struct sized_memory_description tty_color_instance_data_description = { sizeof (struct tty_color_instance_data), tty_color_instance_data_description_1 }; +#endif /* not NEW_GC */ static const struct memory_description tty_font_instance_data_description_1 [] = { { XD_LISP_OBJECT, offsetof (struct tty_font_instance_data, charset) }, { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("tty-font-instance-data", + tty_font_instance_data, + 0, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + tty_font_instance_data_description_1, + struct tty_font_instance_data); +#else /* not NEW_GC */ const struct sized_memory_description tty_font_instance_data_description = { sizeof (struct tty_font_instance_data), tty_font_instance_data_description_1 }; +#endif /* not NEW_GC */ DEFUN ("register-tty-color", Fregister_tty_color, 3, 3, 0, /* Register COLOR as a recognized TTY color. ＠＠ -176,7 +194,12 ＠＠ } /* Don't allocate the data until we're sure that we will succeed. */ +#ifdef NEW_GC + c->data = alloc_lrecord_type (struct tty_color_instance_data, + &lrecord_tty_color_instance_data); +#else /* not NEW_GC */ c->data = xnew (struct tty_color_instance_data); +#endif /* not NEW_GC */ COLOR_INSTANCE_TTY_SYMBOL (c) = name; return 1; ＠＠ -199,7 +222,11 ＠＠ tty_finalize_color_instance (Lisp_Color_Instance *c) { if (c->data) +#ifdef NEW_GC + mc_free (c->data); +#else /* not NEW_GC */ xfree (c->data, void *); +#endif /* not NEW_GC */ } static int ＠＠ -254,7 +281,12 ＠＠ } /* Don't allocate the data until we're sure that we will succeed. */ +#ifdef NEW_GC + f->data = alloc_lrecord_type (struct tty_font_instance_data, + &lrecord_tty_font_instance_data); +#else /* not NEW_GC */ f->data = xnew (struct tty_font_instance_data); +#endif /* not NEW_GC */ FONT_INSTANCE_TTY_CHARSET (f) = charset; #ifdef MULE if (CHARSETP (charset)) ＠＠ -287,7 +319,11 ＠＠ tty_finalize_font_instance (Lisp_Font_Instance *f) { if (f->data) +#ifdef NEW_GC + mc_free (f->data); +#else /* not NEW_GC */ xfree (f->data, void *); +#endif /* not NEW_GC */ } static Lisp_Object ＠＠ -363,6 +399,11 ＠＠ void syms_of_objects_tty (void) { +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (tty_color_instance_data); + INIT_LRECORD_IMPLEMENTATION (tty_font_instance_data); +#endif /* NEW_GC */ + DEFSUBR (Fregister_tty_color); DEFSUBR (Funregister_tty_color); DEFSUBR (Ffind_tty_color); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/objects-tty-impl.h newgc-xemacs-21.5/src/objects-tty-impl.h --- xemacs-21.5/src/objects-tty-impl.h 2002-06-20 23:18:39.000000000 +0200 +++ newgc-xemacs-21.5/src/objects-tty-impl.h 2005-11-02 01:07:06.000000000 +0100 ＠＠ -29,9 +29,25 ＠＠ struct tty_color_instance_data { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ Lisp_Object symbol; /* so we don't have to constantly call Fintern() */ }; +#ifdef NEW_GC +DECLARE_LRECORD (tty_color_instance_data, struct tty_color_instance_data); +#define XTTY_COLOR_INSTANCE_DATA(x) \ + XRECORD (x, tty_color_instance_data, struct tty_color_instance_data) +#define wrap_tty_color_instance_data(p) \ + wrap_record (p, tty_color_instance_data) +#define TTY_COLOR_INSTANCE_DATAP(x) RECORDP (x, tty_color_instance_data) +#define CHECK_TTY_COLOR_INSTANCE_DATA(x) \ + CHECK_RECORD (x, tty_color_instance_data) +#define CONCHECK_TTY_COLOR_INSTANCE_DATA(x) \ + CONCHECK_RECORD (x, tty_color_instance_data) +#endif /* NEW_GC */ + #define TTY_COLOR_INSTANCE_DATA(c) \ ((struct tty_color_instance_data *) (c)->data) ＠＠ -39,9 +55,25 ＠＠ struct tty_font_instance_data { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ Lisp_Object charset; }; +#ifdef NEW_GC +DECLARE_LRECORD (tty_font_instance_data, struct tty_font_instance_data); +#define XTTY_FONT_INSTANCE_DATA(x) \ + XRECORD (x, tty_font_instance_data, struct tty_font_instance_data) +#define wrap_tty_font_instance_data(p) \ + wrap_record (p, tty_font_instance_data) +#define TTY_FONT_INSTANCE_DATAP(x) RECORDP (x, tty_font_instance_data) +#define CHECK_TTY_FONT_INSTANCE_DATA(x) \ + CHECK_RECORD (x, tty_font_instance_data) +#define CONCHECK_TTY_FONT_INSTANCE_DATA(x) \ + CONCHECK_RECORD (x, tty_font_instance_data) +#endif /* NEW_GC */ + #define TTY_FONT_INSTANCE_DATA(c) \ ((struct tty_font_instance_data *) (c)->data) diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/print.c newgc-xemacs-21.5/src/print.c --- xemacs-21.5/src/print.c 2005-11-20 16:34:12.000000000 +0100 +++ newgc-xemacs-21.5/src/print.c 2005-11-22 10:06:53.000000000 +0100 ＠＠ -1733,6 +1733,17 ＠＠ if (STRINGP (obj)) { +#ifdef NEW_GC + if (!debug_can_access_memory (XSTRING_DATA (obj), + XSTRING_LENGTH (obj))) + { + write_fmt_string + (printcharfun, + "#<EMACS BUG: %p (BAD STRING DATA %p)>", + lheader, XSTRING_DATA (obj)); + break; + } +#else /* not NEW_GC */ Lisp_String *l = (Lisp_String *) lheader; if (!debug_can_access_memory (l->data_, l->size_)) { ＠＠ -1742,6 +1753,7 ＠＠ lheader, l->data_); break; } +#endif /* not NEW_GC */ } } ＠＠ -2219,9 +2231,9 ＠＠ debug_out ("#<%s addr=0x%lx uid=0x%lx>", LHEADER_IMPLEMENTATION (header)->name, (EMACS_INT) header, - LHEADER_IMPLEMENTATION (header)->basic_p ? - ((struct lrecord_header *) header)->uid : - ((struct old_lcrecord_header *) header)->uid); + (EMACS_INT) (LHEADER_IMPLEMENTATION (header)->basic_p ? + ((struct lrecord_header *) header)->uid : + ((struct old_lcrecord_header *) header)->uid)); #endif /* not MC_ALLOC */ } diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/specifier.c newgc-xemacs-21.5/src/specifier.c --- xemacs-21.5/src/specifier.c 2005-10-24 12:07:40.000000000 +0200 +++ newgc-xemacs-21.5/src/specifier.c 2005-11-02 01:08:16.000000000 +0100 ＠＠ -302,7 +302,11 ＠＠ /* don't be snafued by the disksave finalization. */ if (!for_disksave && !GHOST_SPECIFIER_P(sp) && sp->caching) { +#ifdef NEW_GC + mc_free (sp->caching); +#else /* not NEW_GC */ xfree (sp->caching, struct specifier_caching *); +#endif /* not NEW_GC */ sp->caching = 0; } } ＠＠ -382,10 +386,19 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("specifier-caching", + specifier_caching, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + specifier_caching_description_1, + struct specifier_caching); +#else /* not NEW_GC */ static const struct sized_memory_description specifier_caching_description = { sizeof (struct specifier_caching), specifier_caching_description_1 }; +#endif /* not NEW_GC */ static const struct sized_memory_description specifier_extra_description_map[] = { ＠＠ -403,8 +416,12 ＠＠ { XD_LISP_OBJECT, offsetof (Lisp_Specifier, frame_specs) }, { XD_LISP_OBJECT, offsetof (Lisp_Specifier, window_specs) }, { XD_LISP_OBJECT, offsetof (Lisp_Specifier, buffer_specs) }, +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (Lisp_Specifier, caching) }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, offsetof (Lisp_Specifier, caching), 1, { &specifier_caching_description } }, +#endif /* not NEW_GC */ { XD_LISP_OBJECT, offsetof (Lisp_Specifier, magic_parent) }, { XD_LISP_OBJECT, offsetof (Lisp_Specifier, fallback) }, { XD_BLOCK_ARRAY, offsetof (Lisp_Specifier, data), 1, ＠＠ -2996,7 +3013,12 ＠＠ assert (!GHOST_SPECIFIER_P (sp)); if (!sp->caching) +#ifdef NEW_GC + sp->caching = alloc_lrecord_type (struct specifier_caching, + &lrecord_specifier_caching); +#else /* not NEW_GC */ sp->caching = xnew_and_zero (struct specifier_caching); +#endif /* not NEW_GC */ sp->caching->offset_into_struct_window = struct_window_offset; sp->caching->value_changed_in_window = value_changed_in_window; sp->caching->offset_into_struct_frame = struct_frame_offset; ＠＠ -3349,6 +3371,9 ＠＠ syms_of_specifier (void) { INIT_LRECORD_IMPLEMENTATION (specifier); +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (specifier_caching); +#endif /* NEW_GC */ DEFSYMBOL (Qspecifierp); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/specifier.h newgc-xemacs-21.5/src/specifier.h --- xemacs-21.5/src/specifier.h 2005-10-24 12:07:41.000000000 +0200 +++ newgc-xemacs-21.5/src/specifier.h 2005-11-02 01:08:02.000000000 +0100 ＠＠ -423,6 +423,9 ＠＠ struct specifier_caching { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ int offset_into_struct_window; void (*value_changed_in_window) (Lisp_Object specifier, struct window *w, Lisp_Object oldval); ＠＠ -432,6 +435,19 ＠＠ int always_recompute; }; +#ifdef NEW_GC +DECLARE_LRECORD (specifier_caching, struct specifier_caching); +#define XSPECIFIER_CACHING(x) \ + XRECORD (x, specifier_caching, struct specifier_caching) +#define wrap_specifier_caching(p) \ + wrap_record (p, specifier_caching) +#define SPECIFIER_CACHINGP(x) RECORDP (x, specifier_caching) +#define CHECK_SPECIFIER_CACHING(x) \ + CHECK_RECORD (x, specifier_caching) +#define CONCHECK_SPECIFIER_CACHING(x) \ + CONCHECK_RECORD (x, specifier_caching) +#endif /* NEW_GC */ + /* #### get image instances out of domains! */ /* #### I think the following should ABORT() rather than return nil diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/syntax.c newgc-xemacs-21.5/src/syntax.c --- xemacs-21.5/src/syntax.c 2005-10-25 13:16:28.000000000 +0200 +++ newgc-xemacs-21.5/src/syntax.c 2005-10-29 13:53:33.000000000 +0200 ＠＠ -309,10 +309,19 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("syntax-cache", syntax_cache, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + syntax_cache_description_1, + Lisp_Syntax_Cache); +#else /* not NEW_GC */ + const struct sized_memory_description syntax_cache_description = { sizeof (struct syntax_cache), syntax_cache_description_1 }; +#endif /* not NEW_GC */ void mark_buffer_syntax_cache (struct buffer *buf) ＠＠ -344,7 +353,12 ＠＠ init_buffer_syntax_cache (struct buffer *buf) { struct syntax_cache *cache; +#ifdef NEW_GC + buf->syntax_cache = alloc_lrecord_type (struct syntax_cache, + &lrecord_syntax_cache); +#else /* not NEW_GC */ buf->syntax_cache = xnew_and_zero (struct syntax_cache); +#endif /* not NEW_GC */ cache = buf->syntax_cache; cache->object = wrap_buffer (buf); cache->buffer = buf; ＠＠ -359,7 +373,11 ＠＠ void uninit_buffer_syntax_cache (struct buffer *buf) { +#ifdef NEW_GC + mc_free (buf->syntax_cache); +#else /* not NEW_GC */ xfree (buf->syntax_cache, struct syntax_cache *); +#endif /* not NEW_GC */ buf->syntax_cache = 0; } ＠＠ -2313,6 +2331,9 ＠＠ void syms_of_syntax (void) { +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (syntax_cache); +#endif /* NEW_GC */ DEFSYMBOL (Qsyntax_table_p); DEFSYMBOL (Qsyntax_table); diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/syntax.h newgc-xemacs-21.5/src/syntax.h --- xemacs-21.5/src/syntax.h 2003-02-20 09:19:43.000000000 +0100 +++ newgc-xemacs-21.5/src/syntax.h 2005-05-23 12:49:58.000000000 +0200 ＠＠ -295,6 +295,9 ＠＠ faster than if we did the whole calculation from scratch. */ struct syntax_cache { +#ifdef NEW_GC + struct lrecord_header header; +#endif /* NEW_GC */ int use_code; /* Whether to use syntax_code or syntax_table. This is set depending on whether the ＠＠ -333,6 +336,21 ＠＠ change. */ }; +#ifdef NEW_GC +typedef struct syntax_cache Lisp_Syntax_Cache; + +DECLARE_LRECORD (syntax_cache, Lisp_Syntax_Cache); + +#define XSYNTAX_CACHE(x) \ + XRECORD (x, syntax_cache, Lisp_Syntax_Cache) +#define wrap_syntax_cache(p) wrap_record (p, syntax_cache) +#define SYNTAX_CACHE_P(x) RECORDP (x, syntax_cache) +#define CHECK_SYNTAX_CACHE(x) CHECK_RECORD (x, syntax_cache) +#define CONCHECK_SYNTAX_CACHE(x) CONCHECK_RECORD (x, syntax_cache) +#endif /* NEW_GC */ + + + extern const struct sized_memory_description syntax_cache_description; /* Note that the external interface to the syntax-cache uses charpos's, but diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/vdb.c newgc-xemacs-21.5/src/vdb.c --- xemacs-21.5/src/vdb.c 1970-01-01 01:00:00.000000000 +0100 +++ newgc-xemacs-21.5/src/vdb.c 2005-11-07 23:32:07.000000000 +0100 ＠＠ -0,0 +1,157 ＠＠ +/* Virtual diry bit implementation (platform independent) for XEmacs. + Copyright (C) 2005 Marcus Crestani. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#include <config.h> +#include "lisp.h" +#include "gc.h" +#include "mc-alloc.h" +#include "vdb.h" + + +typedef struct +{ + Dynarr_declare (void *); +} void_ptr_dynarr; + +void_ptr_dynarr *page_fault_table; + +/* Init page fault table and protect heap. */ +void +vdb_start_dirty_bits_recording (void) +{ + page_fault_table = Dynarr_new2 (void_ptr_dynarr, void *); + protect_heap_pages (); +} + +/* Remove heap protection. */ +void +vdb_stop_dirty_bits_recording (void) +{ + unprotect_heap_pages (); +} + +/* Read page fault table and pass page faults to garbage collector. */ +int +vdb_read_dirty_bits (void) +{ + int repushed_objects = 0; + Elemcount count; + for (count = Dynarr_length (page_fault_table); count; count--) + repushed_objects += + repush_all_objects_on_page (Dynarr_at (page_fault_table, count - 1)); + Dynarr_free (page_fault_table); + page_fault_table = 0; + return repushed_objects; +} + +/* Called by the page fault handler: add address to page fault table. */ +void +vdb_designate_modified (void *addr) +{ + Dynarr_add (page_fault_table, addr); +} + + +/* For testing and debugging... */ + +DEFUN ("test-vdb", Ftest_vdb, 0, 0, "", /* +Test virtual dirty bit implementation. Prints results to stderr. +*/ + ()) +{ + Rawbyte *p; + char c; + Elemcount count; + + /* Wrap up gc (if currently running). */ + gc_full (); + + /* Allocate a buffer; it will have the default + protection of PROT_READ|PROT_WRITE. */ + p = (Rawbyte *) mc_alloc (mc_get_page_size()); + set_lheader_implementation ((struct lrecord_header *) p, &lrecord_cons); + fprintf (stderr, "Allocate p: [%x ... %x], length %d\n", + (int) p, (int) (p + mc_get_page_size ()), + (int) mc_get_page_size ()); + + /* Test read. */ + fprintf (stderr, "Attempt to read p[666]... "); + c = p[666]; + fprintf (stderr, "read ok.\n"); + + /* Test write. */ + fprintf (stderr, "Attempt to write 42 to p[666]... "); + p[666] = 42; + fprintf (stderr, "write ok, p[666] = %d\n", p[666]); + + /* Mark the buffer read-only and set environemnt for write-barrier. */ + fprintf (stderr, "Write-protect the page.\n"); + MARK_BLACK (p); + vdb_start_dirty_bits_recording (); + write_barrier_enabled = 1; + + /* Test write-barrier read. */ + fprintf (stderr, "Attempt to read p[666]... "); + c = p[666]; + fprintf (stderr, "read ok.\n"); + + /* Test write-barrier write, program receives SIGSEGV. */ + fprintf (stderr, "Attempt to write 23 to p[666]... "); + p[666] = 23; + fprintf (stderr, "Written p[666] = %d\n", p[666]); + + /* Stop write-barrier mode. */ + write_barrier_enabled = 0; + MARK_WHITE (p); + vdb_unprotect (p, mc_get_page_size ()); + for (count = Dynarr_length (page_fault_table); count; count--) + if (Dynarr_at (page_fault_table, count - 1) == &p[666]) + fprintf (stderr, "VALID page fault at %x\n", + (int) Dynarr_at (page_fault_table, count - 1)); + else + fprintf (stderr, "WRONG page fault at %x\n", + (int) Dynarr_at (page_fault_table, count - 1)); + Dynarr_free (page_fault_table); + mc_free (p); + return Qnil; +} + +DEFUN ("test-segfault", Ftest_segfault, 0, 0, "", /* +Test virtual dirty bit implementation: provoke a segfault on purpose. +WARNING: this function causes a SEGFAULT on purpose and thus crashes +XEmacs! This is only used for debbugging, e.g. for testing how the +debugger behaves when XEmacs segfaults and the write barrier is +enabled. +*/ + ()) +{ + Rawbyte *q = 0; + q[0] = 23; + return Qnil; +} + +void +syms_of_vdb (void) +{ + DEFSUBR (Ftest_vdb); + DEFSUBR (Ftest_segfault); +} diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/vdb-fake.c newgc-xemacs-21.5/src/vdb-fake.c --- xemacs-21.5/src/vdb-fake.c 1970-01-01 01:00:00.000000000 +0100 +++ newgc-xemacs-21.5/src/vdb-fake.c 2005-11-20 20:13:42.000000000 +0100 ＠＠ -0,0 +1,50 ＠＠ +/* Virtual diry bit implementation for XEmacs. + Copyright (C) 2005 Marcus Crestani. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#include <config.h> +#include "lisp.h" + +void +fake_error (void) +{ + fprintf (stderr, "Incremental garbage collection not yet available on this"); + fprintf (stderr, "system.\nDon't try to set allow-incremental-gc to t.\n"); + ABORT (); +} + +void +vdb_install_signal_handler (void) +{ + allow_incremental_gc = 0; +} + +void +vdb_protect (void *UNUSED (ptr), EMACS_INT UNUSED (len)) +{ + fake_error (); +} + +void +vdb_unprotect (void *UNUSED (ptr), EMACS_INT UNUSED (len)) +{ + fake_error (); +} diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/vdb.h newgc-xemacs-21.5/src/vdb.h --- xemacs-21.5/src/vdb.h 1970-01-01 01:00:00.000000000 +0100 +++ newgc-xemacs-21.5/src/vdb.h 2005-11-01 16:21:59.000000000 +0100 ＠＠ -0,0 +1,70 ＠＠ +/* Virtual diry bit implementation for XEmacs. + Copyright (C) 2005 Marcus Crestani. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#include "lisp.h" + +#ifndef INCLUDED_vdb_h_ +#define INCLUDED_vdb_h_ + + +/*--- prototypes -------------------------------------------------------*/ + +BEGIN_C_DECLS + +/* Platform dependent signal handling: */ + +/* Install the platform-dependent signal handler. */ +void vdb_install_signal_handler (void); + +/* Platform dependent memory protection. */ +void vdb_protect (void *ptr, EMACS_INT len); +void vdb_unprotect (void *ptr, EMACS_INT len); + + + +/* Common (platform independent) virtual diry bit stuff: */ + +/* Start the write barrier. This function is called when a garbage + collection is suspendend and the client is resumed. */ +void vdb_start_dirty_bits_recording (void); +/* Stop the write barrier. This function is called when the client is + suspendend and garbage collection is resumed. */ +void vdb_stop_dirty_bits_recording (void); + +/* Record page faults: Add the object pointed to by addr to the write + barrer's internal data structure that stores modified objects. + This function is called by the write barrier's fault handler. */ +void vdb_designate_modified (void *addr); + +/* Propagate page faults to garbage collector: Read out the write + barrier's internal data structure that stores modified objects and + pass the information to the garbage collector. This function is + called by vdb_stop_dirty_bits_recording(). Return how many objects + have to be re-examined by the garbage collector. */ +int vdb_read_dirty_bits (void); + +/* Provides Lisp functions for testing vdb implementation. */ +void syms_of_vdb (void); + +END_C_DECLS + +#endif /* INCLUDED_vdb_h_ */ diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/vdb-mach.c newgc-xemacs-21.5/src/vdb-mach.c --- xemacs-21.5/src/vdb-mach.c 1970-01-01 01:00:00.000000000 +0100 +++ newgc-xemacs-21.5/src/vdb-mach.c 2005-11-01 17:48:56.000000000 +0100 ＠＠ -0,0 +1,261 ＠＠ +/* Virtual diry bit implementation for XEmacs. + Copyright (C) 2005 Marcus Crestani. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#include <config.h> +#include "lisp.h" +#include "gc.h" +#include "mc-alloc.h" +#include "vdb.h" + +#include <errno.h> +#include <signal.h> +#include <sys/mman.h> +#include <sys/time.h> +#include <sys/resource.h> +#include <unistd.h> +#include <mach/mach.h> +#include <mach/mach_error.h> +#include <architecture/ppc/cframe.h> + + +/* the structure of an exception msg and its reply */ +typedef struct rep_msg { + mach_msg_header_t head; + NDR_record_t NDR; + kern_return_t ret_code; +} mach_reply_msg_t; + +typedef struct exc_msg { + mach_msg_header_t head; + /* start of the kernel processed data */ + mach_msg_body_t msgh_body; + mach_msg_port_descriptor_t thread; + mach_msg_port_descriptor_t task; + /* end of the kernel processed data */ + NDR_record_t NDR; + exception_type_t exception; + mach_msg_type_number_t code_cnt; + exception_data_t code; + /* some padding */ + char pad[512]; +} mach_exc_msg_t; + +/* this is a neat little mach callback */ +extern boolean_t exc_server(mach_msg_header_t *in, mach_msg_header_t *out); + +/* these are the globals everyone needs */ +static size_t page_size = 16384; +static mach_port_t task_self = NULL; +static mach_port_t exc_port = NULL; + +/* these are some less neat mach callbacks */ +kern_return_t +catch_exception_raise_state +(mach_port_t UNUSED (port), + exception_type_t UNUSED (exception_type), + exception_data_t UNUSED (exception_data), + mach_msg_type_number_t UNUSED (data_cnt), + thread_state_flavor_t *UNUSED (flavor), + thread_state_t UNUSED (in_state), + mach_msg_type_number_t UNUSED (is_cnt), + thread_state_t UNUSED (out_state), + mach_msg_type_number_t UNUSED (os_cnt)) +{ + return KERN_FAILURE; +} + +kern_return_t +catch_exception_raise_state_identitity +(mach_port_t UNUSED (port), + mach_port_t UNUSED (thread_port), + mach_port_t UNUSED (task_port), + exception_type_t UNUSED (exception_type), + exception_data_t UNUSED (exception_data), + mach_msg_type_number_t UNUSED (data_count), + thread_state_flavor_t *UNUSED (state_flavor), + thread_state_t UNUSED (in_state), + mach_msg_type_number_t UNUSED (in_state_count), + thread_state_t UNUSED (out_state), + mach_msg_type_number_t UNUSED (out_state_count)) +{ + return KERN_FAILURE; +} + +kern_return_t +catch_exception_raise +(mach_port_t UNUSED (port), + mach_port_t UNUSED (thread_port), + mach_port_t UNUSED (task_port), + exception_type_t UNUSED (exception_type), + exception_data_t exception_data, + mach_msg_type_number_t UNUSED (data_count)) +{ + /* kernel return value is in exception_data[0], faulting address in + exception_data[1] */ + if (write_barrier_enabled + && (fault_on_protected_page ((void *) exception_data[1])) + && exception_data[0] == KERN_PROTECTION_FAILURE) + { + vdb_designate_modified ((void *) exception_data[1]); + unprotect_page_and_mark_dirty ((void *) exception_data[1]); + return KERN_SUCCESS; + } + else /* default sigsegv handler */ + { + fprintf (stderr, "\n\nFatal Error: Received %s (%d) for address 0x%x\n", + "EXC_BAD_ACCESS", exception_data[0], (int) exception_data[1]); + return KERN_FAILURE; + } +} + +/* this is the thread which forwards of exceptions read from the exception + server off to our exception catchers and then back out to the other + thread */ +void +exception_thread(void) +{ + mach_msg_header_t *message; + mach_msg_header_t *reply; + kern_return_t retval; + + /* allocate the space for the message and reply */ + message = (mach_msg_header_t *) malloc (sizeof (mach_exc_msg_t)); + reply = (mach_msg_header_t *) malloc (sizeof (mach_reply_msg_t)); + /* do this loop forever */ + while (1) + { + /* block until we get an exception message */ + retval = mach_msg (message, MACH_RCV_MSG, 0, sizeof (mach_exc_msg_t), + exc_port, MACH_MSG_TIMEOUT_NONE, MACH_PORT_NULL); + /* forward off the handling of this message */ + if (!exc_server (message, reply)) + { + fprintf (stderr, "INTERNAL ERROR: exc_server() failed.\n"); + ABORT (); + } + /* send the message back out to the thread */ + retval = mach_msg (reply, MACH_SEND_MSG, sizeof (mach_reply_msg_t), 0, + MACH_PORT_NULL, MACH_MSG_TIMEOUT_NONE, + MACH_PORT_NULL); + } +} + +/* this initializes the subsystem (sets the exception port, starts the + exception handling thread, etc) */ +void +vdb_install_signal_handler (void) +{ + mach_port_t thread_self, exc_port_s, exc_thread; + ppc_thread_state_t *exc_thread_state; + mach_msg_type_name_t type; + void *subthread_stack; + kern_return_t retval; + + /* get ids for ourself */ + if (!task_self) + task_self = mach_task_self (); + thread_self = mach_thread_self (); + + /* allocate the port we're going to get exceptions on */ + retval = mach_port_allocate (task_self, MACH_PORT_RIGHT_RECEIVE, &exc_port); + if (retval != KERN_SUCCESS) + { + fprintf (stderr, "Couldn't allocate exception port: %s\n", + mach_error_string (retval)); + ABORT (); + } + + /* extract out the send rights for that port, which the OS needs */ + retval = mach_port_extract_right (task_self, exc_port, + MACH_MSG_TYPE_MAKE_SEND, + &exc_port_s, &type); + if(retval != KERN_SUCCESS) + { + fprintf (stderr, "Couldn't extract send rights: %s\n", + mach_error_string (retval)); + ABORT (); + } + + /* set the exception ports for this thread to the above */ + retval = thread_set_exception_ports(thread_self, EXC_MASK_BAD_ACCESS, + exc_port_s, EXCEPTION_DEFAULT, + PPC_THREAD_STATE); + if(retval != KERN_SUCCESS) + { + fprintf (stderr, "Couldn't set exception ports: %s\n", + mach_error_string (retval)); + ABORT (); + } + + /* set up the subthread */ + retval = thread_create(task_self, &exc_thread); + if(retval != KERN_SUCCESS) + { + fprintf (stderr , "Couldn't create exception thread: %s\n", + mach_error_string (retval)); + ABORT (); + } + subthread_stack = (void *) malloc (page_size); + subthread_stack = + (char *) subthread_stack + (page_size - C_ARGSAVE_LEN - C_RED_ZONE); + exc_thread_state = + (ppc_thread_state_t *) malloc (sizeof (ppc_thread_state_t)); + exc_thread_state->srr0 = (unsigned int) exception_thread; + exc_thread_state->r1 = (unsigned int) subthread_stack; + retval = thread_set_state (exc_thread, PPC_THREAD_STATE, + (thread_state_t) exc_thread_state, + PPC_THREAD_STATE_COUNT); + if (retval != KERN_SUCCESS) + { + fprintf (stderr, "Couldn't set subthread state: %s\n", + mach_error_string (retval)); + ABORT (); + } + retval = thread_resume (exc_thread); + if (retval != KERN_SUCCESS) + { + fprintf (stderr, "Couldn't resume subthread: %s\n", + mach_error_string (retval)); + ABORT (); + } + allow_incremental_gc = 1; +} + +void +vdb_protect (void *ptr, EMACS_INT len) +{ + if (mprotect (ptr, len, PROT_READ)) + { + perror ("Couldn't mprotect"); + ABORT (); + } +} + +void +vdb_unprotect (void *ptr, EMACS_INT len) +{ + if (mprotect (ptr, len, PROT_READ | PROT_WRITE)) + { + perror ("Couldn't mprotect"); + ABORT (); + } +} diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/vdb-posix.c newgc-xemacs-21.5/src/vdb-posix.c --- xemacs-21.5/src/vdb-posix.c 1970-01-01 01:00:00.000000000 +0100 +++ newgc-xemacs-21.5/src/vdb-posix.c 2005-11-01 19:34:38.000000000 +0100 ＠＠ -0,0 +1,153 ＠＠ +/* Virtual diry bit implementation for XEmacs. + Copyright (C) 2005 Marcus Crestani. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#include <config.h> +#include "lisp.h" +#include "gc.h" +#include "mc-alloc.h" +#include "vdb.h" + +#include <errno.h> +#include <signal.h> +#include <sys/mman.h> + +#if defined (HAVE_SIGACTION) +# if defined (HAVE_STRUCT_SIGINFO_SI_ADDR) +# define FAULT_HANDLER_ARGUMENTS \ + int signum, struct siginfo *siginfo, void *UNUSED (ctx) +# define GET_FAULT_ADDRESS siginfo->si_addr +# elif defined (HAVE_SIGINFO_T_SI_ADDR) +# define FAULT_HANDLER_ARGUMENTS \ + int signum, siginfo_t *siginfo, void *UNUSED (ctx) +# define GET_FAULT_ADDRESS siginfo->si_addr +# endif +# define USE_SIGACTION +# define FAULT_HANDLER_REMOVE_HANDLER +#elif defined (HAVE_SIGNAL) +# define FAULT_HANDLER_ARGUMENTS int signum, struct sigcontext sc +# define GET_FAULT_ADDRESS (void *) sc.cr2 +# define USE_SIGNAL +#endif + + +#ifdef USE_SIGACTION +struct sigaction act, segv_oact, bus_oact; +#endif /* USE_SIGACTION */ + +#ifdef USE_SIGNAL +sighandler_t segv_oact, bus_oact; +#endif /* USE_SIGNAL */ + +void vdb_remove_signal_handler (void); + +void +vdb_fault_handler (FAULT_HANDLER_ARGUMENTS) +{ + if (write_barrier_enabled + && (fault_on_protected_page (GET_FAULT_ADDRESS))) + { + vdb_designate_modified (GET_FAULT_ADDRESS); + unprotect_page_and_mark_dirty (GET_FAULT_ADDRESS); +#ifdef FAULT_HANDLER_REINSTALL_HANDLER + vdb_install_signal_handler (); +#endif /* FAULT_HANDLER_REINSTALL_HANDLER */ + } + else /* default sigsegv handler */ + { + char *signal_name; + if (signum == SIGSEGV) + signal_name = "SIGSEGV"; + else if (signum == SIGBUS) + signal_name = "SIGBUS"; + else + ABORT (); /* something weird happened: wrong signal caught */ + fprintf (stderr, "\n\nFatal Error: Received %s (%d) for address 0x%x\n", + signal_name, signum, (int) GET_FAULT_ADDRESS); +#ifdef FAULT_HANDLER_CALL_PREVIOUS_HANDLER + if (signum == SIGSEGV) + segv_oact (signum); + else if (signum == SIGBUS) + bus_oact (signum); +#endif /* FAULT_HANDLER_CALL_PREVIOUS_HANDLER */ +#ifdef FAULT_HANDLER_REMOVE_HANDLER + vdb_remove_signal_handler (); +#endif /* FAULT_HANDLER_REMOVE_HANDLER */ + } +} + +void +vdb_remove_signal_handler (void) +{ +#ifdef USE_SIGACTION + sigaction(SIGSEGV, &segv_oact, 0); + sigaction(SIGBUS, &bus_oact, 0); +#endif /* USE_SIGACTION */ +#ifdef USE_SIGNAL + signal (SIGSEGV, segv_oact); + signal (SIGBUS, bus_oact); +#endif +} + +void +vdb_install_signal_handler (void) +{ + /* See init_signals_very_early () in signal.c. */ + if (noninteractive && !initialized) + { + allow_incremental_gc = 0; + return; + } + +#ifdef USE_SIGACTION + memset(&act, sizeof(struct sigaction), 0); + act.sa_sigaction = vdb_fault_handler; + sigemptyset (&act.sa_mask); + act.sa_flags = SA_SIGINFO; + sigaction (SIGSEGV, &act, &segv_oact); + sigaction (SIGBUS, &act, &bus_oact); + allow_incremental_gc = 1; +#endif /* USE_SIGACTION */ +#ifdef USE_SIGNAL + segv_oact = signal (SIGSEGV, (void (*)(int)) vdb_fault_handler); + bus_oact = signal (SIGBUS, (void (*)(int)) vdb_fault_handler); +#endif /* USE_SIGNAL */ +} + +void +vdb_protect (void *ptr, EMACS_INT len) +{ + if (mprotect (ptr, len, PROT_READ)) + { + perror ("Couldn't mprotect"); + ABORT (); + } +} + +void +vdb_unprotect (void *ptr, EMACS_INT len) +{ + if (mprotect (ptr, len, PROT_READ | PROT_WRITE)) + { + perror ("Couldn't mprotect"); + ABORT (); + } +} diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/vdb-win32.c newgc-xemacs-21.5/src/vdb-win32.c --- xemacs-21.5/src/vdb-win32.c 1970-01-01 01:00:00.000000000 +0100 +++ newgc-xemacs-21.5/src/vdb-win32.c 2005-11-01 17:49:07.000000000 +0100 ＠＠ -0,0 +1,100 ＠＠ +/* Virtual diry bit implementation for XEmacs. + Copyright (C) 2005 Marcus Crestani. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +#include <config.h> +#include "lisp.h" +#include "gc.h" +#include "mc-alloc.h" +#include "vdb.h" + +#include "syswindows.h" + + +DWORD WINAPI +win32_fault_handler (LPEXCEPTION_POINTERS e) +{ +#define GET_FAULT_ADDRESS (void *) e->ExceptionRecord->ExceptionInformation[1] + if ((e->ExceptionRecord->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) + && (e->ExceptionRecord->ExceptionInformation[0] == 1) + && write_barrier_enabled + && (fault_on_protected_page (GET_FAULT_ADDRESS))) + { + vdb_designate_modified (GET_FAULT_ADDRESS); + unprotect_page_and_mark_dirty (GET_FAULT_ADDRESS); + return EXCEPTION_CONTINUE_EXECUTION; + } + else + return EXCEPTION_CONTINUE_SEARCH; +} + +typedef DWORD (WINAPI *gcPVECTORED_EXCEPTION_HANDLER) (LPEXCEPTION_POINTERS e); + + +void +vdb_install_signal_handler (void) +{ + HMODULE hm; + PVOID (WINAPI *aveh) (ULONG, gcPVECTORED_EXCEPTION_HANDLER); + + /* See init_signals_very_early () in signal.c. */ + if (noninteractive && !initialized) + { + allow_incremental_gc = 0; + return; + } + + hm = qxeGetModuleHandle (XETEXT ("kernel32")); + if (hm) + aveh = (PVOID (WINAPI *) (ULONG, gcPVECTORED_EXCEPTION_HANDLER)) + GetProcAddress (hm, "AddVectoredExceptionHandler"); + else + { + fprintf (stderr, "\nFAILED TO LOAD LIBRARY\n"); + aveh = NULL; + } + if (aveh) + { + allow_incremental_gc = 1; + aveh (TRUE, win32_fault_handler); + } + else + { + fprintf (stderr, "\nFAILED TO INSTALL SIGNAL HANDLER\n"); + ABORT (); + } +} + + +void +vdb_protect (void *ptr, EMACS_INT len) +{ + DWORD old; + VirtualProtect (ptr, len, PAGE_READONLY, &old); +} + + +void +vdb_unprotect (void *ptr, EMACS_INT len) +{ + DWORD old; + VirtualProtect (ptr, len, PAGE_READWRITE, &old); +} diff -NaurX diff-exclude-gen -x ChangeLog xemacs-21.5/src/window.c newgc-xemacs-21.5/src/window.c --- xemacs-21.5/src/window.c 2005-11-20 16:16:44.000000000 +0100 +++ newgc-xemacs-21.5/src/window.c 2005-11-20 14:35:31.000000000 +0100 ＠＠ -181,40 +181,80 ＠＠ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("face-cachel", face_cachel, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + face_cachel_description_1, + Lisp_Face_Cachel); +#endif /* NEW_GC */ + static const struct sized_memory_description face_cachel_description = { sizeof (face_cachel), face_cachel_description_1 }; static const struct memory_description face_cachel_dynarr_description_1[] = { +#ifdef NEW_GC + XD_LISP_DYNARR_DESC (face_cachel_dynarr, &face_cachel_description), +#else /* not NEW_GC */ XD_DYNARR_DESC (face_cachel_dynarr, &face_cachel_description), +#endif /* not NEW_GC */ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("face-cachel-dynarr", face_cachel_dynarr, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + face_cachel_dynarr_description_1, + face_cachel_dynarr); +#else /* not NEW_GC */ static const struct sized_memory_description face_cachel_dynarr_description = { sizeof (face_cachel_dynarr), face_cachel_dynarr_description_1 }; +#endif /* not NEW_GC */ static const struct memory_description glyph_cachel_description_1[] = { { XD_LISP_OBJECT, offsetof (glyph_cachel, glyph) }, { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("glyph-cachel", glyph_cachel, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + glyph_cachel_description_1, + Lisp_Glyph_Cachel); +#endif /* NEW_GC */ + static const struct sized_memory_description glyph_cachel_description = { sizeof (glyph_cachel), glyph_cachel_description_1 }; static const struct memory_description glyph_cachel_dynarr_description_1[] = { +#ifdef NEW_GC + XD_LISP_DYNARR_DESC (glyph_cachel_dynarr, &glyph_cachel_description), +#else /* not NEW_GC */ XD_DYNARR_DESC (glyph_cachel_dynarr, &glyph_cachel_description), +#endif /* not NEW_GC */ { XD_END } }; +#ifdef NEW_GC +DEFINE_LRECORD_IMPLEMENTATION ("glyph-cachel-dynarr", glyph_cachel_dynarr, + 1, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + glyph_cachel_dynarr_description_1, + glyph_cachel_dynarr); +#else /* not NEW_GC */ static const struct sized_memory_description glyph_cachel_dynarr_description = { sizeof (glyph_cachel_dynarr), glyph_cachel_dynarr_description_1 }; +#endif /* not NEW_GC */ static const struct memory_description line_start_cache_description_1[] = { { XD_END } ＠＠ -241,10 +281,15 ＠＠ { XD_LISP_OBJECT_ARRAY, offsetof (struct window, slot), size }, #include "winslots.h" +#ifdef NEW_GC + { XD_LISP_OBJECT, offsetof (struct window, face_cachels) }, + { XD_LISP_OBJECT, offsetof (struct window, glyph_cachels) }, +#else /* not NEW_GC */ { XD_BLOCK_PTR, offsetof (struct window, face_cachels), 1, { &face_cachel_dynarr_description } }, { XD_BLOCK_PTR, offsetof (struct window, glyph_cachels), 1, { &glyph_cachel_dynarr_description } }, +#endif /* not NEW_GC */ { XD_BLOCK_PTR, offsetof (struct window, line_start_cache), 1, { &line_start_cache_dynarr_description }, XD_FLAG_NO_KKCC }, { XD_END } ＠＠ -362,8 +407,17 ＠＠ INIT_DISP_VARIABLE (last_point, Fmake_marker ()); INIT_DISP_VARIABLE (last_start, Fmake_marker ()); INIT_DISP_VARIABLE (last_facechange, Qzero); +#ifdef NEW_GC + p->face_cachels = Dynarr_lisp_new (face_cachel, + &lrecord_face_cachel_dynarr, + &lrecord_face_cachel); + p->glyph_cachels = Dynarr_lisp_new (glyph_cachel, + &lrecord_glyph_cachel_dynarr, + &lrecord_glyph_cachel); +#else /* not NEW_GC */ p->face_cachels = Dynarr_new (face_cachel); p->glyph_cachels = Dynarr_new (glyph_cachel); +#endif /* not NEW_GC */ p->line_start_cache = Dynarr_new (line_start_cache); p->subwindow_instance_cache = make_image_instance_cache_hash_table (); ＠＠ -3810,8 +3864,17 ＠＠ /* Don't copy the pointers to the line start cache or the face instances. */ p->line_start_cache = Dynarr_new (line_start_cache); +#ifdef NEW_GC + p->face_cachels = Dynarr_lisp_new (face_cachel, + &lrecord_face_cachel_dynarr, + &lrecord_face_cachel); + p->glyph_cachels = Dynarr_lisp_new (glyph_cachel, + &lrecord_glyph_cachel_dynarr, + &lrecord_glyph_cachel); +#else /* not NEW_GC */ p->face_cachels = Dynarr_new (face_cachel); p->glyph_cachels = Dynarr_new (glyph_cachel); +#endif /* not NEW_GC */ p->subwindow_instance_cache = make_image_instance_cache_hash_table (); ＠＠ -5384,6 +5447,12 ＠＠ { INIT_LRECORD_IMPLEMENTATION (window); INIT_LRECORD_IMPLEMENTATION (window_mirror); +#ifdef NEW_GC + INIT_LRECORD_IMPLEMENTATION (face_cachel); + INIT_LRECORD_IMPLEMENTATION (face_cachel_dynarr); + INIT_LRECORD_IMPLEMENTATION (glyph_cachel); + INIT_LRECORD_IMPLEMENTATION (glyph_cachel_dynarr); +#endif /* NEW_GC */ DEFSYMBOL (Qwindowp); DEFSYMBOL (Qwindow_live_p); -- Marcus

APPROVE COMMIT 21.5 The incremental garbage collector is in! -- Marcus

SJT> Why doesn't this case XE_DIE? If there's a reason why developers SJT> would want this, there needs to be an option to enable it. We SJT> should _never_ allow an autodetected configuration that contains SJT> a crash we know how to prevent. Yes, you are right. I don't know too much about how to do the autoconf stuff correctly... I appreciate your review! What about this patch: Index: configure.ac =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.ac,v retrieving revision 1.22 diff -u -r1.22 configure.ac --- configure.ac 25 Nov 2005 01:41:36 -0000 1.22 +++ configure.ac 25 Nov 2005 11:36:25 -0000 ＠＠ -1703,7 +1703,7 ＠＠ linux* ) check_vdb_posix=yes ;; freebsd ) check_vdb_posix=yes ;; dnl bail out immediately -dnl * ) have_vdb_fake=yes ;; +dnl * ) XE_DIE("No write barrier implementation available on this system.") dnl if not sure, try posix first, maybe we are lucky * ) check_vdb_posix=yes ;; esac ＠＠ -5963,15 +5963,6 ＠＠ fi if test "$have_vdb_mach" = yes ; then echo " Using mach exception mechanism as vdb fault handler." -fi -if test "$have_vdb_fake" = yes && test "$enable_vdb" != fake; then - echo " WARNING: ---------------------------------------------------------" - echo " WARNING: The new incremental garbage collector is enabled, but" - echo " WARNING: a virtual dirty bit implementation is not yet available" - echo " WARNING: on this system. XEmacs will crash if you try to switch on" - echo " WARNUNG: incremental garbage collection!" - echo " WARNING: Use \`--disable-newgc' to turn incremental gc off." - echo " WARNING: ---------------------------------------------------------" fi if test "$have_vdb_fake" = yes && test "$enable_vdb" == fake; then echo " Virtual dirty bit write barrier manually disabled." Note that the XE_DIE case is commented out: Currently I'd prefer to test if the platform supports POSIX if it is not listed explicitly. Later, when this list is more complete, the XE_DIE case should be used. If you do not want to have the comment in at all, I'll remove it. BTW, the option to force a write barrier is already there: `--with-vdb=TYPE'. SJT> However, I would like to ask about the extreme repetitiveness of the SJT> patch; is there no way to use macro magic to avoid all of those SJT> (some hunk) SJT> #ifdef NEW_GC SJT> /* a couple lines of code */ SJT> #else /* NEW_GC */ SJT> (next hunk) SJT> #endif /* NEW_GC */ SJT> ? Currently I cannot come up with anything nicer or less repetitive. Someone else? -- Marcus

SJT> I'm pretty sure we can arrange that configure will not die until it SJT> finishes its detection. Then we can have it die with a request to SJT> mail XEmacs Beta with the information about the platform. With the patch below, configure behaves like this: If the system is not explicitly associated with a write barrier (currently only darwin, cygwin*, linux*, and freebsd are), then the configure script runs checks to determine if the POSIX write barrier can be used. I think it is reasonable to assume that a system that knows about autoconf also knows about POSIX. The "POSIX checks" include checks for functions like `mprotect', `sigaction', `signal', and checks for struct members like `struct siginfo.si_addr', `siginfo_t.si_addr', and `struct sigcontext.cr2'. If the functions and structs are not available in certain combinations, configure dies: Error: No working write-barrier implementation found for this system. Please report this and provide information about your system. I'll commit this tomorrow, if nobody objects. Or earlier, to not delay the release. Stephen? ChangeLog addition: 2005-11-27 Marcus Crestani <crestani(a)xemacs.org&gt; * configure.ac: Remove vdb-fake warning, die if POSIX checks fail. xemacs-21.5 source patch: Diff command: cvs -q diff -u Files affected: configure.ac configure Index: configure =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure,v retrieving revision 1.264 diff -u -r1.264 configure --- configure 26 Nov 2005 18:49:06 -0000 1.264 +++ configure 27 Nov 2005 10:17:16 -0000 ＠＠ -30040,6 +30040,8 ＠＠ if test "$have_vdb_sigaction" != "yes" -a "$have_vdb_signal" != "yes" ; then have_vdb_posix=no have_vdb_fake=yes + { echo "Error:" "No working write-barrier implementation found for this system. + Please report this and provide information about your system." >&2; exit 1; } else have_vdb_posix=yes have_vdb_fake=no ＠＠ -39336,15 +39338,6 ＠＠ fi if test "$have_vdb_mach" = yes ; then echo " Using mach exception mechanism as vdb fault handler." -fi -if test "$have_vdb_fake" = yes && test "$enable_vdb" != fake; then - echo " WARNING: ---------------------------------------------------------" - echo " WARNING: The new incremental garbage collector is enabled, but" - echo " WARNING: a virtual dirty bit implementation is not yet available" - echo " WARNING: on this system. XEmacs will crash if you try to switch on" - echo " WARNUNG: incremental garbage collection!" - echo " WARNING: Use \`--disable-newgc' to turn incremental gc off." - echo " WARNING: ---------------------------------------------------------" fi if test "$have_vdb_fake" = yes && test "$enable_vdb" == fake; then echo " Virtual dirty bit write barrier manually disabled." Index: configure.ac =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.ac,v retrieving revision 1.25 diff -u -r1.25 configure.ac --- configure.ac 26 Nov 2005 18:49:09 -0000 1.25 +++ configure.ac 27 Nov 2005 10:17:20 -0000 ＠＠ -1729,8 +1729,6 ＠＠ cygwin* ) AC_DEFINE(VDB_WIN32) have_vdb_win32=yes ;; linux* ) check_vdb_posix=yes ;; freebsd ) check_vdb_posix=yes ;; -dnl bail out immediately -dnl * ) have_vdb_fake=yes ;; dnl if not sure, try posix first, maybe we are lucky * ) check_vdb_posix=yes ;; esac ＠＠ -4609,6 +4607,8 ＠＠ if test "$have_vdb_sigaction" != "yes" -a "$have_vdb_signal" != "yes" ; then have_vdb_posix=no have_vdb_fake=yes + XE_DIE("No working write-barrier implementation found for this system. + Please report this and provide information about your system.") else have_vdb_posix=yes have_vdb_fake=no ＠＠ -6083,15 +6083,6 ＠＠ fi if test "$have_vdb_mach" = yes ; then echo " Using mach exception mechanism as vdb fault handler." -fi -if test "$have_vdb_fake" = yes && test "$enable_vdb" != fake; then - echo " WARNING: ---------------------------------------------------------" - echo " WARNING: The new incremental garbage collector is enabled, but" - echo " WARNING: a virtual dirty bit implementation is not yet available" - echo " WARNING: on this system. XEmacs will crash if you try to switch on" - echo " WARNUNG: incremental garbage collection!" - echo " WARNING: Use \`--disable-newgc' to turn incremental gc off." - echo " WARNING: ---------------------------------------------------------" fi if test "$have_vdb_fake" = yes && test "$enable_vdb" == fake; then echo " Virtual dirty bit write barrier manually disabled." -- Marcus

COMMIT 21.5 I've committed this. SJT> I'll take a look at the code and see if I can arrange to print SJT> more information that might help you implement vdb on so far SJT> unsupported platforms. SJT> Off hand, I guess you'd like to know the results of those tests, SJT> and the system configuration. Anything else? No, that's all. Thanks! -- Marcus