Mercurial > hg > xemacs-beta
annotate src/free-hook.c @ 5127:a9c41067dd88 ben-lisp-object
more cleanups, terminology clarification, lots of doc work
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Introduction to Allocation):
* internals/internals.texi (Integers and Characters):
* internals/internals.texi (Allocation from Frob Blocks):
* internals/internals.texi (lrecords):
* internals/internals.texi (Low-level allocation):
Rewrite section on allocation of Lisp objects to reflect the new
reality. Remove references to nonexistent XSETINT and XSETCHAR.
modules/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (allocate_pgconn):
* postgresql/postgresql.c (allocate_pgresult):
* postgresql/postgresql.h (struct Lisp_PGconn):
* postgresql/postgresql.h (struct Lisp_PGresult):
* ldap/eldap.c (allocate_ldap):
* ldap/eldap.h (struct Lisp_LDAP):
Same changes as in src/ dir. See large log there in ChangeLog,
but basically:
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
../hlo/src/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (old_alloc_sized_lcrecord):
* alloc.c (very_old_free_lcrecord):
* alloc.c (copy_lisp_object):
* alloc.c (zero_sized_lisp_object):
* alloc.c (zero_nonsized_lisp_object):
* alloc.c (lisp_object_storage_size):
* alloc.c (free_normal_lisp_object):
* alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (Fcons):
* alloc.c (noseeum_cons):
* alloc.c (make_float):
* alloc.c (make_bignum):
* alloc.c (make_bignum_bg):
* alloc.c (make_ratio):
* alloc.c (make_ratio_bg):
* alloc.c (make_ratio_rt):
* alloc.c (make_bigfloat):
* alloc.c (make_bigfloat_bf):
* alloc.c (size_vector):
* alloc.c (make_compiled_function):
* alloc.c (Fmake_symbol):
* alloc.c (allocate_extent):
* alloc.c (allocate_event):
* alloc.c (make_key_data):
* alloc.c (make_button_data):
* alloc.c (make_motion_data):
* alloc.c (make_process_data):
* alloc.c (make_timeout_data):
* alloc.c (make_magic_data):
* alloc.c (make_magic_eval_data):
* alloc.c (make_eval_data):
* alloc.c (make_misc_user_data):
* alloc.c (Fmake_marker):
* alloc.c (noseeum_make_marker):
* alloc.c (size_string_direct_data):
* alloc.c (make_uninit_string):
* alloc.c (make_string_nocopy):
* alloc.c (mark_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* alloc.c (malloced_storage_size):
* buffer.c (allocate_buffer):
* buffer.c (compute_buffer_usage):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* buffer.c (nuke_all_buffer_slots):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.h (struct buffer_text):
* buffer.h (struct buffer):
* bytecode.c:
* bytecode.c (make_compiled_function_args):
* bytecode.c (size_compiled_function_args):
* bytecode.h (struct compiled_function_args):
* casetab.c (allocate_case_table):
* casetab.h (struct Lisp_Case_Table):
* charset.h (struct Lisp_Charset):
* chartab.c (fill_char_table):
* chartab.c (Fmake_char_table):
* chartab.c (make_char_table_entry):
* chartab.c (copy_char_table_entry):
* chartab.c (Fcopy_char_table):
* chartab.c (put_char_table):
* chartab.h (struct Lisp_Char_Table_Entry):
* chartab.h (struct Lisp_Char_Table):
* console-gtk-impl.h (struct gtk_device):
* console-gtk-impl.h (struct gtk_frame):
* console-impl.h (struct console):
* console-msw-impl.h (struct Lisp_Devmode):
* console-msw-impl.h (struct mswindows_device):
* console-msw-impl.h (struct msprinter_device):
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (struct mswindows_dialog_id):
* console-stream-impl.h (struct stream_console):
* console-stream.c (stream_init_console):
* console-tty-impl.h (struct tty_console):
* console-tty-impl.h (struct tty_device):
* console-tty.c (allocate_tty_console_struct):
* console-x-impl.h (struct x_device):
* console-x-impl.h (struct x_frame):
* console.c (allocate_console):
* console.c (nuke_all_console_slots):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* console.c (common_init_complex_vars_of_console):
* data.c (make_weak_list):
* data.c (make_weak_box):
* data.c (make_ephemeron):
* database.c:
* database.c (struct Lisp_Database):
* database.c (allocate_database):
* database.c (finalize_database):
* device-gtk.c (allocate_gtk_device_struct):
* device-impl.h (struct device):
* device-msw.c:
* device-msw.c (mswindows_init_device):
* device-msw.c (msprinter_init_device):
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device-tty.c (allocate_tty_device_struct):
* device-x.c (allocate_x_device_struct):
* device.c:
* device.c (nuke_all_device_slots):
* device.c (allocate_device):
* dialog-msw.c (handle_question_dialog_box):
* elhash.c:
* elhash.c (struct Lisp_Hash_Table):
* elhash.c (finalize_hash_table):
* elhash.c (make_general_lisp_hash_table):
* elhash.c (Fcopy_hash_table):
* elhash.h (htentry):
* emacs.c (main_1):
* eval.c:
* eval.c (size_multiple_value):
* event-stream.c (finalize_command_builder):
* event-stream.c (allocate_command_builder):
* event-stream.c (free_command_builder):
* event-stream.c (event_stream_generate_wakeup):
* event-stream.c (event_stream_resignal_wakeup):
* event-stream.c (event_stream_disable_wakeup):
* event-stream.c (event_stream_wakeup_pending_p):
* events.h (struct Lisp_Timeout):
* events.h (struct command_builder):
* extents-impl.h:
* extents-impl.h (struct extent_auxiliary):
* extents-impl.h (struct extent_info):
* extents-impl.h (set_extent_no_chase_aux_field):
* extents-impl.h (set_extent_no_chase_normal_field):
* extents.c:
* extents.c (gap_array_marker):
* extents.c (gap_array):
* extents.c (extent_list_marker):
* extents.c (extent_list):
* extents.c (stack_of_extents):
* extents.c (gap_array_make_marker):
* extents.c (extent_list_make_marker):
* extents.c (allocate_extent_list):
* extents.c (SLOT):
* extents.c (mark_extent_auxiliary):
* extents.c (allocate_extent_auxiliary):
* extents.c (attach_extent_auxiliary):
* extents.c (size_gap_array):
* extents.c (finalize_extent_info):
* extents.c (allocate_extent_info):
* extents.c (uninit_buffer_extents):
* extents.c (allocate_soe):
* extents.c (copy_extent):
* extents.c (vars_of_extents):
* extents.h:
* faces.c (allocate_face):
* faces.h (struct Lisp_Face):
* faces.h (struct face_cachel):
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.c (sizeof_coding_system):
* file-coding.c (Fcopy_coding_system):
* file-coding.h (struct Lisp_Coding_System):
* file-coding.h (MARKED_SLOT):
* fns.c (size_bit_vector):
* font-mgr.c:
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (print_fc_pattern):
* font-mgr.c (Ffc_pattern_p):
* font-mgr.c (Ffc_pattern_create):
* font-mgr.c (Ffc_name_parse):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* font-mgr.c (Ffc_pattern_add):
* font-mgr.c (Ffc_pattern_del):
* font-mgr.c (Ffc_pattern_get):
* font-mgr.c (fc_config_create_using):
* font-mgr.c (fc_strlist_to_lisp_using):
* font-mgr.c (fontset_to_list):
* font-mgr.c (Ffc_config_p):
* font-mgr.c (Ffc_config_up_to_date):
* font-mgr.c (Ffc_config_build_fonts):
* font-mgr.c (Ffc_config_get_cache):
* font-mgr.c (Ffc_config_get_fonts):
* font-mgr.c (Ffc_config_set_current):
* font-mgr.c (Ffc_config_get_blanks):
* font-mgr.c (Ffc_config_get_rescan_interval):
* font-mgr.c (Ffc_config_set_rescan_interval):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_app_font_clear):
* font-mgr.c (size):
* font-mgr.c (Ffc_config_substitute):
* font-mgr.c (Ffc_font_render_prepare):
* font-mgr.c (Ffc_font_match):
* font-mgr.c (Ffc_font_sort):
* font-mgr.c (finalize_fc_config):
* font-mgr.c (print_fc_config):
* font-mgr.h:
* font-mgr.h (struct fc_pattern):
* font-mgr.h (XFC_PATTERN):
* font-mgr.h (struct fc_config):
* font-mgr.h (XFC_CONFIG):
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-impl.h (struct frame):
* frame-msw.c (mswindows_init_frame_1):
* frame-x.c (allocate_x_frame_struct):
* frame.c (nuke_all_frame_slots):
* frame.c (allocate_frame_core):
* gc.c:
* gc.c (GC_CHECK_NOT_FREE):
* glyphs.c (finalize_image_instance):
* glyphs.c (allocate_image_instance):
* glyphs.c (Fcolorize_image_instance):
* glyphs.c (allocate_glyph):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* glyphs.c (register_ignored_expose):
* glyphs.h (struct Lisp_Image_Instance):
* glyphs.h (struct Lisp_Glyph):
* glyphs.h (struct glyph_cachel):
* glyphs.h (struct expose_ignore):
* gui.c (allocate_gui_item):
* gui.h (struct Lisp_Gui_Item):
* keymap.c (struct Lisp_Keymap):
* keymap.c (make_keymap):
* lisp.h:
* lisp.h (struct Lisp_String_Direct_Data):
* lisp.h (struct Lisp_String_Indirect_Data):
* lisp.h (struct Lisp_Vector):
* lisp.h (struct Lisp_Bit_Vector):
* lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR):
* lisp.h (struct weak_box):
* lisp.h (struct ephemeron):
* lisp.h (struct weak_list):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (struct lcrecord_list):
* lstream.c (finalize_lstream):
* lstream.c (sizeof_lstream):
* lstream.c (Lstream_new):
* lstream.c (Lstream_delete):
* lstream.h (struct lstream):
* marker.c:
* marker.c (finalize_marker):
* marker.c (compute_buffer_marker_usage):
* mule-charset.c:
* mule-charset.c (make_charset):
* mule-charset.c (compute_charset_usage):
* objects-impl.h (struct Lisp_Color_Instance):
* objects-impl.h (struct Lisp_Font_Instance):
* objects-tty-impl.h (struct tty_color_instance_data):
* objects-tty-impl.h (struct tty_font_instance_data):
* objects-tty.c (tty_initialize_color_instance):
* objects-tty.c (tty_initialize_font_instance):
* objects.c (finalize_color_instance):
* objects.c (Fmake_color_instance):
* objects.c (finalize_font_instance):
* objects.c (Fmake_font_instance):
* objects.c (reinit_vars_of_objects):
* opaque.c:
* opaque.c (sizeof_opaque):
* opaque.c (make_opaque_ptr):
* opaque.c (free_opaque_ptr):
* opaque.h:
* opaque.h (Lisp_Opaque):
* opaque.h (Lisp_Opaque_Ptr):
* print.c (printing_unreadable_lcrecord):
* print.c (external_object_printer):
* print.c (debug_p4):
* process.c (finalize_process):
* process.c (make_process_internal):
* procimpl.h (struct Lisp_Process):
* rangetab.c (Fmake_range_table):
* rangetab.c (Fcopy_range_table):
* rangetab.h (struct Lisp_Range_Table):
* scrollbar.c:
* scrollbar.c (create_scrollbar_instance):
* scrollbar.c (compute_scrollbar_instance_usage):
* scrollbar.h (struct scrollbar_instance):
* specifier.c (finalize_specifier):
* specifier.c (sizeof_specifier):
* specifier.c (set_specifier_caching):
* specifier.h (struct Lisp_Specifier):
* specifier.h (struct specifier_caching):
* symeval.h:
* symeval.h (SYMBOL_VALUE_MAGIC_P):
* symeval.h (DEFVAR_SYMVAL_FWD):
* symsinit.h:
* syntax.c (init_buffer_syntax_cache):
* syntax.h (struct syntax_cache):
* toolbar.c:
* toolbar.c (allocate_toolbar_button):
* toolbar.c (update_toolbar_button):
* toolbar.h (struct toolbar_button):
* tooltalk.c (struct Lisp_Tooltalk_Message):
* tooltalk.c (make_tooltalk_message):
* tooltalk.c (struct Lisp_Tooltalk_Pattern):
* tooltalk.c (make_tooltalk_pattern):
* ui-gtk.c:
* ui-gtk.c (allocate_ffi_data):
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_object_data):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* ui-gtk.h:
* window-impl.h (struct window):
* window-impl.h (struct window_mirror):
* window.c (finalize_window):
* window.c (allocate_window):
* window.c (new_window_mirror):
* window.c (mark_window_as_deleted):
* window.c (make_dummy_parent):
* window.c (compute_window_mirror_usage):
* window.c (compute_window_usage):
Overall point of this change and previous ones in this repository:
(1) Introduce new, clearer terminology: everything other than int
or char is a "record" object, which comes in two types: "normal
objects" and "frob-block objects". Fix up all places that
referred to frob-block objects as "simple", "basic", etc.
(2) Provide an advertised interface for doing operations on Lisp
objects, including creating new types, that is clean and
consistent in its naming, uses the above-referenced terms and
avoids referencing "lrecords", "old lcrecords", etc., which should
hide under the surface.
(3) Make the size_in_bytes and finalizer methods take a
Lisp_Object rather than a void * for consistency with other methods.
(4) Separate finalizer method into finalizer and disksaver, so
that normal finalize methods don't have to worry about disksaving.
Other specifics:
(1) Renaming:
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
implementation->basic_p -> implementation->frob_block_p
ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT
*FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config
*FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern
(the last two changes make the naming of these macros consistent
with the naming of all other macros, since the objects are named
fc-config and fc-pattern with a hyphen)
(2) Lots of documentation fixes in lrecord.h.
(3) Eliminate macros for copying, freeing, zeroing objects, getting
their storage size. Instead, new functions:
zero_sized_lisp_object()
zero_nonsized_lisp_object()
lisp_object_storage_size()
free_normal_lisp_object()
(copy_lisp_object() already exists)
LISP_OBJECT_FROB_BLOCK_P() (actually a macro)
Eliminated:
free_lrecord()
zero_lrecord()
copy_lrecord()
copy_sized_lrecord()
old_copy_lcrecord()
old_copy_sized_lcrecord()
old_zero_lcrecord()
old_zero_sized_lcrecord()
LISP_OBJECT_STORAGE_SIZE()
COPY_SIZED_LISP_OBJECT()
COPY_SIZED_LCRECORD()
COPY_LISP_OBJECT()
ZERO_LISP_OBJECT()
FREE_LISP_OBJECT()
(4) Catch the remaining places where lrecord stuff was used directly
and use the advertised interface, e.g. alloc_sized_lrecord() ->
ALLOC_SIZED_LISP_OBJECT().
(5) Make certain statically-declared pseudo-objects
(buffer_local_flags, console_local_flags) have their lheader
initialized correctly, so things like copy_lisp_object() can work
on them. Make extent_auxiliary_defaults a proper heap object
Vextent_auxiliary_defaults, and make extent auxiliaries dumpable
so that this object can be dumped. allocate_extent_auxiliary()
now just creates the object, and attach_extent_auxiliary()
creates an extent auxiliary and attaches to an extent, like the
old allocate_extent_auxiliary().
(6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h
files but in a macro instead of a file. The purpose is to avoid
duplication when iterating over all the slots in an extent auxiliary.
Use it.
(7) In lstream.c, don't zero out object after allocation because
allocation routines take care of this.
(8) In marker.c, fix a mistake in computing marker overhead.
(9) In print.c, clean up printing_unreadable_lcrecord(),
external_object_printer() to avoid lots of ifdef NEW_GC's.
(10) Separate toolbar-button allocation into a separate
allocate_toolbar_button() function for use in the example code
in lrecord.h.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Mar 2010 04:08:17 -0600 |
| parents | 6f2158fa75ed |
| children | 88bd4f3ef8e4 |
| rev | line source |
|---|---|
| 428 | 1 /* This file is part of XEmacs. |
| 2 | |
| 3 XEmacs is free software; you can redistribute it and/or modify it | |
| 4 under the terms of the GNU General Public License as published by the | |
| 5 Free Software Foundation; either version 2, or (at your option) any | |
| 6 later version. | |
| 7 | |
| 8 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 9 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 10 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 11 for more details. | |
| 12 | |
| 13 You should have received a copy of the GNU General Public License | |
| 14 along with XEmacs; see the file COPYING. If not, write to | |
| 15 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 16 Boston, MA 02111-1307, USA. */ | |
| 17 | |
| 18 /* Synched up with: Not in FSF. */ | |
| 19 | |
| 20 /* Debugging hooks for malloc. */ | |
| 21 | |
| 22 /* These hooks work with gmalloc to catch allocation errors. | |
| 23 In particular, the following is trapped: | |
| 24 | |
| 25 * Freeing the same pointer twice. | |
| 26 * Trying to free a pointer not returned by malloc. | |
| 27 * Trying to realloc a pointer not returned by malloc. | |
| 28 | |
| 1204 | 29 In addition, every word of every block freed is set to 0xdeadbeef |
| 30 (-559038737). This causes many uses of freed storage to be trapped or | |
| 31 recognized. | |
| 428 | 32 |
| 33 When you use this, the storage used by the last FREE_QUEUE_LIMIT | |
| 34 calls to free() is not recycled. When you call free for the Nth | |
| 35 time, the (N - FREE_QUEUE_LIMIT)'th block is actually recycled. | |
| 36 | |
| 37 For these last FREE_QUEUE_LIMIT calls to free() a backtrace is | |
| 38 saved showing where it was called from. The function | |
| 39 find_backtrace() is provided here to be called from GDB with a | |
| 40 pointer (such as would be passed to free()) as argument, e.g. | |
| 41 (gdb) p/a *find_backtrace (0x234000). If SAVE_ARGS is defined, | |
| 42 the first three arguments to each function are saved as well as the | |
| 43 return addresses. | |
| 44 | |
| 45 If UNMAPPED_FREE is defined, instead of setting every word of freed | |
| 46 storage to 0xdeadbeef, every call to malloc goes on its own page(s). | |
| 47 When free() is called, the block is read and write protected. This | |
| 48 is very useful when debugging, since it usually generates a bus error | |
| 49 when the deadbeef hack might only cause some garbage to be printed. | |
| 50 However, this is too slow for everyday use, since it takes an enormous | |
| 51 number of pages. | |
| 52 | |
| 53 | |
| 54 Some other features that would be useful are: | |
| 55 | |
| 56 * Checking for storage leaks. | |
| 57 This could be done by a GC-like facility that would scan the data | |
| 58 segment looking for pointers to allocated storage and tell you | |
| 59 about those that are no longer referenced. This could be invoked | |
| 60 at any time. Another possibility is to report on what allocated | |
| 61 storage is still in use when the process is exited. Typically | |
| 62 there will be a large amount, so this might not be very useful. | |
| 63 */ | |
| 64 | |
| 65 #ifdef emacs | |
| 66 #include <config.h> | |
| 67 #include "lisp.h" | |
| 68 #else | |
| 69 void *malloc (size_t); | |
| 70 #endif | |
| 71 | |
| 72 #if !defined(HAVE_LIBMCHECK) | |
| 73 #include <stdio.h> | |
| 74 | |
| 75 #include "hash.h" | |
| 76 | |
| 77 #ifdef UNMAPPED_FREE | |
| 78 #include <sys/mman.h> | |
| 79 #include <sys/param.h> | |
| 80 #define ROUND_UP_TO_PAGE(i) (((i) + PAGEOFFSET) & PAGEMASK) | |
| 81 #endif | |
| 82 | |
| 83 #include <sys/types.h> | |
| 84 | |
| 85 /* System function prototypes don't belong in C source files */ | |
| 86 /* extern void free (void *); */ | |
| 87 | |
| 88 static struct hash_table *pointer_table; | |
| 89 | |
| 90 extern void (*__free_hook) (void *); | |
| 91 extern void *(*__malloc_hook) (size_t); | |
| 92 | |
| 93 static void *check_malloc (size_t); | |
| 94 | |
| 95 typedef void (*fun_ptr) (void); | |
| 96 | |
| 97 /* free_queue is not too useful without backtrace logging */ | |
| 98 #define FREE_QUEUE_LIMIT 1 | |
| 99 #define TRACE_LIMIT 20 | |
| 100 | |
| 101 typedef struct { | |
| 102 fun_ptr return_pc; | |
| 103 #ifdef SAVE_ARGS | |
| 104 void *arg[3]; | |
| 105 #endif | |
| 106 } fun_entry; | |
| 107 | |
| 108 typedef struct { | |
| 109 void *address; | |
| 110 unsigned long length; | |
| 111 } free_queue_entry; | |
| 112 | |
| 113 static free_queue_entry free_queue[FREE_QUEUE_LIMIT]; | |
| 114 | |
| 115 static int current_free; | |
| 116 | |
| 117 static int strict_free_check; | |
| 118 | |
| 119 static void | |
| 120 check_free (void *ptr) | |
| 121 { | |
| 122 __free_hook = 0; | |
| 123 __malloc_hook = 0; | |
| 124 if (!pointer_table) | |
| 125 pointer_table = make_hash_table (max (100, FREE_QUEUE_LIMIT * 2)); | |
| 126 if (ptr != 0) | |
| 127 { | |
| 128 long size; | |
| 129 #ifdef UNMAPPED_FREE | |
| 130 unsigned long rounded_up_size; | |
| 131 #endif | |
| 132 | |
| 133 EMACS_INT present = (EMACS_INT) gethash (ptr, pointer_table, | |
| 2519 | 134 (const void **) |
| 135 (void *) &size); | |
| 428 | 136 |
| 137 if (!present) | |
| 138 { | |
| 139 /* This can only happen if you try to free something that didn't | |
| 140 come from malloc */ | |
| 141 #if !defined(__linux__) | |
| 142 /* I originally wrote: "There's really no need to drop core." | |
| 143 I have seen the error of my ways. -slb */ | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
144 assert (!strict_free_check); |
| 428 | 145 #endif |
| 146 printf("Freeing unmalloc'ed memory at %p\n", ptr); | |
| 147 __free_hook = check_free; | |
| 148 __malloc_hook = check_malloc; | |
| 149 goto end; | |
| 150 } | |
| 151 | |
| 152 if (size < 0) | |
| 153 { | |
| 154 /* This happens when you free twice */ | |
| 155 #if !defined(__linux__) | |
| 156 /* See above comment. */ | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
157 assert (!strict_free_check); |
| 428 | 158 #endif |
| 159 printf("Freeing %p twice\n", ptr); | |
| 160 __free_hook = check_free; | |
| 161 __malloc_hook = check_malloc; | |
| 162 goto end; | |
| 163 } | |
| 164 | |
| 165 puthash (ptr, (void *)-size, pointer_table); | |
| 166 #ifdef UNMAPPED_FREE | |
| 167 /* Round up size to an even number of pages. */ | |
| 168 rounded_up_size = ROUND_UP_TO_PAGE (size); | |
| 169 /* Protect the pages freed from all access */ | |
| 170 if (strict_free_check) | |
| 171 mprotect (ptr, rounded_up_size, PROT_NONE); | |
| 172 #else | |
| 173 /* Set every word in the block to 0xdeadbeef */ | |
| 174 if (strict_free_check) | |
| 175 { | |
| 176 unsigned long long_length = (size + (sizeof (long) - 1)) | |
| 177 / sizeof (long); | |
| 178 unsigned long i; | |
| 179 | |
| 3988 | 180 /* Not using the DEADBEEF_CONSTANT #define, since we don't know |
| 181 * that allocation sizes will be multiples of eight. */ | |
| 428 | 182 for (i = 0; i < long_length; i++) |
| 183 ((unsigned long *) ptr)[i] = 0xdeadbeef; | |
| 184 } | |
| 185 #endif | |
| 186 free_queue[current_free].address = ptr; | |
| 187 free_queue[current_free].length = size; | |
| 188 | |
| 189 current_free++; | |
| 190 if (current_free >= FREE_QUEUE_LIMIT) | |
| 191 current_free = 0; | |
| 192 /* Really free this if there's something there */ | |
| 193 { | |
| 194 void *old = free_queue[current_free].address; | |
| 195 | |
| 196 if (old) | |
| 197 { | |
| 198 #ifdef UNMAPPED_FREE | |
| 199 unsigned long old_len = free_queue[current_free].length; | |
| 200 | |
| 201 mprotect (old, old_len, PROT_READ | PROT_WRITE | PROT_EXEC); | |
| 202 #endif | |
| 203 free (old); | |
| 204 remhash (old, pointer_table); | |
| 205 } | |
| 206 } | |
| 207 } | |
| 208 __free_hook = check_free; | |
| 209 __malloc_hook = check_malloc; | |
| 210 | |
| 211 end: | |
| 212 return; | |
| 213 } | |
| 214 | |
| 215 static void * | |
| 216 check_malloc (size_t size) | |
| 217 { | |
| 218 size_t rounded_up_size; | |
| 219 void *result; | |
| 220 | |
| 221 __free_hook = 0; | |
| 222 __malloc_hook = 0; | |
| 223 if (size == 0) | |
| 224 { | |
| 225 result = 0; | |
| 226 goto end; | |
| 227 } | |
| 228 #ifdef UNMAPPED_FREE | |
| 229 /* Round up to an even number of pages. */ | |
| 230 rounded_up_size = ROUND_UP_TO_PAGE (size); | |
| 231 #else | |
| 232 rounded_up_size = size; | |
| 233 #endif | |
| 234 result = malloc (rounded_up_size); | |
| 235 if (!pointer_table) | |
| 236 pointer_table = make_hash_table (FREE_QUEUE_LIMIT * 2); | |
| 237 puthash (result, (void *)size, pointer_table); | |
| 238 __free_hook = check_free; | |
| 239 __malloc_hook = check_malloc; | |
| 240 end: | |
| 241 return result; | |
| 242 } | |
| 243 | |
| 244 extern void *(*__realloc_hook) (void *, size_t); | |
| 245 | |
| 246 #ifdef MIN | |
| 247 #undef MIN | |
| 248 #endif | |
| 249 #define MIN(A, B) ((A) < (B) ? (A) : (B)) | |
| 250 | |
| 251 /* Don't optimize realloc */ | |
| 252 | |
| 253 static void * | |
| 254 check_realloc (void * ptr, size_t size) | |
| 255 { | |
| 256 EMACS_INT present; | |
| 257 size_t old_size; | |
| 258 void *result = malloc (size); | |
| 259 | |
| 260 if (!ptr) return result; | |
| 442 | 261 present = (EMACS_INT) gethash (ptr, pointer_table, (const void **) &old_size); |
| 428 | 262 if (!present) |
| 263 { | |
| 264 /* This can only happen by reallocing a pointer that didn't | |
| 265 come from malloc. */ | |
| 266 #if !defined(__linux__) | |
| 267 /* see comment in check_free(). */ | |
| 2500 | 268 ABORT (); |
| 428 | 269 #endif |
| 270 printf("Realloc'ing unmalloc'ed pointer at %p\n", ptr); | |
| 271 } | |
| 272 | |
| 273 if (result == 0) | |
| 274 goto end; | |
| 275 memcpy (result, ptr, MIN (size, old_size)); | |
| 276 free (ptr); | |
| 277 end: | |
| 278 return result; | |
| 279 } | |
| 280 | |
| 281 void enable_strict_free_check (void); | |
| 282 void | |
| 283 enable_strict_free_check (void) | |
| 284 { | |
| 285 strict_free_check = 1; | |
| 286 } | |
| 287 | |
| 288 void disable_strict_free_check (void); | |
| 289 void | |
| 290 disable_strict_free_check (void) | |
| 291 { | |
| 292 strict_free_check = 0; | |
| 293 } | |
| 294 | |
| 295 /* Note: All BLOCK_INPUT stuff removed from this file because it's | |
| 296 completely gone in XEmacs */ | |
| 297 | |
| 298 static void * | |
| 299 block_input_malloc (size_t size); | |
| 300 | |
| 301 static void | |
| 302 block_input_free (void* ptr) | |
| 303 { | |
| 304 __free_hook = 0; | |
| 305 __malloc_hook = 0; | |
| 306 free (ptr); | |
| 307 __free_hook = block_input_free; | |
| 308 __malloc_hook = block_input_malloc; | |
| 309 } | |
| 310 | |
| 311 static void * | |
| 312 block_input_malloc (size_t size) | |
| 313 { | |
| 314 void* result; | |
| 315 __free_hook = 0; | |
| 316 __malloc_hook = 0; | |
| 317 result = malloc (size); | |
| 318 __free_hook = block_input_free; | |
| 319 __malloc_hook = block_input_malloc; | |
| 320 return result; | |
| 321 } | |
| 322 | |
| 323 | |
| 324 static void * | |
| 325 block_input_realloc (void* ptr, size_t size) | |
| 326 { | |
| 327 void* result; | |
| 328 __free_hook = 0; | |
| 329 __malloc_hook = 0; | |
| 330 __realloc_hook = 0; | |
| 331 result = realloc (ptr, size); | |
| 332 __free_hook = block_input_free; | |
| 333 __malloc_hook = block_input_malloc; | |
| 334 __realloc_hook = block_input_realloc; | |
| 335 return result; | |
| 336 } | |
| 337 | |
| 338 #ifdef emacs | |
| 339 | |
| 340 void disable_free_hook (void); | |
| 341 void | |
| 342 disable_free_hook (void) | |
| 343 { | |
| 344 __free_hook = block_input_free; | |
| 345 __malloc_hook = block_input_malloc; | |
| 346 __realloc_hook = block_input_realloc; | |
| 347 } | |
| 348 | |
| 349 void | |
| 350 init_free_hook (void) | |
| 351 { | |
| 352 __free_hook = check_free; | |
| 353 __malloc_hook = check_malloc; | |
| 354 __realloc_hook = check_realloc; | |
| 355 current_free = 0; | |
| 356 strict_free_check = 1; | |
| 357 } | |
| 358 | |
| 359 void really_free_one_entry (void *, int, int *); | |
| 360 | |
| 361 DEFUN ("really-free", Freally_free, 0, 1, "P", /* | |
| 362 Actually free the storage held by the free() debug hook. | |
| 363 A no-op if the free hook is disabled. | |
| 364 */ | |
| 2286 | 365 (UNUSED (arg))) |
| 428 | 366 { |
| 367 int count[2]; | |
| 368 Lisp_Object lisp_count[2]; | |
| 369 | |
| 370 if ((__free_hook != 0) && pointer_table) | |
| 371 { | |
| 372 count[0] = 0; | |
| 373 count[1] = 0; | |
| 374 __free_hook = 0; | |
| 375 maphash ((maphash_function)really_free_one_entry, | |
| 376 pointer_table, (void *)&count); | |
| 377 memset (free_queue, 0, sizeof (free_queue_entry) * FREE_QUEUE_LIMIT); | |
| 378 current_free = 0; | |
| 379 __free_hook = check_free; | |
| 793 | 380 lisp_count[0] = make_int (count[0]); |
| 381 lisp_count[1] = make_int (count[1]); | |
| 428 | 382 return Fcons (lisp_count[0], lisp_count[1]); |
| 383 } | |
| 384 else | |
| 385 return Fcons (make_int (0), make_int (0)); | |
| 386 } | |
| 387 | |
| 388 void | |
| 389 really_free_one_entry (void *key, int contents, int *countp) | |
| 390 { | |
| 391 if (contents < 0) | |
| 392 { | |
| 393 free (key); | |
| 394 #ifdef UNMAPPED_FREE | |
| 395 mprotect (key, -contents, PROT_READ | PROT_WRITE | PROT_EXEC); | |
| 396 #endif | |
| 397 remhash (key, pointer_table); | |
| 398 countp[0]++; | |
| 399 countp[1] += -contents; | |
| 400 } | |
| 401 } | |
| 402 | |
| 403 void | |
| 404 syms_of_free_hook (void) | |
| 405 { | |
| 406 DEFSUBR (Freally_free); | |
| 407 } | |
| 408 | |
| 409 #else | |
| 410 void (*__free_hook)(void *) = check_free; | |
| 411 void *(*__malloc_hook)(size_t) = check_malloc; | |
| 412 void *(*__realloc_hook)(void *, size_t) = check_realloc; | |
| 413 #endif | |
| 414 | |
| 415 #endif /* !defined(HAVE_LIBMCHECK) */ | |
| 416 | |
| 417 #if defined(DEBUG_INPUT_BLOCKING) || defined (DEBUG_GCPRO) | |
| 418 | |
| 419 /* Note: There is no more input blocking in XEmacs */ | |
| 420 typedef enum { | |
| 421 block_type, unblock_type, totally_type, | |
| 422 gcpro1_type, gcpro2_type, gcpro3_type, gcpro4_type, gcpro5_type, | |
| 423 ungcpro_type | |
| 424 } blocktype; | |
| 425 | |
| 426 struct block_input_history_struct | |
| 427 { | |
| 428 char *file; | |
| 429 int line; | |
| 430 blocktype type; | |
| 431 int value; | |
| 432 }; | |
| 433 | |
| 434 typedef struct block_input_history_struct block_input_history; | |
| 435 | |
| 436 #endif /* DEBUG_INPUT_BLOCKING || DEBUG_GCPRO */ | |
| 437 | |
| 438 #ifdef DEBUG_INPUT_BLOCKING | |
| 439 | |
| 440 int blhistptr; | |
| 441 | |
| 442 #define BLHISTLIMIT 1000 | |
| 443 | |
| 444 block_input_history blhist[BLHISTLIMIT]; | |
| 445 | |
| 446 note_block_input (char *file, int line) | |
| 447 { | |
| 448 note_block (file, line, block_type); | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
449 assert (interrupt_input_blocked <= 2); |
| 428 | 450 } |
| 451 | |
| 452 note_unblock_input (char* file, int line) | |
| 453 { | |
| 454 note_block (file, line, unblock_type); | |
| 455 } | |
| 456 | |
| 457 note_totally_unblocked (char* file, int line) | |
| 458 { | |
| 459 note_block (file, line, totally_type); | |
| 460 } | |
| 461 | |
| 462 note_block (char *file, int line, blocktype type) | |
| 463 { | |
| 464 blhist[blhistptr].file = file; | |
| 465 blhist[blhistptr].line = line; | |
| 466 blhist[blhistptr].type = type; | |
| 467 blhist[blhistptr].value = interrupt_input_blocked; | |
| 468 | |
| 469 blhistptr++; | |
| 470 if (blhistptr >= BLHISTLIMIT) | |
| 471 blhistptr = 0; | |
| 472 } | |
| 473 | |
| 474 #endif /* DEBUG_INPUT_BLOCKING */ | |
| 475 | |
| 476 | |
| 477 #ifdef DEBUG_GCPRO | |
| 478 | |
| 479 int gcprohistptr; | |
| 480 #define GCPROHISTLIMIT 1000 | |
| 481 block_input_history gcprohist[GCPROHISTLIMIT]; | |
| 482 | |
| 483 static void | |
| 484 log_gcpro (char *file, int line, struct gcpro *value, blocktype type) | |
| 485 { | |
| 486 if (type == ungcpro_type) | |
| 487 { | |
| 488 if (value == gcprolist) goto OK; | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
489 assert (gcprolist); |
| 428 | 490 if (value == gcprolist->next) goto OK; |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
491 assert (gcprolist->next); |
| 428 | 492 if (value == gcprolist->next->next) goto OK; |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
493 assert (gcprolist->next->next); |
| 428 | 494 if (value == gcprolist->next->next->next) goto OK; |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
3988
diff
changeset
|
495 assert (gcprolist->next->next->next); |
| 446 | 496 if (value == gcprolist->next->next->next->next) goto OK; |
| 2500 | 497 ABORT (); |
| 428 | 498 OK:; |
| 499 } | |
| 500 gcprohist[gcprohistptr].file = file; | |
| 501 gcprohist[gcprohistptr].line = line; | |
| 502 gcprohist[gcprohistptr].type = type; | |
| 503 gcprohist[gcprohistptr].value = (int) value; | |
| 504 gcprohistptr++; | |
| 505 if (gcprohistptr >= GCPROHISTLIMIT) | |
| 506 gcprohistptr = 0; | |
| 507 } | |
| 508 | |
| 509 void | |
| 510 debug_gcpro1 (char *file, int line, struct gcpro *gcpro1, Lisp_Object *var) | |
| 511 { | |
| 512 gcpro1->next = gcprolist; gcpro1->var = var; gcpro1->nvars = 1; | |
| 513 gcprolist = gcpro1; | |
| 514 log_gcpro (file, line, gcpro1, gcpro1_type); | |
| 515 } | |
| 516 | |
| 517 void | |
| 518 debug_gcpro2 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, | |
| 519 Lisp_Object *var1, Lisp_Object *var2) | |
| 520 { | |
| 521 gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; | |
| 522 gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; | |
| 523 gcprolist = gcpro2; | |
| 524 log_gcpro (file, line, gcpro2, gcpro2_type); | |
| 525 } | |
| 526 | |
| 527 void | |
| 528 debug_gcpro3 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, | |
| 529 struct gcpro *gcpro3, Lisp_Object *var1, Lisp_Object *var2, | |
| 530 Lisp_Object *var3) | |
| 531 { | |
| 532 gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; | |
| 533 gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; | |
| 534 gcpro3->next = gcpro2; gcpro3->var = var3; gcpro3->nvars = 1; | |
| 535 gcprolist = gcpro3; | |
| 536 log_gcpro (file, line, gcpro3, gcpro3_type); | |
| 537 } | |
| 538 | |
| 539 void | |
| 540 debug_gcpro4 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, | |
| 541 struct gcpro *gcpro3, struct gcpro *gcpro4, Lisp_Object *var1, | |
| 542 Lisp_Object *var2, Lisp_Object *var3, Lisp_Object *var4) | |
| 543 { | |
| 544 log_gcpro (file, line, gcpro4, gcpro4_type); | |
| 545 gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; | |
| 546 gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; | |
| 547 gcpro3->next = gcpro2; gcpro3->var = var3; gcpro3->nvars = 1; | |
| 548 gcpro4->next = gcpro3; gcpro4->var = var4; gcpro4->nvars = 1; | |
| 549 gcprolist = gcpro4; | |
| 550 } | |
| 551 | |
| 552 void | |
| 553 debug_gcpro5 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, | |
| 554 struct gcpro *gcpro3, struct gcpro *gcpro4, struct gcpro *gcpro5, | |
| 555 Lisp_Object *var1, Lisp_Object *var2, Lisp_Object *var3, | |
| 556 Lisp_Object *var4, Lisp_Object *var5) | |
| 557 { | |
| 558 log_gcpro (file, line, gcpro5, gcpro5_type); | |
| 559 gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; | |
| 560 gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; | |
| 561 gcpro3->next = gcpro2; gcpro3->var = var3; gcpro3->nvars = 1; | |
| 562 gcpro4->next = gcpro3; gcpro4->var = var4; gcpro4->nvars = 1; | |
| 563 gcpro5->next = gcpro4; gcpro5->var = var5; gcpro5->nvars = 1; | |
| 564 gcprolist = gcpro5; | |
| 565 } | |
| 566 | |
| 567 void | |
| 568 debug_ungcpro (char *file, int line, struct gcpro *gcpro1) | |
| 569 { | |
| 570 log_gcpro (file, line, gcpro1, ungcpro_type); | |
| 571 gcprolist = gcpro1->next; | |
| 572 } | |
| 573 | |
| 574 | |
| 575 /* To be called from the debugger */ | |
| 576 void show_gcprohist (void); | |
| 577 void | |
| 578 show_gcprohist (void) | |
| 579 { | |
| 580 int i, j; | |
| 581 for (i = 0, j = gcprohistptr; | |
| 582 i < GCPROHISTLIMIT; | |
| 583 i++, j++) | |
| 584 { | |
| 585 if (j >= GCPROHISTLIMIT) | |
| 586 j = 0; | |
| 587 printf ("%3d %s %d %s 0x%x\n", | |
| 588 j, gcprohist[j].file, gcprohist[j].line, | |
| 589 (gcprohist[j].type == gcpro1_type ? "GCPRO1" : | |
| 590 gcprohist[j].type == gcpro2_type ? "GCPRO2" : | |
| 591 gcprohist[j].type == gcpro3_type ? "GCPRO3" : | |
| 592 gcprohist[j].type == gcpro4_type ? "GCPRO4" : | |
| 446 | 593 gcprohist[j].type == gcpro5_type ? "GCPRO5" : |
| 428 | 594 gcprohist[j].type == ungcpro_type ? "UNGCPRO" : "???"), |
| 595 gcprohist[j].value); | |
| 596 } | |
| 597 fflush (stdout); | |
| 598 } | |
| 599 | |
| 600 #endif /* DEBUG_GCPRO */ |