Mercurial > emacs
diff src/alloc.c @ 89909:68c22ea6027c
Sync to HEAD
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Fri, 16 Apr 2004 12:51:06 +0000 |
| parents | c9f7a2f363ca |
| children | 4c90ffeb71c5 |
line wrap: on
line diff
--- a/src/alloc.c Thu Apr 15 01:08:34 2004 +0000 +++ b/src/alloc.c Fri Apr 16 12:51:06 2004 +0000 @@ -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, 2002, 2003 + Copyright (C) 1985,86,88,93,94,95,97,98,1999,2000,01,02,03,2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -31,13 +31,6 @@ #include <signal.h> -/* GC_MALLOC_CHECK defined means perform validity checks of malloc'd - memory. Can do this only if using gmalloc.c. */ - -#if defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC -#undef GC_MALLOC_CHECK -#endif - /* This file is part of the core Lisp implementation, and thus must deal with the real data structures. If the Lisp implementation is replaced, this file likely will not be used. */ @@ -56,6 +49,13 @@ #include "syssignal.h" #include <setjmp.h> +/* GC_MALLOC_CHECK defined means perform validity checks of malloc'd + memory. Can do this only if using gmalloc.c. */ + +#if defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC +#undef GC_MALLOC_CHECK +#endif + #ifdef HAVE_UNISTD_H #include <unistd.h> #else @@ -598,6 +598,7 @@ val = (void *) malloc (nbytes); +#ifndef USE_LSB_TAG /* If the memory just allocated cannot be addressed thru a Lisp object's pointer, and it needs to be, that's equivalent to running out of memory. */ @@ -612,6 +613,7 @@ val = 0; } } +#endif #if GC_MARK_STACK && !defined GC_MALLOC_CHECK if (val && type != MEM_TYPE_NON_LISP) @@ -756,6 +758,11 @@ #else base = malloc (ABLOCKS_BYTES); abase = ALIGN (base, BLOCK_ALIGN); + if (base == 0) + { + UNBLOCK_INPUT; + memory_full (); + } #endif aligned = (base == abase); @@ -767,6 +774,7 @@ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); #endif +#ifndef USE_LSB_TAG /* If the memory just allocated cannot be addressed thru a Lisp object's pointer, and it needs to be, that's equivalent to running out of memory. */ @@ -783,6 +791,7 @@ memory_full (); } } +#endif /* Initialize the blocks and put them on the free list. Is `base' was not properly aligned, we can't use the last block. */ @@ -1099,8 +1108,9 @@ struct interval_block { + /* Place `intervals' first, to preserve alignment. */ + struct interval intervals[INTERVAL_BLOCK_SIZE]; struct interval_block *next; - struct interval intervals[INTERVAL_BLOCK_SIZE]; }; /* Current interval block. Its `next' pointer points to older @@ -1338,8 +1348,9 @@ struct string_block { + /* Place `strings' first, to preserve alignment. */ + struct Lisp_String strings[STRING_BLOCK_SIZE]; struct string_block *next; - struct Lisp_String strings[STRING_BLOCK_SIZE]; }; /* Head and tail of the list of sblock structures holding Lisp string @@ -2120,8 +2131,10 @@ by GC are put on a free list to be reallocated before allocating any new float cells from the latest float_block. */ -#define FLOAT_BLOCK_SIZE \ - (((BLOCK_BYTES - sizeof (struct float_block *)) * CHAR_BIT) \ +#define FLOAT_BLOCK_SIZE \ + (((BLOCK_BYTES - sizeof (struct float_block *) \ + /* The compiler might add padding at the end. */ \ + - (sizeof (struct Lisp_Float) - sizeof (int))) * CHAR_BIT) \ / (sizeof (struct Lisp_Float) * CHAR_BIT + 1)) #define GETMARKBIT(block,n) \ @@ -2224,15 +2237,17 @@ new = (struct float_block *) lisp_align_malloc (sizeof *new, MEM_TYPE_FLOAT); new->next = float_block; + bzero ((char *) new->gcmarkbits, sizeof new->gcmarkbits); float_block = new; float_block_index = 0; n_float_blocks++; } - XSETFLOAT (val, &float_block->floats[float_block_index++]); + XSETFLOAT (val, &float_block->floats[float_block_index]); + float_block_index++; } XFLOAT_DATA (val) = float_value; - FLOAT_UNMARK (XFLOAT (val)); + eassert (!FLOAT_MARKED_P (XFLOAT (val))); consing_since_gc += sizeof (struct Lisp_Float); floats_consed++; return val; @@ -2340,17 +2355,19 @@ register struct cons_block *new; new = (struct cons_block *) lisp_align_malloc (sizeof *new, MEM_TYPE_CONS); + bzero ((char *) new->gcmarkbits, sizeof new->gcmarkbits); new->next = cons_block; cons_block = new; cons_block_index = 0; n_cons_blocks++; } - XSETCONS (val, &cons_block->conses[cons_block_index++]); + XSETCONS (val, &cons_block->conses[cons_block_index]); + cons_block_index++; } XSETCAR (val, car); XSETCDR (val, cdr); - CONS_UNMARK (XCONS (val)); + eassert (!CONS_MARKED_P (XCONS (val))); consing_since_gc += sizeof (struct Lisp_Cons); cons_cells_consed++; return val; @@ -2489,7 +2506,9 @@ /* 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 nbytes = sizeof *p + (len - 1) * sizeof p->contents[0]; @@ -2497,7 +2516,9 @@ #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; @@ -2697,8 +2718,9 @@ struct symbol_block { + /* Place `symbols' first, to preserve alignment. */ + struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE]; struct symbol_block *next; - struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE]; }; /* Current symbol block and index of first unused Lisp_Symbol @@ -2756,7 +2778,8 @@ symbol_block_index = 0; n_symbol_blocks++; } - XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]); + XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); + symbol_block_index++; } p = XSYMBOL (val); @@ -2788,8 +2811,9 @@ struct marker_block { + /* Place `markers' first, to preserve alignment. */ + union Lisp_Misc markers[MARKER_BLOCK_SIZE]; struct marker_block *next; - union Lisp_Misc markers[MARKER_BLOCK_SIZE]; }; struct marker_block *marker_block; @@ -2834,7 +2858,8 @@ marker_block_index = 0; n_marker_blocks++; } - XSETMISC (val, &marker_block->markers[marker_block_index++]); + XSETMISC (val, &marker_block->markers[marker_block_index]); + marker_block_index++; } consing_since_gc += sizeof (union Lisp_Misc); @@ -3369,6 +3394,7 @@ must not be on the free-list. */ return (offset >= 0 && offset % sizeof b->strings[0] == 0 + && offset < (STRING_BLOCK_SIZE * sizeof b->strings[0]) && ((struct Lisp_String *) p)->data != NULL); } else @@ -3393,8 +3419,8 @@ one of the unused cells in the current cons block, and not be on the free-list. */ return (offset >= 0 + && offset % sizeof b->conses[0] == 0 && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0]) - && offset % sizeof b->conses[0] == 0 && (b != cons_block || offset / sizeof b->conses[0] < cons_block_index) && !EQ (((struct Lisp_Cons *) p)->car, Vdead)); @@ -3422,6 +3448,7 @@ and not be on the free-list. */ return (offset >= 0 && offset % sizeof b->symbols[0] == 0 + && offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0]) && (b != symbol_block || offset / sizeof b->symbols[0] < symbol_block_index) && !EQ (((struct Lisp_Symbol *) p)->function, Vdead)); @@ -3447,8 +3474,8 @@ /* P must point to the start of a Lisp_Float and not be one of the unused cells in the current float block. */ return (offset >= 0 + && offset % sizeof b->floats[0] == 0 && offset < (FLOAT_BLOCK_SIZE * sizeof b->floats[0]) - && offset % sizeof b->floats[0] == 0 && (b != float_block || offset / sizeof b->floats[0] < float_block_index)); } @@ -3475,6 +3502,7 @@ and not be on the free-list. */ return (offset >= 0 && offset % sizeof b->markers[0] == 0 + && offset < (MARKER_BLOCK_SIZE * sizeof b->markers[0]) && (b != marker_block || offset / sizeof b->markers[0] < marker_block_index) && ((union Lisp_Misc *) p)->u_marker.type != Lisp_Misc_Free); @@ -4009,6 +4037,9 @@ int type; { POINTER_TYPE *result; +#ifdef USE_LSB_TAG + size_t alignment = (1 << GCTYPEBITS); +#else size_t alignment = sizeof (EMACS_INT); /* Give Lisp_Floats an extra alignment. */ @@ -4020,6 +4051,7 @@ alignment = sizeof (struct Lisp_Float); #endif } +#endif again: result = ALIGN (purebeg + pure_bytes_used, alignment); @@ -4155,12 +4187,13 @@ else if (COMPILEDP (obj) || VECTORP (obj)) { register struct Lisp_Vector *vec; - register int i, size; + register int i; + EMACS_INT size; size = XVECTOR (obj)->size; if (size & PSEUDOVECTOR_FLAG) size &= PSEUDOVECTOR_SIZE_MASK; - vec = XVECTOR (make_pure_vector ((EMACS_INT) size)); + vec = XVECTOR (make_pure_vector (size)); for (i = 0; i < size; i++) vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]); if (COMPILEDP (obj)) @@ -4446,13 +4479,6 @@ /* Clear the mark bits that we set in certain root slots. */ -#if (GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE \ - || GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES) - { - register struct gcpro *tail; - } -#endif - unmark_byte_stack (); VECTOR_UNMARK (&buffer_defaults); VECTOR_UNMARK (&buffer_local_symbols);