Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 2720:6fa9919a9a0b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-04-08 23:10:01 by crestani] ChangeLog addition: 2005-04-01  Marcus Crestani  <crestani@xemacs.org>         The new allocator.         New configure flag: `MC_ALLOC':         * configure.ac (XE_COMPLEX_ARG_ENABLE): Add `--enable-mc-alloc' as         a new configure flag.         * configure.in (AC_INIT_PARSE_ARGS): Add `--mc-alloc' as a new         configure flag.         * configure.usage: Add description for `mc-alloc'.         DUMP_IN_EXEC:         * Makefile.in.in: Condition the installation of a separate dump         file on !DUMP_ON_EXEC.         * configure.ac (XE_COMPLEX_ARG_ENABLE): Add         `--enable-dump-in-exec' as a new configure flag.         * configure.ac: DUMP_IN_EXEC is define as default for PDUMP but         not default for MC_ALLOC.         * configure.in (AC_INIT_PARSE_ARGS): Add `--dump-in-exec' as a         new configure flag.         * configure.in: DUMP_IN_EXEC is define as default for PDUMP but         not default for MC_ALLOC.         * configure.usage: Add description for `dump-in-exec'. lib-src/ChangeLog addition: 2005-04-01  Marcus Crestani  <crestani@xemacs.org>         The new allocator.         DUMP_IN_EXEC:                  * Makefile.in.in: Only compile insert-data-in-exec if         DUMP_IN_EXEC is defined. lisp/ChangeLog addition: 2005-04-01  Marcus Crestani  <crestani@xemacs.org>         The new allocator.         MEMORY_USAGE_STATS         * diagnose.el: Add new lisp function to pretty print statistics         about the new allocator.         * diagnose.el (show-mc-alloc-memory-usage): New. modules/ChangeLog addition: 2005-04-01  Marcus Crestani  <crestani@xemacs.org>         The new allocator.         Remove Lcrecords:                  * postgresql/postgresql.c (allocate_pgconn): Allocate with new         allocator.         * postgresql/postgresql.c (allocate_pgresult): Allocate PGresult         with new allocator.           * postgresql/postgresql.h (struct Lisp_PGconn): Add         lrecord_header.         * postgresql/postgresql.h (struct Lisp_PGresult): Add         lrecord_header.         * ldap/eldap.c (allocate_ldap): Allocate with new allocator.         * ldap/eldap.h (struct Lisp_LDAP): Add lrecord_header. nt/ChangeLog addition: 2005-04-01  Marcus Crestani  <crestani@xemacs.org>         The new allocator.         New configure flag: `MC_ALLOC':         * config.inc.samp: Add new flag `MC_ALLOC'.         * xemacs.mak: Add flag and configuration output for `MC_ALLOC'.         New files:         * xemacs.dsp: Add source files mc-alloc.c and mc-alloc.h.         * xemacs.mak: Add new object file mc-alloc.obj to dependencies. src/ChangeLog addition: 2005-04-01  Marcus Crestani  <crestani@xemacs.org>         The new allocator.         New configure flag: `MC_ALLOC':         * config.h.in: Add new flag `MC_ALLOC'.         New files:         * Makefile.in.in: Add new object file mc-alloc.o.         * depend: Add new files to dependencies.         * mc-alloc.c: New.         * mc-alloc.h: New.         Running the new allocator from XEmacs:         * alloc.c (deadbeef_memory): Moved to mc-alloc.c.         * emacs.c (main_1): Initialize the new allocator and add         syms_of_mc_alloc.         * symsinit.h: Add syms_of_mc_alloc.         New lrecord allocation and free functions:         * alloc.c (alloc_lrecord): New. Allocates an lrecord, includes         type checking and initializing of the lrecord_header.         * alloc.c (noseeum_alloc_lrecord): Same as above, but increments         the NOSEEUM cons counter.         * alloc.c (free_lrecord): New. Calls the finalizer and frees the         lrecord.         * lrecord.h: Add lrecord allocation prototypes and comments.         Remove old lrecord FROB block allocation:                  * alloc.c (allocate_lisp_storage): Former function to expand         heap. Not needed anymore, remove.         * alloc.c: Completely remove `Fixed-size type macros'         * alloc.c (release_breathing_space): Remove.         * alloc.c (memory_full): Remove release_breathing_space.         * alloc.c (refill_memory_reserve): Remove.         * alloc.c (TYPE_ALLOC_SIZE): Remove.         * alloc.c (DECLARE_FIXED_TYPE_ALLOC): Remove.         * alloc.c (ALLOCATE_FIXED_TYPE_FROM_BLOCK): Remove.         * alloc.c (ALLOCATE_FIXED_TYPE_1): Remove.         * alloc.c (ALLOCATE_FIXED_TYPE): Remove.         * alloc.c (NOSEEUM_ALLOCATE_FIXED_TYPE): Remove.         * alloc.c (struct Lisp_Free): Remove.         * alloc.c (LRECORD_FREE_P): Remove.         * alloc.c (MARK_LRECORD_AS_FREE): Remove.         * alloc.c (MARK_LRECORD_AS_NOT_FREE): Remove.         * alloc.c (PUT_FIXED_TYPE_ON_FREE_LIST): Remove.         * alloc.c (FREE_FIXED_TYPE): Remove.         * alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC): Remove.         Allocate old lrecords with new allocator:                  * alloc.c: DECLARE_FIXED_TYPE_ALLOC removed for all lrecords         defined in alloc.c.         * alloc.c (Fcons): Allocate with new allocator.         * alloc.c (noseeum_cons): Allocate with new allocator.         * alloc.c (make_float): Allocate with new allocator.         * alloc.c (make_bignum): Allocate with new allocator.         * alloc.c (make_bignum_bg): Allocate with new allocator.         * alloc.c (make_ratio): Allocate with new allocator.         * alloc.c (make_ratio_bg): Allocate with new allocator.         * alloc.c (make_ratio_rt): Allocate with new allocator.         * alloc.c (make_bigfloat): Allocate with new allocator.         * alloc.c (make_bigfloat_bf): Allocate with new allocator.         * alloc.c (make_compiled_function): Allocate with new allocator.         * alloc.c (Fmake_symbol): Allocate with new allocator.         * alloc.c (allocate_extent): Allocate with new allocator.         * alloc.c (allocate_event): Allocate with new allocator.         * alloc.c (make_key_data): Allocate with new allocator.         * alloc.c (make_button_data): Allocate with new allocator.         * alloc.c (make_motion_data): Allocate with new allocator.         * alloc.c (make_process_data): Allocate with new allocator.         * alloc.c (make_timeout_data): Allocate with new allocator.         * alloc.c (make_magic_data): Allocate with new allocator.         * alloc.c (make_magic_eval_data): Allocate with new allocator.         * alloc.c (make_eval_data): Allocate with new allocator.         * alloc.c (make_misc_user_data): Allocate with new allocator.         * alloc.c (Fmake_marker): Allocate with new allocator.         * alloc.c (noseeum_make_marker): Allocate with new allocator.         * alloc.c (make_uninit_string): Allocate with new allocator.         * alloc.c (resize_string): Allocate with new allocator.         * alloc.c (make_string_nocopy): Allocate with new allocator.         Garbage Collection:         * alloc.c (GC_CHECK_NOT_FREE): Remove obsolete assertions.         * alloc.c (SWEEP_FIXED_TYPE_BLOCK): Remove.         * alloc.c (SWEEP_FIXED_TYPE_BLOCK_1): Remove.         * alloc.c (sweep_conses): Remove.         * alloc.c (free_cons): Use new allocator to free.         * alloc.c (sweep_compiled_functions): Remove.         * alloc.c (sweep_floats): Remove.         * alloc.c (sweep_bignums): Remove.         * alloc.c (sweep_ratios): Remove.         * alloc.c (sweep_bigfloats): Remove.         * alloc.c (sweep_symbols): Remove.         * alloc.c (sweep_extents): Remove.         * alloc.c (sweep_events): Remove.         * alloc.c (sweep_key_data): Remove.         * alloc.c (free_key_data): Use new allocator to free.         * alloc.c (sweep_button_data): Remove.         * alloc.c (free_button_data): Use new allocator to free.         * alloc.c (sweep_motion_data): Remove.         * alloc.c (free_motion_data): Use new allocator to free.         * alloc.c (sweep_process_data): Remove.         * alloc.c (free_process_data): Use new allocator to free.         * alloc.c (sweep_timeout_data): Remove.         * alloc.c (free_timeout_data): Use new allocator to free.         * alloc.c (sweep_magic_data): Remove.         * alloc.c (free_magic_data): Use new allocator to free.         * alloc.c (sweep_magic_eval_data): Remove.         * alloc.c (free_magic_eval_data): Use new allocator to free.         * alloc.c (sweep_eval_data): Remove.         * alloc.c (free_eval_data): Use new allocator to free.         * alloc.c (sweep_misc_user_data): Remove.         * alloc.c (free_misc_user_data): Use new allocator to free.         * alloc.c (sweep_markers): Remove.         * alloc.c (free_marker): Use new allocator to free.         * alloc.c (garbage_collect_1): Remove release_breathing_space.         * alloc.c (gc_sweep): Remove all the old lcrecord and lrecord         related stuff. Sweeping now works like this: compact string         chars, finalize, sweep.         * alloc.c (common_init_alloc_early): Remove old lrecord         initializations, remove breathing_space.         * emacs.c (Fdump_emacs): Remove release_breathing_space.         * lisp.h: Remove prototype for release_breathing_space.         * lisp.h: Adjust the special cons mark makros.         Lrecord Finalizer:         * alloc.c: Add finalizer to lrecord definition.         * alloc.c (finalize_string): Add finalizer for string.         * bytecode.c: Add finalizer to lrecord definition.         * bytecode.c (finalize_compiled_function): Add finalizer for         compiled function.         * marker.c: Add finalizer to lrecord definition.         * marker.c (finalize_marker): Add finalizer for marker.         These changes build the interface to mc-alloc:         * lrecord.h (MC_ALLOC_CALL_FINALIZER): Tell mc-alloc how to         finalize lrecords.         * lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE): Tell         mc-alloc how to finalize for disksave.         Unify lrecords and lcrecords:         * lisp.h (struct Lisp_String): Adjust string union hack to         new lrecord header.         * lrecord.h: Adjust comments.         * lrecord.h (struct lrecord_header): The new lrecord header         includes type, lisp-readonly, free, and uid.         * lrecord.h (set_lheader_implementation): Adjust to new         lrecord_header.         * lrecord.h (struct lrecord_implementation): The field basic_p         for indication of an old lrecord is not needed anymore, remove.         * lrecord.h (MAKE_LRECORD_IMPLEMENTATION): Remove basic_p.         * lrecord.h (MAKE_EXTERNAL_LRECORD_IMPLEMENTATION): Remove         basic_p.         * lrecord.h (copy_sized_lrecord): Remove distinction between         old lrecords and lcrecords.         * lrecord.h (copy_lrecord): Remove distinction between old         lrecords and lcrecords.         * lrecord.h (zero_sized_lrecord): Remove distinction between         old lrecords and lcrecords.         * lrecord.h (zero_lrecord): Remove distinction between old         lrecords and lcrecords.         Remove lcrecords and lcrecord lists:         * alloc.c (basic_alloc_lcrecord): Not needed anymore, remove.         * alloc.c (very_old_free_lcrecord): Not needed anymore, remove.         * alloc.c (copy_lisp_object): No more distinction between         lrecords and lcrecords.         * alloc.c (all_lcrecords): Not needed anymore, remove.         * alloc.c (make_vector_internal): Allocate as lrecord.         * alloc.c (make_bit_vector_internal): Allocate as lrecord.         * alloc.c: Completely remove `lcrecord lists'.         * alloc.c (free_description): Remove.         * alloc.c (lcrecord_list_description): Remove.         * alloc.c (mark_lcrecord_list): Remove.         * alloc.c (make_lcrecord_list): Remove.         * alloc.c (alloc_managed_lcrecord): Remove.         * alloc.c (free_managed_lcrecord): Remove.         * alloc.c (alloc_automanaged_lcrecord): Remove.         * alloc.c (free_lcrecord): Remove.         * alloc.c (lcrecord_stats): Remove.         * alloc.c (tick_lcrecord_stats): Remove.         * alloc.c (disksave_object_finalization_1): Add call to         mc_finalize_for_disksave. Remove the lcrecord way to visit all         objects.         * alloc.c (kkcc_marking): Remove XD_FLAG_FREE_LISP_OBJECT         * alloc.c (sweep_lcrecords_1): Remove.         * alloc.c (common_init_alloc_early): Remove everything related         to lcrecords, remove old lrecord initializations,         * alloc.c (init_lcrecord_lists): Not needed anymore, remove.         * alloc.c (reinit_alloc_early): Remove everything related to         lcrecords.         * alloc.c (init_alloc_once_early): Remove everything related to         lcrecords.         * buffer.c (allocate_buffer): Allocate as lrecord.         * buffer.c (nuke_all_buffer_slots): Use lrecord functions.         * buffer.c (common_init_complex_vars_of_buffer): Allocate as         lrecord.         * buffer.h (struct buffer): Add lrecord_header.         * casetab.c (allocate_case_table): Allocate as lrecord.         * casetab.h (struct Lisp_Case_Table): Add lrecord_header.         * charset.h (struct Lisp_Charset): Add lrecord_header.         * chartab.c (fill_char_table): Use lrecord functions.         * chartab.c (Fmake_char_table): Allocate as lrecord.         * chartab.c (make_char_table_entry): Allocate as lrecord.         * chartab.c (copy_char_table_entry): Allocate as lrecord.         * chartab.c (Fcopy_char_table): Allocate as lrecord.         * chartab.c (put_char_table): Use lrecord functions.         * chartab.h (struct Lisp_Char_Table_Entry): Add lrecord_header.         * chartab.h (struct Lisp_Char_Table): Add lrecord_header.         * console-impl.h (struct console): Add lrecord_header.         * console-msw-impl.h (struct Lisp_Devmode): Add lrecord_header.         * console-msw-impl.h (struct mswindows_dialog_id): Add         lrecord_header.         * console.c (allocate_console): Allocate as lrecord.         * console.c (nuke_all_console_slots): Use lrecord functions.         * console.c (common_init_complex_vars_of_console): Allocate as         lrecord.         * data.c (make_weak_list): Allocate as lrecord.         * data.c (make_weak_box): Allocate as lrecord.         * data.c (make_ephemeron): Allocate as lrecord.         * database.c (struct Lisp_Database): Add lrecord_header.         * database.c (allocate_database): Allocate as lrecord.         * device-impl.h (struct device): Add lrecord_header.         * device-msw.c (allocate_devmode): Allocate as lrecord.         * device.c (nuke_all_device_slots): Use lrecord functions.         * device.c (allocate_device): Allocate as lrecord.         * dialog-msw.c (handle_question_dialog_box): Allocate as lrecord.         * elhash.c (struct Lisp_Hash_Table): Add lrecord_header.         * elhash.c (make_general_lisp_hash_table): Allocate as lrecord.         * elhash.c (Fcopy_hash_table): Allocate as lrecord.         * event-stream.c: Lcrecord lists Vcommand_builder_free_list and         Vtimeout_free_list are no longer needed. Remove.         * event-stream.c (allocate_command_builder): Allocate as lrecord.         * event-stream.c (free_command_builder): Use lrecord functions.         * event-stream.c (event_stream_generate_wakeup): Allocate as         lrecord.         * event-stream.c (event_stream_resignal_wakeup): Use lrecord         functions.         * event-stream.c (event_stream_disable_wakeup): Use lrecord         functions.         * event-stream.c (reinit_vars_of_event_stream): Lcrecord lists         remove.         * events.h (struct Lisp_Timeout): Add lrecord_header.         * events.h (struct command_builder): Add lrecord_header.         * extents-impl.h (struct extent_auxiliary): Add lrecord_header.         * extents-impl.h (struct extent_info): Add lrecord_header.         * extents.c (allocate_extent_auxiliary): Allocate as lrecord.         * extents.c (allocate_extent_info): Allocate as lrecord.         * extents.c (copy_extent): Allocate as lrecord.         * faces.c (allocate_face): Allocate as lrecord.         * faces.h (struct Lisp_Face): Add lrecord_header.         * file-coding.c (allocate_coding_system): Allocate as lrecord.         * file-coding.c (Fcopy_coding_system): Allocate as lrecord.         * file-coding.h (struct Lisp_Coding_System): Add lrecord_header.         * fns.c (Ffillarray): Allocate as lrecord.         * frame-impl.h (struct frame): Add lrecord_header.         * frame.c (nuke_all_frame_slots): Use lrecord functions.         * frame.c (allocate_frame_core): Allocate as lrecord.         * glyphs.c (allocate_image_instance): Allocate as lrecord.         * glyphs.c (Fcolorize_image_instance): Allocate as lrecord.         * glyphs.c (allocate_glyph): Allocate as lrecord.         * glyphs.h (struct Lisp_Image_Instance): Add lrecord_header.         * glyphs.h (struct Lisp_Glyph): Add lrecord_header.         * gui.c (allocate_gui_item): Allocate as lrecord.         * gui.h (struct Lisp_Gui_Item): Add lrecord_header.         * keymap.c (struct Lisp_Keymap): Add lrecord_header.         * keymap.c (make_keymap): Allocate as lrecord.         * lisp.h (struct Lisp_Vector): Add lrecord_header.         * lisp.h (struct Lisp_Bit_Vector): Add lrecord_header.         * lisp.h (struct weak_box): Add lrecord_header.         * lisp.h (struct ephemeron): Add lrecord_header.         * lisp.h (struct weak_list): Add lrecord_header.         * lrecord.h (struct lcrecord_header): Not used, remove.         * lrecord.h (struct free_lcrecord_header): Not used, remove.         * lrecord.h (struct lcrecord_list): Not needed anymore, remove.         * lrecord.h (lcrecord_list): Not needed anymore, remove.         * lrecord.h: (enum data_description_entry_flags): Remove         XD_FLAG_FREE_LISP_OBJECT.         * lstream.c: Lrecord list Vlstream_free_list remove.         * lstream.c (Lstream_new): Allocate as lrecord.         * lstream.c (Lstream_delete): Use lrecod functions.         * lstream.c (reinit_vars_of_lstream): Vlstream_free_list         initialization remove.           * lstream.h (struct lstream): Add lrecord_header.         * emacs.c (main_1): Remove lstream initialization.         * mule-charset.c (make_charset): Allocate as lrecord.         * objects-impl.h (struct Lisp_Color_Instance): Add         lrecord_header.         * objects-impl.h (struct Lisp_Font_Instance): Add lrecord_header.         * objects.c (Fmake_color_instance): Allocate as lrecord.         * objects.c (Fmake_font_instance): Allocate as lrecord.         * objects.c (reinit_vars_of_objects): Allocate as lrecord.         * opaque.c: Lcreord list Vopaque_ptr_list remove.         * opaque.c (make_opaque): Allocate as lrecord.         * opaque.c (make_opaque_ptr): Allocate as lrecord.         * opaque.c (free_opaque_ptr): Use lrecord functions.         * opaque.c (reinit_opaque_early):         * opaque.c (init_opaque_once_early): Vopaque_ptr_list         initialization remove.         * opaque.h (Lisp_Opaque): Add lrecord_header.         * opaque.h (Lisp_Opaque_Ptr): Add lrecord_header.         * emacs.c (main_1): Remove opaque variable initialization.         * print.c (default_object_printer): Use new lrecord_header.         * print.c (print_internal): Use new lrecord_header.         * print.c (debug_p4): Use new lrecord_header.         * process.c (make_process_internal): Allocate as lrecord.         * procimpl.h (struct Lisp_Process): Add lrecord_header.         * rangetab.c (Fmake_range_table): Allocate as lrecord.         * rangetab.c (Fcopy_range_table): Allocate as lrecord.         * rangetab.h (struct Lisp_Range_Table): Add lrecord_header.         * scrollbar.c (create_scrollbar_instance): Allocate as lrecord.         * scrollbar.h (struct scrollbar_instance): Add lrecord_header.         * specifier.c (make_specifier_internal): Allocate as lrecord.         * specifier.h (struct Lisp_Specifier): Add lrecord_header.         * symbols.c:         * symbols.c (Fmake_variable_buffer_local): Allocate as lrecord.         * symbols.c (Fdontusethis_set_symbol_value_handler): Allocate         as lrecord.         * symbols.c (Fdefvaralias): Allocate as lrecord.         * symeval.h (struct symbol_value_magic): Add lrecord_header.         * toolbar.c (update_toolbar_button): Allocate as lrecord.         * toolbar.h (struct toolbar_button): Add lrecord_header.         * tooltalk.c (struct Lisp_Tooltalk_Message): Add lrecord_header.         * tooltalk.c (make_tooltalk_message): Allocate as lrecord.         * tooltalk.c (struct Lisp_Tooltalk_Pattern): Add lrecord_header.         * tooltalk.c (make_tooltalk_pattern): Allocate as lrecord.         * ui-gtk.c (allocate_ffi_data): Allocate as lrecord.         * ui-gtk.c (allocate_emacs_gtk_object_data): Allocate as lrecord.         * ui-gtk.c (allocate_emacs_gtk_boxed_data): Allocate as lrecord.         * ui-gtk.h (structs): Add lrecord_header.         * window-impl.h (struct window): Add lrecord_header.         * window-impl.h (struct window_mirror): Add lrecord_header.         * window.c (allocate_window): Allocate as lrecord.         * window.c (new_window_mirror): Allocate as lrecord.         * window.c (make_dummy_parent): Allocate as lrecord.         MEMORY_USAGE_STATS         * alloc.c (fixed_type_block_overhead): Not used anymore, remove.         * buffer.c (compute_buffer_usage): Get storage size from new         allocator.         * marker.c (compute_buffer_marker_usage): Get storage size from         new allocator.         * mule-charset.c (compute_charset_usage): Get storage size from         new allocator.         * scrollbar-gtk.c (gtk_compute_scrollbar_instance_usage): Get         storage size from new allocator.         * scrollbar-msw.c (mswindows_compute_scrollbar_instance_usage):         Get storage size from new allocator.         * scrollbar-x.c (x_compute_scrollbar_instance_usage): Get         storage size from new allocator.         * scrollbar.c (compute_scrollbar_instance_usage): Get storage         size from new allocator.         * unicode.c (compute_from_unicode_table_size_1): Get storage         size from new allocator.         * unicode.c (compute_to_unicode_table_size_1): Get storage size         from new allocator.         * window.c (compute_window_mirror_usage): Get storage size from         new allocator.         * window.c (compute_window_usage): Get storage size from new         allocator.         MC_ALLOC_TYPE_STATS:         * alloc.c (alloc_lrecord): Bump lrecord count.         * alloc.c (noseeum_alloc_lrecord): Bump lrecord count.         * alloc.c (struct lrecord_stats): Storage for counts.         * alloc.c (init_lrecord_stats): Zero statistics.         * alloc.c (inc_lrecord_stats): Increase the statistic.         * alloc.c (dec_lrecord_stats): Decrease the statistic.         * alloc.c (gc_plist_hack): Used to print the information.         * alloc.c (Fgarbage_collect): Return the collected information.         * mc-alloc.c (remove_cell): Decrease lrecord count.         * mc-alloc.h: Set flag MC_ALLOC_TYPE_STATS.         * emacs.c (main_1): Init lrecord statistics.         * lrecord.h: Add prototypes for *_lrecord_stats.         Strings:         * alloc.c (Fmake_string): Initialize ascii_begin to zero.         * alloc.c (gc_count_num_short_string_in_use): Remove.         * alloc.c (gc_count_string_total_size): Remove.         * alloc.c (gc_count_short_string_total_size): Remove.         * alloc.c (debug_string_purity): Remove.         * alloc.c (debug_string_purity_print): Remove.         * alloc.c (sweep_strings): Remove.                  Remove static C-readonly Lisp objects:         * alloc.c (c_readonly): Not needed anymore, remove.         * alloc.c (GC_CHECK_LHEADER_INVARIANTS): Remove some obsolete         lheader invariants assertions.         * buffer.c (DEFVAR_BUFFER_LOCAL_1): Allocate dynamically.         * console.c (DEFVAR_CONSOLE_LOCAL_1): Allocate dynamically.         * gpmevent.c: Indirection via MC_ALLOC_Freceive_gpm_event.         * gpmevent.c (Fgpm_enable): Allocate dynamically.         * gpmevent.c (syms_of_gpmevent): Allocate dynamically.         * lisp.h (C_READONLY): Not needed anymore, remove.         * lisp.h (DEFUN): Allocate dynamically.         * lrecord.h (C_READONLY_RECORD_HEADER_P): Not needed anymore,         remove.         * lrecord.h (SET_C_READONLY_RECORD_HEADER): Not needed anymore,         remove.         * symbols.c (guts_of_unbound_marker):         * symeval.h (defsubr): Allocate dynamically.         * symeval.h (DEFSUBR_MACRO): Allocate dynamically.         * symeval.h (DEFVAR_ SYMVAL_FWD): Allocate dynamically.         * tests.c (TESTS_DEFSUBR): Allocate dynamically.         Definition of mcpro:         * lisp.h: Add mcpro prototypes.         * alloc.c (common_init_alloc_early): Add initialization for         mcpros.         * alloc.c (mcpro_description_1): New.         * alloc.c (mcpro_description): New.         * alloc.c (mcpros_description_1): New.         * alloc.c (mcpros_description): New.         * alloc.c (mcpro_one_name_description_1): New.         * alloc.c (mcpro_one_name_description): New.         * alloc.c (mcpro_names_description_1): New.         * alloc.c (mcpro_names_description): New.         * alloc.c (mcpros): New.         * alloc.c (mcpro_names): New.         * alloc.c (mcpro_1): New.         * alloc.c (mc_pro): New.         * alloc.c (garbage_collect_1): Add mcpros to root set.         Usage of mcpro:         * alloc.c (make_string_nocopy): Add string to root set.         * symbols.c (init_symbols_once_early): Add Qunbound to root set.         Changes to the Portable Dumper:                  * alloc.c (FREE_OR_REALLOC_BEGIN): Since dumped objects can be         freed with the new allocator, remove assertion for !DUMPEDP.         * dumper.c: Adjust comments, increase PDUMP_HASHSIZE.         * dumper.c (pdump_make_hash): Shift address only 2 bytes, to         avoid collisions.         * dumper.c (pdump_objects_unmark): No more mark bits within         the object, remove.         * dumper.c (mc_addr_elt): New. Element data structure for mc         hash table.         * dumper.c (pdump_mc_hash): New hash table: `lookup table'.         * dumper.c (pdump_get_mc_addr): New. Lookup for hash table.         * dumper.c (pdump_get_indirect_mc_addr): New. Lookup for         convertibles.         * dumper.c (pdump_put_mc_addr): New. Putter for hash table.         * dumper.c (pdump_dump_mc_data): New. Writes the table for         relocation at load time to the dump file.         * dumper.c (pdump_scan_lisp_objects_by_alignment): New.         Visits all dumped Lisp objects.         * dumper.c (pdump_scan_non_lisp_objects_by_alignment): New.         Visits all other dumped objects.         * dumper.c (pdump_reloc_one_mc): New. Updates all pointers         of an object by using the hash table pdump_mc_hash.         * dumper.c (pdump_reloc_one): Replaced by pdump_reloc_one_mc.         * dumper.c (pdump): Change the structure of the dump file, add         the mc post dump relocation table to dump file.         * dumper.c (pdump_load_finish): Hand all dumped objects to the         new allocator and use the mc post dump relocation table for         relocating the dumped objects at dump file load time, free not         longer used data structures.         * dumper.c (pdump_load): Free the dump file.         * dumper.h: Remove pdump_objects_unmark.         * lrecord.h (DUMPEDP): Dumped objects can be freed, remove.              DUMP_IN_EXEC:         * Makefile.in.in: Linking for and with dump in executable only if         DUMP_IN_EXEC is defined.         * config.h.in: Add new flag `DUMP_IN_EXEC'         * emacs.c: Condition dump-data.h on DUMP_IN_EXEC.         * emacs.c (main_1): Flag `-si' only works if dump image is         written into executable.         Miscellanious         * lrecord.h (enum lrecord_type): Added numbers to all types,         very handy for debugging.         * xemacs.def.in.in: Add mc-alloc functions to make them visible         to the modules.
author crestani
date Fri, 08 Apr 2005 23:11:35 +0000
parents 7bf1f40e6acb
children 05d62157e048
comparison
equal deleted inserted replaced
2719:5f6ef2b26d9f 2720:6fa9919a9a0b
218 /* Very cheesy ways of figuring out how much memory is being used for 218 /* Very cheesy ways of figuring out how much memory is being used for
219 data. #### Need better (system-dependent) ways. */ 219 data. #### Need better (system-dependent) ways. */
220 void *minimum_address_seen; 220 void *minimum_address_seen;
221 void *maximum_address_seen; 221 void *maximum_address_seen;
222 222
223 #ifndef MC_ALLOC
223 int 224 int
224 c_readonly (Lisp_Object obj) 225 c_readonly (Lisp_Object obj)
225 { 226 {
226 return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj); 227 return POINTER_TYPE_P (XTYPE (obj)) && C_READONLY (obj);
227 } 228 }
229 #endif /* MC_ALLOC */
228 230
229 int 231 int
230 lisp_readonly (Lisp_Object obj) 232 lisp_readonly (Lisp_Object obj)
231 { 233 {
232 return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj); 234 return POINTER_TYPE_P (XTYPE (obj)) && LISP_READONLY (obj);
241 243
242 /* Non-zero means ignore malloc warnings. Set during initialization. */ 244 /* Non-zero means ignore malloc warnings. Set during initialization. */
243 int ignore_malloc_warnings; 245 int ignore_malloc_warnings;
244 246
245 247
248 #ifndef MC_ALLOC
246 static void *breathing_space; 249 static void *breathing_space;
247 250
248 void 251 void
249 release_breathing_space (void) 252 release_breathing_space (void)
250 { 253 {
253 void *tmp = breathing_space; 256 void *tmp = breathing_space;
254 breathing_space = 0; 257 breathing_space = 0;
255 xfree (tmp, void *); 258 xfree (tmp, void *);
256 } 259 }
257 } 260 }
261 #endif /* not MC_ALLOC */
258 262
259 /* malloc calls this if it finds we are near exhausting storage */ 263 /* malloc calls this if it finds we are near exhausting storage */
260 void 264 void
261 malloc_warning (const char *str) 265 malloc_warning (const char *str)
262 { 266 {
280 It's better to loop garbage-collecting (we might reclaim enough 284 It's better to loop garbage-collecting (we might reclaim enough
281 to win) than to loop beeping and barfing "Memory exhausted" 285 to win) than to loop beeping and barfing "Memory exhausted"
282 */ 286 */
283 consing_since_gc = gc_cons_threshold + 1; 287 consing_since_gc = gc_cons_threshold + 1;
284 recompute_need_to_garbage_collect (); 288 recompute_need_to_garbage_collect ();
289 #ifndef MC_ALLOC
285 release_breathing_space (); 290 release_breathing_space ();
291 #endif /* not MC_ALLOC */
286 292
287 /* Flush some histories which might conceivably contain garbalogical 293 /* Flush some histories which might conceivably contain garbalogical
288 inhibitors. */ 294 inhibitors. */
289 if (!NILP (Fboundp (Qvalues))) 295 if (!NILP (Fboundp (Qvalues)))
290 Fset (Qvalues, Qnil); 296 Fset (Qvalues, Qnil);
322 assert (!regex_malloc_disallowed); \ 328 assert (!regex_malloc_disallowed); \
323 in_malloc = 1; \ 329 in_malloc = 1; \
324 } \ 330 } \
325 while (0) 331 while (0)
326 332
333 #ifdef MC_ALLOC
334 #define FREE_OR_REALLOC_BEGIN(block) \
335 do \
336 { \
337 /* Unbelievably, calling free() on 0xDEADBEEF doesn't cause an \
338 error until much later on for many system mallocs, such as \
339 the one that comes with Solaris 2.3. FMH!! */ \
340 assert (block != (void *) 0xDEADBEEF); \
341 MALLOC_BEGIN (); \
342 } \
343 while (0)
344 #else /* not MC_ALLOC */
327 #define FREE_OR_REALLOC_BEGIN(block) \ 345 #define FREE_OR_REALLOC_BEGIN(block) \
328 do \ 346 do \
329 { \ 347 { \
330 /* Unbelievably, calling free() on 0xDEADBEEF doesn't cause an \ 348 /* Unbelievably, calling free() on 0xDEADBEEF doesn't cause an \
331 error until much later on for many system mallocs, such as \ 349 error until much later on for many system mallocs, such as \
337 DUMPEDP. */ \ 355 DUMPEDP. */ \
338 assert (!DUMPEDP (block)); \ 356 assert (!DUMPEDP (block)); \
339 MALLOC_BEGIN (); \ 357 MALLOC_BEGIN (); \
340 } \ 358 } \
341 while (0) 359 while (0)
360 #endif /* not MC_ALLOC */
342 361
343 #define MALLOC_END() \ 362 #define MALLOC_END() \
344 do \ 363 do \
345 { \ 364 { \
346 in_malloc = 0; \ 365 in_malloc = 0; \
422 MALLOC_END (); 441 MALLOC_END ();
423 } 442 }
424 443
425 #ifdef ERROR_CHECK_GC 444 #ifdef ERROR_CHECK_GC
426 445
446 #ifndef MC_ALLOC
427 static void 447 static void
428 deadbeef_memory (void *ptr, Bytecount size) 448 deadbeef_memory (void *ptr, Bytecount size)
429 { 449 {
430 UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr; 450 UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr;
431 Bytecount beefs = size >> 2; 451 Bytecount beefs = size >> 2;
432 452
433 /* In practice, size will always be a multiple of four. */ 453 /* In practice, size will always be a multiple of four. */
434 while (beefs--) 454 while (beefs--)
435 (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */ 455 (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */
436 } 456 }
457 #endif /* not MC_ALLOC */
437 458
438 #else /* !ERROR_CHECK_GC */ 459 #else /* !ERROR_CHECK_GC */
439 460
440 461
441 #define deadbeef_memory(ptr, size) 462 #define deadbeef_memory(ptr, size)
460 return xstrdup (s); 481 return xstrdup (s);
461 } 482 }
462 #endif /* NEED_STRDUP */ 483 #endif /* NEED_STRDUP */
463 484
464 485
486 #ifndef MC_ALLOC
465 static void * 487 static void *
466 allocate_lisp_storage (Bytecount size) 488 allocate_lisp_storage (Bytecount size)
467 { 489 {
468 void *val = xmalloc (size); 490 void *val = xmalloc (size);
469 /* We don't increment the cons counter anymore. Calling functions do 491 /* We don't increment the cons counter anymore. Calling functions do
484 if (need_to_check_c_alloca) 506 if (need_to_check_c_alloca)
485 xemacs_c_alloca (0); 507 xemacs_c_alloca (0);
486 508
487 return val; 509 return val;
488 } 510 }
489 511 #endif /* not MC_ALLOC */
490 512
513 #ifdef MC_ALLOC_TYPE_STATS
514 static struct
515 {
516 int instances_in_use;
517 int bytes_in_use;
518 int bytes_in_use_including_overhead;
519 } lrecord_stats [countof (lrecord_implementations_table)
520 + MODULE_DEFINABLE_TYPE_COUNT];
521
522 void
523 init_lrecord_stats ()
524 {
525 xzero (lrecord_stats);
526 }
527
528 void
529 inc_lrecord_stats (Bytecount size, const struct lrecord_header *h)
530 {
531 int type_index = h->type;
532 if (!size)
533 size = detagged_lisp_object_size (h);
534
535 lrecord_stats[type_index].instances_in_use++;
536 lrecord_stats[type_index].bytes_in_use += size;
537 lrecord_stats[type_index].bytes_in_use_including_overhead
538 #ifdef MEMORY_USAGE_STATS
539 += mc_alloced_storage_size (size, 0);
540 #else /* not MEMORY_USAGE_STATS */
541 += size;
542 #endif /* not MEMORY_USAGE_STATS */
543 }
544
545 void
546 dec_lrecord_stats (Bytecount size_including_overhead,
547 const struct lrecord_header *h)
548 {
549 int type_index = h->type;
550
551 lrecord_stats[type_index].instances_in_use--;
552 lrecord_stats[type_index].bytes_in_use -= detagged_lisp_object_size (h);
553 lrecord_stats[type_index].bytes_in_use_including_overhead
554 -= size_including_overhead;
555
556 DECREMENT_CONS_COUNTER (lrecord_stats[type_index].bytes_in_use);
557 }
558 #endif /* not MC_ALLOC_TYPE_STATS */
559
560 #ifndef MC_ALLOC
491 /* lcrecords are chained together through their "next" field. 561 /* lcrecords are chained together through their "next" field.
492 After doing the mark phase, GC will walk this linked list 562 After doing the mark phase, GC will walk this linked list
493 and free any lcrecord which hasn't been marked. */ 563 and free any lcrecord which hasn't been marked. */
494 static struct lcrecord_header *all_lcrecords; 564 static struct lcrecord_header *all_lcrecords;
565 #endif /* not MC_ALLOC */
566
567 #ifdef MC_ALLOC
568 /* The basic lrecord allocation functions. See lrecord.h for details. */
569 void *
570 alloc_lrecord (Bytecount size,
571 const struct lrecord_implementation *implementation)
572 {
573 struct lrecord_header *lheader;
574
575 type_checking_assert
576 ((implementation->static_size == 0 ?
577 implementation->size_in_bytes_method != NULL :
578 implementation->static_size == size));
579
580 lheader = (struct lrecord_header *) mc_alloc (size);
581 gc_checking_assert (LRECORD_FREE_P (lheader));
582 set_lheader_implementation (lheader, implementation);
583 lheader->uid = lrecord_uid_counter++;
584 #ifdef MC_ALLOC_TYPE_STATS
585 inc_lrecord_stats (size, lheader);
586 #endif /* not MC_ALLOC_TYPE_STATS */
587 INCREMENT_CONS_COUNTER (size, implementation->name);
588 return lheader;
589 }
590
591 void *
592 noseeum_alloc_lrecord (Bytecount size,
593 const struct lrecord_implementation *implementation)
594 {
595 struct lrecord_header *lheader;
596
597 type_checking_assert
598 ((implementation->static_size == 0 ?
599 implementation->size_in_bytes_method != NULL :
600 implementation->static_size == size));
601
602 lheader = (struct lrecord_header *) mc_alloc (size);
603 gc_checking_assert (LRECORD_FREE_P (lheader));
604 set_lheader_implementation (lheader, implementation);
605 lheader->uid = lrecord_uid_counter++;
606 #ifdef MC_ALLOC_TYPE_STATS
607 inc_lrecord_stats (size, lheader);
608 #endif /* not MC_ALLOC_TYPE_STATS */
609 NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name);
610 return lheader;
611 }
612
613 void
614 free_lrecord (Lisp_Object lrecord)
615 {
616 gc_checking_assert (!gc_in_progress);
617 gc_checking_assert (!LRECORD_FREE_P (XRECORD_LHEADER (lrecord)));
618 gc_checking_assert (!XRECORD_LHEADER (lrecord)->free);
619
620 MC_ALLOC_CALL_FINALIZER (XPNTR (lrecord));
621 mc_free (XPNTR (lrecord));
622 }
623 #else /* not MC_ALLOC */
495 624
496 /* The most basic of the lcrecord allocation functions. Not usually called 625 /* The most basic of the lcrecord allocation functions. Not usually called
497 directly. Allocates an lrecord not managed by any lcrecord-list, of a 626 directly. Allocates an lrecord not managed by any lcrecord-list, of a
498 specified size. See lrecord.h. */ 627 specified size. See lrecord.h. */
499 628
561 lrecord->implementation->finalizer (lrecord, 0); 690 lrecord->implementation->finalizer (lrecord, 0);
562 xfree (lrecord); 691 xfree (lrecord);
563 return; 692 return;
564 } 693 }
565 #endif /* Unused */ 694 #endif /* Unused */
695 #endif /* not MC_ALLOC */
566 696
567 697
568 static void 698 static void
569 disksave_object_finalization_1 (void) 699 disksave_object_finalization_1 (void)
570 { 700 {
701 #ifdef MC_ALLOC
702 mc_finalize_for_disksave ();
703 #else /* not MC_ALLOC */
571 struct lcrecord_header *header; 704 struct lcrecord_header *header;
572 705
573 for (header = all_lcrecords; header; header = header->next) 706 for (header = all_lcrecords; header; header = header->next)
574 { 707 {
575 if (LHEADER_IMPLEMENTATION (&header->lheader)->finalizer && 708 if (LHEADER_IMPLEMENTATION (&header->lheader)->finalizer &&
576 !header->free) 709 !header->free)
577 LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1); 710 LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1);
578 } 711 }
712 #endif /* not MC_ALLOC */
579 } 713 }
580 714
581 /* Bitwise copy all parts of a Lisp object other than the header */ 715 /* Bitwise copy all parts of a Lisp object other than the header */
582 716
583 void 717 void
588 Bytecount size = lisp_object_size (src); 722 Bytecount size = lisp_object_size (src);
589 723
590 assert (imp == XRECORD_LHEADER_IMPLEMENTATION (dst)); 724 assert (imp == XRECORD_LHEADER_IMPLEMENTATION (dst));
591 assert (size == lisp_object_size (dst)); 725 assert (size == lisp_object_size (dst));
592 726
727 #ifdef MC_ALLOC
728 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header),
729 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
730 size - sizeof (struct lrecord_header));
731 #else /* not MC_ALLOC */
593 if (imp->basic_p) 732 if (imp->basic_p)
594 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header), 733 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header),
595 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header), 734 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
596 size - sizeof (struct lrecord_header)); 735 size - sizeof (struct lrecord_header));
597 else 736 else
598 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lcrecord_header), 737 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lcrecord_header),
599 (char *) XRECORD_LHEADER (src) + sizeof (struct lcrecord_header), 738 (char *) XRECORD_LHEADER (src) + sizeof (struct lcrecord_header),
600 size - sizeof (struct lcrecord_header)); 739 size - sizeof (struct lcrecord_header));
740 #endif /* not MC_ALLOC */
601 } 741 }
602 742
603 743
604 /************************************************************************/ 744 /************************************************************************/
605 /* Debugger support */ 745 /* Debugger support */
643 { 783 {
644 return EQ (obj1, obj2); 784 return EQ (obj1, obj2);
645 } 785 }
646 786
647 787
788 #ifndef MC_ALLOC
648 /************************************************************************/ 789 /************************************************************************/
649 /* Fixed-size type macros */ 790 /* Fixed-size type macros */
650 /************************************************************************/ 791 /************************************************************************/
651 792
652 /* For fixed-size types that are commonly used, we malloc() large blocks 793 /* For fixed-size types that are commonly used, we malloc() large blocks
1001 gc_count_num_##type##_freelist++; \ 1142 gc_count_num_##type##_freelist++; \
1002 } while (0) 1143 } while (0)
1003 #else 1144 #else
1004 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) 1145 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr)
1005 #endif 1146 #endif
1147 #endif /* not MC_ALLOC */
1006 1148
1007 1149
1008 1150
1009 /************************************************************************/ 1151 /************************************************************************/
1010 /* Cons allocation */ 1152 /* Cons allocation */
1011 /************************************************************************/ 1153 /************************************************************************/
1012 1154
1155 #ifndef MC_ALLOC
1013 DECLARE_FIXED_TYPE_ALLOC (cons, Lisp_Cons); 1156 DECLARE_FIXED_TYPE_ALLOC (cons, Lisp_Cons);
1014 /* conses are used and freed so often that we set this really high */ 1157 /* conses are used and freed so often that we set this really high */
1015 /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 20000 */ 1158 /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 20000 */
1016 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 2000 1159 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 2000
1160 #endif /* not MC_ALLOC */
1017 1161
1018 static Lisp_Object 1162 static Lisp_Object
1019 mark_cons (Lisp_Object obj) 1163 mark_cons (Lisp_Object obj)
1020 { 1164 {
1021 if (NILP (XCDR (obj))) 1165 if (NILP (XCDR (obj)))
1065 { 1209 {
1066 /* This cannot GC. */ 1210 /* This cannot GC. */
1067 Lisp_Object val; 1211 Lisp_Object val;
1068 Lisp_Cons *c; 1212 Lisp_Cons *c;
1069 1213
1214 #ifdef MC_ALLOC
1215 c = alloc_lrecord_type (Lisp_Cons, &lrecord_cons);
1216 #else /* not MC_ALLOC */
1070 ALLOCATE_FIXED_TYPE (cons, Lisp_Cons, c); 1217 ALLOCATE_FIXED_TYPE (cons, Lisp_Cons, c);
1071 set_lheader_implementation (&c->lheader, &lrecord_cons); 1218 set_lheader_implementation (&c->lheader, &lrecord_cons);
1219 #endif /* not MC_ALLOC */
1072 val = wrap_cons (c); 1220 val = wrap_cons (c);
1073 XSETCAR (val, car); 1221 XSETCAR (val, car);
1074 XSETCDR (val, cdr); 1222 XSETCDR (val, cdr);
1075 return val; 1223 return val;
1076 } 1224 }
1082 noseeum_cons (Lisp_Object car, Lisp_Object cdr) 1230 noseeum_cons (Lisp_Object car, Lisp_Object cdr)
1083 { 1231 {
1084 Lisp_Object val; 1232 Lisp_Object val;
1085 Lisp_Cons *c; 1233 Lisp_Cons *c;
1086 1234
1235 #ifdef MC_ALLOC
1236 c = noseeum_alloc_lrecord_type (Lisp_Cons, &lrecord_cons);
1237 #else /* not MC_ALLOC */
1087 NOSEEUM_ALLOCATE_FIXED_TYPE (cons, Lisp_Cons, c); 1238 NOSEEUM_ALLOCATE_FIXED_TYPE (cons, Lisp_Cons, c);
1088 set_lheader_implementation (&c->lheader, &lrecord_cons); 1239 set_lheader_implementation (&c->lheader, &lrecord_cons);
1240 #endif /* not MC_ALLOC */
1089 val = wrap_cons (c); 1241 val = wrap_cons (c);
1090 XCAR (val) = car; 1242 XCAR (val) = car;
1091 XCDR (val) = cdr; 1243 XCDR (val) = cdr;
1092 return val; 1244 return val;
1093 } 1245 }
1185 /* Float allocation */ 1337 /* Float allocation */
1186 /************************************************************************/ 1338 /************************************************************************/
1187 1339
1188 /*** With enhanced number support, these are short floats */ 1340 /*** With enhanced number support, these are short floats */
1189 1341
1342 #ifndef MC_ALLOC
1190 DECLARE_FIXED_TYPE_ALLOC (float, Lisp_Float); 1343 DECLARE_FIXED_TYPE_ALLOC (float, Lisp_Float);
1191 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_float 1000 1344 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_float 1000
1345 #endif /* not MC_ALLOC */
1192 1346
1193 Lisp_Object 1347 Lisp_Object
1194 make_float (double float_value) 1348 make_float (double float_value)
1195 { 1349 {
1196 Lisp_Float *f; 1350 Lisp_Float *f;
1197 1351
1352 #ifdef MC_ALLOC
1353 f = alloc_lrecord_type (Lisp_Float, &lrecord_float);
1354 #else /* not MC_ALLOC */
1198 ALLOCATE_FIXED_TYPE (float, Lisp_Float, f); 1355 ALLOCATE_FIXED_TYPE (float, Lisp_Float, f);
1199 1356
1200 /* Avoid dump-time `uninitialized memory read' purify warnings. */ 1357 /* Avoid dump-time `uninitialized memory read' purify warnings. */
1201 if (sizeof (struct lrecord_header) + sizeof (double) != sizeof (*f)) 1358 if (sizeof (struct lrecord_header) + sizeof (double) != sizeof (*f))
1202 xzero (*f); 1359 xzero (*f);
1360 #endif /* not MC_ALLOC */
1203 1361
1204 set_lheader_implementation (&f->lheader, &lrecord_float); 1362 set_lheader_implementation (&f->lheader, &lrecord_float);
1205 float_data (f) = float_value; 1363 float_data (f) = float_value;
1206 return wrap_float (f); 1364 return wrap_float (f);
1207 } 1365 }
1211 /* Enhanced number allocation */ 1369 /* Enhanced number allocation */
1212 /************************************************************************/ 1370 /************************************************************************/
1213 1371
1214 /*** Bignum ***/ 1372 /*** Bignum ***/
1215 #ifdef HAVE_BIGNUM 1373 #ifdef HAVE_BIGNUM
1374 #ifndef MC_ALLOC
1216 DECLARE_FIXED_TYPE_ALLOC (bignum, Lisp_Bignum); 1375 DECLARE_FIXED_TYPE_ALLOC (bignum, Lisp_Bignum);
1217 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bignum 250 1376 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bignum 250
1377 #endif /* not MC_ALLOC */
1218 1378
1219 /* WARNING: This function returns a bignum even if its argument fits into a 1379 /* WARNING: This function returns a bignum even if its argument fits into a
1220 fixnum. See Fcanonicalize_number(). */ 1380 fixnum. See Fcanonicalize_number(). */
1221 Lisp_Object 1381 Lisp_Object
1222 make_bignum (long bignum_value) 1382 make_bignum (long bignum_value)
1223 { 1383 {
1224 Lisp_Bignum *b; 1384 Lisp_Bignum *b;
1225 1385
1386 #ifdef MC_ALLOC
1387 b = alloc_lrecord_type (Lisp_Bignum, &lrecord_bignum);
1388 #else /* not MC_ALLOC */
1226 ALLOCATE_FIXED_TYPE (bignum, Lisp_Bignum, b); 1389 ALLOCATE_FIXED_TYPE (bignum, Lisp_Bignum, b);
1227 set_lheader_implementation (&b->lheader, &lrecord_bignum); 1390 set_lheader_implementation (&b->lheader, &lrecord_bignum);
1391 #endif /* not MC_ALLOC */
1228 bignum_init (bignum_data (b)); 1392 bignum_init (bignum_data (b));
1229 bignum_set_long (bignum_data (b), bignum_value); 1393 bignum_set_long (bignum_data (b), bignum_value);
1230 return wrap_bignum (b); 1394 return wrap_bignum (b);
1231 } 1395 }
1232 1396
1235 Lisp_Object 1399 Lisp_Object
1236 make_bignum_bg (bignum bg) 1400 make_bignum_bg (bignum bg)
1237 { 1401 {
1238 Lisp_Bignum *b; 1402 Lisp_Bignum *b;
1239 1403
1404 #ifdef MC_ALLOC
1405 b = alloc_lrecord_type (Lisp_Bignum, &lrecord_bignum);
1406 #else /* not MC_ALLOC */
1240 ALLOCATE_FIXED_TYPE (bignum, Lisp_Bignum, b); 1407 ALLOCATE_FIXED_TYPE (bignum, Lisp_Bignum, b);
1241 set_lheader_implementation (&b->lheader, &lrecord_bignum); 1408 set_lheader_implementation (&b->lheader, &lrecord_bignum);
1409 #endif /* not MC_ALLOC */
1242 bignum_init (bignum_data (b)); 1410 bignum_init (bignum_data (b));
1243 bignum_set (bignum_data (b), bg); 1411 bignum_set (bignum_data (b), bg);
1244 return wrap_bignum (b); 1412 return wrap_bignum (b);
1245 } 1413 }
1246 #endif /* HAVE_BIGNUM */ 1414 #endif /* HAVE_BIGNUM */
1247 1415
1248 /*** Ratio ***/ 1416 /*** Ratio ***/
1249 #ifdef HAVE_RATIO 1417 #ifdef HAVE_RATIO
1418 #ifndef MC_ALLOC
1250 DECLARE_FIXED_TYPE_ALLOC (ratio, Lisp_Ratio); 1419 DECLARE_FIXED_TYPE_ALLOC (ratio, Lisp_Ratio);
1251 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_ratio 250 1420 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_ratio 250
1421 #endif /* not MC_ALLOC */
1252 1422
1253 Lisp_Object 1423 Lisp_Object
1254 make_ratio (long numerator, unsigned long denominator) 1424 make_ratio (long numerator, unsigned long denominator)
1255 { 1425 {
1256 Lisp_Ratio *r; 1426 Lisp_Ratio *r;
1257 1427
1428 #ifdef MC_ALLOC
1429 r = alloc_lrecord_type (Lisp_Ratio, &lrecord_ratio);
1430 #else /* not MC_ALLOC */
1258 ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r); 1431 ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r);
1259 set_lheader_implementation (&r->lheader, &lrecord_ratio); 1432 set_lheader_implementation (&r->lheader, &lrecord_ratio);
1433 #endif /* not MC_ALLOC */
1260 ratio_init (ratio_data (r)); 1434 ratio_init (ratio_data (r));
1261 ratio_set_long_ulong (ratio_data (r), numerator, denominator); 1435 ratio_set_long_ulong (ratio_data (r), numerator, denominator);
1262 ratio_canonicalize (ratio_data (r)); 1436 ratio_canonicalize (ratio_data (r));
1263 return wrap_ratio (r); 1437 return wrap_ratio (r);
1264 } 1438 }
1266 Lisp_Object 1440 Lisp_Object
1267 make_ratio_bg (bignum numerator, bignum denominator) 1441 make_ratio_bg (bignum numerator, bignum denominator)
1268 { 1442 {
1269 Lisp_Ratio *r; 1443 Lisp_Ratio *r;
1270 1444
1445 #ifdef MC_ALLOC
1446 r = alloc_lrecord_type (Lisp_Ratio, &lrecord_ratio);
1447 #else /* not MC_ALLOC */
1271 ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r); 1448 ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r);
1272 set_lheader_implementation (&r->lheader, &lrecord_ratio); 1449 set_lheader_implementation (&r->lheader, &lrecord_ratio);
1450 #endif /* not MC_ALLOC */
1273 ratio_init (ratio_data (r)); 1451 ratio_init (ratio_data (r));
1274 ratio_set_bignum_bignum (ratio_data (r), numerator, denominator); 1452 ratio_set_bignum_bignum (ratio_data (r), numerator, denominator);
1275 ratio_canonicalize (ratio_data (r)); 1453 ratio_canonicalize (ratio_data (r));
1276 return wrap_ratio (r); 1454 return wrap_ratio (r);
1277 } 1455 }
1279 Lisp_Object 1457 Lisp_Object
1280 make_ratio_rt (ratio rat) 1458 make_ratio_rt (ratio rat)
1281 { 1459 {
1282 Lisp_Ratio *r; 1460 Lisp_Ratio *r;
1283 1461
1462 #ifdef MC_ALLOC
1463 r = alloc_lrecord_type (Lisp_Ratio, &lrecord_ratio);
1464 #else /* not MC_ALLOC */
1284 ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r); 1465 ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r);
1285 set_lheader_implementation (&r->lheader, &lrecord_ratio); 1466 set_lheader_implementation (&r->lheader, &lrecord_ratio);
1467 #endif /* not MC_ALLOC */
1286 ratio_init (ratio_data (r)); 1468 ratio_init (ratio_data (r));
1287 ratio_set (ratio_data (r), rat); 1469 ratio_set (ratio_data (r), rat);
1288 return wrap_ratio (r); 1470 return wrap_ratio (r);
1289 } 1471 }
1290 #endif /* HAVE_RATIO */ 1472 #endif /* HAVE_RATIO */
1291 1473
1292 /*** Bigfloat ***/ 1474 /*** Bigfloat ***/
1293 #ifdef HAVE_BIGFLOAT 1475 #ifdef HAVE_BIGFLOAT
1476 #ifndef MC_ALLOC
1294 DECLARE_FIXED_TYPE_ALLOC (bigfloat, Lisp_Bigfloat); 1477 DECLARE_FIXED_TYPE_ALLOC (bigfloat, Lisp_Bigfloat);
1295 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bigfloat 250 1478 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bigfloat 250
1479 #endif /* not MC_ALLOC */
1296 1480
1297 /* This function creates a bigfloat with the default precision if the 1481 /* This function creates a bigfloat with the default precision if the
1298 PRECISION argument is zero. */ 1482 PRECISION argument is zero. */
1299 Lisp_Object 1483 Lisp_Object
1300 make_bigfloat (double float_value, unsigned long precision) 1484 make_bigfloat (double float_value, unsigned long precision)
1301 { 1485 {
1302 Lisp_Bigfloat *f; 1486 Lisp_Bigfloat *f;
1303 1487
1488 #ifdef MC_ALLOC
1489 f = alloc_lrecord_type (Lisp_Bigfloat, &lrecord_bigfloat);
1490 #else /* not MC_ALLOC */
1304 ALLOCATE_FIXED_TYPE (bigfloat, Lisp_Bigfloat, f); 1491 ALLOCATE_FIXED_TYPE (bigfloat, Lisp_Bigfloat, f);
1305 set_lheader_implementation (&f->lheader, &lrecord_bigfloat); 1492 set_lheader_implementation (&f->lheader, &lrecord_bigfloat);
1493 #endif /* not MC_ALLOC */
1306 if (precision == 0UL) 1494 if (precision == 0UL)
1307 bigfloat_init (bigfloat_data (f)); 1495 bigfloat_init (bigfloat_data (f));
1308 else 1496 else
1309 bigfloat_init_prec (bigfloat_data (f), precision); 1497 bigfloat_init_prec (bigfloat_data (f), precision);
1310 bigfloat_set_double (bigfloat_data (f), float_value); 1498 bigfloat_set_double (bigfloat_data (f), float_value);
1315 Lisp_Object 1503 Lisp_Object
1316 make_bigfloat_bf (bigfloat float_value) 1504 make_bigfloat_bf (bigfloat float_value)
1317 { 1505 {
1318 Lisp_Bigfloat *f; 1506 Lisp_Bigfloat *f;
1319 1507
1508 #ifdef MC_ALLOC
1509 f = alloc_lrecord_type (Lisp_Bigfloat, &lrecord_bigfloat);
1510 #else /* not MC_ALLOC */
1320 ALLOCATE_FIXED_TYPE (bigfloat, Lisp_Bigfloat, f); 1511 ALLOCATE_FIXED_TYPE (bigfloat, Lisp_Bigfloat, f);
1321 set_lheader_implementation (&f->lheader, &lrecord_bigfloat); 1512 set_lheader_implementation (&f->lheader, &lrecord_bigfloat);
1513 #endif /* not MC_ALLOC */
1322 bigfloat_init_prec (bigfloat_data (f), bigfloat_get_prec (float_value)); 1514 bigfloat_init_prec (bigfloat_data (f), bigfloat_get_prec (float_value));
1323 bigfloat_set (bigfloat_data (f), float_value); 1515 bigfloat_set (bigfloat_data (f), float_value);
1324 return wrap_bigfloat (f); 1516 return wrap_bigfloat (f);
1325 } 1517 }
1326 #endif /* HAVE_BIGFLOAT */ 1518 #endif /* HAVE_BIGFLOAT */
1393 { 1585 {
1394 /* no `next' field; we use lcrecords */ 1586 /* no `next' field; we use lcrecords */
1395 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, 1587 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object,
1396 contents, sizei); 1588 contents, sizei);
1397 Lisp_Vector *p = 1589 Lisp_Vector *p =
1590 #ifdef MC_ALLOC
1591 (Lisp_Vector *) alloc_lrecord (sizem, &lrecord_vector);
1592 #else /* not MC_ALLOC */
1398 (Lisp_Vector *) basic_alloc_lcrecord (sizem, &lrecord_vector); 1593 (Lisp_Vector *) basic_alloc_lcrecord (sizem, &lrecord_vector);
1594 #endif /* not MC_ALLOC */
1399 1595
1400 p->size = sizei; 1596 p->size = sizei;
1401 return p; 1597 return p;
1402 } 1598 }
1403 1599
1550 Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (sizei); 1746 Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (sizei);
1551 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, 1747 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector,
1552 unsigned long, 1748 unsigned long,
1553 bits, num_longs); 1749 bits, num_longs);
1554 Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) 1750 Lisp_Bit_Vector *p = (Lisp_Bit_Vector *)
1751 #ifdef MC_ALLOC
1752 alloc_lrecord (sizem, &lrecord_bit_vector);
1753 #else /* not MC_ALLOC */
1555 basic_alloc_lcrecord (sizem, &lrecord_bit_vector); 1754 basic_alloc_lcrecord (sizem, &lrecord_bit_vector);
1755 #endif /* not MC_ALLOC */
1556 1756
1557 bit_vector_length (p) = sizei; 1757 bit_vector_length (p) = sizei;
1558 return p; 1758 return p;
1559 } 1759 }
1560 1760
1626 1826
1627 /************************************************************************/ 1827 /************************************************************************/
1628 /* Compiled-function allocation */ 1828 /* Compiled-function allocation */
1629 /************************************************************************/ 1829 /************************************************************************/
1630 1830
1831 #ifndef MC_ALLOC
1631 DECLARE_FIXED_TYPE_ALLOC (compiled_function, Lisp_Compiled_Function); 1832 DECLARE_FIXED_TYPE_ALLOC (compiled_function, Lisp_Compiled_Function);
1632 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_compiled_function 1000 1833 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_compiled_function 1000
1834 #endif /* not MC_ALLOC */
1633 1835
1634 static Lisp_Object 1836 static Lisp_Object
1635 make_compiled_function (void) 1837 make_compiled_function (void)
1636 { 1838 {
1637 Lisp_Compiled_Function *f; 1839 Lisp_Compiled_Function *f;
1638 1840
1841 #ifdef MC_ALLOC
1842 f = alloc_lrecord_type (Lisp_Compiled_Function, &lrecord_compiled_function);
1843 #else /* not MC_ALLOC */
1639 ALLOCATE_FIXED_TYPE (compiled_function, Lisp_Compiled_Function, f); 1844 ALLOCATE_FIXED_TYPE (compiled_function, Lisp_Compiled_Function, f);
1640 set_lheader_implementation (&f->lheader, &lrecord_compiled_function); 1845 set_lheader_implementation (&f->lheader, &lrecord_compiled_function);
1846 #endif /* not MC_ALLOC */
1641 1847
1642 f->stack_depth = 0; 1848 f->stack_depth = 0;
1643 f->specpdl_depth = 0; 1849 f->specpdl_depth = 0;
1644 f->flags.documentationp = 0; 1850 f->flags.documentationp = 0;
1645 f->flags.interactivep = 0; 1851 f->flags.interactivep = 0;
1767 1973
1768 /************************************************************************/ 1974 /************************************************************************/
1769 /* Symbol allocation */ 1975 /* Symbol allocation */
1770 /************************************************************************/ 1976 /************************************************************************/
1771 1977
1978 #ifndef MC_ALLOC
1772 DECLARE_FIXED_TYPE_ALLOC (symbol, Lisp_Symbol); 1979 DECLARE_FIXED_TYPE_ALLOC (symbol, Lisp_Symbol);
1773 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_symbol 1000 1980 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_symbol 1000
1981 #endif /* not MC_ALLOC */
1774 1982
1775 DEFUN ("make-symbol", Fmake_symbol, 1, 1, 0, /* 1983 DEFUN ("make-symbol", Fmake_symbol, 1, 1, 0, /*
1776 Return a newly allocated uninterned symbol whose name is NAME. 1984 Return a newly allocated uninterned symbol whose name is NAME.
1777 Its value and function definition are void, and its property list is nil. 1985 Its value and function definition are void, and its property list is nil.
1778 */ 1986 */
1780 { 1988 {
1781 Lisp_Symbol *p; 1989 Lisp_Symbol *p;
1782 1990
1783 CHECK_STRING (name); 1991 CHECK_STRING (name);
1784 1992
1993 #ifdef MC_ALLOC
1994 p = alloc_lrecord_type (Lisp_Symbol, &lrecord_symbol);
1995 #else /* not MC_ALLOC */
1785 ALLOCATE_FIXED_TYPE (symbol, Lisp_Symbol, p); 1996 ALLOCATE_FIXED_TYPE (symbol, Lisp_Symbol, p);
1786 set_lheader_implementation (&p->lheader, &lrecord_symbol); 1997 set_lheader_implementation (&p->lheader, &lrecord_symbol);
1998 #endif /* not MC_ALLOC */
1787 p->name = name; 1999 p->name = name;
1788 p->plist = Qnil; 2000 p->plist = Qnil;
1789 p->value = Qunbound; 2001 p->value = Qunbound;
1790 p->function = Qunbound; 2002 p->function = Qunbound;
1791 symbol_next (p) = 0; 2003 symbol_next (p) = 0;
1795 2007
1796 /************************************************************************/ 2008 /************************************************************************/
1797 /* Extent allocation */ 2009 /* Extent allocation */
1798 /************************************************************************/ 2010 /************************************************************************/
1799 2011
2012 #ifndef MC_ALLOC
1800 DECLARE_FIXED_TYPE_ALLOC (extent, struct extent); 2013 DECLARE_FIXED_TYPE_ALLOC (extent, struct extent);
1801 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_extent 1000 2014 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_extent 1000
2015 #endif /* not MC_ALLOC */
1802 2016
1803 struct extent * 2017 struct extent *
1804 allocate_extent (void) 2018 allocate_extent (void)
1805 { 2019 {
1806 struct extent *e; 2020 struct extent *e;
1807 2021
2022 #ifdef MC_ALLOC
2023 e = alloc_lrecord_type (struct extent, &lrecord_extent);
2024 #else /* not MC_ALLOC */
1808 ALLOCATE_FIXED_TYPE (extent, struct extent, e); 2025 ALLOCATE_FIXED_TYPE (extent, struct extent, e);
1809 set_lheader_implementation (&e->lheader, &lrecord_extent); 2026 set_lheader_implementation (&e->lheader, &lrecord_extent);
2027 #endif /* not MC_ALLOC */
1810 extent_object (e) = Qnil; 2028 extent_object (e) = Qnil;
1811 set_extent_start (e, -1); 2029 set_extent_start (e, -1);
1812 set_extent_end (e, -1); 2030 set_extent_end (e, -1);
1813 e->plist = Qnil; 2031 e->plist = Qnil;
1814 2032
1824 2042
1825 /************************************************************************/ 2043 /************************************************************************/
1826 /* Event allocation */ 2044 /* Event allocation */
1827 /************************************************************************/ 2045 /************************************************************************/
1828 2046
2047 #ifndef MC_ALLOC
1829 DECLARE_FIXED_TYPE_ALLOC (event, Lisp_Event); 2048 DECLARE_FIXED_TYPE_ALLOC (event, Lisp_Event);
1830 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_event 1000 2049 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_event 1000
2050 #endif /* not MC_ALLOC */
1831 2051
1832 Lisp_Object 2052 Lisp_Object
1833 allocate_event (void) 2053 allocate_event (void)
1834 { 2054 {
1835 Lisp_Event *e; 2055 Lisp_Event *e;
1836 2056
2057 #ifdef MC_ALLOC
2058 e = alloc_lrecord_type (Lisp_Event, &lrecord_event);
2059 #else /* not MC_ALLOC */
1837 ALLOCATE_FIXED_TYPE (event, Lisp_Event, e); 2060 ALLOCATE_FIXED_TYPE (event, Lisp_Event, e);
1838 set_lheader_implementation (&e->lheader, &lrecord_event); 2061 set_lheader_implementation (&e->lheader, &lrecord_event);
2062 #endif /* not MC_ALLOC */
1839 2063
1840 return wrap_event (e); 2064 return wrap_event (e);
1841 } 2065 }
1842 2066
1843 #ifdef EVENT_DATA_AS_OBJECTS 2067 #ifdef EVENT_DATA_AS_OBJECTS
2068 #ifndef MC_ALLOC
1844 DECLARE_FIXED_TYPE_ALLOC (key_data, Lisp_Key_Data); 2069 DECLARE_FIXED_TYPE_ALLOC (key_data, Lisp_Key_Data);
1845 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_key_data 1000 2070 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_key_data 1000
2071 #endif /* not MC_ALLOC */
1846 2072
1847 Lisp_Object 2073 Lisp_Object
1848 make_key_data (void) 2074 make_key_data (void)
1849 { 2075 {
1850 Lisp_Key_Data *d; 2076 Lisp_Key_Data *d;
1851 2077
2078 #ifdef MC_ALLOC
2079 d = alloc_lrecord_type (Lisp_Key_Data, &lrecord_key_data);
2080 #else /* not MC_ALLOC */
1852 ALLOCATE_FIXED_TYPE (key_data, Lisp_Key_Data, d); 2081 ALLOCATE_FIXED_TYPE (key_data, Lisp_Key_Data, d);
1853 xzero (*d); 2082 xzero (*d);
1854 set_lheader_implementation (&d->lheader, &lrecord_key_data); 2083 set_lheader_implementation (&d->lheader, &lrecord_key_data);
2084 #endif /* not MC_ALLOC */
1855 d->keysym = Qnil; 2085 d->keysym = Qnil;
1856 2086
1857 return wrap_key_data (d); 2087 return wrap_key_data (d);
1858 } 2088 }
1859 2089
2090 #ifndef MC_ALLOC
1860 DECLARE_FIXED_TYPE_ALLOC (button_data, Lisp_Button_Data); 2091 DECLARE_FIXED_TYPE_ALLOC (button_data, Lisp_Button_Data);
1861 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_button_data 1000 2092 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_button_data 1000
2093 #endif /* not MC_ALLOC */
1862 2094
1863 Lisp_Object 2095 Lisp_Object
1864 make_button_data (void) 2096 make_button_data (void)
1865 { 2097 {
1866 Lisp_Button_Data *d; 2098 Lisp_Button_Data *d;
1867 2099
2100 #ifdef MC_ALLOC
2101 d = alloc_lrecord_type (Lisp_Button_Data, &lrecord_button_data);
2102 #else /* not MC_ALLOC */
1868 ALLOCATE_FIXED_TYPE (button_data, Lisp_Button_Data, d); 2103 ALLOCATE_FIXED_TYPE (button_data, Lisp_Button_Data, d);
1869 xzero (*d); 2104 xzero (*d);
1870 set_lheader_implementation (&d->lheader, &lrecord_button_data); 2105 set_lheader_implementation (&d->lheader, &lrecord_button_data);
1871 2106
2107 #endif /* not MC_ALLOC */
1872 return wrap_button_data (d); 2108 return wrap_button_data (d);
1873 } 2109 }
1874 2110
2111 #ifndef MC_ALLOC
1875 DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data); 2112 DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data);
1876 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_motion_data 1000 2113 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_motion_data 1000
2114 #endif /* not MC_ALLOC */
1877 2115
1878 Lisp_Object 2116 Lisp_Object
1879 make_motion_data (void) 2117 make_motion_data (void)
1880 { 2118 {
1881 Lisp_Motion_Data *d; 2119 Lisp_Motion_Data *d;
1882 2120
2121 #ifdef MC_ALLOC
2122 d = alloc_lrecord_type (Lisp_Motion_Data, &lrecord_motion_data);
2123 #else /* not MC_ALLOC */
1883 ALLOCATE_FIXED_TYPE (motion_data, Lisp_Motion_Data, d); 2124 ALLOCATE_FIXED_TYPE (motion_data, Lisp_Motion_Data, d);
1884 xzero (*d); 2125 xzero (*d);
1885 set_lheader_implementation (&d->lheader, &lrecord_motion_data); 2126 set_lheader_implementation (&d->lheader, &lrecord_motion_data);
2127 #endif /* not MC_ALLOC */
1886 2128
1887 return wrap_motion_data (d); 2129 return wrap_motion_data (d);
1888 } 2130 }
1889 2131
2132 #ifndef MC_ALLOC
1890 DECLARE_FIXED_TYPE_ALLOC (process_data, Lisp_Process_Data); 2133 DECLARE_FIXED_TYPE_ALLOC (process_data, Lisp_Process_Data);
1891 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_process_data 1000 2134 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_process_data 1000
2135 #endif /* not MC_ALLOC */
1892 2136
1893 Lisp_Object 2137 Lisp_Object
1894 make_process_data (void) 2138 make_process_data (void)
1895 { 2139 {
1896 Lisp_Process_Data *d; 2140 Lisp_Process_Data *d;
1897 2141
2142 #ifdef MC_ALLOC
2143 d = alloc_lrecord_type (Lisp_Process_Data, &lrecord_process_data);
2144 #else /* not MC_ALLOC */
1898 ALLOCATE_FIXED_TYPE (process_data, Lisp_Process_Data, d); 2145 ALLOCATE_FIXED_TYPE (process_data, Lisp_Process_Data, d);
1899 xzero (*d); 2146 xzero (*d);
1900 set_lheader_implementation (&d->lheader, &lrecord_process_data); 2147 set_lheader_implementation (&d->lheader, &lrecord_process_data);
1901 d->process = Qnil; 2148 d->process = Qnil;
2149 #endif /* not MC_ALLOC */
1902 2150
1903 return wrap_process_data (d); 2151 return wrap_process_data (d);
1904 } 2152 }
1905 2153
2154 #ifndef MC_ALLOC
1906 DECLARE_FIXED_TYPE_ALLOC (timeout_data, Lisp_Timeout_Data); 2155 DECLARE_FIXED_TYPE_ALLOC (timeout_data, Lisp_Timeout_Data);
1907 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_timeout_data 1000 2156 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_timeout_data 1000
2157 #endif /* not MC_ALLOC */
1908 2158
1909 Lisp_Object 2159 Lisp_Object
1910 make_timeout_data (void) 2160 make_timeout_data (void)
1911 { 2161 {
1912 Lisp_Timeout_Data *d; 2162 Lisp_Timeout_Data *d;
1913 2163
2164 #ifdef MC_ALLOC
2165 d = alloc_lrecord_type (Lisp_Timeout_Data, &lrecord_timeout_data);
2166 #else /* not MC_ALLOC */
1914 ALLOCATE_FIXED_TYPE (timeout_data, Lisp_Timeout_Data, d); 2167 ALLOCATE_FIXED_TYPE (timeout_data, Lisp_Timeout_Data, d);
1915 xzero (*d); 2168 xzero (*d);
1916 set_lheader_implementation (&d->lheader, &lrecord_timeout_data); 2169 set_lheader_implementation (&d->lheader, &lrecord_timeout_data);
1917 d->function = Qnil; 2170 d->function = Qnil;
1918 d->object = Qnil; 2171 d->object = Qnil;
2172 #endif /* not MC_ALLOC */
1919 2173
1920 return wrap_timeout_data (d); 2174 return wrap_timeout_data (d);
1921 } 2175 }
1922 2176
2177 #ifndef MC_ALLOC
1923 DECLARE_FIXED_TYPE_ALLOC (magic_data, Lisp_Magic_Data); 2178 DECLARE_FIXED_TYPE_ALLOC (magic_data, Lisp_Magic_Data);
1924 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_data 1000 2179 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_data 1000
2180 #endif /* not MC_ALLOC */
1925 2181
1926 Lisp_Object 2182 Lisp_Object
1927 make_magic_data (void) 2183 make_magic_data (void)
1928 { 2184 {
1929 Lisp_Magic_Data *d; 2185 Lisp_Magic_Data *d;
1930 2186
2187 #ifdef MC_ALLOC
2188 d = alloc_lrecord_type (Lisp_Magic_Data, &lrecord_magic_data);
2189 #else /* not MC_ALLOC */
1931 ALLOCATE_FIXED_TYPE (magic_data, Lisp_Magic_Data, d); 2190 ALLOCATE_FIXED_TYPE (magic_data, Lisp_Magic_Data, d);
1932 xzero (*d); 2191 xzero (*d);
1933 set_lheader_implementation (&d->lheader, &lrecord_magic_data); 2192 set_lheader_implementation (&d->lheader, &lrecord_magic_data);
2193 #endif /* not MC_ALLOC */
1934 2194
1935 return wrap_magic_data (d); 2195 return wrap_magic_data (d);
1936 } 2196 }
1937 2197
2198 #ifndef MC_ALLOC
1938 DECLARE_FIXED_TYPE_ALLOC (magic_eval_data, Lisp_Magic_Eval_Data); 2199 DECLARE_FIXED_TYPE_ALLOC (magic_eval_data, Lisp_Magic_Eval_Data);
1939 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_eval_data 1000 2200 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_eval_data 1000
2201 #endif /* not MC_ALLOC */
1940 2202
1941 Lisp_Object 2203 Lisp_Object
1942 make_magic_eval_data (void) 2204 make_magic_eval_data (void)
1943 { 2205 {
1944 Lisp_Magic_Eval_Data *d; 2206 Lisp_Magic_Eval_Data *d;
1945 2207
2208 #ifdef MC_ALLOC
2209 d = alloc_lrecord_type (Lisp_Magic_Eval_Data, &lrecord_magic_eval_data);
2210 #else /* not MC_ALLOC */
1946 ALLOCATE_FIXED_TYPE (magic_eval_data, Lisp_Magic_Eval_Data, d); 2211 ALLOCATE_FIXED_TYPE (magic_eval_data, Lisp_Magic_Eval_Data, d);
1947 xzero (*d); 2212 xzero (*d);
1948 set_lheader_implementation (&d->lheader, &lrecord_magic_eval_data); 2213 set_lheader_implementation (&d->lheader, &lrecord_magic_eval_data);
1949 d->object = Qnil; 2214 d->object = Qnil;
2215 #endif /* not MC_ALLOC */
1950 2216
1951 return wrap_magic_eval_data (d); 2217 return wrap_magic_eval_data (d);
1952 } 2218 }
1953 2219
2220 #ifndef MC_ALLOC
1954 DECLARE_FIXED_TYPE_ALLOC (eval_data, Lisp_Eval_Data); 2221 DECLARE_FIXED_TYPE_ALLOC (eval_data, Lisp_Eval_Data);
1955 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_eval_data 1000 2222 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_eval_data 1000
2223 #endif /* not MC_ALLOC */
1956 2224
1957 Lisp_Object 2225 Lisp_Object
1958 make_eval_data (void) 2226 make_eval_data (void)
1959 { 2227 {
1960 Lisp_Eval_Data *d; 2228 Lisp_Eval_Data *d;
1961 2229
2230 #ifdef MC_ALLOC
2231 d = alloc_lrecord_type (Lisp_Eval_Data, &lrecord_eval_data);
2232 #else /* not MC_ALLOC */
1962 ALLOCATE_FIXED_TYPE (eval_data, Lisp_Eval_Data, d); 2233 ALLOCATE_FIXED_TYPE (eval_data, Lisp_Eval_Data, d);
1963 xzero (*d); 2234 xzero (*d);
1964 set_lheader_implementation (&d->lheader, &lrecord_eval_data); 2235 set_lheader_implementation (&d->lheader, &lrecord_eval_data);
1965 d->function = Qnil; 2236 d->function = Qnil;
1966 d->object = Qnil; 2237 d->object = Qnil;
2238 #endif /* not MC_ALLOC */
1967 2239
1968 return wrap_eval_data (d); 2240 return wrap_eval_data (d);
1969 } 2241 }
1970 2242
2243 #ifndef MC_ALLOC
1971 DECLARE_FIXED_TYPE_ALLOC (misc_user_data, Lisp_Misc_User_Data); 2244 DECLARE_FIXED_TYPE_ALLOC (misc_user_data, Lisp_Misc_User_Data);
1972 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_misc_user_data 1000 2245 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_misc_user_data 1000
2246 #endif /* not MC_ALLOC */
1973 2247
1974 Lisp_Object 2248 Lisp_Object
1975 make_misc_user_data (void) 2249 make_misc_user_data (void)
1976 { 2250 {
1977 Lisp_Misc_User_Data *d; 2251 Lisp_Misc_User_Data *d;
1978 2252
2253 #ifdef MC_ALLOC
2254 d = alloc_lrecord_type (Lisp_Misc_User_Data, &lrecord_misc_user_data);
2255 #else /* not MC_ALLOC */
1979 ALLOCATE_FIXED_TYPE (misc_user_data, Lisp_Misc_User_Data, d); 2256 ALLOCATE_FIXED_TYPE (misc_user_data, Lisp_Misc_User_Data, d);
1980 xzero (*d); 2257 xzero (*d);
1981 set_lheader_implementation (&d->lheader, &lrecord_misc_user_data); 2258 set_lheader_implementation (&d->lheader, &lrecord_misc_user_data);
1982 d->function = Qnil; 2259 d->function = Qnil;
1983 d->object = Qnil; 2260 d->object = Qnil;
2261 #endif /* not MC_ALLOC */
1984 2262
1985 return wrap_misc_user_data (d); 2263 return wrap_misc_user_data (d);
1986 } 2264 }
1987 2265
1988 #endif /* EVENT_DATA_AS_OBJECTS */ 2266 #endif /* EVENT_DATA_AS_OBJECTS */
1989 2267
1990 /************************************************************************/ 2268 /************************************************************************/
1991 /* Marker allocation */ 2269 /* Marker allocation */
1992 /************************************************************************/ 2270 /************************************************************************/
1993 2271
2272 #ifndef MC_ALLOC
1994 DECLARE_FIXED_TYPE_ALLOC (marker, Lisp_Marker); 2273 DECLARE_FIXED_TYPE_ALLOC (marker, Lisp_Marker);
1995 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_marker 1000 2274 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_marker 1000
2275 #endif /* not MC_ALLOC */
1996 2276
1997 DEFUN ("make-marker", Fmake_marker, 0, 0, 0, /* 2277 DEFUN ("make-marker", Fmake_marker, 0, 0, 0, /*
1998 Return a new marker which does not point at any place. 2278 Return a new marker which does not point at any place.
1999 */ 2279 */
2000 ()) 2280 ())
2001 { 2281 {
2002 Lisp_Marker *p; 2282 Lisp_Marker *p;
2003 2283
2284 #ifdef MC_ALLOC
2285 p = alloc_lrecord_type (Lisp_Marker, &lrecord_marker);
2286 #else /* not MC_ALLOC */
2004 ALLOCATE_FIXED_TYPE (marker, Lisp_Marker, p); 2287 ALLOCATE_FIXED_TYPE (marker, Lisp_Marker, p);
2005 set_lheader_implementation (&p->lheader, &lrecord_marker); 2288 set_lheader_implementation (&p->lheader, &lrecord_marker);
2289 #endif /* not MC_ALLOC */
2006 p->buffer = 0; 2290 p->buffer = 0;
2007 p->membpos = 0; 2291 p->membpos = 0;
2008 marker_next (p) = 0; 2292 marker_next (p) = 0;
2009 marker_prev (p) = 0; 2293 marker_prev (p) = 0;
2010 p->insertion_type = 0; 2294 p->insertion_type = 0;
2014 Lisp_Object 2298 Lisp_Object
2015 noseeum_make_marker (void) 2299 noseeum_make_marker (void)
2016 { 2300 {
2017 Lisp_Marker *p; 2301 Lisp_Marker *p;
2018 2302
2303 #ifdef MC_ALLOC
2304 p = noseeum_alloc_lrecord_type (Lisp_Marker, &lrecord_marker);
2305 #else /* not MC_ALLOC */
2019 NOSEEUM_ALLOCATE_FIXED_TYPE (marker, Lisp_Marker, p); 2306 NOSEEUM_ALLOCATE_FIXED_TYPE (marker, Lisp_Marker, p);
2020 set_lheader_implementation (&p->lheader, &lrecord_marker); 2307 set_lheader_implementation (&p->lheader, &lrecord_marker);
2308 #endif /* not MC_ALLOC */
2021 p->buffer = 0; 2309 p->buffer = 0;
2022 p->membpos = 0; 2310 p->membpos = 0;
2023 marker_next (p) = 0; 2311 marker_next (p) = 0;
2024 marker_prev (p) = 0; 2312 marker_prev (p) = 0;
2025 p->insertion_type = 0; 2313 p->insertion_type = 0;
2042 strings (since EVERY REFERENCE to a short string needed to be GCPRO'd so 2330 strings (since EVERY REFERENCE to a short string needed to be GCPRO'd so
2043 that the reference would get relocated). 2331 that the reference would get relocated).
2044 2332
2045 This new method makes things somewhat bigger, but it is MUCH safer. */ 2333 This new method makes things somewhat bigger, but it is MUCH safer. */
2046 2334
2335 #ifndef MC_ALLOC
2047 DECLARE_FIXED_TYPE_ALLOC (string, Lisp_String); 2336 DECLARE_FIXED_TYPE_ALLOC (string, Lisp_String);
2048 /* strings are used and freed quite often */ 2337 /* strings are used and freed quite often */
2049 /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 10000 */ 2338 /* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 10000 */
2050 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 1000 2339 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 1000
2340 #endif /* not MC_ALLOC */
2051 2341
2052 static Lisp_Object 2342 static Lisp_Object
2053 mark_string (Lisp_Object obj) 2343 mark_string (Lisp_Object obj)
2054 { 2344 {
2055 if (CONSP (XSTRING_PLIST (obj)) && EXTENT_INFOP (XCAR (XSTRING_PLIST (obj)))) 2345 if (CONSP (XSTRING_PLIST (obj)) && EXTENT_INFOP (XCAR (XSTRING_PLIST (obj))))
2117 string_plist (Lisp_Object string) 2407 string_plist (Lisp_Object string)
2118 { 2408 {
2119 return *string_plist_ptr (string); 2409 return *string_plist_ptr (string);
2120 } 2410 }
2121 2411
2412 #ifndef MC_ALLOC
2122 /* No `finalize', or `hash' methods. 2413 /* No `finalize', or `hash' methods.
2123 internal_hash() already knows how to hash strings and finalization 2414 internal_hash() already knows how to hash strings and finalization
2124 is done with the ADDITIONAL_FREE_string macro, which is the 2415 is done with the ADDITIONAL_FREE_string macro, which is the
2125 standard way to do finalization when using 2416 standard way to do finalization when using
2126 SWEEP_FIXED_TYPE_BLOCK(). */ 2417 SWEEP_FIXED_TYPE_BLOCK(). */
2418
2127 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, 2419 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string,
2128 1, /*dumpable-flag*/ 2420 1, /*dumpable-flag*/
2129 mark_string, print_string, 2421 mark_string, print_string,
2130 0, string_equal, 0, 2422 0, string_equal, 0,
2131 string_description, 2423 string_description,
2132 string_getprop, 2424 string_getprop,
2133 string_putprop, 2425 string_putprop,
2134 string_remprop, 2426 string_remprop,
2135 string_plist, 2427 string_plist,
2136 Lisp_String); 2428 Lisp_String);
2429 #endif /* not MC_ALLOC */
2430
2137 /* String blocks contain this many useful bytes. */ 2431 /* String blocks contain this many useful bytes. */
2138 #define STRING_CHARS_BLOCK_SIZE \ 2432 #define STRING_CHARS_BLOCK_SIZE \
2139 ((Bytecount) (8192 - MALLOC_OVERHEAD - \ 2433 ((Bytecount) (8192 - MALLOC_OVERHEAD - \
2140 ((2 * sizeof (struct string_chars_block *)) \ 2434 ((2 * sizeof (struct string_chars_block *)) \
2141 + sizeof (EMACS_INT)))) 2435 + sizeof (EMACS_INT))))
2163 #define BIG_STRING_FULLSIZE_P(fullsize) ((fullsize) >= STRING_CHARS_BLOCK_SIZE) 2457 #define BIG_STRING_FULLSIZE_P(fullsize) ((fullsize) >= STRING_CHARS_BLOCK_SIZE)
2164 #define BIG_STRING_SIZE_P(size) (BIG_STRING_FULLSIZE_P (STRING_FULLSIZE(size))) 2458 #define BIG_STRING_SIZE_P(size) (BIG_STRING_FULLSIZE_P (STRING_FULLSIZE(size)))
2165 2459
2166 #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL) 2460 #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL)
2167 #define MARK_STRING_CHARS_AS_FREE(ptr) ((void) ((ptr)->string = NULL)) 2461 #define MARK_STRING_CHARS_AS_FREE(ptr) ((void) ((ptr)->string = NULL))
2462
2463 #ifdef MC_ALLOC
2464 static void
2465 finalize_string (void *header, int for_disksave)
2466 {
2467 if (!for_disksave)
2468 {
2469 Lisp_String *s = (Lisp_String *) header;
2470 Bytecount size = s->size_;
2471 if (BIG_STRING_SIZE_P (size))
2472 xfree (s->data_, Ibyte *);
2473 }
2474 }
2475
2476 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string,
2477 1, /*dumpable-flag*/
2478 mark_string, print_string,
2479 finalize_string,
2480 string_equal, 0,
2481 string_description,
2482 string_getprop,
2483 string_putprop,
2484 string_remprop,
2485 string_plist,
2486 Lisp_String);
2487
2488 #endif /* MC_ALLOC */
2168 2489
2169 struct string_chars 2490 struct string_chars
2170 { 2491 {
2171 Lisp_String *string; 2492 Lisp_String *string;
2172 unsigned char chars[1]; 2493 unsigned char chars[1];
2262 Lisp_String *s; 2583 Lisp_String *s;
2263 Bytecount fullsize = STRING_FULLSIZE (length); 2584 Bytecount fullsize = STRING_FULLSIZE (length);
2264 2585
2265 assert (length >= 0 && fullsize > 0); 2586 assert (length >= 0 && fullsize > 0);
2266 2587
2588 #ifdef MC_ALLOC
2589 s = alloc_lrecord_type (Lisp_String, &lrecord_string);
2590 #else /* not MC_ALLOC */
2267 /* Allocate the string header */ 2591 /* Allocate the string header */
2268 ALLOCATE_FIXED_TYPE (string, Lisp_String, s); 2592 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
2269 xzero (*s); 2593 xzero (*s);
2270 set_lheader_implementation (&s->u.lheader, &lrecord_string); 2594 set_lheader_implementation (&s->u.lheader, &lrecord_string);
2271 2595 #endif /* not MC_ALLOC */
2596
2272 set_lispstringp_data (s, BIG_STRING_FULLSIZE_P (fullsize) 2597 set_lispstringp_data (s, BIG_STRING_FULLSIZE_P (fullsize)
2273 ? allocate_big_string_chars (length + 1) 2598 ? allocate_big_string_chars (length + 1)
2274 : allocate_string_chars_struct (wrap_string (s), 2599 : allocate_string_chars_struct (wrap_string (s),
2275 fullsize)->chars); 2600 fullsize)->chars);
2276 2601
2277 set_lispstringp_length (s, length); 2602 set_lispstringp_length (s, length);
2278 s->plist = Qnil; 2603 s->plist = Qnil;
2279 set_string_byte (wrap_string (s), length, 0); 2604 set_string_byte (wrap_string (s), length, 0);
2280 2605
2296 { 2621 {
2297 Bytecount oldfullsize, newfullsize; 2622 Bytecount oldfullsize, newfullsize;
2298 #ifdef VERIFY_STRING_CHARS_INTEGRITY 2623 #ifdef VERIFY_STRING_CHARS_INTEGRITY
2299 verify_string_chars_integrity (); 2624 verify_string_chars_integrity ();
2300 #endif 2625 #endif
2301
2302 #ifdef ERROR_CHECK_TEXT 2626 #ifdef ERROR_CHECK_TEXT
2303 if (pos >= 0) 2627 if (pos >= 0)
2304 { 2628 {
2305 assert (pos <= XSTRING_LENGTH (s)); 2629 assert (pos <= XSTRING_LENGTH (s));
2306 if (delta < 0) 2630 if (delta < 0)
2496 else 2820 else
2497 { 2821 {
2498 EMACS_INT i; 2822 EMACS_INT i;
2499 Ibyte *ptr = XSTRING_DATA (val); 2823 Ibyte *ptr = XSTRING_DATA (val);
2500 2824
2825 #ifdef MC_ALLOC
2826 /* Need this for the new allocator: strings are using the uid
2827 field for ascii_begin. The uid field is set for debugging,
2828 but the string code assumes here that ascii_begin is always
2829 zero, when not touched. This assumption is not true with
2830 the new allocator, so ascii_begin has to be set to zero
2831 here. */
2832 XSET_STRING_ASCII_BEGIN (val, 0);
2833 #endif /* not MC_ALLOC */
2834
2501 for (i = XINT (length); i; i--) 2835 for (i = XINT (length); i; i--)
2502 { 2836 {
2503 Ibyte *init_ptr = init_str; 2837 Ibyte *init_ptr = init_str;
2504 switch (len) 2838 switch (len)
2505 { 2839 {
2632 /* Make sure we find out about bad make_string_nocopy's when they happen */ 2966 /* Make sure we find out about bad make_string_nocopy's when they happen */
2633 #if defined (ERROR_CHECK_TEXT) && defined (MULE) 2967 #if defined (ERROR_CHECK_TEXT) && defined (MULE)
2634 bytecount_to_charcount (contents, length); /* Just for the assertions */ 2968 bytecount_to_charcount (contents, length); /* Just for the assertions */
2635 #endif 2969 #endif
2636 2970
2971 #ifdef MC_ALLOC
2972 s = alloc_lrecord_type (Lisp_String, &lrecord_string);
2973 mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get
2974 collected and static data is tried to
2975 be freed. */
2976 #else /* not MC_ALLOC */
2637 /* Allocate the string header */ 2977 /* Allocate the string header */
2638 ALLOCATE_FIXED_TYPE (string, Lisp_String, s); 2978 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
2639 set_lheader_implementation (&s->u.lheader, &lrecord_string); 2979 set_lheader_implementation (&s->u.lheader, &lrecord_string);
2640 SET_C_READONLY_RECORD_HEADER (&s->u.lheader); 2980 SET_C_READONLY_RECORD_HEADER (&s->u.lheader);
2981 #endif /* not MC_ALLOC */
2641 s->plist = Qnil; 2982 s->plist = Qnil;
2642 set_lispstringp_data (s, (Ibyte *) contents); 2983 set_lispstringp_data (s, (Ibyte *) contents);
2643 set_lispstringp_length (s, length); 2984 set_lispstringp_length (s, length);
2644 val = wrap_string (s); 2985 val = wrap_string (s);
2645 init_string_ascii_begin (val); 2986 init_string_ascii_begin (val);
2647 2988
2648 return val; 2989 return val;
2649 } 2990 }
2650 2991
2651 2992
2993 #ifndef MC_ALLOC
2652 /************************************************************************/ 2994 /************************************************************************/
2653 /* lcrecord lists */ 2995 /* lcrecord lists */
2654 /************************************************************************/ 2996 /************************************************************************/
2655 2997
2656 /* Lcrecord lists are used to manage the allocation of particular 2998 /* Lcrecord lists are used to manage the allocation of particular
2854 3196
2855 assert (!EQ (all_lcrecord_lists[type], Qzero)); 3197 assert (!EQ (all_lcrecord_lists[type], Qzero));
2856 3198
2857 free_managed_lcrecord (all_lcrecord_lists[type], rec); 3199 free_managed_lcrecord (all_lcrecord_lists[type], rec);
2858 } 3200 }
3201 #endif /* not MC_ALLOC */
2859 3202
2860 3203
2861 DEFUN ("purecopy", Fpurecopy, 1, 1, 0, /* 3204 DEFUN ("purecopy", Fpurecopy, 1, 1, 0, /*
2862 Kept for compatibility, returns its argument. 3205 Kept for compatibility, returns its argument.
2863 Old: 3206 Old:
3028 } 3371 }
3029 #endif 3372 #endif
3030 3373
3031 #endif /* not DEBUG_XEMACS */ 3374 #endif /* not DEBUG_XEMACS */
3032 3375
3376
3377
3378
3379
3380 #ifdef MC_ALLOC
3381 static const struct memory_description mcpro_description_1[] = {
3382 { XD_END }
3383 };
3384
3385 static const struct sized_memory_description mcpro_description = {
3386 sizeof (Lisp_Object *),
3387 mcpro_description_1
3388 };
3389
3390 static const struct memory_description mcpros_description_1[] = {
3391 XD_DYNARR_DESC (Lisp_Object_dynarr, &mcpro_description),
3392 { XD_END }
3393 };
3394
3395 static const struct sized_memory_description mcpros_description = {
3396 sizeof (Lisp_Object_dynarr),
3397 mcpros_description_1
3398 };
3399
3400 #ifdef DEBUG_XEMACS
3401
3402 static const struct memory_description mcpro_one_name_description_1[] = {
3403 { XD_ASCII_STRING, 0 },
3404 { XD_END }
3405 };
3406
3407 static const struct sized_memory_description mcpro_one_name_description = {
3408 sizeof (char *),
3409 mcpro_one_name_description_1
3410 };
3411
3412 static const struct memory_description mcpro_names_description_1[] = {
3413 XD_DYNARR_DESC (char_ptr_dynarr, &mcpro_one_name_description),
3414 { XD_END }
3415 };
3416
3417 extern const struct sized_memory_description mcpro_names_description;
3418
3419 const struct sized_memory_description mcpro_names_description = {
3420 sizeof (char_ptr_dynarr),
3421 mcpro_names_description_1
3422 };
3423
3424 /* Help debug crashes gc-marking a mcpro'ed object. */
3425
3426 Lisp_Object_dynarr *mcpros;
3427 char_ptr_dynarr *mcpro_names;
3428
3429 /* Mark the Lisp_Object at non-heap VARADDRESS as a root object for
3430 garbage collection, and for dumping. */
3431 void
3432 mcpro_1 (Lisp_Object varaddress, char *varname)
3433 {
3434 Dynarr_add (mcpros, varaddress);
3435 Dynarr_add (mcpro_names, varname);
3436 }
3437
3438 #else /* not DEBUG_XEMACS */
3439
3440 Lisp_Object_dynarr *mcpros;
3441
3442 /* Mark the Lisp_Object at non-heap VARADDRESS as a root object for
3443 garbage collection, and for dumping. */
3444 void
3445 mcpro (Lisp_Object varaddress)
3446 {
3447 Dynarr_add (mcpros, varaddress);
3448 }
3449
3450 #endif /* not DEBUG_XEMACS */
3451 #endif /* MC_ALLOC */
3452
3033 #ifdef ERROR_CHECK_GC 3453 #ifdef ERROR_CHECK_GC
3454 #ifdef MC_ALLOC
3455 #define GC_CHECK_LHEADER_INVARIANTS(lheader) do { \
3456 struct lrecord_header * GCLI_lh = (lheader); \
3457 assert (GCLI_lh != 0); \
3458 assert (GCLI_lh->type < (unsigned int) lrecord_type_count); \
3459 } while (0)
3460 #else /* not MC_ALLOC */
3034 #define GC_CHECK_LHEADER_INVARIANTS(lheader) do { \ 3461 #define GC_CHECK_LHEADER_INVARIANTS(lheader) do { \
3035 struct lrecord_header * GCLI_lh = (lheader); \ 3462 struct lrecord_header * GCLI_lh = (lheader); \
3036 assert (GCLI_lh != 0); \ 3463 assert (GCLI_lh != 0); \
3037 assert (GCLI_lh->type < (unsigned int) lrecord_type_count); \ 3464 assert (GCLI_lh->type < (unsigned int) lrecord_type_count); \
3038 assert (! C_READONLY_RECORD_HEADER_P (GCLI_lh) || \ 3465 assert (! C_READONLY_RECORD_HEADER_P (GCLI_lh) || \
3039 (MARKED_RECORD_HEADER_P (GCLI_lh) && \ 3466 (MARKED_RECORD_HEADER_P (GCLI_lh) && \
3040 LISP_READONLY_RECORD_HEADER_P (GCLI_lh))); \ 3467 LISP_READONLY_RECORD_HEADER_P (GCLI_lh))); \
3041 } while (0) 3468 } while (0)
3469 #endif /* not MC_ALLOC */
3042 #else 3470 #else
3043 #define GC_CHECK_LHEADER_INVARIANTS(lheader) 3471 #define GC_CHECK_LHEADER_INVARIANTS(lheader)
3044 #endif 3472 #endif
3045 3473
3046 3474
3289 } 3717 }
3290 } 3718 }
3291 3719
3292 #endif /* defined (USE_KKCC) || defined (PDUMP) */ 3720 #endif /* defined (USE_KKCC) || defined (PDUMP) */
3293 3721
3722 #ifdef MC_ALLOC
3723 #define GC_CHECK_NOT_FREE(lheader) \
3724 gc_checking_assert (! LRECORD_FREE_P (lheader));
3725 #else /* MC_ALLOC */
3294 #define GC_CHECK_NOT_FREE(lheader) \ 3726 #define GC_CHECK_NOT_FREE(lheader) \
3727 gc_checking_assert (! LRECORD_FREE_P (lheader)); \
3295 gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || \ 3728 gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || \
3296 ! ((struct lcrecord_header *) lheader)->free) 3729 ! ((struct lcrecord_header *) lheader)->free)
3730 #endif /* MC_ALLOC */
3297 3731
3298 #ifdef USE_KKCC 3732 #ifdef USE_KKCC
3299 /* The following functions implement the new mark algorithm. 3733 /* The following functions implement the new mark algorithm.
3300 They mark objects according to their descriptions. They 3734 They mark objects according to their descriptions. They
3301 are modeled on the corresponding pdumper procedures. */ 3735 are modeled on the corresponding pdumper procedures. */
3337 stderr_out ("KKCC mark stack backtrace :\n"); 3771 stderr_out ("KKCC mark stack backtrace :\n");
3338 for (i = kkcc_bt_depth - 1; i >= 0; i--) 3772 for (i = kkcc_bt_depth - 1; i >= 0; i--)
3339 { 3773 {
3340 Lisp_Object obj = wrap_pointer_1 (kkcc_bt[i].obj); 3774 Lisp_Object obj = wrap_pointer_1 (kkcc_bt[i].obj);
3341 stderr_out (" [%d]", i); 3775 stderr_out (" [%d]", i);
3776 #ifdef MC_ALLOC
3777 if ((XRECORD_LHEADER (obj)->type >= lrecord_type_last_built_in_type)
3778 #else /* not MC_ALLOC */
3342 if ((XRECORD_LHEADER (obj)->type >= lrecord_type_free) 3779 if ((XRECORD_LHEADER (obj)->type >= lrecord_type_free)
3780 #endif /* not MC_ALLOC */
3343 || (!LRECORDP (obj)) 3781 || (!LRECORDP (obj))
3344 || (!XRECORD_LHEADER_IMPLEMENTATION (obj))) 3782 || (!XRECORD_LHEADER_IMPLEMENTATION (obj)))
3345 { 3783 {
3346 stderr_out (" non Lisp Object"); 3784 stderr_out (" non Lisp Object");
3347 } 3785 }
3628 level = stack_entry->level + 1; 4066 level = stack_entry->level + 1;
3629 #endif 4067 #endif
3630 4068
3631 kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos); 4069 kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos);
3632 4070
4071 gc_checking_assert (data);
4072 gc_checking_assert (desc);
4073
3633 for (pos = 0; desc[pos].type != XD_END; pos++) 4074 for (pos = 0; desc[pos].type != XD_END; pos++)
3634 { 4075 {
3635 const struct memory_description *desc1 = &desc[pos]; 4076 const struct memory_description *desc1 = &desc[pos];
3636 const void *rdata = 4077 const void *rdata =
3637 (const char *) data + lispdesc_indirect_count (desc1->offset, 4078 (const char *) data + lispdesc_indirect_count (desc1->offset,
3664 Lisp_Objects have the same representation), XD_LISP_OBJECT 4105 Lisp_Objects have the same representation), XD_LISP_OBJECT
3665 can be used for untagged pointers. They might be NULL, 4106 can be used for untagged pointers. They might be NULL,
3666 though. */ 4107 though. */
3667 if (EQ (*stored_obj, Qnull_pointer)) 4108 if (EQ (*stored_obj, Qnull_pointer))
3668 break; 4109 break;
4110 #ifdef MC_ALLOC
4111 mark_object_maybe_checking_free (*stored_obj, 0, level, pos);
4112 #else /* not MC_ALLOC */
3669 mark_object_maybe_checking_free 4113 mark_object_maybe_checking_free
3670 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, 4114 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT,
3671 level, pos); 4115 level, pos);
3672 break; 4116 break;
4117 #endif /* not MC_ALLOC */
3673 } 4118 }
3674 case XD_LISP_OBJECT_ARRAY: 4119 case XD_LISP_OBJECT_ARRAY:
3675 { 4120 {
3676 int i; 4121 int i;
3677 EMACS_INT count = 4122 EMACS_INT count =
3682 const Lisp_Object *stored_obj = 4127 const Lisp_Object *stored_obj =
3683 (const Lisp_Object *) rdata + i; 4128 (const Lisp_Object *) rdata + i;
3684 4129
3685 if (EQ (*stored_obj, Qnull_pointer)) 4130 if (EQ (*stored_obj, Qnull_pointer))
3686 break; 4131 break;
4132 #ifdef MC_ALLOC
4133 mark_object_maybe_checking_free (*stored_obj, 0, level, pos);
4134 #else /* not MC_ALLOC */
3687 mark_object_maybe_checking_free 4135 mark_object_maybe_checking_free
3688 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT, 4136 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT,
3689 level, pos); 4137 level, pos);
4138 #endif /* not MC_ALLOC */
3690 } 4139 }
3691 break; 4140 break;
3692 } 4141 }
3693 case XD_BLOCK_PTR: 4142 case XD_BLOCK_PTR:
3694 { 4143 {
3781 } 4230 }
3782 #endif /* not KKCC */ 4231 #endif /* not KKCC */
3783 } 4232 }
3784 4233
3785 4234
4235 #ifndef MC_ALLOC
3786 static int gc_count_num_short_string_in_use; 4236 static int gc_count_num_short_string_in_use;
3787 static Bytecount gc_count_string_total_size; 4237 static Bytecount gc_count_string_total_size;
3788 static Bytecount gc_count_short_string_total_size; 4238 static Bytecount gc_count_short_string_total_size;
3789 4239
3790 /* static int gc_count_total_records_used, gc_count_records_total_size; */ 4240 /* static int gc_count_total_records_used, gc_count_records_total_size; */
3826 lcrecord_stats[type_index].instances_in_use++; 4276 lcrecord_stats[type_index].instances_in_use++;
3827 lcrecord_stats[type_index].bytes_in_use += sz; 4277 lcrecord_stats[type_index].bytes_in_use += sz;
3828 } 4278 }
3829 } 4279 }
3830 } 4280 }
4281 #endif /* not MC_ALLOC */
3831 4282
3832 4283
4284 #ifndef MC_ALLOC
3833 /* Free all unmarked records */ 4285 /* Free all unmarked records */
3834 static void 4286 static void
3835 sweep_lcrecords_1 (struct lcrecord_header **prev, int *used) 4287 sweep_lcrecords_1 (struct lcrecord_header **prev, int *used)
3836 { 4288 {
3837 struct lcrecord_header *header; 4289 struct lcrecord_header *header;
4023 #endif /* !ERROR_CHECK_GC */ 4475 #endif /* !ERROR_CHECK_GC */
4024 4476
4025 #define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \ 4477 #define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \
4026 SWEEP_FIXED_TYPE_BLOCK_1 (typename, obj_type, lheader) 4478 SWEEP_FIXED_TYPE_BLOCK_1 (typename, obj_type, lheader)
4027 4479
4480 #endif /* not MC_ALLOC */
4481
4028 4482
4029 4483 #ifndef MC_ALLOC
4030
4031 static void 4484 static void
4032 sweep_conses (void) 4485 sweep_conses (void)
4033 { 4486 {
4034 #define UNMARK_cons(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4487 #define UNMARK_cons(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4035 #define ADDITIONAL_FREE_cons(ptr) 4488 #define ADDITIONAL_FREE_cons(ptr)
4036 4489
4037 SWEEP_FIXED_TYPE_BLOCK (cons, Lisp_Cons); 4490 SWEEP_FIXED_TYPE_BLOCK (cons, Lisp_Cons);
4038 } 4491 }
4492 #endif /* not MC_ALLOC */
4039 4493
4040 /* Explicitly free a cons cell. */ 4494 /* Explicitly free a cons cell. */
4041 void 4495 void
4042 free_cons (Lisp_Object cons) 4496 free_cons (Lisp_Object cons)
4043 { 4497 {
4498 #ifndef MC_ALLOC /* to avoid compiler warning */
4044 Lisp_Cons *ptr = XCONS (cons); 4499 Lisp_Cons *ptr = XCONS (cons);
4500 #endif /* MC_ALLOC */
4045 4501
4046 #ifdef ERROR_CHECK_GC 4502 #ifdef ERROR_CHECK_GC
4503 #ifdef MC_ALLOC
4504 Lisp_Cons *ptr = XCONS (cons);
4505 #endif /* MC_ALLOC */
4047 /* If the CAR is not an int, then it will be a pointer, which will 4506 /* If the CAR is not an int, then it will be a pointer, which will
4048 always be four-byte aligned. If this cons cell has already been 4507 always be four-byte aligned. If this cons cell has already been
4049 placed on the free list, however, its car will probably contain 4508 placed on the free list, however, its car will probably contain
4050 a chain pointer to the next cons on the list, which has cleverly 4509 a chain pointer to the next cons on the list, which has cleverly
4051 had all its 0's and 1's inverted. This allows for a quick 4510 had all its 0's and 1's inverted. This allows for a quick
4056 well as a check in FREE_FIXED_TYPE(). */ 4515 well as a check in FREE_FIXED_TYPE(). */
4057 if (POINTER_TYPE_P (XTYPE (cons_car (ptr)))) 4516 if (POINTER_TYPE_P (XTYPE (cons_car (ptr))))
4058 ASSERT_VALID_POINTER (XPNTR (cons_car (ptr))); 4517 ASSERT_VALID_POINTER (XPNTR (cons_car (ptr)));
4059 #endif /* ERROR_CHECK_GC */ 4518 #endif /* ERROR_CHECK_GC */
4060 4519
4520 #ifdef MC_ALLOC
4521 free_lrecord (cons);
4522 #else /* not MC_ALLOC */
4061 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, Lisp_Cons, ptr); 4523 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, Lisp_Cons, ptr);
4524 #endif /* not MC_ALLOC */
4062 } 4525 }
4063 4526
4064 /* explicitly free a list. You **must make sure** that you have 4527 /* explicitly free a list. You **must make sure** that you have
4065 created all the cons cells that make up this list and that there 4528 created all the cons cells that make up this list and that there
4066 are no pointers to any of these cons cells anywhere else. If there 4529 are no pointers to any of these cons cells anywhere else. If there
4094 free_cons (XCAR (rest)); 4557 free_cons (XCAR (rest));
4095 free_cons (rest); 4558 free_cons (rest);
4096 } 4559 }
4097 } 4560 }
4098 4561
4562 #ifndef MC_ALLOC
4099 static void 4563 static void
4100 sweep_compiled_functions (void) 4564 sweep_compiled_functions (void)
4101 { 4565 {
4102 #define UNMARK_compiled_function(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4566 #define UNMARK_compiled_function(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4103 #define ADDITIONAL_FREE_compiled_function(ptr) \ 4567 #define ADDITIONAL_FREE_compiled_function(ptr) \
4172 #define UNMARK_event(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4636 #define UNMARK_event(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4173 #define ADDITIONAL_FREE_event(ptr) 4637 #define ADDITIONAL_FREE_event(ptr)
4174 4638
4175 SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event); 4639 SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event);
4176 } 4640 }
4641 #endif /* not MC_ALLOC */
4177 4642
4178 #ifdef EVENT_DATA_AS_OBJECTS 4643 #ifdef EVENT_DATA_AS_OBJECTS
4179 4644
4645 #ifndef MC_ALLOC
4180 static void 4646 static void
4181 sweep_key_data (void) 4647 sweep_key_data (void)
4182 { 4648 {
4183 #define UNMARK_key_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4649 #define UNMARK_key_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4184 #define ADDITIONAL_FREE_key_data(ptr) 4650 #define ADDITIONAL_FREE_key_data(ptr)
4185 4651
4186 SWEEP_FIXED_TYPE_BLOCK (key_data, Lisp_Key_Data); 4652 SWEEP_FIXED_TYPE_BLOCK (key_data, Lisp_Key_Data);
4187 } 4653 }
4654 #endif /* not MC_ALLOC */
4188 4655
4189 void 4656 void
4190 free_key_data (Lisp_Object ptr) 4657 free_key_data (Lisp_Object ptr)
4191 { 4658 {
4659 #ifdef MC_ALLOC
4660 free_lrecord (ptr);
4661 #else /* not MC_ALLOC */
4192 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (key_data, Lisp_Key_Data, XKEY_DATA (ptr)); 4662 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (key_data, Lisp_Key_Data, XKEY_DATA (ptr));
4193 } 4663 #endif /* not MC_ALLOC */
4194 4664 }
4665
4666 #ifndef MC_ALLOC
4195 static void 4667 static void
4196 sweep_button_data (void) 4668 sweep_button_data (void)
4197 { 4669 {
4198 #define UNMARK_button_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4670 #define UNMARK_button_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4199 #define ADDITIONAL_FREE_button_data(ptr) 4671 #define ADDITIONAL_FREE_button_data(ptr)
4200 4672
4201 SWEEP_FIXED_TYPE_BLOCK (button_data, Lisp_Button_Data); 4673 SWEEP_FIXED_TYPE_BLOCK (button_data, Lisp_Button_Data);
4202 } 4674 }
4675 #endif /* not MC_ALLOC */
4203 4676
4204 void 4677 void
4205 free_button_data (Lisp_Object ptr) 4678 free_button_data (Lisp_Object ptr)
4206 { 4679 {
4680 #ifdef MC_ALLOC
4681 free_lrecord (ptr);
4682 #else /* not MC_ALLOC */
4207 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (button_data, Lisp_Button_Data, XBUTTON_DATA (ptr)); 4683 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (button_data, Lisp_Button_Data, XBUTTON_DATA (ptr));
4208 } 4684 #endif /* not MC_ALLOC */
4209 4685 }
4686
4687 #ifndef MC_ALLOC
4210 static void 4688 static void
4211 sweep_motion_data (void) 4689 sweep_motion_data (void)
4212 { 4690 {
4213 #define UNMARK_motion_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4691 #define UNMARK_motion_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4214 #define ADDITIONAL_FREE_motion_data(ptr) 4692 #define ADDITIONAL_FREE_motion_data(ptr)
4215 4693
4216 SWEEP_FIXED_TYPE_BLOCK (motion_data, Lisp_Motion_Data); 4694 SWEEP_FIXED_TYPE_BLOCK (motion_data, Lisp_Motion_Data);
4217 } 4695 }
4696 #endif /* not MC_ALLOC */
4218 4697
4219 void 4698 void
4220 free_motion_data (Lisp_Object ptr) 4699 free_motion_data (Lisp_Object ptr)
4221 { 4700 {
4701 #ifdef MC_ALLOC
4702 free_lrecord (ptr);
4703 #else /* not MC_ALLOC */
4222 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (motion_data, Lisp_Motion_Data, XMOTION_DATA (ptr)); 4704 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (motion_data, Lisp_Motion_Data, XMOTION_DATA (ptr));
4223 } 4705 #endif /* not MC_ALLOC */
4224 4706 }
4707
4708 #ifndef MC_ALLOC
4225 static void 4709 static void
4226 sweep_process_data (void) 4710 sweep_process_data (void)
4227 { 4711 {
4228 #define UNMARK_process_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4712 #define UNMARK_process_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4229 #define ADDITIONAL_FREE_process_data(ptr) 4713 #define ADDITIONAL_FREE_process_data(ptr)
4230 4714
4231 SWEEP_FIXED_TYPE_BLOCK (process_data, Lisp_Process_Data); 4715 SWEEP_FIXED_TYPE_BLOCK (process_data, Lisp_Process_Data);
4232 } 4716 }
4717 #endif /* not MC_ALLOC */
4233 4718
4234 void 4719 void
4235 free_process_data (Lisp_Object ptr) 4720 free_process_data (Lisp_Object ptr)
4236 { 4721 {
4722 #ifdef MC_ALLOC
4723 free_lrecord (ptr);
4724 #else /* not MC_ALLOC */
4237 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (process_data, Lisp_Process_Data, XPROCESS_DATA (ptr)); 4725 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (process_data, Lisp_Process_Data, XPROCESS_DATA (ptr));
4238 } 4726 #endif /* not MC_ALLOC */
4239 4727 }
4728
4729 #ifndef MC_ALLOC
4240 static void 4730 static void
4241 sweep_timeout_data (void) 4731 sweep_timeout_data (void)
4242 { 4732 {
4243 #define UNMARK_timeout_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4733 #define UNMARK_timeout_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4244 #define ADDITIONAL_FREE_timeout_data(ptr) 4734 #define ADDITIONAL_FREE_timeout_data(ptr)
4245 4735
4246 SWEEP_FIXED_TYPE_BLOCK (timeout_data, Lisp_Timeout_Data); 4736 SWEEP_FIXED_TYPE_BLOCK (timeout_data, Lisp_Timeout_Data);
4247 } 4737 }
4738 #endif /* not MC_ALLOC */
4248 4739
4249 void 4740 void
4250 free_timeout_data (Lisp_Object ptr) 4741 free_timeout_data (Lisp_Object ptr)
4251 { 4742 {
4743 #ifdef MC_ALLOC
4744 free_lrecord (ptr);
4745 #else /* not MC_ALLOC */
4252 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (timeout_data, Lisp_Timeout_Data, XTIMEOUT_DATA (ptr)); 4746 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (timeout_data, Lisp_Timeout_Data, XTIMEOUT_DATA (ptr));
4253 } 4747 #endif /* not MC_ALLOC */
4254 4748 }
4749
4750 #ifndef MC_ALLOC
4255 static void 4751 static void
4256 sweep_magic_data (void) 4752 sweep_magic_data (void)
4257 { 4753 {
4258 #define UNMARK_magic_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4754 #define UNMARK_magic_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4259 #define ADDITIONAL_FREE_magic_data(ptr) 4755 #define ADDITIONAL_FREE_magic_data(ptr)
4260 4756
4261 SWEEP_FIXED_TYPE_BLOCK (magic_data, Lisp_Magic_Data); 4757 SWEEP_FIXED_TYPE_BLOCK (magic_data, Lisp_Magic_Data);
4262 } 4758 }
4759 #endif /* not MC_ALLOC */
4263 4760
4264 void 4761 void
4265 free_magic_data (Lisp_Object ptr) 4762 free_magic_data (Lisp_Object ptr)
4266 { 4763 {
4764 #ifdef MC_ALLOC
4765 free_lrecord (ptr);
4766 #else /* not MC_ALLOC */
4267 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_data, Lisp_Magic_Data, XMAGIC_DATA (ptr)); 4767 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_data, Lisp_Magic_Data, XMAGIC_DATA (ptr));
4268 } 4768 #endif /* not MC_ALLOC */
4269 4769 }
4770
4771 #ifndef MC_ALLOC
4270 static void 4772 static void
4271 sweep_magic_eval_data (void) 4773 sweep_magic_eval_data (void)
4272 { 4774 {
4273 #define UNMARK_magic_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4775 #define UNMARK_magic_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4274 #define ADDITIONAL_FREE_magic_eval_data(ptr) 4776 #define ADDITIONAL_FREE_magic_eval_data(ptr)
4275 4777
4276 SWEEP_FIXED_TYPE_BLOCK (magic_eval_data, Lisp_Magic_Eval_Data); 4778 SWEEP_FIXED_TYPE_BLOCK (magic_eval_data, Lisp_Magic_Eval_Data);
4277 } 4779 }
4780 #endif /* not MC_ALLOC */
4278 4781
4279 void 4782 void
4280 free_magic_eval_data (Lisp_Object ptr) 4783 free_magic_eval_data (Lisp_Object ptr)
4281 { 4784 {
4785 #ifdef MC_ALLOC
4786 free_lrecord (ptr);
4787 #else /* not MC_ALLOC */
4282 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_eval_data, Lisp_Magic_Eval_Data, XMAGIC_EVAL_DATA (ptr)); 4788 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_eval_data, Lisp_Magic_Eval_Data, XMAGIC_EVAL_DATA (ptr));
4283 } 4789 #endif /* not MC_ALLOC */
4284 4790 }
4791
4792 #ifndef MC_ALLOC
4285 static void 4793 static void
4286 sweep_eval_data (void) 4794 sweep_eval_data (void)
4287 { 4795 {
4288 #define UNMARK_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4796 #define UNMARK_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4289 #define ADDITIONAL_FREE_eval_data(ptr) 4797 #define ADDITIONAL_FREE_eval_data(ptr)
4290 4798
4291 SWEEP_FIXED_TYPE_BLOCK (eval_data, Lisp_Eval_Data); 4799 SWEEP_FIXED_TYPE_BLOCK (eval_data, Lisp_Eval_Data);
4292 } 4800 }
4801 #endif /* not MC_ALLOC */
4293 4802
4294 void 4803 void
4295 free_eval_data (Lisp_Object ptr) 4804 free_eval_data (Lisp_Object ptr)
4296 { 4805 {
4806 #ifdef MC_ALLOC
4807 free_lrecord (ptr);
4808 #else /* not MC_ALLOC */
4297 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (eval_data, Lisp_Eval_Data, XEVAL_DATA (ptr)); 4809 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (eval_data, Lisp_Eval_Data, XEVAL_DATA (ptr));
4298 } 4810 #endif /* not MC_ALLOC */
4299 4811 }
4812
4813 #ifndef MC_ALLOC
4300 static void 4814 static void
4301 sweep_misc_user_data (void) 4815 sweep_misc_user_data (void)
4302 { 4816 {
4303 #define UNMARK_misc_user_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4817 #define UNMARK_misc_user_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4304 #define ADDITIONAL_FREE_misc_user_data(ptr) 4818 #define ADDITIONAL_FREE_misc_user_data(ptr)
4305 4819
4306 SWEEP_FIXED_TYPE_BLOCK (misc_user_data, Lisp_Misc_User_Data); 4820 SWEEP_FIXED_TYPE_BLOCK (misc_user_data, Lisp_Misc_User_Data);
4307 } 4821 }
4822 #endif /* not MC_ALLOC */
4308 4823
4309 void 4824 void
4310 free_misc_user_data (Lisp_Object ptr) 4825 free_misc_user_data (Lisp_Object ptr)
4311 { 4826 {
4827 #ifdef MC_ALLOC
4828 free_lrecord (ptr);
4829 #else /* not MC_ALLOC */
4312 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (misc_user_data, Lisp_Misc_User_Data, XMISC_USER_DATA (ptr)); 4830 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (misc_user_data, Lisp_Misc_User_Data, XMISC_USER_DATA (ptr));
4831 #endif /* not MC_ALLOC */
4313 } 4832 }
4314 4833
4315 #endif /* EVENT_DATA_AS_OBJECTS */ 4834 #endif /* EVENT_DATA_AS_OBJECTS */
4316 4835
4836 #ifndef MC_ALLOC
4317 static void 4837 static void
4318 sweep_markers (void) 4838 sweep_markers (void)
4319 { 4839 {
4320 #define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) 4840 #define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
4321 #define ADDITIONAL_FREE_marker(ptr) \ 4841 #define ADDITIONAL_FREE_marker(ptr) \
4324 unchain_marker (tem); \ 4844 unchain_marker (tem); \
4325 } while (0) 4845 } while (0)
4326 4846
4327 SWEEP_FIXED_TYPE_BLOCK (marker, Lisp_Marker); 4847 SWEEP_FIXED_TYPE_BLOCK (marker, Lisp_Marker);
4328 } 4848 }
4849 #endif /* not MC_ALLOC */
4329 4850
4330 /* Explicitly free a marker. */ 4851 /* Explicitly free a marker. */
4331 void 4852 void
4332 free_marker (Lisp_Object ptr) 4853 free_marker (Lisp_Object ptr)
4333 { 4854 {
4855 #ifdef MC_ALLOC
4856 free_lrecord (ptr);
4857 #else /* not MC_ALLOC */
4334 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, XMARKER (ptr)); 4858 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, XMARKER (ptr));
4859 #endif /* not MC_ALLOC */
4335 } 4860 }
4336 4861
4337 4862
4338 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) 4863 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY)
4339 4864
4372 4897
4373 size = string->size_; 4898 size = string->size_;
4374 fullsize = STRING_FULLSIZE (size); 4899 fullsize = STRING_FULLSIZE (size);
4375 4900
4376 assert (!BIG_STRING_FULLSIZE_P (fullsize)); 4901 assert (!BIG_STRING_FULLSIZE_P (fullsize));
4377 assert (string->data_ == s_chars->chars); 4902 assert (XSTRING_DATA (string) == s_chars->chars);
4378 pos += fullsize; 4903 pos += fullsize;
4379 } 4904 }
4380 assert (pos == sb->pos); 4905 assert (pos == sb->pos);
4381 } 4906 }
4382 } 4907 }
4480 current_string_chars_block->pos = to_pos; 5005 current_string_chars_block->pos = to_pos;
4481 current_string_chars_block->next = 0; 5006 current_string_chars_block->next = 0;
4482 } 5007 }
4483 } 5008 }
4484 5009
5010 #ifndef MC_ALLOC
4485 #if 1 /* Hack to debug missing purecopy's */ 5011 #if 1 /* Hack to debug missing purecopy's */
4486 static int debug_string_purity; 5012 static int debug_string_purity;
4487 5013
4488 static void 5014 static void
4489 debug_string_purity_print (Lisp_Object p) 5015 debug_string_purity_print (Lisp_Object p)
4502 stderr_out ("%c", ch); 5028 stderr_out ("%c", ch);
4503 } 5029 }
4504 stderr_out ("\"\n"); 5030 stderr_out ("\"\n");
4505 } 5031 }
4506 #endif /* 1 */ 5032 #endif /* 1 */
4507 5033 #endif /* not MC_ALLOC */
4508 5034
5035 #ifndef MC_ALLOC
4509 static void 5036 static void
4510 sweep_strings (void) 5037 sweep_strings (void)
4511 { 5038 {
4512 int num_small_used = 0; 5039 int num_small_used = 0;
4513 Bytecount num_small_bytes = 0, num_bytes = 0; 5040 Bytecount num_small_bytes = 0, num_bytes = 0;
4536 5063
4537 gc_count_num_short_string_in_use = num_small_used; 5064 gc_count_num_short_string_in_use = num_small_used;
4538 gc_count_string_total_size = num_bytes; 5065 gc_count_string_total_size = num_bytes;
4539 gc_count_short_string_total_size = num_small_bytes; 5066 gc_count_short_string_total_size = num_small_bytes;
4540 } 5067 }
4541 5068 #endif /* not MC_ALLOC */
4542 5069
4543 /* I hate duplicating all this crap! */ 5070 /* I hate duplicating all this crap! */
4544 int 5071 int
4545 marked_p (Lisp_Object obj) 5072 marked_p (Lisp_Object obj)
4546 { 5073 {
4561 } 5088 }
4562 5089
4563 static void 5090 static void
4564 gc_sweep (void) 5091 gc_sweep (void)
4565 { 5092 {
5093 #ifdef MC_ALLOC
5094 compact_string_chars ();
5095 mc_finalize ();
5096 mc_sweep ();
5097 #else /* not MC_ALLOC */
4566 /* Free all unmarked records. Do this at the very beginning, 5098 /* Free all unmarked records. Do this at the very beginning,
4567 before anything else, so that the finalize methods can safely 5099 before anything else, so that the finalize methods can safely
4568 examine items in the objects. sweep_lcrecords_1() makes 5100 examine items in the objects. sweep_lcrecords_1() makes
4569 sure to call all the finalize methods *before* freeing anything, 5101 sure to call all the finalize methods *before* freeing anything,
4570 to complete the safety. */ 5102 to complete the safety. */
4635 sweep_magic_data (); 5167 sweep_magic_data ();
4636 sweep_magic_eval_data (); 5168 sweep_magic_eval_data ();
4637 sweep_eval_data (); 5169 sweep_eval_data ();
4638 sweep_misc_user_data (); 5170 sweep_misc_user_data ();
4639 #endif /* EVENT_DATA_AS_OBJECTS */ 5171 #endif /* EVENT_DATA_AS_OBJECTS */
4640 5172 #endif /* not MC_ALLOC */
5173
5174 #ifndef MC_ALLOC
4641 #ifdef PDUMP 5175 #ifdef PDUMP
4642 pdump_objects_unmark (); 5176 pdump_objects_unmark ();
4643 #endif 5177 #endif
5178 #endif /* not MC_ALLOC */
4644 } 5179 }
4645 5180
4646 /* Clearing for disksave. */ 5181 /* Clearing for disksave. */
4647 5182
4648 void 5183 void
4927 Lisp_Object **p = Dynarr_begin (staticpros_nodump); 5462 Lisp_Object **p = Dynarr_begin (staticpros_nodump);
4928 Elemcount count; 5463 Elemcount count;
4929 for (count = Dynarr_length (staticpros_nodump); count; count--) 5464 for (count = Dynarr_length (staticpros_nodump); count; count--)
4930 mark_object (**p++); 5465 mark_object (**p++);
4931 } 5466 }
5467
5468 #ifdef MC_ALLOC
5469 { /* mcpro () */
5470 Lisp_Object *p = Dynarr_begin (mcpros);
5471 Elemcount count;
5472 for (count = Dynarr_length (mcpros); count; count--)
5473 mark_object (*p++);
5474 }
5475 #endif /* MC_ALLOC */
4932 5476
4933 { /* GCPRO() */ 5477 { /* GCPRO() */
4934 struct gcpro *tail; 5478 struct gcpro *tail;
4935 int i; 5479 int i;
4936 for (tail = gcprolist; tail; tail = tail->next) 5480 for (tail = gcprolist; tail; tail = tail->next)
5071 } 5615 }
5072 5616
5073 /* now stop inhibiting GC */ 5617 /* now stop inhibiting GC */
5074 unbind_to (speccount); 5618 unbind_to (speccount);
5075 5619
5620 #ifndef MC_ALLOC
5076 if (!breathing_space) 5621 if (!breathing_space)
5077 { 5622 {
5078 breathing_space = malloc (4096 - MALLOC_OVERHEAD); 5623 breathing_space = malloc (4096 - MALLOC_OVERHEAD);
5079 } 5624 }
5625 #endif /* not MC_ALLOC */
5080 5626
5081 UNGCPRO; 5627 UNGCPRO;
5082 5628
5083 need_to_signal_post_gc = 1; 5629 need_to_signal_post_gc = 1;
5084 funcall_allocation_flag = 1; 5630 funcall_allocation_flag = 1;
5086 PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection); 5632 PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection);
5087 5633
5088 return; 5634 return;
5089 } 5635 }
5090 5636
5637 #ifdef MC_ALLOC
5638 #ifdef MC_ALLOC_TYPE_STATS
5639 static Lisp_Object
5640 gc_plist_hack (const Ascbyte *name, int value, Lisp_Object tail)
5641 {
5642 /* C doesn't have local functions (or closures, or GC, or readable syntax,
5643 or portable numeric datatypes, or bit-vectors, or characters, or
5644 arrays, or exceptions, or ...) */
5645 return cons3 (intern (name), make_int (value), tail);
5646 }
5647 #endif /* MC_ALLOC_TYPE_STATS */
5648
5649 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /*
5650 Reclaim storage for Lisp objects no longer needed.
5651 Return info on amount of space in use:
5652 ((USED-CONSES . STORAGE-CONSES) (USED-SYMS . STORAGE-SYMS)
5653 (USED-MARKERS . STORAGE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
5654 PLIST)
5655 where `PLIST' is a list of alternating keyword/value pairs providing
5656 more detailed information.
5657 Garbage collection happens automatically if you cons more than
5658 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.
5659 */
5660 ())
5661 {
5662 #ifdef MC_ALLOC_TYPE_STATS
5663 Lisp_Object pl = Qnil;
5664 int i;
5665 #endif /* not MC_ALLOC_TYPE_STATS */
5666
5667 garbage_collect_1 ();
5668
5669 #ifdef MC_ALLOC_TYPE_STATS
5670 for (i = 0; i < (countof (lrecord_implementations_table)
5671 + MODULE_DEFINABLE_TYPE_COUNT); i++)
5672 {
5673 if (lrecord_stats[i].instances_in_use != 0)
5674 {
5675 char buf [255];
5676 const char *name = lrecord_implementations_table[i]->name;
5677 int len = strlen (name);
5678
5679 if (lrecord_stats[i].bytes_in_use_including_overhead !=
5680 lrecord_stats[i].bytes_in_use)
5681 {
5682 sprintf (buf, "%s-storage-including-overhead", name);
5683 pl = gc_plist_hack (buf,
5684 lrecord_stats[i]
5685 .bytes_in_use_including_overhead,
5686 pl);
5687 }
5688
5689 sprintf (buf, "%s-storage", name);
5690 pl = gc_plist_hack (buf,
5691 lrecord_stats[i].bytes_in_use,
5692 pl);
5693
5694 if (name[len-1] == 's')
5695 sprintf (buf, "%ses-used", name);
5696 else
5697 sprintf (buf, "%ss-used", name);
5698 pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
5699 }
5700 }
5701
5702 /* The things we do for backwards-compatibility */
5703 return
5704 list6
5705 (Fcons (make_int (lrecord_stats[lrecord_type_cons].instances_in_use),
5706 make_int (lrecord_stats[lrecord_type_cons]
5707 .bytes_in_use_including_overhead)),
5708 Fcons (make_int (lrecord_stats[lrecord_type_symbol].instances_in_use),
5709 make_int (lrecord_stats[lrecord_type_symbol]
5710 .bytes_in_use_including_overhead)),
5711 Fcons (make_int (lrecord_stats[lrecord_type_marker].instances_in_use),
5712 make_int (lrecord_stats[lrecord_type_marker]
5713 .bytes_in_use_including_overhead)),
5714 make_int (lrecord_stats[lrecord_type_string]
5715 .bytes_in_use_including_overhead),
5716 make_int (lrecord_stats[lrecord_type_vector]
5717 .bytes_in_use_including_overhead),
5718 pl);
5719 #else /* not MC_ALLOC_TYPE_STATS */
5720 return Qnil;
5721 #endif /* not MC_ALLOC_TYPE_STATS */
5722 }
5723 #else /* not MC_ALLOC */
5091 /* Debugging aids. */ 5724 /* Debugging aids. */
5092 5725
5093 static Lisp_Object 5726 static Lisp_Object
5094 gc_plist_hack (const Ascbyte *name, int value, Lisp_Object tail) 5727 gc_plist_hack (const Ascbyte *name, int value, Lisp_Object tail)
5095 { 5728 {
5228 make_int (gc_count_string_total_size), 5861 make_int (gc_count_string_total_size),
5229 make_int (gc_count_vector_total_size), 5862 make_int (gc_count_vector_total_size),
5230 pl); 5863 pl);
5231 } 5864 }
5232 #undef HACK_O_MATIC 5865 #undef HACK_O_MATIC
5866 #endif /* not MC_ALLOC */
5233 5867
5234 DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /* 5868 DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /*
5235 Return the number of bytes consed since the last garbage collection. 5869 Return the number of bytes consed since the last garbage collection.
5236 \"Consed\" is a misnomer in that this actually counts allocation 5870 \"Consed\" is a misnomer in that this actually counts allocation
5237 of all different kinds of objects, not just conses. 5871 of all different kinds of objects, not just conses.
5421 stats->malloc_overhead += claimed_size - orig_claimed_size; 6055 stats->malloc_overhead += claimed_size - orig_claimed_size;
5422 } 6056 }
5423 return claimed_size; 6057 return claimed_size;
5424 } 6058 }
5425 6059
6060 #ifndef MC_ALLOC
5426 Bytecount 6061 Bytecount
5427 fixed_type_block_overhead (Bytecount size) 6062 fixed_type_block_overhead (Bytecount size)
5428 { 6063 {
5429 Bytecount per_block = TYPE_ALLOC_SIZE (cons, unsigned char); 6064 Bytecount per_block = TYPE_ALLOC_SIZE (cons, unsigned char);
5430 Bytecount overhead = 0; 6065 Bytecount overhead = 0;
5436 } 6071 }
5437 if (rand () % per_block < size) 6072 if (rand () % per_block < size)
5438 overhead += sizeof (void *) + per_block - storage_size; 6073 overhead += sizeof (void *) + per_block - storage_size;
5439 return overhead; 6074 return overhead;
5440 } 6075 }
5441 6076 #endif /* not MC_ALLOC */
5442 #endif /* MEMORY_USAGE_STATS */ 6077 #endif /* MEMORY_USAGE_STATS */
5443 6078
5444 6079
5445 /* Initialization */ 6080 /* Initialization */
5446 static void 6081 static void
5455 so the following is actually a no-op. */ 6090 so the following is actually a no-op. */
5456 Qnull_pointer = wrap_pointer_1 (0); 6091 Qnull_pointer = wrap_pointer_1 (0);
5457 #endif 6092 #endif
5458 6093
5459 gc_generation_number[0] = 0; 6094 gc_generation_number[0] = 0;
6095 #ifndef MC_ALLOC
5460 breathing_space = 0; 6096 breathing_space = 0;
6097 #endif /* not MC_ALLOC */
5461 Vgc_message = Qzero; 6098 Vgc_message = Qzero;
6099 #ifndef MC_ALLOC
5462 all_lcrecords = 0; 6100 all_lcrecords = 0;
6101 #endif /* not MC_ALLOC */
5463 ignore_malloc_warnings = 1; 6102 ignore_malloc_warnings = 1;
5464 #ifdef DOUG_LEA_MALLOC 6103 #ifdef DOUG_LEA_MALLOC
5465 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */ 6104 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
5466 mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */ 6105 mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
5467 #if 0 /* Moved to emacs.c */ 6106 #if 0 /* Moved to emacs.c */
5468 mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */ 6107 mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */
5469 #endif 6108 #endif
5470 #endif 6109 #endif
6110 init_string_chars_alloc ();
6111 #ifndef MC_ALLOC
5471 init_string_alloc (); 6112 init_string_alloc ();
5472 init_string_chars_alloc (); 6113 init_string_chars_alloc ();
5473 init_cons_alloc (); 6114 init_cons_alloc ();
5474 init_symbol_alloc (); 6115 init_symbol_alloc ();
5475 init_compiled_function_alloc (); 6116 init_compiled_function_alloc ();
5495 init_magic_data_alloc (); 6136 init_magic_data_alloc ();
5496 init_magic_eval_data_alloc (); 6137 init_magic_eval_data_alloc ();
5497 init_eval_data_alloc (); 6138 init_eval_data_alloc ();
5498 init_misc_user_data_alloc (); 6139 init_misc_user_data_alloc ();
5499 #endif /* EVENT_DATA_AS_OBJECTS */ 6140 #endif /* EVENT_DATA_AS_OBJECTS */
6141 #endif /* not MC_ALLOC */
5500 6142
5501 ignore_malloc_warnings = 0; 6143 ignore_malloc_warnings = 0;
5502 6144
5503 if (staticpros_nodump) 6145 if (staticpros_nodump)
5504 Dynarr_free (staticpros_nodump); 6146 Dynarr_free (staticpros_nodump);
5509 Dynarr_free (staticpro_nodump_names); 6151 Dynarr_free (staticpro_nodump_names);
5510 staticpro_nodump_names = Dynarr_new2 (char_ptr_dynarr, char *); 6152 staticpro_nodump_names = Dynarr_new2 (char_ptr_dynarr, char *);
5511 Dynarr_resize (staticpro_nodump_names, 100); /* ditto */ 6153 Dynarr_resize (staticpro_nodump_names, 100); /* ditto */
5512 #endif 6154 #endif
5513 6155
6156 #ifdef MC_ALLOC
6157 mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object);
6158 Dynarr_resize (mcpros, 1410); /* merely a small optimization */
6159 dump_add_root_block_ptr (&mcpros, &mcpros_description);
6160 #ifdef DEBUG_XEMACS
6161 mcpro_names = Dynarr_new2 (char_ptr_dynarr, char *);
6162 Dynarr_resize (mcpro_names, 1410); /* merely a small optimization */
6163 dump_add_root_block_ptr (&mcpro_names, &mcpro_names_description);
6164 #endif
6165 #endif /* MC_ALLOC */
6166
5514 consing_since_gc = 0; 6167 consing_since_gc = 0;
5515 need_to_garbage_collect = always_gc; 6168 need_to_garbage_collect = always_gc;
5516 need_to_check_c_alloca = 0; 6169 need_to_check_c_alloca = 0;
5517 funcall_allocation_flag = 0; 6170 funcall_allocation_flag = 0;
5518 funcall_alloca_count = 0; 6171 funcall_alloca_count = 0;
5524 #endif 6177 #endif
5525 gc_cons_percentage = 0; /* #### 20; Don't have an accurate measure of 6178 gc_cons_percentage = 0; /* #### 20; Don't have an accurate measure of
5526 memory usage on Windows; not verified on other 6179 memory usage on Windows; not verified on other
5527 systems */ 6180 systems */
5528 lrecord_uid_counter = 259; 6181 lrecord_uid_counter = 259;
6182 #ifndef MC_ALLOC
5529 debug_string_purity = 0; 6183 debug_string_purity = 0;
6184 #endif /* not MC_ALLOC */
5530 6185
5531 gc_currently_forbidden = 0; 6186 gc_currently_forbidden = 0;
5532 gc_hooks_inhibited = 0; 6187 gc_hooks_inhibited = 0;
5533 6188
5534 #ifdef ERROR_CHECK_TYPES 6189 #ifdef ERROR_CHECK_TYPES
5543 really_unlikely_name_to_have_accidentally_in_a_non_errb_structure = 6198 really_unlikely_name_to_have_accidentally_in_a_non_errb_structure =
5544 8675309; 6199 8675309;
5545 #endif /* ERROR_CHECK_TYPES */ 6200 #endif /* ERROR_CHECK_TYPES */
5546 } 6201 }
5547 6202
6203 #ifndef MC_ALLOC
5548 static void 6204 static void
5549 init_lcrecord_lists (void) 6205 init_lcrecord_lists (void)
5550 { 6206 {
5551 int i; 6207 int i;
5552 6208
5554 { 6210 {
5555 all_lcrecord_lists[i] = Qzero; /* Qnil not yet set */ 6211 all_lcrecord_lists[i] = Qzero; /* Qnil not yet set */
5556 staticpro_nodump (&all_lcrecord_lists[i]); 6212 staticpro_nodump (&all_lcrecord_lists[i]);
5557 } 6213 }
5558 } 6214 }
6215 #endif /* not MC_ALLOC */
5559 6216
5560 void 6217 void
5561 init_alloc_early (void) 6218 init_alloc_early (void)
5562 { 6219 {
5563 #if defined (__cplusplus) && defined (ERROR_CHECK_GC) 6220 #if defined (__cplusplus) && defined (ERROR_CHECK_GC)
5574 6231
5575 void 6232 void
5576 reinit_alloc_early (void) 6233 reinit_alloc_early (void)
5577 { 6234 {
5578 common_init_alloc_early (); 6235 common_init_alloc_early ();
6236 #ifndef MC_ALLOC
5579 init_lcrecord_lists (); 6237 init_lcrecord_lists ();
6238 #endif /* not MC_ALLOC */
5580 } 6239 }
5581 6240
5582 void 6241 void
5583 init_alloc_once_early (void) 6242 init_alloc_once_early (void)
5584 { 6243 {
5591 } 6250 }
5592 6251
5593 INIT_LRECORD_IMPLEMENTATION (cons); 6252 INIT_LRECORD_IMPLEMENTATION (cons);
5594 INIT_LRECORD_IMPLEMENTATION (vector); 6253 INIT_LRECORD_IMPLEMENTATION (vector);
5595 INIT_LRECORD_IMPLEMENTATION (string); 6254 INIT_LRECORD_IMPLEMENTATION (string);
6255 #ifndef MC_ALLOC
5596 INIT_LRECORD_IMPLEMENTATION (lcrecord_list); 6256 INIT_LRECORD_IMPLEMENTATION (lcrecord_list);
5597 INIT_LRECORD_IMPLEMENTATION (free); 6257 INIT_LRECORD_IMPLEMENTATION (free);
6258 #endif /* not MC_ALLOC */
5598 6259
5599 staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *); 6260 staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
5600 Dynarr_resize (staticpros, 1410); /* merely a small optimization */ 6261 Dynarr_resize (staticpros, 1410); /* merely a small optimization */
5601 dump_add_root_block_ptr (&staticpros, &staticpros_description); 6262 dump_add_root_block_ptr (&staticpros, &staticpros_description);
5602 #ifdef DEBUG_XEMACS 6263 #ifdef DEBUG_XEMACS
5603 staticpro_names = Dynarr_new2 (char_ptr_dynarr, char *); 6264 staticpro_names = Dynarr_new2 (char_ptr_dynarr, char *);
5604 Dynarr_resize (staticpro_names, 1410); /* merely a small optimization */ 6265 Dynarr_resize (staticpro_names, 1410); /* merely a small optimization */
5605 dump_add_root_block_ptr (&staticpro_names, &staticpro_names_description); 6266 dump_add_root_block_ptr (&staticpro_names, &staticpro_names_description);
5606 #endif 6267 #endif
5607 6268
6269 #ifdef MC_ALLOC
6270 mcpros = Dynarr_new2 (Lisp_Object_dynarr, Lisp_Object);
6271 Dynarr_resize (mcpros, 1410); /* merely a small optimization */
6272 dump_add_root_block_ptr (&mcpros, &mcpros_description);
6273 #ifdef DEBUG_XEMACS
6274 mcpro_names = Dynarr_new2 (char_ptr_dynarr, char *);
6275 Dynarr_resize (mcpro_names, 1410); /* merely a small optimization */
6276 dump_add_root_block_ptr (&mcpro_names, &mcpro_names_description);
6277 #endif
6278 #endif /* MC_ALLOC */
6279
6280 #ifndef MC_ALLOC
5608 init_lcrecord_lists (); 6281 init_lcrecord_lists ();
6282 #endif /* not MC_ALLOC */
5609 } 6283 }
5610 6284
5611 void 6285 void
5612 syms_of_alloc (void) 6286 syms_of_alloc (void)
5613 { 6287 {