Mercurial > hg > xemacs-beta
annotate src/marker.c @ 2720:6fa9919a9a0b
[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 | 9f70af3ac939 |
| children | facf3239ba30 |
| rev | line source |
|---|---|
| 428 | 1 /* Markers: examining, setting and killing. |
| 2 Copyright (C) 1985, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. | |
| 800 | 3 Copyright (C) 2002 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: FSF 19.30. */ | |
| 23 | |
| 24 /* This file has been Mule-ized. */ | |
| 25 | |
| 26 /* Note that markers are currently kept in an unordered list. | |
| 27 This means that marker operations may be inefficient if | |
| 28 there are a bunch of markers in the buffer. This probably | |
| 29 won't have a significant impact on redisplay (which uses | |
| 30 markers), but if it does, it wouldn't be too hard to change | |
| 31 to an ordered gap array. (Just copy the code from extents.c.) | |
| 32 */ | |
| 33 | |
| 34 #include <config.h> | |
| 35 #include "lisp.h" | |
| 36 | |
| 37 #include "buffer.h" | |
| 38 | |
| 39 static Lisp_Object | |
| 40 mark_marker (Lisp_Object obj) | |
| 41 { | |
| 440 | 42 Lisp_Marker *marker = XMARKER (obj); |
| 428 | 43 Lisp_Object buf; |
| 44 /* DO NOT mark through the marker's chain. | |
| 45 The buffer's markers chain does not preserve markers from gc; | |
| 46 Instead, markers are removed from the chain when they are freed | |
| 47 by gc. | |
| 48 */ | |
| 49 if (!marker->buffer) | |
| 50 return (Qnil); | |
| 51 | |
| 793 | 52 buf = wrap_buffer (marker->buffer); |
| 428 | 53 return (buf); |
| 54 } | |
| 55 | |
| 56 static void | |
| 2286 | 57 print_marker (Lisp_Object obj, Lisp_Object printcharfun, |
| 58 int UNUSED (escapeflag)) | |
| 428 | 59 { |
| 440 | 60 Lisp_Marker *marker = XMARKER (obj); |
| 428 | 61 |
| 62 if (print_readably) | |
| 563 | 63 printing_unreadable_object ("#<marker 0x%lx>", (long) marker); |
| 428 | 64 |
| 826 | 65 write_c_string (printcharfun, GETTEXT ("#<marker ")); |
| 428 | 66 if (!marker->buffer) |
| 826 | 67 write_c_string (printcharfun, GETTEXT ("in no buffer")); |
| 428 | 68 else |
| 69 { | |
| 826 | 70 write_fmt_string (printcharfun, "at %ld in ", |
| 71 (long) marker_position (obj)); | |
| 428 | 72 print_internal (marker->buffer->name, printcharfun, 0); |
| 73 } | |
| 826 | 74 if (marker->insertion_type) |
| 75 write_c_string (printcharfun, " insertion-type=t"); | |
| 800 | 76 write_fmt_string (printcharfun, " 0x%lx>", (long) marker); |
| 428 | 77 } |
| 78 | |
| 79 static int | |
| 2286 | 80 marker_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) |
| 428 | 81 { |
| 440 | 82 Lisp_Marker *marker1 = XMARKER (obj1); |
| 83 Lisp_Marker *marker2 = XMARKER (obj2); | |
| 428 | 84 |
| 85 return ((marker1->buffer == marker2->buffer) && | |
| 665 | 86 (marker1->membpos == marker2->membpos || |
| 428 | 87 /* All markers pointing nowhere are equal */ |
| 88 !marker1->buffer)); | |
| 89 } | |
| 90 | |
| 2515 | 91 static Hashcode |
| 2286 | 92 marker_hash (Lisp_Object obj, int UNUSED (depth)) |
| 428 | 93 { |
| 2515 | 94 Hashcode hash = (Hashcode) XMARKER (obj)->buffer; |
| 428 | 95 if (hash) |
| 665 | 96 hash = HASH2 (hash, XMARKER (obj)->membpos); |
| 428 | 97 return hash; |
| 98 } | |
| 99 | |
| 1204 | 100 static const struct memory_description marker_description[] = { |
| 2551 | 101 { XD_LISP_OBJECT, offsetof (Lisp_Marker, next), 0, { 0 }, XD_FLAG_NO_KKCC }, |
| 102 { XD_LISP_OBJECT, offsetof (Lisp_Marker, prev), 0, { 0 }, XD_FLAG_NO_KKCC }, | |
| 440 | 103 { XD_LISP_OBJECT, offsetof (Lisp_Marker, buffer) }, |
| 428 | 104 { XD_END } |
| 105 }; | |
| 106 | |
| 2720 | 107 #ifdef MC_ALLOC |
| 108 static void | |
| 109 finalize_marker (void *header, int for_disksave) | |
| 110 { | |
| 111 if (!for_disksave) | |
| 112 { | |
| 113 Lisp_Object tem = wrap_marker (header); | |
| 114 unchain_marker (tem); | |
| 115 } | |
| 116 } | |
| 117 | |
| 118 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, | |
| 119 1, /*dumpable-flag*/ | |
| 120 mark_marker, print_marker, | |
| 121 finalize_marker, | |
| 122 marker_equal, marker_hash, | |
| 123 marker_description, Lisp_Marker); | |
| 124 #else /* not MC_ALLOC */ | |
| 934 | 125 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, |
| 126 1, /*dumpable-flag*/ | |
| 127 mark_marker, print_marker, 0, | |
| 1204 | 128 marker_equal, marker_hash, |
| 129 marker_description, Lisp_Marker); | |
| 2720 | 130 #endif /* not MC_ALLOC */ |
| 428 | 131 |
| 132 /* Operations on markers. */ | |
| 133 | |
| 134 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /* | |
| 135 Return the buffer that MARKER points into, or nil if none. | |
| 136 Return nil if MARKER points into a dead buffer or doesn't point anywhere. | |
| 137 */ | |
| 138 (marker)) | |
| 139 { | |
| 140 struct buffer *buf; | |
| 141 CHECK_MARKER (marker); | |
| 142 /* Return marker's buffer only if it is not dead. */ | |
| 143 if ((buf = XMARKER (marker)->buffer) && BUFFER_LIVE_P (buf)) | |
| 144 { | |
| 793 | 145 return wrap_buffer (buf); |
| 428 | 146 } |
| 147 return Qnil; | |
| 148 } | |
| 149 | |
| 150 DEFUN ("marker-position", Fmarker_position, 1, 1, 0, /* | |
| 151 Return the position MARKER points at, as a character number. | |
| 152 Return `nil' if marker doesn't point anywhere. | |
| 153 */ | |
| 154 (marker)) | |
| 155 { | |
| 156 CHECK_MARKER (marker); | |
| 157 return XMARKER (marker)->buffer ? make_int (marker_position (marker)) : Qnil; | |
| 158 } | |
| 159 | |
| 160 #if 0 /* useful debugging function */ | |
| 161 | |
| 162 static void | |
| 163 check_marker_circularities (struct buffer *buf) | |
| 164 { | |
| 440 | 165 Lisp_Marker *tortoise, *hare; |
| 428 | 166 |
| 167 tortoise = BUF_MARKERS (buf); | |
| 168 hare = tortoise; | |
| 169 | |
| 170 if (!tortoise) | |
| 171 return; | |
| 172 | |
| 173 while (1) | |
| 174 { | |
| 175 assert (hare->buffer == buf); | |
| 176 hare = hare->next; | |
| 177 if (!hare) | |
| 178 return; | |
| 179 assert (hare->buffer == buf); | |
| 180 hare = hare->next; | |
| 181 if (!hare) | |
| 182 return; | |
| 183 tortoise = tortoise->next; | |
| 184 assert (tortoise != hare); | |
| 185 } | |
| 186 } | |
| 187 | |
| 188 #endif | |
| 189 | |
| 190 static Lisp_Object | |
| 444 | 191 set_marker_internal (Lisp_Object marker, Lisp_Object position, |
| 192 Lisp_Object buffer, int restricted_p) | |
| 428 | 193 { |
| 665 | 194 Charbpos charno; |
| 428 | 195 struct buffer *b; |
| 440 | 196 Lisp_Marker *m; |
| 428 | 197 int point_p; |
| 198 | |
| 199 CHECK_MARKER (marker); | |
| 200 | |
| 201 point_p = POINT_MARKER_P (marker); | |
| 202 | |
| 203 /* If position is nil or a marker that points nowhere, | |
| 204 make this marker point nowhere. */ | |
| 444 | 205 if (NILP (position) || |
| 206 (MARKERP (position) && !XMARKER (position)->buffer)) | |
| 428 | 207 { |
| 208 if (point_p) | |
| 563 | 209 invalid_operation ("Can't make point-marker point nowhere", |
| 210 marker); | |
| 428 | 211 if (XMARKER (marker)->buffer) |
| 212 unchain_marker (marker); | |
| 213 return marker; | |
| 214 } | |
| 215 | |
| 444 | 216 CHECK_INT_COERCE_MARKER (position); |
| 428 | 217 if (NILP (buffer)) |
| 218 b = current_buffer; | |
| 219 else | |
| 220 { | |
| 221 CHECK_BUFFER (buffer); | |
| 222 b = XBUFFER (buffer); | |
| 223 /* If buffer is dead, set marker to point nowhere. */ | |
| 224 if (!BUFFER_LIVE_P (XBUFFER (buffer))) | |
| 225 { | |
| 226 if (point_p) | |
| 563 | 227 invalid_operation |
| 428 | 228 ("Can't move point-marker in a killed buffer", marker); |
| 229 if (XMARKER (marker)->buffer) | |
| 230 unchain_marker (marker); | |
| 231 return marker; | |
| 232 } | |
| 233 } | |
| 234 | |
| 444 | 235 charno = XINT (position); |
| 428 | 236 m = XMARKER (marker); |
| 237 | |
| 238 if (restricted_p) | |
| 239 { | |
| 240 if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b); | |
| 241 if (charno > BUF_ZV (b)) charno = BUF_ZV (b); | |
| 242 } | |
| 243 else | |
| 244 { | |
| 245 if (charno < BUF_BEG (b)) charno = BUF_BEG (b); | |
| 246 if (charno > BUF_Z (b)) charno = BUF_Z (b); | |
| 247 } | |
| 248 | |
| 249 if (point_p) | |
| 250 { | |
| 251 #ifndef moving_point_by_moving_its_marker_is_a_bug | |
| 252 BUF_SET_PT (b, charno); /* this will move the marker */ | |
| 253 #else /* It's not a feature, so it must be a bug */ | |
| 563 | 254 invalid_operation ("DEBUG: attempt to move point via point-marker", |
| 255 marker); | |
| 428 | 256 #endif |
| 257 } | |
| 258 else | |
| 259 { | |
| 665 | 260 m->membpos = charbpos_to_membpos (b, charno); |
| 428 | 261 } |
| 262 | |
| 263 if (m->buffer != b) | |
| 264 { | |
| 265 if (point_p) | |
| 563 | 266 invalid_operation ("Can't change buffer of point-marker", marker); |
| 428 | 267 if (m->buffer != 0) |
| 268 unchain_marker (marker); | |
| 269 m->buffer = b; | |
| 270 marker_next (m) = BUF_MARKERS (b); | |
| 271 marker_prev (m) = 0; | |
| 272 if (BUF_MARKERS (b)) | |
| 273 marker_prev (BUF_MARKERS (b)) = m; | |
| 274 BUF_MARKERS (b) = m; | |
| 275 } | |
| 276 | |
| 277 return marker; | |
| 278 } | |
| 279 | |
| 280 | |
| 281 DEFUN ("set-marker", Fset_marker, 2, 3, 0, /* | |
| 444 | 282 Move MARKER to position POSITION in BUFFER. |
| 283 POSITION can be a marker, an integer or nil. If POSITION is an | |
| 284 integer, make MARKER point before the POSITIONth character in BUFFER. | |
| 285 If POSITION is nil, makes MARKER point nowhere. Then it no longer | |
| 286 slows down editing in any buffer. If POSITION is less than 1, move | |
| 287 MARKER to the beginning of BUFFER. If POSITION is greater than the | |
| 288 size of BUFFER, move MARKER to the end of BUFFER. | |
| 428 | 289 BUFFER defaults to the current buffer. |
| 444 | 290 If this marker was returned by (point-marker t), then changing its |
| 291 position moves point. You cannot change its buffer or make it point | |
| 292 nowhere. | |
| 293 The return value is MARKER. | |
| 428 | 294 */ |
| 444 | 295 (marker, position, buffer)) |
| 428 | 296 { |
| 444 | 297 return set_marker_internal (marker, position, buffer, 0); |
| 428 | 298 } |
| 299 | |
| 300 | |
| 301 /* This version of Fset_marker won't let the position | |
| 302 be outside the visible part. */ | |
| 303 Lisp_Object | |
| 444 | 304 set_marker_restricted (Lisp_Object marker, Lisp_Object position, |
| 305 Lisp_Object buffer) | |
| 428 | 306 { |
| 444 | 307 return set_marker_internal (marker, position, buffer, 1); |
| 428 | 308 } |
| 309 | |
| 310 | |
| 311 /* This is called during garbage collection, | |
| 312 so we must be careful to ignore and preserve mark bits, | |
| 313 including those in chain fields of markers. */ | |
| 314 | |
| 315 void | |
| 316 unchain_marker (Lisp_Object m) | |
| 317 { | |
| 440 | 318 Lisp_Marker *marker = XMARKER (m); |
| 428 | 319 struct buffer *b = marker->buffer; |
| 320 | |
| 321 if (b == 0) | |
| 322 return; | |
| 323 | |
| 800 | 324 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 325 assert (BUFFER_LIVE_P (b)); |
| 326 #endif | |
| 327 | |
| 328 if (marker_next (marker)) | |
| 329 marker_prev (marker_next (marker)) = marker_prev (marker); | |
| 330 if (marker_prev (marker)) | |
| 331 marker_next (marker_prev (marker)) = marker_next (marker); | |
| 332 else | |
| 333 BUF_MARKERS (b) = marker_next (marker); | |
| 334 | |
| 800 | 335 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 336 assert (marker != XMARKER (b->point_marker)); |
| 337 #endif | |
| 338 | |
| 339 marker->buffer = 0; | |
| 340 } | |
| 341 | |
| 665 | 342 Bytebpos |
| 826 | 343 byte_marker_position (Lisp_Object marker) |
| 428 | 344 { |
| 440 | 345 Lisp_Marker *m = XMARKER (marker); |
| 428 | 346 struct buffer *buf = m->buffer; |
| 665 | 347 Bytebpos pos; |
| 428 | 348 |
| 349 if (!buf) | |
| 563 | 350 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 351 |
| 352 /* FSF claims that marker indices could end up denormalized, i.e. | |
| 353 in the gap. This is way bogus if it ever happens, and means | |
| 354 something fucked up elsewhere. Since I've overhauled all this | |
| 355 shit, I don't think this can happen. In any case, the following | |
| 356 macro has an assert() in it that will catch these denormalized | |
| 357 positions. */ | |
| 665 | 358 pos = membpos_to_bytebpos (buf, m->membpos); |
| 428 | 359 |
| 360 return pos; | |
| 361 } | |
| 362 | |
| 665 | 363 Charbpos |
| 428 | 364 marker_position (Lisp_Object marker) |
| 365 { | |
| 366 struct buffer *buf = XMARKER (marker)->buffer; | |
| 367 | |
| 368 if (!buf) | |
| 563 | 369 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 370 |
| 826 | 371 return bytebpos_to_charbpos (buf, byte_marker_position (marker)); |
| 428 | 372 } |
| 373 | |
| 374 void | |
| 826 | 375 set_byte_marker_position (Lisp_Object marker, Bytebpos pos) |
| 428 | 376 { |
| 440 | 377 Lisp_Marker *m = XMARKER (marker); |
| 428 | 378 struct buffer *buf = m->buffer; |
| 379 | |
| 380 if (!buf) | |
| 563 | 381 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 382 |
| 665 | 383 m->membpos = bytebpos_to_membpos (buf, pos); |
| 428 | 384 } |
| 385 | |
| 386 void | |
| 665 | 387 set_marker_position (Lisp_Object marker, Charbpos pos) |
| 428 | 388 { |
| 389 struct buffer *buf = XMARKER (marker)->buffer; | |
| 390 | |
| 391 if (!buf) | |
| 563 | 392 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 393 |
| 826 | 394 set_byte_marker_position (marker, charbpos_to_bytebpos (buf, pos)); |
| 428 | 395 } |
| 396 | |
| 397 static Lisp_Object | |
| 398 copy_marker_1 (Lisp_Object marker, Lisp_Object type, int noseeum) | |
| 399 { | |
| 400 REGISTER Lisp_Object new; | |
| 401 | |
| 402 while (1) | |
| 403 { | |
| 404 if (INTP (marker) || MARKERP (marker)) | |
| 405 { | |
| 406 if (noseeum) | |
| 407 new = noseeum_make_marker (); | |
| 408 else | |
| 409 new = Fmake_marker (); | |
| 410 Fset_marker (new, marker, | |
| 411 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil)); | |
| 412 XMARKER (new)->insertion_type = !NILP (type); | |
| 413 return new; | |
| 414 } | |
| 415 else | |
| 416 marker = wrong_type_argument (Qinteger_or_marker_p, marker); | |
| 417 } | |
| 418 | |
| 1204 | 419 RETURN_NOT_REACHED (Qnil); /* not reached */ |
| 428 | 420 } |
| 421 | |
| 422 DEFUN ("copy-marker", Fcopy_marker, 1, 2, 0, /* | |
| 444 | 423 Return a new marker pointing at the same place as MARKER-OR-INTEGER. |
| 424 If MARKER-OR-INTEGER is an integer, return a new marker pointing | |
| 428 | 425 at that position in the current buffer. |
| 444 | 426 Optional argument MARKER-TYPE specifies the insertion type of the new |
| 427 marker; see `marker-insertion-type'. | |
| 428 | 428 */ |
| 444 | 429 (marker_or_integer, marker_type)) |
| 428 | 430 { |
| 444 | 431 return copy_marker_1 (marker_or_integer, marker_type, 0); |
| 428 | 432 } |
| 433 | |
| 434 Lisp_Object | |
| 444 | 435 noseeum_copy_marker (Lisp_Object marker, Lisp_Object marker_type) |
| 428 | 436 { |
| 444 | 437 return copy_marker_1 (marker, marker_type, 1); |
| 428 | 438 } |
| 439 | |
| 440 DEFUN ("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /* | |
| 441 Return insertion type of MARKER: t if it stays after inserted text. | |
| 442 nil means the marker stays before text inserted there. | |
| 443 */ | |
| 444 (marker)) | |
| 445 { | |
| 446 CHECK_MARKER (marker); | |
| 447 return XMARKER (marker)->insertion_type ? Qt : Qnil; | |
| 448 } | |
| 449 | |
| 450 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /* | |
| 451 Set the insertion-type of MARKER to TYPE. | |
| 452 If TYPE is t, it means the marker advances when you insert text at it. | |
| 453 If TYPE is nil, it means the marker stays behind when you insert text at it. | |
| 454 */ | |
| 455 (marker, type)) | |
| 456 { | |
| 457 CHECK_MARKER (marker); | |
| 458 | |
| 459 XMARKER (marker)->insertion_type = ! NILP (type); | |
| 460 return type; | |
| 461 } | |
| 462 | |
| 463 /* #### What is the possible use of this? It looks quite useless to | |
| 464 me, because there is no way to find *which* markers are positioned | |
| 465 at POSITION. Additional bogosity bonus: (buffer-has-markers-at | |
| 466 (point)) will always return t because of the `point-marker'. The | |
| 467 same goes for the position of mark. Bletch! | |
| 468 | |
| 469 Someone should discuss this with Stallman, but I don't have the | |
| 470 stomach. In fact, this function sucks so badly that I'm disabling | |
| 471 it by default (although I've debugged it). If you want to use it, | |
| 472 use extents instead. --hniksic */ | |
| 473 #if 0 | |
| 826 | 474 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /* |
| 428 | 475 Return t if there are markers pointing at POSITION in the current buffer. |
| 476 */ | |
| 477 (position)) | |
| 478 { | |
| 440 | 479 Lisp_Marker *marker; |
| 665 | 480 Membpos pos; |
| 428 | 481 |
| 665 | 482 /* A small optimization trick: convert POS to membpos now, rather |
| 483 than converting every marker's memory index to charbpos. */ | |
| 484 pos = bytebpos_to_membpos (current_buffer, | |
| 428 | 485 get_buffer_pos_byte (current_buffer, position, |
| 486 GB_COERCE_RANGE)); | |
| 487 | |
| 488 for (marker = BUF_MARKERS (current_buffer); | |
| 489 marker; | |
| 490 marker = marker_next (marker)) | |
| 491 { | |
| 665 | 492 /* We use marker->membpos, so we don't have to go through the |
| 428 | 493 unwieldy operation of creating a Lisp_Object for |
| 494 marker_position() every time around. */ | |
| 665 | 495 if (marker->membpos == pos) |
| 428 | 496 return Qt; |
| 497 } | |
| 498 | |
| 499 return Qnil; | |
| 500 } | |
| 501 #endif /* 0 */ | |
| 502 | |
| 503 #ifdef MEMORY_USAGE_STATS | |
| 504 | |
| 505 int | |
| 506 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats) | |
| 507 { | |
| 440 | 508 Lisp_Marker *m; |
| 428 | 509 int total = 0; |
| 510 int overhead; | |
| 511 | |
| 512 for (m = BUF_MARKERS (b); m; m = m->next) | |
| 440 | 513 total += sizeof (Lisp_Marker); |
| 428 | 514 ovstats->was_requested += total; |
| 2720 | 515 #ifdef MC_ALLOC |
| 516 overhead = mc_alloced_storage_size (total, 0); | |
| 517 #else /* not MC_ALLOC */ | |
| 428 | 518 overhead = fixed_type_block_overhead (total); |
| 2720 | 519 #endif /* not MC_ALLOC */ |
| 428 | 520 /* #### claiming this is all malloc overhead is not really right, |
| 521 but it has to go somewhere. */ | |
| 522 ovstats->malloc_overhead += overhead; | |
| 523 return total + overhead; | |
| 524 } | |
| 525 | |
| 526 #endif /* MEMORY_USAGE_STATS */ | |
| 527 | |
| 528 | |
| 529 void | |
| 530 syms_of_marker (void) | |
| 531 { | |
| 442 | 532 INIT_LRECORD_IMPLEMENTATION (marker); |
| 533 | |
| 428 | 534 DEFSUBR (Fmarker_position); |
| 535 DEFSUBR (Fmarker_buffer); | |
| 536 DEFSUBR (Fset_marker); | |
| 537 DEFSUBR (Fcopy_marker); | |
| 538 DEFSUBR (Fmarker_insertion_type); | |
| 539 DEFSUBR (Fset_marker_insertion_type); | |
| 540 #if 0 /* FSFmacs crock */ | |
| 541 DEFSUBR (Fbuffer_has_markers_at); | |
| 542 #endif | |
| 543 } | |
| 544 | |
| 545 void | |
| 546 init_buffer_markers (struct buffer *b) | |
| 547 { | |
| 793 | 548 Lisp_Object buf = wrap_buffer (b); |
| 428 | 549 |
| 550 b->mark = Fmake_marker (); | |
| 551 BUF_MARKERS (b) = 0; | |
| 552 b->point_marker = Fmake_marker (); | |
| 553 Fset_marker (b->point_marker, | |
| 554 /* For indirect buffers, point is already set. */ | |
| 555 b->base_buffer ? make_int (BUF_PT (b)) : make_int (1), | |
| 556 buf); | |
| 557 } | |
| 558 | |
| 559 void | |
| 560 uninit_buffer_markers (struct buffer *b) | |
| 561 { | |
| 562 /* Unchain all markers of this buffer | |
| 563 and leave them pointing nowhere. */ | |
| 440 | 564 REGISTER Lisp_Marker *m, *next; |
| 428 | 565 for (m = BUF_MARKERS (b); m; m = next) |
| 566 { | |
| 567 m->buffer = 0; | |
| 568 next = marker_next (m); | |
| 569 marker_next (m) = 0; | |
| 570 marker_prev (m) = 0; | |
| 571 } | |
| 572 BUF_MARKERS (b) = 0; | |
| 573 } |