Mercurial > hg > xemacs-beta
comparison 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 |
comparison
equal
deleted
inserted
replaced
| 1203:5f2f8dcbfb3e | 1204:e22b0213b713 |
|---|---|
| 48 #include "chartab.h" | 48 #include "chartab.h" |
| 49 #include "device.h" | 49 #include "device.h" |
| 50 #include "elhash.h" | 50 #include "elhash.h" |
| 51 #include "events.h" | 51 #include "events.h" |
| 52 #include "extents-impl.h" | 52 #include "extents-impl.h" |
| 53 #include "file-coding.h" | |
| 53 #include "frame-impl.h" | 54 #include "frame-impl.h" |
| 54 #include "glyphs.h" | 55 #include "glyphs.h" |
| 55 #include "opaque.h" | 56 #include "opaque.h" |
| 57 #include "lstream.h" | |
| 56 #include "process.h" | 58 #include "process.h" |
| 57 #include "redisplay.h" | 59 #include "redisplay.h" |
| 58 #include "specifier.h" | 60 #include "specifier.h" |
| 59 #include "sysfile.h" | 61 #include "sysfile.h" |
| 60 #include "sysdep.h" | 62 #include "sysdep.h" |
| 61 #include "window.h" | 63 #include "window.h" |
| 62 #include "console-stream.h" | 64 #include "console-stream.h" |
| 63 | 65 |
| 64 #ifdef USE_KKCC | |
| 65 #include "file-coding.h" | |
| 66 #endif /* USE_KKCC */ | |
| 67 | |
| 68 #ifdef DOUG_LEA_MALLOC | 66 #ifdef DOUG_LEA_MALLOC |
| 69 #include <malloc.h> | 67 #include <malloc.h> |
| 70 #endif | |
| 71 | |
| 72 #ifdef PDUMP | |
| 73 #include "dumper.h" | |
| 74 #endif | 68 #endif |
| 75 | 69 |
| 76 EXFUN (Fgarbage_collect, 0); | 70 EXFUN (Fgarbage_collect, 0); |
| 77 | 71 |
| 78 static void recompute_need_to_garbage_collect (void); | 72 static void recompute_need_to_garbage_collect (void); |
| 197 Lisp_Object Qgarbage_collecting; | 191 Lisp_Object Qgarbage_collecting; |
| 198 | 192 |
| 199 /* Non-zero means we're in the process of doing the dump */ | 193 /* Non-zero means we're in the process of doing the dump */ |
| 200 int purify_flag; | 194 int purify_flag; |
| 201 | 195 |
| 196 /* Non-zero means we're pdumping out or in */ | |
| 197 #ifdef PDUMP | |
| 198 int in_pdump; | |
| 199 #endif | |
| 200 | |
| 202 #ifdef ERROR_CHECK_TYPES | 201 #ifdef ERROR_CHECK_TYPES |
| 203 | 202 |
| 204 Error_Behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN, ERROR_ME_DEBUG_WARN; | 203 Error_Behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN, ERROR_ME_DEBUG_WARN; |
| 205 | 204 |
| 206 #endif | 205 #endif |
| 366 UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr; | 365 UINT_32_BIT *ptr4 = (UINT_32_BIT *) ptr; |
| 367 Bytecount beefs = size >> 2; | 366 Bytecount beefs = size >> 2; |
| 368 | 367 |
| 369 /* In practice, size will always be a multiple of four. */ | 368 /* In practice, size will always be a multiple of four. */ |
| 370 while (beefs--) | 369 while (beefs--) |
| 371 (*ptr4++) = 0xDEADBEEF; | 370 (*ptr4++) = 0xDEADBEEF; /* -559038737 base 10 */ |
| 372 } | 371 } |
| 373 | 372 |
| 374 #else /* !ERROR_CHECK_GC */ | 373 #else /* !ERROR_CHECK_GC */ |
| 375 | 374 |
| 376 | 375 |
| 410 cons counting. #### (Or perhaps, we should decrement it when an object | 409 cons counting. #### (Or perhaps, we should decrement it when an object |
| 411 get freed?) */ | 410 get freed?) */ |
| 412 | 411 |
| 413 /* But we do now (as of 3-27-02) go and zero out the memory. This is a | 412 /* But we do now (as of 3-27-02) go and zero out the memory. This is a |
| 414 good thing, as it will guarantee we won't get any intermittent bugs | 413 good thing, as it will guarantee we won't get any intermittent bugs |
| 415 coming from an uninitiated field. The speed loss if unnoticeable, | 414 coming from an uninitiated field. The speed loss is unnoticeable, |
| 416 esp. as the object are not large -- large stuff like buffer text and | 415 esp. as the objects are not large -- large stuff like buffer text and |
| 417 redisplay structures and allocated separately. */ | 416 redisplay structures are allocated separately. */ |
| 418 memset (val, 0, size); | 417 memset (val, 0, size); |
| 419 | 418 |
| 420 if (need_to_check_c_alloca) | 419 if (need_to_check_c_alloca) |
| 421 xemacs_c_alloca (0); | 420 xemacs_c_alloca (0); |
| 422 | 421 |
| 427 /* lcrecords are chained together through their "next" field. | 426 /* lcrecords are chained together through their "next" field. |
| 428 After doing the mark phase, GC will walk this linked list | 427 After doing the mark phase, GC will walk this linked list |
| 429 and free any lcrecord which hasn't been marked. */ | 428 and free any lcrecord which hasn't been marked. */ |
| 430 static struct lcrecord_header *all_lcrecords; | 429 static struct lcrecord_header *all_lcrecords; |
| 431 | 430 |
| 431 /* The most basic of the lcrecord allocation functions. Not usually called | |
| 432 directly. Allocates an lrecord not managed by any lcrecord-list, of a | |
| 433 specified size. See lrecord.h. */ | |
| 434 | |
| 432 void * | 435 void * |
| 433 alloc_lcrecord (Bytecount size, | 436 basic_alloc_lcrecord (Bytecount size, |
| 434 const struct lrecord_implementation *implementation) | 437 const struct lrecord_implementation *implementation) |
| 435 { | 438 { |
| 436 struct lcrecord_header *lcheader; | 439 struct lcrecord_header *lcheader; |
| 437 | 440 |
| 438 type_checking_assert | 441 type_checking_assert |
| 439 ((implementation->static_size == 0 ? | 442 ((implementation->static_size == 0 ? |
| 506 { | 509 { |
| 507 if (LHEADER_IMPLEMENTATION (&header->lheader)->finalizer && | 510 if (LHEADER_IMPLEMENTATION (&header->lheader)->finalizer && |
| 508 !header->free) | 511 !header->free) |
| 509 LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1); | 512 LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1); |
| 510 } | 513 } |
| 514 } | |
| 515 | |
| 516 /* Bitwise copy all parts of a Lisp object other than the header */ | |
| 517 | |
| 518 void | |
| 519 copy_lisp_object (Lisp_Object dst, Lisp_Object src) | |
| 520 { | |
| 521 const struct lrecord_implementation *imp = | |
| 522 XRECORD_LHEADER_IMPLEMENTATION (src); | |
| 523 Bytecount size = lisp_object_size (src); | |
| 524 | |
| 525 assert (imp == XRECORD_LHEADER_IMPLEMENTATION (dst)); | |
| 526 assert (size == lisp_object_size (dst)); | |
| 527 | |
| 528 if (imp->basic_p) | |
| 529 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header), | |
| 530 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header), | |
| 531 size - sizeof (struct lrecord_header)); | |
| 532 else | |
| 533 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lcrecord_header), | |
| 534 (char *) XRECORD_LHEADER (src) + sizeof (struct lcrecord_header), | |
| 535 size - sizeof (struct lcrecord_header)); | |
| 511 } | 536 } |
| 512 | 537 |
| 513 | 538 |
| 514 /************************************************************************/ | 539 /************************************************************************/ |
| 515 /* Debugger support */ | 540 /* Debugger support */ |
| 595 a string_chars_block, although something like half as big might | 620 a string_chars_block, although something like half as big might |
| 596 make more sense) are malloc()ed separately and not stored in | 621 make more sense) are malloc()ed separately and not stored in |
| 597 string_chars_blocks. Furthermore, no one string stretches across | 622 string_chars_blocks. Furthermore, no one string stretches across |
| 598 two string_chars_blocks. | 623 two string_chars_blocks. |
| 599 | 624 |
| 600 Vectors are each malloc()ed separately, similar to lcrecords. | 625 Vectors are each malloc()ed separately as lcrecords. |
| 601 | 626 |
| 602 In the following discussion, we use conses, but it applies equally | 627 In the following discussion, we use conses, but it applies equally |
| 603 well to the other fixed-size types. | 628 well to the other fixed-size types. |
| 604 | 629 |
| 605 We store cons cells inside of cons_blocks, allocating a new | 630 We store cons cells inside of cons_blocks, allocating a new |
| 784 #define ALLOCATE_FIXED_TYPE_1(type, structtype, result) do { \ | 809 #define ALLOCATE_FIXED_TYPE_1(type, structtype, result) do { \ |
| 785 if (gc_count_num_##type##_freelist > \ | 810 if (gc_count_num_##type##_freelist > \ |
| 786 MINIMUM_ALLOWED_FIXED_TYPE_CELLS_##type) \ | 811 MINIMUM_ALLOWED_FIXED_TYPE_CELLS_##type) \ |
| 787 { \ | 812 { \ |
| 788 result = (structtype *) type##_free_list; \ | 813 result = (structtype *) type##_free_list; \ |
| 789 /* Before actually using the chain pointer, \ | 814 assert (LRECORD_FREE_P (result)); \ |
| 790 we complement all its bits; see FREE_FIXED_TYPE(). */ \ | 815 /* Before actually using the chain pointer, we complement \ |
| 816 all its bits; see PUT_FIXED_TYPE_ON_FREE_LIST(). */ \ | |
| 791 type##_free_list = (Lisp_Free *) \ | 817 type##_free_list = (Lisp_Free *) \ |
| 792 (~ (EMACS_UINT) (type##_free_list->chain)); \ | 818 (~ (EMACS_UINT) (type##_free_list->chain)); \ |
| 793 gc_count_num_##type##_freelist--; \ | 819 gc_count_num_##type##_freelist--; \ |
| 794 } \ | 820 } \ |
| 795 else \ | 821 else \ |
| 880 | 906 |
| 881 /* TYPE and STRUCTTYPE are the same as in ALLOCATE_FIXED_TYPE(). */ | 907 /* TYPE and STRUCTTYPE are the same as in ALLOCATE_FIXED_TYPE(). */ |
| 882 | 908 |
| 883 #define FREE_FIXED_TYPE(type, structtype, ptr) do { \ | 909 #define FREE_FIXED_TYPE(type, structtype, ptr) do { \ |
| 884 structtype *FFT_ptr = (ptr); \ | 910 structtype *FFT_ptr = (ptr); \ |
| 911 gc_checking_assert (!LRECORD_FREE_P (FFT_ptr)); \ | |
| 885 ADDITIONAL_FREE_##type (FFT_ptr); \ | 912 ADDITIONAL_FREE_##type (FFT_ptr); \ |
| 886 deadbeef_memory (FFT_ptr, sizeof (structtype)); \ | 913 deadbeef_memory (FFT_ptr, sizeof (structtype)); \ |
| 887 PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, FFT_ptr); \ | 914 PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, FFT_ptr); \ |
| 888 MARK_LRECORD_AS_FREE (FFT_ptr); \ | 915 MARK_LRECORD_AS_FREE (FFT_ptr); \ |
| 889 } while (0) | 916 } while (0) |
| 894 We attempt to undo the changes made to the allocation counters | 921 We attempt to undo the changes made to the allocation counters |
| 895 as a result of this structure being allocated. This is not | 922 as a result of this structure being allocated. This is not |
| 896 completely necessary but helps keep things saner: e.g. this way, | 923 completely necessary but helps keep things saner: e.g. this way, |
| 897 repeatedly allocating and freeing a cons will not result in | 924 repeatedly allocating and freeing a cons will not result in |
| 898 the consing-since-gc counter advancing, which would cause a GC | 925 the consing-since-gc counter advancing, which would cause a GC |
| 899 and somewhat defeat the purpose of explicitly freeing. */ | 926 and somewhat defeat the purpose of explicitly freeing. |
| 900 | 927 |
| 928 We also disable this mechanism entirely when ALLOC_NO_POOLS is | |
| 929 set, which is used for Purify and the like. */ | |
| 930 | |
| 931 #ifndef ALLOC_NO_POOLS | |
| 901 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) \ | 932 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) \ |
| 902 do { FREE_FIXED_TYPE (type, structtype, ptr); \ | 933 do { FREE_FIXED_TYPE (type, structtype, ptr); \ |
| 903 DECREMENT_CONS_COUNTER (sizeof (structtype)); \ | 934 DECREMENT_CONS_COUNTER (sizeof (structtype)); \ |
| 904 gc_count_num_##type##_freelist++; \ | 935 gc_count_num_##type##_freelist++; \ |
| 905 } while (0) | 936 } while (0) |
| 937 #else | |
| 938 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) | |
| 939 #endif | |
| 906 | 940 |
| 907 | 941 |
| 908 | 942 |
| 909 /************************************************************************/ | 943 /************************************************************************/ |
| 910 /* Cons allocation */ | 944 /* Cons allocation */ |
| 937 return internal_equal (ob1, ob2, depth); | 971 return internal_equal (ob1, ob2, depth); |
| 938 } | 972 } |
| 939 return 0; | 973 return 0; |
| 940 } | 974 } |
| 941 | 975 |
| 942 static const struct lrecord_description cons_description[] = { | 976 static const struct memory_description cons_description[] = { |
| 943 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car_) }, | 977 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car_) }, |
| 944 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr_) }, | 978 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr_) }, |
| 945 { XD_END } | 979 { XD_END } |
| 946 }; | 980 }; |
| 947 | 981 |
| 948 #ifdef USE_KKCC | |
| 949 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons, | 982 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons, |
| 950 1, /*dumpable-flag*/ | 983 1, /*dumpable-flag*/ |
| 951 mark_cons, print_cons, 0, | 984 mark_cons, print_cons, 0, |
| 952 cons_equal, | 985 cons_equal, |
| 953 /* | 986 /* |
| 956 * handle conses. | 989 * handle conses. |
| 957 */ | 990 */ |
| 958 0, | 991 0, |
| 959 cons_description, | 992 cons_description, |
| 960 Lisp_Cons); | 993 Lisp_Cons); |
| 961 #else /* not USE_KKCC */ | |
| 962 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons, | |
| 963 mark_cons, print_cons, 0, | |
| 964 cons_equal, | |
| 965 /* | |
| 966 * No `hash' method needed. | |
| 967 * internal_hash knows how to | |
| 968 * handle conses. | |
| 969 */ | |
| 970 0, | |
| 971 cons_description, | |
| 972 Lisp_Cons); | |
| 973 #endif /* not USE_KKCC */ | |
| 974 | 994 |
| 975 DEFUN ("cons", Fcons, 2, 2, 0, /* | 995 DEFUN ("cons", Fcons, 2, 2, 0, /* |
| 976 Create a new cons, give it CAR and CDR as components, and return it. | 996 Create a new cons, give it CAR and CDR as components, and return it. |
| 977 */ | 997 */ |
| 978 (car, cdr)) | 998 (car, cdr)) |
| 1166 internal_array_hash (XVECTOR_DATA (obj), | 1186 internal_array_hash (XVECTOR_DATA (obj), |
| 1167 XVECTOR_LENGTH (obj), | 1187 XVECTOR_LENGTH (obj), |
| 1168 depth + 1)); | 1188 depth + 1)); |
| 1169 } | 1189 } |
| 1170 | 1190 |
| 1171 static const struct lrecord_description vector_description[] = { | 1191 static const struct memory_description vector_description[] = { |
| 1172 { XD_LONG, offsetof (Lisp_Vector, size) }, | 1192 { XD_LONG, offsetof (Lisp_Vector, size) }, |
| 1173 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Vector, contents), XD_INDIRECT(0, 0) }, | 1193 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Vector, contents), XD_INDIRECT(0, 0) }, |
| 1174 { XD_END } | 1194 { XD_END } |
| 1175 }; | 1195 }; |
| 1176 | 1196 |
| 1177 #ifdef USE_KKCC | 1197 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("vector", vector, |
| 1178 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("vector", vector, | 1198 1, /*dumpable-flag*/ |
| 1179 1, /*dumpable-flag*/ | 1199 mark_vector, print_vector, 0, |
| 1180 mark_vector, print_vector, 0, | 1200 vector_equal, |
| 1181 vector_equal, | 1201 vector_hash, |
| 1182 vector_hash, | 1202 vector_description, |
| 1183 vector_description, | 1203 size_vector, Lisp_Vector); |
| 1184 size_vector, Lisp_Vector); | |
| 1185 #else /* not USE_KKCC */ | |
| 1186 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("vector", vector, | |
| 1187 mark_vector, print_vector, 0, | |
| 1188 vector_equal, | |
| 1189 vector_hash, | |
| 1190 vector_description, | |
| 1191 size_vector, Lisp_Vector); | |
| 1192 #endif /* not USE_KKCC */ | |
| 1193 /* #### should allocate `small' vectors from a frob-block */ | 1204 /* #### should allocate `small' vectors from a frob-block */ |
| 1194 static Lisp_Vector * | 1205 static Lisp_Vector * |
| 1195 make_vector_internal (Elemcount sizei) | 1206 make_vector_internal (Elemcount sizei) |
| 1196 { | 1207 { |
| 1197 /* no vector_next */ | 1208 /* no `next' field; we use lcrecords */ |
| 1198 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, | 1209 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, |
| 1199 contents, sizei); | 1210 contents, sizei); |
| 1200 Lisp_Vector *p = (Lisp_Vector *) alloc_lcrecord (sizem, &lrecord_vector); | 1211 Lisp_Vector *p = |
| 1212 (Lisp_Vector *) basic_alloc_lcrecord (sizem, &lrecord_vector); | |
| 1201 | 1213 |
| 1202 p->size = sizei; | 1214 p->size = sizei; |
| 1203 return p; | 1215 return p; |
| 1204 } | 1216 } |
| 1205 | 1217 |
| 1342 | 1354 |
| 1343 /************************************************************************/ | 1355 /************************************************************************/ |
| 1344 /* Bit Vector allocation */ | 1356 /* Bit Vector allocation */ |
| 1345 /************************************************************************/ | 1357 /************************************************************************/ |
| 1346 | 1358 |
| 1347 static Lisp_Object all_bit_vectors; | |
| 1348 | |
| 1349 /* #### should allocate `small' bit vectors from a frob-block */ | 1359 /* #### should allocate `small' bit vectors from a frob-block */ |
| 1350 static Lisp_Bit_Vector * | 1360 static Lisp_Bit_Vector * |
| 1351 make_bit_vector_internal (Elemcount sizei) | 1361 make_bit_vector_internal (Elemcount sizei) |
| 1352 { | 1362 { |
| 1363 /* no `next' field; we use lcrecords */ | |
| 1353 Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (sizei); | 1364 Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (sizei); |
| 1354 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, | 1365 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, |
| 1355 unsigned long, | 1366 unsigned long, |
| 1356 bits, num_longs); | 1367 bits, num_longs); |
| 1357 Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) allocate_lisp_storage (sizem); | 1368 Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) |
| 1358 set_lheader_implementation (&p->lheader, &lrecord_bit_vector); | 1369 basic_alloc_lcrecord (sizem, &lrecord_bit_vector); |
| 1359 | |
| 1360 INCREMENT_CONS_COUNTER (sizem, "bit-vector"); | |
| 1361 | 1370 |
| 1362 bit_vector_length (p) = sizei; | 1371 bit_vector_length (p) = sizei; |
| 1363 bit_vector_next (p) = all_bit_vectors; | |
| 1364 /* make sure the extra bits in the last long are 0; the calling | |
| 1365 functions might not set them. */ | |
| 1366 p->bits[num_longs - 1] = 0; | |
| 1367 all_bit_vectors = wrap_bit_vector (p); | |
| 1368 return p; | 1372 return p; |
| 1369 } | 1373 } |
| 1370 | 1374 |
| 1371 Lisp_Object | 1375 Lisp_Object |
| 1372 make_bit_vector (Elemcount length, Lisp_Object bit) | 1376 make_bit_vector (Elemcount length, Lisp_Object bit) |
| 1688 set_lheader_implementation (&e->lheader, &lrecord_event); | 1692 set_lheader_implementation (&e->lheader, &lrecord_event); |
| 1689 | 1693 |
| 1690 return wrap_event (e); | 1694 return wrap_event (e); |
| 1691 } | 1695 } |
| 1692 | 1696 |
| 1693 #ifdef USE_KKCC | 1697 #ifdef EVENT_DATA_AS_OBJECTS |
| 1694 DECLARE_FIXED_TYPE_ALLOC (key_data, Lisp_Key_Data); | 1698 DECLARE_FIXED_TYPE_ALLOC (key_data, Lisp_Key_Data); |
| 1695 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_key_data 1000 | 1699 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_key_data 1000 |
| 1696 | 1700 |
| 1697 Lisp_Object | 1701 Lisp_Object |
| 1698 allocate_key_data (void) | 1702 make_key_data (void) |
| 1699 { | 1703 { |
| 1700 Lisp_Key_Data *d; | 1704 Lisp_Key_Data *d; |
| 1701 | 1705 |
| 1702 ALLOCATE_FIXED_TYPE (key_data, Lisp_Key_Data, d); | 1706 ALLOCATE_FIXED_TYPE (key_data, Lisp_Key_Data, d); |
| 1707 xzero (*d); | |
| 1703 set_lheader_implementation (&d->lheader, &lrecord_key_data); | 1708 set_lheader_implementation (&d->lheader, &lrecord_key_data); |
| 1704 | 1709 d->keysym = Qnil; |
| 1705 return wrap_key_data(d); | 1710 |
| 1711 return wrap_key_data (d); | |
| 1706 } | 1712 } |
| 1707 | 1713 |
| 1708 DECLARE_FIXED_TYPE_ALLOC (button_data, Lisp_Button_Data); | 1714 DECLARE_FIXED_TYPE_ALLOC (button_data, Lisp_Button_Data); |
| 1709 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_button_data 1000 | 1715 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_button_data 1000 |
| 1710 | 1716 |
| 1711 Lisp_Object | 1717 Lisp_Object |
| 1712 allocate_button_data (void) | 1718 make_button_data (void) |
| 1713 { | 1719 { |
| 1714 Lisp_Button_Data *d; | 1720 Lisp_Button_Data *d; |
| 1715 | 1721 |
| 1716 ALLOCATE_FIXED_TYPE (button_data, Lisp_Button_Data, d); | 1722 ALLOCATE_FIXED_TYPE (button_data, Lisp_Button_Data, d); |
| 1723 xzero (*d); | |
| 1717 set_lheader_implementation (&d->lheader, &lrecord_button_data); | 1724 set_lheader_implementation (&d->lheader, &lrecord_button_data); |
| 1718 | 1725 |
| 1719 return wrap_button_data(d); | 1726 return wrap_button_data (d); |
| 1720 } | 1727 } |
| 1721 | 1728 |
| 1722 DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data); | 1729 DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data); |
| 1723 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_motion_data 1000 | 1730 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_motion_data 1000 |
| 1724 | 1731 |
| 1725 Lisp_Object | 1732 Lisp_Object |
| 1726 allocate_motion_data (void) | 1733 make_motion_data (void) |
| 1727 { | 1734 { |
| 1728 Lisp_Motion_Data *d; | 1735 Lisp_Motion_Data *d; |
| 1729 | 1736 |
| 1730 ALLOCATE_FIXED_TYPE (motion_data, Lisp_Motion_Data, d); | 1737 ALLOCATE_FIXED_TYPE (motion_data, Lisp_Motion_Data, d); |
| 1738 xzero (*d); | |
| 1731 set_lheader_implementation (&d->lheader, &lrecord_motion_data); | 1739 set_lheader_implementation (&d->lheader, &lrecord_motion_data); |
| 1732 | 1740 |
| 1733 return wrap_motion_data(d); | 1741 return wrap_motion_data (d); |
| 1734 } | 1742 } |
| 1735 | 1743 |
| 1736 DECLARE_FIXED_TYPE_ALLOC (process_data, Lisp_Process_Data); | 1744 DECLARE_FIXED_TYPE_ALLOC (process_data, Lisp_Process_Data); |
| 1737 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_process_data 1000 | 1745 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_process_data 1000 |
| 1738 | 1746 |
| 1739 Lisp_Object | 1747 Lisp_Object |
| 1740 allocate_process_data (void) | 1748 make_process_data (void) |
| 1741 { | 1749 { |
| 1742 Lisp_Process_Data *d; | 1750 Lisp_Process_Data *d; |
| 1743 | 1751 |
| 1744 ALLOCATE_FIXED_TYPE (process_data, Lisp_Process_Data, d); | 1752 ALLOCATE_FIXED_TYPE (process_data, Lisp_Process_Data, d); |
| 1753 xzero (*d); | |
| 1745 set_lheader_implementation (&d->lheader, &lrecord_process_data); | 1754 set_lheader_implementation (&d->lheader, &lrecord_process_data); |
| 1746 | 1755 d->process = Qnil; |
| 1747 return wrap_process_data(d); | 1756 |
| 1757 return wrap_process_data (d); | |
| 1748 } | 1758 } |
| 1749 | 1759 |
| 1750 DECLARE_FIXED_TYPE_ALLOC (timeout_data, Lisp_Timeout_Data); | 1760 DECLARE_FIXED_TYPE_ALLOC (timeout_data, Lisp_Timeout_Data); |
| 1751 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_timeout_data 1000 | 1761 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_timeout_data 1000 |
| 1752 | 1762 |
| 1753 Lisp_Object | 1763 Lisp_Object |
| 1754 allocate_timeout_data (void) | 1764 make_timeout_data (void) |
| 1755 { | 1765 { |
| 1756 Lisp_Timeout_Data *d; | 1766 Lisp_Timeout_Data *d; |
| 1757 | 1767 |
| 1758 ALLOCATE_FIXED_TYPE (timeout_data, Lisp_Timeout_Data, d); | 1768 ALLOCATE_FIXED_TYPE (timeout_data, Lisp_Timeout_Data, d); |
| 1769 xzero (*d); | |
| 1759 set_lheader_implementation (&d->lheader, &lrecord_timeout_data); | 1770 set_lheader_implementation (&d->lheader, &lrecord_timeout_data); |
| 1760 | 1771 d->function = Qnil; |
| 1761 return wrap_timeout_data(d); | 1772 d->object = Qnil; |
| 1773 | |
| 1774 return wrap_timeout_data (d); | |
| 1762 } | 1775 } |
| 1763 | 1776 |
| 1764 DECLARE_FIXED_TYPE_ALLOC (magic_data, Lisp_Magic_Data); | 1777 DECLARE_FIXED_TYPE_ALLOC (magic_data, Lisp_Magic_Data); |
| 1765 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_data 1000 | 1778 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_data 1000 |
| 1766 | 1779 |
| 1767 Lisp_Object | 1780 Lisp_Object |
| 1768 allocate_magic_data (void) | 1781 make_magic_data (void) |
| 1769 { | 1782 { |
| 1770 Lisp_Magic_Data *d; | 1783 Lisp_Magic_Data *d; |
| 1771 | 1784 |
| 1772 ALLOCATE_FIXED_TYPE (magic_data, Lisp_Magic_Data, d); | 1785 ALLOCATE_FIXED_TYPE (magic_data, Lisp_Magic_Data, d); |
| 1786 xzero (*d); | |
| 1773 set_lheader_implementation (&d->lheader, &lrecord_magic_data); | 1787 set_lheader_implementation (&d->lheader, &lrecord_magic_data); |
| 1774 | 1788 |
| 1775 return wrap_magic_data(d); | 1789 return wrap_magic_data (d); |
| 1776 } | 1790 } |
| 1777 | 1791 |
| 1778 DECLARE_FIXED_TYPE_ALLOC (magic_eval_data, Lisp_Magic_Eval_Data); | 1792 DECLARE_FIXED_TYPE_ALLOC (magic_eval_data, Lisp_Magic_Eval_Data); |
| 1779 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_eval_data 1000 | 1793 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_magic_eval_data 1000 |
| 1780 | 1794 |
| 1781 Lisp_Object | 1795 Lisp_Object |
| 1782 allocate_magic_eval_data (void) | 1796 make_magic_eval_data (void) |
| 1783 { | 1797 { |
| 1784 Lisp_Magic_Eval_Data *d; | 1798 Lisp_Magic_Eval_Data *d; |
| 1785 | 1799 |
| 1786 ALLOCATE_FIXED_TYPE (magic_eval_data, Lisp_Magic_Eval_Data, d); | 1800 ALLOCATE_FIXED_TYPE (magic_eval_data, Lisp_Magic_Eval_Data, d); |
| 1801 xzero (*d); | |
| 1787 set_lheader_implementation (&d->lheader, &lrecord_magic_eval_data); | 1802 set_lheader_implementation (&d->lheader, &lrecord_magic_eval_data); |
| 1788 | 1803 d->object = Qnil; |
| 1789 return wrap_magic_eval_data(d); | 1804 |
| 1805 return wrap_magic_eval_data (d); | |
| 1790 } | 1806 } |
| 1791 | 1807 |
| 1792 DECLARE_FIXED_TYPE_ALLOC (eval_data, Lisp_Eval_Data); | 1808 DECLARE_FIXED_TYPE_ALLOC (eval_data, Lisp_Eval_Data); |
| 1793 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_eval_data 1000 | 1809 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_eval_data 1000 |
| 1794 | 1810 |
| 1795 Lisp_Object | 1811 Lisp_Object |
| 1796 allocate_eval_data (void) | 1812 make_eval_data (void) |
| 1797 { | 1813 { |
| 1798 Lisp_Eval_Data *d; | 1814 Lisp_Eval_Data *d; |
| 1799 | 1815 |
| 1800 ALLOCATE_FIXED_TYPE (eval_data, Lisp_Eval_Data, d); | 1816 ALLOCATE_FIXED_TYPE (eval_data, Lisp_Eval_Data, d); |
| 1817 xzero (*d); | |
| 1801 set_lheader_implementation (&d->lheader, &lrecord_eval_data); | 1818 set_lheader_implementation (&d->lheader, &lrecord_eval_data); |
| 1802 | 1819 d->function = Qnil; |
| 1803 return wrap_eval_data(d); | 1820 d->object = Qnil; |
| 1821 | |
| 1822 return wrap_eval_data (d); | |
| 1804 } | 1823 } |
| 1805 | 1824 |
| 1806 DECLARE_FIXED_TYPE_ALLOC (misc_user_data, Lisp_Misc_User_Data); | 1825 DECLARE_FIXED_TYPE_ALLOC (misc_user_data, Lisp_Misc_User_Data); |
| 1807 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_misc_user_data 1000 | 1826 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_misc_user_data 1000 |
| 1808 | 1827 |
| 1809 Lisp_Object | 1828 Lisp_Object |
| 1810 allocate_misc_user_data (void) | 1829 make_misc_user_data (void) |
| 1811 { | 1830 { |
| 1812 Lisp_Misc_User_Data *d; | 1831 Lisp_Misc_User_Data *d; |
| 1813 | 1832 |
| 1814 ALLOCATE_FIXED_TYPE (misc_user_data, Lisp_Misc_User_Data, d); | 1833 ALLOCATE_FIXED_TYPE (misc_user_data, Lisp_Misc_User_Data, d); |
| 1834 xzero (*d); | |
| 1815 set_lheader_implementation (&d->lheader, &lrecord_misc_user_data); | 1835 set_lheader_implementation (&d->lheader, &lrecord_misc_user_data); |
| 1816 | 1836 d->function = Qnil; |
| 1817 return wrap_misc_user_data(d); | 1837 d->object = Qnil; |
| 1818 } | 1838 |
| 1819 #endif /* USE_KKCC */ | 1839 return wrap_misc_user_data (d); |
| 1840 } | |
| 1841 | |
| 1842 #endif /* EVENT_DATA_AS_OBJECTS */ | |
| 1820 | 1843 |
| 1821 /************************************************************************/ | 1844 /************************************************************************/ |
| 1822 /* Marker allocation */ | 1845 /* Marker allocation */ |
| 1823 /************************************************************************/ | 1846 /************************************************************************/ |
| 1824 | 1847 |
| 1862 /* String allocation */ | 1885 /* String allocation */ |
| 1863 /************************************************************************/ | 1886 /************************************************************************/ |
| 1864 | 1887 |
| 1865 /* The data for "short" strings generally resides inside of structs of type | 1888 /* The data for "short" strings generally resides inside of structs of type |
| 1866 string_chars_block. The Lisp_String structure is allocated just like any | 1889 string_chars_block. The Lisp_String structure is allocated just like any |
| 1867 other Lisp object (except for vectors), and these are freelisted when | 1890 other basic lrecord, and these are freelisted when they get garbage |
| 1868 they get garbage collected. The data for short strings get compacted, | 1891 collected. The data for short strings get compacted, but the data for |
| 1869 but the data for large strings do not. | 1892 large strings do not. |
| 1870 | 1893 |
| 1871 Previously Lisp_String structures were relocated, but this caused a lot | 1894 Previously Lisp_String structures were relocated, but this caused a lot |
| 1872 of bus-errors because the C code didn't include enough GCPRO's for | 1895 of bus-errors because the C code didn't include enough GCPRO's for |
| 1873 strings (since EVERY REFERENCE to a short string needed to be GCPRO'd so | 1896 strings (since EVERY REFERENCE to a short string needed to be GCPRO'd so |
| 1874 that the reference would get relocated). | 1897 that the reference would get relocated). |
| 1894 Bytecount len; | 1917 Bytecount len; |
| 1895 return (((len = XSTRING_LENGTH (obj1)) == XSTRING_LENGTH (obj2)) && | 1918 return (((len = XSTRING_LENGTH (obj1)) == XSTRING_LENGTH (obj2)) && |
| 1896 !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len)); | 1919 !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len)); |
| 1897 } | 1920 } |
| 1898 | 1921 |
| 1899 static const struct lrecord_description string_description[] = { | 1922 static const struct memory_description string_description[] = { |
| 1900 { XD_BYTECOUNT, offsetof (Lisp_String, size_) }, | 1923 { XD_BYTECOUNT, offsetof (Lisp_String, size_) }, |
| 1901 { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data_), XD_INDIRECT(0, 1) }, | 1924 { XD_OPAQUE_DATA_PTR, offsetof (Lisp_String, data_), XD_INDIRECT(0, 1) }, |
| 1902 { XD_LISP_OBJECT, offsetof (Lisp_String, plist) }, | 1925 { XD_LISP_OBJECT, offsetof (Lisp_String, plist) }, |
| 1903 { XD_END } | 1926 { XD_END } |
| 1904 }; | 1927 }; |
| 1953 /* No `finalize', or `hash' methods. | 1976 /* No `finalize', or `hash' methods. |
| 1954 internal_hash() already knows how to hash strings and finalization | 1977 internal_hash() already knows how to hash strings and finalization |
| 1955 is done with the ADDITIONAL_FREE_string macro, which is the | 1978 is done with the ADDITIONAL_FREE_string macro, which is the |
| 1956 standard way to do finalization when using | 1979 standard way to do finalization when using |
| 1957 SWEEP_FIXED_TYPE_BLOCK(). */ | 1980 SWEEP_FIXED_TYPE_BLOCK(). */ |
| 1958 #ifdef USE_KKCC | |
| 1959 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, | 1981 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, |
| 1960 1, /*dumpable-flag*/ | 1982 1, /*dumpable-flag*/ |
| 1961 mark_string, print_string, | 1983 mark_string, print_string, |
| 1962 0, string_equal, 0, | 1984 0, string_equal, 0, |
| 1963 string_description, | 1985 string_description, |
| 1964 string_getprop, | 1986 string_getprop, |
| 1965 string_putprop, | 1987 string_putprop, |
| 1966 string_remprop, | 1988 string_remprop, |
| 1967 string_plist, | 1989 string_plist, |
| 1968 Lisp_String); | 1990 Lisp_String); |
| 1969 #else /* not USE_KKCC */ | |
| 1970 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string, | |
| 1971 mark_string, print_string, | |
| 1972 0, string_equal, 0, | |
| 1973 string_description, | |
| 1974 string_getprop, | |
| 1975 string_putprop, | |
| 1976 string_remprop, | |
| 1977 string_plist, | |
| 1978 Lisp_String); | |
| 1979 #endif /* not USE_KKCC */ | |
| 1980 /* String blocks contain this many useful bytes. */ | 1991 /* String blocks contain this many useful bytes. */ |
| 1981 #define STRING_CHARS_BLOCK_SIZE \ | 1992 #define STRING_CHARS_BLOCK_SIZE \ |
| 1982 ((Bytecount) (8192 - MALLOC_OVERHEAD - \ | 1993 ((Bytecount) (8192 - MALLOC_OVERHEAD - \ |
| 1983 ((2 * sizeof (struct string_chars_block *)) \ | 1994 ((2 * sizeof (struct string_chars_block *)) \ |
| 1984 + sizeof (EMACS_INT)))) | 1995 + sizeof (EMACS_INT)))) |
| 2482 /************************************************************************/ | 2493 /************************************************************************/ |
| 2483 /* lcrecord lists */ | 2494 /* lcrecord lists */ |
| 2484 /************************************************************************/ | 2495 /************************************************************************/ |
| 2485 | 2496 |
| 2486 /* Lcrecord lists are used to manage the allocation of particular | 2497 /* Lcrecord lists are used to manage the allocation of particular |
| 2487 sorts of lcrecords, to avoid calling alloc_lcrecord() (and thus | 2498 sorts of lcrecords, to avoid calling basic_alloc_lcrecord() (and thus |
| 2488 malloc() and garbage-collection junk) as much as possible. | 2499 malloc() and garbage-collection junk) as much as possible. |
| 2489 It is similar to the Blocktype class. | 2500 It is similar to the Blocktype class. |
| 2490 | 2501 |
| 2491 It works like this: | 2502 See detailed comment in lcrecord.h. |
| 2492 | 2503 */ |
| 2493 1) Create an lcrecord-list object using make_lcrecord_list(). | 2504 |
| 2494 This is often done at initialization. Remember to staticpro_nodump | 2505 const struct memory_description free_description[] = { |
| 2495 this object! The arguments to make_lcrecord_list() are the | 2506 { XD_LISP_OBJECT, offsetof (struct free_lcrecord_header, chain), 0, 0, |
| 2496 same as would be passed to alloc_lcrecord(). | 2507 XD_FLAG_FREE_LISP_OBJECT }, |
| 2497 2) Instead of calling alloc_lcrecord(), call allocate_managed_lcrecord() | 2508 { XD_END } |
| 2498 and pass the lcrecord-list earlier created. | 2509 }; |
| 2499 3) When done with the lcrecord, call free_managed_lcrecord(). | 2510 |
| 2500 The standard freeing caveats apply: ** make sure there are no | 2511 DEFINE_LRECORD_IMPLEMENTATION ("free", free, |
| 2501 pointers to the object anywhere! ** | 2512 0, /*dumpable-flag*/ |
| 2502 4) Calling free_managed_lcrecord() is just like kissing the | 2513 0, internal_object_printer, |
| 2503 lcrecord goodbye as if it were garbage-collected. This means: | 2514 0, 0, 0, free_description, |
| 2504 -- the contents of the freed lcrecord are undefined, and the | 2515 struct free_lcrecord_header); |
| 2505 contents of something produced by allocate_managed_lcrecord() | 2516 |
| 2506 are undefined, just like for alloc_lcrecord(). | 2517 const struct memory_description lcrecord_list_description[] = { |
| 2507 -- the mark method for the lcrecord's type will *NEVER* be called | 2518 { XD_LISP_OBJECT, offsetof (struct lcrecord_list, free), 0, 0, |
| 2508 on freed lcrecords. | 2519 XD_FLAG_FREE_LISP_OBJECT }, |
| 2509 -- the finalize method for the lcrecord's type will be called | 2520 { XD_END } |
| 2510 at the time that free_managed_lcrecord() is called. | 2521 }; |
| 2511 | |
| 2512 */ | |
| 2513 | 2522 |
| 2514 static Lisp_Object | 2523 static Lisp_Object |
| 2515 mark_lcrecord_list (Lisp_Object obj) | 2524 mark_lcrecord_list (Lisp_Object obj) |
| 2516 { | 2525 { |
| 2517 struct lcrecord_list *list = XLCRECORD_LIST (obj); | 2526 struct lcrecord_list *list = XLCRECORD_LIST (obj); |
| 2526 gc_checking_assert | 2535 gc_checking_assert |
| 2527 (/* There should be no other pointers to the free list. */ | 2536 (/* There should be no other pointers to the free list. */ |
| 2528 ! MARKED_RECORD_HEADER_P (lheader) | 2537 ! MARKED_RECORD_HEADER_P (lheader) |
| 2529 && | 2538 && |
| 2530 /* Only lcrecords should be here. */ | 2539 /* Only lcrecords should be here. */ |
| 2531 ! LHEADER_IMPLEMENTATION (lheader)->basic_p | 2540 ! list->implementation->basic_p |
| 2532 && | 2541 && |
| 2533 /* Only free lcrecords should be here. */ | 2542 /* Only free lcrecords should be here. */ |
| 2534 free_header->lcheader.free | 2543 free_header->lcheader.free |
| 2535 && | 2544 && |
| 2536 /* The type of the lcrecord must be right. */ | 2545 /* The type of the lcrecord must be right. */ |
| 2537 LHEADER_IMPLEMENTATION (lheader) == list->implementation | 2546 lheader->type == lrecord_type_free |
| 2538 && | 2547 && |
| 2539 /* So must the size. */ | 2548 /* So must the size. */ |
| 2540 (LHEADER_IMPLEMENTATION (lheader)->static_size == 0 || | 2549 (list->implementation->static_size == 0 || |
| 2541 LHEADER_IMPLEMENTATION (lheader)->static_size == list->size) | 2550 list->implementation->static_size == list->size) |
| 2542 ); | 2551 ); |
| 2543 | 2552 |
| 2544 MARK_RECORD_HEADER (lheader); | 2553 MARK_RECORD_HEADER (lheader); |
| 2545 chain = free_header->chain; | 2554 chain = free_header->chain; |
| 2546 } | 2555 } |
| 2547 | 2556 |
| 2548 return Qnil; | 2557 return Qnil; |
| 2549 } | 2558 } |
| 2550 | 2559 |
| 2551 #ifdef USE_KKCC | |
| 2552 DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list, | 2560 DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list, |
| 2553 0, /*dumpable-flag*/ | 2561 0, /*dumpable-flag*/ |
| 2554 mark_lcrecord_list, internal_object_printer, | 2562 mark_lcrecord_list, internal_object_printer, |
| 2555 0, 0, 0, 0, struct lcrecord_list); | 2563 0, 0, 0, lcrecord_list_description, |
| 2556 #else /* not USE_KKCC */ | 2564 struct lcrecord_list); |
| 2557 DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list, | |
| 2558 mark_lcrecord_list, internal_object_printer, | |
| 2559 0, 0, 0, 0, struct lcrecord_list); | |
| 2560 #endif /* not USE_KKCC */ | |
| 2561 | 2565 |
| 2562 Lisp_Object | 2566 Lisp_Object |
| 2563 make_lcrecord_list (Elemcount size, | 2567 make_lcrecord_list (Elemcount size, |
| 2564 const struct lrecord_implementation *implementation) | 2568 const struct lrecord_implementation *implementation) |
| 2565 { | 2569 { |
| 2566 struct lcrecord_list *p = | 2570 /* Don't use alloc_lcrecord_type() avoid infinite recursion |
| 2567 /* Avoid infinite recursion allocating this */ | 2571 allocating this, */ |
| 2568 alloc_unmanaged_lcrecord_type (struct lcrecord_list, | 2572 struct lcrecord_list *p = (struct lcrecord_list *) |
| 2569 &lrecord_lcrecord_list); | 2573 basic_alloc_lcrecord (sizeof (struct lcrecord_list), |
| 2574 &lrecord_lcrecord_list); | |
| 2570 | 2575 |
| 2571 p->implementation = implementation; | 2576 p->implementation = implementation; |
| 2572 p->size = size; | 2577 p->size = size; |
| 2573 p->free = Qnil; | 2578 p->free = Qnil; |
| 2574 return wrap_lcrecord_list (p); | 2579 return wrap_lcrecord_list (p); |
| 2575 } | 2580 } |
| 2576 | 2581 |
| 2577 Lisp_Object | 2582 Lisp_Object |
| 2578 allocate_managed_lcrecord (Lisp_Object lcrecord_list) | 2583 alloc_managed_lcrecord (Lisp_Object lcrecord_list) |
| 2579 { | 2584 { |
| 2580 struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list); | 2585 struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list); |
| 2581 if (!NILP (list->free)) | 2586 if (!NILP (list->free)) |
| 2582 { | 2587 { |
| 2583 Lisp_Object val = list->free; | 2588 Lisp_Object val = list->free; |
| 2584 struct free_lcrecord_header *free_header = | 2589 struct free_lcrecord_header *free_header = |
| 2585 (struct free_lcrecord_header *) XPNTR (val); | 2590 (struct free_lcrecord_header *) XPNTR (val); |
| 2591 struct lrecord_header *lheader = &free_header->lcheader.lheader; | |
| 2586 | 2592 |
| 2587 #ifdef ERROR_CHECK_GC | 2593 #ifdef ERROR_CHECK_GC |
| 2588 struct lrecord_header *lheader = &free_header->lcheader.lheader; | 2594 /* Major overkill here. */ |
| 2589 | |
| 2590 /* There should be no other pointers to the free list. */ | 2595 /* There should be no other pointers to the free list. */ |
| 2591 assert (! MARKED_RECORD_HEADER_P (lheader)); | 2596 assert (! MARKED_RECORD_HEADER_P (lheader)); |
| 2592 /* Only lcrecords should be here. */ | |
| 2593 assert (! LHEADER_IMPLEMENTATION (lheader)->basic_p); | |
| 2594 /* Only free lcrecords should be here. */ | 2597 /* Only free lcrecords should be here. */ |
| 2595 assert (free_header->lcheader.free); | 2598 assert (free_header->lcheader.free); |
| 2599 assert (lheader->type == lrecord_type_free); | |
| 2600 /* Only lcrecords should be here. */ | |
| 2601 assert (! (list->implementation->basic_p)); | |
| 2602 #if 0 /* Not used anymore, now that we set the type of the header to | |
| 2603 lrecord_type_free. */ | |
| 2596 /* The type of the lcrecord must be right. */ | 2604 /* The type of the lcrecord must be right. */ |
| 2597 assert (LHEADER_IMPLEMENTATION (lheader) == list->implementation); | 2605 assert (LHEADER_IMPLEMENTATION (lheader) == list->implementation); |
| 2606 #endif /* 0 */ | |
| 2598 /* So must the size. */ | 2607 /* So must the size. */ |
| 2599 assert (LHEADER_IMPLEMENTATION (lheader)->static_size == 0 || | 2608 assert (list->implementation->static_size == 0 || |
| 2600 LHEADER_IMPLEMENTATION (lheader)->static_size == list->size); | 2609 list->implementation->static_size == list->size); |
| 2601 #endif /* ERROR_CHECK_GC */ | 2610 #endif /* ERROR_CHECK_GC */ |
| 2602 | 2611 |
| 2603 list->free = free_header->chain; | 2612 list->free = free_header->chain; |
| 2604 free_header->lcheader.free = 0; | 2613 free_header->lcheader.free = 0; |
| 2614 /* Put back the correct type, as we set it to lrecord_type_free. */ | |
| 2615 lheader->type = list->implementation->lrecord_type_index; | |
| 2616 zero_sized_lcrecord (free_header, list->size); | |
| 2605 return val; | 2617 return val; |
| 2606 } | 2618 } |
| 2607 else | 2619 else |
| 2608 return wrap_pointer_1 (alloc_lcrecord (list->size, list->implementation)); | 2620 return wrap_pointer_1 (basic_alloc_lcrecord (list->size, |
| 2621 list->implementation)); | |
| 2609 } | 2622 } |
| 2610 | 2623 |
| 2611 /* "Free" a Lisp object LCRECORD by placing it on its associated free list | 2624 /* "Free" a Lisp object LCRECORD by placing it on its associated free list |
| 2612 LCRECORD_LIST; next time allocate_managed_lcrecord() is called with the | 2625 LCRECORD_LIST; next time alloc_managed_lcrecord() is called with the |
| 2613 same LCRECORD_LIST as its parameter, it will return an object from the | 2626 same LCRECORD_LIST as its parameter, it will return an object from the |
| 2614 free list, which may be this one. Be VERY VERY SURE there are no | 2627 free list, which may be this one. Be VERY VERY SURE there are no |
| 2615 pointers to this object hanging around anywhere where they might be | 2628 pointers to this object hanging around anywhere where they might be |
| 2616 used! | 2629 used! |
| 2617 | 2630 |
| 2639 problems. */ | 2652 problems. */ |
| 2640 gc_checking_assert (!gc_in_progress); | 2653 gc_checking_assert (!gc_in_progress); |
| 2641 | 2654 |
| 2642 /* Make sure the size is correct. This will catch, for example, | 2655 /* Make sure the size is correct. This will catch, for example, |
| 2643 putting a window configuration on the wrong free list. */ | 2656 putting a window configuration on the wrong free list. */ |
| 2644 gc_checking_assert ((implementation->size_in_bytes_method ? | 2657 gc_checking_assert (detagged_lisp_object_size (lheader) == list->size); |
| 2645 implementation->size_in_bytes_method (lheader) : | |
| 2646 implementation->static_size) | |
| 2647 == list->size); | |
| 2648 /* Make sure the object isn't already freed. */ | 2658 /* Make sure the object isn't already freed. */ |
| 2649 gc_checking_assert (!free_header->lcheader.free); | 2659 gc_checking_assert (!free_header->lcheader.free); |
| 2650 | 2660 |
| 2651 if (implementation->finalizer) | 2661 if (implementation->finalizer) |
| 2652 implementation->finalizer (lheader, 0); | 2662 implementation->finalizer (lheader, 0); |
| 2663 /* Yes, there are two ways to indicate freeness -- the type is | |
| 2664 lrecord_type_free or the ->free flag is set. We used to do only the | |
| 2665 latter; now we do the former as well for KKCC purposes. Probably | |
| 2666 safer in any case, as we will lose quicker this way than keeping | |
| 2667 around an lrecord of apparently correct type but bogus junk in it. */ | |
| 2668 MARK_LRECORD_AS_FREE (lheader); | |
| 2653 free_header->chain = list->free; | 2669 free_header->chain = list->free; |
| 2654 free_header->lcheader.free = 1; | 2670 free_header->lcheader.free = 1; |
| 2655 list->free = lcrecord; | 2671 list->free = lcrecord; |
| 2656 } | 2672 } |
| 2657 | 2673 |
| 2663 { | 2679 { |
| 2664 if (EQ (all_lcrecord_lists[imp->lrecord_type_index], Qzero)) | 2680 if (EQ (all_lcrecord_lists[imp->lrecord_type_index], Qzero)) |
| 2665 all_lcrecord_lists[imp->lrecord_type_index] = | 2681 all_lcrecord_lists[imp->lrecord_type_index] = |
| 2666 make_lcrecord_list (size, imp); | 2682 make_lcrecord_list (size, imp); |
| 2667 | 2683 |
| 2668 return XPNTR (allocate_managed_lcrecord | 2684 return XPNTR (alloc_managed_lcrecord |
| 2669 (all_lcrecord_lists[imp->lrecord_type_index])); | 2685 (all_lcrecord_lists[imp->lrecord_type_index])); |
| 2670 } | 2686 } |
| 2671 | 2687 |
| 2672 void | 2688 void |
| 2673 free_lcrecord (Lisp_Object rec) | 2689 free_lcrecord (Lisp_Object rec) |
| 2714 in the heap; we only dump heap objects. Hence we use a trivial | 2730 in the heap; we only dump heap objects. Hence we use a trivial |
| 2715 description, as for pointerless objects. (Note that the data segment | 2731 description, as for pointerless objects. (Note that the data segment |
| 2716 objects, which are global variables like Qfoo or Vbar, themselves are | 2732 objects, which are global variables like Qfoo or Vbar, themselves are |
| 2717 pointers to heap objects. Each needs to be described to pdump as a | 2733 pointers to heap objects. Each needs to be described to pdump as a |
| 2718 "root pointer"; this happens in the call to staticpro(). */ | 2734 "root pointer"; this happens in the call to staticpro(). */ |
| 2719 static const struct lrecord_description staticpro_description_1[] = { | 2735 static const struct memory_description staticpro_description_1[] = { |
| 2720 { XD_END } | 2736 { XD_END } |
| 2721 }; | 2737 }; |
| 2722 | 2738 |
| 2723 static const struct struct_description staticpro_description = { | 2739 static const struct sized_memory_description staticpro_description = { |
| 2724 sizeof (Lisp_Object *), | 2740 sizeof (Lisp_Object *), |
| 2725 staticpro_description_1 | 2741 staticpro_description_1 |
| 2726 }; | 2742 }; |
| 2727 | 2743 |
| 2728 static const struct lrecord_description staticpros_description_1[] = { | 2744 static const struct memory_description staticpros_description_1[] = { |
| 2729 XD_DYNARR_DESC (Lisp_Object_ptr_dynarr, &staticpro_description), | 2745 XD_DYNARR_DESC (Lisp_Object_ptr_dynarr, &staticpro_description), |
| 2730 { XD_END } | 2746 { XD_END } |
| 2731 }; | 2747 }; |
| 2732 | 2748 |
| 2733 static const struct struct_description staticpros_description = { | 2749 static const struct sized_memory_description staticpros_description = { |
| 2734 sizeof (Lisp_Object_ptr_dynarr), | 2750 sizeof (Lisp_Object_ptr_dynarr), |
| 2735 staticpros_description_1 | 2751 staticpros_description_1 |
| 2736 }; | 2752 }; |
| 2737 | 2753 |
| 2738 #ifdef DEBUG_XEMACS | 2754 #ifdef DEBUG_XEMACS |
| 2739 | 2755 |
| 2740 static const struct lrecord_description staticpro_one_name_description_1[] = { | 2756 static const struct memory_description staticpro_one_name_description_1[] = { |
| 2741 { XD_C_STRING, 0 }, | 2757 { XD_C_STRING, 0 }, |
| 2742 { XD_END } | 2758 { XD_END } |
| 2743 }; | 2759 }; |
| 2744 | 2760 |
| 2745 static const struct struct_description staticpro_one_name_description = { | 2761 static const struct sized_memory_description staticpro_one_name_description = { |
| 2746 sizeof (char *), | 2762 sizeof (char *), |
| 2747 staticpro_one_name_description_1 | 2763 staticpro_one_name_description_1 |
| 2748 }; | 2764 }; |
| 2749 | 2765 |
| 2750 static const struct lrecord_description staticpro_names_description_1[] = { | 2766 static const struct memory_description staticpro_names_description_1[] = { |
| 2751 XD_DYNARR_DESC (char_ptr_dynarr, &staticpro_one_name_description), | 2767 XD_DYNARR_DESC (char_ptr_dynarr, &staticpro_one_name_description), |
| 2752 { XD_END } | 2768 { XD_END } |
| 2753 }; | 2769 }; |
| 2754 | 2770 |
| 2755 static const struct struct_description staticpro_names_description = { | 2771 |
| 2772 extern const struct sized_memory_description staticpro_names_description; | |
| 2773 | |
| 2774 const struct sized_memory_description staticpro_names_description = { | |
| 2756 sizeof (char_ptr_dynarr), | 2775 sizeof (char_ptr_dynarr), |
| 2757 staticpro_names_description_1 | 2776 staticpro_names_description_1 |
| 2758 }; | 2777 }; |
| 2759 | 2778 |
| 2760 /* Help debug crashes gc-marking a staticpro'ed object. */ | 2779 /* Help debug crashes gc-marking a staticpro'ed object. */ |
| 2767 void | 2786 void |
| 2768 staticpro_1 (Lisp_Object *varaddress, char *varname) | 2787 staticpro_1 (Lisp_Object *varaddress, char *varname) |
| 2769 { | 2788 { |
| 2770 Dynarr_add (staticpros, varaddress); | 2789 Dynarr_add (staticpros, varaddress); |
| 2771 Dynarr_add (staticpro_names, varname); | 2790 Dynarr_add (staticpro_names, varname); |
| 2772 dump_add_root_object (varaddress); | 2791 dump_add_root_lisp_object (varaddress); |
| 2773 } | 2792 } |
| 2774 | 2793 |
| 2775 | 2794 |
| 2776 Lisp_Object_ptr_dynarr *staticpros_nodump; | 2795 Lisp_Object_ptr_dynarr *staticpros_nodump; |
| 2777 char_ptr_dynarr *staticpro_nodump_names; | 2796 char_ptr_dynarr *staticpro_nodump_names; |
| 2804 garbage collection, and for dumping. */ | 2823 garbage collection, and for dumping. */ |
| 2805 void | 2824 void |
| 2806 staticpro (Lisp_Object *varaddress) | 2825 staticpro (Lisp_Object *varaddress) |
| 2807 { | 2826 { |
| 2808 Dynarr_add (staticpros, varaddress); | 2827 Dynarr_add (staticpros, varaddress); |
| 2809 dump_add_root_object (varaddress); | 2828 dump_add_root_lisp_object (varaddress); |
| 2810 } | 2829 } |
| 2811 | 2830 |
| 2812 | 2831 |
| 2813 Lisp_Object_ptr_dynarr *staticpros_nodump; | 2832 Lisp_Object_ptr_dynarr *staticpros_nodump; |
| 2814 | 2833 |
| 2859 #else | 2878 #else |
| 2860 #define GC_CHECK_LHEADER_INVARIANTS(lheader) | 2879 #define GC_CHECK_LHEADER_INVARIANTS(lheader) |
| 2861 #endif | 2880 #endif |
| 2862 | 2881 |
| 2863 | 2882 |
| 2864 | 2883 static const struct memory_description lisp_object_description_1[] = { |
| 2865 #ifdef USE_KKCC | 2884 { XD_LISP_OBJECT, 0 }, |
| 2866 /* The following functions implement the new mark algorithm. | 2885 { XD_END } |
| 2867 They mark objects according to their descriptions. They | 2886 }; |
| 2868 are modeled on the corresponding pdumper procedures. */ | 2887 |
| 2869 | 2888 const struct sized_memory_description lisp_object_description = { |
| 2870 static void mark_struct_contents (const void *data, | 2889 sizeof (Lisp_Object), |
| 2871 const struct struct_description * | 2890 lisp_object_description_1 |
| 2872 sdesc, | 2891 }; |
| 2873 int count); | 2892 |
| 2893 #if defined (USE_KKCC) || defined (PDUMP) | |
| 2874 | 2894 |
| 2875 /* This function extracts the value of a count variable described somewhere | 2895 /* This function extracts the value of a count variable described somewhere |
| 2876 else in the description. It is converted corresponding to the type */ | 2896 else in the description. It is converted corresponding to the type */ |
| 2877 static EMACS_INT | 2897 EMACS_INT |
| 2878 get_indirect_count (EMACS_INT code, | 2898 lispdesc_indirect_count_1 (EMACS_INT code, |
| 2879 const struct lrecord_description *idesc, | 2899 const struct memory_description *idesc, |
| 2880 const void *idata) | 2900 const void *idata) |
| 2881 { | 2901 { |
| 2882 EMACS_INT count; | 2902 EMACS_INT count; |
| 2883 const void *irdata; | 2903 const void *irdata; |
| 2884 | 2904 |
| 2885 int line = XD_INDIRECT_VAL (code); | 2905 int line = XD_INDIRECT_VAL (code); |
| 2886 int delta = XD_INDIRECT_DELTA (code); | 2906 int delta = XD_INDIRECT_DELTA (code); |
| 2887 | 2907 |
| 2888 irdata = ((char *)idata) + idesc[line].offset; | 2908 irdata = ((char *) idata) + |
| 2909 lispdesc_indirect_count (idesc[line].offset, idesc, idata); | |
| 2889 switch (idesc[line].type) | 2910 switch (idesc[line].type) |
| 2890 { | 2911 { |
| 2891 case XD_BYTECOUNT: | 2912 case XD_BYTECOUNT: |
| 2892 count = *(Bytecount *)irdata; | 2913 count = * (Bytecount *) irdata; |
| 2893 break; | 2914 break; |
| 2894 case XD_ELEMCOUNT: | 2915 case XD_ELEMCOUNT: |
| 2895 count = *(Elemcount *)irdata; | 2916 count = * (Elemcount *) irdata; |
| 2896 break; | 2917 break; |
| 2897 case XD_HASHCODE: | 2918 case XD_HASHCODE: |
| 2898 count = *(Hashcode *)irdata; | 2919 count = * (Hashcode *) irdata; |
| 2899 break; | 2920 break; |
| 2900 case XD_INT: | 2921 case XD_INT: |
| 2901 count = *(int *)irdata; | 2922 count = * (int *) irdata; |
| 2902 break; | 2923 break; |
| 2903 case XD_LONG: | 2924 case XD_LONG: |
| 2904 count = *(long *)irdata; | 2925 count = * (long *) irdata; |
| 2905 break; | 2926 break; |
| 2906 default: | 2927 default: |
| 2907 stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n", | 2928 stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n", |
| 2908 idesc[line].type, line, (long)code); | 2929 idesc[line].type, line, (long) code); |
| 2930 #ifdef PDUMP | |
| 2931 if (in_pdump) | |
| 2932 pdump_backtrace (); | |
| 2933 #endif | |
| 2909 count = 0; /* warning suppression */ | 2934 count = 0; /* warning suppression */ |
| 2910 abort (); | 2935 abort (); |
| 2911 } | 2936 } |
| 2912 count += delta; | 2937 count += delta; |
| 2913 return count; | 2938 return count; |
| 2914 } | 2939 } |
| 2940 | |
| 2941 /* SDESC is a "description map" (basically, a list of offsets used for | |
| 2942 successive indirections) and OBJ is the first object to indirect off of. | |
| 2943 Return the description ultimately found. */ | |
| 2944 | |
| 2945 const struct sized_memory_description * | |
| 2946 lispdesc_indirect_description_1 (const void *obj, | |
| 2947 const struct sized_memory_description *sdesc) | |
| 2948 { | |
| 2949 int pos; | |
| 2950 | |
| 2951 for (pos = 0; sdesc[pos].size >= 0; pos++) | |
| 2952 obj = * (const void **) ((const char *) obj + sdesc[pos].size); | |
| 2953 | |
| 2954 return (const struct sized_memory_description *) obj; | |
| 2955 } | |
| 2956 | |
| 2957 /* Compute the size of the data at RDATA, described by a single entry | |
| 2958 DESC1 in a description array. OBJ and DESC are used for | |
| 2959 XD_INDIRECT references. */ | |
| 2960 | |
| 2961 static Bytecount | |
| 2962 lispdesc_one_description_line_size (void *rdata, | |
| 2963 const struct memory_description *desc1, | |
| 2964 const void *obj, | |
| 2965 const struct memory_description *desc) | |
| 2966 { | |
| 2967 union_switcheroo: | |
| 2968 switch (desc1->type) | |
| 2969 { | |
| 2970 case XD_LISP_OBJECT_ARRAY: | |
| 2971 { | |
| 2972 EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); | |
| 2973 return (val * sizeof (Lisp_Object)); | |
| 2974 } | |
| 2975 case XD_LISP_OBJECT: | |
| 2976 case XD_LO_LINK: | |
| 2977 return sizeof (Lisp_Object); | |
| 2978 case XD_OPAQUE_PTR: | |
| 2979 return sizeof (void *); | |
| 2980 case XD_STRUCT_PTR: | |
| 2981 { | |
| 2982 EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); | |
| 2983 return val * sizeof (void *); | |
| 2984 } | |
| 2985 case XD_STRUCT_ARRAY: | |
| 2986 { | |
| 2987 EMACS_INT val = lispdesc_indirect_count (desc1->data1, desc, obj); | |
| 2988 | |
| 2989 return (val * | |
| 2990 lispdesc_structure_size | |
| 2991 (rdata, lispdesc_indirect_description (obj, desc1->data2))); | |
| 2992 } | |
| 2993 case XD_OPAQUE_DATA_PTR: | |
| 2994 return sizeof (void *); | |
| 2995 case XD_UNION_DYNAMIC_SIZE: | |
| 2996 { | |
| 2997 /* If an explicit size was given in the first-level structure | |
| 2998 description, use it; else compute size based on current union | |
| 2999 constant. */ | |
| 3000 const struct sized_memory_description *sdesc = | |
| 3001 lispdesc_indirect_description (obj, desc1->data2); | |
| 3002 if (sdesc->size) | |
| 3003 return sdesc->size; | |
| 3004 else | |
| 3005 { | |
| 3006 desc1 = lispdesc_process_xd_union (desc1, desc, obj); | |
| 3007 if (desc1) | |
| 3008 goto union_switcheroo; | |
| 3009 break; | |
| 3010 } | |
| 3011 } | |
| 3012 case XD_UNION: | |
| 3013 { | |
| 3014 /* If an explicit size was given in the first-level structure | |
| 3015 description, use it; else compute size based on maximum of all | |
| 3016 possible structures. */ | |
| 3017 const struct sized_memory_description *sdesc = | |
| 3018 lispdesc_indirect_description (obj, desc1->data2); | |
| 3019 if (sdesc->size) | |
| 3020 return sdesc->size; | |
| 3021 else | |
| 3022 { | |
| 3023 int count; | |
| 3024 Bytecount max_size = -1, size; | |
| 3025 | |
| 3026 desc1 = sdesc->description; | |
| 3027 | |
| 3028 for (count = 0; desc1[count].type != XD_END; count++) | |
| 3029 { | |
| 3030 size = lispdesc_one_description_line_size (rdata, | |
| 3031 &desc1[count], | |
| 3032 obj, desc); | |
| 3033 if (size > max_size) | |
| 3034 max_size = size; | |
| 3035 } | |
| 3036 return max_size; | |
| 3037 } | |
| 3038 } | |
| 3039 case XD_C_STRING: | |
| 3040 return sizeof (void *); | |
| 3041 case XD_DOC_STRING: | |
| 3042 return sizeof (void *); | |
| 3043 case XD_INT_RESET: | |
| 3044 return sizeof (int); | |
| 3045 case XD_BYTECOUNT: | |
| 3046 return sizeof (Bytecount); | |
| 3047 case XD_ELEMCOUNT: | |
| 3048 return sizeof (Elemcount); | |
| 3049 case XD_HASHCODE: | |
| 3050 return sizeof (Hashcode); | |
| 3051 case XD_INT: | |
| 3052 return sizeof (int); | |
| 3053 case XD_LONG: | |
| 3054 return sizeof (long); | |
| 3055 default: | |
| 3056 stderr_out ("Unsupported dump type : %d\n", desc1->type); | |
| 3057 abort (); | |
| 3058 } | |
| 3059 | |
| 3060 return 0; | |
| 3061 } | |
| 3062 | |
| 3063 | |
| 3064 /* Return the size of the memory block (NOT necessarily a structure!) | |
| 3065 described by SDESC and pointed to by OBJ. If SDESC records an | |
| 3066 explicit size (i.e. non-zero), it is simply returned; otherwise, | |
| 3067 the size is calculated by the maximum offset and the size of the | |
| 3068 object at that offset, rounded up to the maximum alignment. In | |
| 3069 this case, we may need the object, for example when retrieving an | |
| 3070 "indirect count" of an inlined array (the count is not constant, | |
| 3071 but is specified by one of the elements of the memory block). (It | |
| 3072 is generally not a problem if we return an overly large size -- we | |
| 3073 will simply end up reserving more space than necessary; but if the | |
| 3074 size is too small we could be in serious trouble, in particular | |
| 3075 with nested inlined structures, where there may be alignment | |
| 3076 padding in the middle of a block. #### In fact there is an (at | |
| 3077 least theoretical) problem with an overly large size -- we may | |
| 3078 trigger a protection fault when reading from invalid memory. We | |
| 3079 need to handle this -- perhaps in a stupid but dependable way, | |
| 3080 i.e. by trapping SIGSEGV and SIGBUS.) */ | |
| 3081 | |
| 3082 Bytecount | |
| 3083 lispdesc_structure_size (const void *obj, | |
| 3084 const struct sized_memory_description *sdesc) | |
| 3085 { | |
| 3086 EMACS_INT max_offset = -1; | |
| 3087 int max_offset_pos = -1; | |
| 3088 int pos; | |
| 3089 const struct memory_description *desc; | |
| 3090 | |
| 3091 if (sdesc->size) | |
| 3092 return sdesc->size; | |
| 3093 | |
| 3094 desc = sdesc->description; | |
| 3095 | |
| 3096 for (pos = 0; desc[pos].type != XD_END; pos++) | |
| 3097 { | |
| 3098 EMACS_INT offset = lispdesc_indirect_count (desc[pos].offset, desc, obj); | |
| 3099 if (offset == max_offset) | |
| 3100 { | |
| 3101 stderr_out ("Two relocatable elements at same offset?\n"); | |
| 3102 abort (); | |
| 3103 } | |
| 3104 else if (offset > max_offset) | |
| 3105 { | |
| 3106 max_offset = offset; | |
| 3107 max_offset_pos = pos; | |
| 3108 } | |
| 3109 } | |
| 3110 | |
| 3111 if (max_offset_pos < 0) | |
| 3112 return 0; | |
| 3113 | |
| 3114 { | |
| 3115 Bytecount size_at_max; | |
| 3116 size_at_max = | |
| 3117 lispdesc_one_description_line_size ((char *) obj + max_offset, | |
| 3118 &desc[max_offset_pos], obj, desc); | |
| 3119 | |
| 3120 /* We have no way of knowing the required alignment for this structure, | |
| 3121 so just make it maximally aligned. */ | |
| 3122 return MAX_ALIGN_SIZE (max_offset + size_at_max); | |
| 3123 } | |
| 3124 } | |
| 3125 | |
| 3126 #endif /* defined (USE_KKCC) || defined (PDUMP) */ | |
| 3127 | |
| 3128 #ifdef USE_KKCC | |
| 3129 /* The following functions implement the new mark algorithm. | |
| 3130 They mark objects according to their descriptions. They | |
| 3131 are modeled on the corresponding pdumper procedures. */ | |
| 3132 | |
| 3133 static void mark_struct_contents (const void *data, | |
| 3134 const struct sized_memory_description *sdesc, | |
| 3135 int count); | |
| 3136 | |
| 3137 | |
| 3138 #ifdef ERROR_CHECK_GC | |
| 3139 void | |
| 3140 mark_object_maybe_checking_free (Lisp_Object obj, int allow_free) | |
| 3141 { | |
| 3142 | |
| 3143 if (!allow_free && XTYPE (obj) == Lisp_Type_Record) | |
| 3144 { | |
| 3145 struct lrecord_header *lheader = XRECORD_LHEADER (obj); | |
| 3146 gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || | |
| 3147 ! ((struct lcrecord_header *) lheader)->free); | |
| 3148 } | |
| 3149 mark_object (obj); | |
| 3150 } | |
| 3151 #else | |
| 3152 #define mark_object_maybe_checking_free (obj, allow_free) mark_object (obj) | |
| 3153 #endif /* ERROR_CHECK_GC */ | |
| 2915 | 3154 |
| 2916 /* This function is called to mark the elements of an object. It processes | 3155 /* This function is called to mark the elements of an object. It processes |
| 2917 the description of the object and calls mark object with every described | 3156 the description of the object and calls mark object with every described |
| 2918 object. */ | 3157 object. */ |
| 2919 static void | 3158 static void |
| 2920 mark_with_description (const void *lheader, const struct lrecord_description *desc) | 3159 mark_with_description (const void *data, |
| 3160 const struct memory_description *desc) | |
| 2921 { | 3161 { |
| 2922 int pos; | 3162 int pos; |
| 2923 | 3163 static const Lisp_Object *last_occurred_object = (Lisp_Object *) 0; |
| 2924 static const Lisp_Object *last_occured_object = (Lisp_Object *) 0; | 3164 static int mark_last_occurred_object = 0; |
| 2925 static int mark_last_occured_object = 0; | 3165 #ifdef ERROR_CHECK_GC |
| 2926 | 3166 static int last_occurred_flags; |
| 2927 reprocess_desc: | 3167 #endif |
| 2928 for (pos=0; desc[pos].type != XD_END; pos++) | 3168 |
| 2929 { | 3169 for (pos = 0; desc[pos].type != XD_END; pos++) |
| 2930 const void *rdata = (const char *)lheader + desc[pos].offset; | 3170 { |
| 2931 switch (desc[pos].type) { | 3171 const struct memory_description *desc1 = &desc[pos]; |
| 2932 case XD_LISP_OBJECT: | 3172 const void *rdata = |
| 3173 (const char *) data + lispdesc_indirect_count (desc1->offset, | |
| 3174 desc, data); | |
| 3175 union_switcheroo: | |
| 3176 | |
| 3177 /* If the flag says don't mark, then don't mark. */ | |
| 3178 if ((desc1->flags) & XD_FLAG_NO_KKCC) | |
| 3179 continue; | |
| 3180 | |
| 3181 switch (desc1->type) | |
| 2933 { | 3182 { |
| 2934 const Lisp_Object *stored_obj = (const Lisp_Object *)rdata; | 3183 case XD_BYTECOUNT: |
| 2935 | 3184 case XD_ELEMCOUNT: |
| 2936 if (EQ (*stored_obj, Qnull_pointer)) | 3185 case XD_HASHCODE: |
| 3186 case XD_INT: | |
| 3187 case XD_LONG: | |
| 3188 case XD_INT_RESET: | |
| 3189 case XD_LO_LINK: | |
| 3190 case XD_OPAQUE_PTR: | |
| 3191 case XD_OPAQUE_DATA_PTR: | |
| 3192 case XD_C_STRING: | |
| 3193 case XD_DOC_STRING: | |
| 3194 break; | |
| 3195 case XD_LISP_OBJECT: | |
| 3196 { | |
| 3197 const Lisp_Object *stored_obj = (const Lisp_Object *) rdata; | |
| 3198 | |
| 3199 /* Because of the way that tagged objects work (pointers and | |
| 3200 Lisp_Objects have the same representation), XD_LISP_OBJECT | |
| 3201 can be used for untagged pointers. They might be NULL, | |
| 3202 though. */ | |
| 3203 if (EQ (*stored_obj, Qnull_pointer)) | |
| 3204 break; | |
| 3205 | |
| 3206 if (desc[pos+1].type == XD_END) | |
| 3207 { | |
| 3208 mark_last_occurred_object = 1; | |
| 3209 last_occurred_object = stored_obj; | |
| 3210 #ifdef ERROR_CHECK_GC | |
| 3211 last_occurred_flags = desc1->flags; | |
| 3212 #endif | |
| 3213 break; | |
| 3214 } | |
| 3215 else | |
| 3216 mark_object_maybe_checking_free | |
| 3217 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT); | |
| 3218 | |
| 2937 break; | 3219 break; |
| 2938 | 3220 } |
| 2939 if (desc[pos+1].type == XD_END) | 3221 case XD_LISP_OBJECT_ARRAY: |
| 2940 { | 3222 { |
| 2941 mark_last_occured_object = 1; | 3223 int i; |
| 2942 last_occured_object = stored_obj; | 3224 EMACS_INT count = |
| 2943 break; | 3225 lispdesc_indirect_count (desc1->data1, desc, data); |
| 2944 } | 3226 |
| 2945 else | 3227 for (i = 0; i < count; i++) |
| 2946 { | 3228 { |
| 2947 mark_object (*stored_obj); | 3229 const Lisp_Object *stored_obj = |
| 2948 } | 3230 (const Lisp_Object *) rdata + i; |
| 2949 | 3231 |
| 2950 | 3232 if (EQ (*stored_obj, Qnull_pointer)) |
| 3233 break; | |
| 3234 | |
| 3235 mark_object_maybe_checking_free | |
| 3236 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT); | |
| 3237 } | |
| 3238 break; | |
| 3239 } | |
| 3240 case XD_STRUCT_PTR: | |
| 3241 { | |
| 3242 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, | |
| 3243 data); | |
| 3244 const struct sized_memory_description *sdesc = | |
| 3245 lispdesc_indirect_description (data, desc1->data2); | |
| 3246 const char *dobj = * (const char **) rdata; | |
| 3247 if (dobj) | |
| 3248 mark_struct_contents (dobj, sdesc, count); | |
| 3249 break; | |
| 3250 } | |
| 3251 case XD_STRUCT_ARRAY: | |
| 3252 { | |
| 3253 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, | |
| 3254 data); | |
| 3255 const struct sized_memory_description *sdesc = | |
| 3256 lispdesc_indirect_description (data, desc1->data2); | |
| 3257 | |
| 3258 mark_struct_contents (rdata, sdesc, count); | |
| 3259 break; | |
| 3260 } | |
| 3261 case XD_UNION: | |
| 3262 case XD_UNION_DYNAMIC_SIZE: | |
| 3263 desc1 = lispdesc_process_xd_union (desc1, desc, data); | |
| 3264 if (desc1) | |
| 3265 goto union_switcheroo; | |
| 2951 break; | 3266 break; |
| 2952 } | |
| 2953 case XD_LISP_OBJECT_ARRAY: | |
| 2954 { | |
| 2955 int i; | |
| 2956 EMACS_INT count = desc[pos].data1; | |
| 2957 if (XD_IS_INDIRECT (count)) | |
| 2958 count = get_indirect_count (count, desc, lheader); | |
| 2959 | |
| 2960 for (i = 0; i < count; i++) | |
| 2961 { | |
| 2962 const Lisp_Object *stored_obj = ((const Lisp_Object *)rdata) + i; | |
| 2963 | |
| 2964 if (EQ (*stored_obj, Qnull_pointer)) | |
| 2965 break; | |
| 2966 | |
| 2967 mark_object (*stored_obj); | |
| 2968 } | |
| 2969 break; | |
| 2970 } | |
| 2971 case XD_SPECIFIER_END: | |
| 2972 desc = ((const Lisp_Specifier *)lheader)->methods->extra_description; | |
| 2973 goto reprocess_desc; | |
| 2974 break; | |
| 2975 case XD_CODING_SYSTEM_END: | |
| 2976 desc = ((const Lisp_Coding_System *)lheader)->methods->extra_description; | |
| 2977 goto reprocess_desc; | |
| 2978 break; | |
| 2979 case XD_BYTECOUNT: | |
| 2980 break; | |
| 2981 case XD_ELEMCOUNT: | |
| 2982 break; | |
| 2983 case XD_HASHCODE: | |
| 2984 break; | |
| 2985 case XD_INT: | |
| 2986 break; | |
| 2987 case XD_LONG: | |
| 2988 break; | |
| 2989 case XD_INT_RESET: | |
| 2990 break; | |
| 2991 case XD_LO_LINK: | |
| 2992 break; | |
| 2993 case XD_OPAQUE_PTR: | |
| 2994 break; | |
| 2995 case XD_OPAQUE_DATA_PTR: | |
| 2996 break; | |
| 2997 case XD_C_STRING: | |
| 2998 break; | |
| 2999 case XD_DOC_STRING: | |
| 3000 break; | |
| 3001 case XD_STRUCT_PTR: | |
| 3002 { | |
| 3003 EMACS_INT count = desc[pos].data1; | |
| 3004 const struct struct_description *sdesc = desc[pos].data2; | |
| 3005 const char *dobj = *(const char **)rdata; | |
| 3006 if (dobj) | |
| 3007 { | |
| 3008 if (XD_IS_INDIRECT (count)) | |
| 3009 count = get_indirect_count (count, desc, lheader); | |
| 3010 mark_struct_contents (dobj, sdesc, count); | |
| 3011 } | |
| 3012 break; | |
| 3013 } | |
| 3014 case XD_STRUCT_ARRAY: | |
| 3015 { | |
| 3016 EMACS_INT count = desc[pos].data1; | |
| 3017 const struct struct_description *sdesc = desc[pos].data2; | |
| 3018 | |
| 3019 if (XD_IS_INDIRECT (count)) | |
| 3020 count = get_indirect_count (count, desc, lheader); | |
| 3021 | |
| 3022 mark_struct_contents (rdata, sdesc, count); | |
| 3023 break; | |
| 3024 } | |
| 3025 case XD_UNION: | |
| 3026 { | |
| 3027 int count = 0; | |
| 3028 int variant = desc[pos].data1; | |
| 3029 const struct struct_description *sdesc = desc[pos].data2; | |
| 3030 const char *dobj = *(const char **)rdata; | |
| 3031 if (XD_IS_INDIRECT (variant)) | |
| 3032 variant = get_indirect_count (variant, desc, lheader); | |
| 3033 | |
| 3034 for (count=0; sdesc[count].size != XD_END; count++) | |
| 3035 { | |
| 3036 if (sdesc[count].size == variant) | |
| 3037 { | |
| 3038 mark_with_description(dobj, sdesc[count].description); | |
| 3039 break; | |
| 3040 } | |
| 3041 } | |
| 3042 break; | |
| 3043 } | |
| 3044 | 3267 |
| 3045 default: | 3268 default: |
| 3046 stderr_out ("Unsupported description type : %d\n", desc[pos].type); | 3269 stderr_out ("Unsupported description type : %d\n", desc1->type); |
| 3047 abort (); | |
| 3048 } | |
| 3049 } | |
| 3050 | |
| 3051 if (mark_last_occured_object) | |
| 3052 { | |
| 3053 mark_object(*last_occured_object); | |
| 3054 mark_last_occured_object = 0; | |
| 3055 } | |
| 3056 } | |
| 3057 | |
| 3058 | |
| 3059 /* This function calculates the size of a described struct. */ | |
| 3060 static Bytecount | |
| 3061 structure_size (const void *obj, const struct struct_description *sdesc) | |
| 3062 { | |
| 3063 int max_offset = -1; | |
| 3064 int max_offset_pos = -1; | |
| 3065 int size_at_max = 0; | |
| 3066 int pos; | |
| 3067 const struct lrecord_description *desc; | |
| 3068 void *rdata; | |
| 3069 | |
| 3070 if (sdesc->size) | |
| 3071 return sdesc->size; | |
| 3072 | |
| 3073 desc = sdesc->description; | |
| 3074 | |
| 3075 for (pos = 0; desc[pos].type != XD_END; pos++) | |
| 3076 { | |
| 3077 if (desc[pos].offset == max_offset) | |
| 3078 { | |
| 3079 stderr_out ("Two relocatable elements at same offset?\n"); | |
| 3080 abort (); | 3270 abort (); |
| 3081 } | 3271 } |
| 3082 else if (desc[pos].offset > max_offset) | 3272 } |
| 3083 { | 3273 |
| 3084 max_offset = desc[pos].offset; | 3274 if (mark_last_occurred_object) |
| 3085 max_offset_pos = pos; | 3275 { |
| 3086 } | 3276 /* NOTE: The second parameter isn't even evaluated |
| 3087 } | 3277 non-ERROR_CHECK_GC, so it's OK for the variable not to exist. |
| 3088 | 3278 */ |
| 3089 if (max_offset_pos < 0) | 3279 mark_object_maybe_checking_free (*last_occurred_object, |
| 3090 return 0; | 3280 last_occurred_flags & |
| 3091 | 3281 XD_FLAG_FREE_LISP_OBJECT); |
| 3092 pos = max_offset_pos; | 3282 mark_last_occurred_object = 0; |
| 3093 rdata = (char *) obj + desc[pos].offset; | 3283 } |
| 3094 | 3284 } |
| 3095 switch (desc[pos].type) | |
| 3096 { | |
| 3097 case XD_LISP_OBJECT_ARRAY: | |
| 3098 { | |
| 3099 EMACS_INT val = desc[pos].data1; | |
| 3100 if (XD_IS_INDIRECT (val)) | |
| 3101 val = get_indirect_count (val, desc, obj); | |
| 3102 size_at_max = val * sizeof (Lisp_Object); | |
| 3103 break; | |
| 3104 } | |
| 3105 case XD_LISP_OBJECT: | |
| 3106 case XD_LO_LINK: | |
| 3107 size_at_max = sizeof (Lisp_Object); | |
| 3108 break; | |
| 3109 case XD_OPAQUE_PTR: | |
| 3110 size_at_max = sizeof (void *); | |
| 3111 break; | |
| 3112 case XD_STRUCT_PTR: | |
| 3113 { | |
| 3114 EMACS_INT val = desc[pos].data1; | |
| 3115 if (XD_IS_INDIRECT (val)) | |
| 3116 val = get_indirect_count (val, desc, obj); | |
| 3117 size_at_max = val * sizeof (void *); | |
| 3118 break; | |
| 3119 } | |
| 3120 break; | |
| 3121 case XD_STRUCT_ARRAY: | |
| 3122 { | |
| 3123 EMACS_INT val = desc[pos].data1; | |
| 3124 | |
| 3125 if (XD_IS_INDIRECT (val)) | |
| 3126 val = get_indirect_count (val, desc, obj); | |
| 3127 | |
| 3128 size_at_max = val * structure_size (rdata, desc[pos].data2); | |
| 3129 break; | |
| 3130 } | |
| 3131 break; | |
| 3132 case XD_OPAQUE_DATA_PTR: | |
| 3133 size_at_max = sizeof (void *); | |
| 3134 break; | |
| 3135 case XD_UNION: | |
| 3136 abort (); | |
| 3137 break; | |
| 3138 case XD_C_STRING: | |
| 3139 size_at_max = sizeof (void *); | |
| 3140 break; | |
| 3141 case XD_DOC_STRING: | |
| 3142 size_at_max = sizeof (void *); | |
| 3143 break; | |
| 3144 case XD_INT_RESET: | |
| 3145 size_at_max = sizeof (int); | |
| 3146 break; | |
| 3147 case XD_BYTECOUNT: | |
| 3148 size_at_max = sizeof (Bytecount); | |
| 3149 break; | |
| 3150 case XD_ELEMCOUNT: | |
| 3151 size_at_max = sizeof (Elemcount); | |
| 3152 break; | |
| 3153 case XD_HASHCODE: | |
| 3154 size_at_max = sizeof (Hashcode); | |
| 3155 break; | |
| 3156 case XD_INT: | |
| 3157 size_at_max = sizeof (int); | |
| 3158 break; | |
| 3159 case XD_LONG: | |
| 3160 size_at_max = sizeof (long); | |
| 3161 break; | |
| 3162 case XD_SPECIFIER_END: | |
| 3163 case XD_CODING_SYSTEM_END: | |
| 3164 stderr_out | |
| 3165 ("Should not be seeing XD_SPECIFIER_END or\n" | |
| 3166 "XD_CODING_SYSTEM_END outside of struct Lisp_Specifier\n" | |
| 3167 "and struct Lisp_Coding_System.\n"); | |
| 3168 abort (); | |
| 3169 default: | |
| 3170 stderr_out ("Unsupported dump type : %d\n", desc[pos].type); | |
| 3171 abort (); | |
| 3172 } | |
| 3173 | |
| 3174 return ALIGN_SIZE (max_offset + size_at_max, ALIGNOF (max_align_t)); | |
| 3175 } | |
| 3176 | |
| 3177 | 3285 |
| 3178 /* This function loops all elements of a struct pointer and calls | 3286 /* This function loops all elements of a struct pointer and calls |
| 3179 mark_with_description with each element. */ | 3287 mark_with_description with each element. */ |
| 3180 static void | 3288 static void |
| 3181 mark_struct_contents (const void *data, | 3289 mark_struct_contents (const void *data, |
| 3182 const struct struct_description *sdesc, | 3290 const struct sized_memory_description *sdesc, |
| 3183 int count) | 3291 int count) |
| 3184 { | 3292 { |
| 3185 int i; | 3293 int i; |
| 3186 Bytecount elsize; | 3294 Bytecount elsize; |
| 3187 elsize = structure_size (data, sdesc); | 3295 elsize = lispdesc_structure_size (data, sdesc); |
| 3188 | 3296 |
| 3189 for (i = 0; i < count; i++) | 3297 for (i = 0; i < count; i++) |
| 3190 { | 3298 { |
| 3191 mark_with_description (((char *) data) + elsize * i, | 3299 mark_with_description (((char *) data) + elsize * i, |
| 3192 sdesc->description); | 3300 sdesc->description); |
| 3209 /* if (PURIFIED (XPNTR (obj))) return; */ | 3317 /* if (PURIFIED (XPNTR (obj))) return; */ |
| 3210 | 3318 |
| 3211 if (XTYPE (obj) == Lisp_Type_Record) | 3319 if (XTYPE (obj) == Lisp_Type_Record) |
| 3212 { | 3320 { |
| 3213 struct lrecord_header *lheader = XRECORD_LHEADER (obj); | 3321 struct lrecord_header *lheader = XRECORD_LHEADER (obj); |
| 3214 #ifdef USE_KKCC | |
| 3215 const struct lrecord_implementation *imp; | |
| 3216 const struct lrecord_description *desc; | |
| 3217 #endif /* USE_KKCC */ | |
| 3218 | 3322 |
| 3219 GC_CHECK_LHEADER_INVARIANTS (lheader); | 3323 GC_CHECK_LHEADER_INVARIANTS (lheader); |
| 3220 | 3324 |
| 3325 #ifndef USE_KKCC | |
| 3326 /* We handle this separately, above, so we can mark free objects */ | |
| 3221 gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || | 3327 gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p || |
| 3222 ! ((struct lcrecord_header *) lheader)->free); | 3328 ! ((struct lcrecord_header *) lheader)->free); |
| 3329 #endif /* not USE_KKCC */ | |
| 3330 | |
| 3223 | 3331 |
| 3224 /* All c_readonly objects have their mark bit set, | 3332 /* All c_readonly objects have their mark bit set, |
| 3225 so that we only need to check the mark bit here. */ | 3333 so that we only need to check the mark bit here. */ |
| 3226 if (! MARKED_RECORD_HEADER_P (lheader)) | 3334 if (! MARKED_RECORD_HEADER_P (lheader)) |
| 3227 { | 3335 { |
| 3228 MARK_RECORD_HEADER (lheader); | 3336 MARK_RECORD_HEADER (lheader); |
| 3229 | 3337 |
| 3338 { | |
| 3230 #ifdef USE_KKCC | 3339 #ifdef USE_KKCC |
| 3231 imp = LHEADER_IMPLEMENTATION (lheader); | 3340 const struct lrecord_implementation *imp; |
| 3232 desc = imp->description; | 3341 const struct memory_description *desc; |
| 3342 | |
| 3343 imp = LHEADER_IMPLEMENTATION (lheader); | |
| 3344 desc = imp->description; | |
| 3233 | 3345 |
| 3234 if (desc) /* && !CONSP(obj))*/ /* KKCC cons special case */ | 3346 if (desc) /* && !CONSP(obj))*/ /* KKCC cons special case */ |
| 3235 { | 3347 { |
| 3236 mark_with_description (lheader, desc); | 3348 mark_with_description (lheader, desc); |
| 3237 } | 3349 } |
| 3238 | 3350 else |
| 3239 else | |
| 3240 { | |
| 3241 | |
| 3242 #endif /* USE_KKCC */ | 3351 #endif /* USE_KKCC */ |
| 3243 | 3352 { |
| 3244 | 3353 if (RECORD_MARKER (lheader)) |
| 3245 if (RECORD_MARKER (lheader)) | 3354 { |
| 3246 { | 3355 obj = RECORD_MARKER (lheader) (obj); |
| 3247 obj = RECORD_MARKER (lheader) (obj); | 3356 if (!NILP (obj)) goto tail_recurse; |
| 3248 if (!NILP (obj)) goto tail_recurse; | 3357 } |
| 3249 } | 3358 } |
| 3250 | 3359 } |
| 3251 #ifdef USE_KKCC | |
| 3252 } | |
| 3253 #endif /* USE_KKCC */ | |
| 3254 } | 3360 } |
| 3255 } | 3361 } |
| 3256 } | |
| 3257 | |
| 3258 /* mark all of the conses in a list and mark the final cdr; but | |
| 3259 DO NOT mark the cars. | |
| 3260 | |
| 3261 Use only for internal lists! There should never be other pointers | |
| 3262 to the cons cells, because if so, the cars will remain unmarked | |
| 3263 even when they maybe should be marked. */ | |
| 3264 void | |
| 3265 mark_conses_in_list (Lisp_Object obj) | |
| 3266 { | |
| 3267 Lisp_Object rest; | |
| 3268 | |
| 3269 for (rest = obj; CONSP (rest); rest = XCDR (rest)) | |
| 3270 { | |
| 3271 if (CONS_MARKED_P (XCONS (rest))) | |
| 3272 return; | |
| 3273 MARK_CONS (XCONS (rest)); | |
| 3274 } | |
| 3275 | |
| 3276 mark_object (rest); | |
| 3277 } | 3362 } |
| 3278 | 3363 |
| 3279 | 3364 |
| 3280 /* Find all structures not marked, and free them. */ | 3365 /* Find all structures not marked, and free them. */ |
| 3281 | 3366 |
| 3282 static int gc_count_num_bit_vector_used, gc_count_bit_vector_total_size; | |
| 3283 static int gc_count_bit_vector_storage; | |
| 3284 static int gc_count_num_short_string_in_use; | 3367 static int gc_count_num_short_string_in_use; |
| 3285 static Bytecount gc_count_string_total_size; | 3368 static Bytecount gc_count_string_total_size; |
| 3286 static Bytecount gc_count_short_string_total_size; | 3369 static Bytecount gc_count_short_string_total_size; |
| 3287 | 3370 |
| 3288 /* static int gc_count_total_records_used, gc_count_records_total_size; */ | 3371 /* static int gc_count_total_records_used, gc_count_records_total_size; */ |
| 3310 gc_checking_assert (!free_p); | 3393 gc_checking_assert (!free_p); |
| 3311 lcrecord_stats[type_index].instances_on_free_list++; | 3394 lcrecord_stats[type_index].instances_on_free_list++; |
| 3312 } | 3395 } |
| 3313 else | 3396 else |
| 3314 { | 3397 { |
| 3315 const struct lrecord_implementation *implementation = | 3398 Bytecount sz = detagged_lisp_object_size (h); |
| 3316 LHEADER_IMPLEMENTATION (h); | 3399 |
| 3317 | |
| 3318 Bytecount sz = (implementation->size_in_bytes_method ? | |
| 3319 implementation->size_in_bytes_method (h) : | |
| 3320 implementation->static_size); | |
| 3321 if (free_p) | 3400 if (free_p) |
| 3322 { | 3401 { |
| 3323 lcrecord_stats[type_index].instances_freed++; | 3402 lcrecord_stats[type_index].instances_freed++; |
| 3324 lcrecord_stats[type_index].bytes_freed += sz; | 3403 lcrecord_stats[type_index].bytes_freed += sz; |
| 3325 } | 3404 } |
| 3389 header = next; | 3468 header = next; |
| 3390 } | 3469 } |
| 3391 } | 3470 } |
| 3392 *used = num_used; | 3471 *used = num_used; |
| 3393 /* *total = total_size; */ | 3472 /* *total = total_size; */ |
| 3394 } | |
| 3395 | |
| 3396 | |
| 3397 static void | |
| 3398 sweep_bit_vectors_1 (Lisp_Object *prev, | |
| 3399 int *used, int *total, int *storage) | |
| 3400 { | |
| 3401 Lisp_Object bit_vector; | |
| 3402 int num_used = 0; | |
| 3403 int total_size = 0; | |
| 3404 int total_storage = 0; | |
| 3405 | |
| 3406 /* BIT_VECTORP fails because the objects are marked, which changes | |
| 3407 their implementation */ | |
| 3408 for (bit_vector = *prev; !EQ (bit_vector, Qzero); ) | |
| 3409 { | |
| 3410 Lisp_Bit_Vector *v = XBIT_VECTOR (bit_vector); | |
| 3411 int len = v->size; | |
| 3412 if (MARKED_RECORD_P (bit_vector)) | |
| 3413 { | |
| 3414 if (! C_READONLY_RECORD_HEADER_P(&(v->lheader))) | |
| 3415 UNMARK_RECORD_HEADER (&(v->lheader)); | |
| 3416 total_size += len; | |
| 3417 total_storage += | |
| 3418 MALLOC_OVERHEAD + | |
| 3419 FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, | |
| 3420 bits, BIT_VECTOR_LONG_STORAGE (len)); | |
| 3421 num_used++; | |
| 3422 /* #### May modify next on a C_READONLY bitvector */ | |
| 3423 prev = &(bit_vector_next (v)); | |
| 3424 bit_vector = *prev; | |
| 3425 } | |
| 3426 else | |
| 3427 { | |
| 3428 Lisp_Object next = bit_vector_next (v); | |
| 3429 *prev = next; | |
| 3430 xfree (v); | |
| 3431 bit_vector = next; | |
| 3432 } | |
| 3433 } | |
| 3434 *used = num_used; | |
| 3435 *total = total_size; | |
| 3436 *storage = total_storage; | |
| 3437 } | 3473 } |
| 3438 | 3474 |
| 3439 /* And the Lord said: Thou shalt use the `c-backslash-region' command | 3475 /* And the Lord said: Thou shalt use the `c-backslash-region' command |
| 3440 to make macros prettier. */ | 3476 to make macros prettier. */ |
| 3441 | 3477 |
| 3592 /* If the CAR is not an int, then it will be a pointer, which will | 3628 /* If the CAR is not an int, then it will be a pointer, which will |
| 3593 always be four-byte aligned. If this cons cell has already been | 3629 always be four-byte aligned. If this cons cell has already been |
| 3594 placed on the free list, however, its car will probably contain | 3630 placed on the free list, however, its car will probably contain |
| 3595 a chain pointer to the next cons on the list, which has cleverly | 3631 a chain pointer to the next cons on the list, which has cleverly |
| 3596 had all its 0's and 1's inverted. This allows for a quick | 3632 had all its 0's and 1's inverted. This allows for a quick |
| 3597 check to make sure we're not freeing something already freed. */ | 3633 check to make sure we're not freeing something already freed. |
| 3634 | |
| 3635 NOTE: This check may not be necessary. Freeing an object sets its | |
| 3636 type to lrecord_type_free, which will trip up the XCONS() above -- as | |
| 3637 well as a check in FREE_FIXED_TYPE(). */ | |
| 3598 if (POINTER_TYPE_P (XTYPE (cons_car (ptr)))) | 3638 if (POINTER_TYPE_P (XTYPE (cons_car (ptr)))) |
| 3599 ASSERT_VALID_POINTER (XPNTR (cons_car (ptr))); | 3639 ASSERT_VALID_POINTER (XPNTR (cons_car (ptr))); |
| 3600 #endif /* ERROR_CHECK_GC */ | 3640 #endif /* ERROR_CHECK_GC */ |
| 3601 | 3641 |
| 3602 #ifndef ALLOC_NO_POOLS | |
| 3603 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, Lisp_Cons, ptr); | 3642 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, Lisp_Cons, ptr); |
| 3604 #endif /* ALLOC_NO_POOLS */ | |
| 3605 } | 3643 } |
| 3606 | 3644 |
| 3607 /* explicitly free a list. You **must make sure** that you have | 3645 /* explicitly free a list. You **must make sure** that you have |
| 3608 created all the cons cells that make up this list and that there | 3646 created all the cons cells that make up this list and that there |
| 3609 are no pointers to any of these cons cells anywhere else. If there | 3647 are no pointers to any of these cons cells anywhere else. If there |
| 3683 #define ADDITIONAL_FREE_event(ptr) | 3721 #define ADDITIONAL_FREE_event(ptr) |
| 3684 | 3722 |
| 3685 SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event); | 3723 SWEEP_FIXED_TYPE_BLOCK (event, Lisp_Event); |
| 3686 } | 3724 } |
| 3687 | 3725 |
| 3688 #ifdef USE_KKCC | 3726 #ifdef EVENT_DATA_AS_OBJECTS |
| 3689 | 3727 |
| 3690 static void | 3728 static void |
| 3691 sweep_key_data (void) | 3729 sweep_key_data (void) |
| 3692 { | 3730 { |
| 3693 #define UNMARK_key_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3731 #define UNMARK_key_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
| 3694 #define ADDITIONAL_FREE_key_data(ptr) | 3732 #define ADDITIONAL_FREE_key_data(ptr) |
| 3695 | 3733 |
| 3696 SWEEP_FIXED_TYPE_BLOCK (key_data, Lisp_Key_Data); | 3734 SWEEP_FIXED_TYPE_BLOCK (key_data, Lisp_Key_Data); |
| 3697 } | 3735 } |
| 3698 | 3736 |
| 3737 void | |
| 3738 free_key_data (Lisp_Object ptr) | |
| 3739 { | |
| 3740 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (key_data, Lisp_Key_Data, XKEY_DATA (ptr)); | |
| 3741 } | |
| 3742 | |
| 3699 static void | 3743 static void |
| 3700 sweep_button_data (void) | 3744 sweep_button_data (void) |
| 3701 { | 3745 { |
| 3702 #define UNMARK_button_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3746 #define UNMARK_button_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
| 3703 #define ADDITIONAL_FREE_button_data(ptr) | 3747 #define ADDITIONAL_FREE_button_data(ptr) |
| 3704 | 3748 |
| 3705 SWEEP_FIXED_TYPE_BLOCK (button_data, Lisp_Button_Data); | 3749 SWEEP_FIXED_TYPE_BLOCK (button_data, Lisp_Button_Data); |
| 3706 } | 3750 } |
| 3707 | 3751 |
| 3752 void | |
| 3753 free_button_data (Lisp_Object ptr) | |
| 3754 { | |
| 3755 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (button_data, Lisp_Button_Data, XBUTTON_DATA (ptr)); | |
| 3756 } | |
| 3757 | |
| 3708 static void | 3758 static void |
| 3709 sweep_motion_data (void) | 3759 sweep_motion_data (void) |
| 3710 { | 3760 { |
| 3711 #define UNMARK_motion_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3761 #define UNMARK_motion_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
| 3712 #define ADDITIONAL_FREE_motion_data(ptr) | 3762 #define ADDITIONAL_FREE_motion_data(ptr) |
| 3713 | 3763 |
| 3714 SWEEP_FIXED_TYPE_BLOCK (motion_data, Lisp_Motion_Data); | 3764 SWEEP_FIXED_TYPE_BLOCK (motion_data, Lisp_Motion_Data); |
| 3715 } | 3765 } |
| 3716 | 3766 |
| 3767 void | |
| 3768 free_motion_data (Lisp_Object ptr) | |
| 3769 { | |
| 3770 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (motion_data, Lisp_Motion_Data, XMOTION_DATA (ptr)); | |
| 3771 } | |
| 3772 | |
| 3717 static void | 3773 static void |
| 3718 sweep_process_data (void) | 3774 sweep_process_data (void) |
| 3719 { | 3775 { |
| 3720 #define UNMARK_process_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3776 #define UNMARK_process_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
| 3721 #define ADDITIONAL_FREE_process_data(ptr) | 3777 #define ADDITIONAL_FREE_process_data(ptr) |
| 3722 | 3778 |
| 3723 SWEEP_FIXED_TYPE_BLOCK (process_data, Lisp_Process_Data); | 3779 SWEEP_FIXED_TYPE_BLOCK (process_data, Lisp_Process_Data); |
| 3724 } | 3780 } |
| 3725 | 3781 |
| 3782 void | |
| 3783 free_process_data (Lisp_Object ptr) | |
| 3784 { | |
| 3785 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (process_data, Lisp_Process_Data, XPROCESS_DATA (ptr)); | |
| 3786 } | |
| 3787 | |
| 3726 static void | 3788 static void |
| 3727 sweep_timeout_data (void) | 3789 sweep_timeout_data (void) |
| 3728 { | 3790 { |
| 3729 #define UNMARK_timeout_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3791 #define UNMARK_timeout_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
| 3730 #define ADDITIONAL_FREE_timeout_data(ptr) | 3792 #define ADDITIONAL_FREE_timeout_data(ptr) |
| 3731 | 3793 |
| 3732 SWEEP_FIXED_TYPE_BLOCK (timeout_data, Lisp_Timeout_Data); | 3794 SWEEP_FIXED_TYPE_BLOCK (timeout_data, Lisp_Timeout_Data); |
| 3733 } | 3795 } |
| 3734 | 3796 |
| 3797 void | |
| 3798 free_timeout_data (Lisp_Object ptr) | |
| 3799 { | |
| 3800 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (timeout_data, Lisp_Timeout_Data, XTIMEOUT_DATA (ptr)); | |
| 3801 } | |
| 3802 | |
| 3735 static void | 3803 static void |
| 3736 sweep_magic_data (void) | 3804 sweep_magic_data (void) |
| 3737 { | 3805 { |
| 3738 #define UNMARK_magic_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3806 #define UNMARK_magic_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
| 3739 #define ADDITIONAL_FREE_magic_data(ptr) | 3807 #define ADDITIONAL_FREE_magic_data(ptr) |
| 3740 | 3808 |
| 3741 SWEEP_FIXED_TYPE_BLOCK (magic_data, Lisp_Magic_Data); | 3809 SWEEP_FIXED_TYPE_BLOCK (magic_data, Lisp_Magic_Data); |
| 3742 } | 3810 } |
| 3743 | 3811 |
| 3812 void | |
| 3813 free_magic_data (Lisp_Object ptr) | |
| 3814 { | |
| 3815 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_data, Lisp_Magic_Data, XMAGIC_DATA (ptr)); | |
| 3816 } | |
| 3817 | |
| 3744 static void | 3818 static void |
| 3745 sweep_magic_eval_data (void) | 3819 sweep_magic_eval_data (void) |
| 3746 { | 3820 { |
| 3747 #define UNMARK_magic_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3821 #define UNMARK_magic_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
| 3748 #define ADDITIONAL_FREE_magic_eval_data(ptr) | 3822 #define ADDITIONAL_FREE_magic_eval_data(ptr) |
| 3749 | 3823 |
| 3750 SWEEP_FIXED_TYPE_BLOCK (magic_eval_data, Lisp_Magic_Eval_Data); | 3824 SWEEP_FIXED_TYPE_BLOCK (magic_eval_data, Lisp_Magic_Eval_Data); |
| 3751 } | 3825 } |
| 3752 | 3826 |
| 3827 void | |
| 3828 free_magic_eval_data (Lisp_Object ptr) | |
| 3829 { | |
| 3830 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_eval_data, Lisp_Magic_Eval_Data, XMAGIC_EVAL_DATA (ptr)); | |
| 3831 } | |
| 3832 | |
| 3753 static void | 3833 static void |
| 3754 sweep_eval_data (void) | 3834 sweep_eval_data (void) |
| 3755 { | 3835 { |
| 3756 #define UNMARK_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3836 #define UNMARK_eval_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
| 3757 #define ADDITIONAL_FREE_eval_data(ptr) | 3837 #define ADDITIONAL_FREE_eval_data(ptr) |
| 3758 | 3838 |
| 3759 SWEEP_FIXED_TYPE_BLOCK (eval_data, Lisp_Eval_Data); | 3839 SWEEP_FIXED_TYPE_BLOCK (eval_data, Lisp_Eval_Data); |
| 3760 } | 3840 } |
| 3761 | 3841 |
| 3842 void | |
| 3843 free_eval_data (Lisp_Object ptr) | |
| 3844 { | |
| 3845 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (eval_data, Lisp_Eval_Data, XEVAL_DATA (ptr)); | |
| 3846 } | |
| 3847 | |
| 3762 static void | 3848 static void |
| 3763 sweep_misc_user_data (void) | 3849 sweep_misc_user_data (void) |
| 3764 { | 3850 { |
| 3765 #define UNMARK_misc_user_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3851 #define UNMARK_misc_user_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
| 3766 #define ADDITIONAL_FREE_misc_user_data(ptr) | 3852 #define ADDITIONAL_FREE_misc_user_data(ptr) |
| 3767 | 3853 |
| 3768 SWEEP_FIXED_TYPE_BLOCK (misc_user_data, Lisp_Misc_User_Data); | 3854 SWEEP_FIXED_TYPE_BLOCK (misc_user_data, Lisp_Misc_User_Data); |
| 3769 } | 3855 } |
| 3770 | 3856 |
| 3771 #endif /* USE_KKCC */ | 3857 void |
| 3858 free_misc_user_data (Lisp_Object ptr) | |
| 3859 { | |
| 3860 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (misc_user_data, Lisp_Misc_User_Data, XMISC_USER_DATA (ptr)); | |
| 3861 } | |
| 3862 | |
| 3863 #endif /* EVENT_DATA_AS_OBJECTS */ | |
| 3772 | 3864 |
| 3773 static void | 3865 static void |
| 3774 sweep_markers (void) | 3866 sweep_markers (void) |
| 3775 { | 3867 { |
| 3776 #define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) | 3868 #define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) |
| 3783 SWEEP_FIXED_TYPE_BLOCK (marker, Lisp_Marker); | 3875 SWEEP_FIXED_TYPE_BLOCK (marker, Lisp_Marker); |
| 3784 } | 3876 } |
| 3785 | 3877 |
| 3786 /* Explicitly free a marker. */ | 3878 /* Explicitly free a marker. */ |
| 3787 void | 3879 void |
| 3788 free_marker (Lisp_Marker *ptr) | 3880 free_marker (Lisp_Object ptr) |
| 3789 { | 3881 { |
| 3790 /* Perhaps this will catch freeing an already-freed marker. */ | 3882 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, XMARKER (ptr)); |
| 3791 gc_checking_assert (ptr->lheader.type == lrecord_type_marker); | |
| 3792 | |
| 3793 #ifndef ALLOC_NO_POOLS | |
| 3794 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, ptr); | |
| 3795 #endif /* ALLOC_NO_POOLS */ | |
| 3796 } | 3883 } |
| 3797 | 3884 |
| 3798 | 3885 |
| 3799 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) | 3886 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) |
| 3800 | 3887 |
| 3840 } | 3927 } |
| 3841 assert (pos == sb->pos); | 3928 assert (pos == sb->pos); |
| 3842 } | 3929 } |
| 3843 } | 3930 } |
| 3844 | 3931 |
| 3845 #endif /* MULE && ERROR_CHECK_GC */ | 3932 #endif /* defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) */ |
| 3846 | 3933 |
| 3847 /* Compactify string chars, relocating the reference to each -- | 3934 /* Compactify string chars, relocating the reference to each -- |
| 3848 free any empty string_chars_block we see. */ | 3935 free any empty string_chars_block we see. */ |
| 3849 static void | 3936 static void |
| 3850 compact_string_chars (void) | 3937 compact_string_chars (void) |
| 3882 from_pos += fullsize; | 3969 from_pos += fullsize; |
| 3883 continue; | 3970 continue; |
| 3884 } | 3971 } |
| 3885 | 3972 |
| 3886 string = from_s_chars->string; | 3973 string = from_s_chars->string; |
| 3887 assert (!(LRECORD_FREE_P (string))); | 3974 gc_checking_assert (!(LRECORD_FREE_P (string))); |
| 3888 | 3975 |
| 3889 size = string->size_; | 3976 size = string->size_; |
| 3890 fullsize = STRING_FULLSIZE (size); | 3977 fullsize = STRING_FULLSIZE (size); |
| 3891 | 3978 |
| 3892 gc_checking_assert (! BIG_STRING_FULLSIZE_P (fullsize)); | 3979 gc_checking_assert (! BIG_STRING_FULLSIZE_P (fullsize)); |
| 4052 sweep_strings (); | 4139 sweep_strings (); |
| 4053 | 4140 |
| 4054 /* Put all unmarked conses on free list */ | 4141 /* Put all unmarked conses on free list */ |
| 4055 sweep_conses (); | 4142 sweep_conses (); |
| 4056 | 4143 |
| 4057 /* Free all unmarked bit vectors */ | |
| 4058 sweep_bit_vectors_1 (&all_bit_vectors, | |
| 4059 &gc_count_num_bit_vector_used, | |
| 4060 &gc_count_bit_vector_total_size, | |
| 4061 &gc_count_bit_vector_storage); | |
| 4062 | |
| 4063 /* Free all unmarked compiled-function objects */ | 4144 /* Free all unmarked compiled-function objects */ |
| 4064 sweep_compiled_functions (); | 4145 sweep_compiled_functions (); |
| 4065 | 4146 |
| 4066 /* Put all unmarked floats on free list */ | 4147 /* Put all unmarked floats on free list */ |
| 4067 sweep_floats (); | 4148 sweep_floats (); |
| 4076 Dechain each one first from the buffer into which it points. */ | 4157 Dechain each one first from the buffer into which it points. */ |
| 4077 sweep_markers (); | 4158 sweep_markers (); |
| 4078 | 4159 |
| 4079 sweep_events (); | 4160 sweep_events (); |
| 4080 | 4161 |
| 4081 #ifdef USE_KKCC | 4162 #ifdef EVENT_DATA_AS_OBJECTS |
| 4082 sweep_key_data (); | 4163 sweep_key_data (); |
| 4083 sweep_button_data (); | 4164 sweep_button_data (); |
| 4084 sweep_motion_data (); | 4165 sweep_motion_data (); |
| 4085 sweep_process_data (); | 4166 sweep_process_data (); |
| 4086 sweep_timeout_data (); | 4167 sweep_timeout_data (); |
| 4087 sweep_magic_data (); | 4168 sweep_magic_data (); |
| 4088 sweep_magic_eval_data (); | 4169 sweep_magic_eval_data (); |
| 4089 sweep_eval_data (); | 4170 sweep_eval_data (); |
| 4090 sweep_misc_user_data (); | 4171 sweep_misc_user_data (); |
| 4091 #endif /* USE_KKCC */ | 4172 #endif /* EVENT_DATA_AS_OBJECTS */ |
| 4092 | 4173 |
| 4093 #ifdef PDUMP | 4174 #ifdef PDUMP |
| 4094 pdump_objects_unmark (); | 4175 pdump_objects_unmark (); |
| 4095 #endif | 4176 #endif |
| 4096 } | 4177 } |
| 4354 | 4435 |
| 4355 /* Do some totally ad-hoc resource clearing. */ | 4436 /* Do some totally ad-hoc resource clearing. */ |
| 4356 /* #### generalize this? */ | 4437 /* #### generalize this? */ |
| 4357 clear_event_resource (); | 4438 clear_event_resource (); |
| 4358 cleanup_specifiers (); | 4439 cleanup_specifiers (); |
| 4440 cleanup_buffer_undo_lists (); | |
| 4359 | 4441 |
| 4360 /* Mark all the special slots that serve as the roots of accessibility. */ | 4442 /* Mark all the special slots that serve as the roots of accessibility. */ |
| 4361 | 4443 |
| 4362 { /* staticpro() */ | 4444 { /* staticpro() */ |
| 4363 Lisp_Object **p = Dynarr_begin (staticpros); | 4445 Lisp_Object **p = Dynarr_begin (staticpros); |
| 4605 pl = gc_plist_hack ("compiled-functions-free", | 4687 pl = gc_plist_hack ("compiled-functions-free", |
| 4606 gc_count_num_compiled_function_freelist, pl); | 4688 gc_count_num_compiled_function_freelist, pl); |
| 4607 pl = gc_plist_hack ("compiled-functions-used", | 4689 pl = gc_plist_hack ("compiled-functions-used", |
| 4608 gc_count_num_compiled_function_in_use, pl); | 4690 gc_count_num_compiled_function_in_use, pl); |
| 4609 | 4691 |
| 4610 pl = gc_plist_hack ("bit-vector-storage", gc_count_bit_vector_storage, pl); | |
| 4611 pl = gc_plist_hack ("bit-vectors-total-length", | |
| 4612 gc_count_bit_vector_total_size, pl); | |
| 4613 pl = gc_plist_hack ("bit-vectors-used", gc_count_num_bit_vector_used, pl); | |
| 4614 | |
| 4615 HACK_O_MATIC (symbol, "symbol-storage", pl); | 4692 HACK_O_MATIC (symbol, "symbol-storage", pl); |
| 4616 pl = gc_plist_hack ("symbols-free", gc_count_num_symbol_freelist, pl); | 4693 pl = gc_plist_hack ("symbols-free", gc_count_num_symbol_freelist, pl); |
| 4617 pl = gc_plist_hack ("symbols-used", gc_count_num_symbol_in_use, pl); | 4694 pl = gc_plist_hack ("symbols-used", gc_count_num_symbol_in_use, pl); |
| 4618 | 4695 |
| 4619 HACK_O_MATIC (cons, "cons-storage", pl); | 4696 HACK_O_MATIC (cons, "cons-storage", pl); |
| 4843 #endif /* MEMORY_USAGE_STATS */ | 4920 #endif /* MEMORY_USAGE_STATS */ |
| 4844 | 4921 |
| 4845 | 4922 |
| 4846 /* Initialization */ | 4923 /* Initialization */ |
| 4847 static void | 4924 static void |
| 4848 common_init_alloc_once_early (void) | 4925 common_init_alloc_early (void) |
| 4849 { | 4926 { |
| 4850 #ifndef Qzero | 4927 #ifndef Qzero |
| 4851 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */ | 4928 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */ |
| 4852 #endif | 4929 #endif |
| 4853 | 4930 |
| 4857 Qnull_pointer = wrap_pointer_1 (0); | 4934 Qnull_pointer = wrap_pointer_1 (0); |
| 4858 #endif | 4935 #endif |
| 4859 | 4936 |
| 4860 gc_generation_number[0] = 0; | 4937 gc_generation_number[0] = 0; |
| 4861 breathing_space = 0; | 4938 breathing_space = 0; |
| 4862 all_bit_vectors = Qzero; | |
| 4863 Vgc_message = Qzero; | 4939 Vgc_message = Qzero; |
| 4864 all_lcrecords = 0; | 4940 all_lcrecords = 0; |
| 4865 ignore_malloc_warnings = 1; | 4941 ignore_malloc_warnings = 1; |
| 4866 #ifdef DOUG_LEA_MALLOC | 4942 #ifdef DOUG_LEA_MALLOC |
| 4867 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */ | 4943 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */ |
| 4877 init_compiled_function_alloc (); | 4953 init_compiled_function_alloc (); |
| 4878 init_float_alloc (); | 4954 init_float_alloc (); |
| 4879 init_marker_alloc (); | 4955 init_marker_alloc (); |
| 4880 init_extent_alloc (); | 4956 init_extent_alloc (); |
| 4881 init_event_alloc (); | 4957 init_event_alloc (); |
| 4882 #ifdef USE_KKCC | 4958 #ifdef EVENT_DATA_AS_OBJECTS |
| 4883 init_key_data_alloc (); | 4959 init_key_data_alloc (); |
| 4884 init_button_data_alloc (); | 4960 init_button_data_alloc (); |
| 4885 init_motion_data_alloc (); | 4961 init_motion_data_alloc (); |
| 4886 init_process_data_alloc (); | 4962 init_process_data_alloc (); |
| 4887 init_timeout_data_alloc (); | 4963 init_timeout_data_alloc (); |
| 4888 init_magic_data_alloc (); | 4964 init_magic_data_alloc (); |
| 4889 init_magic_eval_data_alloc (); | 4965 init_magic_eval_data_alloc (); |
| 4890 init_eval_data_alloc (); | 4966 init_eval_data_alloc (); |
| 4891 init_misc_user_data_alloc (); | 4967 init_misc_user_data_alloc (); |
| 4892 #endif /* USE_KKCC */ | 4968 #endif /* EVENT_DATA_AS_OBJECTS */ |
| 4893 | 4969 |
| 4894 ignore_malloc_warnings = 0; | 4970 ignore_malloc_warnings = 0; |
| 4895 | 4971 |
| 4896 if (staticpros_nodump) | 4972 if (staticpros_nodump) |
| 4897 Dynarr_free (staticpros_nodump); | 4973 Dynarr_free (staticpros_nodump); |
| 4918 gc_cons_percentage = 0; /* #### 20; Don't have an accurate measure of | 4994 gc_cons_percentage = 0; /* #### 20; Don't have an accurate measure of |
| 4919 memory usage on Windows; not verified on other | 4995 memory usage on Windows; not verified on other |
| 4920 systems */ | 4996 systems */ |
| 4921 lrecord_uid_counter = 259; | 4997 lrecord_uid_counter = 259; |
| 4922 debug_string_purity = 0; | 4998 debug_string_purity = 0; |
| 4923 gcprolist = 0; | |
| 4924 | 4999 |
| 4925 gc_currently_forbidden = 0; | 5000 gc_currently_forbidden = 0; |
| 4926 gc_hooks_inhibited = 0; | 5001 gc_hooks_inhibited = 0; |
| 4927 | 5002 |
| 4928 #ifdef ERROR_CHECK_TYPES | 5003 #ifdef ERROR_CHECK_TYPES |
| 4950 staticpro_nodump (&all_lcrecord_lists[i]); | 5025 staticpro_nodump (&all_lcrecord_lists[i]); |
| 4951 } | 5026 } |
| 4952 } | 5027 } |
| 4953 | 5028 |
| 4954 void | 5029 void |
| 4955 reinit_alloc_once_early (void) | 5030 init_alloc_early (void) |
| 4956 { | 5031 { |
| 4957 common_init_alloc_once_early (); | 5032 #if defined (__cplusplus) && defined (ERROR_CHECK_GC) |
| 5033 static struct gcpro initial_gcpro; | |
| 5034 | |
| 5035 initial_gcpro.next = 0; | |
| 5036 initial_gcpro.var = &Qnil; | |
| 5037 initial_gcpro.nvars = 1; | |
| 5038 gcprolist = &initial_gcpro; | |
| 5039 #else | |
| 5040 gcprolist = 0; | |
| 5041 #endif /* defined (__cplusplus) && defined (ERROR_CHECK_GC) */ | |
| 5042 } | |
| 5043 | |
| 5044 void | |
| 5045 reinit_alloc_early (void) | |
| 5046 { | |
| 5047 common_init_alloc_early (); | |
| 4958 init_lcrecord_lists (); | 5048 init_lcrecord_lists (); |
| 4959 } | 5049 } |
| 4960 | 5050 |
| 4961 void | 5051 void |
| 4962 init_alloc_once_early (void) | 5052 init_alloc_once_early (void) |
| 4963 { | 5053 { |
| 4964 common_init_alloc_once_early (); | 5054 common_init_alloc_early (); |
| 4965 | 5055 |
| 4966 { | 5056 { |
| 4967 int i; | 5057 int i; |
| 4968 for (i = 0; i < countof (lrecord_implementations_table); i++) | 5058 for (i = 0; i < countof (lrecord_implementations_table); i++) |
| 4969 lrecord_implementations_table[i] = 0; | 5059 lrecord_implementations_table[i] = 0; |
| 4971 | 5061 |
| 4972 INIT_LRECORD_IMPLEMENTATION (cons); | 5062 INIT_LRECORD_IMPLEMENTATION (cons); |
| 4973 INIT_LRECORD_IMPLEMENTATION (vector); | 5063 INIT_LRECORD_IMPLEMENTATION (vector); |
| 4974 INIT_LRECORD_IMPLEMENTATION (string); | 5064 INIT_LRECORD_IMPLEMENTATION (string); |
| 4975 INIT_LRECORD_IMPLEMENTATION (lcrecord_list); | 5065 INIT_LRECORD_IMPLEMENTATION (lcrecord_list); |
| 5066 INIT_LRECORD_IMPLEMENTATION (free); | |
| 4976 | 5067 |
| 4977 staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *); | 5068 staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *); |
| 4978 Dynarr_resize (staticpros, 1410); /* merely a small optimization */ | 5069 Dynarr_resize (staticpros, 1410); /* merely a small optimization */ |
| 4979 dump_add_root_struct_ptr (&staticpros, &staticpros_description); | 5070 dump_add_root_struct_ptr (&staticpros, &staticpros_description); |
| 4980 #ifdef DEBUG_XEMACS | 5071 #ifdef DEBUG_XEMACS |
| 4982 Dynarr_resize (staticpro_names, 1410); /* merely a small optimization */ | 5073 Dynarr_resize (staticpro_names, 1410); /* merely a small optimization */ |
| 4983 dump_add_root_struct_ptr (&staticpro_names, &staticpro_names_description); | 5074 dump_add_root_struct_ptr (&staticpro_names, &staticpro_names_description); |
| 4984 #endif | 5075 #endif |
| 4985 | 5076 |
| 4986 init_lcrecord_lists (); | 5077 init_lcrecord_lists (); |
| 4987 } | |
| 4988 | |
| 4989 void | |
| 4990 init_alloc_early (void) | |
| 4991 { | |
| 4992 gcprolist = 0; | |
| 4993 } | 5078 } |
| 4994 | 5079 |
| 4995 void | 5080 void |
| 4996 syms_of_alloc (void) | 5081 syms_of_alloc (void) |
| 4997 { | 5082 { |