=== modified file 'src/alloc.c' --- src/alloc.c 2012-06-16 12:24:15 +0000 +++ src/alloc.c 2012-06-19 16:46:26 +0000 @@ -309,9 +309,6 @@ MEM_TYPE_VECTOR_BLOCK }; -static void *lisp_malloc (size_t, enum mem_type); - - #if GC_MARK_STACK || defined GC_MALLOC_CHECK #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES @@ -888,19 +885,37 @@ return Qnil; } +#if ! USE_LSB_TAG + +/* Used to catch invalid address when debugging. */ + +void *lisp_malloc_loser EXTERNALLY_VISIBLE; + +/* Nonzero if the memory at ADDR can be + addressed thru a Lisp object's pointer. */ + +static inline void +verify_address (char *addr) +{ + Lisp_Object obj; + + XSETCONS (obj, addr); + if ((char *) XCONS (obj) == addr) + return 1; + lisp_malloc_loser = addr; + return 0; +} + +#endif /* not USE_LSB_TAG */ /* Like malloc but used for allocating Lisp data. NBYTES is the number of bytes to allocate, TYPE describes the intended use of the allocated memory block (for strings, for conses, ...). */ -#if ! USE_LSB_TAG -void *lisp_malloc_loser EXTERNALLY_VISIBLE; -#endif - static void * lisp_malloc (size_t nbytes, enum mem_type type) { - register void *val; + void *val; MALLOC_BLOCK_INPUT; @@ -908,24 +923,33 @@ allocated_mem_type = type; #endif +#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 val = (void *) malloc (nbytes); +#ifdef DOUG_LEA_MALLOC + /* Back to a reasonable maximum of mmap'ed areas. */ + mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); +#endif + + if (!val && nbytes) + { + MALLOC_UNBLOCK_INPUT; + memory_full (nbytes); + } #if ! 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. */ - if (val && type != MEM_TYPE_NON_LISP) + if (val && type != MEM_TYPE_NON_LISP + && !verify_address ((char *) val + nbytes - 1)) { - Lisp_Object tem; - XSETCONS (tem, (char *) val + nbytes - 1); - if ((char *) XCONS (tem) != (char *) val + nbytes - 1) - { - lisp_malloc_loser = val; - free (val); - val = 0; - } + free (val); + MALLOC_UNBLOCK_INPUT; + memory_full (SIZE_MAX); } -#endif +#endif /* not USE_LSB_TAG */ #if GC_MARK_STACK && !defined GC_MALLOC_CHECK if (val && type != MEM_TYPE_NON_LISP) @@ -933,116 +957,33 @@ #endif MALLOC_UNBLOCK_INPUT; - if (!val && nbytes) - memory_full (nbytes); return val; } -/* Free BLOCK. This must be called to free memory allocated with a - call to lisp_malloc. */ - -static void -lisp_free (void *block) -{ - MALLOC_BLOCK_INPUT; - free (block); -#if GC_MARK_STACK && !defined GC_MALLOC_CHECK - mem_delete (mem_find (block)); -#endif - MALLOC_UNBLOCK_INPUT; -} - -/***** Allocation of aligned blocks of memory to store Lisp data. *****/ - -/* The entry point is lisp_align_malloc which returns blocks of at most - BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */ - -#if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC) -#define USE_POSIX_MEMALIGN 1 -#endif +/* Allocation of aligned blocks. We assume that malloc implementation + provides posix_memalign or (obsolete) memalign at least. */ /* BLOCK_ALIGN has to be a power of 2. */ + #define BLOCK_ALIGN (1 << 10) -/* Padding to leave at the end of a malloc'd block. This is to give - malloc a chance to minimize the amount of memory wasted to alignment. - It should be tuned to the particular malloc library used. - On glibc-2.3.2, malloc never tries to align, so a padding of 0 is best. - posix_memalign on the other hand would ideally prefer a value of 4 - because otherwise, there's 1020 bytes wasted between each ablocks. - In Emacs, testing shows that those 1020 can most of the time be - efficiently used by malloc to place other objects, so a value of 0 can - still preferable unless you have a lot of aligned blocks and virtually - nothing else. */ -#define BLOCK_PADDING 0 -#define BLOCK_BYTES \ - (BLOCK_ALIGN - sizeof (struct ablocks *) - BLOCK_PADDING) - -/* Internal data structures and constants. */ - -#define ABLOCKS_SIZE 16 - -/* An aligned block of memory. */ -struct ablock -{ - union - { - char payload[BLOCK_BYTES]; - struct ablock *next_free; - } x; - /* `abase' is the aligned base of the ablocks. */ - /* It is overloaded to hold the virtual `busy' field that counts - the number of used ablock in the parent ablocks. - The first ablock has the `busy' field, the others have the `abase' - field. To tell the difference, we assume that pointers will have - integer values larger than 2 * ABLOCKS_SIZE. The lowest bit of `busy' - is used to tell whether the real base of the parent ablocks is `abase' - (if not, the word before the first ablock holds a pointer to the - real base). */ - struct ablocks *abase; - /* The padding of all but the last ablock is unused. The padding of - the last ablock in an ablocks is not allocated. */ -#if BLOCK_PADDING - char padding[BLOCK_PADDING]; -#endif -}; - -/* A bunch of consecutive aligned blocks. */ -struct ablocks -{ - struct ablock blocks[ABLOCKS_SIZE]; -}; - -/* Size of the block requested from malloc or posix_memalign. */ -#define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING) - -#define ABLOCK_ABASE(block) \ - (((uintptr_t) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \ - ? (struct ablocks *)(block) \ - : (block)->abase) - -/* Virtual `busy' field. */ -#define ABLOCKS_BUSY(abase) ((abase)->blocks[0].abase) - -/* Pointer to the (not necessarily aligned) malloc block. */ -#ifdef USE_POSIX_MEMALIGN -#define ABLOCKS_BASE(abase) (abase) -#else -#define ABLOCKS_BASE(abase) \ - (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1]) -#endif - -/* The list of free ablock. */ -static struct ablock *free_ablock; - -/* Allocate an aligned block of nbytes. - Alignment is on a multiple of BLOCK_ALIGN and `nbytes' has to be - smaller or equal to BLOCK_BYTES. */ +/* Padding to leave at the end of a malloc'd block. This should help + the malloc implementation to allocate aligned blocks consecutively. + FIXME: tuned to fit glibc malloc, may be suboptimal for others. */ + +#define BLOCK_PADDING sizeof (long) + +/* Maximum amount of memory in aligned block. */ + +#define BLOCK_BYTES (BLOCK_ALIGN - BLOCK_PADDING) + +/* Like lisp_malloc, but allocates aligned block of at + most BLOCK_BYTES aligned on a BLOCK_ALIGN boundary. */ + static void * lisp_align_malloc (size_t nbytes, enum mem_type type) { - void *base, *val; - struct ablocks *abase; + void *val; eassert (nbytes <= BLOCK_BYTES); @@ -1052,86 +993,40 @@ allocated_mem_type = type; #endif - if (!free_ablock) - { - int i; - intptr_t aligned; /* int gets warning casting to 64-bit pointer. */ - #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); + /* 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 -#ifdef USE_POSIX_MEMALIGN - { - int err = posix_memalign (&base, BLOCK_ALIGN, ABLOCKS_BYTES); - if (err) - base = NULL; - abase = base; - } +#ifdef HAVE_POSIX_MEMALIGN + if (posix_memalign (&val, BLOCK_ALIGN, nbytes)) + val = NULL; #else - base = malloc (ABLOCKS_BYTES); - abase = ALIGN (base, BLOCK_ALIGN); + val = memalign (BLOCK_ALIGN, nbytes); #endif - if (base == 0) - { - MALLOC_UNBLOCK_INPUT; - memory_full (ABLOCKS_BYTES); - } - - aligned = (base == abase); - if (!aligned) - ((void**)abase)[-1] = base; - #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 + if (!val && nbytes) + { + MALLOC_UNBLOCK_INPUT; + memory_full (nbytes); + } + #if ! 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. */ - if (type != MEM_TYPE_NON_LISP) - { - Lisp_Object tem; - char *end = (char *) base + ABLOCKS_BYTES - 1; - XSETCONS (tem, end); - if ((char *) XCONS (tem) != end) - { - lisp_malloc_loser = base; - free (base); - MALLOC_UNBLOCK_INPUT; - memory_full (SIZE_MAX); - } - } -#endif - - /* Initialize the blocks and put them on the free list. - If `base' was not properly aligned, we can't use the last block. */ - for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++) - { - abase->blocks[i].abase = abase; - abase->blocks[i].x.next_free = free_ablock; - free_ablock = &abase->blocks[i]; - } - ABLOCKS_BUSY (abase) = (struct ablocks *) aligned; - - eassert (0 == ((uintptr_t) abase) % BLOCK_ALIGN); - eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */ - eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase); - eassert (ABLOCKS_BASE (abase) == base); - eassert (aligned == (intptr_t) ABLOCKS_BUSY (abase)); + if (type != MEM_TYPE_NON_LISP + && !verify_address ((char *) val + nbytes - 1)) + { + free (val); + MALLOC_UNBLOCK_INPUT; + memory_full (SIZE_MAX); } - - abase = ABLOCK_ABASE (free_ablock); - ABLOCKS_BUSY (abase) = - (struct ablocks *) (2 + (intptr_t) ABLOCKS_BUSY (abase)); - val = free_ablock; - free_ablock = free_ablock->x.next_free; +#endif /* not USE_LSB_TAG */ #if GC_MARK_STACK && !defined GC_MALLOC_CHECK if (type != MEM_TYPE_NON_LISP) @@ -1139,51 +1034,21 @@ #endif MALLOC_UNBLOCK_INPUT; - eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN); return val; } +/* Free BLOCK. This must be called to free memory allocated + with a call to lisp_malloc or lisp_align_malloc. */ + static void -lisp_align_free (void *block) +lisp_free (void *block) { - struct ablock *ablock = block; - struct ablocks *abase = ABLOCK_ABASE (ablock); - MALLOC_BLOCK_INPUT; + free (block); #if GC_MARK_STACK && !defined GC_MALLOC_CHECK mem_delete (mem_find (block)); #endif - /* Put on free list. */ - ablock->x.next_free = free_ablock; - free_ablock = ablock; - /* Update busy count. */ - ABLOCKS_BUSY (abase) - = (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase)); - - if (2 > (intptr_t) ABLOCKS_BUSY (abase)) - { /* All the blocks are free. */ - int i = 0, aligned = (intptr_t) ABLOCKS_BUSY (abase); - struct ablock **tem = &free_ablock; - struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1]; - - while (*tem) - { - if (*tem >= (struct ablock *) abase && *tem < atop) - { - i++; - *tem = (*tem)->x.next_free; - } - else - tem = &(*tem)->x.next_free; - } - eassert ((aligned & 1) == aligned); - eassert (i == (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1)); -#ifdef USE_POSIX_MEMALIGN - eassert ((uintptr_t) ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0); -#endif - free (ABLOCKS_BASE (abase)); - } MALLOC_UNBLOCK_INPUT; } @@ -3757,7 +3622,7 @@ if (i == 0) free (spare_memory[i]); else if (i >= 1 && i <= 4) - lisp_align_free (spare_memory[i]); + lisp_free (spare_memory[i]); else lisp_free (spare_memory[i]); spare_memory[i] = 0; @@ -6292,7 +6157,7 @@ *cprev = cblk->next; /* Unhook from the free list. */ cons_free_list = cblk->conses[0].u.chain; - lisp_align_free (cblk); + lisp_free (cblk); } else { @@ -6338,7 +6203,7 @@ *fprev = fblk->next; /* Unhook from the free list. */ float_free_list = fblk->floats[0].u.chain; - lisp_align_free (fblk); + lisp_free (fblk); } else { @@ -6671,9 +6536,6 @@ pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0; pure_bytes_used_before_overflow = 0; - /* Initialize the list of free aligned blocks. */ - free_ablock = NULL; - #if GC_MARK_STACK || defined GC_MALLOC_CHECK mem_init (); Vdead = make_pure_string ("DEAD", 4, 4, 0);