aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDmitry Antipov2012-06-08 12:44:30 +0400
committerDmitry Antipov2012-06-08 12:44:30 +0400
commitf3372c8789c843a00912e7fc9793ded4beb9a35a (patch)
tree72217e83c99d83ce8b56884b0a21276669e1699b
parentd52ba5afda376fedc679ac6d4e003867d70866dd (diff)
downloademacs-f3372c8789c843a00912e7fc9793ded4beb9a35a.tar.gz
emacs-f3372c8789c843a00912e7fc9793ded4beb9a35a.zip
Block-based vector allocation of small vectors.
* src/lisp.h (struct vectorlike_header): New field `nbytes', adjust comment accordingly. * src/alloc.c (enum mem_type): New type `MEM_TYPE_VECTOR_BLOCK' to denote vector blocks. Adjust users (live_vector_p, mark_maybe_pointer, valid_lisp_object_p) accordingly. (COMMON_MULTIPLE): Move outside #if USE_LSB_TAG. (VECTOR_BLOCK_SIZE, vroundup, VECTOR_BLOCK_BYTES), (VBLOCK_BYTES_MIN, VBLOCK_BYTES_MAX, VECTOR_MAX_FREE_LIST_INDEX), (VECTOR_FREE_LIST_FLAG, ADVANCE, VINDEX, SETUP_ON_FREE_LIST), (VECTOR_SIZE, VECTOR_IN_BLOCK): New macros. (roundup_size): New constant. (struct vector_block): New data type. (vector_blocks, vector_free_lists, zero_vector): New variables. (all_vectors): Renamed to `large_vectors'. (allocate_vector_from_block, init_vectors, allocate_vector_from_block) (sweep_vectors): New functions. (allocate_vectorlike): Return `zero_vector' as the only vector of 0 items. Allocate new vector from block if vector size is less than or equal to VBLOCK_BYTES_MAX. (Fgarbage_collect): Move all vector sweeping code to sweep_vectors. (init_alloc_once): Add call to init_vectors. * doc/lispref/internals.text (Garbage Collection): Document new vector management code and vectorlike_header structure.
-rw-r--r--doc/lispref/ChangeLog5
-rw-r--r--doc/lispref/internals.texi29
-rw-r--r--src/ChangeLog25
-rw-r--r--src/alloc.c388
-rw-r--r--src/lisp.h6
5 files changed, 404 insertions, 49 deletions
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index b774809feb9..1ef5595fa06 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,8 @@
12012-06-08 Dmitry Antipov <dmantipov@yandex.ru>
2
3 * internals.text (Garbage Collection): Document new
4 vector management code and vectorlike_header structure.
5
12012-06-03 Chong Yidong <cyd@gnu.org> 62012-06-03 Chong Yidong <cyd@gnu.org>
2 7
3 * modes.texi (Mode Line Data): Use "mode line construct" 8 * modes.texi (Mode Line Data): Use "mode line construct"
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 5d4a9c6a3af..1d0a7102a22 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -215,10 +215,23 @@ You should not change this flag in a running Emacs.
215(such as by loading a library), that data is placed in normal storage. 215(such as by loading a library), that data is placed in normal storage.
216If normal storage runs low, then Emacs asks the operating system to 216If normal storage runs low, then Emacs asks the operating system to
217allocate more memory. Different types of Lisp objects, such as 217allocate more memory. Different types of Lisp objects, such as
218symbols, cons cells, markers, etc., are segregated in distinct blocks 218symbols, cons cells, small vectors, markers, etc., are segregated in
219in memory. (Vectors, long strings, buffers and certain other editing 219distinct blocks in memory. (Large vectors, long strings, buffers and
220types, which are fairly large, are allocated in individual blocks, one 220certain other editing types, which are fairly large, are allocated in
221per object, while small strings are packed into blocks of 8k bytes.) 221individual blocks, one per object; small strings are packed into blocks
222of 8k bytes, and small vectors are packed into blocks of 4k bytes).
223
224@cindex vector-like objects, storage
225@cindex storage of vector-like Lisp objects
226 Beyond the basic vector, a lot of objects like window, buffer, and
227frame are managed as if they were vectors. The corresponding C data
228structures include the @code{struct vectorlike_header} field whose
229@code{next} field points to the next object in the chain:
230@code{header.next.buffer} points to the next buffer (which could be
231a killed buffer), and @code{header.next.vector} points to the next
232vector in a free list. If a vector is small (smaller than or equal to
233@code{VBLOCK_BYTES_MIN} bytes, see @file{alloc.c}), then
234@code{header.next.nbytes} contains the vector size in bytes.
222 235
223@cindex garbage collection 236@cindex garbage collection
224 It is quite common to use some storage for a while, then release it 237 It is quite common to use some storage for a while, then release it
@@ -243,8 +256,12 @@ might as well be reused, since no one will miss them. The second
243 The sweep phase puts unused cons cells onto a @dfn{free list} 256 The sweep phase puts unused cons cells onto a @dfn{free list}
244for future allocation; likewise for symbols and markers. It compacts 257for future allocation; likewise for symbols and markers. It compacts
245the accessible strings so they occupy fewer 8k blocks; then it frees the 258the accessible strings so they occupy fewer 8k blocks; then it frees the
246other 8k blocks. Vectors, buffers, windows, and other large objects are 259other 8k blocks. Unreachable vectors from vector blocks are coalesced
247individually allocated and freed using @code{malloc} and @code{free}. 260to create largest possible free areas; if a free area spans a complete
2614k block, that block is freed. Otherwise, the free area is recorded
262in a free list array, where each entry corresponds to a free list
263of areas of the same size. Large vectors, buffers, and other large
264objects are allocated and freed individually.
248 265
249@cindex CL note---allocate more storage 266@cindex CL note---allocate more storage
250@quotation 267@quotation
diff --git a/src/ChangeLog b/src/ChangeLog
index e16da43761f..bebb36b50a8 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,28 @@
12012-06-08 Dmitry Antipov <dmantipov@yandex.ru>
2
3 Block-based vector allocation of small vectors.
4 * lisp.h (struct vectorlike_header): New field `nbytes',
5 adjust comment accordingly.
6 * alloc.c (enum mem_type): New type `MEM_TYPE_VECTOR_BLOCK'
7 to denote vector blocks. Adjust users (live_vector_p,
8 mark_maybe_pointer, valid_lisp_object_p) accordingly.
9 (COMMON_MULTIPLE): Move outside #if USE_LSB_TAG.
10 (VECTOR_BLOCK_SIZE, vroundup, VECTOR_BLOCK_BYTES),
11 (VBLOCK_BYTES_MIN, VBLOCK_BYTES_MAX, VECTOR_MAX_FREE_LIST_INDEX),
12 (VECTOR_FREE_LIST_FLAG, ADVANCE, VINDEX, SETUP_ON_FREE_LIST),
13 (VECTOR_SIZE, VECTOR_IN_BLOCK): New macros.
14 (roundup_size): New constant.
15 (struct vector_block): New data type.
16 (vector_blocks, vector_free_lists, zero_vector): New variables.
17 (all_vectors): Renamed to `large_vectors'.
18 (allocate_vector_from_block, init_vectors, allocate_vector_from_block)
19 (sweep_vectors): New functions.
20 (allocate_vectorlike): Return `zero_vector' as the only vector of
21 0 items. Allocate new vector from block if vector size is less than
22 or equal to VBLOCK_BYTES_MAX.
23 (Fgarbage_collect): Move all vector sweeping code to sweep_vectors.
24 (init_alloc_once): Add call to init_vectors.
25
12012-06-08 Stefan Monnier <monnier@iro.umontreal.ca> 262012-06-08 Stefan Monnier <monnier@iro.umontreal.ca>
2 27
3 * eval.c (Fmacroexpand): Stop if the macro returns the same form. 28 * eval.c (Fmacroexpand): Stop if the macro returns the same form.
diff --git a/src/alloc.c b/src/alloc.c
index 7c461c5a6af..958da1dbbb0 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -304,7 +304,9 @@ enum mem_type
304 process, hash_table, frame, terminal, and window, but we never made 304 process, hash_table, frame, terminal, and window, but we never made
305 use of the distinction, so it only caused source-code complexity 305 use of the distinction, so it only caused source-code complexity
306 and runtime slowdown. Minor but pointless. */ 306 and runtime slowdown. Minor but pointless. */
307 MEM_TYPE_VECTORLIKE 307 MEM_TYPE_VECTORLIKE,
308 /* Special type to denote vector blocks. */
309 MEM_TYPE_VECTOR_BLOCK
308}; 310};
309 311
310static void *lisp_malloc (size_t, enum mem_type); 312static void *lisp_malloc (size_t, enum mem_type);
@@ -494,6 +496,11 @@ buffer_memory_full (ptrdiff_t nbytes)
494 xsignal (Qnil, Vmemory_signal_data); 496 xsignal (Qnil, Vmemory_signal_data);
495} 497}
496 498
499/* A common multiple of the positive integers A and B. Ideally this
500 would be the least common multiple, but there's no way to do that
501 as a constant expression in C, so do the best that we can easily do. */
502#define COMMON_MULTIPLE(a, b) \
503 ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
497 504
498#ifndef XMALLOC_OVERRUN_CHECK 505#ifndef XMALLOC_OVERRUN_CHECK
499#define XMALLOC_OVERRUN_CHECK_OVERHEAD 0 506#define XMALLOC_OVERRUN_CHECK_OVERHEAD 0
@@ -525,12 +532,8 @@ buffer_memory_full (ptrdiff_t nbytes)
525 char c; \ 532 char c; \
526 }, \ 533 }, \
527 c) 534 c)
535
528#ifdef USE_LSB_TAG 536#ifdef USE_LSB_TAG
529/* A common multiple of the positive integers A and B. Ideally this
530 would be the least common multiple, but there's no way to do that
531 as a constant expression in C, so do the best that we can easily do. */
532# define COMMON_MULTIPLE(a, b) \
533 ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
534# define XMALLOC_HEADER_ALIGNMENT \ 537# define XMALLOC_HEADER_ALIGNMENT \
535 COMMON_MULTIPLE (1 << GCTYPEBITS, XMALLOC_BASE_ALIGNMENT) 538 COMMON_MULTIPLE (1 << GCTYPEBITS, XMALLOC_BASE_ALIGNMENT)
536#else 539#else
@@ -2928,17 +2931,307 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
2928 Vector Allocation 2931 Vector Allocation
2929 ***********************************************************************/ 2932 ***********************************************************************/
2930 2933
2931/* Singly-linked list of all vectors. */ 2934/* This value is balanced well enough to avoid too much internal overhead
2935 for the most common cases; it's not required to be a power of two, but
2936 it's expected to be a mult-of-ROUNDUP_SIZE (see below). */
2932 2937
2933static struct Lisp_Vector *all_vectors; 2938#define VECTOR_BLOCK_SIZE 4096
2934 2939
2935/* Handy constants for vectorlike objects. */ 2940/* Handy constants for vectorlike objects. */
2936enum 2941enum
2937 { 2942 {
2938 header_size = offsetof (struct Lisp_Vector, contents), 2943 header_size = offsetof (struct Lisp_Vector, contents),
2939 word_size = sizeof (Lisp_Object) 2944 word_size = sizeof (Lisp_Object),
2945 roundup_size = COMMON_MULTIPLE (sizeof (Lisp_Object),
2946#ifdef USE_LSB_TAG
2947 8 /* Helps to maintain alignment constraints imposed by
2948 assumption that least 3 bits of pointers are always 0. */
2949#else
2950 1 /* If alignment doesn't matter, should round up
2951 to sizeof (Lisp_Object) at least. */
2952#endif
2953 )
2940 }; 2954 };
2941 2955
2956/* Round up X to nearest mult-of-ROUNDUP_SIZE,
2957 assuming ROUNDUP_SIZE is a power of 2. */
2958
2959#define vroundup(x) (((x) + (roundup_size - 1)) & ~(roundup_size - 1))
2960
2961/* Rounding helps to maintain alignment constraints if USE_LSB_TAG. */
2962
2963#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup (sizeof (void *)))
2964
2965/* Size of the minimal vector allocated from block. */
2966
2967#define VBLOCK_BYTES_MIN vroundup (sizeof (struct Lisp_Vector))
2968
2969/* Size of the largest vector allocated from block. */
2970
2971#define VBLOCK_BYTES_MAX \
2972 vroundup ((VECTOR_BLOCK_BYTES / 2) - sizeof (Lisp_Object))
2973
2974/* We maintain one free list for each possible block-allocated
2975 vector size, and this is the number of free lists we have. */
2976
2977#define VECTOR_MAX_FREE_LIST_INDEX \
2978 ((VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1)
2979
2980/* When the vector is on a free list, vectorlike_header.SIZE is set to
2981 this special value ORed with vector's memory footprint size. */
2982
2983#define VECTOR_FREE_LIST_FLAG (~(ARRAY_MARK_FLAG | PSEUDOVECTOR_FLAG \
2984 | (VECTOR_BLOCK_SIZE - 1)))
2985
2986/* Common shortcut to advance vector pointer over a block data. */
2987
2988#define ADVANCE(v, nbytes) ((struct Lisp_Vector *) ((char *) (v) + (nbytes)))
2989
2990/* Common shortcut to calculate NBYTES-vector index in VECTOR_FREE_LISTS. */
2991
2992#define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size)
2993
2994/* Common shortcut to setup vector on a free list. */
2995
2996#define SETUP_ON_FREE_LIST(v, nbytes, index) \
2997 do { \
2998 (v)->header.size = VECTOR_FREE_LIST_FLAG | (nbytes); \
2999 eassert ((nbytes) % roundup_size == 0); \
3000 (index) = VINDEX (nbytes); \
3001 eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \
3002 (v)->header.next.vector = vector_free_lists[index]; \
3003 vector_free_lists[index] = (v); \
3004 } while (0)
3005
3006struct vector_block
3007{
3008 char data[VECTOR_BLOCK_BYTES];
3009 struct vector_block *next;
3010};
3011
3012/* Chain of vector blocks. */
3013
3014static struct vector_block *vector_blocks;
3015
3016/* Vector free lists, where NTH item points to a chain of free
3017 vectors of the same NBYTES size, so NTH == VINDEX (NBYTES). */
3018
3019static struct Lisp_Vector *vector_free_lists[VECTOR_MAX_FREE_LIST_INDEX];
3020
3021/* Singly-linked list of large vectors. */
3022
3023static struct Lisp_Vector *large_vectors;
3024
3025/* The only vector with 0 slots, allocated from pure space. */
3026
3027static struct Lisp_Vector *zero_vector;
3028
3029/* Get a new vector block. */
3030
3031static struct vector_block *
3032allocate_vector_block (void)
3033{
3034 struct vector_block *block;
3035
3036#ifdef DOUG_LEA_MALLOC
3037 mallopt (M_MMAP_MAX, 0);
3038#endif
3039
3040 block = xmalloc (sizeof (struct vector_block));
3041
3042#ifdef DOUG_LEA_MALLOC
3043 mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
3044#endif
3045
3046#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
3047 mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES,
3048 MEM_TYPE_VECTOR_BLOCK);
3049#endif
3050
3051 block->next = vector_blocks;
3052 vector_blocks = block;
3053 return block;
3054}
3055
3056/* Called once to initialize vector allocation. */
3057
3058static void
3059init_vectors (void)
3060{
3061 zero_vector = pure_alloc (header_size, Lisp_Vectorlike);
3062 zero_vector->header.size = 0;
3063}
3064
3065/* Allocate vector from a vector block. */
3066
3067static struct Lisp_Vector *
3068allocate_vector_from_block (size_t nbytes)
3069{
3070 struct Lisp_Vector *vector, *rest;
3071 struct vector_block *block;
3072 size_t index, restbytes;
3073
3074 eassert (VBLOCK_BYTES_MIN <= nbytes && nbytes <= VBLOCK_BYTES_MAX);
3075 eassert (nbytes % roundup_size == 0);
3076
3077 /* First, try to allocate from a free list
3078 containing vectors of the requested size. */
3079 index = VINDEX (nbytes);
3080 if (vector_free_lists[index])
3081 {
3082 vector = vector_free_lists[index];
3083 vector_free_lists[index] = vector->header.next.vector;
3084 vector->header.next.nbytes = nbytes;
3085 return vector;
3086 }
3087
3088 /* Next, check free lists containing larger vectors. Since
3089 we will split the result, we should have remaining space
3090 large enough to use for one-slot vector at least. */
3091 for (index = VINDEX (nbytes + VBLOCK_BYTES_MIN);
3092 index < VECTOR_MAX_FREE_LIST_INDEX; index++)
3093 if (vector_free_lists[index])
3094 {
3095 /* This vector is larger than requested. */
3096 vector = vector_free_lists[index];
3097 vector_free_lists[index] = vector->header.next.vector;
3098 vector->header.next.nbytes = nbytes;
3099
3100 /* Excess bytes are used for the smaller vector,
3101 which should be set on an appropriate free list. */
3102 restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes;
3103 eassert (restbytes % roundup_size == 0);
3104 rest = ADVANCE (vector, nbytes);
3105 SETUP_ON_FREE_LIST (rest, restbytes, index);
3106 return vector;
3107 }
3108
3109 /* Finally, need a new vector block. */
3110 block = allocate_vector_block ();
3111
3112 /* New vector will be at the beginning of this block. */
3113 vector = (struct Lisp_Vector *) block->data;
3114 vector->header.next.nbytes = nbytes;
3115
3116 /* If the rest of space from this block is large enough
3117 for one-slot vector at least, set up it on a free list. */
3118 restbytes = VECTOR_BLOCK_BYTES - nbytes;
3119 if (restbytes >= VBLOCK_BYTES_MIN)
3120 {
3121 eassert (restbytes % roundup_size == 0);
3122 rest = ADVANCE (vector, nbytes);
3123 SETUP_ON_FREE_LIST (rest, restbytes, index);
3124 }
3125 return vector;
3126 }
3127
3128/* Return how many Lisp_Objects can be stored in V. */
3129
3130#define VECTOR_SIZE(v) ((v)->header.size & PSEUDOVECTOR_FLAG ? \
3131 (PSEUDOVECTOR_SIZE_MASK & (v)->header.size) : \
3132 (v)->header.size)
3133
3134/* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */
3135
3136#define VECTOR_IN_BLOCK(vector, block) \
3137 ((char *) (vector) <= (block)->data \
3138 + VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN)
3139
3140/* Reclaim space used by unmarked vectors. */
3141
3142static void
3143sweep_vectors (void)
3144{
3145 struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
3146 struct Lisp_Vector *vector, *next, **vprev = &large_vectors;
3147
3148 total_vector_size = 0;
3149 memset (vector_free_lists, 0, sizeof (vector_free_lists));
3150
3151 /* Looking through vector blocks. */
3152
3153 for (block = vector_blocks; block; block = *bprev)
3154 {
3155 int free_this_block = 0;
3156
3157 for (vector = (struct Lisp_Vector *) block->data;
3158 VECTOR_IN_BLOCK (vector, block); vector = next)
3159 {
3160 if (VECTOR_MARKED_P (vector))
3161 {
3162 VECTOR_UNMARK (vector);
3163 total_vector_size += VECTOR_SIZE (vector);
3164 next = ADVANCE (vector, vector->header.next.nbytes);
3165 }
3166 else
3167 {
3168 ptrdiff_t nbytes;
3169
3170 if ((vector->header.size & VECTOR_FREE_LIST_FLAG)
3171 == VECTOR_FREE_LIST_FLAG)
3172 vector->header.next.nbytes =
3173 vector->header.size & (VECTOR_BLOCK_SIZE - 1);
3174
3175 next = ADVANCE (vector, vector->header.next.nbytes);
3176
3177 /* While NEXT is not marked, try to coalesce with VECTOR,
3178 thus making VECTOR of the largest possible size. */
3179
3180 while (VECTOR_IN_BLOCK (next, block))
3181 {
3182 if (VECTOR_MARKED_P (next))
3183 break;
3184 if ((next->header.size & VECTOR_FREE_LIST_FLAG)
3185 == VECTOR_FREE_LIST_FLAG)
3186 nbytes = next->header.size & (VECTOR_BLOCK_SIZE - 1);
3187 else
3188 nbytes = next->header.next.nbytes;
3189 vector->header.next.nbytes += nbytes;
3190 next = ADVANCE (next, nbytes);
3191 }
3192
3193 eassert (vector->header.next.nbytes % roundup_size == 0);
3194
3195 if (vector == (struct Lisp_Vector *) block->data
3196 && !VECTOR_IN_BLOCK (next, block))
3197 /* This block should be freed because all of it's
3198 space was coalesced into the only free vector. */
3199 free_this_block = 1;
3200 else
3201 SETUP_ON_FREE_LIST (vector, vector->header.next.nbytes, nbytes);
3202 }
3203 }
3204
3205 if (free_this_block)
3206 {
3207 *bprev = block->next;
3208#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
3209 mem_delete (mem_find (block->data));
3210#endif
3211 xfree (block);
3212 }
3213 else
3214 bprev = &block->next;
3215 }
3216
3217 /* Sweep large vectors. */
3218
3219 for (vector = large_vectors; vector; vector = *vprev)
3220 {
3221 if (VECTOR_MARKED_P (vector))
3222 {
3223 VECTOR_UNMARK (vector);
3224 total_vector_size += VECTOR_SIZE (vector);
3225 vprev = &vector->header.next.vector;
3226 }
3227 else
3228 {
3229 *vprev = vector->header.next.vector;
3230 lisp_free (vector);
3231 }
3232 }
3233}
3234
2942/* Value is a pointer to a newly allocated Lisp_Vector structure 3235/* Value is a pointer to a newly allocated Lisp_Vector structure
2943 with room for LEN Lisp_Objects. */ 3236 with room for LEN Lisp_Objects. */
2944 3237
@@ -2960,8 +3253,19 @@ allocate_vectorlike (ptrdiff_t len)
2960 /* This gets triggered by code which I haven't bothered to fix. --Stef */ 3253 /* This gets triggered by code which I haven't bothered to fix. --Stef */
2961 /* eassert (!handling_signal); */ 3254 /* eassert (!handling_signal); */
2962 3255
3256 if (len == 0)
3257 return zero_vector;
3258
2963 nbytes = header_size + len * word_size; 3259 nbytes = header_size + len * word_size;
2964 p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); 3260
3261 if (nbytes <= VBLOCK_BYTES_MAX)
3262 p = allocate_vector_from_block (vroundup (nbytes));
3263 else
3264 {
3265 p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
3266 p->header.next.vector = large_vectors;
3267 large_vectors = p;
3268 }
2965 3269
2966#ifdef DOUG_LEA_MALLOC 3270#ifdef DOUG_LEA_MALLOC
2967 /* Back to a reasonable maximum of mmap'ed areas. */ 3271 /* Back to a reasonable maximum of mmap'ed areas. */
@@ -2971,9 +3275,6 @@ allocate_vectorlike (ptrdiff_t len)
2971 consing_since_gc += nbytes; 3275 consing_since_gc += nbytes;
2972 vector_cells_consed += len; 3276 vector_cells_consed += len;
2973 3277
2974 p->header.next.vector = all_vectors;
2975 all_vectors = p;
2976
2977 MALLOC_UNBLOCK_INPUT; 3278 MALLOC_UNBLOCK_INPUT;
2978 3279
2979 return p; 3280 return p;
@@ -4072,7 +4373,34 @@ live_misc_p (struct mem_node *m, void *p)
4072static inline int 4373static inline int
4073live_vector_p (struct mem_node *m, void *p) 4374live_vector_p (struct mem_node *m, void *p)
4074{ 4375{
4075 return (p == m->start && m->type == MEM_TYPE_VECTORLIKE); 4376 if (m->type == MEM_TYPE_VECTOR_BLOCK)
4377 {
4378 /* This memory node corresponds to a vector block. */
4379 struct vector_block *block = (struct vector_block *) m->start;
4380 struct Lisp_Vector *vector = (struct Lisp_Vector *) block->data;
4381
4382 /* P is in the block's allocation range. Scan the block
4383 up to P and see whether P points to the start of some
4384 vector which is not on a free list. FIXME: check whether
4385 some allocation patterns (probably a lot of short vectors)
4386 may cause a substantial overhead of this loop. */
4387 while (VECTOR_IN_BLOCK (vector, block)
4388 && vector <= (struct Lisp_Vector *) p)
4389 {
4390 if ((vector->header.size & VECTOR_FREE_LIST_FLAG)
4391 == VECTOR_FREE_LIST_FLAG)
4392 vector = ADVANCE (vector, (vector->header.size
4393 & (VECTOR_BLOCK_SIZE - 1)));
4394 else if (vector == p)
4395 return 1;
4396 else
4397 vector = ADVANCE (vector, vector->header.next.nbytes);
4398 }
4399 }
4400 else if (m->type == MEM_TYPE_VECTORLIKE && p == m->start)
4401 /* This memory node corresponds to a large vector. */
4402 return 1;
4403 return 0;
4076} 4404}
4077 4405
4078 4406
@@ -4272,6 +4600,7 @@ mark_maybe_pointer (void *p)
4272 break; 4600 break;
4273 4601
4274 case MEM_TYPE_VECTORLIKE: 4602 case MEM_TYPE_VECTORLIKE:
4603 case MEM_TYPE_VECTOR_BLOCK:
4275 if (live_vector_p (m, p)) 4604 if (live_vector_p (m, p))
4276 { 4605 {
4277 Lisp_Object tem; 4606 Lisp_Object tem;
@@ -4705,6 +5034,7 @@ valid_lisp_object_p (Lisp_Object obj)
4705 return live_float_p (m, p); 5034 return live_float_p (m, p);
4706 5035
4707 case MEM_TYPE_VECTORLIKE: 5036 case MEM_TYPE_VECTORLIKE:
5037 case MEM_TYPE_VECTOR_BLOCK:
4708 return live_vector_p (m, p); 5038 return live_vector_p (m, p);
4709 5039
4710 default: 5040 default:
@@ -6241,33 +6571,7 @@ gc_sweep (void)
6241 } 6571 }
6242 } 6572 }
6243 6573
6244 /* Free all unmarked vectors */ 6574 sweep_vectors ();
6245 {
6246 register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next;
6247 total_vector_size = 0;
6248
6249 while (vector)
6250 if (!VECTOR_MARKED_P (vector))
6251 {
6252 if (prev)
6253 prev->header.next = vector->header.next;
6254 else
6255 all_vectors = vector->header.next.vector;
6256 next = vector->header.next.vector;
6257 lisp_free (vector);
6258 vector = next;
6259
6260 }
6261 else
6262 {
6263 VECTOR_UNMARK (vector);
6264 if (vector->header.size & PSEUDOVECTOR_FLAG)
6265 total_vector_size += PSEUDOVECTOR_SIZE_MASK & vector->header.size;
6266 else
6267 total_vector_size += vector->header.size;
6268 prev = vector, vector = vector->header.next.vector;
6269 }
6270 }
6271 6575
6272#ifdef GC_CHECK_STRING_BYTES 6576#ifdef GC_CHECK_STRING_BYTES
6273 if (!noninteractive) 6577 if (!noninteractive)
@@ -6404,7 +6708,6 @@ init_alloc_once (void)
6404 Vdead = make_pure_string ("DEAD", 4, 4, 0); 6708 Vdead = make_pure_string ("DEAD", 4, 4, 0);
6405#endif 6709#endif
6406 6710
6407 all_vectors = 0;
6408 ignore_warnings = 1; 6711 ignore_warnings = 1;
6409#ifdef DOUG_LEA_MALLOC 6712#ifdef DOUG_LEA_MALLOC
6410 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */ 6713 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
@@ -6417,6 +6720,7 @@ init_alloc_once (void)
6417 init_marker (); 6720 init_marker ();
6418 init_float (); 6721 init_float ();
6419 init_intervals (); 6722 init_intervals ();
6723 init_vectors ();
6420 init_weak_hash_tables (); 6724 init_weak_hash_tables ();
6421 6725
6422#ifdef REL_ALLOC 6726#ifdef REL_ALLOC
diff --git a/src/lisp.h b/src/lisp.h
index de627b9f4ad..acadcf50183 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -916,11 +916,15 @@ struct vectorlike_header
916 { 916 {
917 ptrdiff_t size; 917 ptrdiff_t size;
918 918
919 /* Pointer to the next vector-like object. It is generally a buffer or a 919 /* When the vector is allocated from a vector block, NBYTES is used
920 if the vector is not on a free list, and VECTOR is used otherwise.
921 For large vector-like objects, BUFFER or VECTOR is used as a pointer
922 to the next vector-like object. It is generally a buffer or a
920 Lisp_Vector alias, so for convenience it is a union instead of a 923 Lisp_Vector alias, so for convenience it is a union instead of a
921 pointer: this way, one can write P->next.vector instead of ((struct 924 pointer: this way, one can write P->next.vector instead of ((struct
922 Lisp_Vector *) P->next). */ 925 Lisp_Vector *) P->next). */
923 union { 926 union {
927 ptrdiff_t nbytes;
924 struct buffer *buffer; 928 struct buffer *buffer;
925 struct Lisp_Vector *vector; 929 struct Lisp_Vector *vector;
926 } next; 930 } next;