Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 5127:a9c41067dd88 ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
more cleanups, terminology clarification, lots of doc work -------------------- ChangeLog entries follow: -------------------- man/ChangeLog addition: 2010-03-05 Ben Wing <ben@xemacs.org> * internals/internals.texi (Introduction to Allocation): * internals/internals.texi (Integers and Characters): * internals/internals.texi (Allocation from Frob Blocks): * internals/internals.texi (lrecords): * internals/internals.texi (Low-level allocation): Rewrite section on allocation of Lisp objects to reflect the new reality. Remove references to nonexistent XSETINT and XSETCHAR. modules/ChangeLog addition: 2010-03-05 Ben Wing <ben@xemacs.org> * postgresql/postgresql.c (allocate_pgconn): * postgresql/postgresql.c (allocate_pgresult): * postgresql/postgresql.h (struct Lisp_PGconn): * postgresql/postgresql.h (struct Lisp_PGresult): * ldap/eldap.c (allocate_ldap): * ldap/eldap.h (struct Lisp_LDAP): Same changes as in src/ dir. See large log there in ChangeLog, but basically: ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER ../hlo/src/ChangeLog addition: 2010-03-05 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (old_alloc_sized_lcrecord): * alloc.c (very_old_free_lcrecord): * alloc.c (copy_lisp_object): * alloc.c (zero_sized_lisp_object): * alloc.c (zero_nonsized_lisp_object): * alloc.c (lisp_object_storage_size): * alloc.c (free_normal_lisp_object): * alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC): * alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT): * alloc.c (Fcons): * alloc.c (noseeum_cons): * alloc.c (make_float): * alloc.c (make_bignum): * alloc.c (make_bignum_bg): * alloc.c (make_ratio): * alloc.c (make_ratio_bg): * alloc.c (make_ratio_rt): * alloc.c (make_bigfloat): * alloc.c (make_bigfloat_bf): * alloc.c (size_vector): * alloc.c (make_compiled_function): * alloc.c (Fmake_symbol): * alloc.c (allocate_extent): * alloc.c (allocate_event): * alloc.c (make_key_data): * alloc.c (make_button_data): * alloc.c (make_motion_data): * alloc.c (make_process_data): * alloc.c (make_timeout_data): * alloc.c (make_magic_data): * alloc.c (make_magic_eval_data): * alloc.c (make_eval_data): * alloc.c (make_misc_user_data): * alloc.c (Fmake_marker): * alloc.c (noseeum_make_marker): * alloc.c (size_string_direct_data): * alloc.c (make_uninit_string): * alloc.c (make_string_nocopy): * alloc.c (mark_lcrecord_list): * alloc.c (alloc_managed_lcrecord): * alloc.c (free_managed_lcrecord): * alloc.c (sweep_lcrecords_1): * alloc.c (malloced_storage_size): * buffer.c (allocate_buffer): * buffer.c (compute_buffer_usage): * buffer.c (DEFVAR_BUFFER_LOCAL_1): * buffer.c (nuke_all_buffer_slots): * buffer.c (common_init_complex_vars_of_buffer): * buffer.h (struct buffer_text): * buffer.h (struct buffer): * bytecode.c: * bytecode.c (make_compiled_function_args): * bytecode.c (size_compiled_function_args): * bytecode.h (struct compiled_function_args): * casetab.c (allocate_case_table): * casetab.h (struct Lisp_Case_Table): * charset.h (struct Lisp_Charset): * chartab.c (fill_char_table): * chartab.c (Fmake_char_table): * chartab.c (make_char_table_entry): * chartab.c (copy_char_table_entry): * chartab.c (Fcopy_char_table): * chartab.c (put_char_table): * chartab.h (struct Lisp_Char_Table_Entry): * chartab.h (struct Lisp_Char_Table): * console-gtk-impl.h (struct gtk_device): * console-gtk-impl.h (struct gtk_frame): * console-impl.h (struct console): * console-msw-impl.h (struct Lisp_Devmode): * console-msw-impl.h (struct mswindows_device): * console-msw-impl.h (struct msprinter_device): * console-msw-impl.h (struct mswindows_frame): * console-msw-impl.h (struct mswindows_dialog_id): * console-stream-impl.h (struct stream_console): * console-stream.c (stream_init_console): * console-tty-impl.h (struct tty_console): * console-tty-impl.h (struct tty_device): * console-tty.c (allocate_tty_console_struct): * console-x-impl.h (struct x_device): * console-x-impl.h (struct x_frame): * console.c (allocate_console): * console.c (nuke_all_console_slots): * console.c (DEFVAR_CONSOLE_LOCAL_1): * console.c (common_init_complex_vars_of_console): * data.c (make_weak_list): * data.c (make_weak_box): * data.c (make_ephemeron): * database.c: * database.c (struct Lisp_Database): * database.c (allocate_database): * database.c (finalize_database): * device-gtk.c (allocate_gtk_device_struct): * device-impl.h (struct device): * device-msw.c: * device-msw.c (mswindows_init_device): * device-msw.c (msprinter_init_device): * device-msw.c (finalize_devmode): * device-msw.c (allocate_devmode): * device-tty.c (allocate_tty_device_struct): * device-x.c (allocate_x_device_struct): * device.c: * device.c (nuke_all_device_slots): * device.c (allocate_device): * dialog-msw.c (handle_question_dialog_box): * elhash.c: * elhash.c (struct Lisp_Hash_Table): * elhash.c (finalize_hash_table): * elhash.c (make_general_lisp_hash_table): * elhash.c (Fcopy_hash_table): * elhash.h (htentry): * emacs.c (main_1): * eval.c: * eval.c (size_multiple_value): * event-stream.c (finalize_command_builder): * event-stream.c (allocate_command_builder): * event-stream.c (free_command_builder): * event-stream.c (event_stream_generate_wakeup): * event-stream.c (event_stream_resignal_wakeup): * event-stream.c (event_stream_disable_wakeup): * event-stream.c (event_stream_wakeup_pending_p): * events.h (struct Lisp_Timeout): * events.h (struct command_builder): * extents-impl.h: * extents-impl.h (struct extent_auxiliary): * extents-impl.h (struct extent_info): * extents-impl.h (set_extent_no_chase_aux_field): * extents-impl.h (set_extent_no_chase_normal_field): * extents.c: * extents.c (gap_array_marker): * extents.c (gap_array): * extents.c (extent_list_marker): * extents.c (extent_list): * extents.c (stack_of_extents): * extents.c (gap_array_make_marker): * extents.c (extent_list_make_marker): * extents.c (allocate_extent_list): * extents.c (SLOT): * extents.c (mark_extent_auxiliary): * extents.c (allocate_extent_auxiliary): * extents.c (attach_extent_auxiliary): * extents.c (size_gap_array): * extents.c (finalize_extent_info): * extents.c (allocate_extent_info): * extents.c (uninit_buffer_extents): * extents.c (allocate_soe): * extents.c (copy_extent): * extents.c (vars_of_extents): * extents.h: * faces.c (allocate_face): * faces.h (struct Lisp_Face): * faces.h (struct face_cachel): * file-coding.c: * file-coding.c (finalize_coding_system): * file-coding.c (sizeof_coding_system): * file-coding.c (Fcopy_coding_system): * file-coding.h (struct Lisp_Coding_System): * file-coding.h (MARKED_SLOT): * fns.c (size_bit_vector): * font-mgr.c: * font-mgr.c (finalize_fc_pattern): * font-mgr.c (print_fc_pattern): * font-mgr.c (Ffc_pattern_p): * font-mgr.c (Ffc_pattern_create): * font-mgr.c (Ffc_name_parse): * font-mgr.c (Ffc_name_unparse): * font-mgr.c (Ffc_pattern_duplicate): * font-mgr.c (Ffc_pattern_add): * font-mgr.c (Ffc_pattern_del): * font-mgr.c (Ffc_pattern_get): * font-mgr.c (fc_config_create_using): * font-mgr.c (fc_strlist_to_lisp_using): * font-mgr.c (fontset_to_list): * font-mgr.c (Ffc_config_p): * font-mgr.c (Ffc_config_up_to_date): * font-mgr.c (Ffc_config_build_fonts): * font-mgr.c (Ffc_config_get_cache): * font-mgr.c (Ffc_config_get_fonts): * font-mgr.c (Ffc_config_set_current): * font-mgr.c (Ffc_config_get_blanks): * font-mgr.c (Ffc_config_get_rescan_interval): * font-mgr.c (Ffc_config_set_rescan_interval): * font-mgr.c (Ffc_config_app_font_add_file): * font-mgr.c (Ffc_config_app_font_add_dir): * font-mgr.c (Ffc_config_app_font_clear): * font-mgr.c (size): * font-mgr.c (Ffc_config_substitute): * font-mgr.c (Ffc_font_render_prepare): * font-mgr.c (Ffc_font_match): * font-mgr.c (Ffc_font_sort): * font-mgr.c (finalize_fc_config): * font-mgr.c (print_fc_config): * font-mgr.h: * font-mgr.h (struct fc_pattern): * font-mgr.h (XFC_PATTERN): * font-mgr.h (struct fc_config): * font-mgr.h (XFC_CONFIG): * frame-gtk.c (allocate_gtk_frame_struct): * frame-impl.h (struct frame): * frame-msw.c (mswindows_init_frame_1): * frame-x.c (allocate_x_frame_struct): * frame.c (nuke_all_frame_slots): * frame.c (allocate_frame_core): * gc.c: * gc.c (GC_CHECK_NOT_FREE): * glyphs.c (finalize_image_instance): * glyphs.c (allocate_image_instance): * glyphs.c (Fcolorize_image_instance): * glyphs.c (allocate_glyph): * glyphs.c (unmap_subwindow_instance_cache_mapper): * glyphs.c (register_ignored_expose): * glyphs.h (struct Lisp_Image_Instance): * glyphs.h (struct Lisp_Glyph): * glyphs.h (struct glyph_cachel): * glyphs.h (struct expose_ignore): * gui.c (allocate_gui_item): * gui.h (struct Lisp_Gui_Item): * keymap.c (struct Lisp_Keymap): * keymap.c (make_keymap): * lisp.h: * lisp.h (struct Lisp_String_Direct_Data): * lisp.h (struct Lisp_String_Indirect_Data): * lisp.h (struct Lisp_Vector): * lisp.h (struct Lisp_Bit_Vector): * lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR): * lisp.h (struct weak_box): * lisp.h (struct ephemeron): * lisp.h (struct weak_list): * lrecord.h: * lrecord.h (struct lrecord_implementation): * lrecord.h (MC_ALLOC_CALL_FINALIZER): * lrecord.h (struct lcrecord_list): * lstream.c (finalize_lstream): * lstream.c (sizeof_lstream): * lstream.c (Lstream_new): * lstream.c (Lstream_delete): * lstream.h (struct lstream): * marker.c: * marker.c (finalize_marker): * marker.c (compute_buffer_marker_usage): * mule-charset.c: * mule-charset.c (make_charset): * mule-charset.c (compute_charset_usage): * objects-impl.h (struct Lisp_Color_Instance): * objects-impl.h (struct Lisp_Font_Instance): * objects-tty-impl.h (struct tty_color_instance_data): * objects-tty-impl.h (struct tty_font_instance_data): * objects-tty.c (tty_initialize_color_instance): * objects-tty.c (tty_initialize_font_instance): * objects.c (finalize_color_instance): * objects.c (Fmake_color_instance): * objects.c (finalize_font_instance): * objects.c (Fmake_font_instance): * objects.c (reinit_vars_of_objects): * opaque.c: * opaque.c (sizeof_opaque): * opaque.c (make_opaque_ptr): * opaque.c (free_opaque_ptr): * opaque.h: * opaque.h (Lisp_Opaque): * opaque.h (Lisp_Opaque_Ptr): * print.c (printing_unreadable_lcrecord): * print.c (external_object_printer): * print.c (debug_p4): * process.c (finalize_process): * process.c (make_process_internal): * procimpl.h (struct Lisp_Process): * rangetab.c (Fmake_range_table): * rangetab.c (Fcopy_range_table): * rangetab.h (struct Lisp_Range_Table): * scrollbar.c: * scrollbar.c (create_scrollbar_instance): * scrollbar.c (compute_scrollbar_instance_usage): * scrollbar.h (struct scrollbar_instance): * specifier.c (finalize_specifier): * specifier.c (sizeof_specifier): * specifier.c (set_specifier_caching): * specifier.h (struct Lisp_Specifier): * specifier.h (struct specifier_caching): * symeval.h: * symeval.h (SYMBOL_VALUE_MAGIC_P): * symeval.h (DEFVAR_SYMVAL_FWD): * symsinit.h: * syntax.c (init_buffer_syntax_cache): * syntax.h (struct syntax_cache): * toolbar.c: * toolbar.c (allocate_toolbar_button): * toolbar.c (update_toolbar_button): * toolbar.h (struct toolbar_button): * tooltalk.c (struct Lisp_Tooltalk_Message): * tooltalk.c (make_tooltalk_message): * tooltalk.c (struct Lisp_Tooltalk_Pattern): * tooltalk.c (make_tooltalk_pattern): * ui-gtk.c: * ui-gtk.c (allocate_ffi_data): * ui-gtk.c (emacs_gtk_object_finalizer): * ui-gtk.c (allocate_emacs_gtk_object_data): * ui-gtk.c (allocate_emacs_gtk_boxed_data): * ui-gtk.h: * window-impl.h (struct window): * window-impl.h (struct window_mirror): * window.c (finalize_window): * window.c (allocate_window): * window.c (new_window_mirror): * window.c (mark_window_as_deleted): * window.c (make_dummy_parent): * window.c (compute_window_mirror_usage): * window.c (compute_window_usage): Overall point of this change and previous ones in this repository: (1) Introduce new, clearer terminology: everything other than int or char is a "record" object, which comes in two types: "normal objects" and "frob-block objects". Fix up all places that referred to frob-block objects as "simple", "basic", etc. (2) Provide an advertised interface for doing operations on Lisp objects, including creating new types, that is clean and consistent in its naming, uses the above-referenced terms and avoids referencing "lrecords", "old lcrecords", etc., which should hide under the surface. (3) Make the size_in_bytes and finalizer methods take a Lisp_Object rather than a void * for consistency with other methods. (4) Separate finalizer method into finalizer and disksaver, so that normal finalize methods don't have to worry about disksaving. Other specifics: (1) Renaming: LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT implementation->basic_p -> implementation->frob_block_p ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT *FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config *FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern (the last two changes make the naming of these macros consistent with the naming of all other macros, since the objects are named fc-config and fc-pattern with a hyphen) (2) Lots of documentation fixes in lrecord.h. (3) Eliminate macros for copying, freeing, zeroing objects, getting their storage size. Instead, new functions: zero_sized_lisp_object() zero_nonsized_lisp_object() lisp_object_storage_size() free_normal_lisp_object() (copy_lisp_object() already exists) LISP_OBJECT_FROB_BLOCK_P() (actually a macro) Eliminated: free_lrecord() zero_lrecord() copy_lrecord() copy_sized_lrecord() old_copy_lcrecord() old_copy_sized_lcrecord() old_zero_lcrecord() old_zero_sized_lcrecord() LISP_OBJECT_STORAGE_SIZE() COPY_SIZED_LISP_OBJECT() COPY_SIZED_LCRECORD() COPY_LISP_OBJECT() ZERO_LISP_OBJECT() FREE_LISP_OBJECT() (4) Catch the remaining places where lrecord stuff was used directly and use the advertised interface, e.g. alloc_sized_lrecord() -> ALLOC_SIZED_LISP_OBJECT(). (5) Make certain statically-declared pseudo-objects (buffer_local_flags, console_local_flags) have their lheader initialized correctly, so things like copy_lisp_object() can work on them. Make extent_auxiliary_defaults a proper heap object Vextent_auxiliary_defaults, and make extent auxiliaries dumpable so that this object can be dumped. allocate_extent_auxiliary() now just creates the object, and attach_extent_auxiliary() creates an extent auxiliary and attaches to an extent, like the old allocate_extent_auxiliary(). (6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h files but in a macro instead of a file. The purpose is to avoid duplication when iterating over all the slots in an extent auxiliary. Use it. (7) In lstream.c, don't zero out object after allocation because allocation routines take care of this. (8) In marker.c, fix a mistake in computing marker overhead. (9) In print.c, clean up printing_unreadable_lcrecord(), external_object_printer() to avoid lots of ifdef NEW_GC's. (10) Separate toolbar-button allocation into a separate allocate_toolbar_button() function for use in the example code in lrecord.h.
author Ben Wing <ben@xemacs.org>
date Fri, 05 Mar 2010 04:08:17 -0600
parents 2a462149bd6a
children f965e31a35f0
comparison
equal deleted inserted replaced
5126:2a462149bd6a 5127:a9c41067dd88
146 #define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \ 146 #define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \
147 INCREMENT_CONS_COUNTER_1 (size) 147 INCREMENT_CONS_COUNTER_1 (size)
148 #endif 148 #endif
149 149
150 #ifdef NEW_GC 150 #ifdef NEW_GC
151 /* The call to recompute_need_to_garbage_collect is moved to 151 /* [[ The call to recompute_need_to_garbage_collect is moved to
152 free_lrecord, since DECREMENT_CONS_COUNTER is extensively called 152 free_normal_lisp_object, since DECREMENT_CONS_COUNTER is extensively called
153 during sweep and recomputing need_to_garbage_collect all the time 153 during sweep and recomputing need_to_garbage_collect all the time
154 is not needed. */ 154 is not needed. ]] -- not accurate! */
155 #define DECREMENT_CONS_COUNTER(size) do { \ 155 #define DECREMENT_CONS_COUNTER(size) do { \
156 consing_since_gc -= (size); \ 156 consing_since_gc -= (size); \
157 total_consing -= (size); \ 157 total_consing -= (size); \
158 if (profiling_active) \ 158 if (profiling_active) \
159 profile_record_unconsing (size); \ 159 profile_record_unconsing (size); \
670 type_checking_assert (implementation->static_size > 0); 670 type_checking_assert (implementation->static_size > 0);
671 return alloc_sized_lrecord_array (implementation->static_size, elemcount, 671 return alloc_sized_lrecord_array (implementation->static_size, elemcount,
672 implementation); 672 implementation);
673 } 673 }
674 674
675 void
676 free_lrecord (Lisp_Object UNUSED (lrecord))
677 {
678 /* Manual frees are not allowed with asynchronous finalization */
679 return;
680 }
681 #else /* not NEW_GC */ 675 #else /* not NEW_GC */
682 676
683 /* The most basic of the lcrecord allocation functions. Not usually called 677 /* The most basic of the lcrecord allocation functions. Not usually called
684 directly. Allocates an lrecord not managed by any lcrecord-list, of a 678 directly. Allocates an lrecord not managed by any lcrecord-list, of a
685 specified size. See lrecord.h. */ 679 specified size. See lrecord.h. */
690 { 684 {
691 struct old_lcrecord_header *lcheader; 685 struct old_lcrecord_header *lcheader;
692 686
693 assert_proper_sizing (size); 687 assert_proper_sizing (size);
694 type_checking_assert 688 type_checking_assert
695 (!implementation->basic_p 689 (!implementation->frob_block_p
696 && 690 &&
697 !(implementation->hash == NULL && implementation->equal != NULL)); 691 !(implementation->hash == NULL && implementation->equal != NULL));
698 692
699 lcheader = (struct old_lcrecord_header *) allocate_lisp_storage (size); 693 lcheader = (struct old_lcrecord_header *) allocate_lisp_storage (size);
700 set_lheader_implementation (&lcheader->lheader, implementation); 694 set_lheader_implementation (&lcheader->lheader, implementation);
748 else 742 else
749 header = next; 743 header = next;
750 } 744 }
751 } 745 }
752 if (lrecord->implementation->finalizer) 746 if (lrecord->implementation->finalizer)
753 lrecord->implementation->finalizer (lrecord); 747 lrecord->implementation->finalizer (wrap_pointer_1 (lrecord));
754 xfree (lrecord); 748 xfree (lrecord);
755 return; 749 return;
756 } 750 }
757 #endif /* Unused */ 751 #endif /* Unused */
758 #endif /* not NEW_GC */ 752 #endif /* not NEW_GC */
798 #ifdef NEW_GC 792 #ifdef NEW_GC
799 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header), 793 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header),
800 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header), 794 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
801 size - sizeof (struct lrecord_header)); 795 size - sizeof (struct lrecord_header));
802 #else /* not NEW_GC */ 796 #else /* not NEW_GC */
803 if (imp->basic_p) 797 if (imp->frob_block_p)
804 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header), 798 memcpy ((char *) XRECORD_LHEADER (dst) + sizeof (struct lrecord_header),
805 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header), 799 (char *) XRECORD_LHEADER (src) + sizeof (struct lrecord_header),
806 size - sizeof (struct lrecord_header)); 800 size - sizeof (struct lrecord_header));
807 else 801 else
808 memcpy ((char *) XRECORD_LHEADER (dst) + 802 memcpy ((char *) XRECORD_LHEADER (dst) +
809 sizeof (struct old_lcrecord_header), 803 sizeof (struct old_lcrecord_header),
810 (char *) XRECORD_LHEADER (src) + 804 (char *) XRECORD_LHEADER (src) +
811 sizeof (struct old_lcrecord_header), 805 sizeof (struct old_lcrecord_header),
812 size - sizeof (struct old_lcrecord_header)); 806 size - sizeof (struct old_lcrecord_header));
813 #endif /* not NEW_GC */ 807 #endif /* not NEW_GC */
808 }
809
810 /* Zero out all parts of a Lisp object other than the header, for a
811 variable-sized object. The size needs to be given explicitly because
812 at the time this is called, the contents of the object may not be
813 defined, or may not be set up in such a way that we can reliably
814 retrieve the size, since it may depend on settings inside of the object. */
815
816 void
817 zero_sized_lisp_object (Lisp_Object obj, Bytecount size)
818 {
819 #ifndef NEW_GC
820 const struct lrecord_implementation *imp =
821 XRECORD_LHEADER_IMPLEMENTATION (obj);
822 #endif /* not NEW_GC */
823
824 #ifdef NEW_GC
825 memset ((char *) XRECORD_LHEADER (obj) + sizeof (struct lrecord_header), 0,
826 size - sizeof (struct lrecord_header));
827 #else /* not NEW_GC */
828 if (imp->frob_block_p)
829 memset ((char *) XRECORD_LHEADER (obj) + sizeof (struct lrecord_header), 0,
830 size - sizeof (struct lrecord_header));
831 else
832 memset ((char *) XRECORD_LHEADER (obj) +
833 sizeof (struct old_lcrecord_header), 0,
834 size - sizeof (struct old_lcrecord_header));
835 #endif /* not NEW_GC */
836 }
837
838 /* Zero out all parts of a Lisp object other than the header, for an object
839 that isn't variable-size. Objects that are variable-size need to use
840 zero_sized_lisp_object().
841 */
842
843 void
844 zero_nonsized_lisp_object (Lisp_Object obj)
845 {
846 const struct lrecord_implementation *imp =
847 XRECORD_LHEADER_IMPLEMENTATION (obj);
848 assert (!imp->size_in_bytes_method);
849
850 zero_sized_lisp_object (obj, lisp_object_size (obj));
851 }
852
853 #ifdef MEMORY_USAGE_STATS
854
855 Bytecount
856 lisp_object_storage_size (Lisp_Object obj, struct overhead_stats *ovstats)
857 {
858 #ifndef NEW_GC
859 const struct lrecord_implementation *imp =
860 XRECORD_LHEADER_IMPLEMENTATION (obj);
861 #endif /* not NEW_GC */
862 Bytecount size = lisp_object_size (obj);
863
864 #ifdef NEW_GC
865 return mc_alloced_storage_size (size, ovstats);
866 #else
867 if (imp->frob_block_p)
868 {
869 Bytecount overhead = fixed_type_block_overhead (size);
870 if (ovstats)
871 {
872 ovstats->was_requested += size;
873 ovstats->malloc_overhead += overhead;
874 }
875 return size + overhead;
876 }
877 else
878 return malloced_storage_size (XPNTR (obj), size, ovstats);
879 #endif
880 }
881
882 #endif /* MEMORY_USAGE_STATS */
883
884 void
885 free_normal_lisp_object (Lisp_Object obj)
886 {
887 #ifndef NEW_GC
888 const struct lrecord_implementation *imp =
889 XRECORD_LHEADER_IMPLEMENTATION (obj);
890 #endif /* not NEW_GC */
891
892 #ifdef NEW_GC
893 /* Manual frees are not allowed with asynchronous finalization */
894 return;
895 #else
896 assert (!imp->frob_block_p);
897 assert (!imp->size_in_bytes_method);
898 old_free_lcrecord (obj);
899 #endif
814 } 900 }
815 901
816 902
817 /************************************************************************/ 903 /************************************************************************/
818 /* Debugger support */ 904 /* Debugger support */
1187 } while (0) 1273 } while (0)
1188 #endif /* NEW_GC */ 1274 #endif /* NEW_GC */
1189 1275
1190 #ifdef NEW_GC 1276 #ifdef NEW_GC
1191 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr) \ 1277 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr) \
1192 free_lrecord (lo) 1278 free_normal_lisp_object (lo)
1193 #else /* not NEW_GC */ 1279 #else /* not NEW_GC */
1194 /* Like FREE_FIXED_TYPE() but used when we are explicitly 1280 /* Like FREE_FIXED_TYPE() but used when we are explicitly
1195 freeing a structure through free_cons(), free_marker(), etc. 1281 freeing a structure through free_cons(), free_marker(), etc.
1196 rather than through the normal process of sweeping. 1282 rather than through the normal process of sweeping.
1197 We attempt to undo the changes made to the allocation counters 1283 We attempt to undo the changes made to the allocation counters
1214 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr) 1300 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr)
1215 #endif 1301 #endif
1216 #endif /* (not) NEW_GC */ 1302 #endif /* (not) NEW_GC */
1217 1303
1218 #ifdef NEW_GC 1304 #ifdef NEW_GC
1219 #define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr)\ 1305 #define ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, lrec_ptr)\
1220 do { \ 1306 do { \
1221 (var) = (lisp_type *) XPNTR (ALLOC_LISP_OBJECT (type)); \ 1307 (var) = (lisp_type *) XPNTR (ALLOC_NORMAL_LISP_OBJECT (type)); \
1222 } while (0) 1308 } while (0)
1223 #define NOSEEUM_ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, \ 1309 #define NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, \
1224 lrec_ptr) \ 1310 lrec_ptr) \
1225 do { \ 1311 do { \
1226 (var) = (lisp_type *) XPNTR (noseeum_alloc_lrecord (lrec_ptr)); \ 1312 (var) = (lisp_type *) XPNTR (noseeum_alloc_lrecord (lrec_ptr)); \
1227 } while (0) 1313 } while (0)
1228 #else /* not NEW_GC */ 1314 #else /* not NEW_GC */
1229 #define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr) \ 1315 #define ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, lrec_ptr) \
1230 do \ 1316 do \
1231 { \ 1317 { \
1232 ALLOCATE_FIXED_TYPE (type, lisp_type, var); \ 1318 ALLOCATE_FIXED_TYPE (type, lisp_type, var); \
1233 set_lheader_implementation (&(var)->lheader, lrec_ptr); \ 1319 set_lheader_implementation (&(var)->lheader, lrec_ptr); \
1234 } while (0) 1320 } while (0)
1235 #define NOSEEUM_ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, \ 1321 #define NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT(type, lisp_type, var, \
1236 lrec_ptr) \ 1322 lrec_ptr) \
1237 do \ 1323 do \
1238 { \ 1324 { \
1239 NOSEEUM_ALLOCATE_FIXED_TYPE (type, lisp_type, var); \ 1325 NOSEEUM_ALLOCATE_FIXED_TYPE (type, lisp_type, var); \
1240 set_lheader_implementation (&(var)->lheader, lrec_ptr); \ 1326 set_lheader_implementation (&(var)->lheader, lrec_ptr); \
1307 { 1393 {
1308 /* This cannot GC. */ 1394 /* This cannot GC. */
1309 Lisp_Object val; 1395 Lisp_Object val;
1310 Lisp_Cons *c; 1396 Lisp_Cons *c;
1311 1397
1312 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (cons, Lisp_Cons, c, &lrecord_cons); 1398 ALLOC_FROB_BLOCK_LISP_OBJECT (cons, Lisp_Cons, c, &lrecord_cons);
1313 val = wrap_cons (c); 1399 val = wrap_cons (c);
1314 XSETCAR (val, car); 1400 XSETCAR (val, car);
1315 XSETCDR (val, cdr); 1401 XSETCDR (val, cdr);
1316 return val; 1402 return val;
1317 } 1403 }
1323 noseeum_cons (Lisp_Object car, Lisp_Object cdr) 1409 noseeum_cons (Lisp_Object car, Lisp_Object cdr)
1324 { 1410 {
1325 Lisp_Object val; 1411 Lisp_Object val;
1326 Lisp_Cons *c; 1412 Lisp_Cons *c;
1327 1413
1328 NOSEEUM_ALLOCATE_FIXED_TYPE_AND_SET_IMPL (cons, Lisp_Cons, c, &lrecord_cons); 1414 NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT (cons, Lisp_Cons, c, &lrecord_cons);
1329 val = wrap_cons (c); 1415 val = wrap_cons (c);
1330 XCAR (val) = car; 1416 XCAR (val) = car;
1331 XCDR (val) = cdr; 1417 XCDR (val) = cdr;
1332 return val; 1418 return val;
1333 } 1419 }
1435 Lisp_Object 1521 Lisp_Object
1436 make_float (double float_value) 1522 make_float (double float_value)
1437 { 1523 {
1438 Lisp_Float *f; 1524 Lisp_Float *f;
1439 1525
1440 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (float, Lisp_Float, f, &lrecord_float); 1526 ALLOC_FROB_BLOCK_LISP_OBJECT (float, Lisp_Float, f, &lrecord_float);
1441 1527
1442 /* Avoid dump-time `uninitialized memory read' purify warnings. */ 1528 /* Avoid dump-time `uninitialized memory read' purify warnings. */
1443 if (sizeof (struct lrecord_header) + sizeof (double) != sizeof (*f)) 1529 if (sizeof (struct lrecord_header) + sizeof (double) != sizeof (*f))
1444 zero_lrecord (f); 1530 zero_nonsized_lisp_object (wrap_float (f));
1445 1531
1446 float_data (f) = float_value; 1532 float_data (f) = float_value;
1447 return wrap_float (f); 1533 return wrap_float (f);
1448 } 1534 }
1449 1535
1462 Lisp_Object 1548 Lisp_Object
1463 make_bignum (long bignum_value) 1549 make_bignum (long bignum_value)
1464 { 1550 {
1465 Lisp_Bignum *b; 1551 Lisp_Bignum *b;
1466 1552
1467 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (bignum, Lisp_Bignum, b, &lrecord_bignum); 1553 ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum);
1468 bignum_init (bignum_data (b)); 1554 bignum_init (bignum_data (b));
1469 bignum_set_long (bignum_data (b), bignum_value); 1555 bignum_set_long (bignum_data (b), bignum_value);
1470 return wrap_bignum (b); 1556 return wrap_bignum (b);
1471 } 1557 }
1472 1558
1475 Lisp_Object 1561 Lisp_Object
1476 make_bignum_bg (bignum bg) 1562 make_bignum_bg (bignum bg)
1477 { 1563 {
1478 Lisp_Bignum *b; 1564 Lisp_Bignum *b;
1479 1565
1480 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (bignum, Lisp_Bignum, b, &lrecord_bignum); 1566 ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum);
1481 bignum_init (bignum_data (b)); 1567 bignum_init (bignum_data (b));
1482 bignum_set (bignum_data (b), bg); 1568 bignum_set (bignum_data (b), bg);
1483 return wrap_bignum (b); 1569 return wrap_bignum (b);
1484 } 1570 }
1485 #endif /* HAVE_BIGNUM */ 1571 #endif /* HAVE_BIGNUM */
1492 Lisp_Object 1578 Lisp_Object
1493 make_ratio (long numerator, unsigned long denominator) 1579 make_ratio (long numerator, unsigned long denominator)
1494 { 1580 {
1495 Lisp_Ratio *r; 1581 Lisp_Ratio *r;
1496 1582
1497 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (ratio, Lisp_Ratio, r, &lrecord_ratio); 1583 ALLOC_FROB_BLOCK_LISP_OBJECT (ratio, Lisp_Ratio, r, &lrecord_ratio);
1498 ratio_init (ratio_data (r)); 1584 ratio_init (ratio_data (r));
1499 ratio_set_long_ulong (ratio_data (r), numerator, denominator); 1585 ratio_set_long_ulong (ratio_data (r), numerator, denominator);
1500 ratio_canonicalize (ratio_data (r)); 1586 ratio_canonicalize (ratio_data (r));
1501 return wrap_ratio (r); 1587 return wrap_ratio (r);
1502 } 1588 }
1504 Lisp_Object 1590 Lisp_Object
1505 make_ratio_bg (bignum numerator, bignum denominator) 1591 make_ratio_bg (bignum numerator, bignum denominator)
1506 { 1592 {
1507 Lisp_Ratio *r; 1593 Lisp_Ratio *r;
1508 1594
1509 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (ratio, Lisp_Ratio, r, &lrecord_ratio); 1595 ALLOC_FROB_BLOCK_LISP_OBJECT (ratio, Lisp_Ratio, r, &lrecord_ratio);
1510 ratio_init (ratio_data (r)); 1596 ratio_init (ratio_data (r));
1511 ratio_set_bignum_bignum (ratio_data (r), numerator, denominator); 1597 ratio_set_bignum_bignum (ratio_data (r), numerator, denominator);
1512 ratio_canonicalize (ratio_data (r)); 1598 ratio_canonicalize (ratio_data (r));
1513 return wrap_ratio (r); 1599 return wrap_ratio (r);
1514 } 1600 }
1516 Lisp_Object 1602 Lisp_Object
1517 make_ratio_rt (ratio rat) 1603 make_ratio_rt (ratio rat)
1518 { 1604 {
1519 Lisp_Ratio *r; 1605 Lisp_Ratio *r;
1520 1606
1521 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (ratio, Lisp_Ratio, r, &lrecord_ratio); 1607 ALLOC_FROB_BLOCK_LISP_OBJECT (ratio, Lisp_Ratio, r, &lrecord_ratio);
1522 ratio_init (ratio_data (r)); 1608 ratio_init (ratio_data (r));
1523 ratio_set (ratio_data (r), rat); 1609 ratio_set (ratio_data (r), rat);
1524 return wrap_ratio (r); 1610 return wrap_ratio (r);
1525 } 1611 }
1526 #endif /* HAVE_RATIO */ 1612 #endif /* HAVE_RATIO */
1535 Lisp_Object 1621 Lisp_Object
1536 make_bigfloat (double float_value, unsigned long precision) 1622 make_bigfloat (double float_value, unsigned long precision)
1537 { 1623 {
1538 Lisp_Bigfloat *f; 1624 Lisp_Bigfloat *f;
1539 1625
1540 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (bigfloat, Lisp_Bigfloat, f, &lrecord_bigfloat); 1626 ALLOC_FROB_BLOCK_LISP_OBJECT (bigfloat, Lisp_Bigfloat, f, &lrecord_bigfloat);
1541 if (precision == 0UL) 1627 if (precision == 0UL)
1542 bigfloat_init (bigfloat_data (f)); 1628 bigfloat_init (bigfloat_data (f));
1543 else 1629 else
1544 bigfloat_init_prec (bigfloat_data (f), precision); 1630 bigfloat_init_prec (bigfloat_data (f), precision);
1545 bigfloat_set_double (bigfloat_data (f), float_value); 1631 bigfloat_set_double (bigfloat_data (f), float_value);
1550 Lisp_Object 1636 Lisp_Object
1551 make_bigfloat_bf (bigfloat float_value) 1637 make_bigfloat_bf (bigfloat float_value)
1552 { 1638 {
1553 Lisp_Bigfloat *f; 1639 Lisp_Bigfloat *f;
1554 1640
1555 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (bigfloat, Lisp_Bigfloat, f, &lrecord_bigfloat); 1641 ALLOC_FROB_BLOCK_LISP_OBJECT (bigfloat, Lisp_Bigfloat, f, &lrecord_bigfloat);
1556 bigfloat_init_prec (bigfloat_data (f), bigfloat_get_prec (float_value)); 1642 bigfloat_init_prec (bigfloat_data (f), bigfloat_get_prec (float_value));
1557 bigfloat_set (bigfloat_data (f), float_value); 1643 bigfloat_set (bigfloat_data (f), float_value);
1558 return wrap_bigfloat (f); 1644 return wrap_bigfloat (f);
1559 } 1645 }
1560 #endif /* HAVE_BIGFLOAT */ 1646 #endif /* HAVE_BIGFLOAT */
1574 mark_object (ptr->contents[i]); 1660 mark_object (ptr->contents[i]);
1575 return (len > 0) ? ptr->contents[len - 1] : Qnil; 1661 return (len > 0) ? ptr->contents[len - 1] : Qnil;
1576 } 1662 }
1577 1663
1578 static Bytecount 1664 static Bytecount
1579 size_vector (const void *lheader) 1665 size_vector (Lisp_Object obj)
1580 { 1666 {
1667
1581 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, contents, 1668 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, contents,
1582 ((Lisp_Vector *) lheader)->size); 1669 XVECTOR (obj)->size);
1583 } 1670 }
1584 1671
1585 static int 1672 static int
1586 vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) 1673 vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase)
1587 { 1674 {
1871 static Lisp_Object 1958 static Lisp_Object
1872 make_compiled_function (void) 1959 make_compiled_function (void)
1873 { 1960 {
1874 Lisp_Compiled_Function *f; 1961 Lisp_Compiled_Function *f;
1875 1962
1876 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (compiled_function, Lisp_Compiled_Function, 1963 ALLOC_FROB_BLOCK_LISP_OBJECT (compiled_function, Lisp_Compiled_Function,
1877 f, &lrecord_compiled_function); 1964 f, &lrecord_compiled_function);
1878 1965
1879 f->stack_depth = 0; 1966 f->stack_depth = 0;
1880 f->specpdl_depth = 0; 1967 f->specpdl_depth = 0;
1881 f->flags.documentationp = 0; 1968 f->flags.documentationp = 0;
2009 { 2096 {
2010 Lisp_Symbol *p; 2097 Lisp_Symbol *p;
2011 2098
2012 CHECK_STRING (name); 2099 CHECK_STRING (name);
2013 2100
2014 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (symbol, Lisp_Symbol, p, &lrecord_symbol); 2101 ALLOC_FROB_BLOCK_LISP_OBJECT (symbol, Lisp_Symbol, p, &lrecord_symbol);
2015 p->name = name; 2102 p->name = name;
2016 p->plist = Qnil; 2103 p->plist = Qnil;
2017 p->value = Qunbound; 2104 p->value = Qunbound;
2018 p->function = Qunbound; 2105 p->function = Qunbound;
2019 symbol_next (p) = 0; 2106 symbol_next (p) = 0;
2031 struct extent * 2118 struct extent *
2032 allocate_extent (void) 2119 allocate_extent (void)
2033 { 2120 {
2034 struct extent *e; 2121 struct extent *e;
2035 2122
2036 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (extent, struct extent, e, &lrecord_extent); 2123 ALLOC_FROB_BLOCK_LISP_OBJECT (extent, struct extent, e, &lrecord_extent);
2037 extent_object (e) = Qnil; 2124 extent_object (e) = Qnil;
2038 set_extent_start (e, -1); 2125 set_extent_start (e, -1);
2039 set_extent_end (e, -1); 2126 set_extent_end (e, -1);
2040 e->plist = Qnil; 2127 e->plist = Qnil;
2041 2128
2059 Lisp_Object 2146 Lisp_Object
2060 allocate_event (void) 2147 allocate_event (void)
2061 { 2148 {
2062 Lisp_Event *e; 2149 Lisp_Event *e;
2063 2150
2064 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (event, Lisp_Event, e, &lrecord_event); 2151 ALLOC_FROB_BLOCK_LISP_OBJECT (event, Lisp_Event, e, &lrecord_event);
2065 2152
2066 return wrap_event (e); 2153 return wrap_event (e);
2067 } 2154 }
2068 2155
2069 #ifdef EVENT_DATA_AS_OBJECTS 2156 #ifdef EVENT_DATA_AS_OBJECTS
2073 Lisp_Object 2160 Lisp_Object
2074 make_key_data (void) 2161 make_key_data (void)
2075 { 2162 {
2076 Lisp_Key_Data *d; 2163 Lisp_Key_Data *d;
2077 2164
2078 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (key_data, Lisp_Key_Data, d, 2165 ALLOC_FROB_BLOCK_LISP_OBJECT (key_data, Lisp_Key_Data, d,
2079 &lrecord_key_data); 2166 &lrecord_key_data);
2080 zero_lrecord (d); 2167 zero_nonsized_lisp_object (wrap_key_data (d));
2081 d->keysym = Qnil; 2168 d->keysym = Qnil;
2082 2169
2083 return wrap_key_data (d); 2170 return wrap_key_data (d);
2084 } 2171 }
2085 2172
2089 Lisp_Object 2176 Lisp_Object
2090 make_button_data (void) 2177 make_button_data (void)
2091 { 2178 {
2092 Lisp_Button_Data *d; 2179 Lisp_Button_Data *d;
2093 2180
2094 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (button_data, Lisp_Button_Data, d, &lrecord_button_data); 2181 ALLOC_FROB_BLOCK_LISP_OBJECT (button_data, Lisp_Button_Data, d, &lrecord_button_data);
2095 zero_lrecord (d); 2182 zero_nonsized_lisp_object (wrap_button_data (d));
2096 return wrap_button_data (d); 2183 return wrap_button_data (d);
2097 } 2184 }
2098 2185
2099 DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data); 2186 DECLARE_FIXED_TYPE_ALLOC (motion_data, Lisp_Motion_Data);
2100 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_motion_data 1000 2187 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_motion_data 1000
2102 Lisp_Object 2189 Lisp_Object
2103 make_motion_data (void) 2190 make_motion_data (void)
2104 { 2191 {
2105 Lisp_Motion_Data *d; 2192 Lisp_Motion_Data *d;
2106 2193
2107 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (motion_data, Lisp_Motion_Data, d, &lrecord_motion_data); 2194 ALLOC_FROB_BLOCK_LISP_OBJECT (motion_data, Lisp_Motion_Data, d, &lrecord_motion_data);
2108 zero_lrecord (d); 2195 zero_nonsized_lisp_object (wrap_motion_data (d));
2109 2196
2110 return wrap_motion_data (d); 2197 return wrap_motion_data (d);
2111 } 2198 }
2112 2199
2113 DECLARE_FIXED_TYPE_ALLOC (process_data, Lisp_Process_Data); 2200 DECLARE_FIXED_TYPE_ALLOC (process_data, Lisp_Process_Data);
2116 Lisp_Object 2203 Lisp_Object
2117 make_process_data (void) 2204 make_process_data (void)
2118 { 2205 {
2119 Lisp_Process_Data *d; 2206 Lisp_Process_Data *d;
2120 2207
2121 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (process_data, Lisp_Process_Data, d, &lrecord_process_data); 2208 ALLOC_FROB_BLOCK_LISP_OBJECT (process_data, Lisp_Process_Data, d, &lrecord_process_data);
2122 zero_lrecord (d); 2209 zero_nonsized_lisp_object (wrap_process_data (d));
2123 d->process = Qnil; 2210 d->process = Qnil;
2124 2211
2125 return wrap_process_data (d); 2212 return wrap_process_data (d);
2126 } 2213 }
2127 2214
2131 Lisp_Object 2218 Lisp_Object
2132 make_timeout_data (void) 2219 make_timeout_data (void)
2133 { 2220 {
2134 Lisp_Timeout_Data *d; 2221 Lisp_Timeout_Data *d;
2135 2222
2136 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (timeout_data, Lisp_Timeout_Data, d, &lrecord_timeout_data); 2223 ALLOC_FROB_BLOCK_LISP_OBJECT (timeout_data, Lisp_Timeout_Data, d, &lrecord_timeout_data);
2137 zero_lrecord (d); 2224 zero_nonsized_lisp_object (wrap_timeout_data (d));
2138 d->function = Qnil; 2225 d->function = Qnil;
2139 d->object = Qnil; 2226 d->object = Qnil;
2140 2227
2141 return wrap_timeout_data (d); 2228 return wrap_timeout_data (d);
2142 } 2229 }
2147 Lisp_Object 2234 Lisp_Object
2148 make_magic_data (void) 2235 make_magic_data (void)
2149 { 2236 {
2150 Lisp_Magic_Data *d; 2237 Lisp_Magic_Data *d;
2151 2238
2152 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (magic_data, Lisp_Magic_Data, d, &lrecord_magic_data); 2239 ALLOC_FROB_BLOCK_LISP_OBJECT (magic_data, Lisp_Magic_Data, d, &lrecord_magic_data);
2153 zero_lrecord (d); 2240 zero_nonsized_lisp_object (wrap_magic_data (d));
2154 2241
2155 return wrap_magic_data (d); 2242 return wrap_magic_data (d);
2156 } 2243 }
2157 2244
2158 DECLARE_FIXED_TYPE_ALLOC (magic_eval_data, Lisp_Magic_Eval_Data); 2245 DECLARE_FIXED_TYPE_ALLOC (magic_eval_data, Lisp_Magic_Eval_Data);
2161 Lisp_Object 2248 Lisp_Object
2162 make_magic_eval_data (void) 2249 make_magic_eval_data (void)
2163 { 2250 {
2164 Lisp_Magic_Eval_Data *d; 2251 Lisp_Magic_Eval_Data *d;
2165 2252
2166 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (magic_eval_data, Lisp_Magic_Eval_Data, d, &lrecord_magic_eval_data); 2253 ALLOC_FROB_BLOCK_LISP_OBJECT (magic_eval_data, Lisp_Magic_Eval_Data, d, &lrecord_magic_eval_data);
2167 zero_lrecord (d); 2254 zero_nonsized_lisp_object (wrap_magic_eval_data (d));
2168 d->object = Qnil; 2255 d->object = Qnil;
2169 2256
2170 return wrap_magic_eval_data (d); 2257 return wrap_magic_eval_data (d);
2171 } 2258 }
2172 2259
2176 Lisp_Object 2263 Lisp_Object
2177 make_eval_data (void) 2264 make_eval_data (void)
2178 { 2265 {
2179 Lisp_Eval_Data *d; 2266 Lisp_Eval_Data *d;
2180 2267
2181 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (eval_data, Lisp_Eval_Data, d, &lrecord_eval_data); 2268 ALLOC_FROB_BLOCK_LISP_OBJECT (eval_data, Lisp_Eval_Data, d, &lrecord_eval_data);
2182 zero_lrecord (d); 2269 zero_nonsized_lisp_object (wrap_eval_data (d));
2183 d->function = Qnil; 2270 d->function = Qnil;
2184 d->object = Qnil; 2271 d->object = Qnil;
2185 2272
2186 return wrap_eval_data (d); 2273 return wrap_eval_data (d);
2187 } 2274 }
2192 Lisp_Object 2279 Lisp_Object
2193 make_misc_user_data (void) 2280 make_misc_user_data (void)
2194 { 2281 {
2195 Lisp_Misc_User_Data *d; 2282 Lisp_Misc_User_Data *d;
2196 2283
2197 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (misc_user_data, Lisp_Misc_User_Data, d, &lrecord_misc_user_data); 2284 ALLOC_FROB_BLOCK_LISP_OBJECT (misc_user_data, Lisp_Misc_User_Data, d, &lrecord_misc_user_data);
2198 zero_lrecord (d); 2285 zero_nonsized_lisp_object (wrap_misc_user_data (d));
2199 d->function = Qnil; 2286 d->function = Qnil;
2200 d->object = Qnil; 2287 d->object = Qnil;
2201 2288
2202 return wrap_misc_user_data (d); 2289 return wrap_misc_user_data (d);
2203 } 2290 }
2216 */ 2303 */
2217 ()) 2304 ())
2218 { 2305 {
2219 Lisp_Marker *p; 2306 Lisp_Marker *p;
2220 2307
2221 ALLOCATE_FIXED_TYPE_AND_SET_IMPL (marker, Lisp_Marker, p, &lrecord_marker); 2308 ALLOC_FROB_BLOCK_LISP_OBJECT (marker, Lisp_Marker, p, &lrecord_marker);
2222 p->buffer = 0; 2309 p->buffer = 0;
2223 p->membpos = 0; 2310 p->membpos = 0;
2224 marker_next (p) = 0; 2311 marker_next (p) = 0;
2225 marker_prev (p) = 0; 2312 marker_prev (p) = 0;
2226 p->insertion_type = 0; 2313 p->insertion_type = 0;
2230 Lisp_Object 2317 Lisp_Object
2231 noseeum_make_marker (void) 2318 noseeum_make_marker (void)
2232 { 2319 {
2233 Lisp_Marker *p; 2320 Lisp_Marker *p;
2234 2321
2235 NOSEEUM_ALLOCATE_FIXED_TYPE_AND_SET_IMPL (marker, Lisp_Marker, p, 2322 NOSEEUM_ALLOC_FROB_BLOCK_LISP_OBJECT (marker, Lisp_Marker, p,
2236 &lrecord_marker); 2323 &lrecord_marker);
2237 p->buffer = 0; 2324 p->buffer = 0;
2238 p->membpos = 0; 2325 p->membpos = 0;
2239 marker_next (p) = 0; 2326 marker_next (p) = 0;
2240 marker_prev (p) = 0; 2327 marker_prev (p) = 0;
2247 /* String allocation */ 2334 /* String allocation */
2248 /************************************************************************/ 2335 /************************************************************************/
2249 2336
2250 /* The data for "short" strings generally resides inside of structs of type 2337 /* The data for "short" strings generally resides inside of structs of type
2251 string_chars_block. The Lisp_String structure is allocated just like any 2338 string_chars_block. The Lisp_String structure is allocated just like any
2252 other basic lrecord, and these are freelisted when they get garbage 2339 other frob-block lrecord, and these are freelisted when they get garbage
2253 collected. The data for short strings get compacted, but the data for 2340 collected. The data for short strings get compacted, but the data for
2254 large strings do not. 2341 large strings do not.
2255 2342
2256 Previously Lisp_String structures were relocated, but this caused a lot 2343 Previously Lisp_String structures were relocated, but this caused a lot
2257 of bus-errors because the C code didn't include enough GCPRO's for 2344 of bus-errors because the C code didn't include enough GCPRO's for
2417 { XD_BYTECOUNT, offsetof (Lisp_String_Direct_Data, size) }, 2504 { XD_BYTECOUNT, offsetof (Lisp_String_Direct_Data, size) },
2418 { XD_END } 2505 { XD_END }
2419 }; 2506 };
2420 2507
2421 static Bytecount 2508 static Bytecount
2422 size_string_direct_data (const void *lheader) 2509 size_string_direct_data (Lisp_Object obj)
2423 { 2510 {
2424 return STRING_FULLSIZE (((Lisp_String_Direct_Data *) lheader)->size); 2511 return STRING_FULLSIZE (XSTRING_DIRECT_DATA (obj)->size);
2425 } 2512 }
2426 2513
2427 2514
2428 DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("string-direct-data", 2515 DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("string-direct-data",
2429 string_direct_data, 2516 string_direct_data,
2546 Bytecount fullsize = STRING_FULLSIZE (length); 2633 Bytecount fullsize = STRING_FULLSIZE (length);
2547 2634
2548 assert (length >= 0 && fullsize > 0); 2635 assert (length >= 0 && fullsize > 0);
2549 2636
2550 #ifdef NEW_GC 2637 #ifdef NEW_GC
2551 s = XSTRING (ALLOC_LISP_OBJECT (string)); 2638 s = XSTRING (ALLOC_NORMAL_LISP_OBJECT (string));
2552 #else /* not NEW_GC */ 2639 #else /* not NEW_GC */
2553 /* Allocate the string header */ 2640 /* Allocate the string header */
2554 ALLOCATE_FIXED_TYPE (string, Lisp_String, s); 2641 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
2555 xzero (*s); 2642 xzero (*s);
2556 set_lheader_implementation (&s->u.lheader, &lrecord_string); 2643 set_lheader_implementation (&s->u.lheader, &lrecord_string);
3008 #if defined (ERROR_CHECK_TEXT) && defined (MULE) 3095 #if defined (ERROR_CHECK_TEXT) && defined (MULE)
3009 bytecount_to_charcount (contents, length); /* Just for the assertions */ 3096 bytecount_to_charcount (contents, length); /* Just for the assertions */
3010 #endif 3097 #endif
3011 3098
3012 #ifdef NEW_GC 3099 #ifdef NEW_GC
3013 s = XSTRING (ALLOC_LISP_OBJECT (string)); 3100 s = XSTRING (ALLOC_NORMAL_LISP_OBJECT (string));
3014 mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get 3101 mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get
3015 collected and static data is tried to 3102 collected and static data is tried to
3016 be freed. */ 3103 be freed. */
3017 #else /* not NEW_GC */ 3104 #else /* not NEW_GC */
3018 /* Allocate the string header */ 3105 /* Allocate the string header */
3023 /* Don't need to XSET_STRING_ASCII_BEGIN() here because it happens in 3110 /* Don't need to XSET_STRING_ASCII_BEGIN() here because it happens in
3024 init_string_ascii_begin(). */ 3111 init_string_ascii_begin(). */
3025 s->plist = Qnil; 3112 s->plist = Qnil;
3026 #ifdef NEW_GC 3113 #ifdef NEW_GC
3027 set_lispstringp_indirect (s); 3114 set_lispstringp_indirect (s);
3028 STRING_DATA_OBJECT (s) = ALLOC_LISP_OBJECT (string_indirect_data); 3115 STRING_DATA_OBJECT (s) = ALLOC_NORMAL_LISP_OBJECT (string_indirect_data);
3029 XSTRING_INDIRECT_DATA_DATA (STRING_DATA_OBJECT (s)) = (Ibyte *) contents; 3116 XSTRING_INDIRECT_DATA_DATA (STRING_DATA_OBJECT (s)) = (Ibyte *) contents;
3030 XSTRING_INDIRECT_DATA_SIZE (STRING_DATA_OBJECT (s)) = length; 3117 XSTRING_INDIRECT_DATA_SIZE (STRING_DATA_OBJECT (s)) = length;
3031 #else /* not NEW_GC */ 3118 #else /* not NEW_GC */
3032 set_lispstringp_data (s, (Ibyte *) contents); 3119 set_lispstringp_data (s, (Ibyte *) contents);
3033 set_lispstringp_length (s, length); 3120 set_lispstringp_length (s, length);
3044 /************************************************************************/ 3131 /************************************************************************/
3045 /* lcrecord lists */ 3132 /* lcrecord lists */
3046 /************************************************************************/ 3133 /************************************************************************/
3047 3134
3048 /* Lcrecord lists are used to manage the allocation of particular 3135 /* Lcrecord lists are used to manage the allocation of particular
3049 sorts of lcrecords, to avoid calling ALLOC_LISP_OBJECT() (and thus 3136 sorts of lcrecords, to avoid calling ALLOC_NORMAL_LISP_OBJECT() (and thus
3050 malloc() and garbage-collection junk) as much as possible. 3137 malloc() and garbage-collection junk) as much as possible.
3051 It is similar to the Blocktype class. 3138 It is similar to the Blocktype class.
3052 3139
3053 See detailed comment in lcrecord.h. 3140 See detailed comment in lcrecord.h.
3054 */ 3141 */
3083 gc_checking_assert 3170 gc_checking_assert
3084 (/* There should be no other pointers to the free list. */ 3171 (/* There should be no other pointers to the free list. */
3085 ! MARKED_RECORD_HEADER_P (lheader) 3172 ! MARKED_RECORD_HEADER_P (lheader)
3086 && 3173 &&
3087 /* Only lcrecords should be here. */ 3174 /* Only lcrecords should be here. */
3088 ! list->implementation->basic_p 3175 ! list->implementation->frob_block_p
3089 && 3176 &&
3090 /* Only free lcrecords should be here. */ 3177 /* Only free lcrecords should be here. */
3091 free_header->lcheader.free 3178 free_header->lcheader.free
3092 && 3179 &&
3093 /* The type of the lcrecord must be right. */ 3180 /* The type of the lcrecord must be right. */
3142 assert (! MARKED_RECORD_HEADER_P (lheader)); 3229 assert (! MARKED_RECORD_HEADER_P (lheader));
3143 /* Only free lcrecords should be here. */ 3230 /* Only free lcrecords should be here. */
3144 assert (free_header->lcheader.free); 3231 assert (free_header->lcheader.free);
3145 assert (lheader->type == lrecord_type_free); 3232 assert (lheader->type == lrecord_type_free);
3146 /* Only lcrecords should be here. */ 3233 /* Only lcrecords should be here. */
3147 assert (! (list->implementation->basic_p)); 3234 assert (! (list->implementation->frob_block_p));
3148 #if 0 /* Not used anymore, now that we set the type of the header to 3235 #if 0 /* Not used anymore, now that we set the type of the header to
3149 lrecord_type_free. */ 3236 lrecord_type_free. */
3150 /* The type of the lcrecord must be right. */ 3237 /* The type of the lcrecord must be right. */
3151 assert (LHEADER_IMPLEMENTATION (lheader) == list->implementation); 3238 assert (LHEADER_IMPLEMENTATION (lheader) == list->implementation);
3152 #endif /* 0 */ 3239 #endif /* 0 */
3157 3244
3158 list->free = free_header->chain; 3245 list->free = free_header->chain;
3159 free_header->lcheader.free = 0; 3246 free_header->lcheader.free = 0;
3160 /* Put back the correct type, as we set it to lrecord_type_free. */ 3247 /* Put back the correct type, as we set it to lrecord_type_free. */
3161 lheader->type = list->implementation->lrecord_type_index; 3248 lheader->type = list->implementation->lrecord_type_index;
3162 old_zero_sized_lcrecord (free_header, list->size); 3249 zero_sized_lisp_object (val, list->size);
3163 return val; 3250 return val;
3164 } 3251 }
3165 else 3252 else
3166 return wrap_pointer_1 (old_alloc_sized_lcrecord (list->size, 3253 return wrap_pointer_1 (old_alloc_sized_lcrecord (list->size,
3167 list->implementation)); 3254 list->implementation));
3206 problems. */ 3293 problems. */
3207 gc_checking_assert (!gc_in_progress); 3294 gc_checking_assert (!gc_in_progress);
3208 3295
3209 /* Make sure the size is correct. This will catch, for example, 3296 /* Make sure the size is correct. This will catch, for example,
3210 putting a window configuration on the wrong free list. */ 3297 putting a window configuration on the wrong free list. */
3211 gc_checking_assert (detagged_lisp_object_size (lheader) == list->size); 3298 gc_checking_assert (lisp_object_size (lcrecord) == list->size);
3212 /* Make sure the object isn't already freed. */ 3299 /* Make sure the object isn't already freed. */
3213 gc_checking_assert (!free_header->lcheader.free); 3300 gc_checking_assert (!free_header->lcheader.free);
3214 /* Freeing stuff in dumped memory is bad. If you trip this, you 3301 /* Freeing stuff in dumped memory is bad. If you trip this, you
3215 may need to check for this before freeing. */ 3302 may need to check for this before freeing. */
3216 gc_checking_assert (!OBJECT_DUMPED_P (lcrecord)); 3303 gc_checking_assert (!OBJECT_DUMPED_P (lcrecord));
3217 3304
3218 if (implementation->finalizer) 3305 if (implementation->finalizer)
3219 implementation->finalizer (lheader); 3306 implementation->finalizer (lcrecord);
3220 /* Yes, there are two ways to indicate freeness -- the type is 3307 /* Yes, there are two ways to indicate freeness -- the type is
3221 lrecord_type_free or the ->free flag is set. We used to do only the 3308 lrecord_type_free or the ->free flag is set. We used to do only the
3222 latter; now we do the former as well for KKCC purposes. Probably 3309 latter; now we do the former as well for KKCC purposes. Probably
3223 safer in any case, as we will lose quicker this way than keeping 3310 safer in any case, as we will lose quicker this way than keeping
3224 around an lrecord of apparently correct type but bogus junk in it. */ 3311 around an lrecord of apparently correct type but bogus junk in it. */
3580 GC_CHECK_LHEADER_INVARIANTS (h); 3667 GC_CHECK_LHEADER_INVARIANTS (h);
3581 3668
3582 if (! MARKED_RECORD_HEADER_P (h) && ! header->free) 3669 if (! MARKED_RECORD_HEADER_P (h) && ! header->free)
3583 { 3670 {
3584 if (LHEADER_IMPLEMENTATION (h)->finalizer) 3671 if (LHEADER_IMPLEMENTATION (h)->finalizer)
3585 LHEADER_IMPLEMENTATION (h)->finalizer (h); 3672 LHEADER_IMPLEMENTATION (h)->finalizer (wrap_pointer_1 (h));
3586 } 3673 }
3587 } 3674 }
3588 3675
3589 for (header = *prev; header; ) 3676 for (header = *prev; header; )
3590 { 3677 {
4868 2 * sizeof (void *), is required as overhead and that 4955 2 * sizeof (void *), is required as overhead and that
4869 blocks are allocated in the minimum required size except 4956 blocks are allocated in the minimum required size except
4870 that some minimum block size is imposed (e.g. 16 bytes). */ 4957 that some minimum block size is imposed (e.g. 16 bytes). */
4871 4958
4872 Bytecount 4959 Bytecount
4873 malloced_storage_size (void *UNUSED (ptr), Bytecount claimed_size, 4960 malloced_storage_size (void * UNUSED (ptr), Bytecount claimed_size,
4874 struct overhead_stats *stats) 4961 struct overhead_stats *stats)
4875 { 4962 {
4876 Bytecount orig_claimed_size = claimed_size; 4963 Bytecount orig_claimed_size = claimed_size;
4877 4964
4878 #ifndef SYSTEM_MALLOC 4965 #ifndef SYSTEM_MALLOC