Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 5142:f965e31a35f0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
reduce lcrecord headers to 2 words, rename printing_unreadable_object -------------------- ChangeLog entries follow: -------------------- man/ChangeLog addition: 2010-03-13 Ben Wing <ben@xemacs.org> * internals/internals.texi (Working with Lisp Objects): * internals/internals.texi (Writing Macros): * internals/internals.texi (lrecords): More rewriting to correspond with changes from *LRECORD* to *LISP_OBJECT*. modules/ChangeLog addition: 2010-03-13 Ben Wing <ben@xemacs.org> * postgresql/postgresql.c (print_pgconn): * postgresql/postgresql.c (print_pgresult): printing_unreadable_object -> printing_unreadable_object_fmt. 2010-03-13 Ben Wing <ben@xemacs.org> * ldap/eldap.c (print_ldap): printing_unreadable_object -> printing_unreadable_object_fmt. src/ChangeLog addition: 2010-03-13 Ben Wing <ben@xemacs.org> * alloc.c (alloc_sized_lrecord_1): * alloc.c (alloc_sized_lrecord_array): * alloc.c (old_alloc_sized_lcrecord): * alloc.c (disksave_object_finalization_1): * alloc.c (mark_lcrecord_list): * alloc.c (alloc_managed_lcrecord): * alloc.c (free_managed_lcrecord): * alloc.c (tick_lcrecord_stats): * alloc.c (sweep_lcrecords_1): * buffer.c (print_buffer): * buffer.c (DEFVAR_BUFFER_LOCAL_1): * casetab.c: * casetab.c (print_case_table): * console.c (print_console): * console.c (DEFVAR_CONSOLE_LOCAL_1): * data.c (print_weak_list): * data.c (print_weak_box): * data.c (print_ephemeron): * data.c (ephemeron_equal): * database.c (print_database): * database.c (finalize_database): * device-msw.c (sync_printer_with_devmode): * device-msw.c (print_devmode): * device-msw.c (finalize_devmode): * device.c: * device.c (print_device): * elhash.c: * elhash.c (print_hash_table): * eval.c (print_subr): * eval.c (print_multiple_value): * event-stream.c (event_stream_resignal_wakeup): * events.c (clear_event_resource): * events.c (zero_event): * events.c (print_event): * extents.c: * extents.c (print_extent): * file-coding.c (print_coding_system): * font-mgr.c: * font-mgr.c (Ffc_init): * frame.c: * frame.c (print_frame): * gc.c: * gc.c (GC_CHECK_NOT_FREE): * glyphs.c: * glyphs.c (print_image_instance): * glyphs.c (print_glyph): * gui.c (print_gui_item): * gui.c (copy_gui_item): * keymap.c (print_keymap): * keymap.c (MARKED_SLOT): * lisp.h: * lisp.h (struct Lisp_String): * lisp.h (DEFUN): * lisp.h (DEFUN_NORETURN): * lrecord.h: * lrecord.h (NORMAL_LISP_OBJECT_UID): * lrecord.h (struct lrecord_header): * lrecord.h (set_lheader_implementation): * lrecord.h (struct old_lcrecord_header): * lrecord.h (struct free_lcrecord_header): * marker.c (print_marker): * mule-charset.c: * mule-charset.c (print_charset): * objects.c (print_color_instance): * objects.c (print_font_instance): * objects.c (finalize_font_instance): * print.c (print_cons): * print.c (printing_unreadable_object_fmt): * print.c (printing_unreadable_lisp_object): * print.c (external_object_printer): * print.c (internal_object_printer): * print.c (debug_p4): * print.c (ext_print_begin): * process.c (print_process): * rangetab.c (print_range_table): * rangetab.c (range_table_equal): * scrollbar.c (free_scrollbar_instance): * specifier.c (print_specifier): * specifier.c (finalize_specifier): * symbols.c (guts_of_unbound_marker): * symeval.h: * symeval.h (DEFVAR_SYMVAL_FWD): * tooltalk.c: * tooltalk.c (print_tooltalk_message): * tooltalk.c (print_tooltalk_pattern): * ui-gtk.c (ffi_object_printer): * ui-gtk.c (emacs_gtk_object_printer): * ui-gtk.c (emacs_gtk_boxed_printer): * window.c (print_window): * window.c (free_window_mirror): * window.c (debug_print_window): * xemacs.def.in.in: (1) printing_unreadable_object -> printing_unreadable_object_fmt. (2) printing_unreadable_lcrecord -> printing_unreadable_lisp_object and fix up so it no longer requires an lcrecord. These previous changes eliminate most of the remaining places where the terms `lcrecord' and `lrecord' occurred outside of specialized code. (3) Fairly major change: Reduce the number of words in an lcrecord from 3 to 2. The third word consisted of a uid that duplicated the lrecord uid, and a single free bit, which was moved into the lrecord structure. This reduces the size of the `uid' slot from 21 bits to 20 bits. Arguably this isn't enough -- we could easily have more than 1,000,000 or so objects created in a session. The answer is (a) It doesn't really matter if we overflow the uid field because it's only used for debugging, to identify an object uniquely (or pretty much so). (b) If we cared about it overflowing and wanted to reduce this, we could make it so that cons, string, float and certain other frob-block types that never print out the uid simply don't store a uid in them and don't increment the lrecord_uid_counter. (4) In conjunction with (3), create new macro NORMAL_LISP_OBJECT_UID() and use it to abstract out the differences between NEWGC and old-GC in accessing the `uid' value from a "normal Lisp Object pointer". (5) In events.c, use zero_nonsized_lisp_object() in place of custom- written equivalent. In font-mgr.c use external_object_printer() in place of custom-written equivalents.
author Ben Wing <ben@xemacs.org>
date Sat, 13 Mar 2010 05:38:08 -0600
parents a9c41067dd88
children 88bd4f3ef8e4
comparison
equal deleted inserted replaced
5141:0dcd22290039 5142:f965e31a35f0
588 assert_proper_sizing (size); 588 assert_proper_sizing (size);
589 589
590 lheader = (struct lrecord_header *) mc_alloc (size); 590 lheader = (struct lrecord_header *) mc_alloc (size);
591 gc_checking_assert (LRECORD_FREE_P (lheader)); 591 gc_checking_assert (LRECORD_FREE_P (lheader));
592 set_lheader_implementation (lheader, implementation); 592 set_lheader_implementation (lheader, implementation);
593 lheader->uid = lrecord_uid_counter++;
594 #ifdef ALLOC_TYPE_STATS 593 #ifdef ALLOC_TYPE_STATS
595 inc_lrecord_stats (size, lheader); 594 inc_lrecord_stats (size, lheader);
596 #endif /* ALLOC_TYPE_STATS */ 595 #endif /* ALLOC_TYPE_STATS */
597 if (implementation->finalizer) 596 if (implementation->finalizer)
598 add_finalizable_obj (wrap_pointer_1 (lheader)); 597 add_finalizable_obj (wrap_pointer_1 (lheader));
649 stop = ((Rawbyte *) lheader) + (size * elemcount -1); 648 stop = ((Rawbyte *) lheader) + (size * elemcount -1);
650 start < stop; start += size) 649 start < stop; start += size)
651 { 650 {
652 struct lrecord_header *lh = (struct lrecord_header *) start; 651 struct lrecord_header *lh = (struct lrecord_header *) start;
653 set_lheader_implementation (lh, implementation); 652 set_lheader_implementation (lh, implementation);
654 lh->uid = lrecord_uid_counter++;
655 #ifdef ALLOC_TYPE_STATS 653 #ifdef ALLOC_TYPE_STATS
656 inc_lrecord_stats (size, lh); 654 inc_lrecord_stats (size, lh);
657 #endif /* not ALLOC_TYPE_STATS */ 655 #endif /* not ALLOC_TYPE_STATS */
658 if (implementation->finalizer) 656 if (implementation->finalizer)
659 add_finalizable_obj (wrap_pointer_1 (lh)); 657 add_finalizable_obj (wrap_pointer_1 (lh));
691 !(implementation->hash == NULL && implementation->equal != NULL)); 689 !(implementation->hash == NULL && implementation->equal != NULL));
692 690
693 lcheader = (struct old_lcrecord_header *) allocate_lisp_storage (size); 691 lcheader = (struct old_lcrecord_header *) allocate_lisp_storage (size);
694 set_lheader_implementation (&lcheader->lheader, implementation); 692 set_lheader_implementation (&lcheader->lheader, implementation);
695 lcheader->next = all_lcrecords; 693 lcheader->next = all_lcrecords;
696 #if 1 /* mly prefers to see small ID numbers */
697 lcheader->uid = lrecord_uid_counter++;
698 #else /* jwz prefers to see real addrs */
699 lcheader->uid = (int) &lcheader;
700 #endif
701 lcheader->free = 0;
702 all_lcrecords = lcheader; 694 all_lcrecords = lcheader;
703 INCREMENT_CONS_COUNTER (size, implementation->name); 695 INCREMENT_CONS_COUNTER (size, implementation->name);
704 return wrap_pointer_1 (lcheader); 696 return wrap_pointer_1 (lcheader);
705 } 697 }
706 698
763 for (header = all_lcrecords; header; header = header->next) 755 for (header = all_lcrecords; header; header = header->next)
764 { 756 {
765 struct lrecord_header *objh = &header->lheader; 757 struct lrecord_header *objh = &header->lheader;
766 const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (objh); 758 const struct lrecord_implementation *imp = LHEADER_IMPLEMENTATION (objh);
767 #if 0 /* possibly useful for debugging */ 759 #if 0 /* possibly useful for debugging */
768 if (!RECORD_DUMPABLE (objh) && !header->free) 760 if (!RECORD_DUMPABLE (objh) && !objh->free)
769 { 761 {
770 stderr_out ("Disksaving a non-dumpable object: "); 762 stderr_out ("Disksaving a non-dumpable object: ");
771 debug_print (wrap_pointer_1 (header)); 763 debug_print (wrap_pointer_1 (header));
772 } 764 }
773 #endif 765 #endif
774 if (imp->disksaver && !header->free) 766 if (imp->disksaver && !objh->free)
775 (imp->disksaver) (wrap_pointer_1 (header)); 767 (imp->disksaver) (wrap_pointer_1 (header));
776 } 768 }
777 #endif /* not NEW_GC */ 769 #endif /* not NEW_GC */
778 } 770 }
779 771
3173 && 3165 &&
3174 /* Only lcrecords should be here. */ 3166 /* Only lcrecords should be here. */
3175 ! list->implementation->frob_block_p 3167 ! list->implementation->frob_block_p
3176 && 3168 &&
3177 /* Only free lcrecords should be here. */ 3169 /* Only free lcrecords should be here. */
3178 free_header->lcheader.free 3170 lheader->free
3179 && 3171 &&
3180 /* The type of the lcrecord must be right. */ 3172 /* The type of the lcrecord must be right. */
3181 lheader->type == lrecord_type_free 3173 lheader->type == lrecord_type_free
3182 && 3174 &&
3183 /* So must the size. */ 3175 /* So must the size. */
3226 #ifdef ERROR_CHECK_GC 3218 #ifdef ERROR_CHECK_GC
3227 /* Major overkill here. */ 3219 /* Major overkill here. */
3228 /* There should be no other pointers to the free list. */ 3220 /* There should be no other pointers to the free list. */
3229 assert (! MARKED_RECORD_HEADER_P (lheader)); 3221 assert (! MARKED_RECORD_HEADER_P (lheader));
3230 /* Only free lcrecords should be here. */ 3222 /* Only free lcrecords should be here. */
3231 assert (free_header->lcheader.free); 3223 assert (lheader->free);
3232 assert (lheader->type == lrecord_type_free); 3224 assert (lheader->type == lrecord_type_free);
3233 /* Only lcrecords should be here. */ 3225 /* Only lcrecords should be here. */
3234 assert (! (list->implementation->frob_block_p)); 3226 assert (! (list->implementation->frob_block_p));
3235 #if 0 /* Not used anymore, now that we set the type of the header to 3227 #if 0 /* Not used anymore, now that we set the type of the header to
3236 lrecord_type_free. */ 3228 lrecord_type_free. */
3241 assert (list->implementation->static_size == 0 || 3233 assert (list->implementation->static_size == 0 ||
3242 list->implementation->static_size == list->size); 3234 list->implementation->static_size == list->size);
3243 #endif /* ERROR_CHECK_GC */ 3235 #endif /* ERROR_CHECK_GC */
3244 3236
3245 list->free = free_header->chain; 3237 list->free = free_header->chain;
3246 free_header->lcheader.free = 0; 3238 lheader->free = 0;
3247 /* Put back the correct type, as we set it to lrecord_type_free. */ 3239 /* Put back the correct type, as we set it to lrecord_type_free. */
3248 lheader->type = list->implementation->lrecord_type_index; 3240 lheader->type = list->implementation->lrecord_type_index;
3249 zero_sized_lisp_object (val, list->size); 3241 zero_sized_lisp_object (val, list->size);
3250 return val; 3242 return val;
3251 } 3243 }
3295 3287
3296 /* Make sure the size is correct. This will catch, for example, 3288 /* Make sure the size is correct. This will catch, for example,
3297 putting a window configuration on the wrong free list. */ 3289 putting a window configuration on the wrong free list. */
3298 gc_checking_assert (lisp_object_size (lcrecord) == list->size); 3290 gc_checking_assert (lisp_object_size (lcrecord) == list->size);
3299 /* Make sure the object isn't already freed. */ 3291 /* Make sure the object isn't already freed. */
3300 gc_checking_assert (!free_header->lcheader.free); 3292 gc_checking_assert (!lheader->free);
3301 /* Freeing stuff in dumped memory is bad. If you trip this, you 3293 /* Freeing stuff in dumped memory is bad. If you trip this, you
3302 may need to check for this before freeing. */ 3294 may need to check for this before freeing. */
3303 gc_checking_assert (!OBJECT_DUMPED_P (lcrecord)); 3295 gc_checking_assert (!OBJECT_DUMPED_P (lcrecord));
3304 3296
3305 if (implementation->finalizer) 3297 if (implementation->finalizer)
3309 latter; now we do the former as well for KKCC purposes. Probably 3301 latter; now we do the former as well for KKCC purposes. Probably
3310 safer in any case, as we will lose quicker this way than keeping 3302 safer in any case, as we will lose quicker this way than keeping
3311 around an lrecord of apparently correct type but bogus junk in it. */ 3303 around an lrecord of apparently correct type but bogus junk in it. */
3312 MARK_LRECORD_AS_FREE (lheader); 3304 MARK_LRECORD_AS_FREE (lheader);
3313 free_header->chain = list->free; 3305 free_header->chain = list->free;
3314 free_header->lcheader.free = 1; 3306 lheader->free = 1;
3315 list->free = lcrecord; 3307 list->free = lcrecord;
3316 } 3308 }
3317 3309
3318 static Lisp_Object all_lcrecord_lists[countof (lrecord_implementations_table)]; 3310 static Lisp_Object all_lcrecord_lists[countof (lrecord_implementations_table)];
3319 3311
3628 } 3620 }
3629 3621
3630 inline static void 3622 inline static void
3631 tick_lcrecord_stats (const struct lrecord_header *h, int free_p) 3623 tick_lcrecord_stats (const struct lrecord_header *h, int free_p)
3632 { 3624 {
3633 if (((struct old_lcrecord_header *) h)->free) 3625 if (h->free)
3634 { 3626 {
3635 gc_checking_assert (!free_p); 3627 gc_checking_assert (!free_p);
3636 tick_lrecord_stats (h, ALLOC_ON_FREE_LIST); 3628 tick_lrecord_stats (h, ALLOC_ON_FREE_LIST);
3637 } 3629 }
3638 else 3630 else
3664 { 3656 {
3665 struct lrecord_header *h = &(header->lheader); 3657 struct lrecord_header *h = &(header->lheader);
3666 3658
3667 GC_CHECK_LHEADER_INVARIANTS (h); 3659 GC_CHECK_LHEADER_INVARIANTS (h);
3668 3660
3669 if (! MARKED_RECORD_HEADER_P (h) && ! header->free) 3661 if (! MARKED_RECORD_HEADER_P (h) && !h->free)
3670 { 3662 {
3671 if (LHEADER_IMPLEMENTATION (h)->finalizer) 3663 if (LHEADER_IMPLEMENTATION (h)->finalizer)
3672 LHEADER_IMPLEMENTATION (h)->finalizer (wrap_pointer_1 (h)); 3664 LHEADER_IMPLEMENTATION (h)->finalizer (wrap_pointer_1 (h));
3673 } 3665 }
3674 } 3666 }