X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ae8e81224e5b308d75bd283a2395d326126e0a46..ca70e62febbbb5315ba2908f5a1d189635039928:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index 6340761c88..067dd7b753 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1,5 +1,5 @@ /* Storage allocation and gc for GNU Emacs Lisp interpreter. - Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001 + Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -122,18 +122,18 @@ int consing_since_gc; /* Count the amount of consing of various sorts of space. */ -int cons_cells_consed; -int floats_consed; -int vector_cells_consed; -int symbols_consed; -int string_chars_consed; -int misc_objects_consed; -int intervals_consed; -int strings_consed; +EMACS_INT cons_cells_consed; +EMACS_INT floats_consed; +EMACS_INT vector_cells_consed; +EMACS_INT symbols_consed; +EMACS_INT string_chars_consed; +EMACS_INT misc_objects_consed; +EMACS_INT intervals_consed; +EMACS_INT strings_consed; /* Number of bytes of consing since GC before another GC should be done. */ -int gc_cons_threshold; +EMACS_INT gc_cons_threshold; /* Nonzero during GC. */ @@ -155,8 +155,8 @@ int malloc_sbrk_unused; /* Two limits controlling how much undo information to keep. */ -int undo_limit; -int undo_strong_limit; +EMACS_INT undo_limit; +EMACS_INT undo_strong_limit; /* Number of live and free conses etc. */ @@ -215,7 +215,7 @@ static size_t pure_bytes_used_before_overflow; /* Index in pure at which next pure object will be allocated.. */ -int pure_bytes_used; +EMACS_INT pure_bytes_used; /* If nonzero, this is a warning delivered by malloc and not yet displayed. */ @@ -396,7 +396,7 @@ struct gcpro *gcprolist; /* Addresses of staticpro'd variables. */ -#define NSTATICS 1024 +#define NSTATICS 1280 Lisp_Object *staticvec[NSTATICS] = {0}; /* Index of next unused slot in staticvec. */ @@ -1020,7 +1020,7 @@ make_number (n) /* Lisp_Strings are allocated in string_block structures. When a new string_block is allocated, all the Lisp_Strings it contains are - added to a free-list stiing_free_list. When a new Lisp_String is + added to a free-list string_free_list. When a new Lisp_String is needed, it is taken from that list. During the sweep phase of GC, string_blocks that are entirely free are freed, except two which we keep. @@ -1668,8 +1668,8 @@ Both LENGTH and INIT must be numbers. */) register unsigned char *p, *end; int c, nbytes; - CHECK_NATNUM (length, 0); - CHECK_NUMBER (init, 1); + CHECK_NATNUM (length); + CHECK_NUMBER (init); c = XINT (init); if (SINGLE_BYTE_CHAR_P (c)) @@ -1713,7 +1713,7 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */) int real_init, i; int length_in_chars, length_in_elts, bits_per_value; - CHECK_NATNUM (length, 0); + CHECK_NATNUM (length); bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR; @@ -2130,7 +2130,7 @@ list5 (arg1, arg2, arg3, arg4, arg5) DEFUN ("list", Flist, Slist, 0, MANY, 0, - doc: /* Return a newly created list with specified arguments as elements. + doc: /* Return a newly created list with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (list &rest OBJECTS) */) (nargs, args) @@ -2157,7 +2157,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, register Lisp_Object val; register int size; - CHECK_NATNUM (length, 0); + CHECK_NATNUM (length); size = XFASTINT (length); val = Qnil; @@ -2347,7 +2347,7 @@ See also the function `vector'. */) register int index; register struct Lisp_Vector *p; - CHECK_NATNUM (length, 0); + CHECK_NATNUM (length); sizei = XFASTINT (length); p = allocate_vector (sizei); @@ -2369,9 +2369,9 @@ The property's value should be an integer between 0 and 10. */) { Lisp_Object vector; Lisp_Object n; - CHECK_SYMBOL (purpose, 1); + CHECK_SYMBOL (purpose); n = Fget (purpose, Qchar_table_extra_slots); - CHECK_NUMBER (n, 0); + CHECK_NUMBER (n); if (XINT (n) < 0 || XINT (n) > 10) args_out_of_range (n, Qnil); /* Add 2 to the size for the defalt and parent slots. */ @@ -2403,7 +2403,7 @@ make_sub_char_table (defalt) DEFUN ("vector", Fvector, Svector, 0, MANY, 0, - doc: /* Return a newly created vector with specified arguments as elements. + doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (vector &rest OBJECTS) */) (nargs, args) @@ -2521,7 +2521,7 @@ Its value and function definition are void, and its property list is nil. */) register Lisp_Object val; register struct Lisp_Symbol *p; - CHECK_STRING (name, 0); + CHECK_STRING (name); if (symbol_free_list) { @@ -2711,6 +2711,17 @@ make_event_array (nargs, args) #if GC_MARK_STACK || defined GC_MALLOC_CHECK +/* Conservative C stack marking requires a method to identify possibly + live Lisp objects given a pointer value. We do this by keeping + track of blocks of Lisp data that are allocated in a red-black tree + (see also the comment of mem_node which is the type of nodes in + that tree). Function lisp_malloc adds information for an allocated + block to the red-black tree with calls to mem_insert, and function + lisp_free removes it with mem_delete. Functions live_string_p etc + call mem_find to lookup information about a given pointer in the + tree, and use that to determine if the pointer points to a Lisp + object or not. */ + /* Initialize this part of alloc.c. */ static void @@ -3574,7 +3585,7 @@ If you are a system-programmer, or can get the help of a local wizard\n\ who is, please take a look at the function mark_stack in alloc.c, and\n\ verify that the methods used are appropriate for your system.\n\ \n\ -Please mail the result to .\n\ +Please mail the result to .\n\ " #define SETJMP_WILL_NOT_WORK "\ @@ -3586,7 +3597,7 @@ solution for your system.\n\ \n\ Please take a look at the function mark_stack in alloc.c, and\n\ try to find a way to make it work on your system.\n\ -Please mail the result to .\n\ +Please mail the result to .\n\ " @@ -3723,6 +3734,7 @@ dump_zombies () static void mark_stack () { + int i; jmp_buf j; volatile int stack_grows_down_p = (char *) &j > (char *) stack_base; void *end; @@ -3758,17 +3770,11 @@ mark_stack () /* This assumes that the stack is a contiguous region in memory. If that's not the case, something has to be done here to iterate over the stack segments. */ -#if GC_LISP_OBJECT_ALIGNMENT == 1 - mark_memory (stack_base, end); - mark_memory ((char *) stack_base + 1, end); - mark_memory ((char *) stack_base + 2, end); - mark_memory ((char *) stack_base + 3, end); -#elif GC_LISP_OBJECT_ALIGNMENT == 2 - mark_memory (stack_base, end); - mark_memory ((char *) stack_base + 2, end); -#else - mark_memory (stack_base, end); +#ifndef GC_LISP_OBJECT_ALIGNMENT +#define GC_LISP_OBJECT_ALIGNMENT sizeof (Lisp_Object) #endif + for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT) + mark_memory ((char *) stack_base + i, end); #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS check_gcpros (); @@ -3816,8 +3822,11 @@ pure_alloc (size, type) if (pure_bytes_used + nbytes > pure_size) { - beg = purebeg = (char *) xmalloc (PURESIZE); - pure_size = PURESIZE; + /* Don't allocate a large amount here, + because it might get mmap'd and then its address + might not be usable. */ + beg = purebeg = (char *) xmalloc (10000); + pure_size = 10000; pure_bytes_used_before_overflow += pure_bytes_used; pure_bytes_used = 0; } @@ -3828,14 +3837,14 @@ pure_alloc (size, type) } -/* Signal an error if PURESIZE is too small. */ +/* Print a warning if PURESIZE is too small. */ void check_pure_size () { if (pure_bytes_used_before_overflow) - error ("Pure Lisp storage overflow (approx. %d bytes needed)", - (int) (pure_bytes_used + pure_bytes_used_before_overflow)); + message ("Pure Lisp storage overflow (approx. %d bytes needed)", + (int) (pure_bytes_used + pure_bytes_used_before_overflow)); } @@ -4012,7 +4021,9 @@ int inhibit_garbage_collection () { int count = specpdl_ptr - specpdl; - specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM)); + int nbits = min (VALBITS, BITS_PER_INT); + + specbind (Qgc_cons_threshold, make_number (((EMACS_INT) 1 << (nbits - 1)) - 1)); return count; } @@ -4096,6 +4107,24 @@ Garbage collection happens automatically if you cons more than nextb->undo_list = truncate_undo_list (nextb->undo_list, undo_limit, undo_strong_limit); + + /* Shrink buffer gaps, but skip indirect and dead buffers. */ + if (nextb->base_buffer == 0 && !NILP (nextb->name)) + { + /* If a buffer's gap size is more than 10% of the buffer + size, or larger than 2000 bytes, then shrink it + accordingly. Keep a minimum size of 20 bytes. */ + int size = min (2000, max (20, (nextb->text->z_byte / 10))); + + if (nextb->text->gap_size > size) + { + struct buffer *save_current = current_buffer; + current_buffer = nextb; + make_gap (-(nextb->text->gap_size - size)); + current_buffer = save_current; + } + } + nextb = nextb->next; } } @@ -4610,6 +4639,10 @@ mark_object (argptr) h->size |= ARRAY_MARK_FLAG; /* Mark contents. */ + /* Do not mark next_free or next_weak. + Being in the next_weak chain + should not keep the hash table alive. + No need to mark `count' since it is an integer. */ mark_object (&h->test); mark_object (&h->weak); mark_object (&h->rehash_size); @@ -4859,6 +4892,7 @@ mark_kboards () mark_object (&kb->Vsystem_key_alist); mark_object (&kb->system_key_syms); mark_object (&kb->Vdefault_minibuffer_frame); + mark_object (&kb->echo_string); } }