X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/84eb0351d8be4811897c8cf62a69757ff5d14001..4e75f29d3a9eaaaa185d67facb7ba38611045aed:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index f75903aab5..412527b41a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -92,7 +92,8 @@ extern __malloc_size_t __malloc_extra_blocks; #endif /* not DOUG_LEA_MALLOC */ -#if ! defined (SYSTEM_MALLOC) && defined (HAVE_GTK_AND_PTHREAD) +#if ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT +#ifdef HAVE_GTK_AND_PTHREAD /* When GTK uses the file chooser dialog, different backends can be loaded dynamically. One such a backend is the Gnome VFS backend that gets loaded @@ -130,16 +131,13 @@ static pthread_mutex_t alloc_mutex; } \ while (0) -#else /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */ +#else /* ! defined HAVE_GTK_AND_PTHREAD */ #define BLOCK_INPUT_ALLOC BLOCK_INPUT #define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT -#endif /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */ - -/* Value of _bytes_used, when spare_memory was freed. */ - -static __malloc_size_t bytes_used_when_full; +#endif /* ! defined HAVE_GTK_AND_PTHREAD */ +#endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */ /* Mark, unmark, query mark bit of a Lisp string. S must be a pointer to a struct Lisp_String. */ @@ -152,13 +150,11 @@ static __malloc_size_t bytes_used_when_full; #define VECTOR_UNMARK(V) ((V)->size &= ~ARRAY_MARK_FLAG) #define VECTOR_MARKED_P(V) (((V)->size & ARRAY_MARK_FLAG) != 0) -/* Value is the number of bytes/chars of S, a pointer to a struct - Lisp_String. This must be used instead of STRING_BYTES (S) or - S->size during GC, because S->size contains the mark bit for +/* Value is the number of bytes of S, a pointer to a struct Lisp_String. + Be careful during GC, because S->size contains the mark bit for strings. */ #define GC_STRING_BYTES(S) (STRING_BYTES (S)) -#define GC_STRING_CHARS(S) ((S)->size & ~ARRAY_MARK_FLAG) /* Global variables. */ struct emacs_globals globals; @@ -198,9 +194,11 @@ static int total_free_floats, total_floats; static char *spare_memory[7]; +#ifndef SYSTEM_MALLOC /* Amount of spare memory to keep in large reserve block. */ #define SPARE_MEMORY (1 << 14) +#endif /* Number of extra blocks malloc should get when it needs more core. */ @@ -212,6 +210,9 @@ static int malloc_hysteresis; remapping on more recent systems because this is less important nowadays than in the days of small memories and timesharing. */ +#ifndef VIRT_ADDR_VARIES +static +#endif EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,}; #define PUREBEG (char *) pure @@ -254,39 +255,37 @@ const char *pending_malloc_warning; /* Buffer in which we save a copy of the C stack at each GC. */ +#if MAX_SAVE_STACK > 0 static char *stack_copy; -static int stack_copy_size; +static size_t stack_copy_size; +#endif /* Non-zero means ignore malloc warnings. Set during initialization. Currently not used. */ static int ignore_warnings; -Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots; +static Lisp_Object Qgc_cons_threshold; +Lisp_Object Qchar_table_extra_slots; /* Hook run after GC has finished. */ -Lisp_Object Qpost_gc_hook; +static Lisp_Object Qpost_gc_hook; static void mark_buffer (Lisp_Object); static void mark_terminals (void); -extern void mark_kboards (void); -extern void mark_ttys (void); -extern void mark_backtrace (void); static void gc_sweep (void); static void mark_glyph_matrix (struct glyph_matrix *); static void mark_face_cache (struct face_cache *); -#ifdef HAVE_WINDOW_SYSTEM -extern void mark_fringe_data (void); -#endif /* HAVE_WINDOW_SYSTEM */ - +#if !defined REL_ALLOC || defined SYSTEM_MALLOC +static void refill_memory_reserve (void); +#endif static struct Lisp_String *allocate_string (void); static void compact_small_strings (void); static void free_large_strings (void); static void sweep_strings (void); - -extern int message_enable_multibyte; +static void free_misc (Lisp_Object); /* When scanning the C stack for live Lisp objects, Emacs keeps track of what memory allocated via lisp_malloc is intended for what @@ -468,13 +467,6 @@ display_malloc_warning (void) intern ("emergency")); pending_malloc_warning = 0; } - - -#ifdef DOUG_LEA_MALLOC -# define BYTES_USED (mallinfo ().uordblks) -#else -# define BYTES_USED _bytes_used -#endif /* Called if we can't allocate relocatable space for a buffer. */ @@ -564,8 +556,7 @@ static int check_depth; /* Like malloc, but wraps allocated block with header and trailer. */ POINTER_TYPE * -overrun_check_malloc (size) - size_t size; +overrun_check_malloc (size_t size) { register unsigned char *val; size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0; @@ -589,11 +580,9 @@ overrun_check_malloc (size) with header and trailer. */ POINTER_TYPE * -overrun_check_realloc (block, size) - POINTER_TYPE *block; - size_t size; +overrun_check_realloc (POINTER_TYPE *block, size_t size) { - register unsigned char *val = (unsigned char *)block; + register unsigned char *val = (unsigned char *) block; size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0; if (val @@ -629,10 +618,9 @@ overrun_check_realloc (block, size) /* Like free, but checks block for overrun. */ void -overrun_check_free (block) - POINTER_TYPE *block; +overrun_check_free (POINTER_TYPE *block) { - unsigned char *val = (unsigned char *)block; + unsigned char *val = (unsigned char *) block; ++check_depth; if (val @@ -1099,8 +1087,18 @@ static void * (*old_malloc_hook) (size_t, const void *); static void * (*old_realloc_hook) (void *, size_t, const void*); static void (*old_free_hook) (void*, const void*); +#ifdef DOUG_LEA_MALLOC +# define BYTES_USED (mallinfo ().uordblks) +#else +# define BYTES_USED _bytes_used +#endif + static __malloc_size_t bytes_used_when_reconsidered; +/* Value of _bytes_used, when spare_memory was freed. */ + +static __malloc_size_t bytes_used_when_full; + /* This function is used as the hook for free to call. */ static void @@ -1345,7 +1343,7 @@ static int total_free_intervals, total_intervals; /* List of free intervals. */ -INTERVAL interval_free_list; +static INTERVAL interval_free_list; /* Total number of interval blocks now in use. */ @@ -2301,7 +2299,6 @@ make_unibyte_string (const char *contents, EMACS_INT length) register Lisp_Object val; val = make_uninit_string (length); memcpy (SDATA (val), contents, length); - STRING_SET_UNIBYTE (val); return val; } @@ -2465,19 +2462,19 @@ struct float_block /* Current float_block. */ -struct float_block *float_block; +static struct float_block *float_block; /* Index of first unused Lisp_Float in the current float_block. */ -int float_block_index; +static int float_block_index; /* Total number of float blocks now in use. */ -int n_float_blocks; +static int n_float_blocks; /* Free-list of Lisp_Floats. */ -struct Lisp_Float *float_free_list; +static struct Lisp_Float *float_free_list; /* Initialize float allocation. */ @@ -2577,15 +2574,15 @@ struct cons_block /* Current cons_block. */ -struct cons_block *cons_block; +static struct cons_block *cons_block; /* Index of first unused Lisp_Cons in the current block. */ -int cons_block_index; +static int cons_block_index; /* Free-list of Lisp_Cons structures. */ -struct Lisp_Cons *cons_free_list; +static struct Lisp_Cons *cons_free_list; /* Total number of cons blocks now in use. */ @@ -2660,17 +2657,17 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, return val; } +#ifdef GC_CHECK_CONS_LIST /* Get an error now if there's any junk in the cons free list. */ void check_cons_list (void) { -#ifdef GC_CHECK_CONS_LIST struct Lisp_Cons *tail = cons_free_list; while (tail) tail = tail->u.chain; -#endif } +#endif /* Make a list of 1, 2, 3, 4 or 5 specified objects. */ @@ -2713,7 +2710,7 @@ DEFUN ("list", Flist, Slist, 0, MANY, 0, doc: /* Return a newly created list with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (list &rest OBJECTS) */) - (int nargs, register Lisp_Object *args) + (size_t nargs, register Lisp_Object *args) { register Lisp_Object val; val = Qnil; @@ -2910,15 +2907,15 @@ See also the function `vector'. */) { Lisp_Object vector; register EMACS_INT sizei; - register EMACS_INT index; + register EMACS_INT i; register struct Lisp_Vector *p; CHECK_NATNUM (length); sizei = XFASTINT (length); p = allocate_vector (sizei); - for (index = 0; index < sizei; index++) - p->contents[index] = init; + for (i = 0; i < sizei; i++) + p->contents[i] = init; XSETVECTOR (vector, p); return vector; @@ -2929,32 +2926,41 @@ DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. usage: (vector &rest OBJECTS) */) - (register int nargs, Lisp_Object *args) + (register size_t nargs, Lisp_Object *args) { register Lisp_Object len, val; - register int index; + register size_t i; register struct Lisp_Vector *p; XSETFASTINT (len, nargs); val = Fmake_vector (len, Qnil); p = XVECTOR (val); - for (index = 0; index < nargs; index++) - p->contents[index] = args[index]; + for (i = 0; i < nargs; i++) + p->contents[i] = args[i]; return val; } DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, doc: /* Create a byte-code object with specified arguments as elements. -The arguments should be the arglist, bytecode-string, constant vector, -stack size, (optional) doc string, and (optional) interactive spec. +The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant +vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING, +and (optional) INTERACTIVE-SPEC. The first four arguments are required; at most six have any significance. +The ARGLIST can be either like the one of `lambda', in which case the arguments +will be dynamically bound before executing the byte code, or it can be an +integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the +minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number +of arguments (ignoring &rest) and the R bit specifies whether there is a &rest +argument to catch the left-over arguments. If such an integer is used, the +arguments will not be dynamically bound but will be instead pushed on the +stack before executing the byte-code. usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) - (register int nargs, Lisp_Object *args) + (register size_t nargs, Lisp_Object *args) { register Lisp_Object len, val; - register int index; + register size_t i; register struct Lisp_Vector *p; XSETFASTINT (len, nargs); @@ -2972,11 +2978,11 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT args[1] = Fstring_as_unibyte (args[1]); p = XVECTOR (val); - for (index = 0; index < nargs; index++) + for (i = 0; i < nargs; i++) { if (!NILP (Vpurify_flag)) - args[index] = Fpurecopy (args[index]); - p->contents[index] = args[index]; + args[i] = Fpurecopy (args[i]); + p->contents[i] = args[i]; } XSETPVECTYPE (p, PVEC_COMPILED); XSETCOMPILED (val, p); @@ -3077,6 +3083,7 @@ Its value and function definition are void, and its property list is nil. */) p->gcmarkbit = 0; p->interned = SYMBOL_UNINTERNED; p->constant = 0; + p->declared_special = 0; consing_since_gc += sizeof (struct Lisp_Symbol); symbols_consed++; return val; @@ -3163,7 +3170,7 @@ allocate_misc (void) /* Free a Lisp_Misc object */ -void +static void free_misc (Lisp_Object misc) { XMISCTYPE (misc) = Lisp_Misc_Free; @@ -3290,7 +3297,7 @@ memory_full (void) /* Record the space now used. When it decreases substantially, we can refill the memory reserve. */ -#ifndef SYSTEM_MALLOC +#if !defined SYSTEM_MALLOC && !defined SYNC_INPUT bytes_used_when_full = BYTES_USED; #endif @@ -3886,7 +3893,7 @@ live_buffer_p (struct mem_node *m, void *p) must not have been killed. */ return (m->type == MEM_TYPE_BUFFER && p == m->start - && !NILP (((struct buffer *) p)->name)); + && !NILP (((struct buffer *) p)->BUFFER_INTERNAL_FIELD (name))); } #endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */ @@ -4236,7 +4243,7 @@ static void check_gcpros (void) { struct gcpro *p; - int i; + size_t i; for (p = gcprolist; p; p = p->next) for (i = 0; i < p->nvars; ++i) @@ -4319,12 +4326,6 @@ static void mark_stack (void) { int i; - /* jmp_buf may not be aligned enough on darwin-ppc64 */ - union aligned_jmpbuf { - Lisp_Object o; - jmp_buf j; - } j; - volatile int stack_grows_down_p = (char *) &j > (char *) stack_base; void *end; #ifdef HAVE___BUILTIN_UNWIND_INIT @@ -4334,6 +4335,14 @@ mark_stack (void) __builtin_unwind_init (); end = &end; #else /* not HAVE___BUILTIN_UNWIND_INIT */ +#ifndef GC_SAVE_REGISTERS_ON_STACK + /* jmp_buf may not be aligned enough on darwin-ppc64 */ + union aligned_jmpbuf { + Lisp_Object o; + jmp_buf j; + } j; + volatile int stack_grows_down_p = (char *) &j > (char *) stack_base; +#endif /* This trick flushes the register windows so that all the state of the process is contained in the stack. */ /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is @@ -4842,10 +4851,8 @@ returns nil, because real GC can't be done. */) (void) { register struct specbinding *bind; - struct catchtag *catch; - struct handler *handler; char stack_top_variable; - register int i; + register size_t i; int message_p; Lisp_Object total[8]; int count = SPECPDL_INDEX (); @@ -4872,11 +4879,11 @@ returns nil, because real GC can't be done. */) turned off in that buffer. Calling truncate_undo_list on Qt tends to return NULL, which effectively turns undo back on. So don't call truncate_undo_list if undo_list is Qt. */ - if (! NILP (nextb->name) && ! EQ (nextb->undo_list, Qt)) + if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt)) truncate_undo_list (nextb); /* Shrink buffer gaps, but skip indirect and dead buffers. */ - if (nextb->base_buffer == 0 && !NILP (nextb->name) + if (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! nextb->text->inhibit_shrinking) { /* If a buffer's gap size is more than 10% of the buffer @@ -4911,21 +4918,26 @@ returns nil, because real GC can't be done. */) #if MAX_SAVE_STACK > 0 if (NILP (Vpurify_flag)) { - i = &stack_top_variable - stack_bottom; - if (i < 0) i = -i; - if (i < MAX_SAVE_STACK) + char *stack; + size_t stack_size; + if (&stack_top_variable < stack_bottom) + { + stack = &stack_top_variable; + stack_size = stack_bottom - &stack_top_variable; + } + else + { + stack = stack_bottom; + stack_size = &stack_top_variable - stack_bottom; + } + if (stack_size <= MAX_SAVE_STACK) { - if (stack_copy == 0) - stack_copy = (char *) xmalloc (stack_copy_size = i); - else if (stack_copy_size < i) - stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i)); - if (stack_copy) + if (stack_copy_size < stack_size) { - if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0) - memcpy (stack_copy, stack_bottom, i); - else - memcpy (stack_copy, &stack_top_variable, i); + stack_copy = (char *) xrealloc (stack_copy, stack_size); + stack_copy_size = stack_size; } + memcpy (stack_copy, stack, stack_size); } } #endif /* MAX_SAVE_STACK > 0 */ @@ -4972,9 +4984,11 @@ returns nil, because real GC can't be done. */) for (i = 0; i < tail->nvars; i++) mark_object (tail->var[i]); } -#endif - mark_byte_stack (); + { + struct catchtag *catch; + struct handler *handler; + for (catch = catchlist; catch; catch = catch->next) { mark_object (catch->tag); @@ -4985,7 +4999,9 @@ returns nil, because real GC can't be done. */) mark_object (handler->handler); mark_object (handler->var); } + } mark_backtrace (); +#endif #ifdef HAVE_WINDOW_SYSTEM mark_fringe_data (); @@ -5009,10 +5025,10 @@ returns nil, because real GC can't be done. */) turned off in that buffer. Calling truncate_undo_list on Qt tends to return NULL, which effectively turns undo back on. So don't call truncate_undo_list if undo_list is Qt. */ - if (! EQ (nextb->undo_list, Qt)) + if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt)) { Lisp_Object tail, prev; - tail = nextb->undo_list; + tail = nextb->BUFFER_INTERNAL_FIELD (undo_list); prev = Qnil; while (CONSP (tail)) { @@ -5021,7 +5037,7 @@ returns nil, because real GC can't be done. */) && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) { if (NILP (prev)) - nextb->undo_list = tail = XCDR (tail); + nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail); else { tail = XCDR (tail); @@ -5037,7 +5053,7 @@ returns nil, because real GC can't be done. */) } /* Now that we have stripped the elements that need not be in the undo_list any more, we can finally mark the list. */ - mark_object (nextb->undo_list); + mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list)); nextb = nextb->next; } @@ -5068,18 +5084,18 @@ returns nil, because real GC can't be done. */) if (FLOATP (Vgc_cons_percentage)) { /* Set gc_cons_combined_threshold. */ - EMACS_INT total = 0; - - total += total_conses * sizeof (struct Lisp_Cons); - total += total_symbols * sizeof (struct Lisp_Symbol); - total += total_markers * sizeof (union Lisp_Misc); - total += total_string_size; - total += total_vector_size * sizeof (Lisp_Object); - total += total_floats * sizeof (struct Lisp_Float); - total += total_intervals * sizeof (struct interval); - total += total_strings * sizeof (struct Lisp_String); - - gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage); + EMACS_INT tot = 0; + + tot += total_conses * sizeof (struct Lisp_Cons); + tot += total_symbols * sizeof (struct Lisp_Symbol); + tot += total_markers * sizeof (union Lisp_Misc); + tot += total_string_size; + tot += total_vector_size * sizeof (Lisp_Object); + tot += total_floats * sizeof (struct Lisp_Float); + tot += total_intervals * sizeof (struct interval); + tot += total_strings * sizeof (struct Lisp_String); + + gc_relative_threshold = tot * XFLOAT_DATA (Vgc_cons_percentage); } else gc_relative_threshold = 0; @@ -5128,9 +5144,9 @@ returns nil, because real GC can't be done. */) if (!NILP (Vpost_gc_hook)) { - int count = inhibit_garbage_collection (); + int gc_count = inhibit_garbage_collection (); safe_run_hooks (Qpost_gc_hook); - unbind_to (count, Qnil); + unbind_to (gc_count, Qnil); } /* Accumulate statistics. */ @@ -5202,13 +5218,13 @@ mark_face_cache (struct face_cache *c) #define LAST_MARKED_SIZE 500 static Lisp_Object last_marked[LAST_MARKED_SIZE]; -int last_marked_index; +static int last_marked_index; /* For debugging--call abort when we cdr down this many links of a list, in mark_object. In debugging, the call to abort will hit a breakpoint. Normally this is zero and the check never goes off. */ -static int mark_object_loop_halt; +static size_t mark_object_loop_halt; static void mark_vectorlike (struct Lisp_Vector *ptr) @@ -5265,7 +5281,7 @@ mark_object (Lisp_Object arg) void *po; struct mem_node *m; #endif - int cdr_count = 0; + size_t cdr_count = 0; loop: @@ -5309,7 +5325,6 @@ mark_object (Lisp_Object arg) #else /* not GC_CHECK_MARKED_OBJECTS */ -#define CHECK_ALLOCATED() (void) 0 #define CHECK_LIVE(LIVEP) (void) 0 #define CHECK_ALLOCATED_AND_LIVE(LIVEP) (void) 0 @@ -5595,7 +5610,7 @@ mark_buffer (Lisp_Object buf) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (ptr = &buffer->name; + for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name); (char *)ptr < (char *)buffer + sizeof (struct buffer); ptr++) mark_object (*ptr); @@ -6061,7 +6076,7 @@ We divide the value by 1024 to make sure it fits in a Lisp integer. */) { Lisp_Object end; - XSETINT (end, (EMACS_INT) sbrk (0) / 1024); + XSETINT (end, (EMACS_INT) (char *) sbrk (0) / 1024); return end; } @@ -6095,6 +6110,7 @@ Frames, windows, buffers, and subprocesses count as vectors return Flist (8, consed); } +#ifdef ENABLE_CHECKING int suppress_checking; void @@ -6104,6 +6120,7 @@ die (const char *msg, const char *file, int line) file, line, msg); abort (); } +#endif /* Initialization */