Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 5124:623d57b7fbe8 ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
separate regular and disksave finalization, print method fixes. Create separate disksave method and make the finalize method only be for actual object finalization, not disksave finalization. Fix places where 0 was given in place of a printer -- print methods are mandatory, and internal objects formerly without a print method now must explicitly specify internal_object_printer(). Change the defn of CONSOLE_LIVE_P to avoid problems in some weird situations. -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-01-20 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (very_old_free_lcrecord): * alloc.c (disksave_object_finalization_1): * alloc.c (make_lcrecord_list): * alloc.c (alloc_managed_lcrecord): * alloc.c (free_managed_lcrecord): * alloc.c (sweep_lcrecords_1): * buffer.c: * bytecode.c: * bytecode.c (Fcompiled_function_p): * chartab.c: * console-impl.h: * console-impl.h (CONSOLE_TYPE_P): * console.c: * console.c (set_quit_events): * data.c: * data.c (Fmake_ephemeron): * database.c: * database.c (finalize_database): * database.c (Fclose_database): * device-msw.c: * device-msw.c (finalize_devmode): * device-msw.c (allocate_devmode): * device.c: * elhash.c: * elhash.c (finalize_hash_table): * eval.c: * eval.c (bind_multiple_value_limits): * event-stream.c: * event-stream.c (finalize_command_builder): * events.c: * events.c (mark_event): * extents.c: * extents.c (finalize_extent_info): * extents.c (uninit_buffer_extents): * faces.c: * file-coding.c: * file-coding.c (finalize_coding_system): * file-coding.h: * file-coding.h (struct coding_system_methods): * file-coding.h (struct detector): * floatfns.c: * floatfns.c (extract_float): * fns.c: * fns.c (Fidentity): * font-mgr.c (finalize_fc_pattern): * font-mgr.c (finalize_fc_config): * frame.c: * glyphs.c: * glyphs.c (finalize_image_instance): * glyphs.c (unmap_subwindow_instance_cache_mapper): * gui.c: * gui.c (gui_error): * keymap.c: * lisp.h (struct Lisp_Symbol): * lrecord.h: * lrecord.h (struct lrecord_implementation): * lrecord.h (MC_ALLOC_CALL_FINALIZER): * lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE): * lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_GENERAL_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_GENERAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT): * lrecord.h (MAKE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT): * lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT): * lrecord.h (MAKE_MODULE_LISP_OBJECT): * lstream.c: * lstream.c (finalize_lstream): * lstream.c (disksave_lstream): * marker.c: * marker.c (finalize_marker): * mule-charset.c (make_charset): * number.c: * objects.c: * objects.c (finalize_color_instance): * objects.c (finalize_font_instance): * opaque.c: * opaque.c (make_opaque_ptr): * process-nt.c: * process-nt.c (nt_finalize_process_data): * process-nt.c (nt_deactivate_process): * process.c: * process.c (finalize_process): * procimpl.h (struct process_methods): * scrollbar.c: * scrollbar.c (free_scrollbar_instance): * specifier.c (finalize_specifier): * symbols.c: * toolbar.c: * toolbar.c (Ftoolbar_button_p): * tooltalk.c: * ui-gtk.c: * ui-gtk.c (emacs_gtk_object_finalizer): * ui-gtk.c (allocate_emacs_gtk_boxed_data): * window.c: * window.c (finalize_window): * window.c (mark_window_as_deleted): Separate out regular and disksave finalization. Instead of a FOR_DISKSAVE argument to the finalizer, create a separate object method `disksaver'. Make `finalizer' have only one argument. Go through and separate out all finalize methods into finalize and disksave. Delete lots of thereby redundant disksave checking. Delete places that signal an error if we attempt to disksave -- all of these objects are non-dumpable and we will get an error from pdump anyway if we attempt to dump them. After this is done, only one object remains that has a disksave method -- lstream. Change DEFINE_*_LISP_OBJECT_WITH_PROPS to DEFINE_*_GENERAL_LISP_OBJECT, which is used for specifying either property methods or disksave methods (or in the future, any other less-used methods). Remove the for_disksave argument to finalize_process_data. Don't provide a disksaver for processes because no one currently needs it. Clean up various places where objects didn't provide a print method. It was made mandatory in previous changes, and all methods now either provide their own print method or use internal_object_printer or external_object_printer. Change the definition of CONSOLE_LIVE_P to use the contype enum rather than looking into the conmeths structure -- in some weird situations with dead objects, the conmeths structure is NULL, and printing such objects from debug_print() will crash if we try to look into the conmeths structure.
author Ben Wing <ben@xemacs.org>
date Wed, 20 Jan 2010 07:05:57 -0600
parents d1247f3cc363
children b5df3737028a
comparison
equal deleted inserted replaced
5123:fc85923c49af 5124:623d57b7fbe8
1 /* Storage allocation and gc for XEmacs Lisp interpreter. 1 /* Storage allocation and gc for XEmacs Lisp interpreter.
2 Copyright (C) 1985-1998 Free Software Foundation, Inc. 2 Copyright (C) 1985-1998 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc. 3 Copyright (C) 1995 Sun Microsystems, Inc.
4 Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005 Ben Wing. 4 Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005, 2010 Ben Wing.
5 5
6 This file is part of XEmacs. 6 This file is part of XEmacs.
7 7
8 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the 9 under the terms of the GNU General Public License as published by the
745 else 745 else
746 header = next; 746 header = next;
747 } 747 }
748 } 748 }
749 if (lrecord->implementation->finalizer) 749 if (lrecord->implementation->finalizer)
750 lrecord->implementation->finalizer (lrecord, 0); 750 lrecord->implementation->finalizer (lrecord);
751 xfree (lrecord); 751 xfree (lrecord);
752 return; 752 return;
753 } 753 }
754 #endif /* Unused */ 754 #endif /* Unused */
755 #endif /* not NEW_GC */ 755 #endif /* not NEW_GC */
763 #else /* not NEW_GC */ 763 #else /* not NEW_GC */
764 struct old_lcrecord_header *header; 764 struct old_lcrecord_header *header;
765 765
766 for (header = all_lcrecords; header; header = header->next) 766 for (header = all_lcrecords; header; header = header->next)
767 { 767 {
768 if (LHEADER_IMPLEMENTATION (&header->lheader)->finalizer && 768 struct lrecord_header *objh = &header->lheader;
769 !header->free) 769 const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (objh);
770 LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1); 770 #if 0 /* possibly useful for debugging */
771 if (!RECORD_DUMPABLE (objh) && !header->free)
772 {
773 stderr_out ("Disksaving a non-dumpable object: ");
774 debug_print (wrap_pointer_1 (header));
775 }
776 #endif
777 if (imp->disksaver && !header->free)
778 (imp->disksaver) (wrap_pointer_1 (header));
771 } 779 }
772 #endif /* not NEW_GC */ 780 #endif /* not NEW_GC */
773 } 781 }
774 782
775 /* Bitwise copy all parts of a Lisp object other than the header */ 783 /* Bitwise copy all parts of a Lisp object other than the header */
2340 internal_hash() already knows how to hash strings and finalization 2348 internal_hash() already knows how to hash strings and finalization
2341 is done with the ADDITIONAL_FREE_string macro, which is the 2349 is done with the ADDITIONAL_FREE_string macro, which is the
2342 standard way to do finalization when using 2350 standard way to do finalization when using
2343 SWEEP_FIXED_TYPE_BLOCK(). */ 2351 SWEEP_FIXED_TYPE_BLOCK(). */
2344 2352
2345 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT_WITH_PROPS ("string", string, 2353 DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT ("string", string,
2346 mark_string, print_string, 2354 mark_string, print_string,
2347 0, string_equal, 0, 2355 0, string_equal, 0,
2348 string_description, 2356 string_description,
2349 string_getprop, 2357 string_getprop,
2350 string_putprop, 2358 string_putprop,
2351 string_remprop, 2359 string_remprop,
2352 string_plist, 2360 string_plist,
2353 Lisp_String); 2361 0 /* no disksaver */,
2362 Lisp_String);
2354 #endif /* not NEW_GC */ 2363 #endif /* not NEW_GC */
2355 2364
2356 #ifdef NEW_GC 2365 #ifdef NEW_GC
2357 #define STRING_FULLSIZE(size) \ 2366 #define STRING_FULLSIZE(size) \
2358 ALIGN_SIZE (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_String_Direct_Data, Lisp_Object, data, (size) + 1), sizeof (Lisp_Object *)); 2367 ALIGN_SIZE (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_String_Direct_Data, Lisp_Object, data, (size) + 1), sizeof (Lisp_Object *));
2389 #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL) 2398 #define STRING_CHARS_FREE_P(ptr) ((ptr)->string == NULL)
2390 #define MARK_STRING_CHARS_AS_FREE(ptr) ((void) ((ptr)->string = NULL)) 2399 #define MARK_STRING_CHARS_AS_FREE(ptr) ((void) ((ptr)->string = NULL))
2391 #endif /* not NEW_GC */ 2400 #endif /* not NEW_GC */
2392 2401
2393 #ifdef NEW_GC 2402 #ifdef NEW_GC
2394 DEFINE_DUMPABLE_LISP_OBJECT_WITH_PROPS ("string", string, 2403 DEFINE_DUMPABLE_GENERAL_LISP_OBJECT ("string", string,
2395 mark_string, print_string, 2404 mark_string, print_string,
2396 0, 2405 0,
2397 string_equal, 0, 2406 string_equal, 0,
2398 string_description, 2407 string_description,
2399 string_getprop, 2408 string_getprop,
2400 string_putprop, 2409 string_putprop,
2401 string_remprop, 2410 string_remprop,
2402 string_plist, 2411 string_plist,
2403 Lisp_String); 2412 0 /* no disksaver */,
2413 Lisp_String);
2404 2414
2405 2415
2406 static const struct memory_description string_direct_data_description[] = { 2416 static const struct memory_description string_direct_data_description[] = {
2407 { XD_BYTECOUNT, offsetof (Lisp_String_Direct_Data, size) }, 2417 { XD_BYTECOUNT, offsetof (Lisp_String_Direct_Data, size) },
2408 { XD_END } 2418 { XD_END }
3048 3058
3049 Lisp_Object 3059 Lisp_Object
3050 make_lcrecord_list (Elemcount size, 3060 make_lcrecord_list (Elemcount size,
3051 const struct lrecord_implementation *implementation) 3061 const struct lrecord_implementation *implementation)
3052 { 3062 {
3053 /* Don't use old_alloc_lcrecord_type() avoid infinite recursion 3063 /* Don't use alloc_automanaged_lcrecord() avoid infinite recursion
3054 allocating this, */ 3064 allocating this. */
3055 struct lcrecord_list *p = (struct lcrecord_list *) 3065 struct lcrecord_list *p = (struct lcrecord_list *)
3056 old_basic_alloc_lcrecord (sizeof (struct lcrecord_list), 3066 old_alloc_lcrecord (&lrecord_lcrecord_list);
3057 &lrecord_lcrecord_list);
3058 3067
3059 p->implementation = implementation; 3068 p->implementation = implementation;
3060 p->size = size; 3069 p->size = size;
3061 p->free = Qnil; 3070 p->free = Qnil;
3062 return wrap_lcrecord_list (p); 3071 return wrap_lcrecord_list (p);
3098 lheader->type = list->implementation->lrecord_type_index; 3107 lheader->type = list->implementation->lrecord_type_index;
3099 old_zero_sized_lcrecord (free_header, list->size); 3108 old_zero_sized_lcrecord (free_header, list->size);
3100 return val; 3109 return val;
3101 } 3110 }
3102 else 3111 else
3103 return wrap_pointer_1 (old_basic_alloc_lcrecord (list->size, 3112 return wrap_pointer_1 (old_alloc_sized_lcrecord (list->size,
3104 list->implementation)); 3113 list->implementation));
3105 } 3114 }
3106 3115
3107 /* "Free" a Lisp object LCRECORD by placing it on its associated free list 3116 /* "Free" a Lisp object LCRECORD by placing it on its associated free list
3108 LCRECORD_LIST; next time alloc_managed_lcrecord() is called with the 3117 LCRECORD_LIST; next time alloc_managed_lcrecord() is called with the
3143 /* Freeing stuff in dumped memory is bad. If you trip this, you 3152 /* Freeing stuff in dumped memory is bad. If you trip this, you
3144 may need to check for this before freeing. */ 3153 may need to check for this before freeing. */
3145 gc_checking_assert (!OBJECT_DUMPED_P (lcrecord)); 3154 gc_checking_assert (!OBJECT_DUMPED_P (lcrecord));
3146 3155
3147 if (implementation->finalizer) 3156 if (implementation->finalizer)
3148 implementation->finalizer (lheader, 0); 3157 implementation->finalizer (lheader);
3149 /* Yes, there are two ways to indicate freeness -- the type is 3158 /* Yes, there are two ways to indicate freeness -- the type is
3150 lrecord_type_free or the ->free flag is set. We used to do only the 3159 lrecord_type_free or the ->free flag is set. We used to do only the
3151 latter; now we do the former as well for KKCC purposes. Probably 3160 latter; now we do the former as well for KKCC purposes. Probably
3152 safer in any case, as we will lose quicker this way than keeping 3161 safer in any case, as we will lose quicker this way than keeping
3153 around an lrecord of apparently correct type but bogus junk in it. */ 3162 around an lrecord of apparently correct type but bogus junk in it. */
3515 GC_CHECK_LHEADER_INVARIANTS (h); 3524 GC_CHECK_LHEADER_INVARIANTS (h);
3516 3525
3517 if (! MARKED_RECORD_HEADER_P (h) && ! header->free) 3526 if (! MARKED_RECORD_HEADER_P (h) && ! header->free)
3518 { 3527 {
3519 if (LHEADER_IMPLEMENTATION (h)->finalizer) 3528 if (LHEADER_IMPLEMENTATION (h)->finalizer)
3520 LHEADER_IMPLEMENTATION (h)->finalizer (h, 0); 3529 LHEADER_IMPLEMENTATION (h)->finalizer (h);
3521 } 3530 }
3522 } 3531 }
3523 3532
3524 for (header = *prev; header; ) 3533 for (header = *prev; header; )
3525 { 3534 {