X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5db81e33629049da22e7d0ff6c28a5cae31edac9..3438fe218c77633ee2c5f106e3a335f906347247:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index d24787576e..27426cdff6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -161,6 +161,10 @@ static pthread_mutex_t alloc_mutex; #define GC_STRING_BYTES(S) (STRING_BYTES (S)) +/* Default value of gc_cons_threshold (see below). */ + +#define GC_DEFAULT_THRESHOLD (100000 * sizeof (Lisp_Object)) + /* Global variables. */ struct emacs_globals globals; @@ -258,7 +262,7 @@ static char *stack_copy; static ptrdiff_t stack_copy_size; #endif -static Lisp_Object Qstring_bytes, Qvector_slots; +static Lisp_Object Qstring_bytes, Qvector_slots, Qheap; static Lisp_Object Qgc_cons_threshold; Lisp_Object Qchar_table_extra_slots; @@ -2711,6 +2715,7 @@ free_cons (struct Lisp_Cons *ptr) ptr->car = Vdead; #endif cons_free_list = ptr; + consing_since_gc -= sizeof *ptr; total_free_conses++; } @@ -2806,6 +2811,38 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, L Fcons (arg5, Qnil))))); } +/* Make a list of COUNT Lisp_Objects, where ARG is the + first one. Allocate conses from pure space if TYPE + is CONSTYPE_PURE, or allocate as usual if type is CONSTYPE_HEAP. */ + +Lisp_Object +listn (enum constype type, ptrdiff_t count, Lisp_Object arg, ...) +{ + va_list ap; + ptrdiff_t i; + Lisp_Object val, *objp; + + /* Change to SAFE_ALLOCA if you hit this eassert. */ + eassert (count <= MAX_ALLOCA / sizeof (Lisp_Object)); + + objp = alloca (count * sizeof (Lisp_Object)); + objp[0] = arg; + va_start (ap, arg); + for (i = 1; i < count; i++) + objp[i] = va_arg (ap, Lisp_Object); + va_end (ap); + + for (i = 0, val = Qnil; i < count; i++) + { + if (type == CONSTYPE_PURE) + val = pure_cons (objp[i], val); + else if (type == CONSTYPE_HEAP) + val = Fcons (objp[i], val); + else + abort (); + } + return val; +} DEFUN ("list", Flist, Slist, 0, MANY, 0, doc: /* Return a newly created list with specified arguments as elements. @@ -3559,10 +3596,10 @@ static int marker_block_index = MARKER_BLOCK_SIZE; static union Lisp_Misc *marker_free_list; -/* Return a newly allocated Lisp_Misc object, with no substructure. */ +/* Return a newly allocated Lisp_Misc object of specified TYPE. */ -Lisp_Object -allocate_misc (void) +static Lisp_Object +allocate_misc (enum Lisp_Misc_Type type) { Lisp_Object val; @@ -3594,6 +3631,7 @@ allocate_misc (void) --total_free_markers; consing_since_gc += sizeof (union Lisp_Misc); misc_objects_consed++; + XMISCTYPE (val) = type; XMISCANY (val)->gcmarkbit = 0; return val; } @@ -3606,7 +3644,7 @@ free_misc (Lisp_Object misc) XMISCTYPE (misc) = Lisp_Misc_Free; XMISC (misc)->u_free.chain = marker_free_list; marker_free_list = XMISC (misc); - + consing_since_gc -= sizeof (union Lisp_Misc); total_free_markers++; } @@ -3620,8 +3658,7 @@ make_save_value (void *pointer, ptrdiff_t integer) register Lisp_Object val; register struct Lisp_Save_Value *p; - val = allocate_misc (); - XMISCTYPE (val) = Lisp_Misc_Save_Value; + val = allocate_misc (Lisp_Misc_Save_Value); p = XSAVE_VALUE (val); p->pointer = pointer; p->integer = integer; @@ -3629,6 +3666,21 @@ make_save_value (void *pointer, ptrdiff_t integer) return val; } +/* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */ + +Lisp_Object +build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist) +{ + register Lisp_Object overlay; + + overlay = allocate_misc (Lisp_Misc_Overlay); + OVERLAY_START (overlay) = start; + OVERLAY_END (overlay) = end; + OVERLAY_PLIST (overlay) = plist; + XOVERLAY (overlay)->next = NULL; + return overlay; +} + DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, doc: /* Return a newly allocated marker which does not point at any place. */) (void) @@ -3636,8 +3688,7 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, register Lisp_Object val; register struct Lisp_Marker *p; - val = allocate_misc (); - XMISCTYPE (val) = Lisp_Misc_Marker; + val = allocate_misc (Lisp_Misc_Marker); p = XMARKER (val); p->buffer = 0; p->bytepos = 0; @@ -3662,8 +3713,7 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) /* Every character is at least one byte. */ eassert (charpos <= bytepos); - obj = allocate_misc (); - XMISCTYPE (obj) = Lisp_Misc_Marker; + obj = allocate_misc (Lisp_Misc_Marker); m = XMARKER (obj); m->buffer = buf; m->charpos = charpos; @@ -5396,7 +5446,7 @@ See Info node `(elisp)Garbage Collection'. */) char stack_top_variable; ptrdiff_t i; int message_p; - Lisp_Object total[10]; + Lisp_Object total[11]; ptrdiff_t count = SPECPDL_INDEX (); EMACS_TIME t1; @@ -5412,7 +5462,7 @@ See Info node `(elisp)Garbage Collection'. */) /* Don't keep undo information around forever. Do this early on, so it is no problem if the user quits. */ - for_each_buffer (nextb) + FOR_EACH_BUFFER (nextb) compact_buffer (nextb); t1 = current_emacs_time (); @@ -5462,8 +5512,6 @@ See Info node `(elisp)Garbage Collection'. */) gc_in_progress = 1; - /* clear_marks (); */ - /* Mark all the special slots that serve as the roots of accessibility. */ for (i = 0; i < staticidx; i++) @@ -5527,7 +5575,7 @@ See Info node `(elisp)Garbage Collection'. */) Look thru every buffer's undo list for elements that update markers that were not marked, and delete them. */ - for_each_buffer (nextb) + FOR_EACH_BUFFER (nextb) { /* If a buffer's undo list is Qt, that means that undo is turned off in that buffer. Calling truncate_undo_list on @@ -5580,12 +5628,11 @@ See Info node `(elisp)Garbage Collection'. */) CHECK_CONS_LIST (); - /* clear_marks (); */ gc_in_progress = 0; consing_since_gc = 0; - if (gc_cons_threshold < 10000) - gc_cons_threshold = 10000; + if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10) + gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10; gc_relative_threshold = 0; if (FLOATP (Vgc_cons_percentage)) @@ -5658,6 +5705,15 @@ See Info node `(elisp)Garbage Collection'. */) total[9] = list3 (Qbuffer, make_number (sizeof (struct buffer)), bounded_number (total_buffers)); + total[10] = list4 (Qheap, make_number (1024), +#ifdef DOUG_LEA_MALLOC + bounded_number ((mallinfo ().uordblks + 1023) >> 10), + bounded_number ((mallinfo ().fordblks + 1023) >> 10) +#else + Qnil, Qnil +#endif + ); + #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES { /* Compute average percentage of zombies. */ @@ -5955,7 +6011,7 @@ mark_object (Lisp_Object arg) if (po != &buffer_defaults && po != &buffer_local_symbols) { struct buffer *b; - for_each_buffer (b) + FOR_EACH_BUFFER (b) if (b == po) break; if (b == NULL) @@ -6605,33 +6661,6 @@ We divide the value by 1024 to make sure it fits in a Lisp integer. */) return end; } -DEFUN ("memory-free", Fmemory_free, Smemory_free, 0, 0, 0, - doc: /* Return a list (E H) of two measures of free memory. -E counts free lists maintained by Emacs itself. H counts the heap, -freed by Emacs but not released to the operating system; this is zero -if heap statistics are not available. Both counters are in units of -1024 bytes, rounded up. */) - (void) -{ - /* Make the return value first, so that its storage is accounted for. */ - Lisp_Object val = Fmake_list (make_number (2), make_number (0)); - - XSETCAR (val, - bounded_number - ((total_free_conses * sizeof (struct Lisp_Cons) - + total_free_markers * sizeof (union Lisp_Misc) - + total_free_symbols * sizeof (struct Lisp_Symbol) - + total_free_floats * sizeof (struct Lisp_Float) - + total_free_intervals * sizeof (struct interval) - + total_free_strings * sizeof (struct Lisp_String) - + total_free_vector_slots * word_size - + 1023) >> 10)); -#ifdef DOUG_LEA_MALLOC - XSETCAR (XCDR (val), bounded_number ((mallinfo ().fordblks + 1023) >> 10)); -#endif - return val; -} - DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0, doc: /* Return a list of counters that measure how much consing there has been. Each of these counters increments for a certain kind of object. @@ -6647,18 +6676,15 @@ Frames, windows, buffers, and subprocesses count as vectors (but the contents of a buffer's text do not count here). */) (void) { - Lisp_Object consed[8]; - - consed[0] = bounded_number (cons_cells_consed); - consed[1] = bounded_number (floats_consed); - consed[2] = bounded_number (vector_cells_consed); - consed[3] = bounded_number (symbols_consed); - consed[4] = bounded_number (string_chars_consed); - consed[5] = bounded_number (misc_objects_consed); - consed[6] = bounded_number (intervals_consed); - consed[7] = bounded_number (strings_consed); - - return Flist (8, consed); + return listn (CONSTYPE_HEAP, 8, + bounded_number (cons_cells_consed), + bounded_number (floats_consed), + bounded_number (vector_cells_consed), + bounded_number (symbols_consed), + bounded_number (string_chars_consed), + bounded_number (misc_objects_consed), + bounded_number (intervals_consed), + bounded_number (strings_consed)); } /* Find at most FIND_MAX symbols which have OBJ as their value or @@ -6752,7 +6778,7 @@ init_alloc_once (void) #endif refill_memory_reserve (); - gc_cons_threshold = 100000 * sizeof (Lisp_Object); + gc_cons_threshold = GC_DEFAULT_THRESHOLD; } void @@ -6839,8 +6865,8 @@ do hash-consing of the objects allocated to pure space. */); /* We build this in advance because if we wait until we need it, we might not be able to allocate the memory to hold it. */ Vmemory_signal_data - = pure_cons (Qerror, - pure_cons (build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil)); + = listn (CONSTYPE_PURE, 2, Qerror, + build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs")); DEFVAR_LISP ("memory-full", Vmemory_full, doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); @@ -6848,6 +6874,7 @@ do hash-consing of the objects allocated to pure space. */); DEFSYM (Qstring_bytes, "string-bytes"); DEFSYM (Qvector_slots, "vector-slots"); + DEFSYM (Qheap, "heap"); DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots"); @@ -6871,10 +6898,48 @@ The time is in seconds as a floating point value. */); defsubr (&Spurecopy); defsubr (&Sgarbage_collect); defsubr (&Smemory_limit); - defsubr (&Smemory_free); defsubr (&Smemory_use_counts); #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES defsubr (&Sgc_status); #endif } + +/* Make some symbols visible to GDB. This section is last, so that + the #undef lines don't mess up later code. */ + +/* When compiled with GCC, GDB might say "No enum type named + pvec_type" if we don't have at least one symbol with that type, and + then xbacktrace could fail. Similarly for the other enums and + their values. */ +union +{ + enum CHECK_LISP_OBJECT_TYPE CHECK_LISP_OBJECT_TYPE; + enum enum_USE_LSB_TAG enum_USE_LSB_TAG; + enum Lisp_Bits Lisp_Bits; + enum More_Lisp_Bits More_Lisp_Bits; + enum pvec_type pvec_type; +} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; + +/* These symbols cannot be done as enums, since values might not be + in 'int' range. Each symbol X has a corresponding X_VAL symbol, + verified to have the correct value. */ + +#define ARRAY_MARK_FLAG_VAL PTRDIFF_MIN +#define PSEUDOVECTOR_FLAG_VAL (PTRDIFF_MAX - PTRDIFF_MAX / 2) +#define VALMASK_VAL (USE_LSB_TAG ? -1 << GCTYPEBITS : VAL_MAX) + +verify (ARRAY_MARK_FLAG_VAL == ARRAY_MARK_FLAG); +verify (PSEUDOVECTOR_FLAG_VAL == PSEUDOVECTOR_FLAG); +verify (VALMASK_VAL == VALMASK); + +#undef ARRAY_MARK_FLAG +#undef PSEUDOVECTOR_FLAG +#undef VALMASK + +ptrdiff_t const EXTERNALLY_VISIBLE + ARRAY_MARK_FLAG = ARRAY_MARK_FLAG_VAL, + PSEUDOVECTOR_FLAG = PSEUDOVECTOR_FLAG_VAL; + +EMACS_INT const EXTERNALLY_VISIBLE + VALMASK = VALMASK_VAL;