X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/492d9f3e3ccd2b640958e840caa451e9e04e86db..985773c9038f9847f9e7362f3b5fb0c8acac13a2:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index 0c5b9d7a02..ed003af3ea 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6,7 +6,7 @@ This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) +the Free Software Foundation; either version 3, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, @@ -53,8 +53,9 @@ Boston, MA 02110-1301, USA. */ #include "keyboard.h" #include "frame.h" #include "blockinput.h" -#include "charset.h" +#include "character.h" #include "syssignal.h" +#include "termhooks.h" /* For struct terminal. */ #include /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd @@ -266,7 +267,7 @@ Lisp_Object Vmemory_full; remapping on more recent systems because this is less important nowadays than in the days of small memories and timesharing. */ -EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {1,}; +EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,}; #define PUREBEG (char *) pure #else /* HAVE_SHM */ @@ -341,7 +342,7 @@ Lisp_Object Vgc_elapsed; /* accumulated elapsed time in GC */ EMACS_INT gcs_done; /* accumulated GCs */ static void mark_buffer P_ ((Lisp_Object)); -extern void mark_terminals P_ ((void)); +static void mark_terminals P_ ((void)); extern void mark_kboards P_ ((void)); extern void mark_ttys P_ ((void)); extern void mark_backtrace P_ ((void)); @@ -375,14 +376,11 @@ enum mem_type MEM_TYPE_MISC, MEM_TYPE_SYMBOL, MEM_TYPE_FLOAT, - /* Keep the following vector-like types together, with - MEM_TYPE_WINDOW being the last, and MEM_TYPE_VECTOR the - first. Or change the code of live_vector_p, for instance. */ - MEM_TYPE_VECTOR, - MEM_TYPE_PROCESS, - MEM_TYPE_HASH_TABLE, - MEM_TYPE_FRAME, - MEM_TYPE_WINDOW + /* We used to keep separate mem_types for subtypes of vectors such as + process, hash_table, frame, terminal, and window, but we never made + use of the distinction, so it only caused source-code complexity + and runtime slowdown. Minor but pointless. */ + MEM_TYPE_VECTORLIKE }; static POINTER_TYPE *lisp_align_malloc P_ ((size_t, enum mem_type)); @@ -469,7 +467,7 @@ static struct mem_node mem_z; #define MEM_NIL &mem_z static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type)); -static struct Lisp_Vector *allocate_vectorlike P_ ((EMACS_INT, enum mem_type)); +static struct Lisp_Vector *allocate_vectorlike P_ ((EMACS_INT)); static void lisp_free P_ ((POINTER_TYPE *)); static void mark_stack P_ ((void)); static int live_vector_p P_ ((struct mem_node *, void *)); @@ -504,7 +502,7 @@ struct gcpro *gcprolist; /* Addresses of staticpro'd variables. Initialize it to a nonzero value; otherwise some compilers put it into BSS. */ -#define NSTATICS 1280 +#define NSTATICS 0x600 Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag}; /* Index of next unused slot in staticvec. */ @@ -745,6 +743,15 @@ overrun_check_free (block) #define free overrun_check_free #endif +#ifdef SYNC_INPUT +/* When using SYNC_INPUT, we don't call malloc from a signal handler, so + there's no need to block input around malloc. */ +#define MALLOC_BLOCK_INPUT ((void)0) +#define MALLOC_UNBLOCK_INPUT ((void)0) +#else +#define MALLOC_BLOCK_INPUT BLOCK_INPUT +#define MALLOC_UNBLOCK_INPUT UNBLOCK_INPUT +#endif /* Like malloc but check for no memory and block interrupt input.. */ @@ -754,9 +761,9 @@ xmalloc (size) { register POINTER_TYPE *val; - BLOCK_INPUT; + MALLOC_BLOCK_INPUT; val = (POINTER_TYPE *) malloc (size); - UNBLOCK_INPUT; + MALLOC_UNBLOCK_INPUT; if (!val && size) memory_full (); @@ -773,14 +780,14 @@ xrealloc (block, size) { register POINTER_TYPE *val; - BLOCK_INPUT; + MALLOC_BLOCK_INPUT; /* We must call malloc explicitly when BLOCK is 0, since some reallocs don't do this. */ if (! block) val = (POINTER_TYPE *) malloc (size); else val = (POINTER_TYPE *) realloc (block, size); - UNBLOCK_INPUT; + MALLOC_UNBLOCK_INPUT; if (!val && size) memory_full (); return val; @@ -793,9 +800,9 @@ void xfree (block) POINTER_TYPE *block; { - BLOCK_INPUT; + MALLOC_BLOCK_INPUT; free (block); - UNBLOCK_INPUT; + MALLOC_UNBLOCK_INPUT; /* We don't call refill_memory_reserve here because that duplicates doing so in emacs_blocked_free and the criterion should go there. */ @@ -846,7 +853,7 @@ lisp_malloc (nbytes, type) { register void *val; - BLOCK_INPUT; + MALLOC_BLOCK_INPUT; #ifdef GC_MALLOC_CHECK allocated_mem_type = type; @@ -876,7 +883,7 @@ lisp_malloc (nbytes, type) mem_insert (val, (char *) val + nbytes, type); #endif - UNBLOCK_INPUT; + MALLOC_UNBLOCK_INPUT; if (!val && nbytes) memory_full (); return val; @@ -889,12 +896,12 @@ static void lisp_free (block) POINTER_TYPE *block; { - BLOCK_INPUT; + MALLOC_BLOCK_INPUT; free (block); #if GC_MARK_STACK && !defined GC_MALLOC_CHECK mem_delete (mem_find (block)); #endif - UNBLOCK_INPUT; + MALLOC_UNBLOCK_INPUT; } /* Allocation of aligned blocks of memory to store Lisp data. */ @@ -995,7 +1002,7 @@ lisp_align_malloc (nbytes, type) eassert (nbytes <= BLOCK_BYTES); - BLOCK_INPUT; + MALLOC_BLOCK_INPUT; #ifdef GC_MALLOC_CHECK allocated_mem_type = type; @@ -1027,7 +1034,7 @@ lisp_align_malloc (nbytes, type) if (base == 0) { - UNBLOCK_INPUT; + MALLOC_UNBLOCK_INPUT; memory_full (); } @@ -1053,7 +1060,7 @@ lisp_align_malloc (nbytes, type) { lisp_malloc_loser = base; free (base); - UNBLOCK_INPUT; + MALLOC_UNBLOCK_INPUT; memory_full (); } } @@ -1086,7 +1093,7 @@ lisp_align_malloc (nbytes, type) mem_insert (val, (char *) val + nbytes, type); #endif - UNBLOCK_INPUT; + MALLOC_UNBLOCK_INPUT; if (!val && nbytes) memory_full (); @@ -1101,7 +1108,7 @@ lisp_align_free (block) struct ablock *ablock = block; struct ablocks *abase = ABLOCK_ABASE (ablock); - BLOCK_INPUT; + MALLOC_BLOCK_INPUT; #if GC_MARK_STACK && !defined GC_MALLOC_CHECK mem_delete (mem_find (block)); #endif @@ -1134,7 +1141,7 @@ lisp_align_free (block) #endif free (ABLOCKS_BASE (abase)); } - UNBLOCK_INPUT; + MALLOC_UNBLOCK_INPUT; } /* Return a new buffer structure allocated from the heap with @@ -1163,6 +1170,8 @@ allocate_buffer () can use GNU malloc. */ #ifndef SYNC_INPUT +/* When using SYNC_INPUT, we don't call malloc from a signal handler, so + there's no need to block input around malloc. */ #ifndef DOUG_LEA_MALLOC extern void * (*__malloc_hook) P_ ((size_t, const void *)); @@ -1343,9 +1352,9 @@ emacs_blocked_realloc (ptr, size, ptr2) void reset_malloc_hooks () { - __free_hook = 0; - __malloc_hook = 0; - __realloc_hook = 0; + __free_hook = old_free_hook; + __malloc_hook = old_malloc_hook; + __realloc_hook = old_realloc_hook; } #endif /* HAVE_GTK_AND_PTHREAD */ @@ -1447,9 +1456,7 @@ make_interval () /* eassert (!handling_signal); */ -#ifndef SYNC_INPUT - BLOCK_INPUT; -#endif + MALLOC_BLOCK_INPUT; if (interval_free_list) { @@ -1473,9 +1480,7 @@ make_interval () val = &interval_block->intervals[interval_block_index++]; } -#ifndef SYNC_INPUT - UNBLOCK_INPUT; -#endif + MALLOC_UNBLOCK_INPUT; consing_since_gc += sizeof (struct interval); intervals_consed++; @@ -1878,9 +1883,7 @@ allocate_string () /* eassert (!handling_signal); */ -#ifndef SYNC_INPUT - BLOCK_INPUT; -#endif + MALLOC_BLOCK_INPUT; /* If the free-list is empty, allocate a new string_block, and add all the Lisp_Strings in it to the free-list. */ @@ -1911,9 +1914,7 @@ allocate_string () s = string_free_list; string_free_list = NEXT_FREE_LISP_STRING (s); -#ifndef SYNC_INPUT - UNBLOCK_INPUT; -#endif + MALLOC_UNBLOCK_INPUT; /* Probably not strictly necessary, but play it safe. */ bzero (s, sizeof *s); @@ -1965,9 +1966,7 @@ allocate_string_data (s, nchars, nbytes) old_data = s->data ? SDATA_OF_STRING (s) : NULL; old_nbytes = GC_STRING_BYTES (s); -#ifndef SYNC_INPUT - BLOCK_INPUT; -#endif + MALLOC_BLOCK_INPUT; if (nbytes > LARGE_STRING_BYTES) { @@ -1983,18 +1982,14 @@ allocate_string_data (s, nchars, nbytes) mmap'ed data typically have an address towards the top of the address space, which won't fit into an EMACS_INT (at least on 32-bit systems with the current tagging scheme). --fx */ - BLOCK_INPUT; mallopt (M_MMAP_MAX, 0); - UNBLOCK_INPUT; #endif b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP); #ifdef DOUG_LEA_MALLOC /* Back to a reasonable maximum of mmap'ed areas. */ - BLOCK_INPUT; mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); - UNBLOCK_INPUT; #endif b->next_free = &b->first_data; @@ -2025,9 +2020,7 @@ allocate_string_data (s, nchars, nbytes) data = b->next_free; b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA); -#ifndef SYNC_INPUT - UNBLOCK_INPUT; -#endif + MALLOC_UNBLOCK_INPUT; data->string = s; s->data = SDATA_DATA (data); @@ -2293,7 +2286,7 @@ INIT must be an integer that represents a character. */) CHECK_NUMBER (init); c = XINT (init); - if (SINGLE_BYTE_CHAR_P (c)) + if (ASCII_CHAR_P (c)) { nbytes = XINT (length); val = make_uninit_string (nbytes); @@ -2345,11 +2338,13 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */) /* We must allocate one more elements than LENGTH_IN_ELTS for the slot `size' of the struct Lisp_Bool_Vector. */ val = Fmake_vector (make_number (length_in_elts + 1), Qnil); - p = XBOOL_VECTOR (val); /* Get rid of any bits that would cause confusion. */ - p->vector_size = 0; - XSETBOOL_VECTOR (val, p); + XVECTOR (val)->size = 0; /* No Lisp_Object to trace in there. */ + /* Use XVECTOR (val) rather than `p' because p->size is not TRT. */ + XSETPVECTYPE (XVECTOR (val), PVEC_BOOL_VECTOR); + + p = XBOOL_VECTOR (val); p->size = XFASTINT (length); real_init = (NILP (init) ? 0 : -1); @@ -2358,7 +2353,7 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */) /* Clear the extraneous bits in the last byte. */ if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR) - XBOOL_VECTOR (val)->data[length_in_chars - 1] + p->data[length_in_chars - 1] &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; return val; @@ -2616,9 +2611,7 @@ make_float (float_value) /* eassert (!handling_signal); */ -#ifndef SYNC_INPUT - BLOCK_INPUT; -#endif + MALLOC_BLOCK_INPUT; if (float_free_list) { @@ -2645,9 +2638,7 @@ make_float (float_value) float_block_index++; } -#ifndef SYNC_INPUT - UNBLOCK_INPUT; -#endif + MALLOC_UNBLOCK_INPUT; XFLOAT_DATA (val) = float_value; eassert (!FLOAT_MARKED_P (XFLOAT (val))); @@ -2745,9 +2736,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, /* eassert (!handling_signal); */ -#ifndef SYNC_INPUT - BLOCK_INPUT; -#endif + MALLOC_BLOCK_INPUT; if (cons_free_list) { @@ -2773,9 +2762,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, cons_block_index++; } -#ifndef SYNC_INPUT - UNBLOCK_INPUT; -#endif + MALLOC_UNBLOCK_INPUT; XSETCAR (val, car); XSETCDR (val, cdr); @@ -2925,48 +2912,39 @@ int n_vectors; with room for LEN Lisp_Objects. */ static struct Lisp_Vector * -allocate_vectorlike (len, type) +allocate_vectorlike (len) EMACS_INT len; - enum mem_type type; { struct Lisp_Vector *p; size_t nbytes; + MALLOC_BLOCK_INPUT; + #ifdef DOUG_LEA_MALLOC /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed because mapped region contents are not preserved in a dumped Emacs. */ - BLOCK_INPUT; mallopt (M_MMAP_MAX, 0); - UNBLOCK_INPUT; #endif /* This gets triggered by code which I haven't bothered to fix. --Stef */ /* eassert (!handling_signal); */ nbytes = sizeof *p + (len - 1) * sizeof p->contents[0]; - p = (struct Lisp_Vector *) lisp_malloc (nbytes, type); + p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); #ifdef DOUG_LEA_MALLOC /* Back to a reasonable maximum of mmap'ed areas. */ - BLOCK_INPUT; mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); - UNBLOCK_INPUT; #endif consing_since_gc += nbytes; vector_cells_consed += len; -#ifndef SYNC_INPUT - BLOCK_INPUT; -#endif - p->next = all_vectors; all_vectors = p; -#ifndef SYNC_INPUT - UNBLOCK_INPUT; -#endif + MALLOC_UNBLOCK_INPUT; ++n_vectors; return p; @@ -2979,7 +2957,7 @@ struct Lisp_Vector * allocate_vector (nslots) EMACS_INT nslots; { - struct Lisp_Vector *v = allocate_vectorlike (nslots, MEM_TYPE_VECTOR); + struct Lisp_Vector *v = allocate_vectorlike (nslots); v->size = nslots; return v; } @@ -2987,74 +2965,78 @@ allocate_vector (nslots) /* Allocate other vector-like structures. */ -struct Lisp_Hash_Table * -allocate_hash_table () +static struct Lisp_Vector * +allocate_pseudovector (memlen, lisplen, tag) + int memlen, lisplen; + EMACS_INT tag; { - EMACS_INT len = VECSIZE (struct Lisp_Hash_Table); - struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_HASH_TABLE); + struct Lisp_Vector *v = allocate_vectorlike (memlen); EMACS_INT i; - v->size = len; - for (i = 0; i < len; ++i) + /* Only the first lisplen slots will be traced normally by the GC. */ + v->size = lisplen; + for (i = 0; i < lisplen; ++i) v->contents[i] = Qnil; - return (struct Lisp_Hash_Table *) v; + XSETPVECTYPE (v, tag); /* Add the appropriate tag. */ + return v; +} +#define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \ + ((typ*) \ + allocate_pseudovector \ + (VECSIZE (typ), PSEUDOVECSIZE (typ, field), tag)) + +struct Lisp_Hash_Table * +allocate_hash_table (void) +{ + return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, count, PVEC_HASH_TABLE); } struct window * allocate_window () { - EMACS_INT len = VECSIZE (struct window); - struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_WINDOW); - EMACS_INT i; + return ALLOCATE_PSEUDOVECTOR(struct window, current_matrix, PVEC_WINDOW); +} - for (i = 0; i < len; ++i) - v->contents[i] = Qnil; - v->size = len; - return (struct window *) v; -} +struct terminal * +allocate_terminal () +{ + struct terminal *t = ALLOCATE_PSEUDOVECTOR (struct terminal, + next_terminal, PVEC_TERMINAL); + /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */ + bzero (&(t->next_terminal), + ((char*)(t+1)) - ((char*)&(t->next_terminal))); + return t; +} struct frame * allocate_frame () { - EMACS_INT len = VECSIZE (struct frame); - struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_FRAME); - EMACS_INT i; - - for (i = 0; i < len; ++i) - v->contents[i] = make_number (0); - v->size = len; - return (struct frame *) v; + struct frame *f = ALLOCATE_PSEUDOVECTOR (struct frame, + face_cache, PVEC_FRAME); + /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */ + bzero (&(f->face_cache), + ((char*)(f+1)) - ((char*)&(f->face_cache))); + return f; } struct Lisp_Process * allocate_process () { - /* Memory-footprint of the object in nb of Lisp_Object fields. */ - EMACS_INT memlen = VECSIZE (struct Lisp_Process); - /* Size if we only count the actual Lisp_Object fields (which need to be - traced by the GC). */ - EMACS_INT lisplen = PSEUDOVECSIZE (struct Lisp_Process, pid); - struct Lisp_Vector *v = allocate_vectorlike (memlen, MEM_TYPE_PROCESS); - EMACS_INT i; - - for (i = 0; i < lisplen; ++i) - v->contents[i] = Qnil; - v->size = lisplen; - - return (struct Lisp_Process *) v; + return ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS); } +/* Only used for PVEC_WINDOW_CONFIGURATION. */ struct Lisp_Vector * allocate_other_vector (len) EMACS_INT len; { - struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_VECTOR); + struct Lisp_Vector *v = allocate_vectorlike (len); EMACS_INT i; for (i = 0; i < len; ++i) @@ -3088,49 +3070,6 @@ See also the function `vector'. */) } -DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, - doc: /* Return a newly created char-table, with purpose PURPOSE. -Each element is initialized to INIT, which defaults to nil. -PURPOSE should be a symbol which has a `char-table-extra-slots' property. -The property's value should be an integer between 0 and 10. */) - (purpose, init) - register Lisp_Object purpose, init; -{ - Lisp_Object vector; - Lisp_Object n; - CHECK_SYMBOL (purpose); - n = Fget (purpose, Qchar_table_extra_slots); - 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. */ - vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)), - init); - XCHAR_TABLE (vector)->top = Qt; - XCHAR_TABLE (vector)->parent = Qnil; - XCHAR_TABLE (vector)->purpose = purpose; - XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); - return vector; -} - - -/* Return a newly created sub char table with slots initialized by INIT. - Since a sub char table does not appear as a top level Emacs Lisp - object, we don't need a Lisp interface to make it. */ - -Lisp_Object -make_sub_char_table (init) - Lisp_Object init; -{ - Lisp_Object vector - = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), init); - XCHAR_TABLE (vector)->top = Qnil; - XCHAR_TABLE (vector)->defalt = Qnil; - XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); - return vector; -} - - 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. @@ -3188,6 +3127,7 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT args[index] = Fpurecopy (args[index]); p->contents[index] = args[index]; } + XSETPVECTYPE (p, PVEC_COMPILED); XSETCOMPILED (val, p); return val; } @@ -3252,9 +3192,7 @@ Its value and function definition are void, and its property list is nil. */) /* eassert (!handling_signal); */ -#ifndef SYNC_INPUT - BLOCK_INPUT; -#endif + MALLOC_BLOCK_INPUT; if (symbol_free_list) { @@ -3277,9 +3215,7 @@ Its value and function definition are void, and its property list is nil. */) symbol_block_index++; } -#ifndef SYNC_INPUT - UNBLOCK_INPUT; -#endif + MALLOC_UNBLOCK_INPUT; p = XSYMBOL (val); p->xname = name; @@ -3342,9 +3278,7 @@ allocate_misc () /* eassert (!handling_signal); */ -#ifndef SYNC_INPUT - BLOCK_INPUT; -#endif + MALLOC_BLOCK_INPUT; if (marker_free_list) { @@ -3368,9 +3302,7 @@ allocate_misc () marker_block_index++; } -#ifndef SYNC_INPUT - UNBLOCK_INPUT; -#endif + MALLOC_UNBLOCK_INPUT; --total_free_markers; consing_since_gc += sizeof (union Lisp_Misc); @@ -4116,9 +4048,7 @@ live_vector_p (m, p) struct mem_node *m; void *p; { - return (p == m->start - && m->type >= MEM_TYPE_VECTOR - && m->type <= MEM_TYPE_WINDOW); + return (p == m->start && m->type == MEM_TYPE_VECTORLIKE); } @@ -4204,7 +4134,7 @@ mark_maybe_object (obj) { int mark_p = 0; - switch (XGCTYPE (obj)) + switch (XTYPE (obj)) { case Lisp_String: mark_p = (live_string_p (m, po) @@ -4224,13 +4154,13 @@ mark_maybe_object (obj) break; case Lisp_Vectorlike: - /* Note: can't check GC_BUFFERP before we know it's a + /* Note: can't check BUFFERP before we know it's a buffer because checking that dereferences the pointer PO which might point anywhere. */ if (live_vector_p (m, po)) - mark_p = !GC_SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj)); + mark_p = !SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj)); else if (live_buffer_p (m, po)) - mark_p = GC_BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj)); + mark_p = BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj)); break; case Lisp_Misc: @@ -4316,16 +4246,12 @@ mark_maybe_pointer (p) XSETFLOAT (obj, p); break; - case MEM_TYPE_VECTOR: - case MEM_TYPE_PROCESS: - case MEM_TYPE_HASH_TABLE: - case MEM_TYPE_FRAME: - case MEM_TYPE_WINDOW: + case MEM_TYPE_VECTORLIKE: if (live_vector_p (m, p)) { Lisp_Object tem; XSETVECTOR (tem, p); - if (!GC_SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem))) + if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem))) obj = tem; } break; @@ -4334,7 +4260,7 @@ mark_maybe_pointer (p) abort (); } - if (!GC_NILP (obj)) + if (!NILP (obj)) mark_object (obj); } } @@ -4720,11 +4646,7 @@ valid_lisp_object_p (obj) case MEM_TYPE_FLOAT: return live_float_p (m, p); - case MEM_TYPE_VECTOR: - case MEM_TYPE_PROCESS: - case MEM_TYPE_HASH_TABLE: - case MEM_TYPE_FRAME: - case MEM_TYPE_WINDOW: + case MEM_TYPE_VECTORLIKE: return live_vector_p (m, p); default: @@ -4997,7 +4919,10 @@ Does not copy symbols. Copies strings without text properties. */) for (i = 0; i < size; i++) vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]); if (COMPILEDP (obj)) - XSETCOMPILED (obj, vec); + { + XSETPVECTYPE (vec, PVEC_COMPILED); + XSETCOMPILED (obj, vec); + } else XSETVECTOR (obj, vec); return obj; @@ -5099,7 +5024,8 @@ returns nil, because real GC can't be done. */) 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->name) + && ! nextb->text->inhibit_shrinking) { /* If a buffer's gap size is more than 10% of the buffer size, or larger than 2000 bytes, then shrink it @@ -5238,8 +5164,8 @@ returns nil, because real GC can't be done. */) prev = Qnil; while (CONSP (tail)) { - if (GC_CONSP (XCAR (tail)) - && GC_MARKERP (XCAR (XCAR (tail))) + if (CONSP (XCAR (tail)) + && MARKERP (XCAR (XCAR (tail))) && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) { if (NILP (prev)) @@ -5388,7 +5314,7 @@ mark_glyph_matrix (matrix) struct glyph *end_glyph = glyph + row->used[area]; for (; glyph < end_glyph; ++glyph) - if (GC_STRINGP (glyph->object) + if (STRINGP (glyph->object) && !STRING_MARKED_P (XSTRING (glyph->object))) mark_object (glyph->object); } @@ -5462,6 +5388,29 @@ int last_marked_index; Normally this is zero and the check never goes off. */ int mark_object_loop_halt; +/* Return non-zero if the object was not yet marked. */ +static int +mark_vectorlike (ptr) + struct Lisp_Vector *ptr; +{ + register EMACS_INT size = ptr->size; + register int i; + + if (VECTOR_MARKED_P (ptr)) + return 0; /* Already marked */ + VECTOR_MARK (ptr); /* Else mark it */ + if (size & PSEUDOVECTOR_FLAG) + size &= PSEUDOVECTOR_SIZE_MASK; + + /* Note that this size is not the memory-footprint size, but only + the number of Lisp_Object fields that we should trace. + The distinction is used e.g. by Lisp_Process which places extra + non-Lisp_Object fields at the end of the structure. */ + for (i = 0; i < size; i++) /* and then mark its elements */ + mark_object (ptr->contents[i]); + return 1; +} + void mark_object (arg) Lisp_Object arg; @@ -5521,7 +5470,7 @@ mark_object (arg) #endif /* not GC_CHECK_MARKED_OBJECTS */ - switch (SWITCH_ENUM_CAST (XGCTYPE (obj))) + switch (SWITCH_ENUM_CAST (XTYPE (obj))) { case Lisp_String: { @@ -5540,13 +5489,13 @@ mark_object (arg) case Lisp_Vectorlike: #ifdef GC_CHECK_MARKED_OBJECTS m = mem_find (po); - if (m == MEM_NIL && !GC_SUBRP (obj) + if (m == MEM_NIL && !SUBRP (obj) && po != &buffer_defaults && po != &buffer_local_symbols) abort (); #endif /* GC_CHECK_MARKED_OBJECTS */ - if (GC_BUFFERP (obj)) + if (BUFFERP (obj)) { if (!VECTOR_MARKED_P (XBUFFER (obj))) { @@ -5563,9 +5512,9 @@ mark_object (arg) mark_buffer (obj); } } - else if (GC_SUBRP (obj)) + else if (SUBRP (obj)) break; - else if (GC_COMPILEDP (obj)) + else if (COMPILEDP (obj)) /* We could treat this just like a vector, but it is better to save the COMPILED_CONSTANTS element for last and avoid recursion there. */ @@ -5588,133 +5537,49 @@ mark_object (arg) obj = ptr->contents[COMPILED_CONSTANTS]; goto loop; } - else if (GC_FRAMEP (obj)) + else if (FRAMEP (obj)) { register struct frame *ptr = XFRAME (obj); - - if (VECTOR_MARKED_P (ptr)) break; /* Already marked */ - VECTOR_MARK (ptr); /* Else mark it */ - - CHECK_LIVE (live_vector_p); - mark_object (ptr->name); - mark_object (ptr->icon_name); - mark_object (ptr->title); - mark_object (ptr->focus_frame); - mark_object (ptr->selected_window); - mark_object (ptr->minibuffer_window); - mark_object (ptr->param_alist); - mark_object (ptr->scroll_bars); - mark_object (ptr->condemned_scroll_bars); - mark_object (ptr->menu_bar_items); - mark_object (ptr->face_alist); - mark_object (ptr->menu_bar_vector); - mark_object (ptr->buffer_predicate); - mark_object (ptr->buffer_list); - mark_object (ptr->buried_buffer_list); - mark_object (ptr->menu_bar_window); - mark_object (ptr->tool_bar_window); - mark_face_cache (ptr->face_cache); + if (mark_vectorlike (XVECTOR (obj))) + { + mark_face_cache (ptr->face_cache); #ifdef HAVE_WINDOW_SYSTEM - mark_image_cache (ptr); - mark_object (ptr->tool_bar_items); - mark_object (ptr->desired_tool_bar_string); - mark_object (ptr->current_tool_bar_string); + mark_image_cache (ptr); #endif /* HAVE_WINDOW_SYSTEM */ + } } - else if (GC_BOOL_VECTOR_P (obj)) - { - register struct Lisp_Vector *ptr = XVECTOR (obj); - - if (VECTOR_MARKED_P (ptr)) - break; /* Already marked */ - CHECK_LIVE (live_vector_p); - VECTOR_MARK (ptr); /* Else mark it */ - } - else if (GC_WINDOWP (obj)) + else if (WINDOWP (obj)) { register struct Lisp_Vector *ptr = XVECTOR (obj); struct window *w = XWINDOW (obj); - register int i; - - /* Stop if already marked. */ - if (VECTOR_MARKED_P (ptr)) - break; - - /* Mark it. */ - CHECK_LIVE (live_vector_p); - VECTOR_MARK (ptr); - - /* There is no Lisp data above The member CURRENT_MATRIX in - struct WINDOW. Stop marking when that slot is reached. */ - for (i = 0; - (char *) &ptr->contents[i] < (char *) &w->current_matrix; - i++) - mark_object (ptr->contents[i]); - - /* Mark glyphs for leaf windows. Marking window matrices is - sufficient because frame matrices use the same glyph - memory. */ - if (NILP (w->hchild) - && NILP (w->vchild) - && w->current_matrix) + if (mark_vectorlike (ptr)) { - mark_glyph_matrix (w->current_matrix); - mark_glyph_matrix (w->desired_matrix); + /* Mark glyphs for leaf windows. Marking window matrices is + sufficient because frame matrices use the same glyph + memory. */ + if (NILP (w->hchild) + && NILP (w->vchild) + && w->current_matrix) + { + mark_glyph_matrix (w->current_matrix); + mark_glyph_matrix (w->desired_matrix); + } } } - else if (GC_HASH_TABLE_P (obj)) + else if (HASH_TABLE_P (obj)) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); - - /* Stop if already marked. */ - if (VECTOR_MARKED_P (h)) - break; - - /* Mark it. */ - CHECK_LIVE (live_vector_p); - VECTOR_MARK (h); - - /* 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); - mark_object (h->rehash_threshold); - mark_object (h->hash); - mark_object (h->next); - mark_object (h->index); - mark_object (h->user_hash_function); - mark_object (h->user_cmp_function); - - /* If hash table is not weak, mark all keys and values. - For weak tables, mark only the vector. */ - if (GC_NILP (h->weak)) - mark_object (h->key_and_value); - else - VECTOR_MARK (XVECTOR (h->key_and_value)); + if (mark_vectorlike ((struct Lisp_Vector *)h)) + { /* If hash table is not weak, mark all keys and values. + For weak tables, mark only the vector. */ + if (NILP (h->weak)) + mark_object (h->key_and_value); + else + VECTOR_MARK (XVECTOR (h->key_and_value)); + } } else - { - register struct Lisp_Vector *ptr = XVECTOR (obj); - register EMACS_INT size = ptr->size; - register int i; - - if (VECTOR_MARKED_P (ptr)) break; /* Already marked */ - CHECK_LIVE (live_vector_p); - VECTOR_MARK (ptr); /* Else mark it */ - if (size & PSEUDOVECTOR_FLAG) - size &= PSEUDOVECTOR_SIZE_MASK; - - /* Note that this size is not the memory-footprint size, but only - the number of Lisp_Object fields that we should trace. - The distinction is used e.g. by Lisp_Process which places extra - non-Lisp_Object fields at the end of the structure. */ - for (i = 0; i < size; i++) /* and then mark its elements */ - mark_object (ptr->contents[i]); - } + mark_vectorlike (XVECTOR (obj)); break; case Lisp_Symbol: @@ -5905,6 +5770,21 @@ mark_buffer (buf) } } +/* Mark the Lisp pointers in the terminal objects. + Called by the Fgarbage_collector. */ + +static void +mark_terminals (void) +{ + struct terminal *t; + for (t = terminal_list; t; t = t->next_terminal) + { + eassert (t->name != NULL); + mark_vectorlike ((struct Lisp_Vector *)t); + } +} + + /* Value is non-zero if OBJ will survive the current GC because it's either marked or does not need to be marked to survive. */ @@ -5915,7 +5795,7 @@ survives_gc_p (obj) { int survives_p; - switch (XGCTYPE (obj)) + switch (XTYPE (obj)) { case Lisp_Int: survives_p = 1; @@ -5934,7 +5814,7 @@ survives_gc_p (obj) break; case Lisp_Vectorlike: - survives_p = GC_SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj)); + survives_p = SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj)); break; case Lisp_Cons: @@ -5980,23 +5860,51 @@ gc_sweep () for (cblk = cons_block; cblk; cblk = *cprev) { - register int i; + register int i = 0; int this_free = 0; - for (i = 0; i < lim; i++) - if (!CONS_MARKED_P (&cblk->conses[i])) - { - this_free++; - cblk->conses[i].u.chain = cons_free_list; - cons_free_list = &cblk->conses[i]; + int ilim = (lim + BITS_PER_INT - 1) / BITS_PER_INT; + + /* Scan the mark bits an int at a time. */ + for (i = 0; i <= ilim; i++) + { + if (cblk->gcmarkbits[i] == -1) + { + /* Fast path - all cons cells for this int are marked. */ + cblk->gcmarkbits[i] = 0; + num_used += BITS_PER_INT; + } + else + { + /* Some cons cells for this int are not marked. + Find which ones, and free them. */ + int start, pos, stop; + + start = i * BITS_PER_INT; + stop = lim - start; + if (stop > BITS_PER_INT) + stop = BITS_PER_INT; + stop += start; + + for (pos = start; pos < stop; pos++) + { + if (!CONS_MARKED_P (&cblk->conses[pos])) + { + this_free++; + cblk->conses[pos].u.chain = cons_free_list; + cons_free_list = &cblk->conses[pos]; #if GC_MARK_STACK - cons_free_list->car = Vdead; + cons_free_list->car = Vdead; #endif - } - else - { - num_used++; - CONS_UNMARK (&cblk->conses[i]); - } + } + else + { + num_used++; + CONS_UNMARK (&cblk->conses[pos]); + } + } + } + } + lim = CONS_BLOCK_SIZE; /* If this block contains only free conses and we have already seen more than two blocks worth of free conses then deallocate @@ -6515,7 +6423,6 @@ The time is in seconds as a floating point value. */); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); - defsubr (&Smake_char_table); defsubr (&Smake_string); defsubr (&Smake_bool_vector); defsubr (&Smake_symbol);