X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/cf5c017598d130e76e96c47045372ba4a9ad6404..2a0213a6d0a9e36a388994445837e051d0bbe5f9:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index b059d6c04a..52d683a1b6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -615,7 +615,7 @@ overrun_check_malloc (size_t size) if (SIZE_MAX - overhead < size) abort (); - val = (unsigned char *) malloc (size + overhead); + val = malloc (size + overhead); if (val && check_depth == 1) { memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE); @@ -735,6 +735,22 @@ xmalloc (size_t size) return val; } +/* Like the above, but zeroes out the memory just allocated. */ + +void * +xzalloc (size_t size) +{ + void *val; + + MALLOC_BLOCK_INPUT; + val = malloc (size); + MALLOC_UNBLOCK_INPUT; + + if (!val && size) + memory_full (size); + memset (val, 0, size); + return val; +} /* Like realloc but check for no memory and block interrupt input.. */ @@ -867,7 +883,7 @@ char * xstrdup (const char *s) { size_t len = strlen (s) + 1; - char *p = (char *) xmalloc (len); + char *p = xmalloc (len); memcpy (p, s, len); return p; } @@ -907,7 +923,7 @@ lisp_malloc (size_t nbytes, enum mem_type type) allocated_mem_type = type; #endif - val = (void *) malloc (nbytes); + val = malloc (nbytes); #if ! USE_LSB_TAG /* If the memory just allocated cannot be addressed thru a Lisp @@ -1186,21 +1202,6 @@ lisp_align_free (void *block) MALLOC_UNBLOCK_INPUT; } -/* Return a new buffer structure allocated from the heap with - a call to lisp_malloc. */ - -struct buffer * -allocate_buffer (void) -{ - struct buffer *b - = (struct buffer *) lisp_malloc (sizeof (struct buffer), - MEM_TYPE_BUFFER); - XSETPVECTYPESIZE (b, PVEC_BUFFER, - ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1) - / sizeof (EMACS_INT))); - return b; -} - #ifndef SYSTEM_MALLOC @@ -1308,7 +1309,7 @@ emacs_blocked_malloc (size_t size, const void *ptr) __malloc_extra_blocks = malloc_hysteresis; #endif - value = (void *) malloc (size); + value = malloc (size); #ifdef GC_MALLOC_CHECK { @@ -1370,7 +1371,7 @@ emacs_blocked_realloc (void *ptr, size_t size, const void *ptr2) dont_register_blocks = 1; #endif /* GC_MALLOC_CHECK */ - value = (void *) realloc (ptr, size); + value = realloc (ptr, size); #ifdef GC_MALLOC_CHECK dont_register_blocks = 0; @@ -1522,10 +1523,8 @@ make_interval (void) { if (interval_block_index == INTERVAL_BLOCK_SIZE) { - register struct interval_block *newi; - - newi = (struct interval_block *) lisp_malloc (sizeof *newi, - MEM_TYPE_NON_LISP); + struct interval_block *newi + = lisp_malloc (sizeof *newi, MEM_TYPE_NON_LISP); newi->next = interval_block; interval_block = newi; @@ -1544,7 +1543,7 @@ make_interval (void) } -/* Mark Lisp objects in interval I. */ +/* Mark Lisp objects in interval I. */ static void mark_interval (register INTERVAL i, Lisp_Object dummy) @@ -1851,7 +1850,7 @@ check_sblock (struct sblock *b) ptrdiff_t nbytes; /* Check that the string size recorded in the string is the - same as the one recorded in the sdata structure. */ + same as the one recorded in the sdata structure. */ if (from->string) CHECK_STRING_BYTES (from->string); @@ -1887,7 +1886,7 @@ check_string_bytes (int all_p) for (b = oldest_sblock; b; b = b->next) check_sblock (b); } - else + else if (current_sblock) check_sblock (current_sblock); } @@ -1931,10 +1930,9 @@ allocate_string (void) add all the Lisp_Strings in it to the free-list. */ if (string_free_list == NULL) { - struct string_block *b; + struct string_block *b = lisp_malloc (sizeof *b, MEM_TYPE_STRING); int i; - b = (struct string_block *) lisp_malloc (sizeof *b, MEM_TYPE_STRING); b->next = string_blocks; string_blocks = b; @@ -2020,7 +2018,7 @@ allocate_string_data (struct Lisp_String *s, mallopt (M_MMAP_MAX, 0); #endif - b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP); + b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP); #ifdef DOUG_LEA_MALLOC /* Back to a reasonable maximum of mmap'ed areas. */ @@ -2038,7 +2036,7 @@ allocate_string_data (struct Lisp_String *s, < (needed + GC_STRING_EXTRA))) { /* Not enough room in the current sblock. */ - b = (struct sblock *) lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP); + b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP); b->next_free = &b->first_data; b->first_data.string = NULL; b->next = NULL; @@ -2519,6 +2517,20 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) return string; } +/* Print arguments to BUF according to a FORMAT, then return + a Lisp_String initialized with the data from BUF. */ + +Lisp_Object +make_formatted_string (char *buf, const char *format, ...) +{ + va_list ap; + int length; + + va_start (ap, format); + length = vsprintf (buf, format, ap); + va_end (ap); + return make_string (buf, length); +} /*********************************************************************** @@ -2618,10 +2630,8 @@ make_float (double float_value) { if (float_block_index == FLOAT_BLOCK_SIZE) { - register struct float_block *new; - - new = (struct float_block *) lisp_align_malloc (sizeof *new, - MEM_TYPE_FLOAT); + struct float_block *new + = lisp_align_malloc (sizeof *new, MEM_TYPE_FLOAT); new->next = float_block; memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); float_block = new; @@ -2737,9 +2747,8 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, { if (cons_block_index == CONS_BLOCK_SIZE) { - register struct cons_block *new; - new = (struct cons_block *) lisp_align_malloc (sizeof *new, - MEM_TYPE_CONS); + struct cons_block *new + = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS); memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); new->next = cons_block; cons_block = new; @@ -2896,6 +2905,10 @@ enum /* ROUNDUP_SIZE must be a power of 2. */ verify ((roundup_size & (roundup_size - 1)) == 0); +/* Verify assumptions described above. */ +verify ((VECTOR_BLOCK_SIZE % roundup_size) == 0); +verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS)); + /* Round up X to nearest mult-of-ROUNDUP_SIZE. */ #define vroundup(x) (((x) + (roundup_size - 1)) & ~(roundup_size - 1)) @@ -2919,12 +2932,6 @@ verify ((roundup_size & (roundup_size - 1)) == 0); #define VECTOR_MAX_FREE_LIST_INDEX \ ((VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1) -/* When the vector is on a free list, vectorlike_header.SIZE is set to - this special value ORed with vector's memory footprint size. */ - -#define VECTOR_FREE_LIST_FLAG (~(ARRAY_MARK_FLAG | PSEUDOVECTOR_FLAG \ - | (VECTOR_BLOCK_SIZE - 1))) - /* Common shortcut to advance vector pointer over a block data. */ #define ADVANCE(v, nbytes) ((struct Lisp_Vector *) ((char *) (v) + (nbytes))) @@ -2937,7 +2944,7 @@ verify ((roundup_size & (roundup_size - 1)) == 0); #define SETUP_ON_FREE_LIST(v, nbytes, index) \ do { \ - (v)->header.size = VECTOR_FREE_LIST_FLAG | (nbytes); \ + XSETPVECTYPESIZE (v, PVEC_FREE, nbytes); \ eassert ((nbytes) % roundup_size == 0); \ (index) = VINDEX (nbytes); \ eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \ @@ -2973,17 +2980,7 @@ static struct Lisp_Vector *zero_vector; static struct vector_block * allocate_vector_block (void) { - struct vector_block *block; - -#ifdef DOUG_LEA_MALLOC - mallopt (M_MMAP_MAX, 0); -#endif - - block = xmalloc (sizeof (struct vector_block)); - -#ifdef DOUG_LEA_MALLOC - mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); -#endif + struct vector_block *block = xmalloc (sizeof *block); #if GC_MARK_STACK && !defined GC_MALLOC_CHECK mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES, @@ -3079,6 +3076,16 @@ allocate_vector_from_block (size_t nbytes) ((char *) (vector) <= (block)->data \ + VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) +/* Number of bytes used by vector-block-allocated object. This is the only + place where we actually use the `nbytes' field of the vector-header. + I.e. we could get rid of the `nbytes' field by computing it based on the + vector-type. */ + +#define PSEUDOVECTOR_NBYTES(vector) \ + (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \ + ? vector->header.size & PSEUDOVECTOR_SIZE_MASK \ + : vector->header.next.nbytes) + /* Reclaim space used by unmarked vectors. */ static void @@ -3107,14 +3114,10 @@ sweep_vectors (void) } else { - ptrdiff_t nbytes; + ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector); + ptrdiff_t total_bytes = nbytes; - if ((vector->header.size & VECTOR_FREE_LIST_FLAG) - == VECTOR_FREE_LIST_FLAG) - vector->header.next.nbytes = - vector->header.size & (VECTOR_BLOCK_SIZE - 1); - - next = ADVANCE (vector, vector->header.next.nbytes); + next = ADVANCE (vector, nbytes); /* While NEXT is not marked, try to coalesce with VECTOR, thus making VECTOR of the largest possible size. */ @@ -3123,16 +3126,12 @@ sweep_vectors (void) { if (VECTOR_MARKED_P (next)) break; - if ((next->header.size & VECTOR_FREE_LIST_FLAG) - == VECTOR_FREE_LIST_FLAG) - nbytes = next->header.size & (VECTOR_BLOCK_SIZE - 1); - else - nbytes = next->header.next.nbytes; - vector->header.next.nbytes += nbytes; + nbytes = PSEUDOVECTOR_NBYTES (next); + total_bytes += nbytes; next = ADVANCE (next, nbytes); } - eassert (vector->header.next.nbytes % roundup_size == 0); + eassert (total_bytes % roundup_size == 0); if (vector == (struct Lisp_Vector *) block->data && !VECTOR_IN_BLOCK (next, block)) @@ -3140,7 +3139,10 @@ sweep_vectors (void) space was coalesced into the only free vector. */ free_this_block = 1; else - SETUP_ON_FREE_LIST (vector, vector->header.next.nbytes, nbytes); + { + int tmp; + SETUP_ON_FREE_LIST (vector, total_bytes, tmp); + } } } @@ -3181,44 +3183,42 @@ static struct Lisp_Vector * allocate_vectorlike (ptrdiff_t len) { 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. */ - mallopt (M_MMAP_MAX, 0); -#endif - /* This gets triggered by code which I haven't bothered to fix. --Stef */ /* eassert (!handling_signal); */ if (len == 0) + p = zero_vector; + else { - MALLOC_UNBLOCK_INPUT; - return zero_vector; - } + size_t nbytes = header_size + len * word_size; - nbytes = header_size + len * word_size; +#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. */ + mallopt (M_MMAP_MAX, 0); +#endif - if (nbytes <= VBLOCK_BYTES_MAX) - p = allocate_vector_from_block (vroundup (nbytes)); - else - { - p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); - p->header.next.vector = large_vectors; - large_vectors = p; - } + if (nbytes <= VBLOCK_BYTES_MAX) + p = allocate_vector_from_block (vroundup (nbytes)); + else + { + p = lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); + p->header.next.vector = large_vectors; + large_vectors = p; + } #ifdef DOUG_LEA_MALLOC - /* Back to a reasonable maximum of mmap'ed areas. */ - mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); + /* Back to a reasonable maximum of mmap'ed areas. */ + mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); #endif - consing_since_gc += nbytes; - vector_cells_consed += len; + consing_since_gc += nbytes; + vector_cells_consed += len; + } MALLOC_UNBLOCK_INPUT; @@ -3258,6 +3258,17 @@ allocate_pseudovector (int memlen, int lisplen, int tag) return v; } +struct buffer * +allocate_buffer (void) +{ + struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER); + + XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text) + - header_size) / word_size); + /* Note that the fields of B are not initialized. */ + return b; +} + struct Lisp_Hash_Table * allocate_hash_table (void) { @@ -3484,9 +3495,8 @@ Its value and function definition are void, and its property list is nil. */) { if (symbol_block_index == SYMBOL_BLOCK_SIZE) { - struct symbol_block *new; - new = (struct symbol_block *) lisp_malloc (sizeof *new, - MEM_TYPE_SYMBOL); + struct symbol_block *new + = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL); new->next = symbol_block; symbol_block = new; symbol_block_index = 0; @@ -3577,9 +3587,7 @@ allocate_misc (void) { if (marker_block_index == MARKER_BLOCK_SIZE) { - struct marker_block *new; - new = (struct marker_block *) lisp_malloc (sizeof *new, - MEM_TYPE_MISC); + struct marker_block *new = lisp_malloc (sizeof *new, MEM_TYPE_MISC); new->next = marker_block; marker_block = new; marker_block_index = 0; @@ -3647,6 +3655,33 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, return val; } +/* Return a newly allocated marker which points into BUF + at character position CHARPOS and byte position BYTEPOS. */ + +Lisp_Object +build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) +{ + Lisp_Object obj; + struct Lisp_Marker *m; + + /* No dead buffers here. */ + eassert (!NILP (BVAR (buf, name))); + + /* Every character is at least one byte. */ + eassert (charpos <= bytepos); + + obj = allocate_misc (); + XMISCTYPE (obj) = Lisp_Misc_Marker; + m = XMARKER (obj); + m->buffer = buf; + m->charpos = charpos; + m->bytepos = bytepos; + m->insertion_type = 0; + m->next = BUF_MARKERS (buf); + BUF_MARKERS (buf) = m; + return obj; +} + /* Put MARKER back on the free list after using it temporarily. */ void @@ -3772,25 +3807,25 @@ refill_memory_reserve (void) { #ifndef SYSTEM_MALLOC if (spare_memory[0] == 0) - spare_memory[0] = (char *) malloc (SPARE_MEMORY); + spare_memory[0] = malloc (SPARE_MEMORY); if (spare_memory[1] == 0) - spare_memory[1] = (char *) lisp_align_malloc (sizeof (struct cons_block), + spare_memory[1] = lisp_align_malloc (sizeof (struct cons_block), MEM_TYPE_CONS); if (spare_memory[2] == 0) - spare_memory[2] = (char *) lisp_align_malloc (sizeof (struct cons_block), - MEM_TYPE_CONS); + spare_memory[2] = lisp_align_malloc (sizeof (struct cons_block), + MEM_TYPE_CONS); if (spare_memory[3] == 0) - spare_memory[3] = (char *) lisp_align_malloc (sizeof (struct cons_block), - MEM_TYPE_CONS); + spare_memory[3] = lisp_align_malloc (sizeof (struct cons_block), + MEM_TYPE_CONS); if (spare_memory[4] == 0) - spare_memory[4] = (char *) lisp_align_malloc (sizeof (struct cons_block), - MEM_TYPE_CONS); + spare_memory[4] = lisp_align_malloc (sizeof (struct cons_block), + MEM_TYPE_CONS); if (spare_memory[5] == 0) - spare_memory[5] = (char *) lisp_malloc (sizeof (struct string_block), - MEM_TYPE_STRING); + spare_memory[5] = lisp_malloc (sizeof (struct string_block), + MEM_TYPE_STRING); if (spare_memory[6] == 0) - spare_memory[6] = (char *) lisp_malloc (sizeof (struct string_block), - MEM_TYPE_STRING); + spare_memory[6] = lisp_malloc (sizeof (struct string_block), + MEM_TYPE_STRING); if (spare_memory[0] && spare_memory[1] && spare_memory[5]) Vmemory_full = Qnil; #endif @@ -3890,11 +3925,11 @@ mem_insert (void *start, void *end, enum mem_type type) /* Create a new node. */ #ifdef GC_MALLOC_CHECK - x = (struct mem_node *) _malloc_internal (sizeof *x); + x = _malloc_internal (sizeof *x); if (x == NULL) abort (); #else - x = (struct mem_node *) xmalloc (sizeof *x); + x = xmalloc (sizeof *x); #endif x->start = start; x->end = end; @@ -4347,10 +4382,9 @@ live_vector_p (struct mem_node *m, void *p) while (VECTOR_IN_BLOCK (vector, block) && vector <= (struct Lisp_Vector *) p) { - if ((vector->header.size & VECTOR_FREE_LIST_FLAG) - == VECTOR_FREE_LIST_FLAG) + if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE)) vector = ADVANCE (vector, (vector->header.size - & (VECTOR_BLOCK_SIZE - 1))); + & PSEUDOVECTOR_SIZE_MASK)); else if (vector == p) return 1; else @@ -5061,7 +5095,7 @@ pure_alloc (size_t size, int type) /* Don't allocate a large amount here, because it might get mmap'd and then its address might not be usable. */ - purebeg = (char *) xmalloc (10000); + purebeg = xmalloc (10000); pure_size = 10000; pure_bytes_used_before_overflow += pure_bytes_used - size; pure_bytes_used = 0; @@ -5178,15 +5212,14 @@ make_pure_string (const char *data, return string; } -/* Return a string a string allocated in pure space. Do not allocate - the string data, just point to DATA. */ +/* Return a string allocated in pure space. Do not + allocate the string data, just point to DATA. */ Lisp_Object -make_pure_c_string (const char *data) +make_pure_c_string (const char *data, ptrdiff_t nchars) { Lisp_Object string; struct Lisp_String *s; - ptrdiff_t nchars = strlen (data); s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); s->size = nchars; @@ -5439,7 +5472,7 @@ See Info node `(elisp)Garbage Collection'. */) { if (stack_copy_size < stack_size) { - stack_copy = (char *) xrealloc (stack_copy, stack_size); + stack_copy = xrealloc (stack_copy, stack_size); stack_copy_size = stack_size; } memcpy (stack_copy, stack, stack_size); @@ -5746,15 +5779,15 @@ mark_vectorlike (struct Lisp_Vector *ptr) ptrdiff_t i; eassert (!VECTOR_MARKED_P (ptr)); - VECTOR_MARK (ptr); /* Else mark it */ + 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 */ + 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]); } @@ -5786,15 +5819,29 @@ mark_char_table (struct Lisp_Vector *ptr) } } -/* Mark the pointers in a buffer structure. */ +/* Mark the chain of overlays starting at PTR. */ + +static void +mark_overlay (struct Lisp_Overlay *ptr) +{ + for (; ptr && !ptr->gcmarkbit; ptr = ptr->next) + { + ptr->gcmarkbit = 1; + mark_object (ptr->start); + mark_object (ptr->end); + mark_object (ptr->plist); + } +} + +/* Mark Lisp_Objects and special pointers in BUFFER. */ static void mark_buffer (struct buffer *buffer) { - register Lisp_Object *ptr, tmp; + /* This is handled much like other pseudovectors... */ + mark_vectorlike ((struct Lisp_Vector *) buffer); - eassert (!VECTOR_MARKED_P (buffer)); - VECTOR_MARK (buffer); + /* ...but there are some buffer-specific things. */ MARK_INTERVAL_TREE (BUF_INTERVALS (buffer)); @@ -5802,24 +5849,8 @@ mark_buffer (struct buffer *buffer) a special way just before the sweep phase, and after stripping some of its elements that are not needed any more. */ - if (buffer->overlays_before) - { - XSETMISC (tmp, buffer->overlays_before); - mark_object (tmp); - } - if (buffer->overlays_after) - { - XSETMISC (tmp, buffer->overlays_after); - mark_object (tmp); - } - - /* buffer-local Lisp variables start at `undo_list', - tho only the ones from `name' on are GC'd normally. */ - for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name); - ptr <= &PER_BUFFER_VALUE (buffer, - PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER)); - ptr++) - mark_object (*ptr); + mark_overlay (buffer->overlays_before); + mark_overlay (buffer->overlays_after); /* If this is an indirect buffer, mark its base buffer. */ if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer)) @@ -5893,11 +5924,11 @@ mark_object (Lisp_Object arg) if (STRING_MARKED_P (ptr)) break; CHECK_ALLOCATED_AND_LIVE (live_string_p); - MARK_INTERVAL_TREE (ptr->intervals); MARK_STRING (ptr); + MARK_INTERVAL_TREE (ptr->intervals); #ifdef GC_CHECK_STRING_BYTES /* Check that the string size recorded in the string is the - same as the one recorded in the sdata structure. */ + same as the one recorded in the sdata structure. */ CHECK_STRING_BYTES (ptr); #endif /* GC_CHECK_STRING_BYTES */ } @@ -5920,17 +5951,17 @@ mark_object (Lisp_Object arg) #endif /* GC_CHECK_MARKED_OBJECTS */ if (ptr->header.size & PSEUDOVECTOR_FLAG) - pvectype = ptr->header.size & PVEC_TYPE_MASK; + pvectype = ((ptr->header.size & PVEC_TYPE_MASK) + >> PSEUDOVECTOR_SIZE_BITS); else pvectype = 0; -#ifdef GC_CHECK_MARKED_OBJECTS if (pvectype != PVEC_SUBR && pvectype != PVEC_BUFFER) CHECK_LIVE (live_vector_p); -#endif /* GC_CHECK_MARKED_OBJECTS */ - if (pvectype == PVEC_BUFFER) + switch (pvectype) { + case PVEC_BUFFER: #ifdef GC_CHECK_MARKED_OBJECTS if (po != &buffer_defaults && po != &buffer_local_symbols) { @@ -5942,67 +5973,82 @@ mark_object (Lisp_Object arg) } #endif /* GC_CHECK_MARKED_OBJECTS */ mark_buffer ((struct buffer *) ptr); - } + break; - else if (pvectype == PVEC_COMPILED) - /* We could treat this just like a vector, but it is better - to save the COMPILED_CONSTANTS element for last and avoid - recursion there. */ - { - int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; - int i; + case PVEC_COMPILED: + { /* We could treat this just like a vector, but it is better + to save the COMPILED_CONSTANTS element for last and avoid + recursion there. */ + int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; + int i; + + VECTOR_MARK (ptr); + for (i = 0; i < size; i++) + if (i != COMPILED_CONSTANTS) + mark_object (ptr->contents[i]); + if (size > COMPILED_CONSTANTS) + { + obj = ptr->contents[COMPILED_CONSTANTS]; + goto loop; + } + } + break; - VECTOR_MARK (ptr); - for (i = 0; i < size; i++) - if (i != COMPILED_CONSTANTS) - mark_object (ptr->contents[i]); - obj = ptr->contents[COMPILED_CONSTANTS]; - goto loop; - } + case PVEC_FRAME: + { + mark_vectorlike (ptr); + mark_face_cache (((struct frame *) ptr)->face_cache); + } + break; - else if (pvectype == PVEC_FRAME) - { - mark_vectorlike (ptr); - mark_face_cache (((struct frame *) ptr)->face_cache); - } + case PVEC_WINDOW: + { + struct window *w = (struct window *) ptr; - else if (pvectype == PVEC_WINDOW) - { - struct window *w = (struct window *) ptr; + mark_vectorlike (ptr); + /* 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); + } + } + break; - mark_vectorlike (ptr); - /* 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); - } - } + case PVEC_HASH_TABLE: + { + struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr; - else if (pvectype == PVEC_HASH_TABLE) - { - struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr; + mark_vectorlike (ptr); + /* 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)); + } + break; - mark_vectorlike (ptr); - /* 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)); - } + case PVEC_CHAR_TABLE: + mark_char_table (ptr); + break; - else if (pvectype == PVEC_CHAR_TABLE) - mark_char_table (ptr); + case PVEC_BOOL_VECTOR: + /* No Lisp_Objects to mark in a bool vector. */ + VECTOR_MARK (ptr); + break; + + case PVEC_SUBR: + break; - else if (pvectype == PVEC_BOOL_VECTOR) - /* No Lisp_Objects to mark in a bool vector. */ - VECTOR_MARK (ptr); + case PVEC_FREE: + abort (); - else if (pvectype != PVEC_SUBR) - mark_vectorlike (ptr); + default: + mark_vectorlike (ptr); + } } break; @@ -6054,7 +6100,7 @@ mark_object (Lisp_Object arg) ptr = ptr->next; if (ptr) { - ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */ + ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun. */ XSETSYMBOL (obj, ptrx); goto loop; } @@ -6063,20 +6109,21 @@ mark_object (Lisp_Object arg) case Lisp_Misc: CHECK_ALLOCATED_AND_LIVE (live_misc_p); + if (XMISCANY (obj)->gcmarkbit) break; - XMISCANY (obj)->gcmarkbit = 1; switch (XMISCTYPE (obj)) { - case Lisp_Misc_Marker: /* DO NOT mark thru the marker's chain. The buffer's markers chain does not preserve markers from gc; instead, markers are removed from the chain when freed by gc. */ + XMISCANY (obj)->gcmarkbit = 1; break; case Lisp_Misc_Save_Value: + XMISCANY (obj)->gcmarkbit = 1; #if GC_MARK_STACK { register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj); @@ -6094,17 +6141,7 @@ mark_object (Lisp_Object arg) break; case Lisp_Misc_Overlay: - { - struct Lisp_Overlay *ptr = XOVERLAY (obj); - mark_object (ptr->start); - mark_object (ptr->end); - mark_object (ptr->plist); - if (ptr->next) - { - XSETMISC (obj, ptr->next); - goto loop; - } - } + mark_overlay (XOVERLAY (obj)); break; default: @@ -6804,7 +6841,7 @@ do hash-consing of the objects allocated to pure space. */); not be able to allocate the memory to hold it. */ Vmemory_signal_data = pure_cons (Qerror, - pure_cons (make_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil)); + pure_cons (build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil)); DEFVAR_LISP ("memory-full", Vmemory_full, doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);