Mercurial > hg > xemacs-beta
diff src/alloc.c @ 1204:e22b0213b713
[xemacs-hg @ 2003-01-12 11:07:58 by michaels]
modules/ChangeLog:
2002-12-16 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
remove ifdef USE_KKCC.
src/ChangeLog:
2003-01-08 Mike Sperber <mike@xemacs.org>
* console.h (CDFW_CONSOLE): Don't lead to a crash if we're dealing
with a dead window/frame/device/console.
2002-12-20 Mike Sperber <mike@xemacs.org>
* ui-gtk.c: Fix typo from Ben's patch: emacs_ffi_data is a
typedef, not a struct. emacs_gtk_object_data is a typedef, not a
struct.
* gtk-glue.c (gdk_event_to_emacs_event): Fix typos from Ben's
patch: le -> emacs_event + rearrange the code.
* event-gtk.c (gtk_event_to_emacs_event): Fix typos from Ben's
patch: ..._UNDERLYING_GDK_EVENT -> ..._GDK_EVENT, ev -> key_event.
* device-gtk.c: Fix typo from Ben's patch: x_keysym_map_hash_table
-> x_keysym_map_hashtable.
2002-12-19 Mike Sperber <mike@xemacs.org>
* menubar-x.c (set_frame_menubar): Initialize protect_me field of
popup_data.
2002-12-16 Ben Wing <ben@xemacs.org>
Major cleanup of KKCC, etc.
KKCC, pdump-related:
-- descriptions are written for all objects. this required some
changes in the format of some objects, e.g. extents, popup-data,
coding system, lstream, lcrecord-list.
-- KKCC now handles weakness in markers, hash tables, elsewhere
correctly (formerly, you'd eventually get a stack overflow due
to endlessly expanding markers).
-- textual changes: lrecord_description -> memory_description,
struct_description -> sized_memory_description.
-- extensive comment describing descriptions and pdump.
-- redo XD_UNION so it works inline and change its format to provide
sufficient info for pdump. implement XD_UNION in pdump. also add
XD_UNION_DYNAMIC_SIZE, which works like XD_UNION except for when
auto-computing structure sizes.
-- add support for XD_INDIRECT in description offsets (used by
extents).
-- add support for "description maps", allowing for indirect
descriptions that are retrieved from an object at run-time. this
generalizes XD_CODING_SYSTEM_END, XD_SPECIFIER_END, etc., which
have now been eliminated.
-- add a fifth field "flags" to memory_description, to support flags
that can be specified for this particular line. Currently defined
flags are XD_FLAG_NO_KKCC (KKCC should ignore this entry; useful
for the weakness above in markers, etc.), XD_FLAG_NO_PDUMP (pdump
should ignore this entry), XD_FLAG_UNION_DEFAULT_ENTRY (in
union maps, this specifies a "default" entry for all remaining
values), and XD_FLAG_FREE_LISP_OBJECT (for use with lcrecord-lists).
-- clean up the kkcc-itis in events, so that the differences
between event data as separate objects and as a union are now
minimized to a small number of places. with the new XD_UNION, we
no longer need event data as separate objects, so this code is no
longer ifdef USE_KKCC, but instead ifdef EVENT_DATA_AS_OBJECTS,
not used by default. make sure that we explicitly free the
separate event data objects when no longer in use, to maintain the
invariant the event processing causes no consing.
-- also remove other USE_KKCC ifdefs when not necessary.
-- allow for KKCC compilation under MS Windows.
-- fix README.kkcc.
-- dump_add_root_object -> dump_add_root_lisp_object.
-- implement dump_add_root_block and use this to handle
dump_add_opaque.
-- factor out some code duplicated in kkcc and pdump.
Other allocation/object-related:
-- change various *slots.h so MARKED_SLOT() call no longer
includes semicolon.
-- free_marker() takes a Lisp_Object not a direct pointer.
-- make bit vectors lcrecords, like vectors, and eliminate code
that essentially duplicated the lcrecord handling.
-- additional asserts in FREE_FIXED_TYPE, formerly duplicated in
the various callers of this.
-- all lcrecord allocation functions now zero out the returned
lcrecords. unnecessary calls to zero_lcrecord removed. add long
comment describing these functions.
-- extract out process and coding system slots, like for buffers,
frames, etc.
-- lcrecords now set the type of items sitting on the free list to
lcrecord_type_free.
-- changes to the way that gap arrays are allocated, for kkcc's
benefit -- now, one single memory block with a stretchy array on
the end, instead of a separate block holding the array.
Error-checking-related:
-- now can compile with C++ under MS Windows. clean up compile errors
discovered that way. (a few were real problems)
-- add C++ error-checking code to verify problems with mismatched
GCPRO/UNGCPRO. (there were a few in the kkcc code.) add long
comment about how to catch insufficient GCPRO (yes, it's possible
using C++).
-- add debug_p4(), a simple object printer, when debug_print()
doesn't work.
-- add dp() and db() as short synonyms of debug_print(),
debug_backtrace().
-- `print' tries EXTREMELY hard to avoid core dumping when printing
when crashing or from debug_print(), and tries as hard as it
reasonably can in other situations.
-- Correct the message output upon crashing to be more up-to-date.
Event-related:
-- document event-matches-key-specifier-p better.
-- generalize the dispatch queues formerly duplicated in the
various event implementations. add event methods to drain pending
events. generalize and clean up QUIT handling, removing
event-specific quit processing. allow arbitrary keystrokes, not
just ASCII, to be the QUIT char. among other things, this should
fix some longstanding bugs in X quit handling. long comment
describing the various event queues.
-- implement delaying of XFlush() if there are pending expose events.
SOMEONE PLEASE TRY THIS OUT.
-- Fix `xemacs -batch -l dunnet' under Cygwin. Try to fix under
MS Windows but not quite there yet.
Other:
-- class -> class_ and no more C++ games with this item.
new -> new_ in the lwlib code, so far not elsewhere.
-- use `struct htentry' not `struct hentry' in elhash.c to avoid
debugger confusion with hash.c.
-- new macros ALIST_LOOP_3, ALIST_LOOP_4.
* README.kkcc:
* alloc.c:
* alloc.c (deadbeef_memory):
* alloc.c (allocate_lisp_storage):
* alloc.c (copy_lisp_object):
* alloc.c (ALLOCATE_FIXED_TYPE_1):
* alloc.c (FREE_FIXED_TYPE):
* alloc.c (make_vector_internal):
* alloc.c (make_bit_vector_internal):
* 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 (struct string_chars_block):
* alloc.c (mark_lcrecord_list):
* alloc.c (make_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (alloc_automanaged_lcrecord):
* alloc.c (staticpro_1):
* alloc.c (staticpro):
* alloc.c (lispdesc_indirect_count_1):
* alloc.c (lispdesc_indirect_description_1):
* alloc.c (lispdesc_one_description_line_size):
* alloc.c (lispdesc_structure_size):
* alloc.c (mark_object_maybe_checking_free):
* alloc.c (mark_with_description):
* alloc.c (mark_struct_contents):
* alloc.c (mark_object):
* alloc.c (tick_lcrecord_stats):
* alloc.c (free_cons):
* alloc.c (free_key_data):
* alloc.c (free_button_data):
* alloc.c (free_motion_data):
* alloc.c (free_process_data):
* alloc.c (free_timeout_data):
* alloc.c (free_magic_data):
* alloc.c (free_magic_eval_data):
* alloc.c (free_eval_data):
* alloc.c (free_misc_user_data):
* alloc.c (free_marker):
* alloc.c (compact_string_chars):
* alloc.c (gc_sweep):
* alloc.c (garbage_collect_1):
* alloc.c (Fgarbage_collect):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_early):
* alloc.c (init_alloc_once_early):
* buffer.c:
* buffer.c (mark_buffer):
* buffer.c (MARKED_SLOT):
* buffer.c (cleanup_buffer_undo_lists):
* buffer.c (Fget_file_buffer):
* buffer.h (MARKED_SLOT):
* bufslots.h:
* bytecode.c:
* callint.c:
* casetab.c:
* chartab.c:
* chartab.c (symbol_to_char_table_type):
* cmdloop.c:
* cmdloop.c (Fcommand_loop_1):
* config.h.in (new):
* conslots.h:
* console-gtk-impl.h (struct gtk_frame):
* console-impl.h:
* console-impl.h (struct console):
* console-impl.h (MARKED_SLOT):
* console-impl.h (CONSOLE_QUIT_EVENT):
* console-msw-impl.h (XM_BUMPQUEUE):
* console-msw.c (write_string_to_mswindows_debugging_output):
* console-msw.h:
* console-stream-impl.h:
* console-stream-impl.h (struct stream_console):
* console-stream.c:
* console-stream.c (stream_init_console):
* console-stream.h:
* console-tty.c:
* console-tty.h:
* console-x.h:
* console.c:
* console.c (mark_console):
* console.c (MARKED_SLOT):
* console.c (allocate_console):
* console.c (get_console_variant):
* console.c (create_console):
* console.c (delete_console_internal):
* console.c (Fset_input_mode):
* console.c (Fcurrent_input_mode):
* console.c (common_init_complex_vars_of_console):
* console.h:
* console.h (console_variant):
* console.h (device_metrics):
* data.c:
* data.c (Faref):
* data.c (Faset):
* data.c (decode_weak_list_type):
* database.c:
* debug.c (xemacs_debug_loop):
* debug.c (FROB):
* debug.c (Fadd_debug_class_to_check):
* debug.c (Fdelete_debug_class_to_check):
* debug.c (Fset_debug_classes_to_check):
* debug.c (Fset_debug_class_types_to_check):
* debug.c (Fdebug_types_being_checked):
* debug.h (DASSERT):
* device-gtk.c:
* device-impl.h (struct device):
* device-impl.h (MARKED_SLOT):
* device-msw.c:
* device-x.c:
* device-x.c (x_init_device_class):
* device-x.c (x_comp_visual_info):
* device-x.c (x_try_best_visual_class):
* device-x.c (x_init_device):
* device-x.c (construct_name_list):
* device-x.c (x_get_resource_prefix):
* device-x.c (Fx_get_resource):
* device-x.c (Fx_display_visual_class):
* device.c:
* device.c (MARKED_SLOT):
* device.c (allocate_device):
* device.c (Fmake_device):
* device.c (delete_device_internal):
* device.c (Fset_device_class):
* device.h:
* devslots.h:
* devslots.h (MARKED_SLOT):
* dialog-msw.c:
* dired-msw.c (mswindows_ls_sort_fcn):
* dired-msw.c (mswindows_get_files):
* dired-msw.c (mswindows_format_file):
* doprnt.c (parse_doprnt_spec):
* dumper.c:
* dumper.c (struct):
* dumper.c (dump_add_root_block):
* dumper.c (dump_add_root_struct_ptr):
* dumper.c (dump_add_root_lisp_object):
* dumper.c (pdump_struct_list_elt):
* dumper.c (pdump_get_entry_list):
* dumper.c (pdump_backtrace):
* dumper.c (pdump_bump_depth):
* dumper.c (pdump_register_sub):
* dumper.c (pdump_register_object):
* dumper.c (pdump_register_struct_contents):
* dumper.c (pdump_register_struct):
* dumper.c (pdump_store_new_pointer_offsets):
* dumper.c (pdump_dump_data):
* dumper.c (pdump_reloc_one):
* dumper.c (pdump_allocate_offset):
* dumper.c (pdump_scan_by_alignment):
* dumper.c (pdump_dump_root_blocks):
* dumper.c (pdump_dump_rtables):
* dumper.c (pdump_dump_root_lisp_objects):
* dumper.c (pdump):
* dumper.c (pdump_load_finish):
* dumper.c (pdump_file_get):
* dumper.c (pdump_resource_get):
* dumper.c (pdump_load):
* editfns.c (save_excursion_restore):
* editfns.c (user_login_name):
* editfns.c (save_restriction_restore):
* elhash.c:
* elhash.c (htentry):
* elhash.c (struct Lisp_Hash_Table):
* elhash.c (HTENTRY_CLEAR_P):
* elhash.c (LINEAR_PROBING_LOOP):
* elhash.c (check_hash_table_invariants):
* elhash.c (mark_hash_table):
* elhash.c (hash_table_equal):
* elhash.c (print_hash_table_data):
* elhash.c (free_hentries):
* elhash.c (make_general_lisp_hash_table):
* elhash.c (decode_hash_table_weakness):
* elhash.c (decode_hash_table_test):
* elhash.c (Fcopy_hash_table):
* elhash.c (resize_hash_table):
* elhash.c (pdump_reorganize_hash_table):
* elhash.c (find_htentry):
* elhash.c (Fgethash):
* elhash.c (Fputhash):
* elhash.c (remhash_1):
* elhash.c (Fremhash):
* elhash.c (Fclrhash):
* elhash.c (copy_compress_hentries):
* elhash.c (elisp_maphash_unsafe):
* elhash.c (finish_marking_weak_hash_tables):
* elhash.c (prune_weak_hash_tables):
* elhash.h:
* emacs.c:
* emacs.c (main_1):
* emacs.c (main):
* emacs.c (shut_down_emacs):
* emodules.h (dump_add_root_lisp_object):
* eval.c:
* eval.c (unwind_to_catch):
* eval.c (maybe_signal_error_1):
* eval.c (maybe_signal_continuable_error_1):
* eval.c (maybe_signal_error):
* eval.c (maybe_signal_continuable_error):
* eval.c (maybe_signal_error_2):
* eval.c (maybe_signal_continuable_error_2):
* eval.c (maybe_signal_ferror):
* eval.c (maybe_signal_continuable_ferror):
* eval.c (maybe_signal_ferror_with_frob):
* eval.c (maybe_signal_continuable_ferror_with_frob):
* eval.c (maybe_syntax_error):
* eval.c (maybe_sferror):
* eval.c (maybe_invalid_argument):
* eval.c (maybe_invalid_constant):
* eval.c (maybe_invalid_operation):
* eval.c (maybe_invalid_change):
* eval.c (maybe_invalid_state):
* eval.c (Feval):
* eval.c (call_trapping_problems):
* eval.c (call_with_suspended_errors):
* eval.c (warn_when_safe_lispobj):
* eval.c (warn_when_safe):
* eval.c (vars_of_eval):
* event-Xt.c:
* event-Xt.c (maybe_define_x_key_as_self_inserting_character):
* event-Xt.c (x_to_emacs_keysym):
* event-Xt.c (x_event_to_emacs_event):
* event-Xt.c (emacs_Xt_enqueue_focus_event):
* event-Xt.c (emacs_Xt_format_magic_event):
* event-Xt.c (emacs_Xt_compare_magic_event):
* event-Xt.c (emacs_Xt_hash_magic_event):
* event-Xt.c (emacs_Xt_handle_magic_event):
* event-Xt.c (Xt_timeout_to_emacs_event):
* event-Xt.c (Xt_process_to_emacs_event):
* event-Xt.c (signal_special_Xt_user_event):
* event-Xt.c (emacs_Xt_next_event):
* event-Xt.c (emacs_Xt_event_handler):
* event-Xt.c (emacs_Xt_drain_queue):
* event-Xt.c (emacs_Xt_event_pending_p):
* event-Xt.c (check_if_pending_expose_event):
* event-Xt.c (reinit_vars_of_event_Xt):
* event-Xt.c (vars_of_event_Xt):
* event-gtk.c:
* event-gtk.c (IS_MODIFIER_KEY):
* event-gtk.c (emacs_gtk_format_magic_event):
* event-gtk.c (emacs_gtk_compare_magic_event):
* event-gtk.c (emacs_gtk_hash_magic_event):
* event-gtk.c (emacs_gtk_handle_magic_event):
* event-gtk.c (gtk_to_emacs_keysym):
* event-gtk.c (gtk_timeout_to_emacs_event):
* event-gtk.c (gtk_process_to_emacs_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (signal_special_gtk_user_event):
* event-gtk.c (emacs_gtk_next_event):
* event-gtk.c (gtk_event_to_emacs_event):
* event-gtk.c (generic_event_handler):
* event-gtk.c (emacs_shell_event_handler):
* event-gtk.c (emacs_gtk_drain_queue):
* event-gtk.c (emacs_gtk_event_pending_p):
* event-gtk.c (reinit_vars_of_event_gtk):
* event-gtk.c (vars_of_event_gtk):
* event-msw.c:
* event-msw.c (struct winsock_stream):
* event-msw.c (winsock_reader):
* event-msw.c (winsock_writer):
* event-msw.c (mswindows_enqueue_dispatch_event):
* event-msw.c (mswindows_enqueue_misc_user_event):
* event-msw.c (mswindows_enqueue_magic_event):
* event-msw.c (mswindows_enqueue_process_event):
* event-msw.c (mswindows_enqueue_mouse_button_event):
* event-msw.c (mswindows_enqueue_keypress_event):
* event-msw.c (mswindows_dequeue_dispatch_event):
* event-msw.c (emacs_mswindows_drain_queue):
* event-msw.c (mswindows_need_event_in_modal_loop):
* event-msw.c (mswindows_need_event):
* event-msw.c (mswindows_wm_timer_callback):
* event-msw.c (dde_eval_string):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_wnd_proc):
* event-msw.c (remove_timeout_mapper):
* event-msw.c (emacs_mswindows_remove_timeout):
* event-msw.c (emacs_mswindows_event_pending_p):
* event-msw.c (emacs_mswindows_format_magic_event):
* event-msw.c (emacs_mswindows_compare_magic_event):
* event-msw.c (emacs_mswindows_hash_magic_event):
* event-msw.c (emacs_mswindows_handle_magic_event):
* event-msw.c (emacs_mswindows_select_console):
* event-msw.c (emacs_mswindows_unselect_console):
* event-msw.c (reinit_vars_of_event_mswindows):
* event-msw.c (vars_of_event_mswindows):
* event-stream.c:
* event-stream.c (mark_command_builder):
* event-stream.c (reset_command_builder_event_chain):
* event-stream.c (allocate_command_builder):
* event-stream.c (copy_command_builder):
* event-stream.c (command_builder_append_event):
* event-stream.c (event_stream_event_pending_p):
* event-stream.c (event_stream_force_event_pending):
* event-stream.c (maybe_read_quit_event):
* event-stream.c (event_stream_drain_queue):
* event-stream.c (remove_quit_p_event):
* event-stream.c (event_stream_quit_p):
* event-stream.c (echo_key_event):
* event-stream.c (maybe_kbd_translate):
* event-stream.c (execute_help_form):
* event-stream.c (event_stream_generate_wakeup):
* event-stream.c (enqueue_dispatch_event):
* event-stream.c (enqueue_magic_eval_event):
* event-stream.c (Fenqueue_eval_event):
* event-stream.c (enqueue_misc_user_event):
* event-stream.c (enqueue_misc_user_event_pos):
* event-stream.c (next_event_internal):
* event-stream.c (Fnext_event):
* event-stream.c (Faccept_process_output):
* event-stream.c (execute_internal_event):
* event-stream.c (munge_keymap_translate):
* event-stream.c (command_builder_find_leaf_no_mule_processing):
* event-stream.c (command_builder_find_leaf):
* event-stream.c (lookup_command_event):
* event-stream.c (is_scrollbar_event):
* event-stream.c (execute_command_event):
* event-stream.c (Fdispatch_event):
* event-stream.c (Fread_key_sequence):
* event-stream.c (dribble_out_event):
* event-stream.c (vars_of_event_stream):
* event-tty.c (tty_timeout_to_emacs_event):
* event-tty.c (emacs_tty_next_event):
* event-tty.c (emacs_tty_drain_queue):
* event-tty.c (reinit_vars_of_event_tty):
* event-unixoid.c:
* event-unixoid.c (find_tty_or_stream_console_from_fd):
* event-unixoid.c (read_event_from_tty_or_stream_desc):
* event-unixoid.c (drain_tty_devices):
* event-unixoid.c (poll_fds_for_input):
* events.c:
* events.c (deinitialize_event):
* events.c (zero_event):
* events.c (mark_event):
* events.c (print_event_1):
* events.c (print_event):
* events.c (event_equal):
* events.c (event_hash):
* events.c (Fmake_event):
* events.c (Fdeallocate_event):
* events.c (Fcopy_event):
* events.c (map_event_chain_remove):
* events.c (character_to_event):
* events.c (event_to_character):
* events.c (Fevent_to_character):
* events.c (format_event_object):
* events.c (upshift_event):
* events.c (downshift_event):
* events.c (event_upshifted_p):
* events.c (Fevent_live_p):
* events.c (Fevent_type):
* events.c (Fevent_timestamp):
* events.c (CHECK_EVENT_TYPE):
* events.c (CHECK_EVENT_TYPE2):
* events.c (CHECK_EVENT_TYPE3):
* events.c (Fevent_key):
* events.c (Fevent_button):
* events.c (Fevent_modifier_bits):
* events.c (event_x_y_pixel_internal):
* events.c (event_pixel_translation):
* events.c (Fevent_process):
* events.c (Fevent_function):
* events.c (Fevent_object):
* events.c (Fevent_properties):
* events.c (syms_of_events):
* events.c (vars_of_events):
* events.h:
* events.h (struct event_stream):
* events.h (struct Lisp_Key_Data):
* events.h (KEY_DATA_KEYSYM):
* events.h (EVENT_KEY_KEYSYM):
* events.h (struct Lisp_Button_Data):
* events.h (EVENT_BUTTON_BUTTON):
* events.h (struct Lisp_Motion_Data):
* events.h (EVENT_MOTION_X):
* events.h (struct Lisp_Process_Data):
* events.h (EVENT_PROCESS_PROCESS):
* events.h (struct Lisp_Timeout_Data):
* events.h (EVENT_TIMEOUT_INTERVAL_ID):
* events.h (struct Lisp_Eval_Data):
* events.h (EVENT_EVAL_FUNCTION):
* events.h (struct Lisp_Misc_User_Data):
* events.h (EVENT_MISC_USER_FUNCTION):
* events.h (struct Lisp_Magic_Eval_Data):
* events.h (EVENT_MAGIC_EVAL_INTERNAL_FUNCTION):
* events.h (struct Lisp_Magic_Data):
* events.h (EVENT_MAGIC_UNDERLYING):
* events.h (EVENT_MAGIC_GDK_EVENT):
* events.h (struct Lisp_Event):
* events.h (XEVENT_CHANNEL):
* events.h (SET_EVENT_TIMESTAMP_ZERO):
* events.h (SET_EVENT_CHANNEL):
* events.h (SET_EVENT_NEXT):
* events.h (XSET_EVENT_TYPE):
* events.h (struct command_builder):
* extents.c:
* extents.c (gap_array_adjust_markers):
* extents.c (gap_array_recompute_derived_values):
* extents.c (gap_array_move_gap):
* extents.c (gap_array_make_gap):
* extents.c (gap_array_insert_els):
* extents.c (gap_array_delete_els):
* extents.c (gap_array_make_marker):
* extents.c (gap_array_delete_marker):
* extents.c (gap_array_move_marker):
* extents.c (make_gap_array):
* extents.c (free_gap_array):
* extents.c (extent_list_num_els):
* extents.c (extent_list_insert):
* extents.c (mark_extent_auxiliary):
* extents.c (allocate_extent_auxiliary):
* extents.c (decode_extent_at_flag):
* extents.c (verify_extent_mapper):
* extents.c (symbol_to_glyph_layout):
* extents.c (syms_of_extents):
* faces.c:
* file-coding.c:
* file-coding.c (struct_detector_category_description =):
* file-coding.c (detector_category_dynarr_description_1):
* file-coding.c (struct_detector_description =):
* file-coding.c (detector_dynarr_description_1):
* file-coding.c (MARKED_SLOT):
* file-coding.c (mark_coding_system):
* file-coding.c (coding_system_extra_description_map):
* file-coding.c (coding_system_description):
* file-coding.c (allocate_coding_system):
* file-coding.c (symbol_to_eol_type):
* file-coding.c (Fcoding_system_aliasee):
* file-coding.c (set_coding_stream_coding_system):
* file-coding.c (struct convert_eol_coding_system):
* file-coding.c (struct undecided_coding_system):
* file-coding.c (undecided_mark_coding_stream):
* file-coding.c (coding_category_symbol_to_id):
* file-coding.c (struct gzip_coding_system):
* file-coding.c (coding_system_type_create):
* file-coding.h:
* file-coding.h (struct Lisp_Coding_System):
* file-coding.h (CODING_SYSTEM_SLOT_DECLARATION):
* file-coding.h (coding_system_variant):
* file-coding.h (struct coding_system_methods):
* file-coding.h (DEFINE_CODING_SYSTEM_TYPE_WITH_DATA):
* file-coding.h (INITIALIZE_CODING_SYSTEM_TYPE_WITH_DATA):
* file-coding.h (struct coding_stream):
* fileio.c (Fsubstitute_in_file_name):
* floatfns.c:
* fns.c:
* fns.c (base64_encode_1):
* frame-gtk.c:
* frame-gtk.c (Fgtk_start_drag_internal):
* frame-impl.h (struct frame):
* frame-impl.h (MARKED_SLOT):
* frame-msw.c:
* frame-x.c:
* frame-x.c (Fcde_start_drag_internal):
* frame-x.c (Foffix_start_drag_internal):
* frame.c:
* frame.c (MARKED_SLOT):
* frame.c (allocate_frame_core):
* frame.c (delete_frame_internal):
* frame.c (Fmouse_position_as_motion_event):
* frameslots.h:
* frameslots.h (MARKED_SLOT_ARRAY):
* free-hook.c:
* glyphs-msw.c (mswindows_widget_instantiate):
* glyphs-x.c:
* glyphs-x.c (convert_EImage_to_XImage):
* glyphs.c:
* glyphs.c (process_image_string_instantiator):
* glyphs.c (mark_image_instance):
* glyphs.c (allocate_image_instance):
* glyphs.c (unmap_subwindow):
* glyphs.c (map_subwindow):
* glyphs.c (syms_of_glyphs):
* glyphs.c (specifier_type_create_image):
* glyphs.h:
* glyphs.h (struct text_image_instance):
* glyphs.h (struct Lisp_Image_Instance):
* gmalloc.c:
* gmalloc.c ("C"):
* gpmevent.c (Freceive_gpm_event):
* gpmevent.c (gpm_next_event_cb):
* gpmevent.c (vars_of_gpmevent):
* gtk-glue.c (gdk_event_to_emacs_event):
* gtk-xemacs.c (gtk_xemacs_class_init):
* gui-msw.c:
* gui-msw.c (mswindows_handle_gui_wm_command):
* gui-msw.c (mswindows_translate_menu_or_dialog_item):
* gui-x.c:
* gui-x.c (mark_popup_data):
* gui-x.c (snarf_widget_value_mapper):
* gui-x.c (gcpro_popup_callbacks):
* gui-x.c (ungcpro_popup_callbacks):
* gui-x.c (free_popup_widget_value_tree):
* gui-x.c (popup_selection_callback):
* gui-x.h:
* gui-x.h (struct popup_data):
* gui.c:
* gui.c (allocate_gui_item):
* gutter.c (decode_gutter_position):
* hash.c (NULL_ENTRY):
* indent.c (vmotion_1):
* indent.c (vmotion_pixels):
* input-method-motif.c (res):
* input-method-xlib.c (IMInstantiateCallback):
* input-method-xlib.c (XIM_init_device):
* input-method-xlib.c (res):
* intl-encap-win32.c:
* intl-encap-win32.c (qxeSHGetDataFromIDList):
* intl-win32.c:
* intl-win32.c (mswindows_multibyte_cp_type):
* intl-win32.c (struct mswindows_multibyte_coding_system):
* keymap.c:
* keymap.c (make_key_description):
* keymap.c (keymap_store):
* keymap.c (get_keyelt):
* keymap.c (keymap_lookup_1):
* keymap.c (define_key_parser):
* keymap.c (key_desc_list_to_event):
* keymap.c (event_matches_key_specifier_p):
* keymap.c (meta_prefix_char_p):
* keymap.c (ensure_meta_prefix_char_keymapp):
* keymap.c (Fdefine_key):
* keymap.c (struct raw_lookup_key_mapper_closure):
* keymap.c (raw_lookup_key):
* keymap.c (raw_lookup_key_mapper):
* keymap.c (lookup_keys):
* keymap.c (lookup_events):
* keymap.c (Flookup_key):
* keymap.c (struct map_keymap_unsorted_closure):
* keymap.c (map_keymap_unsorted_mapper):
* keymap.c (map_keymap_sorted):
* keymap.c (map_keymap_mapper):
* keymap.c (map_keymap):
* keymap.c (accessible_keymaps_mapper_1):
* keymap.c (Faccessible_keymaps):
* keymap.c (Fsingle_key_description):
* keymap.c (raw_keys_to_keys):
* keymap.c (format_raw_keys):
* keymap.c (where_is_recursive_mapper):
* keymap.c (where_is_internal):
* keymap.c (describe_map_mapper_shadow_search):
* keymap.c (keymap_lookup_inherited_mapper):
* keymap.c (describe_map_mapper):
* keymap.h (event_matches_key_specifier_p):
* lisp.h:
* lisp.h (this):
* lisp.h (RETURN_NOT_REACHED):
* lisp.h (struct Lisp_Vector):
* lisp.h (struct Lisp_Bit_Vector):
* lisp.h (UNGCPRO_1):
* lisp.h (NUNGCPRO):
* lisp.h (NNUNGCPRO):
* lisp.h (DECLARE_INLINE_HEADER):
* lrecord.h:
* lrecord.h (struct lrecord_header):
* lrecord.h (struct lcrecord_header):
* lrecord.h (lrecord_type):
* lrecord.h (struct lrecord_implementation):
* lrecord.h (RECORD_DUMPABLE):
* lrecord.h (memory_description_type):
* lrecord.h (data_description_entry_flags):
* lrecord.h (struct memory_description):
* lrecord.h (struct sized_memory_description):
* lrecord.h (XD_INDIRECT):
* lrecord.h (XD_IS_INDIRECT):
* lrecord.h (XD_DYNARR_DESC):
* lrecord.h (DEFINE_BASIC_LRECORD_IMPLEMENTATION):
* lrecord.h (MAKE_LRECORD_IMPLEMENTATION):
* lrecord.h (MAKE_EXTERNAL_LRECORD_IMPLEMENTATION):
* lrecord.h (alloc_lcrecord_type):
* lstream.c:
* lstream.c (Lstream_new):
* lstream.c (lisp_buffer_marker):
* lstream.h:
* lstream.h (lstream_implementation):
* lstream.h (DEFINE_LSTREAM_IMPLEMENTATION):
* lstream.h (DEFINE_LSTREAM_IMPLEMENTATION_WITH_DATA):
* marker.c:
* marker.c (copy_marker_1):
* mem-limits.h:
* menubar-gtk.c:
* menubar-gtk.c (gtk_popup_menu):
* menubar-msw.c:
* menubar-msw.c (mswindows_popup_menu):
* menubar-x.c (make_dummy_xbutton_event):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar-x.c (menu_accelerator_safe_compare):
* menubar-x.c (menu_accelerator_safe_mod_compare):
* mule-charset.c:
* mule-charset.c (make_charset):
* mule-charset.c (Fcharset_property):
* mule-coding.c:
* mule-coding.c (ccs_description_1):
* mule-coding.c (ccs_description =):
* mule-coding.c (ccsd_description_1):
* mule-coding.c (ccsd_description =):
* nt.c (getpwnam):
* nt.c (init_mswindows_environment):
* nt.c (get_cached_volume_information):
* nt.c (mswindows_is_executable):
* nt.c (read_unc_volume):
* nt.c (mswindows_access):
* nt.c (mswindows_link):
* nt.c (mswindows_fstat):
* nt.c (mswindows_stat):
* nt.c (mswindows_executable_type):
* nt.c (Fmswindows_short_file_name):
* nt.c (Fmswindows_long_file_name):
* objects-impl.h (struct Lisp_Color_Instance):
* objects-impl.h (struct Lisp_Font_Instance):
* objects-tty.c:
* objects-x.c (allocate_nearest_color):
* objects.c:
* objects.c (Fmake_color_instance):
* objects.c (Fmake_font_instance):
* objects.c (font_instantiate):
* opaque.c:
* opaque.c (make_opaque):
* opaque.c (make_opaque_ptr):
* opaque.c (reinit_opaque_early):
* opaque.c (init_opaque_once_early):
* print.c:
* print.c (printing_badness):
* print.c (printing_major_badness):
* print.c (print_internal):
* print.c (debug_p4):
* print.c (dp):
* print.c (debug_backtrace):
* process-nt.c (nt_create_process):
* process-nt.c (get_internet_address):
* process-unix.c:
* process-unix.c (struct unix_process_data):
* process-unix.c (get_internet_address):
* process-unix.c (unix_alloc_process_data):
* process-unix.c (unix_create_process):
* process-unix.c (try_to_initialize_subtty):
* process-unix.c (unix_kill_child_process):
* process-unix.c (process_type_create_unix):
* process.c:
* process.c (mark_process):
* process.c (MARKED_SLOT):
* process.c (make_process_internal):
* process.c (Fprocess_tty_name):
* process.c (decode_signal):
* process.h:
* procimpl.h:
* procimpl.h (struct process_methods):
* procimpl.h (struct Lisp_Process):
* rangetab.c:
* realpath.c (readlink_and_correct_case):
* redisplay-x.c (x_window_output_end):
* redisplay-x.c (x_redraw_exposed_area):
* redisplay-x.c (x_clear_frame):
* redisplay.c:
* redisplay.h:
* redisplay.h (struct rune_dglyph):
* redisplay.h (struct rune):
* scrollbar.c:
* scrollbar.c (create_scrollbar_instance):
* specifier.c:
* specifier.c (specifier_empty_extra_description_1):
* specifier.c (make_specifier_internal):
* specifier.c (decode_locale_type):
* specifier.c (decode_how_to_add_specification):
* specifier.h:
* specifier.h (struct specifier_methods):
* specifier.h (DEFINE_SPECIFIER_TYPE_WITH_DATA):
* specifier.h (INITIALIZE_SPECIFIER_TYPE_WITH_DATA):
* symbols.c:
* symbols.c (Fsetplist):
* symbols.c (default_value):
* symbols.c (decode_magic_handler_type):
* symbols.c (handler_type_from_function_symbol):
* symbols.c (Fdefvaralias):
* symbols.c (init_symbols_once_early):
* symbols.c (reinit_symbols_early):
* symsinit.h:
* sysdep.c (sys_subshell):
* sysdep.c (tty_init_sys_modes_on_device):
* syswindows.h:
* text.c (dfc_convert_to_external_format):
* text.c (dfc_convert_to_internal_format):
* text.c (reinit_eistring_early):
* text.c (init_eistring_once_early):
* text.c (reinit_vars_of_text):
* text.h:
* text.h (INC_IBYTEPTR_FMT):
* text.h (DEC_IBYTEPTR_FMT):
* toolbar.c:
* toolbar.c (decode_toolbar_position):
* tooltalk.c:
* ui-gtk.c:
* unexnt.c:
* unexnt.c (_start):
* unexnt.c (unexec):
* unexnt.c (get_section_info):
* unicode.c:
* unicode.c (vars_of_unicode):
* window.c:
* window.c (allocate_window):
* window.c (new_window_mirror):
* window.c (update_mirror_internal):
* winslots.h:
| author | michaels |
|---|---|
| date | Sun, 12 Jan 2003 11:08:22 +0000 |
| parents | 3136b3c99ceb |
| children | f0af455e89d9 |
line wrap: on
line diff
--- a/src/alloc.c Sun Jan 12 11:04:30 2003 +0000 +++ b/src/alloc.c Sun Jan 12 11:08:22 2003 +0000 @@ -50,9 +50,11 @@ #include "elhash.h" #include "events.h" #include "extents-impl.h" +#include "file-coding.h" #include "frame-impl.h" #include "glyphs.h" #include "opaque.h" +#include "lstream.h" #include "process.h" #include "redisplay.h" #include "specifier.h" @@ -61,18 +63,10 @@ #include "window.h" #include "console-stream.h" -#ifdef USE_KKCC -#include "file-coding.h" -#endif /* USE_KKCC */ - #ifdef DOUG_LEA_MALLOC #include <malloc.h> #endif -#ifdef PDUMP -#include "dumper.h" -#endif - EXFUN (Fgarbage_collect, 0); static void recompute_need_to_garbage_collect (void); @@ -199,6 +193,11 @@ /* Non-zero means we're in the process of doing the dump */ int purify_flag; +/* Non-zero means we're pdumping out or in */ +#ifdef PDUMP +int in_pdump; +#endif + #ifdef ERROR_CHECK_TYPES Error_Behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN, ERROR_ME_DEBUG_WARN; @@ -368,7 +367,7 @@ /* In practice, size will always be a multiple of four. */ while (beefs--) - (*ptr4++) = 0xDEADBEEF; + (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */ } #else /* !ERROR_CHECK_GC */ @@ -412,9 +411,9 @@ /* But we do now (as of 3-27-02) go and zero out the memory. This is a good thing, as it will guarantee we won't get any intermittent bugs - coming from an uninitiated field. The speed loss if unnoticeable, - esp. as the object are not large -- large stuff like buffer text and - redisplay structures and allocated separately. */ + coming from an uninitiated field. The speed loss is unnoticeable, + esp. as the objects are not large -- large stuff like buffer text and + redisplay structures are allocated separately. */ memset (val, 0, size); if (need_to_check_c_alloca) @@ -429,9 +428,13 @@ and free any lcrecord which hasn't been marked. */ static struct lcrecord_header *all_lcrecords; +/* The most basic of the lcrecord allocation functions. Not usually called + directly. Allocates an lrecord not managed by any lcrecord-list, of a + specified size. See lrecord.h. */ + void * -alloc_lcrecord (Bytecount size, - const struct lrecord_implementation *implementation) +basic_alloc_lcrecord (Bytecount size, + const struct lrecord_implementation *implementation) { struct lcrecord_header *lcheader; @@ -510,6 +513,28 @@ } } +/* Bitwise copy all parts of a Lisp object other than the header */ + +void +copy_lisp_object (Lisp_Object dst, Lisp_Object src) +{ + const struct lrecord_implementation *imp = + XRECORD_LHEADER_IMPLEMENTATION (src); + Bytecount size = lisp_object_size (src); + + assert (imp == XRECORD_LHEADER_IMPLEMENTATION (dst)); + assert (size == lisp_object_size (dst)); + + if (imp->basic_p) + memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header), + (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header), + size - sizeof (struct lrecord_header)); + else + memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lcrecord_header), + (char *) XRECORD_LHEADER (src) + sizeof (struct lcrecord_header), + size - sizeof (struct lcrecord_header)); +} + /************************************************************************/ /* Debugger support */ @@ -597,7 +622,7 @@ string_chars_blocks. Furthermore, no one string stretches across two string_chars_blocks. - Vectors are each malloc()ed separately, similar to lcrecords. + Vectors are each malloc()ed separately as lcrecords. In the following discussion, we use conses, but it applies equally well to the other fixed-size types. @@ -786,8 +811,9 @@ MINIMUM_ALLOWED_FIXED_TYPE_CELLS_##type) \ { \ result = (structtype *) type##_free_list; \ - /* Before actually using the chain pointer, \ - we complement all its bits; see FREE_FIXED_TYPE(). */ \ + assert (LRECORD_FREE_P (result)); \ + /* Before actually using the chain pointer, we complement \ + all its bits; see PUT_FIXED_TYPE_ON_FREE_LIST(). */ \ type##_free_list = (Lisp_Free *) \ (~ (EMACS_UINT) (type##_free_list->chain)); \ gc_count_num_##type##_freelist--; \ @@ -882,6 +908,7 @@ #define FREE_FIXED_TYPE(type, structtype, ptr) do { \ structtype *FFT_ptr = (ptr); \ + gc_checking_assert (!LRECORD_FREE_P (FFT_ptr)); \ ADDITIONAL_FREE_##type (FFT_ptr); \ deadbeef_memory (FFT_ptr, sizeof (structtype)); \ PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, FFT_ptr); \ @@ -896,13 +923,20 @@ completely necessary but helps keep things saner: e.g. this way, repeatedly allocating and freeing a cons will not result in the consing-since-gc counter advancing, which would cause a GC - and somewhat defeat the purpose of explicitly freeing. */ - + and somewhat defeat the purpose of explicitly freeing. + + We also disable this mechanism entirely when ALLOC_NO_POOLS is + set, which is used for Purify and the like. */ + +#ifndef ALLOC_NO_POOLS #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) \ do { FREE_FIXED_TYPE (type, structtype, ptr); \ DECREMENT_CONS_COUNTER (sizeof (structtype)); \ gc_count_num_##type##_freelist++; \ } while (0) +#else +#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) +#endif @@ -939,13 +973,12 @@ return 0; } -static const struct lrecord_description cons_description[] = { +static const struct memory_description cons_description[] = { { XD_LISP_OBJECT, offsetof (Lisp_Cons, car_) }, { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr_) }, { XD_END } }; -#ifdef USE_KKCC DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons, 1, /*dumpable-flag*/ mark_cons, print_cons, 0, @@ -958,19 +991,6 @@ 0, cons_description, Lisp_Cons); -#else /* not USE_KKCC */ -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons, - mark_cons, print_cons, 0, - cons_equal, - /* - * No `hash' method needed. - * internal_hash knows how to - * handle conses. - */ - 0, - cons_description, - Lisp_Cons); -#endif /* not USE_KKCC */ DEFUN ("cons", Fcons, 2, 2, 0, /* Create a new cons, give it CAR and CDR as components, and return it. @@ -1168,36 +1188,28 @@ depth + 1)); } -static const struct lrecord_description vector_description[] = { +static const struct memory_description vector_description[] = { { XD_LONG, offsetof (Lisp_Vector, size) }, { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Vector, contents), XD_INDIRECT(0, 0) }, { XD_END } }; -#ifdef USE_KKCC -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("vector", vector, - 1, /*dumpable-flag*/ - mark_vector, print_vector, 0, - vector_equal, - vector_hash, - vector_description, - size_vector, Lisp_Vector); -#else /* not USE_KKCC */ -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("vector", vector, - mark_vector, print_vector, 0, - vector_equal, - vector_hash, - vector_description, - size_vector, Lisp_Vector); -#endif /* not USE_KKCC */ +DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("vector", vector, + 1, /*dumpable-flag*/ + mark_vector, print_vector, 0, + vector_equal, + vector_hash, + vector_description, + size_vector, Lisp_Vector); /* #### should allocate `small' vectors from a frob-block */ static Lisp_Vector * make_vector_internal (Elemcount sizei) { - /* no vector_next */ + /* no `next' field; we use lcrecords */ Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, - contents, sizei); - Lisp_Vector *p = (Lisp_Vector *) alloc_lcrecord (sizem, &lrecord_vector); + contents, sizei); + Lisp_Vector *p = + (Lisp_Vector *) basic_alloc_lcrecord (sizem, &lrecord_vector); p->size = sizei; return p; @@ -1344,27 +1356,19 @@ /* Bit Vector allocation */ /************************************************************************/ -static Lisp_Object all_bit_vectors; - /* #### should allocate `small' bit vectors from a frob-block */ static Lisp_Bit_Vector * make_bit_vector_internal (Elemcount sizei) { + /* no `next' field; we use lcrecords */ Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (sizei); Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, - unsigned long, - bits, num_longs); - Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) allocate_lisp_storage (sizem); - set_lheader_implementation (&p->lheader, &lrecord_bit_vector); - - INCREMENT_CONS_COUNTER (sizem, "bit-vector"); + unsigned long, + bits, num_longs); + Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) + basic_alloc_lcrecord (sizem, &lrecord_bit_vector); bit_vector_length (p) = sizei; - bit_vector_next (p) = all_bit_vectors; - /* make sure the extra bits in the last long are 0; the calling - functions might not set them. */ - p->bits[num_longs - 1] = 0; - all_bit_vectors = wrap_bit_vector (p); return p; } @@ -1690,133 +1694,152 @@ return wrap_event (e); } -#ifdef USE_KKCC +#ifdef EVENT_DATA_AS_OBJECTS DECLARE_FIXED_TYPE_ALLOC (key_data, Lisp_Key_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_key_data 1000 Lisp_Object -allocate_key_data (void) +make_key_data (void) { Lisp_Key_Data *d; ALLOCATE_FIXED_TYPE (key_data, Lisp_Key_Data, d); + xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_key_data); - - return wrap_key_data(d); + d->keysym = Qnil; + + return wrap_key_data (d); } DECLARE_FIXED_TYPE_ALLOC (button_data, Lisp_Button_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_button_data 1000 Lisp_Object -allocate_button_data (void) +make_button_data (void) { Lisp_Button_Data *d; ALLOCATE_FIXED_TYPE (button_data, Lisp_Button_Data, d); + xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_button_data); - return wrap_button_data(d); + return wrap_button_data (d); } DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_motion_data 1000 Lisp_Object -allocate_motion_data (void) +make_motion_data (void) { Lisp_Motion_Data *d; ALLOCATE_FIXED_TYPE (motion_data, Lisp_Motion_Data, d); + xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_motion_data); - return wrap_motion_data(d); + return wrap_motion_data (d); } DECLARE_FIXED_TYPE_ALLOC (process_data, Lisp_Process_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_process_data 1000 Lisp_Object -allocate_process_data (void) +make_process_data (void) { Lisp_Process_Data *d; ALLOCATE_FIXED_TYPE (process_data, Lisp_Process_Data, d); + xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_process_data); - - return wrap_process_data(d); + d->process = Qnil; + + return wrap_process_data (d); } DECLARE_FIXED_TYPE_ALLOC (timeout_data, Lisp_Timeout_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_timeout_data 1000 Lisp_Object -allocate_timeout_data (void) +make_timeout_data (void) { Lisp_Timeout_Data *d; ALLOCATE_FIXED_TYPE (timeout_data, Lisp_Timeout_Data, d); + xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_timeout_data); - - return wrap_timeout_data(d); + d->function = Qnil; + d->object = Qnil; + + return wrap_timeout_data (d); } DECLARE_FIXED_TYPE_ALLOC (magic_data, Lisp_Magic_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_data 1000 Lisp_Object -allocate_magic_data (void) +make_magic_data (void) { Lisp_Magic_Data *d; ALLOCATE_FIXED_TYPE (magic_data, Lisp_Magic_Data, d); + xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_magic_data); - return wrap_magic_data(d); + return wrap_magic_data (d); } DECLARE_FIXED_TYPE_ALLOC (magic_eval_data, Lisp_Magic_Eval_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_eval_data 1000 Lisp_Object -allocate_magic_eval_data (void) +make_magic_eval_data (void) { Lisp_Magic_Eval_Data *d; ALLOCATE_FIXED_TYPE (magic_eval_data, Lisp_Magic_Eval_Data, d); + xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_magic_eval_data); - - return wrap_magic_eval_data(d); + d->object = Qnil; + + return wrap_magic_eval_data (d); } DECLARE_FIXED_TYPE_ALLOC (eval_data, Lisp_Eval_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_eval_data 1000 Lisp_Object -allocate_eval_data (void) +make_eval_data (void) { Lisp_Eval_Data *d; ALLOCATE_FIXED_TYPE (eval_data, Lisp_Eval_Data, d); + xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_eval_data); - - return wrap_eval_data(d); + d->function = Qnil; + d->object = Qnil; + + return wrap_eval_data (d); } DECLARE_FIXED_TYPE_ALLOC (misc_user_data, Lisp_Misc_User_Data); #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_misc_user_data 1000 Lisp_Object -allocate_misc_user_data (void) +make_misc_user_data (void) { Lisp_Misc_User_Data *d; ALLOCATE_FIXED_TYPE (misc_user_data, Lisp_Misc_User_Data, d); + xzero (*d); set_lheader_implementation (&d->lheader, &lrecord_misc_user_data); - - return wrap_misc_user_data(d); + d->function = Qnil; + d->object = Qnil; + + return wrap_misc_user_data (d); } -#endif /* USE_KKCC */ + +#endif /* EVENT_DATA_AS_OBJECTS */ /************************************************************************/ /* Marker allocation */ @@ -1864,9 +1887,9 @@ /* The data for "short" strings generally resides inside of structs of type string_chars_block. The Lisp_String structure is allocated just like any - other Lisp object (except for vectors), and these are freelisted when - they get garbage collected. The data for short strings get compacted, - but the data for large strings do not. + other basic lrecord, and these are freelisted when they get garbage + collected. The data for short strings get compacted, but the data for + large strings do not. Previously Lisp_String structures were relocated, but this caused a lot of bus-errors because the C code didn't include enough GCPRO's for @@ -1896,7 +1919,7 @@ !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len)); } -static const struct lrecord_description string_description[] = { +static const struct memory_description string_description[] = { { XD_BYTECOUNT, offsetof (Lisp_String, size_) }, { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data_), XD_INDIRECT(0, 1) }, { XD_LISP_OBJECT, offsetof (Lisp_String, plist) }, @@ -1955,7 +1978,6 @@ is done with the ADDITIONAL_FREE_string macro, which is the standard way to do finalization when using SWEEP_FIXED_TYPE_BLOCK(). */ -#ifdef USE_KKCC DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, 1, /*dumpable-flag*/ mark_string, print_string, @@ -1966,17 +1988,6 @@ string_remprop, string_plist, Lisp_String); -#else /* not USE_KKCC */ -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, - mark_string, print_string, - 0, string_equal, 0, - string_description, - string_getprop, - string_putprop, - string_remprop, - string_plist, - Lisp_String); -#endif /* not USE_KKCC */ /* String blocks contain this many useful bytes. */ #define STRING_CHARS_BLOCK_SIZE \ ((Bytecount) (8192 - MALLOC_OVERHEAD - \ @@ -2484,32 +2495,30 @@ /************************************************************************/ /* Lcrecord lists are used to manage the allocation of particular - sorts of lcrecords, to avoid calling alloc_lcrecord() (and thus + sorts of lcrecords, to avoid calling basic_alloc_lcrecord() (and thus malloc() and garbage-collection junk) as much as possible. It is similar to the Blocktype class. - It works like this: - - 1) Create an lcrecord-list object using make_lcrecord_list(). - This is often done at initialization. Remember to staticpro_nodump - this object! The arguments to make_lcrecord_list() are the - same as would be passed to alloc_lcrecord(). - 2) Instead of calling alloc_lcrecord(), call allocate_managed_lcrecord() - and pass the lcrecord-list earlier created. - 3) When done with the lcrecord, call free_managed_lcrecord(). - The standard freeing caveats apply: ** make sure there are no - pointers to the object anywhere! ** - 4) Calling free_managed_lcrecord() is just like kissing the - lcrecord goodbye as if it were garbage-collected. This means: - -- the contents of the freed lcrecord are undefined, and the - contents of something produced by allocate_managed_lcrecord() - are undefined, just like for alloc_lcrecord(). - -- the mark method for the lcrecord's type will *NEVER* be called - on freed lcrecords. - -- the finalize method for the lcrecord's type will be called - at the time that free_managed_lcrecord() is called. - - */ + See detailed comment in lcrecord.h. +*/ + +const struct memory_description free_description[] = { + { XD_LISP_OBJECT, offsetof (struct free_lcrecord_header, chain), 0, 0, + XD_FLAG_FREE_LISP_OBJECT }, + { XD_END } +}; + +DEFINE_LRECORD_IMPLEMENTATION ("free", free, + 0, /*dumpable-flag*/ + 0, internal_object_printer, + 0, 0, 0, free_description, + struct free_lcrecord_header); + +const struct memory_description lcrecord_list_description[] = { + { XD_LISP_OBJECT, offsetof (struct lcrecord_list, free), 0, 0, + XD_FLAG_FREE_LISP_OBJECT }, + { XD_END } +}; static Lisp_Object mark_lcrecord_list (Lisp_Object obj) @@ -2528,17 +2537,17 @@ ! MARKED_RECORD_HEADER_P (lheader) && /* Only lcrecords should be here. */ - ! LHEADER_IMPLEMENTATION (lheader)->basic_p + ! list->implementation->basic_p && /* Only free lcrecords should be here. */ free_header->lcheader.free && /* The type of the lcrecord must be right. */ - LHEADER_IMPLEMENTATION (lheader) == list->implementation + lheader->type == lrecord_type_free && /* So must the size. */ - (LHEADER_IMPLEMENTATION (lheader)->static_size == 0 || - LHEADER_IMPLEMENTATION (lheader)->static_size == list->size) + (list->implementation->static_size == 0 || + list->implementation->static_size == list->size) ); MARK_RECORD_HEADER (lheader); @@ -2548,25 +2557,21 @@ return Qnil; } -#ifdef USE_KKCC DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list, 0, /*dumpable-flag*/ mark_lcrecord_list, internal_object_printer, - 0, 0, 0, 0, struct lcrecord_list); -#else /* not USE_KKCC */ -DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list, - mark_lcrecord_list, internal_object_printer, - 0, 0, 0, 0, struct lcrecord_list); -#endif /* not USE_KKCC */ + 0, 0, 0, lcrecord_list_description, + struct lcrecord_list); Lisp_Object make_lcrecord_list (Elemcount size, const struct lrecord_implementation *implementation) { - struct lcrecord_list *p = - /* Avoid infinite recursion allocating this */ - alloc_unmanaged_lcrecord_type (struct lcrecord_list, - &lrecord_lcrecord_list); + /* Don't use alloc_lcrecord_type() avoid infinite recursion + allocating this, */ + struct lcrecord_list *p = (struct lcrecord_list *) + basic_alloc_lcrecord (sizeof (struct lcrecord_list), + &lrecord_lcrecord_list); p->implementation = implementation; p->size = size; @@ -2575,7 +2580,7 @@ } Lisp_Object -allocate_managed_lcrecord (Lisp_Object lcrecord_list) +alloc_managed_lcrecord (Lisp_Object lcrecord_list) { struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list); if (!NILP (list->free)) @@ -2583,33 +2588,41 @@ Lisp_Object val = list->free; struct free_lcrecord_header *free_header = (struct free_lcrecord_header *) XPNTR (val); + struct lrecord_header *lheader = &free_header->lcheader.lheader; #ifdef ERROR_CHECK_GC - struct lrecord_header *lheader = &free_header->lcheader.lheader; - + /* Major overkill here. */ /* There should be no other pointers to the free list. */ assert (! MARKED_RECORD_HEADER_P (lheader)); - /* Only lcrecords should be here. */ - assert (! LHEADER_IMPLEMENTATION (lheader)->basic_p); /* Only free lcrecords should be here. */ assert (free_header->lcheader.free); + assert (lheader->type == lrecord_type_free); + /* Only lcrecords should be here. */ + assert (! (list->implementation->basic_p)); +#if 0 /* Not used anymore, now that we set the type of the header to + lrecord_type_free. */ /* The type of the lcrecord must be right. */ assert (LHEADER_IMPLEMENTATION (lheader) == list->implementation); +#endif /* 0 */ /* So must the size. */ - assert (LHEADER_IMPLEMENTATION (lheader)->static_size == 0 || - LHEADER_IMPLEMENTATION (lheader)->static_size == list->size); + assert (list->implementation->static_size == 0 || + list->implementation->static_size == list->size); #endif /* ERROR_CHECK_GC */ list->free = free_header->chain; free_header->lcheader.free = 0; + /* Put back the correct type, as we set it to lrecord_type_free. */ + lheader->type = list->implementation->lrecord_type_index; + zero_sized_lcrecord (free_header, list->size); return val; } else - return wrap_pointer_1 (alloc_lcrecord (list->size, list->implementation)); + return wrap_pointer_1 (basic_alloc_lcrecord (list->size, + list->implementation)); } /* "Free" a Lisp object LCRECORD by placing it on its associated free list - LCRECORD_LIST; next time allocate_managed_lcrecord() is called with the + LCRECORD_LIST; next time alloc_managed_lcrecord() is called with the same LCRECORD_LIST as its parameter, it will return an object from the free list, which may be this one. Be VERY VERY SURE there are no pointers to this object hanging around anywhere where they might be @@ -2641,15 +2654,18 @@ /* Make sure the size is correct. This will catch, for example, putting a window configuration on the wrong free list. */ - gc_checking_assert ((implementation->size_in_bytes_method ? - implementation->size_in_bytes_method (lheader) : - implementation->static_size) - == list->size); + gc_checking_assert (detagged_lisp_object_size (lheader) == list->size); /* Make sure the object isn't already freed. */ gc_checking_assert (!free_header->lcheader.free); if (implementation->finalizer) implementation->finalizer (lheader, 0); + /* Yes, there are two ways to indicate freeness -- the type is + lrecord_type_free or the ->free flag is set. We used to do only the + latter; now we do the former as well for KKCC purposes. Probably + safer in any case, as we will lose quicker this way than keeping + around an lrecord of apparently correct type but bogus junk in it. */ + MARK_LRECORD_AS_FREE (lheader); free_header->chain = list->free; free_header->lcheader.free = 1; list->free = lcrecord; @@ -2665,7 +2681,7 @@ all_lcrecord_lists[imp->lrecord_type_index] = make_lcrecord_list (size, imp); - return XPNTR (allocate_managed_lcrecord + return XPNTR (alloc_managed_lcrecord (all_lcrecord_lists[imp->lrecord_type_index])); } @@ -2716,43 +2732,46 @@ objects, which are global variables like Qfoo or Vbar, themselves are pointers to heap objects. Each needs to be described to pdump as a "root pointer"; this happens in the call to staticpro(). */ -static const struct lrecord_description staticpro_description_1[] = { +static const struct memory_description staticpro_description_1[] = { { XD_END } }; -static const struct struct_description staticpro_description = { +static const struct sized_memory_description staticpro_description = { sizeof (Lisp_Object *), staticpro_description_1 }; -static const struct lrecord_description staticpros_description_1[] = { +static const struct memory_description staticpros_description_1[] = { XD_DYNARR_DESC (Lisp_Object_ptr_dynarr, &staticpro_description), { XD_END } }; -static const struct struct_description staticpros_description = { +static const struct sized_memory_description staticpros_description = { sizeof (Lisp_Object_ptr_dynarr), staticpros_description_1 }; #ifdef DEBUG_XEMACS -static const struct lrecord_description staticpro_one_name_description_1[] = { +static const struct memory_description staticpro_one_name_description_1[] = { { XD_C_STRING, 0 }, { XD_END } }; -static const struct struct_description staticpro_one_name_description = { +static const struct sized_memory_description staticpro_one_name_description = { sizeof (char *), staticpro_one_name_description_1 }; -static const struct lrecord_description staticpro_names_description_1[] = { +static const struct memory_description staticpro_names_description_1[] = { XD_DYNARR_DESC (char_ptr_dynarr, &staticpro_one_name_description), { XD_END } }; -static const struct struct_description staticpro_names_description = { + +extern const struct sized_memory_description staticpro_names_description; + +const struct sized_memory_description staticpro_names_description = { sizeof (char_ptr_dynarr), staticpro_names_description_1 }; @@ -2769,7 +2788,7 @@ { Dynarr_add (staticpros, varaddress); Dynarr_add (staticpro_names, varname); - dump_add_root_object (varaddress); + dump_add_root_lisp_object (varaddress); } @@ -2806,7 +2825,7 @@ staticpro (Lisp_Object *varaddress) { Dynarr_add (staticpros, varaddress); - dump_add_root_object (varaddress); + dump_add_root_lisp_object (varaddress); } @@ -2861,23 +2880,24 @@ #endif - -#ifdef USE_KKCC -/* The following functions implement the new mark algorithm. - They mark objects according to their descriptions. They - are modeled on the corresponding pdumper procedures. */ - -static void mark_struct_contents (const void *data, - const struct struct_description * - sdesc, - int count); +static const struct memory_description lisp_object_description_1[] = { + { XD_LISP_OBJECT, 0 }, + { XD_END } +}; + +const struct sized_memory_description lisp_object_description = { + sizeof (Lisp_Object), + lisp_object_description_1 +}; + +#if defined (USE_KKCC) || defined (PDUMP) /* This function extracts the value of a count variable described somewhere else in the description. It is converted corresponding to the type */ -static EMACS_INT -get_indirect_count (EMACS_INT code, - const struct lrecord_description *idesc, - const void *idata) +EMACS_INT +lispdesc_indirect_count_1 (EMACS_INT code, + const struct memory_description *idesc, + const void *idata) { EMACS_INT count; const void *irdata; @@ -2885,27 +2905,32 @@ int line = XD_INDIRECT_VAL (code); int delta = XD_INDIRECT_DELTA (code); - irdata = ((char *)idata) + idesc[line].offset; + irdata = ((char *) idata) + + lispdesc_indirect_count (idesc[line].offset, idesc, idata); switch (idesc[line].type) { case XD_BYTECOUNT: - count = *(Bytecount *)irdata; + count = * (Bytecount *) irdata; break; case XD_ELEMCOUNT: - count = *(Elemcount *)irdata; + count = * (Elemcount *) irdata; break; case XD_HASHCODE: - count = *(Hashcode *)irdata; + count = * (Hashcode *) irdata; break; case XD_INT: - count = *(int *)irdata; + count = * (int *) irdata; break; case XD_LONG: - count = *(long *)irdata; + count = * (long *) irdata; break; default: stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n", - idesc[line].type, line, (long)code); + idesc[line].type, line, (long) code); +#ifdef PDUMP + if (in_pdump) + pdump_backtrace (); +#endif count = 0; /* warning suppression */ abort (); } @@ -2913,159 +2938,155 @@ return count; } -/* This function is called to mark the elements of an object. It processes - the description of the object and calls mark object with every described - object. */ -static void -mark_with_description (const void *lheader, const struct lrecord_description *desc) +/* SDESC is a "description map" (basically, a list of offsets used for + successive indirections) and OBJ is the first object to indirect off of. + Return the description ultimately found. */ + +const struct sized_memory_description * +lispdesc_indirect_description_1 (const void *obj, + const struct sized_memory_description *sdesc) { int pos; - static const Lisp_Object *last_occured_object = (Lisp_Object *) 0; - static int mark_last_occured_object = 0; - - reprocess_desc: - for (pos=0; desc[pos].type != XD_END; pos++) + for (pos = 0; sdesc[pos].size >= 0; pos++) + obj = * (const void **) ((const char *) obj + sdesc[pos].size); + + return (const struct sized_memory_description *) obj; +} + +/* Compute the size of the data at RDATA, described by a single entry + DESC1 in a description array. OBJ and DESC are used for + XD_INDIRECT references. */ + +static Bytecount +lispdesc_one_description_line_size (void *rdata, + const struct memory_description *desc1, + const void *obj, + const struct memory_description *desc) +{ + union_switcheroo: + switch (desc1->type) { - const void *rdata = (const char *)lheader + desc[pos].offset; - switch (desc[pos].type) { - case XD_LISP_OBJECT: - { - const Lisp_Object *stored_obj = (const Lisp_Object *)rdata; - - if (EQ (*stored_obj, Qnull_pointer)) + case XD_LISP_OBJECT_ARRAY: + { + EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); + return (val * sizeof (Lisp_Object)); + } + case XD_LISP_OBJECT: + case XD_LO_LINK: + return sizeof (Lisp_Object); + case XD_OPAQUE_PTR: + return sizeof (void *); + case XD_STRUCT_PTR: + { + EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); + return val * sizeof (void *); + } + case XD_STRUCT_ARRAY: + { + EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); + + return (val * + lispdesc_structure_size + (rdata, lispdesc_indirect_description (obj, desc1->data2))); + } + case XD_OPAQUE_DATA_PTR: + return sizeof (void *); + case XD_UNION_DYNAMIC_SIZE: + { + /* If an explicit size was given in the first-level structure + description, use it; else compute size based on current union + constant. */ + const struct sized_memory_description *sdesc = + lispdesc_indirect_description (obj, desc1->data2); + if (sdesc->size) + return sdesc->size; + else + { + desc1 = lispdesc_process_xd_union (desc1, desc, obj); + if (desc1) + goto union_switcheroo; break; - - if (desc[pos+1].type == XD_END) - { - mark_last_occured_object = 1; - last_occured_object = stored_obj; - break; - } - else - { - mark_object (*stored_obj); - } - - - break; - } - case XD_LISP_OBJECT_ARRAY: - { - int i; - EMACS_INT count = desc[pos].data1; - if (XD_IS_INDIRECT (count)) - count = get_indirect_count (count, desc, lheader); - - for (i = 0; i < count; i++) - { - const Lisp_Object *stored_obj = ((const Lisp_Object *)rdata) + i; - - if (EQ (*stored_obj, Qnull_pointer)) - break; - - mark_object (*stored_obj); - } - break; - } - case XD_SPECIFIER_END: - desc = ((const Lisp_Specifier *)lheader)->methods->extra_description; - goto reprocess_desc; - break; - case XD_CODING_SYSTEM_END: - desc = ((const Lisp_Coding_System *)lheader)->methods->extra_description; - goto reprocess_desc; - break; - case XD_BYTECOUNT: - break; - case XD_ELEMCOUNT: - break; - case XD_HASHCODE: - break; - case XD_INT: - break; - case XD_LONG: - break; - case XD_INT_RESET: - break; - case XD_LO_LINK: - break; - case XD_OPAQUE_PTR: - break; - case XD_OPAQUE_DATA_PTR: - break; - case XD_C_STRING: - break; - case XD_DOC_STRING: - break; - case XD_STRUCT_PTR: - { - EMACS_INT count = desc[pos].data1; - const struct struct_description *sdesc = desc[pos].data2; - const char *dobj = *(const char **)rdata; - if (dobj) - { - if (XD_IS_INDIRECT (count)) - count = get_indirect_count (count, desc, lheader); - mark_struct_contents (dobj, sdesc, count); - } - break; - } - case XD_STRUCT_ARRAY: - { - EMACS_INT count = desc[pos].data1; - const struct struct_description *sdesc = desc[pos].data2; - - if (XD_IS_INDIRECT (count)) - count = get_indirect_count (count, desc, lheader); - - mark_struct_contents (rdata, sdesc, count); - break; - } - case XD_UNION: - { - int count = 0; - int variant = desc[pos].data1; - const struct struct_description *sdesc = desc[pos].data2; - const char *dobj = *(const char **)rdata; - if (XD_IS_INDIRECT (variant)) - variant = get_indirect_count (variant, desc, lheader); - - for (count=0; sdesc[count].size != XD_END; count++) - { - if (sdesc[count].size == variant) - { - mark_with_description(dobj, sdesc[count].description); - break; - } - } - break; - } - - default: - stderr_out ("Unsupported description type : %d\n", desc[pos].type); - abort (); + } + } + case XD_UNION: + { + /* If an explicit size was given in the first-level structure + description, use it; else compute size based on maximum of all + possible structures. */ + const struct sized_memory_description *sdesc = + lispdesc_indirect_description (obj, desc1->data2); + if (sdesc->size) + return sdesc->size; + else + { + int count; + Bytecount max_size = -1, size; + + desc1 = sdesc->description; + + for (count = 0; desc1[count].type != XD_END; count++) + { + size = lispdesc_one_description_line_size (rdata, + &desc1[count], + obj, desc); + if (size > max_size) + max_size = size; + } + return max_size; + } } + case XD_C_STRING: + return sizeof (void *); + case XD_DOC_STRING: + return sizeof (void *); + case XD_INT_RESET: + return sizeof (int); + case XD_BYTECOUNT: + return sizeof (Bytecount); + case XD_ELEMCOUNT: + return sizeof (Elemcount); + case XD_HASHCODE: + return sizeof (Hashcode); + case XD_INT: + return sizeof (int); + case XD_LONG: + return sizeof (long); + default: + stderr_out ("Unsupported dump type : %d\n", desc1->type); + abort (); } - if (mark_last_occured_object) - { - mark_object(*last_occured_object); - mark_last_occured_object = 0; - } + return 0; } -/* This function calculates the size of a described struct. */ -static Bytecount -structure_size (const void *obj, const struct struct_description *sdesc) +/* Return the size of the memory block (NOT necessarily a structure!) + described by SDESC and pointed to by OBJ. If SDESC records an + explicit size (i.e. non-zero), it is simply returned; otherwise, + the size is calculated by the maximum offset and the size of the + object at that offset, rounded up to the maximum alignment. In + this case, we may need the object, for example when retrieving an + "indirect count" of an inlined array (the count is not constant, + but is specified by one of the elements of the memory block). (It + is generally not a problem if we return an overly large size -- we + will simply end up reserving more space than necessary; but if the + size is too small we could be in serious trouble, in particular + with nested inlined structures, where there may be alignment + padding in the middle of a block. #### In fact there is an (at + least theoretical) problem with an overly large size -- we may + trigger a protection fault when reading from invalid memory. We + need to handle this -- perhaps in a stupid but dependable way, + i.e. by trapping SIGSEGV and SIGBUS.) */ + +Bytecount +lispdesc_structure_size (const void *obj, + const struct sized_memory_description *sdesc) { - int max_offset = -1; + EMACS_INT max_offset = -1; int max_offset_pos = -1; - int size_at_max = 0; int pos; - const struct lrecord_description *desc; - void *rdata; + const struct memory_description *desc; if (sdesc->size) return sdesc->size; @@ -3074,14 +3095,15 @@ for (pos = 0; desc[pos].type != XD_END; pos++) { - if (desc[pos].offset == max_offset) + EMACS_INT offset = lispdesc_indirect_count (desc[pos].offset, desc, obj); + if (offset == max_offset) { stderr_out ("Two relocatable elements at same offset?\n"); abort (); } - else if (desc[pos].offset > max_offset) + else if (offset > max_offset) { - max_offset = desc[pos].offset; + max_offset = offset; max_offset_pos = pos; } } @@ -3089,102 +3111,188 @@ if (max_offset_pos < 0) return 0; - pos = max_offset_pos; - rdata = (char *) obj + desc[pos].offset; - - switch (desc[pos].type) + { + Bytecount size_at_max; + size_at_max = + lispdesc_one_description_line_size ((char *) obj + max_offset, + &desc[max_offset_pos], obj, desc); + + /* We have no way of knowing the required alignment for this structure, + so just make it maximally aligned. */ + return MAX_ALIGN_SIZE (max_offset + size_at_max); + } +} + +#endif /* defined (USE_KKCC) || defined (PDUMP) */ + +#ifdef USE_KKCC +/* The following functions implement the new mark algorithm. + They mark objects according to their descriptions. They + are modeled on the corresponding pdumper procedures. */ + +static void mark_struct_contents (const void *data, + const struct sized_memory_description *sdesc, + int count); + + +#ifdef ERROR_CHECK_GC +void +mark_object_maybe_checking_free (Lisp_Object obj, int allow_free) +{ + + if (!allow_free && XTYPE (obj) == Lisp_Type_Record) + { + struct lrecord_header *lheader = XRECORD_LHEADER (obj); + gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || + ! ((struct lcrecord_header *) lheader)->free); + } + mark_object (obj); +} +#else +#define mark_object_maybe_checking_free (obj, allow_free) mark_object (obj) +#endif /* ERROR_CHECK_GC */ + +/* This function is called to mark the elements of an object. It processes + the description of the object and calls mark object with every described + object. */ +static void +mark_with_description (const void *data, + const struct memory_description *desc) +{ + int pos; + static const Lisp_Object *last_occurred_object = (Lisp_Object *) 0; + static int mark_last_occurred_object = 0; +#ifdef ERROR_CHECK_GC + static int last_occurred_flags; +#endif + + for (pos = 0; desc[pos].type != XD_END; pos++) { - case XD_LISP_OBJECT_ARRAY: - { - EMACS_INT val = desc[pos].data1; - if (XD_IS_INDIRECT (val)) - val = get_indirect_count (val, desc, obj); - size_at_max = val * sizeof (Lisp_Object); - break; - } - case XD_LISP_OBJECT: - case XD_LO_LINK: - size_at_max = sizeof (Lisp_Object); - break; - case XD_OPAQUE_PTR: - size_at_max = sizeof (void *); - break; - case XD_STRUCT_PTR: - { - EMACS_INT val = desc[pos].data1; - if (XD_IS_INDIRECT (val)) - val = get_indirect_count (val, desc, obj); - size_at_max = val * sizeof (void *); - break; - } - break; - case XD_STRUCT_ARRAY: - { - EMACS_INT val = desc[pos].data1; - - if (XD_IS_INDIRECT (val)) - val = get_indirect_count (val, desc, obj); - - size_at_max = val * structure_size (rdata, desc[pos].data2); - break; - } - break; - case XD_OPAQUE_DATA_PTR: - size_at_max = sizeof (void *); - break; - case XD_UNION: - abort (); - break; - case XD_C_STRING: - size_at_max = sizeof (void *); - break; - case XD_DOC_STRING: - size_at_max = sizeof (void *); - break; - case XD_INT_RESET: - size_at_max = sizeof (int); - break; - case XD_BYTECOUNT: - size_at_max = sizeof (Bytecount); - break; - case XD_ELEMCOUNT: - size_at_max = sizeof (Elemcount); - break; - case XD_HASHCODE: - size_at_max = sizeof (Hashcode); - break; - case XD_INT: - size_at_max = sizeof (int); - break; - case XD_LONG: - size_at_max = sizeof (long); - break; - case XD_SPECIFIER_END: - case XD_CODING_SYSTEM_END: - stderr_out - ("Should not be seeing XD_SPECIFIER_END or\n" - "XD_CODING_SYSTEM_END outside of struct Lisp_Specifier\n" - "and struct Lisp_Coding_System.\n"); - abort (); - default: - stderr_out ("Unsupported dump type : %d\n", desc[pos].type); - abort (); + const struct memory_description *desc1 = &desc[pos]; + const void *rdata = + (const char *) data + lispdesc_indirect_count (desc1->offset, + desc, data); + union_switcheroo: + + /* If the flag says don't mark, then don't mark. */ + if ((desc1->flags) & XD_FLAG_NO_KKCC) + continue; + + switch (desc1->type) + { + case XD_BYTECOUNT: + case XD_ELEMCOUNT: + case XD_HASHCODE: + case XD_INT: + case XD_LONG: + case XD_INT_RESET: + case XD_LO_LINK: + case XD_OPAQUE_PTR: + case XD_OPAQUE_DATA_PTR: + case XD_C_STRING: + case XD_DOC_STRING: + break; + case XD_LISP_OBJECT: + { + const Lisp_Object *stored_obj = (const Lisp_Object *) rdata; + + /* Because of the way that tagged objects work (pointers and + Lisp_Objects have the same representation), XD_LISP_OBJECT + can be used for untagged pointers. They might be NULL, + though. */ + if (EQ (*stored_obj, Qnull_pointer)) + break; + + if (desc[pos+1].type == XD_END) + { + mark_last_occurred_object = 1; + last_occurred_object = stored_obj; +#ifdef ERROR_CHECK_GC + last_occurred_flags = desc1->flags; +#endif + break; + } + else + mark_object_maybe_checking_free + (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT); + + break; + } + case XD_LISP_OBJECT_ARRAY: + { + int i; + EMACS_INT count = + lispdesc_indirect_count (desc1->data1, desc, data); + + for (i = 0; i < count; i++) + { + const Lisp_Object *stored_obj = + (const Lisp_Object *) rdata + i; + + if (EQ (*stored_obj, Qnull_pointer)) + break; + + mark_object_maybe_checking_free + (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT); + } + break; + } + case XD_STRUCT_PTR: + { + EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, + data); + const struct sized_memory_description *sdesc = + lispdesc_indirect_description (data, desc1->data2); + const char *dobj = * (const char **) rdata; + if (dobj) + mark_struct_contents (dobj, sdesc, count); + break; + } + case XD_STRUCT_ARRAY: + { + EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, + data); + const struct sized_memory_description *sdesc = + lispdesc_indirect_description (data, desc1->data2); + + mark_struct_contents (rdata, sdesc, count); + break; + } + case XD_UNION: + case XD_UNION_DYNAMIC_SIZE: + desc1 = lispdesc_process_xd_union (desc1, desc, data); + if (desc1) + goto union_switcheroo; + break; + + default: + stderr_out ("Unsupported description type : %d\n", desc1->type); + abort (); + } } - return ALIGN_SIZE (max_offset + size_at_max, ALIGNOF (max_align_t)); + if (mark_last_occurred_object) + { + /* NOTE: The second parameter isn't even evaluated + non-ERROR_CHECK_GC, so it's OK for the variable not to exist. + */ + mark_object_maybe_checking_free (*last_occurred_object, + last_occurred_flags & + XD_FLAG_FREE_LISP_OBJECT); + mark_last_occurred_object = 0; + } } - /* This function loops all elements of a struct pointer and calls mark_with_description with each element. */ static void mark_struct_contents (const void *data, - const struct struct_description *sdesc, - int count) + const struct sized_memory_description *sdesc, + int count) { int i; Bytecount elsize; - elsize = structure_size (data, sdesc); + elsize = lispdesc_structure_size (data, sdesc); for (i = 0; i < count; i++) { @@ -3211,15 +3319,15 @@ if (XTYPE (obj) == Lisp_Type_Record) { struct lrecord_header *lheader = XRECORD_LHEADER (obj); -#ifdef USE_KKCC - const struct lrecord_implementation *imp; - const struct lrecord_description *desc; -#endif /* USE_KKCC */ GC_CHECK_LHEADER_INVARIANTS (lheader); +#ifndef USE_KKCC + /* We handle this separately, above, so we can mark free objects */ gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || ! ((struct lcrecord_header *) lheader)->free); +#endif /* not USE_KKCC */ + /* All c_readonly objects have their mark bit set, so that we only need to check the mark bit here. */ @@ -3227,60 +3335,35 @@ { MARK_RECORD_HEADER (lheader); + { #ifdef USE_KKCC - imp = LHEADER_IMPLEMENTATION (lheader); - desc = imp->description; - - if (desc) /* && !CONSP(obj))*/ /* KKCC cons special case */ - { - mark_with_description (lheader, desc); - } + const struct lrecord_implementation *imp; + const struct memory_description *desc; + + imp = LHEADER_IMPLEMENTATION (lheader); + desc = imp->description; - else - { - + if (desc) /* && !CONSP(obj))*/ /* KKCC cons special case */ + { + mark_with_description (lheader, desc); + } + else #endif /* USE_KKCC */ - - - if (RECORD_MARKER (lheader)) - { - obj = RECORD_MARKER (lheader) (obj); - if (!NILP (obj)) goto tail_recurse; - } - -#ifdef USE_KKCC - } -#endif /* USE_KKCC */ + { + if (RECORD_MARKER (lheader)) + { + obj = RECORD_MARKER (lheader) (obj); + if (!NILP (obj)) goto tail_recurse; + } + } + } } } } -/* mark all of the conses in a list and mark the final cdr; but - DO NOT mark the cars. - - Use only for internal lists! There should never be other pointers - to the cons cells, because if so, the cars will remain unmarked - even when they maybe should be marked. */ -void -mark_conses_in_list (Lisp_Object obj) -{ - Lisp_Object rest; - - for (rest = obj; CONSP (rest); rest = XCDR (rest)) - { - if (CONS_MARKED_P (XCONS (rest))) - return; - MARK_CONS (XCONS (rest)); - } - - mark_object (rest); -} - /* Find all structures not marked, and free them. */ -static int gc_count_num_bit_vector_used, gc_count_bit_vector_total_size; -static int gc_count_bit_vector_storage; static int gc_count_num_short_string_in_use; static Bytecount gc_count_string_total_size; static Bytecount gc_count_short_string_total_size; @@ -3312,12 +3395,8 @@ } else { - const struct lrecord_implementation *implementation = - LHEADER_IMPLEMENTATION (h); - - Bytecount sz = (implementation->size_in_bytes_method ? - implementation->size_in_bytes_method (h) : - implementation->static_size); + Bytecount sz = detagged_lisp_object_size (h); + if (free_p) { lcrecord_stats[type_index].instances_freed++; @@ -3393,49 +3472,6 @@ /* *total = total_size; */ } - -static void -sweep_bit_vectors_1 (Lisp_Object *prev, - int *used, int *total, int *storage) -{ - Lisp_Object bit_vector; - int num_used = 0; - int total_size = 0; - int total_storage = 0; - - /* BIT_VECTORP fails because the objects are marked, which changes - their implementation */ - for (bit_vector = *prev; !EQ (bit_vector, Qzero); ) - { - Lisp_Bit_Vector *v = XBIT_VECTOR (bit_vector); - int len = v->size; - if (MARKED_RECORD_P (bit_vector)) - { - if (! C_READONLY_RECORD_HEADER_P(&(v->lheader))) - UNMARK_RECORD_HEADER (&(v->lheader)); - total_size += len; - total_storage += - MALLOC_OVERHEAD + - FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, - bits, BIT_VECTOR_LONG_STORAGE (len)); - num_used++; - /* #### May modify next on a C_READONLY bitvector */ - prev = &(bit_vector_next (v)); - bit_vector = *prev; - } - else - { - Lisp_Object next = bit_vector_next (v); - *prev = next; - xfree (v); - bit_vector = next; - } - } - *used = num_used; - *total = total_size; - *storage = total_storage; -} - /* And the Lord said: Thou shalt use the `c-backslash-region' command to make macros prettier. */ @@ -3594,14 +3630,16 @@ placed on the free list, however, its car will probably contain a chain pointer to the next cons on the list, which has cleverly had all its 0's and 1's inverted. This allows for a quick - check to make sure we're not freeing something already freed. */ + check to make sure we're not freeing something already freed. + + NOTE: This check may not be necessary. Freeing an object sets its + type to lrecord_type_free, which will trip up the XCONS() above -- as + well as a check in FREE_FIXED_TYPE(). */ if (POINTER_TYPE_P (XTYPE (cons_car (ptr)))) ASSERT_VALID_POINTER (XPNTR (cons_car (ptr))); #endif /* ERROR_CHECK_GC */ -#ifndef ALLOC_NO_POOLS FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, Lisp_Cons, ptr); -#endif /* ALLOC_NO_POOLS */ } /* explicitly free a list. You **must make sure** that you have @@ -3685,7 +3723,7 @@ SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event); } -#ifdef USE_KKCC +#ifdef EVENT_DATA_AS_OBJECTS static void sweep_key_data (void) @@ -3696,6 +3734,12 @@ SWEEP_FIXED_TYPE_BLOCK (key_data, Lisp_Key_Data); } +void +free_key_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (key_data, Lisp_Key_Data, XKEY_DATA (ptr)); +} + static void sweep_button_data (void) { @@ -3705,6 +3749,12 @@ SWEEP_FIXED_TYPE_BLOCK (button_data, Lisp_Button_Data); } +void +free_button_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (button_data, Lisp_Button_Data, XBUTTON_DATA (ptr)); +} + static void sweep_motion_data (void) { @@ -3714,6 +3764,12 @@ SWEEP_FIXED_TYPE_BLOCK (motion_data, Lisp_Motion_Data); } +void +free_motion_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (motion_data, Lisp_Motion_Data, XMOTION_DATA (ptr)); +} + static void sweep_process_data (void) { @@ -3723,6 +3779,12 @@ SWEEP_FIXED_TYPE_BLOCK (process_data, Lisp_Process_Data); } +void +free_process_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (process_data, Lisp_Process_Data, XPROCESS_DATA (ptr)); +} + static void sweep_timeout_data (void) { @@ -3732,6 +3794,12 @@ SWEEP_FIXED_TYPE_BLOCK (timeout_data, Lisp_Timeout_Data); } +void +free_timeout_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (timeout_data, Lisp_Timeout_Data, XTIMEOUT_DATA (ptr)); +} + static void sweep_magic_data (void) { @@ -3741,6 +3809,12 @@ SWEEP_FIXED_TYPE_BLOCK (magic_data, Lisp_Magic_Data); } +void +free_magic_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_data, Lisp_Magic_Data, XMAGIC_DATA (ptr)); +} + static void sweep_magic_eval_data (void) { @@ -3750,6 +3824,12 @@ SWEEP_FIXED_TYPE_BLOCK (magic_eval_data, Lisp_Magic_Eval_Data); } +void +free_magic_eval_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_eval_data, Lisp_Magic_Eval_Data, XMAGIC_EVAL_DATA (ptr)); +} + static void sweep_eval_data (void) { @@ -3759,6 +3839,12 @@ SWEEP_FIXED_TYPE_BLOCK (eval_data, Lisp_Eval_Data); } +void +free_eval_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (eval_data, Lisp_Eval_Data, XEVAL_DATA (ptr)); +} + static void sweep_misc_user_data (void) { @@ -3768,7 +3854,13 @@ SWEEP_FIXED_TYPE_BLOCK (misc_user_data, Lisp_Misc_User_Data); } -#endif /* USE_KKCC */ +void +free_misc_user_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (misc_user_data, Lisp_Misc_User_Data, XMISC_USER_DATA (ptr)); +} + +#endif /* EVENT_DATA_AS_OBJECTS */ static void sweep_markers (void) @@ -3785,14 +3877,9 @@ /* Explicitly free a marker. */ void -free_marker (Lisp_Marker *ptr) +free_marker (Lisp_Object ptr) { - /* Perhaps this will catch freeing an already-freed marker. */ - gc_checking_assert (ptr->lheader.type == lrecord_type_marker); - -#ifndef ALLOC_NO_POOLS - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, ptr); -#endif /* ALLOC_NO_POOLS */ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, XMARKER (ptr)); } @@ -3842,7 +3929,7 @@ } } -#endif /* MULE && ERROR_CHECK_GC */ +#endif /* defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) */ /* Compactify string chars, relocating the reference to each -- free any empty string_chars_block we see. */ @@ -3884,7 +3971,7 @@ } string = from_s_chars->string; - assert (!(LRECORD_FREE_P (string))); + gc_checking_assert (!(LRECORD_FREE_P (string))); size = string->size_; fullsize = STRING_FULLSIZE (size); @@ -4054,12 +4141,6 @@ /* Put all unmarked conses on free list */ sweep_conses (); - /* Free all unmarked bit vectors */ - sweep_bit_vectors_1 (&all_bit_vectors, - &gc_count_num_bit_vector_used, - &gc_count_bit_vector_total_size, - &gc_count_bit_vector_storage); - /* Free all unmarked compiled-function objects */ sweep_compiled_functions (); @@ -4078,7 +4159,7 @@ sweep_events (); -#ifdef USE_KKCC +#ifdef EVENT_DATA_AS_OBJECTS sweep_key_data (); sweep_button_data (); sweep_motion_data (); @@ -4088,7 +4169,7 @@ sweep_magic_eval_data (); sweep_eval_data (); sweep_misc_user_data (); -#endif /* USE_KKCC */ +#endif /* EVENT_DATA_AS_OBJECTS */ #ifdef PDUMP pdump_objects_unmark (); @@ -4356,6 +4437,7 @@ /* #### generalize this? */ clear_event_resource (); cleanup_specifiers (); + cleanup_buffer_undo_lists (); /* Mark all the special slots that serve as the roots of accessibility. */ @@ -4607,11 +4689,6 @@ pl = gc_plist_hack ("compiled-functions-used", gc_count_num_compiled_function_in_use, pl); - pl = gc_plist_hack ("bit-vector-storage", gc_count_bit_vector_storage, pl); - pl = gc_plist_hack ("bit-vectors-total-length", - gc_count_bit_vector_total_size, pl); - pl = gc_plist_hack ("bit-vectors-used", gc_count_num_bit_vector_used, pl); - HACK_O_MATIC (symbol, "symbol-storage", pl); pl = gc_plist_hack ("symbols-free", gc_count_num_symbol_freelist, pl); pl = gc_plist_hack ("symbols-used", gc_count_num_symbol_in_use, pl); @@ -4845,7 +4922,7 @@ /* Initialization */ static void -common_init_alloc_once_early (void) +common_init_alloc_early (void) { #ifndef Qzero Qzero = make_int (0); /* Only used if Lisp_Object is a union type */ @@ -4859,7 +4936,6 @@ gc_generation_number[0] = 0; breathing_space = 0; - all_bit_vectors = Qzero; Vgc_message = Qzero; all_lcrecords = 0; ignore_malloc_warnings = 1; @@ -4879,7 +4955,7 @@ init_marker_alloc (); init_extent_alloc (); init_event_alloc (); -#ifdef USE_KKCC +#ifdef EVENT_DATA_AS_OBJECTS init_key_data_alloc (); init_button_data_alloc (); init_motion_data_alloc (); @@ -4889,7 +4965,7 @@ init_magic_eval_data_alloc (); init_eval_data_alloc (); init_misc_user_data_alloc (); -#endif /* USE_KKCC */ +#endif /* EVENT_DATA_AS_OBJECTS */ ignore_malloc_warnings = 0; @@ -4920,7 +4996,6 @@ systems */ lrecord_uid_counter = 259; debug_string_purity = 0; - gcprolist = 0; gc_currently_forbidden = 0; gc_hooks_inhibited = 0; @@ -4952,16 +5027,31 @@ } void -reinit_alloc_once_early (void) +init_alloc_early (void) { - common_init_alloc_once_early (); +#if defined (__cplusplus) && defined (ERROR_CHECK_GC) + static struct gcpro initial_gcpro; + + initial_gcpro.next = 0; + initial_gcpro.var = &Qnil; + initial_gcpro.nvars = 1; + gcprolist = &initial_gcpro; +#else + gcprolist = 0; +#endif /* defined (__cplusplus) && defined (ERROR_CHECK_GC) */ +} + +void +reinit_alloc_early (void) +{ + common_init_alloc_early (); init_lcrecord_lists (); } void init_alloc_once_early (void) { - common_init_alloc_once_early (); + common_init_alloc_early (); { int i; @@ -4973,6 +5063,7 @@ INIT_LRECORD_IMPLEMENTATION (vector); INIT_LRECORD_IMPLEMENTATION (string); INIT_LRECORD_IMPLEMENTATION (lcrecord_list); + INIT_LRECORD_IMPLEMENTATION (free); staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *); Dynarr_resize (staticpros, 1410); /* merely a small optimization */ @@ -4987,12 +5078,6 @@ } void -init_alloc_early (void) -{ - gcprolist = 0; -} - -void syms_of_alloc (void) { DEFSYMBOL (Qpre_gc_hook);