[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: immediate strings
|
From: |
Stefan Monnier |
|
Subject: |
Re: immediate strings |
|
Date: |
Sat, 26 Nov 2011 09:28:37 -0500 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.0.91 (gnu/linux) |
>> > I think it's worth playing with such a little complication.
FWIW, I have been using a very similar patch for a couple years now.
See below my sig for the actual code (don't try to use it, it's
probably incomplete). My patch makes fewer changes (leaves "size" and
the gc mark bit alone).
It also has one more difference: "immediate" strings are used not only
for small strings but also for all strings allocated in pure space.
> But if that means applying this to the trunk, based just on the
> preliminary statistics reported by Dmitry, presumably for his usage
> pattern and locale, then I think the gains are not substantiated
> enough to justify the change.
I tend to agree. I think to make it worthwhile we want a more
aggressive approach that packs size&byte_size together for such small
strings. Using the `intervals' field is also an attractive option,
although it would be a bit more complex since it requires changing the
string if/when we add the first text-property to it.
BTW, another implementation option is to split the Lisp_String tag into
two (which could be done by requiring Lisp_String objects to be aligned
on a 16x boundary), i.e. move the immediate/inline bit outside of the
Lisp_String object and into the Lisp_Object.
> FWIW, I'd like to see a much more detailed statistics, both for memory
> usage and for speed of frequent operations, before I could make up my
> mind on whether this kind of micro-optimization is justified. YMMV.
Very much so. I don't know if there's even something to win here (tho
it seems to getting rid of one indirection is usually a good thing).
Stefan
Using submit branch file:///home/monnier/src/emacs/bzr/trunk/
=== modified file 'src/lisp.h'
--- src/lisp.h 2011-11-20 03:07:02 +0000
+++ src/lisp.h 2011-11-21 02:54:00 +0000
@@ -691,7 +700,11 @@
/* Convenience macros for dealing with Lisp strings. */
-#define SDATA(string) (XSTRING (string)->data + 0)
+#define STRING_DATA(s) ((s)->inlined ? (s)->data.chars : (s)->data.ptr)
+
+#define SDATA(string) (STRING_DATA (XSTRING (string)) + 0)
+/* Whatch out: there are some SREF (foo, offset++) in xdisp.c where the
+ ++ is difficult to move outside of the macro call. */
#define SREF(string, index) (SDATA (string)[index] + 0)
#define SSET(string, index, new) (SDATA (string)[index] = (new))
#define SCHARS(string) (XSTRING (string)->size + 0)
@@ -843,14 +864,24 @@
/* Set text properties. */
#define STRING_SET_INTERVALS(STR, INT) (XSTRING (STR)->intervals = (INT))
+/* If the string's size is smaller than the size of a pointer,
+ we store the data directly in Lisp_String, otherwise, we store it in
+ a separate object. */
+#define STRING_MAXINLINE (sizeof (unsigned char *))
+
/* In a string or vector, the sign bit of the `size' is the gc mark bit */
struct Lisp_String
{
EMACS_INT size;
- EMACS_INT size_byte;
+ EMACS_INT size_byte : BITS_PER_EMACS_INT - 1;
+ unsigned inlined : 1; /* 0 -> ptr, 1 -> chars; in union below. */
INTERVAL intervals; /* text properties in this string */
- unsigned char *data;
+ union
+ {
+ unsigned char *ptr;
+ unsigned char chars[STRING_MAXINLINE];
+ } data;
};
/* Header of vector-like objects. This documents the layout constraints on
=== modified file 'src/alloc.c'
--- src/alloc.c 2011-11-20 03:07:02 +0000
+++ src/alloc.c 2011-11-24 15:00:12 +0000
@@ -17,6 +17,9 @@
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+/* TODO:
+ - Optimize small vectors along the lines of small strings. */
+
#include <config.h>
#include <stdio.h>
#include <limits.h> /* For CHAR_BIT. */
@@ -178,7 +181,8 @@
/* Number of live and free conses etc. */
-static EMACS_INT total_conses, total_markers, total_symbols, total_vector_size;
+static EMACS_INT total_conses, total_markers, total_symbols;
+static EMACS_INT total_vectors, total_vector_size;
static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
static EMACS_INT total_free_floats, total_floats;
@@ -951,6 +955,8 @@
/* BLOCK_ALIGN has to be a power of 2. */
#define BLOCK_ALIGN (1 << 10)
+#undef HAVE_GOOD_POSIX_MEMALIGN
+
/* 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.
@@ -1577,7 +1583,7 @@
{
Lisp_Object obj;
obj.s.val = n;
- obj.s.type = Lisp_Int;
+ obj.s.type = LISP_INT_TAG; /* (obj.s.val == n) ? Lisp_Int0 : Lisp_Int1; */
return obj;
}
#endif
@@ -1733,7 +1739,7 @@
a pointer to the `u.data' member of its sdata structure; the
structure starts at a constant offset in front of that. */
-#define SDATA_OF_STRING(S) ((struct sdata *) ((S)->data - SDATA_DATA_OFFSET))
+#define SDATA_OF_STRING(S) ((struct sdata *) (STRING_DATA (S) -
SDATA_DATA_OFFSET))
#ifdef GC_CHECK_STRING_OVERRUN
@@ -1827,7 +1833,7 @@
(s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
if (!PURE_POINTER_P (s)
- && s->data
+ && STRING_DATA (s)
&& nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
abort ();
return nbytes;
@@ -1915,7 +1921,7 @@
#endif
/* Return a new Lisp_String. */
-
+/* Memalign: malloc_align +* sizeof(struct Lisp_String) */
static struct Lisp_String *
allocate_string (void)
{
@@ -1979,6 +1985,7 @@
return s;
}
+int alloc_hist[80];
/* Set up Lisp_String S for holding NCHARS characters, NBYTES bytes,
plus a NUL byte at the end. Allocate an sdata structure for S, and
@@ -1990,18 +1997,35 @@
allocate_string_data (struct Lisp_String *s,
EMACS_INT nchars, EMACS_INT nbytes)
{
- struct sdata *data, *old_data;
- struct sblock *b;
- EMACS_INT needed, old_nbytes;
+ struct sdata *old_data;
+ EMACS_INT old_nbytes;
if (STRING_BYTES_MAX < nbytes)
string_overflow ();
+ { int i,j, n = nbytes / 4 + 1;
+ if (n < 16)
+ alloc_hist[n]++;
+ else
+ {
+ for (j = 16, i = 16; i < n; j++, i += i);
+ alloc_hist[j]++;
+ }
+ }
+
+ old_data = (!s->inlined && STRING_DATA (s)) ? SDATA_OF_STRING (s) : NULL;
+ old_nbytes = GC_STRING_BYTES (s);
+
+ if (nbytes < STRING_MAXINLINE)
+ s->inlined = 1;
+ else
+ {
+ struct sdata *data;
+ struct sblock *b;
+ EMACS_INT needed;
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
needed = SDATA_SIZE (nbytes);
- old_data = s->data ? SDATA_OF_STRING (s) : NULL;
- old_nbytes = GC_STRING_BYTES (s);
MALLOC_BLOCK_INPUT;
@@ -2060,13 +2084,15 @@
MALLOC_UNBLOCK_INPUT;
data->string = s;
- s->data = SDATA_DATA (data);
+ s->inlined = 0; s->data.ptr = SDATA_DATA (data);
#ifdef GC_CHECK_STRING_BYTES
SDATA_NBYTES (data) = nbytes;
#endif
+ consing_since_gc += needed;
+ }
s->size = nchars;
s->size_byte = nbytes;
- s->data[nbytes] = '\0';
+ STRING_DATA (s)[nbytes] = '\0';
#ifdef GC_CHECK_STRING_OVERRUN
memcpy ((char *) data + needed, string_overrun_cookie,
GC_STRING_OVERRUN_COOKIE_SIZE);
@@ -2080,8 +2106,6 @@
SDATA_NBYTES (old_data) = old_nbytes;
old_data->string = NULL;
}
-
- consing_since_gc += needed;
}
@@ -2109,7 +2133,7 @@
{
struct Lisp_String *s = b->strings + i;
- if (s->data)
+ if (STRING_DATA (s))
{
/* String was not on free-list before. */
if (STRING_MARKED_P (s))
@@ -2141,7 +2165,7 @@
/* Reset the strings's `data' member so that we
know it's free. */
- s->data = NULL;
+ s->inlined = 0; s->data.ptr = NULL;
/* Put the string on the free-list. */
NEXT_FREE_LISP_STRING (s) = string_free_list;
@@ -2284,7 +2308,8 @@
{
xassert (tb != b || to < from);
memmove (to, from, nbytes + GC_STRING_EXTRA);
- to->string->data = SDATA_DATA (to);
+ eassert (!to->string->inlined);
+ to->string->data.ptr = SDATA_DATA (to);
}
/* Advance past the sdata we copied to. */
@@ -2330,7 +2355,7 @@
if (ASCII_CHAR_P (c))
{
nbytes = XINT (length);
- val = make_uninit_string (nbytes);
+ val = make_uninit_multibyte_string (nbytes, nbytes);
p = SDATA (val);
end = p + SCHARS (val);
while (p != end)
@@ -2443,6 +2468,7 @@
EMACS_INT nchars, EMACS_INT nbytes)
{
register Lisp_Object val;
+ eassert (nbytes >= nchars);
val = make_uninit_multibyte_string (nchars, nbytes);
memcpy (SDATA (val), contents, nbytes);
return val;
@@ -2618,6 +2644,7 @@
/* Return a new float object with value FLOAT_VALUE. */
+/* Memalign: malloc_align +* sizeof (struct Lisp_Float) */
Lisp_Object
make_float (double float_value)
{
@@ -2734,6 +2761,7 @@
cons_free_list = ptr;
}
+/* Memalign: malloc_align +* sizeof (struct Lisp_Cons) */
DEFUN ("cons", Fcons, Scons, 2, 2, 0,
doc: /* Create a new cons, give it CAR and CDR as components, and
return it. */)
(Lisp_Object car, Lisp_Object cdr)
@@ -2769,8 +2797,8 @@
MALLOC_UNBLOCK_INPUT;
- XSETCAR (val, car);
- XSETCDR (val, cdr);
+ XSETCAR_UNCHECKED (val, car);
+ XSETCDR_UNCHECKED (val, cdr);
eassert (!CONS_MARKED_P (XCONS (val)));
consing_since_gc += sizeof (struct Lisp_Cons);
cons_cells_consed++;
@@ -2854,38 +2882,19 @@
CHECK_NATNUM (length);
size = XFASTINT (length);
- val = Qnil;
- while (size > 0)
- {
- val = Fcons (init, val);
- --size;
-
- if (size > 0)
- {
- val = Fcons (init, val);
- --size;
-
- if (size > 0)
- {
- val = Fcons (init, val);
- --size;
+#define UNROLL_FACTOR 4
- if (size > 0)
- {
- val = Fcons (init, val);
- --size;
-
- if (size > 0)
+ val = Qnil;
+ while (size >= UNROLL_FACTOR)
{
+ int i;
+ for (i = 0; i < UNROLL_FACTOR; i++)
val = Fcons (init, val);
- --size;
- }
- }
- }
- }
-
+ size -= UNROLL_FACTOR;
QUIT;
}
+ while (size-- > 0)
+ val = Fcons (init, val);
return val;
}
@@ -2925,7 +2934,28 @@
mallopt (M_MMAP_MAX, 0);
#endif
- /* This gets triggered by code which I haven't bothered to fix. --Stef */
+ /* This gets triggered by:
+ (gdb) bt
+ #0 abort () at emacs.c:464
+ #1 0x081946fa in die (msg=0x8265950 "assertion failed:
!handling_signal", file=0x8265209 "alloc.c", line=2866) at alloc.c:6126
+ #2 0x08197013 in allocate_vectorlike (len=391, type=MEM_TYPE_VECTOR) at
alloc.c:2866
+ #3 0x081971f4 in allocate_vector (nslots=391) at alloc.c:2894
+ #4 0x08197223 in Fmake_vector (length=3128, init=138309641) at
alloc.c:2990
+ #5 0x08197562 in Fmake_char_table (purpose=138537273, init=138309641) at
alloc.c:3015
+ #6 0x0811a984 in make_fontset (frame=142414076, name=138309641,
base=142390252) at fontset.c:401
+ #7 0x0811b03d in make_fontset_for_ascii_face (f=0x87d10f8,
base_fontset_id=3) at fontset.c:580
+ #8 0x080f49f9 in realize_face (cache=0x87d1780, attrs=0xbfffce90, c=0,
base_face=0x0, former_face_id=-1) at xfaces.c:7224
+ #9 0x080f6236 in lookup_face (f=0x87d10f8, attr=0xbfffce90, c=0,
base_face=0x0) at xfaces.c:5685
+ #10 0x080f66d3 in face_at_buffer_position (w=0x87d1258, pos=768,
region_beg=0, region_end=0, endptr=0xbfffd0b0, limit=769, mouse=1) at
xfaces.c:7690
+ #11 0x0809dee9 in note_mouse_highlight (f=0x87d10f8, x=88, y=285) at
xdisp.c:22533
+ #12 0x080fd0ee in note_mouse_movement (frame=0x87d10f8, event=0xbfffd624)
at xterm.c:3614
+ #13 0x08103405 in handle_one_xevent (dpyinfo=0x871fb28,
eventp=0xbfffd6f0, finish=0xbfffd77c, hold_quit=0xbfffe7b0) at xterm.c:6573
+ #14 0x0810683b in XTread_socket (sd=0, expected=1, hold_quit=0xbfffe7b0)
at xterm.c:7021
+ #15 0x0813b1b9 in read_avail_input (expected=<value optimized out>) at
keyboard.c:6712
+ #16 0x0813b35a in handle_async_input () at keyboard.c:6858
+ #17 0x0813b389 in input_available_signal (signo=29) at keyboard.c:6900
+ #18 <signal handler called>
+ But it's probably not too serious. */
/* eassert (!handling_signal); */
nbytes = header_size + len * word_size;
@@ -3155,7 +3185,7 @@
symbol_free_list = 0;
}
-
+/* Memalign: malloc_align +* sizeof (struct Lisp_Symbol) */
DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
doc: /* Return a newly allocated uninterned symbol whose name is NAME.
Its value and function definition are void, and its property list is nil. */)
@@ -3193,7 +3223,7 @@
MALLOC_UNBLOCK_INPUT;
p = XSYMBOL (val);
- p->xname = name;
+ p->name = XSTRING (name);
p->plist = Qnil;
p->redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (p, Qunbound);
@@ -3241,7 +3271,7 @@
}
/* Return a newly allocated Lisp_Misc object, with no substructure. */
-
+/* Memalign: malloc_align +* sizeof (union Lisp_Misc) */
Lisp_Object
allocate_misc (void)
{
@@ -3496,6 +3526,8 @@
tree, and use that to determine if the pointer points to a Lisp
object or not. */
+static int mem_count;
+
/* Initialize this part of alloc.c. */
static void
@@ -3506,6 +3538,7 @@
mem_z.color = MEM_BLACK;
mem_z.start = mem_z.end = NULL;
mem_root = MEM_NIL;
+ mem_count = 0;
}
@@ -3540,6 +3573,8 @@
{
struct mem_node *c, *parent, *x;
+ mem_count++;
+
if (min_heap_address == NULL || start < min_heap_address)
min_heap_address = start;
if (max_heap_address == NULL || end > max_heap_address)
@@ -3551,26 +3586,16 @@
c = mem_root;
parent = NULL;
-#if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
-
while (c != MEM_NIL)
{
+#if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
if (start >= c->start && start < c->end)
abort ();
+#endif /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
parent = c;
c = start < c->start ? c->left : c->right;
}
-#else /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
-
- while (c != MEM_NIL)
- {
- parent = c;
- c = start < c->start ? c->left : c->right;
- }
-
-#endif /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
-
/* Create a new node. */
#ifdef GC_MALLOC_CHECK
x = (struct mem_node *) _malloc_internal (sizeof *x);
@@ -3761,6 +3786,9 @@
if (!z || z == MEM_NIL)
return;
+ mem_count--;
+ eassert (mem_count >= 0);
+
if (z->left == MEM_NIL || z->right == MEM_NIL)
y = z;
else
@@ -3901,7 +3929,8 @@
return (offset >= 0
&& offset % sizeof b->strings[0] == 0
&& offset < (STRING_BLOCK_SIZE * sizeof b->strings[0])
- && ((struct Lisp_String *) p)->data != NULL);
+ && !(((struct Lisp_String *) p)->inlined == 0
+ && ((struct Lisp_String *) p)->data.ptr == NULL));
}
else
return 0;
@@ -3949,6 +3978,7 @@
one of the unused cells in the current symbol block,
and not be on the free-list. */
return (offset >= 0
+ && offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0])
&& offset % sizeof b->symbols[0] == 0
&& offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0])
&& (b != symbol_block
@@ -3999,6 +4029,7 @@
one of the unused cells in the current misc block,
and not be on the free-list. */
return (offset >= 0
+ && offset < (MARKER_BLOCK_SIZE * sizeof b->markers[0])
&& offset % sizeof b->markers[0] == 0
&& offset < (MARKER_BLOCK_SIZE * sizeof b->markers[0])
&& (b != marker_block
@@ -4129,9 +4160,9 @@
buffer because checking that dereferences the pointer
PO which might point anywhere. */
if (live_vector_p (m, po))
- mark_p = !SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj));
+ mark_p = !VECTOR_MARKED_P (XVECTOR (obj));
else if (live_buffer_p (m, po))
- mark_p = BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj));
+ mark_p = !VECTOR_MARKED_P (XBUFFER (obj));
break;
case Lisp_Misc:
@@ -4220,7 +4251,7 @@
{
Lisp_Object tem;
XSETVECTOR (tem, p);
- if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))
+ if (!VECTOR_MARKED_P (XVECTOR (tem)))
obj = tem;
}
break;
@@ -4230,7 +4261,11 @@
}
if (!NILP (obj))
+#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
+ mark_maybe_object (obj);
+#else
mark_object (obj);
+#endif
}
}
@@ -4400,7 +4435,7 @@
if (!survives_gc_p (p->var[i]))
/* FIXME: It's not necessarily a bug. It might just be that the
GCPRO is unnecessary or should release the object sooner. */
- abort ();
+ /* abort () */;
}
#elif GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
@@ -4799,14 +4834,21 @@
{
Lisp_Object string;
struct Lisp_String *s;
+ char *puredata = (unsigned char *) find_string_data_in_pure (data, nbytes);
+ if (puredata)
+ {
s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
- s->data = (unsigned char *) find_string_data_in_pure (data, nbytes);
- if (s->data == NULL)
+ s->inlined = 0;
+ s->data.ptr = puredata;
+ }
+ else
{
- s->data = (unsigned char *) pure_alloc (nbytes + 1, -1);
- memcpy (s->data, data, nbytes);
- s->data[nbytes] = '\0';
+ s = (struct Lisp_String *) pure_alloc (sizeof *s - sizeof (char *)
+ + nbytes + 1, Lisp_String);
+ s->inlined = 1;
+ memcpy (STRING_DATA (s), data, nbytes);
+ STRING_DATA (s)[nbytes] = '\0';
}
s->size = nchars;
s->size_byte = multibyte ? nbytes : -1;
@@ -4826,14 +4868,24 @@
EMACS_INT nchars = strlen (data);
s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
+ s->inlined = 0;
s->size = nchars;
s->size_byte = -1;
- s->data = (unsigned char *) data;
+ s->data.ptr = data;
s->intervals = NULL_INTERVAL;
XSETSTRING (string, s);
return string;
}
+void CHECK_HASHCONS (Lisp_Object x)
+{
+ if (HASH_TABLE_P (Vpurify_flag))
+ {
+ if (!NILP (x) && EQ (x, Fgethash (x, Vpurify_flag, Qnil)))
+ error ("modifying hashcons'd object");
+ }
+}
+
/* Return a cons allocated from pure space. Give it pure copies
of CAR as car and CDR as cdr. */
@@ -4845,8 +4897,8 @@
p = (struct Lisp_Cons *) pure_alloc (sizeof *p, Lisp_Cons);
XSETCONS (new, p);
- XSETCAR (new, Fpurecopy (car));
- XSETCDR (new, Fpurecopy (cdr));
+ XSETCAR_UNCHECKED (new, Fpurecopy (car));
+ XSETCDR_UNCHECKED (new, Fpurecopy (cdr));
return new;
}
@@ -4983,7 +5035,8 @@
`gc-cons-threshold' bytes of Lisp data since previous garbage collection.
`garbage-collect' normally returns a list with info on amount of space in use:
((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
- (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
+ (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS
+ (USED-VECTORS . USED-VECTOR-SLOTS)
(USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS)
(USED-STRINGS . FREE-STRINGS))
However, if there was overflow in pure space, `garbage-collect'
@@ -5205,7 +5258,6 @@
unmark_byte_stack ();
VECTOR_UNMARK (&buffer_defaults);
- VECTOR_UNMARK (&buffer_local_symbols);
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES && 0
dump_zombies ();
@@ -5263,7 +5315,8 @@
total[2] = Fcons (make_number (total_markers),
make_number (total_free_markers));
total[3] = make_number (total_string_size);
- total[4] = make_number (total_vector_size);
+ total[4] = Fcons (make_number (total_vectors),
+ make_number (total_vector_size));
total[5] = Fcons (make_number (total_floats),
make_number (total_free_floats));
total[6] = Fcons (make_number (total_intervals),
@@ -5366,12 +5419,19 @@
static Lisp_Object last_marked[LAST_MARKED_SIZE];
static int last_marked_index;
+long stef_foo1 = PSEUDOVECTOR_FLAG;
+long stef_foo2 = ARRAY_MARK_FLAG;
+
/* For debugging--call abort when we cdr down this many
links of a list, in mark_object. In debugging,
the call to abort will hit a breakpoint.
Normally this is zero and the check never goes off. */
ptrdiff_t mark_object_loop_halt EXTERNALLY_VISIBLE;
+#if ! GC_MARK_STACK
+#undef GC_CHECK_MARKED_OBJECTS
+#endif
+
static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
@@ -5422,13 +5482,14 @@
void
mark_object (Lisp_Object arg)
{
- register Lisp_Object obj = arg;
+ register Lisp_Object obj;
#ifdef GC_CHECK_MARKED_OBJECTS
void *po;
struct mem_node *m;
#endif
ptrdiff_t cdr_count = 0;
+ obj = arg;
loop:
if (PURE_POINTER_P (XPNTR (obj)))
@@ -5497,18 +5558,25 @@
case Lisp_Vectorlike:
if (VECTOR_MARKED_P (XVECTOR (obj)))
break;
+ /* if (!GC_SUBRP (obj))
+ * /\* Subroutines are not swept, so the mark bit is never reset,
+ * so if we ever set it, everywhere where SUBRP is used instead
+ * of GC_SUBRP will lose. *\/
+ * VECTOR_MARK (XVECTOR (obj)); */
#ifdef GC_CHECK_MARKED_OBJECTS
m = mem_find (po);
if (m == MEM_NIL && !SUBRP (obj)
- && po != &buffer_defaults
- && po != &buffer_local_symbols)
+ /* b->name == 0 is for special (static) pseudo-buffers. */
+ && !(BUFFERP (obj)
+ && EQ (((struct buffer *)po)->name, make_number (0))))
abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */
if (BUFFERP (obj))
{
#ifdef GC_CHECK_MARKED_OBJECTS
- if (po != &buffer_defaults && po != &buffer_local_symbols)
+ /* b->name == 0 is for static pseudo-buffers. */
+ if (!EQ (((struct buffer *)po)->name, make_number (0)))
{
struct buffer *b;
for (b = all_buffers; b && b != po; b = b->header.next.buffer)
@@ -5520,7 +5588,11 @@
mark_buffer (obj);
}
else if (SUBRP (obj))
+ {
+ /* This seems dangerous, but seems to work. */
+ VECTOR_MARK (XVECTOR (obj));
break;
+ }
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
@@ -5530,8 +5602,8 @@
int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
int i;
- CHECK_LIVE (live_vector_p);
VECTOR_MARK (ptr); /* Else mark it */
+ CHECK_LIVE (live_vector_p);
for (i = 0; i < size; i++) /* and then mark its elements */
{
if (i != COMPILED_CONSTANTS)
@@ -5548,9 +5620,8 @@
}
else if (WINDOWP (obj))
{
- register struct Lisp_Vector *ptr = XVECTOR (obj);
struct window *w = XWINDOW (obj);
- mark_vectorlike (ptr);
+ mark_vectorlike (XVECTOR (obj));
/* Mark glyphs for leaf windows. Marking window matrices is
sufficient because frame matrices use the same glyph
memory. */
@@ -5620,9 +5691,9 @@
break;
default: abort ();
}
- if (!PURE_POINTER_P (XSTRING (ptr->xname)))
- MARK_STRING (XSTRING (ptr->xname));
- MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname));
+ if (!PURE_POINTER_P (ptr->name))
+ MARK_STRING (ptr->name);
+ MARK_INTERVAL_TREE (ptr->name->intervals);
ptr = ptr->next;
if (ptr)
@@ -5655,6 +5726,7 @@
register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj);
/* If DOGC is set, POINTER is the address of a memory
area containing INTEGER potential Lisp_Objects. */
+#if GC_MARK_STACK
if (ptr->dogc)
{
Lisp_Object *p = (Lisp_Object *) ptr->pointer;
@@ -5662,6 +5734,7 @@
for (nelt = ptr->integer; nelt > 0; nelt--, p++)
mark_maybe_object (*p);
}
+#endif
}
#endif
break;
@@ -5674,6 +5747,7 @@
mark_object (ptr->plist);
if (ptr->next)
{
+ /* FIXME: This is inefficient. */
XSETMISC (obj, ptr->next);
goto loop;
}
@@ -6046,7 +6120,7 @@
/* Check if the symbol was created during loadup. In such a case
it might be pointed to by pure bytecode which we don't trace,
so we conservatively assume that it is live. */
- int pure_p = PURE_POINTER_P (XSTRING (sym->xname));
+ int pure_p = PURE_POINTER_P (sym->name);
if (!sym->gcmarkbit && !pure_p)
{
@@ -6063,7 +6137,7 @@
{
++num_used;
if (!pure_p)
- UNMARK_STRING (XSTRING (sym->xname));
+ UNMARK_STRING (sym->name);
sym->gcmarkbit = 0;
}
}
@@ -6099,6 +6173,19 @@
marker_free_list = 0;
+ for (mblk = marker_block; mblk; mblk = mblk->next)
+ {
+ register int i;
+
+ for (i = 0; i < lim; i++)
+ if (mblk->markers[i].u_overlay.gcmarkbit)
+ eassert (mblk->markers[i].u_marker.type != Lisp_Misc_Overlay
+ || !mblk->markers[i].u_overlay.next
+ || mblk->markers[i].u_overlay.next->gcmarkbit);
+ lim = MARKER_BLOCK_SIZE;
+ }
+ lim = marker_block_index;
+
for (mblk = marker_block; mblk; mblk = *mprev)
{
register int i;
@@ -6173,6 +6260,7 @@
{
register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next;
total_vector_size = 0;
+ total_vectors = 0;
while (vector)
if (!VECTOR_MARKED_P (vector))
@@ -6193,6 +6281,7 @@
total_vector_size += PSEUDOVECTOR_SIZE_MASK & vector->header.size;
else
total_vector_size += vector->header.size;
+ total_vectors++;
prev = vector, vector = vector->header.next.vector;
}
}
@@ -6311,7 +6400,7 @@
}
#endif
-/* Initialization */
+/* Initialization. */
void
init_alloc_once (void)
@@ -6323,8 +6412,16 @@
pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
pure_bytes_used_before_overflow = 0;
+ {
+ int i;
+ for (i = 0; i < 50; i++)
+ alloc_hist[i] = 0;
+ }
+
+#ifndef HAVE_GOOD_POSIX_MEMALIGN
/* Initialize the list of free aligned blocks. */
free_ablock = NULL;
+#endif
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
mem_init ();
@@ -6377,6 +6474,19 @@
gcs_done = 0;
}
+DEFUN ("alloc-hist", Falloc_hist, Salloc_hist, 0, 0, 0, doc: /* */)
+ (void)
+{
+ Lisp_Object l = Qnil;
+ int i;
+ for (i = 40; i > 0; i--)
+ if (alloc_hist[i])
+ l = Fcons (Fcons (make_number (i < 16 ? i : 16 * (1 << (i - 16))),
+ make_number (alloc_hist[i])),
+ l);
+ return l;
+}
+
void
syms_of_alloc (void)
{
@@ -6475,6 +6585,7 @@
defsubr (&Sgarbage_collect);
defsubr (&Smemory_limit);
defsubr (&Smemory_use_counts);
+ defsubr (&Salloc_hist);
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
defsubr (&Sgc_status);
- immediate strings, Dmitry Antipov, 2011/11/25
- Re: immediate strings, Andreas Schwab, 2011/11/26
- Re: immediate strings, Paul Eggert, 2011/11/26
- Re: immediate strings, Eli Zaretskii, 2011/11/26
- Re: immediate strings,
Stefan Monnier <=
- Re: immediate strings, Dmitry Antipov, 2011/11/26
- Re: immediate strings, Paul Eggert, 2011/11/26
- --with-wide-int, Stefan Monnier, 2011/11/27
- Re: --with-wide-int, Paul Eggert, 2011/11/28
- Re: --with-wide-int, Stefan Monnier, 2011/11/28
- Re: --with-wide-int, Dan Nicolaescu, 2011/11/28
- Re: --with-wide-int, Eli Zaretskii, 2011/11/28
- Re: --with-wide-int, Stefan Monnier, 2011/11/28
- Re: --with-wide-int, Stephen J. Turnbull, 2011/11/28
- Re: --with-wide-int, Paul Eggert, 2011/11/29