procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Use alignas to fix GCALIGN-related bugs

Browse source 
Use alignas and unions to specify alignments of objects needing
addresses that are at least a multiple of GCALIGNMENT.  Using
these standard C facilities should be safer than relying on ad hoc
and poorly-understood features like GCC’s __attribute__
((aligned (N))), the root cause for recent porting bugs like
Bug#29040.  The alignas macro was standardized by C11 and Gnulib
supports alignas for pre-C11 platforms.  I have tested this on Sun
Studio 12 sparc (2007) and GCC 4.4.7 x86-64 (2012) as well as on
more recent platforms like GCC 7.2.1 (2017) on Fedora 26 (both
x86-64 and x86).
* lib-src/make-docfile.c (close_emacs_globals): lispsym is now
just an array of struct Lisp_Symbol, since struct Lisp_Symbol is
now properly aligned.  All uses changed.
* src/alloc.c (NEXT_FREE_LISP_STRING): Just use the new u.next
member; this is simpler and safer than casting a pointer that
might not be aligned properly.
(aligned_Lisp_Symbol): Remove.  No longer needed, now that struct
Lisp_Symbol is aligned properly.  All uses replaced with struct
Lisp_Symbol.
* src/lisp.h (GCALIGNED): Remove, as it does not work as expected:
it can cause the natural alignment to be ignored.  All uses
replaced by unions with a ‘char alignas (GCALIGNMENT)’ member as
described below.
(struct Lisp_Symbol, struct Lisp_Cons, struct Lisp_String):
Change definition from ‘struct TAG { MEMBERS };’ to
‘struct TAG { union { struct { MEMBERS } s; char alignas
(GCALIGNMENT) gcaligned; } u; };’.  This guarantees ‘struct TAG’
to have an alignment that at least max (GCALIGNMENT, N) where N is
its old alignment.  All uses like ‘PTR->MEMBER’ changed to
‘PTR->u.s.MEMBER’; these uses were supposed to be mostly private
anyway.  Verify that the resulting ‘struct TAG’ is properly
aligned for Emacs.
(union vectorlike_header): New member ‘gcaligned’ to guarantee
that this type, and its containing types like ‘struct Lisp_Subr’,
‘struct buffer’ and ‘struct thread_state’, are all properly
aligned for Emacs.
(struct Lisp_String): New union member ‘next’, for the benefit
of NEXT_FREE_LISP_STRING.
(union Aligned_Cons, union Aligned_String): Remove.  All uses
replaced by struct Lisp_Cons and struct Lisp_String, since they
are now properly aligned.
(USE_STACK_CONS, USE_STACK_STRING): Simplify now that we can
assume struct Lisp_Cons and struct Lisp_String are properly
aligned.
This commit is contained in:
Paul Eggert 2017-11-13 08:51:41 -08:00
parent 5d68dc9a2f
commit b1573a97e1
16 changed files with 358 additions and 368 deletions
Download patch file Download diff file Expand all files Collapse all files

4
lib-src/make-docfile.c
View file

@ -667,9 +667,7 @@ close_emacs_globals (ptrdiff_t num_symbols)
"#ifndef DEFINE_SYMBOLS\n" "#ifndef DEFINE_SYMBOLS\n"
"extern\n" "extern\n"
"#endif\n" "#endif\n"
"struct {\n" "struct Lisp_Symbol lispsym[%td];\n"),
" struct GCALIGNED Lisp_Symbol s;\n"
"} lispsym[%td];\n"),
num_symbols); num_symbols);
} }

211
src/alloc.c
View file

@ -211,9 +211,9 @@ alloc_unexec_post (void)
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer /* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */ to a struct Lisp_String. */
#define MARK_STRING(S) ((S)->size |= ARRAY_MARK_FLAG) #define MARK_STRING(S) ((S)->u.s.size |= ARRAY_MARK_FLAG)
#define UNMARK_STRING(S) ((S)->size &= ~ARRAY_MARK_FLAG) #define UNMARK_STRING(S) ((S)->u.s.size &= ~ARRAY_MARK_FLAG)
#define STRING_MARKED_P(S) (((S)->size & ARRAY_MARK_FLAG) != 0) #define STRING_MARKED_P(S) (((S)->u.s.size & ARRAY_MARK_FLAG) != 0)
#define VECTOR_MARK(V) ((V)->header.size |= ARRAY_MARK_FLAG) #define VECTOR_MARK(V) ((V)->header.size |= ARRAY_MARK_FLAG)
#define VECTOR_UNMARK(V) ((V)->header.size &= ~ARRAY_MARK_FLAG) #define VECTOR_UNMARK(V) ((V)->header.size &= ~ARRAY_MARK_FLAG)
@ -1730,14 +1730,14 @@ static EMACS_INT total_string_bytes;
string_free_list, return a pointer to its successor in the string_free_list, return a pointer to its successor in the
free-list. */ free-list. */
#define NEXT_FREE_LISP_STRING(S) (*(struct Lisp_String **) (S)) #define NEXT_FREE_LISP_STRING(S) ((S)->u.next)
/* Return a pointer to the sdata structure belonging to Lisp string S. /* Return a pointer to the sdata structure belonging to Lisp string S.
S must be live, i.e. S->data must not be null. S->data is actually S must be live, i.e. S->data must not be null. S->data is actually
a pointer to the `u.data' member of its sdata structure; the a pointer to the `u.data' member of its sdata structure; the
structure starts at a constant offset in front of that. */ structure starts at a constant offset in front of that. */
#define SDATA_OF_STRING(S) ((sdata *) ((S)->data - SDATA_DATA_OFFSET)) #define SDATA_OF_STRING(S) ((sdata *) ((S)->u.s.data - SDATA_DATA_OFFSET))
#ifdef GC_CHECK_STRING_OVERRUN #ifdef GC_CHECK_STRING_OVERRUN
@ -1818,9 +1818,10 @@ ptrdiff_t
string_bytes (struct Lisp_String *s) string_bytes (struct Lisp_String *s)
{ {
ptrdiff_t nbytes = ptrdiff_t nbytes =
(s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte); (s->u.s.size_byte < 0 ? s->u.s.size & ~ARRAY_MARK_FLAG : s->u.s.size_byte);
if (!PURE_P (s) && s->data && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) if (!PURE_P (s) && s->u.s.data
&& nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
emacs_abort (); emacs_abort ();
return nbytes; return nbytes;
} }
@ -1926,7 +1927,7 @@ allocate_string (void)
{ {
s = b->strings + i; s = b->strings + i;
/* Every string on a free list should have NULL data pointer. */ /* Every string on a free list should have NULL data pointer. */
s->data = NULL; s->u.s.data = NULL;
NEXT_FREE_LISP_STRING (s) = string_free_list; NEXT_FREE_LISP_STRING (s) = string_free_list;
string_free_list = s; string_free_list = s;
} }
@ -1965,10 +1966,10 @@ allocate_string (void)
/* Set up Lisp_String S for holding NCHARS characters, NBYTES bytes, /* 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 plus a NUL byte at the end. Allocate an sdata structure DATA for
set S->data to its `u.data' member. Store a NUL byte at the end of S, and set S->u.s.data to SDATA->u.data. Store a NUL byte at the
S->data. Set S->size to NCHARS and S->size_byte to NBYTES. Free end of S->u.s.data. Set S->u.s.size to NCHARS and S->u.s.size_byte
S->data if it was initially non-null. */ to NBYTES. Free S->u.s.data if it was initially non-null. */
void void
allocate_string_data (struct Lisp_String *s, allocate_string_data (struct Lisp_String *s,
@ -1984,7 +1985,7 @@ allocate_string_data (struct Lisp_String *s,
/* Determine the number of bytes needed to store NBYTES bytes /* Determine the number of bytes needed to store NBYTES bytes
of string data. */ of string data. */
needed = SDATA_SIZE (nbytes); needed = SDATA_SIZE (nbytes);
if (s->data) if (s->u.s.data)
{ {
old_data = SDATA_OF_STRING (s); old_data = SDATA_OF_STRING (s);
old_nbytes = STRING_BYTES (s); old_nbytes = STRING_BYTES (s);
@ -2043,13 +2044,13 @@ allocate_string_data (struct Lisp_String *s,
MALLOC_UNBLOCK_INPUT; MALLOC_UNBLOCK_INPUT;
s->data = SDATA_DATA (data); s->u.s.data = SDATA_DATA (data);
#ifdef GC_CHECK_STRING_BYTES #ifdef GC_CHECK_STRING_BYTES
SDATA_NBYTES (data) = nbytes; SDATA_NBYTES (data) = nbytes;
#endif #endif
s->size = nchars; s->u.s.size = nchars;
s->size_byte = nbytes; s->u.s.size_byte = nbytes;
s->data[nbytes] = '\0'; s->u.s.data[nbytes] = '\0';
#ifdef GC_CHECK_STRING_OVERRUN #ifdef GC_CHECK_STRING_OVERRUN
memcpy ((char *) data + needed, string_overrun_cookie, memcpy ((char *) data + needed, string_overrun_cookie,
GC_STRING_OVERRUN_COOKIE_SIZE); GC_STRING_OVERRUN_COOKIE_SIZE);
@ -2093,7 +2094,7 @@ sweep_strings (void)
{ {
struct Lisp_String *s = b->strings + i; struct Lisp_String *s = b->strings + i;
if (s->data) if (s->u.s.data)
{ {
/* String was not on free-list before. */ /* String was not on free-list before. */
if (STRING_MARKED_P (s)) if (STRING_MARKED_P (s))
@ -2102,7 +2103,7 @@ sweep_strings (void)
UNMARK_STRING (s); UNMARK_STRING (s);
/* Do not use string_(set|get)_intervals here. */ /* Do not use string_(set|get)_intervals here. */
s->intervals = balance_intervals (s->intervals); s->u.s.intervals = balance_intervals (s->u.s.intervals);
++total_strings; ++total_strings;
total_string_bytes += STRING_BYTES (s); total_string_bytes += STRING_BYTES (s);
@ -2125,7 +2126,7 @@ sweep_strings (void)
/* Reset the strings's `data' member so that we /* Reset the strings's `data' member so that we
know it's free. */ know it's free. */
s->data = NULL; s->u.s.data = NULL;
/* Put the string on the free-list. */ /* Put the string on the free-list. */
NEXT_FREE_LISP_STRING (s) = string_free_list; NEXT_FREE_LISP_STRING (s) = string_free_list;
@ -2264,7 +2265,7 @@ compact_small_strings (void)
{ {
eassert (tb != b || to < from); eassert (tb != b || to < from);
memmove (to, from, nbytes + GC_STRING_EXTRA); memmove (to, from, nbytes + GC_STRING_EXTRA);
to->string->data = SDATA_DATA (to); to->string->u.s.data = SDATA_DATA (to);
} }
/* Advance past the sdata we copied to. */ /* Advance past the sdata we copied to. */
@ -2544,7 +2545,7 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
return empty_multibyte_string; return empty_multibyte_string;
s = allocate_string (); s = allocate_string ();
s->intervals = NULL; s->u.s.intervals = NULL;
allocate_string_data (s, nchars, nbytes); allocate_string_data (s, nchars, nbytes);
XSETSTRING (string, s); XSETSTRING (string, s);
string_chars_consed += nbytes; string_chars_consed += nbytes;
@ -2729,8 +2730,8 @@ static struct Lisp_Cons *cons_free_list;
void void
free_cons (struct Lisp_Cons *ptr) free_cons (struct Lisp_Cons *ptr)
{ {
ptr->u.chain = cons_free_list; ptr->u.s.u.chain = cons_free_list;
ptr->car = Vdead; ptr->u.s.car = Vdead;
cons_free_list = ptr; cons_free_list = ptr;
consing_since_gc -= sizeof *ptr; consing_since_gc -= sizeof *ptr;
total_free_conses++; total_free_conses++;
@ -2749,7 +2750,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
/* We use the cdr for chaining the free list /* We use the cdr for chaining the free list
so that we won't use the same field that has the mark bit. */ so that we won't use the same field that has the mark bit. */
XSETCONS (val, cons_free_list); XSETCONS (val, cons_free_list);
cons_free_list = cons_free_list->u.chain; cons_free_list = cons_free_list->u.s.u.chain;
} }
else else
{ {
@ -2786,7 +2787,7 @@ check_cons_list (void)
struct Lisp_Cons *tail = cons_free_list; struct Lisp_Cons *tail = cons_free_list;
while (tail) while (tail)
tail = tail->u.chain; tail = tail->u.s.u.chain;
} }
#endif #endif
@ -3543,27 +3544,17 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
Symbol Allocation Symbol Allocation
***********************************************************************/ ***********************************************************************/
/* Like struct Lisp_Symbol, but padded so that the size is a multiple
of the required alignment. */
union aligned_Lisp_Symbol
{
struct Lisp_Symbol s;
unsigned char c[(sizeof (struct Lisp_Symbol) + GCALIGNMENT - 1)
& -GCALIGNMENT];
};
/* Each symbol_block is just under 1020 bytes long, since malloc /* Each symbol_block is just under 1020 bytes long, since malloc
really allocates in units of powers of two and uses 4 bytes for its really allocates in units of powers of two and uses 4 bytes for its
own overhead. */ own overhead. */
#define SYMBOL_BLOCK_SIZE \ #define SYMBOL_BLOCK_SIZE \
((1020 - sizeof (struct symbol_block *)) / sizeof (union aligned_Lisp_Symbol)) ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol))
struct symbol_block struct symbol_block
{ {
/* Place `symbols' first, to preserve alignment. */ /* Place `symbols' first, to preserve alignment. */
union aligned_Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE]; struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
struct symbol_block *next; struct symbol_block *next;
}; };
@ -3587,7 +3578,7 @@ static struct Lisp_Symbol *symbol_free_list;
static void static void
set_symbol_name (Lisp_Object sym, Lisp_Object name) set_symbol_name (Lisp_Object sym, Lisp_Object name)
{ {
XSYMBOL (sym)->name = name; XSYMBOL (sym)->u.s.name = name;
} }
void void
@ -3596,15 +3587,15 @@ init_symbol (Lisp_Object val, Lisp_Object name)
struct Lisp_Symbol *p = XSYMBOL (val); struct Lisp_Symbol *p = XSYMBOL (val);
set_symbol_name (val, name); set_symbol_name (val, name);
set_symbol_plist (val, Qnil); set_symbol_plist (val, Qnil);
p->redirect = SYMBOL_PLAINVAL; p->u.s.redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (p, Qunbound); SET_SYMBOL_VAL (p, Qunbound);
set_symbol_function (val, Qnil); set_symbol_function (val, Qnil);
set_symbol_next (val, NULL); set_symbol_next (val, NULL);
p->gcmarkbit = false; p->u.s.gcmarkbit = false;
p->interned = SYMBOL_UNINTERNED; p->u.s.interned = SYMBOL_UNINTERNED;
p->trapped_write = SYMBOL_UNTRAPPED_WRITE; p->u.s.trapped_write = SYMBOL_UNTRAPPED_WRITE;
p->declared_special = false; p->u.s.declared_special = false;
p->pinned = false; p->u.s.pinned = false;
} }
DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
@ -3621,7 +3612,7 @@ Its value is void, and its function definition and property list are nil. */)
if (symbol_free_list) if (symbol_free_list)
{ {
XSETSYMBOL (val, symbol_free_list); XSETSYMBOL (val, symbol_free_list);
symbol_free_list = symbol_free_list->next; symbol_free_list = symbol_free_list->u.s.next;
} }
else else
{ {
@ -3634,7 +3625,7 @@ Its value is void, and its function definition and property list are nil. */)
symbol_block_index = 0; symbol_block_index = 0;
total_free_symbols += SYMBOL_BLOCK_SIZE; total_free_symbols += SYMBOL_BLOCK_SIZE;
} }
XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index].s); XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
symbol_block_index++; symbol_block_index++;
} }
@ -4587,7 +4578,7 @@ live_string_holding (struct mem_node *m, void *p)
if (0 <= offset && offset < STRING_BLOCK_SIZE * sizeof b->strings[0]) if (0 <= offset && offset < STRING_BLOCK_SIZE * sizeof b->strings[0])
{ {
struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0]; struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0];
if (s->data) if (s->u.s.data)
return make_lisp_ptr (s, Lisp_String); return make_lisp_ptr (s, Lisp_String);
} }
} }
@ -4621,7 +4612,7 @@ live_cons_holding (struct mem_node *m, void *p)
|| offset / sizeof b->conses[0] < cons_block_index)) || offset / sizeof b->conses[0] < cons_block_index))
{ {
struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0]; struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0];
if (!EQ (s->car, Vdead)) if (!EQ (s->u.s.car, Vdead))
return make_lisp_ptr (s, Lisp_Cons); return make_lisp_ptr (s, Lisp_Cons);
} }
} }
@ -4656,7 +4647,7 @@ live_symbol_holding (struct mem_node *m, void *p)
|| offset / sizeof b->symbols[0] < symbol_block_index)) || offset / sizeof b->symbols[0] < symbol_block_index))
{ {
struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0]; struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0];
if (!EQ (s->function, Vdead)) if (!EQ (s->u.s.function, Vdead))
return make_lisp_symbol (s); return make_lisp_symbol (s);
} }
} }
@ -4984,7 +4975,7 @@ mark_memory (void *start, void *end)
Lisp_Object obj = build_string ("test"); Lisp_Object obj = build_string ("test");
struct Lisp_String *s = XSTRING (obj); struct Lisp_String *s = XSTRING (obj);
Fgarbage_collect (); Fgarbage_collect ();
fprintf (stderr, "test '%s'\n", s->data); fprintf (stderr, "test '%s'\n", s->u.s.data);
return Qnil; return Qnil;
} }
@ -5484,16 +5475,16 @@ make_pure_string (const char *data,
{ {
Lisp_Object string; Lisp_Object string;
struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
s->data = (unsigned char *) find_string_data_in_pure (data, nbytes); s->u.s.data = (unsigned char *) find_string_data_in_pure (data, nbytes);
if (s->data == NULL) if (s->u.s.data == NULL)
{ {
s->data = pure_alloc (nbytes + 1, -1); s->u.s.data = pure_alloc (nbytes + 1, -1);
memcpy (s->data, data, nbytes); memcpy (s->u.s.data, data, nbytes);
s->data[nbytes] = '\0'; s->u.s.data[nbytes] = '\0';
} }
s->size = nchars; s->u.s.size = nchars;
s->size_byte = multibyte ? nbytes : -1; s->u.s.size_byte = multibyte ? nbytes : -1;
s->intervals = NULL; s->u.s.intervals = NULL;
XSETSTRING (string, s); XSETSTRING (string, s);
return string; return string;
} }
@ -5506,10 +5497,10 @@ make_pure_c_string (const char *data, ptrdiff_t nchars)
{ {
Lisp_Object string; Lisp_Object string;
struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
s->size = nchars; s->u.s.size = nchars;
s->size_byte = -1; s->u.s.size_byte = -1;
s->data = (unsigned char *) data; s->u.s.data = (unsigned char *) data;
s->intervals = NULL; s->u.s.intervals = NULL;
XSETSTRING (string, s); XSETSTRING (string, s);
return string; return string;
} }
@ -5620,7 +5611,7 @@ purecopy (Lisp_Object obj)
|| SUBRP (obj)) || SUBRP (obj))
return obj; /* Already pure. */ return obj; /* Already pure. */
if (STRINGP (obj) && XSTRING (obj)->intervals) if (STRINGP (obj) && XSTRING (obj)->u.s.intervals)
message_with_string ("Dropping text-properties while making string `%s' pure", message_with_string ("Dropping text-properties while making string `%s' pure",
obj, true); obj, true);
@ -5675,10 +5666,10 @@ purecopy (Lisp_Object obj)
} }
else if (SYMBOLP (obj)) else if (SYMBOLP (obj))
{ {
if (!XSYMBOL (obj)->pinned && !c_symbol_p (XSYMBOL (obj))) if (!XSYMBOL (obj)->u.s.pinned && !c_symbol_p (XSYMBOL (obj)))
{ /* We can't purify them, but they appear in many pure objects. { /* We can't purify them, but they appear in many pure objects.
Mark them as `pinned' so we know to mark them at every GC cycle. */ Mark them as `pinned' so we know to mark them at every GC cycle. */
XSYMBOL (obj)->pinned = true; XSYMBOL (obj)->u.s.pinned = true;
symbol_block_pinned = symbol_block; symbol_block_pinned = symbol_block;
} }
/* Don't hash-cons it. */ /* Don't hash-cons it. */
@ -5891,10 +5882,10 @@ mark_pinned_symbols (void)
for (sblk = symbol_block_pinned; sblk; sblk = sblk->next) for (sblk = symbol_block_pinned; sblk; sblk = sblk->next)
{ {
union aligned_Lisp_Symbol *sym = sblk->symbols, *end = sym + lim; struct Lisp_Symbol *sym = sblk->symbols, *end = sym + lim;
for (; sym < end; ++sym) for (; sym < end; ++sym)
if (sym->s.pinned) if (sym->u.s.pinned)
mark_object (make_lisp_symbol (&sym->s)); mark_object (make_lisp_symbol (sym));
lim = SYMBOL_BLOCK_SIZE; lim = SYMBOL_BLOCK_SIZE;
} }
@ -6256,7 +6247,7 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype)
{ {
Lisp_Object val = ptr->contents[i]; Lisp_Object val = ptr->contents[i];
if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->gcmarkbit)) if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->u.s.gcmarkbit))
continue; continue;
if (SUB_CHAR_TABLE_P (val)) if (SUB_CHAR_TABLE_P (val))
{ {
@ -6499,7 +6490,7 @@ mark_object (Lisp_Object arg)
break; break;
CHECK_ALLOCATED_AND_LIVE (live_string_p); CHECK_ALLOCATED_AND_LIVE (live_string_p);
MARK_STRING (ptr); MARK_STRING (ptr);
MARK_INTERVAL_TREE (ptr->intervals); MARK_INTERVAL_TREE (ptr->u.s.intervals);
#ifdef GC_CHECK_STRING_BYTES #ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the /* 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. */
@ -6640,17 +6631,17 @@ mark_object (Lisp_Object arg)
case Lisp_Symbol: case Lisp_Symbol:
{ {
register struct Lisp_Symbol *ptr = XSYMBOL (obj); struct Lisp_Symbol *ptr = XSYMBOL (obj);
nextsym: nextsym:
if (ptr->gcmarkbit) if (ptr->u.s.gcmarkbit)
break; break;
CHECK_ALLOCATED_AND_LIVE_SYMBOL (); CHECK_ALLOCATED_AND_LIVE_SYMBOL ();
ptr->gcmarkbit = 1; ptr->u.s.gcmarkbit = 1;
/* Attempt to catch bogus objects. */ /* Attempt to catch bogus objects. */
eassert (valid_lisp_object_p (ptr->function)); eassert (valid_lisp_object_p (ptr->u.s.function));
mark_object (ptr->function); mark_object (ptr->u.s.function);
mark_object (ptr->plist); mark_object (ptr->u.s.plist);
switch (ptr->redirect) switch (ptr->u.s.redirect)
{ {
case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break; case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break;
case SYMBOL_VARALIAS: case SYMBOL_VARALIAS:
@ -6671,11 +6662,11 @@ mark_object (Lisp_Object arg)
break; break;
default: emacs_abort (); default: emacs_abort ();
} }
if (!PURE_P (XSTRING (ptr->name))) if (!PURE_P (XSTRING (ptr->u.s.name)))
MARK_STRING (XSTRING (ptr->name)); MARK_STRING (XSTRING (ptr->u.s.name));
MARK_INTERVAL_TREE (string_intervals (ptr->name)); MARK_INTERVAL_TREE (string_intervals (ptr->u.s.name));
/* Inner loop to mark next symbol in this bucket, if any. */ /* Inner loop to mark next symbol in this bucket, if any. */
po = ptr = ptr->next; po = ptr = ptr->u.s.next;
if (ptr) if (ptr)
goto nextsym; goto nextsym;
} }
@ -6729,14 +6720,14 @@ mark_object (Lisp_Object arg)
CHECK_ALLOCATED_AND_LIVE (live_cons_p); CHECK_ALLOCATED_AND_LIVE (live_cons_p);
CONS_MARK (ptr); CONS_MARK (ptr);
/* If the cdr is nil, avoid recursion for the car. */ /* If the cdr is nil, avoid recursion for the car. */
if (EQ (ptr->u.cdr, Qnil)) if (EQ (ptr->u.s.u.cdr, Qnil))
{ {
obj = ptr->car; obj = ptr->u.s.car;
cdr_count = 0; cdr_count = 0;
goto loop; goto loop;
} }
mark_object (ptr->car); mark_object (ptr->u.s.car);
obj = ptr->u.cdr; obj = ptr->u.s.u.cdr;
cdr_count++; cdr_count++;
if (cdr_count == mark_object_loop_halt) if (cdr_count == mark_object_loop_halt)
emacs_abort (); emacs_abort ();
@ -6797,7 +6788,7 @@ survives_gc_p (Lisp_Object obj)
break; break;
case Lisp_Symbol: case Lisp_Symbol:
survives_p = XSYMBOL (obj)->gcmarkbit; survives_p = XSYMBOL (obj)->u.s.gcmarkbit;
break; break;
case Lisp_Misc: case Lisp_Misc:
@ -6873,9 +6864,9 @@ sweep_conses (void)
if (!CONS_MARKED_P (&cblk->conses[pos])) if (!CONS_MARKED_P (&cblk->conses[pos]))
{ {
this_free++; this_free++;
cblk->conses[pos].u.chain = cons_free_list; cblk->conses[pos].u.s.u.chain = cons_free_list;
cons_free_list = &cblk->conses[pos]; cons_free_list = &cblk->conses[pos];
cons_free_list->car = Vdead; cons_free_list->u.s.car = Vdead;
} }
else else
{ {
@ -6894,7 +6885,7 @@ sweep_conses (void)
{ {
*cprev = cblk->next; *cprev = cblk->next;
/* Unhook from the free list. */ /* Unhook from the free list. */
cons_free_list = cblk->conses[0].u.chain; cons_free_list = cblk->conses[0].u.s.u.chain;
lisp_align_free (cblk); lisp_align_free (cblk);
} }
else else
@ -7018,39 +7009,39 @@ sweep_symbols (void)
symbol_free_list = NULL; symbol_free_list = NULL;
for (int i = 0; i < ARRAYELTS (lispsym); i++) for (int i = 0; i < ARRAYELTS (lispsym); i++)
lispsym[i].s.gcmarkbit = 0; lispsym[i].u.s.gcmarkbit = 0;
for (sblk = symbol_block; sblk; sblk = *sprev) for (sblk = symbol_block; sblk; sblk = *sprev)
{ {
int this_free = 0; int this_free = 0;
union aligned_Lisp_Symbol *sym = sblk->symbols; struct Lisp_Symbol *sym = sblk->symbols;
union aligned_Lisp_Symbol *end = sym + lim; struct Lisp_Symbol *end = sym + lim;
for (; sym < end; ++sym) for (; sym < end; ++sym)
{ {
if (!sym->s.gcmarkbit) if (!sym->u.s.gcmarkbit)
{ {
if (sym->s.redirect == SYMBOL_LOCALIZED) if (sym->u.s.redirect == SYMBOL_LOCALIZED)
{ {
xfree (SYMBOL_BLV (&sym->s)); xfree (SYMBOL_BLV (sym));
/* At every GC we sweep all symbol_blocks and rebuild the /* At every GC we sweep all symbol_blocks and rebuild the
symbol_free_list, so those symbols which stayed unused symbol_free_list, so those symbols which stayed unused
between the two will be re-swept. between the two will be re-swept.
So we have to make sure we don't re-free this blv next So we have to make sure we don't re-free this blv next
time we sweep this symbol_block (bug#29066). */ time we sweep this symbol_block (bug#29066). */
sym->s.redirect = SYMBOL_PLAINVAL; sym->u.s.redirect = SYMBOL_PLAINVAL;
} }
sym->s.next = symbol_free_list; sym->u.s.next = symbol_free_list;
symbol_free_list = &sym->s; symbol_free_list = sym;
symbol_free_list->function = Vdead; symbol_free_list->u.s.function = Vdead;
++this_free; ++this_free;
} }
else else
{ {
++num_used; ++num_used;
sym->s.gcmarkbit = 0; sym->u.s.gcmarkbit = 0;
/* Attempt to catch bogus objects. */ /* Attempt to catch bogus objects. */
eassert (valid_lisp_object_p (sym->s.function)); eassert (valid_lisp_object_p (sym->u.s.function));
} }
} }
@ -7062,7 +7053,7 @@ sweep_symbols (void)
{ {
*sprev = sblk->next; *sprev = sblk->next;
/* Unhook from the free list. */ /* Unhook from the free list. */
symbol_free_list = sblk->symbols[0].s.next; symbol_free_list = sblk->symbols[0].u.s.next;
lisp_free (sblk); lisp_free (sblk);
} }
else else
@ -7289,10 +7280,10 @@ symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj)
struct Lisp_Symbol *sym = XSYMBOL (symbol); struct Lisp_Symbol *sym = XSYMBOL (symbol);
Lisp_Object val = find_symbol_value (symbol); Lisp_Object val = find_symbol_value (symbol);
return (EQ (val, obj) return (EQ (val, obj)
|| EQ (sym->function, obj) || EQ (sym->u.s.function, obj)
|| (!NILP (sym->function) || (!NILP (sym->u.s.function)
&& COMPILEDP (sym->function) && COMPILEDP (sym->u.s.function)
&& EQ (AREF (sym->function, COMPILED_BYTECODE), obj)) && EQ (AREF (sym->u.s.function, COMPILED_BYTECODE), obj))
|| (!NILP (val) || (!NILP (val)
&& COMPILEDP (val) && COMPILEDP (val)
&& EQ (AREF (val, COMPILED_BYTECODE), obj))); && EQ (AREF (val, COMPILED_BYTECODE), obj)));
@ -7323,15 +7314,15 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max)
for (sblk = symbol_block; sblk; sblk = sblk->next) for (sblk = symbol_block; sblk; sblk = sblk->next)
{ {
union aligned_Lisp_Symbol *aligned_sym = sblk->symbols; struct Lisp_Symbol *asym = sblk->symbols;
int bn; int bn;
for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, aligned_sym++) for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, asym++)
{ {
if (sblk == symbol_block && bn >= symbol_block_index) if (sblk == symbol_block && bn >= symbol_block_index)
break; break;
Lisp_Object sym = make_lisp_symbol (&aligned_sym->s); Lisp_Object sym = make_lisp_symbol (asym);
if (symbol_uses_obj (sym, obj)) if (symbol_uses_obj (sym, obj))
{ {
found = Fcons (sym, found); found = Fcons (sym, found);

19
src/buffer.c
View file

@ -61,7 +61,7 @@ struct buffer *all_buffers;
Setting the default value also goes through the alist of buffers Setting the default value also goes through the alist of buffers
and stores into each buffer that does not say it has a local value. */ and stores into each buffer that does not say it has a local value. */
struct GCALIGNED buffer buffer_defaults; struct buffer buffer_defaults;
/* This structure marks which slots in a buffer have corresponding /* This structure marks which slots in a buffer have corresponding
default values in buffer_defaults. default values in buffer_defaults.
@ -84,7 +84,7 @@ struct buffer buffer_local_flags;
/* This structure holds the names of symbols whose values may be /* This structure holds the names of symbols whose values may be
buffer-local. It is indexed and accessed in the same way as the above. */ buffer-local. It is indexed and accessed in the same way as the above. */
struct GCALIGNED buffer buffer_local_symbols; struct buffer buffer_local_symbols;
/* Return the symbol of the per-buffer variable at offset OFFSET in /* Return the symbol of the per-buffer variable at offset OFFSET in
the buffer structure. */ the buffer structure. */
@ -1021,7 +1021,8 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
newlist = Fcons (elt, newlist); newlist = Fcons (elt, newlist);
} }
newlist = Fnreverse (newlist); newlist = Fnreverse (newlist);
if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE) if (XSYMBOL (local_var)->u.s.trapped_write
== SYMBOL_TRAPPED_WRITE)
notify_variable_watchers (local_var, newlist, notify_variable_watchers (local_var, newlist,
Qmakunbound, Fcurrent_buffer ()); Qmakunbound, Fcurrent_buffer ());
XSETCDR (XCAR (tmp), newlist); XSETCDR (XCAR (tmp), newlist);
@ -1034,7 +1035,7 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
else else
XSETCDR (last, XCDR (tmp)); XSETCDR (last, XCDR (tmp));
if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE) if (XSYMBOL (local_var)->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
notify_variable_watchers (local_var, Qnil, notify_variable_watchers (local_var, Qnil,
Qmakunbound, Fcurrent_buffer ()); Qmakunbound, Fcurrent_buffer ());
} }
@ -1166,7 +1167,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
sym = XSYMBOL (variable); sym = XSYMBOL (variable);
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break; case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
@ -2096,7 +2097,7 @@ void set_buffer_internal_2 (register struct buffer *b)
{ {
Lisp_Object var = XCAR (XCAR (tail)); Lisp_Object var = XCAR (XCAR (tail));
struct Lisp_Symbol *sym = XSYMBOL (var); struct Lisp_Symbol *sym = XSYMBOL (var);
if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */ if (sym->u.s.redirect == SYMBOL_LOCALIZED /* Just to be sure. */
&& SYMBOL_BLV (sym)->fwd) && SYMBOL_BLV (sym)->fwd)
/* Just reference the variable /* Just reference the variable
to cause it to become set for this buffer. */ to cause it to become set for this buffer. */
@ -2752,7 +2753,7 @@ swap_out_buffer_local_variables (struct buffer *b)
for (alist = oalist; CONSP (alist); alist = XCDR (alist)) for (alist = oalist; CONSP (alist); alist = XCDR (alist))
{ {
Lisp_Object sym = XCAR (XCAR (alist)); Lisp_Object sym = XCAR (XCAR (alist));
eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED); eassert (XSYMBOL (sym)->u.s.redirect == SYMBOL_LOCALIZED);
/* Need not do anything if some other buffer's binding is /* Need not do anything if some other buffer's binding is
now cached. */ now cached. */
if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer)) if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
@ -5423,8 +5424,8 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
bo_fwd->type = Lisp_Fwd_Buffer_Obj; bo_fwd->type = Lisp_Fwd_Buffer_Obj;
bo_fwd->offset = offset; bo_fwd->offset = offset;
bo_fwd->predicate = predicate; bo_fwd->predicate = predicate;
sym->declared_special = 1; sym->u.s.declared_special = true;
sym->redirect = SYMBOL_FORWARDED; sym->u.s.redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (sym, (union Lisp_Fwd *) bo_fwd); SET_SYMBOL_FWD (sym, (union Lisp_Fwd *) bo_fwd);
XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym); XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);

4
src/bytecode.c
View file

@ -489,7 +489,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
{ {
Lisp_Object v1 = vectorp[op], v2; Lisp_Object v1 = vectorp[op], v2;
if (!SYMBOLP (v1) if (!SYMBOLP (v1)
|| XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL || XSYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL
|| (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound))) || (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound)))
v2 = Fsymbol_value (v1); v2 = Fsymbol_value (v1);
PUSH (v2); PUSH (v2);
@ -558,7 +558,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
/* Inline the most common case. */ /* Inline the most common case. */
if (SYMBOLP (sym) if (SYMBOLP (sym)
&& !EQ (val, Qunbound) && !EQ (val, Qunbound)
&& !XSYMBOL (sym)->redirect && !XSYMBOL (sym)->u.s.redirect
&& !SYMBOL_TRAPPED_WRITE_P (sym)) && !SYMBOL_TRAPPED_WRITE_P (sym))
SET_SYMBOL_VAL (XSYMBOL (sym), val); SET_SYMBOL_VAL (XSYMBOL (sym), val);
else else

4
src/casefiddle.c
View file

@ -133,9 +133,9 @@ case_character_impl (struct casing_str_buf *buf,
struct Lisp_String *str = XSTRING (prop); struct Lisp_String *str = XSTRING (prop);
if (STRING_BYTES (str) <= sizeof buf->data) if (STRING_BYTES (str) <= sizeof buf->data)
{ {
buf->len_chars = str->size; buf->len_chars = str->u.s.size;
buf->len_bytes = STRING_BYTES (str); buf->len_bytes = STRING_BYTES (str);
memcpy (buf->data, str->data, buf->len_bytes); memcpy (buf->data, str->u.s.data, buf->len_bytes);
return 1; return 1;
} }
} }

6
src/cmds.c
View file

@ -421,11 +421,11 @@ internal_self_insert (int c, EMACS_INT n)
and the hook has a non-nil `no-self-insert' property, and the hook has a non-nil `no-self-insert' property,
return right away--don't really self-insert. */ return right away--don't really self-insert. */
if (SYMBOLP (sym) && ! NILP (sym) if (SYMBOLP (sym) && ! NILP (sym)
&& ! NILP (XSYMBOL (sym)->function) && ! NILP (XSYMBOL (sym)->u.s.function)
&& SYMBOLP (XSYMBOL (sym)->function)) && SYMBOLP (XSYMBOL (sym)->u.s.function))
{ {
Lisp_Object prop; Lisp_Object prop;
prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert")); prop = Fget (XSYMBOL (sym)->u.s.function, intern ("no-self-insert"));
if (! NILP (prop)) if (! NILP (prop))
return 1; return 1;
} }

76
src/data.c
View file

@ -670,7 +670,7 @@ global value outside of any lexical scope. */)
sym = XSYMBOL (symbol); sym = XSYMBOL (symbol);
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break; case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break;
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
@ -704,10 +704,10 @@ global value outside of any lexical scope. */)
expect `t' in particular, rather than any true value. */ expect `t' in particular, rather than any true value. */
DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
doc: /* Return t if SYMBOL's function definition is not void. */) doc: /* Return t if SYMBOL's function definition is not void. */)
(register Lisp_Object symbol) (Lisp_Object symbol)
{ {
CHECK_SYMBOL (symbol); CHECK_SYMBOL (symbol);
return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt; return NILP (XSYMBOL (symbol)->u.s.function) ? Qnil : Qt;
} }
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
@ -736,18 +736,18 @@ Return SYMBOL. */)
DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
doc: /* Return SYMBOL's function definition, or nil if that is void. */) doc: /* Return SYMBOL's function definition, or nil if that is void. */)
(register Lisp_Object symbol) (Lisp_Object symbol)
{ {
CHECK_SYMBOL (symbol); CHECK_SYMBOL (symbol);
return XSYMBOL (symbol)->function; return XSYMBOL (symbol)->u.s.function;
} }
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
doc: /* Return SYMBOL's property list. */) doc: /* Return SYMBOL's property list. */)
(register Lisp_Object symbol) (Lisp_Object symbol)
{ {
CHECK_SYMBOL (symbol); CHECK_SYMBOL (symbol);
return XSYMBOL (symbol)->plist; return XSYMBOL (symbol)->u.s.plist;
} }
DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
@ -771,7 +771,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
if (NILP (symbol)) if (NILP (symbol))
xsignal1 (Qsetting_constant, symbol); xsignal1 (Qsetting_constant, symbol);
function = XSYMBOL (symbol)->function; function = XSYMBOL (symbol)->u.s.function;
if (!NILP (Vautoload_queue) && !NILP (function)) if (!NILP (Vautoload_queue) && !NILP (function))
Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
@ -814,7 +814,7 @@ The return value is undefined. */)
{ /* Only add autoload entries after dumping, because the ones before are { /* Only add autoload entries after dumping, because the ones before are
not useful and else we get loads of them from the loaddefs.el. */ not useful and else we get loads of them from the loaddefs.el. */
if (AUTOLOADP (XSYMBOL (symbol)->function)) if (AUTOLOADP (XSYMBOL (symbol)->u.s.function))
/* Remember that the function was already an autoload. */ /* Remember that the function was already an autoload. */
LOADHIST_ATTACH (Fcons (Qt, symbol)); LOADHIST_ATTACH (Fcons (Qt, symbol));
LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol)); LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
@ -940,10 +940,10 @@ indirect_variable (struct Lisp_Symbol *symbol)
hare = tortoise = symbol; hare = tortoise = symbol;
while (hare->redirect == SYMBOL_VARALIAS) while (hare->u.s.redirect == SYMBOL_VARALIAS)
{ {
hare = SYMBOL_ALIAS (hare); hare = SYMBOL_ALIAS (hare);
if (hare->redirect != SYMBOL_VARALIAS) if (hare->u.s.redirect != SYMBOL_VARALIAS)
break; break;
hare = SYMBOL_ALIAS (hare); hare = SYMBOL_ALIAS (hare);
@ -1247,7 +1247,7 @@ find_symbol_value (Lisp_Object symbol)
sym = XSYMBOL (symbol); sym = XSYMBOL (symbol);
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
@ -1310,7 +1310,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
CHECK_SYMBOL (symbol); CHECK_SYMBOL (symbol);
sym = XSYMBOL (symbol); sym = XSYMBOL (symbol);
switch (sym->trapped_write) switch (sym->u.s.trapped_write)
{ {
case SYMBOL_NOWRITE: case SYMBOL_NOWRITE:
if (NILP (Fkeywordp (symbol)) if (NILP (Fkeywordp (symbol))
@ -1336,7 +1336,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
} }
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return; case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
@ -1436,7 +1436,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
if (voide) if (voide)
{ /* If storing void (making the symbol void), forward only through { /* If storing void (making the symbol void), forward only through
buffer-local indicator, not through Lisp_Objfwd, etc. */ buffer-local indicator, not through Lisp_Objfwd, etc. */
sym->redirect = SYMBOL_PLAINVAL; sym->u.s.redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (sym, newval); SET_SYMBOL_VAL (sym, newval);
} }
else else
@ -1452,9 +1452,9 @@ static void
set_symbol_trapped_write (Lisp_Object symbol, enum symbol_trapped_write trap) set_symbol_trapped_write (Lisp_Object symbol, enum symbol_trapped_write trap)
{ {
struct Lisp_Symbol *sym = XSYMBOL (symbol); struct Lisp_Symbol *sym = XSYMBOL (symbol);
if (sym->trapped_write == SYMBOL_NOWRITE) if (sym->u.s.trapped_write == SYMBOL_NOWRITE)
xsignal1 (Qtrapping_constant, symbol); xsignal1 (Qtrapping_constant, symbol);
sym->trapped_write = trap; sym->u.s.trapped_write = trap;
} }
static void static void
@ -1469,7 +1469,7 @@ harmonize_variable_watchers (Lisp_Object alias, Lisp_Object base_variable)
if (!EQ (base_variable, alias) if (!EQ (base_variable, alias)
&& EQ (base_variable, Findirect_variable (alias))) && EQ (base_variable, Findirect_variable (alias)))
set_symbol_trapped_write set_symbol_trapped_write
(alias, XSYMBOL (base_variable)->trapped_write); (alias, XSYMBOL (base_variable)->u.s.trapped_write);
} }
DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher, DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher,
@ -1583,7 +1583,7 @@ default_value (Lisp_Object symbol)
sym = XSYMBOL (symbol); sym = XSYMBOL (symbol);
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
@ -1653,7 +1653,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
CHECK_SYMBOL (symbol); CHECK_SYMBOL (symbol);
sym = XSYMBOL (symbol); sym = XSYMBOL (symbol);
switch (sym->trapped_write) switch (sym->u.s.trapped_write)
{ {
case SYMBOL_NOWRITE: case SYMBOL_NOWRITE:
if (NILP (Fkeywordp (symbol)) if (NILP (Fkeywordp (symbol))
@ -1665,7 +1665,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
case SYMBOL_TRAPPED_WRITE: case SYMBOL_TRAPPED_WRITE:
/* Don't notify here if we're going to call Fset anyway. */ /* Don't notify here if we're going to call Fset anyway. */
if (sym->redirect != SYMBOL_PLAINVAL if (sym->u.s.redirect != SYMBOL_PLAINVAL
/* Setting due to thread switching doesn't count. */ /* Setting due to thread switching doesn't count. */
&& bindflag != SET_INTERNAL_THREAD_SWITCH) && bindflag != SET_INTERNAL_THREAD_SWITCH)
notify_variable_watchers (symbol, value, Qset_default, Qnil); notify_variable_watchers (symbol, value, Qset_default, Qnil);
@ -1677,7 +1677,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
} }
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return; case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return;
@ -1829,7 +1829,7 @@ The function `default-value' gets the default value and `set-default' sets it.
sym = XSYMBOL (variable); sym = XSYMBOL (variable);
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: case SYMBOL_PLAINVAL:
@ -1857,7 +1857,7 @@ The function `default-value' gets the default value and `set-default' sets it.
if (!blv) if (!blv)
{ {
blv = make_blv (sym, forwarded, valcontents); blv = make_blv (sym, forwarded, valcontents);
sym->redirect = SYMBOL_LOCALIZED; sym->u.s.redirect = SYMBOL_LOCALIZED;
SET_SYMBOL_BLV (sym, blv); SET_SYMBOL_BLV (sym, blv);
} }
@ -1897,7 +1897,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
sym = XSYMBOL (variable); sym = XSYMBOL (variable);
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: case SYMBOL_PLAINVAL:
@ -1914,7 +1914,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
default: emacs_abort (); default: emacs_abort ();
} }
if (sym->trapped_write == SYMBOL_NOWRITE) if (sym->u.s.trapped_write == SYMBOL_NOWRITE)
error ("Symbol %s may not be buffer-local", error ("Symbol %s may not be buffer-local",
SDATA (SYMBOL_NAME (variable))); SDATA (SYMBOL_NAME (variable)));
@ -1930,7 +1930,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
if (!blv) if (!blv)
{ {
blv = make_blv (sym, forwarded, valcontents); blv = make_blv (sym, forwarded, valcontents);
sym->redirect = SYMBOL_LOCALIZED; sym->u.s.redirect = SYMBOL_LOCALIZED;
SET_SYMBOL_BLV (sym, blv); SET_SYMBOL_BLV (sym, blv);
} }
@ -1987,7 +1987,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
sym = XSYMBOL (variable); sym = XSYMBOL (variable);
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return variable; case SYMBOL_PLAINVAL: return variable;
@ -2014,7 +2014,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
default: emacs_abort (); default: emacs_abort ();
} }
if (sym->trapped_write == SYMBOL_TRAPPED_WRITE) if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ()); notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ());
/* Get rid of this buffer's alist element, if any. */ /* Get rid of this buffer's alist element, if any. */
@ -2056,7 +2056,7 @@ BUFFER defaults to the current buffer. */)
sym = XSYMBOL (variable); sym = XSYMBOL (variable);
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil; case SYMBOL_PLAINVAL: return Qnil;
@ -2110,7 +2110,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see
sym = XSYMBOL (variable); sym = XSYMBOL (variable);
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil; case SYMBOL_PLAINVAL: return Qnil;
@ -2145,7 +2145,7 @@ If the current binding is global (the default), the value is nil. */)
find_symbol_value (variable); find_symbol_value (variable);
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil; case SYMBOL_PLAINVAL: return Qnil;
@ -2163,7 +2163,7 @@ If the current binding is global (the default), the value is nil. */)
buffer's or frame's value we are saving. */ buffer's or frame's value we are saving. */
if (!NILP (Flocal_variable_p (variable, Qnil))) if (!NILP (Flocal_variable_p (variable, Qnil)))
return Fcurrent_buffer (); return Fcurrent_buffer ();
else if (sym->redirect == SYMBOL_LOCALIZED else if (sym->u.s.redirect == SYMBOL_LOCALIZED
&& blv_found (SYMBOL_BLV (sym))) && blv_found (SYMBOL_BLV (sym)))
return SYMBOL_BLV (sym)->where; return SYMBOL_BLV (sym)->where;
else else
@ -2234,12 +2234,12 @@ indirect_function (register Lisp_Object object)
{ {
if (!SYMBOLP (hare) || NILP (hare)) if (!SYMBOLP (hare) || NILP (hare))
break; break;
hare = XSYMBOL (hare)->function; hare = XSYMBOL (hare)->u.s.function;
if (!SYMBOLP (hare) || NILP (hare)) if (!SYMBOLP (hare) || NILP (hare))
break; break;
hare = XSYMBOL (hare)->function; hare = XSYMBOL (hare)->u.s.function;
tortoise = XSYMBOL (tortoise)->function; tortoise = XSYMBOL (tortoise)->u.s.function;
if (EQ (hare, tortoise)) if (EQ (hare, tortoise))
xsignal1 (Qcyclic_function_indirection, object); xsignal1 (Qcyclic_function_indirection, object);
@ -2261,7 +2261,7 @@ function chain of symbols. */)
/* Optimize for no indirection. */ /* Optimize for no indirection. */
result = object; result = object;
if (SYMBOLP (result) && !NILP (result) if (SYMBOLP (result) && !NILP (result)
&& (result = XSYMBOL (result)->function, SYMBOLP (result))) && (result = XSYMBOL (result)->u.s.function, SYMBOLP (result)))
result = indirect_function (result); result = indirect_function (result);
if (!NILP (result)) if (!NILP (result))
return result; return result;
@ -3877,7 +3877,7 @@ syms_of_data (void)
defsubr (&Sbool_vector_count_consecutive); defsubr (&Sbool_vector_count_consecutive);
defsubr (&Sbool_vector_count_population); defsubr (&Sbool_vector_count_population);
set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function); set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->u.s.function);
DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum, DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,
doc: /* The largest value that is representable in a Lisp integer. */); doc: /* The largest value that is representable in a Lisp integer. */);

2
src/doc.c
View file

@ -472,7 +472,7 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
{ {
/* Don't use indirect_function here, or defaliases will apply their /* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */ docstrings to the base functions (Bug#2603). */
Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj; Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->u.s.function : obj;
/* The type determines where the docstring is stored. */ /* The type determines where the docstring is stored. */

59
src/eval.c
View file

@ -603,7 +603,7 @@ The return value is BASE-VARIABLE. */)
sym = XSYMBOL (new_alias); sym = XSYMBOL (new_alias);
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_FORWARDED: case SYMBOL_FORWARDED:
error ("Cannot make an internal variable an alias"); error ("Cannot make an internal variable an alias");
@ -632,14 +632,14 @@ The return value is BASE-VARIABLE. */)
error ("Don't know how to make a let-bound variable an alias"); error ("Don't know how to make a let-bound variable an alias");
} }
if (sym->trapped_write == SYMBOL_TRAPPED_WRITE) if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
notify_variable_watchers (new_alias, base_variable, Qdefvaralias, Qnil); notify_variable_watchers (new_alias, base_variable, Qdefvaralias, Qnil);
sym->declared_special = 1; sym->u.s.declared_special = true;
XSYMBOL (base_variable)->declared_special = 1; XSYMBOL (base_variable)->u.s.declared_special = true;
sym->redirect = SYMBOL_VARALIAS; sym->u.s.redirect = SYMBOL_VARALIAS;
SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable)); SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
sym->trapped_write = XSYMBOL (base_variable)->trapped_write; sym->u.s.trapped_write = XSYMBOL (base_variable)->u.s.trapped_write;
LOADHIST_ATTACH (new_alias); LOADHIST_ATTACH (new_alias);
/* Even if docstring is nil: remove old docstring. */ /* Even if docstring is nil: remove old docstring. */
Fput (new_alias, Qvariable_documentation, docstring); Fput (new_alias, Qvariable_documentation, docstring);
@ -745,7 +745,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
tem = Fdefault_boundp (sym); tem = Fdefault_boundp (sym);
/* Do it before evaluating the initial value, for self-references. */ /* Do it before evaluating the initial value, for self-references. */
XSYMBOL (sym)->declared_special = 1; XSYMBOL (sym)->u.s.declared_special = true;
if (NILP (tem)) if (NILP (tem))
Fset_default (sym, eval_sub (XCAR (tail))); Fset_default (sym, eval_sub (XCAR (tail)));
@ -769,7 +769,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
LOADHIST_ATTACH (sym); LOADHIST_ATTACH (sym);
} }
else if (!NILP (Vinternal_interpreter_environment) else if (!NILP (Vinternal_interpreter_environment)
&& !XSYMBOL (sym)->declared_special) && !XSYMBOL (sym)->u.s.declared_special)
/* A simple (defvar foo) with lexical scoping does "nothing" except /* A simple (defvar foo) with lexical scoping does "nothing" except
declare that var to be dynamically scoped *locally* (i.e. within declare that var to be dynamically scoped *locally* (i.e. within
the current file or let-block). */ the current file or let-block). */
@ -818,7 +818,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
if (!NILP (Vpurify_flag)) if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem); tem = Fpurecopy (tem);
Fset_default (sym, tem); Fset_default (sym, tem);
XSYMBOL (sym)->declared_special = 1; XSYMBOL (sym)->u.s.declared_special = true;
if (!NILP (docstring)) if (!NILP (docstring))
{ {
if (!NILP (Vpurify_flag)) if (!NILP (Vpurify_flag))
@ -837,7 +837,7 @@ DEFUN ("internal-make-var-non-special", Fmake_var_non_special,
(Lisp_Object symbol) (Lisp_Object symbol)
{ {
CHECK_SYMBOL (symbol); CHECK_SYMBOL (symbol);
XSYMBOL (symbol)->declared_special = 0; XSYMBOL (symbol)->u.s.declared_special = false;
return Qnil; return Qnil;
} }
@ -877,7 +877,7 @@ usage: (let* VARLIST BODY...) */)
} }
if (!NILP (lexenv) && SYMBOLP (var) if (!NILP (lexenv) && SYMBOLP (var)
&& !XSYMBOL (var)->declared_special && !XSYMBOL (var)->u.s.declared_special
&& NILP (Fmemq (var, Vinternal_interpreter_environment))) && NILP (Fmemq (var, Vinternal_interpreter_environment)))
/* Lexically bind VAR by adding it to the interpreter's binding /* Lexically bind VAR by adding it to the interpreter's binding
alist. */ alist. */
@ -953,7 +953,7 @@ usage: (let VARLIST BODY...) */)
tem = temps[argnum]; tem = temps[argnum];
if (!NILP (lexenv) && SYMBOLP (var) if (!NILP (lexenv) && SYMBOLP (var)
&& !XSYMBOL (var)->declared_special && !XSYMBOL (var)->u.s.declared_special
&& NILP (Fmemq (var, Vinternal_interpreter_environment))) && NILP (Fmemq (var, Vinternal_interpreter_environment)))
/* Lexically bind VAR by adding it to the lexenv alist. */ /* Lexically bind VAR by adding it to the lexenv alist. */
lexenv = Fcons (Fcons (var, tem), lexenv); lexenv = Fcons (Fcons (var, tem), lexenv);
@ -1022,7 +1022,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
tem = Fassq (sym, environment); tem = Fassq (sym, environment);
if (NILP (tem)) if (NILP (tem))
{ {
def = XSYMBOL (sym)->function; def = XSYMBOL (sym)->u.s.function;
if (!NILP (def)) if (!NILP (def))
continue; continue;
} }
@ -1932,8 +1932,8 @@ this does nothing and returns nil. */)
CHECK_STRING (file); CHECK_STRING (file);
/* If function is defined and not as an autoload, don't override. */ /* If function is defined and not as an autoload, don't override. */
if (!NILP (XSYMBOL (function)->function) if (!NILP (XSYMBOL (function)->u.s.function)
&& !AUTOLOADP (XSYMBOL (function)->function)) && !AUTOLOADP (XSYMBOL (function)->u.s.function))
return Qnil; return Qnil;
if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0))) if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0)))
@ -2164,7 +2164,7 @@ eval_sub (Lisp_Object form)
fun = original_fun; fun = original_fun;
if (!SYMBOLP (fun)) if (!SYMBOLP (fun))
fun = Ffunction (Fcons (fun, Qnil)); fun = Ffunction (Fcons (fun, Qnil));
else if (!NILP (fun) && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) else if (!NILP (fun) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
fun = indirect_function (fun); fun = indirect_function (fun);
if (SUBRP (fun)) if (SUBRP (fun))
@ -2347,7 +2347,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
/* Optimize for no indirection. */ /* Optimize for no indirection. */
if (SYMBOLP (fun) && !NILP (fun) if (SYMBOLP (fun) && !NILP (fun)
&& (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
{ {
fun = indirect_function (fun); fun = indirect_function (fun);
if (NILP (fun)) if (NILP (fun))
@ -2759,7 +2759,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
/* Optimize for no indirection. */ /* Optimize for no indirection. */
fun = original_fun; fun = original_fun;
if (SYMBOLP (fun) && !NILP (fun) if (SYMBOLP (fun) && !NILP (fun)
&& (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
fun = indirect_function (fun); fun = indirect_function (fun);
if (SUBRP (fun)) if (SUBRP (fun))
@ -3075,7 +3075,7 @@ function with `&rest' args, or `unevalled' for a special form. */)
function = original; function = original;
if (SYMBOLP (function) && !NILP (function)) if (SYMBOLP (function) && !NILP (function))
{ {
function = XSYMBOL (function)->function; function = XSYMBOL (function)->u.s.function;
if (SYMBOLP (function)) if (SYMBOLP (function))
function = indirect_function (function); function = indirect_function (function);
} }
@ -3214,7 +3214,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
if ((--p)->kind > SPECPDL_LET) if ((--p)->kind > SPECPDL_LET)
{ {
struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p)); struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p));
eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS); eassert (let_bound_symbol->u.s.redirect != SYMBOL_VARALIAS);
if (symbol == let_bound_symbol if (symbol == let_bound_symbol
&& EQ (specpdl_where (p), buf)) && EQ (specpdl_where (p), buf))
return 1; return 1;
@ -3227,10 +3227,10 @@ static void
do_specbind (struct Lisp_Symbol *sym, union specbinding *bind, do_specbind (struct Lisp_Symbol *sym, union specbinding *bind,
Lisp_Object value, enum Set_Internal_Bind bindflag) Lisp_Object value, enum Set_Internal_Bind bindflag)
{ {
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_PLAINVAL: case SYMBOL_PLAINVAL:
if (!sym->trapped_write) if (!sym->u.s.trapped_write)
SET_SYMBOL_VAL (sym, value); SET_SYMBOL_VAL (sym, value);
else else
set_internal (specpdl_symbol (bind), value, Qnil, bindflag); set_internal (specpdl_symbol (bind), value, Qnil, bindflag);
@ -3274,7 +3274,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
sym = XSYMBOL (symbol); sym = XSYMBOL (symbol);
start: start:
switch (sym->redirect) switch (sym->u.s.redirect)
{ {
case SYMBOL_VARALIAS: case SYMBOL_VARALIAS:
sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start; sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
@ -3298,10 +3298,10 @@ specbind (Lisp_Object symbol, Lisp_Object value)
specpdl_ptr->let.where = Fcurrent_buffer (); specpdl_ptr->let.where = Fcurrent_buffer ();
specpdl_ptr->let.saved_value = Qnil; specpdl_ptr->let.saved_value = Qnil;
eassert (sym->redirect != SYMBOL_LOCALIZED eassert (sym->u.s.redirect != SYMBOL_LOCALIZED
|| (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ())));
if (sym->redirect == SYMBOL_LOCALIZED) if (sym->u.s.redirect == SYMBOL_LOCALIZED)
{ {
if (!blv_found (SYMBOL_BLV (sym))) if (!blv_found (SYMBOL_BLV (sym)))
specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
@ -3412,9 +3412,9 @@ do_one_unbind (union specbinding *this_binding, bool unwinding,
{ /* If variable has a trivial value (no forwarding), and isn't { /* If variable has a trivial value (no forwarding), and isn't
trapped, we can just set it. */ trapped, we can just set it. */
Lisp_Object sym = specpdl_symbol (this_binding); Lisp_Object sym = specpdl_symbol (this_binding);
if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL) if (SYMBOLP (sym) && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL)
{ {
if (XSYMBOL (sym)->trapped_write == SYMBOL_UNTRAPPED_WRITE) if (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_UNTRAPPED_WRITE)
SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (this_binding)); SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (this_binding));
else else
set_internal (sym, specpdl_old_value (this_binding), set_internal (sym, specpdl_old_value (this_binding),
@ -3546,7 +3546,7 @@ context where binding is lexical by default. */)
(Lisp_Object symbol) (Lisp_Object symbol)
{ {
CHECK_SYMBOL (symbol); CHECK_SYMBOL (symbol);
return XSYMBOL (symbol)->declared_special ? Qt : Qnil; return XSYMBOL (symbol)->u.s.declared_special ? Qt : Qnil;
} }
@ -3702,7 +3702,8 @@ backtrace_eval_unrewind (int distance)
just set it. No need to check for constant symbols here, just set it. No need to check for constant symbols here,
since that was already done by specbind. */ since that was already done by specbind. */
Lisp_Object sym = specpdl_symbol (tmp); Lisp_Object sym = specpdl_symbol (tmp);
if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL) if (SYMBOLP (sym)
&& XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL)
{ {
Lisp_Object old_value = specpdl_old_value (tmp); Lisp_Object old_value = specpdl_old_value (tmp);
set_specpdl_old_value (tmp, SYMBOL_VAL (XSYMBOL (sym))); set_specpdl_old_value (tmp, SYMBOL_VAL (XSYMBOL (sym)));

4
src/fns.c
View file

@ -1993,7 +1993,7 @@ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */)
propname); propname);
if (!NILP (propval)) if (!NILP (propval))
return propval; return propval;
return Fplist_get (XSYMBOL (symbol)->plist, propname); return Fplist_get (XSYMBOL (symbol)->u.s.plist, propname);
} }
DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0, DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
@ -2039,7 +2039,7 @@ It can be retrieved with `(get SYMBOL PROPNAME)'. */)
{ {
CHECK_SYMBOL (symbol); CHECK_SYMBOL (symbol);
set_symbol_plist set_symbol_plist
(symbol, Fplist_put (XSYMBOL (symbol)->plist, propname, value)); (symbol, Fplist_put (XSYMBOL (symbol)->u.s.plist, propname, value));
return value; return value;
} }

10
src/keyboard.c
View file

@ -7901,7 +7901,7 @@ parse_menu_item (Lisp_Object item, int inmenubar)
(such as lmenu.el set it up), check if the (such as lmenu.el set it up), check if the
original command matches the cached command. */ original command matches the cached command. */
&& !(SYMBOLP (def) && !(SYMBOLP (def)
&& EQ (tem, XSYMBOL (def)->function)))) && EQ (tem, XSYMBOL (def)->u.s.function))))
keys = Qnil; keys = Qnil;
} }
@ -8761,9 +8761,9 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
/* Handle a symbol whose function definition is a keymap /* Handle a symbol whose function definition is a keymap
or an array. */ or an array. */
if (SYMBOLP (next) && !NILP (Ffboundp (next)) if (SYMBOLP (next) && !NILP (Ffboundp (next))
&& (ARRAYP (XSYMBOL (next)->function) && (ARRAYP (XSYMBOL (next)->u.s.function)
|| KEYMAPP (XSYMBOL (next)->function))) || KEYMAPP (XSYMBOL (next)->u.s.function)))
next = Fautoload_do_load (XSYMBOL (next)->function, next, Qnil); next = Fautoload_do_load (XSYMBOL (next)->u.s.function, next, Qnil);
/* If the keymap gives a function, not an /* If the keymap gives a function, not an
array, then call the function with one arg and use array, then call the function with one arg and use
@ -11510,7 +11510,7 @@ for that character after that prefix key. */);
doc: /* Form to evaluate when Emacs starts up. doc: /* Form to evaluate when Emacs starts up.
Useful to set before you dump a modified Emacs. */); Useful to set before you dump a modified Emacs. */);
Vtop_level = Qnil; Vtop_level = Qnil;
XSYMBOL (Qtop_level)->declared_special = false; XSYMBOL (Qtop_level)->u.s.declared_special = false;
DEFVAR_KBOARD ("keyboard-translate-table", Vkeyboard_translate_table, DEFVAR_KBOARD ("keyboard-translate-table", Vkeyboard_translate_table,
doc: /* Translate table for local keyboard input, or nil. doc: /* Translate table for local keyboard input, or nil.

163
src/lisp.h
View file

@ -229,7 +229,7 @@ extern bool suppress_checking EXTERNALLY_VISIBLE;
USE_LSB_TAG not only requires the least 3 bits of pointers returned by USE_LSB_TAG not only requires the least 3 bits of pointers returned by
malloc to be 0 but also needs to be able to impose a mult-of-8 alignment malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
on the few static Lisp_Objects used, all of which are aligned via on the few static Lisp_Objects used, all of which are aligned via
the GCALIGN macro defined below. */ 'char alignas (GCALIGNMENT) gcaligned;' inside a union. */
enum Lisp_Bits enum Lisp_Bits
{ {
@ -277,20 +277,6 @@ DEFINE_GDB_SYMBOL_END (VALMASK)
error !; error !;
#endif #endif
/* Use GCALIGNED immediately after the 'struct' keyword to require the
struct to have an address that is a multiple of GCALIGNMENT. This
is a no-op if the struct's natural alignment is already a multiple
of GCALIGNMENT. GCALIGNED's implementation uses the 'aligned'
attribute instead of 'alignas (GCALIGNMENT)', as the latter would
fail if an object's natural alignment exceeds GCALIGNMENT. The
implementation hopes that natural alignment suffices on platforms
lacking 'aligned'. */
#ifdef HAVE_STRUCT_ATTRIBUTE_ALIGNED
# define GCALIGNED __attribute__ ((aligned (GCALIGNMENT)))
#else
# define GCALIGNED /* empty */
#endif
/* Some operations are so commonly executed that they are implemented /* Some operations are so commonly executed that they are implemented
as macros, not functions, because otherwise runtime performance would as macros, not functions, because otherwise runtime performance would
suffer too much when compiling with GCC without optimization. suffer too much when compiling with GCC without optimization.
@ -338,15 +324,17 @@ error !;
#define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc) #define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc)
#define lisp_h_NILP(x) EQ (x, Qnil) #define lisp_h_NILP(x) EQ (x, Qnil)
#define lisp_h_SET_SYMBOL_VAL(sym, v) \ #define lisp_h_SET_SYMBOL_VAL(sym, v) \
(eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \
#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->trapped_write == SYMBOL_NOWRITE) (sym)->u.s.val.value = (v))
#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->trapped_write) #define lisp_h_SYMBOL_CONSTANT_P(sym) \
(XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE)
#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write)
#define lisp_h_SYMBOL_VAL(sym) \ #define lisp_h_SYMBOL_VAL(sym) \
(eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value)
#define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) #define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
#define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike) #define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike)
#define lisp_h_XCAR(c) XCONS (c)->car #define lisp_h_XCAR(c) XCONS (c)->u.s.car
#define lisp_h_XCDR(c) XCONS (c)->u.cdr #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr
#define lisp_h_XCONS(a) \ #define lisp_h_XCONS(a) \
(eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
#define lisp_h_XHASH(a) XUINT (a) #define lisp_h_XHASH(a) XUINT (a)
@ -677,6 +665,10 @@ enum symbol_trapped_write
struct Lisp_Symbol struct Lisp_Symbol
{ {
union
{
struct
{
bool_bf gcmarkbit : 1; bool_bf gcmarkbit : 1;
/* Indicates where the value can be found: /* Indicates where the value can be found:
@ -722,7 +714,11 @@ struct Lisp_Symbol
/* Next symbol in obarray bucket, if the symbol is interned. */ /* Next symbol in obarray bucket, if the symbol is interned. */
struct Lisp_Symbol *next; struct Lisp_Symbol *next;
} s;
char alignas (GCALIGNMENT) gcaligned;
} u;
}; };
verify (alignof (struct Lisp_Symbol) % GCALIGNMENT == 0);
/* Declare a Lisp-callable function. The MAXARGS parameter has the same /* Declare a Lisp-callable function. The MAXARGS parameter has the same
meaning as in the DEFUN macro, and is used to construct a prototype. */ meaning as in the DEFUN macro, and is used to construct a prototype. */
@ -802,7 +798,7 @@ struct Lisp_Symbol
Bug#8546. */ Bug#8546. */
union vectorlike_header union vectorlike_header
{ {
/* The only field contains various pieces of information: /* The main member contains various pieces of information:
- The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit.
- The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain
vector (0) or a pseudovector (1). vector (0) or a pseudovector (1).
@ -822,7 +818,9 @@ union vectorlike_header
Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, Current layout limits the pseudovectors to 63 PVEC_xxx subtypes,
4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */
ptrdiff_t size; ptrdiff_t size;
char alignas (GCALIGNMENT) gcaligned;
}; };
verify (alignof (union vectorlike_header) % GCALIGNMENT == 0);
INLINE bool INLINE bool
(SYMBOLP) (Lisp_Object x) (SYMBOLP) (Lisp_Object x)
@ -854,7 +852,7 @@ make_lisp_symbol (struct Lisp_Symbol *sym)
INLINE Lisp_Object INLINE Lisp_Object
builtin_lisp_symbol (int index) builtin_lisp_symbol (int index)
{ {
return make_lisp_symbol (&lispsym[index].s); return make_lisp_symbol (&lispsym[index]);
} }
INLINE void INLINE void
@ -1144,7 +1142,11 @@ make_pointer_integer (void *p)
typedef struct interval *INTERVAL; typedef struct interval *INTERVAL;
struct GCALIGNED Lisp_Cons struct Lisp_Cons
{
union
{
struct
{ {
/* Car of this cons cell. */ /* Car of this cons cell. */
Lisp_Object car; Lisp_Object car;
@ -1157,7 +1159,11 @@ struct GCALIGNED Lisp_Cons
/* Used to chain conses on a free list. */ /* Used to chain conses on a free list. */
struct Lisp_Cons *chain; struct Lisp_Cons *chain;
} u; } u;
}; } s;
char alignas (GCALIGNMENT) gcaligned;
} u;
};
verify (alignof (struct Lisp_Cons) % GCALIGNMENT == 0);
INLINE bool INLINE bool
(NILP) (Lisp_Object x) (NILP) (Lisp_Object x)
@ -1193,12 +1199,12 @@ INLINE struct Lisp_Cons *
INLINE Lisp_Object * INLINE Lisp_Object *
xcar_addr (Lisp_Object c) xcar_addr (Lisp_Object c)
{ {
return &XCONS (c)->car; return &XCONS (c)->u.s.car;
} }
INLINE Lisp_Object * INLINE Lisp_Object *
xcdr_addr (Lisp_Object c) xcdr_addr (Lisp_Object c)
{ {
return &XCONS (c)->u.cdr; return &XCONS (c)->u.s.u.cdr;
} }
/* Use these from normal code. */ /* Use these from normal code. */
@ -1262,15 +1268,24 @@ CDR_SAFE (Lisp_Object c)
return CONSP (c) ? XCDR (c) : Qnil; return CONSP (c) ? XCDR (c) : Qnil;
} }
/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ /* In a string or vector, the sign bit of u.s.size is the gc mark bit. */
struct GCALIGNED Lisp_String struct Lisp_String
{
union
{
struct
{ {
ptrdiff_t size; ptrdiff_t size;
ptrdiff_t size_byte; ptrdiff_t size_byte;
INTERVAL intervals; /* Text properties in this string. */ INTERVAL intervals; /* Text properties in this string. */
unsigned char *data; unsigned char *data;
}; } s;
struct Lisp_String *next;
char alignas (GCALIGNMENT) gcaligned;
} u;
};
verify (alignof (struct Lisp_String) % GCALIGNMENT == 0);
INLINE bool INLINE bool
STRINGP (Lisp_Object x) STRINGP (Lisp_Object x)
@ -1295,7 +1310,7 @@ XSTRING (Lisp_Object a)
INLINE bool INLINE bool
STRING_MULTIBYTE (Lisp_Object str) STRING_MULTIBYTE (Lisp_Object str)
{ {
return 0 <= XSTRING (str)->size_byte; return 0 <= XSTRING (str)->u.s.size_byte;
} }
/* An upper bound on the number of bytes in a Lisp string, not /* An upper bound on the number of bytes in a Lisp string, not
@ -1317,20 +1332,20 @@ STRING_MULTIBYTE (Lisp_Object str)
/* Mark STR as a unibyte string. */ /* Mark STR as a unibyte string. */
#define STRING_SET_UNIBYTE(STR) \ #define STRING_SET_UNIBYTE(STR) \
do { \ do { \
if (XSTRING (STR)->size == 0) \ if (XSTRING (STR)->u.s.size == 0) \
(STR) = empty_unibyte_string; \ (STR) = empty_unibyte_string; \
else \ else \
XSTRING (STR)->size_byte = -1; \ XSTRING (STR)->u.s.size_byte = -1; \
} while (false) } while (false)
/* Mark STR as a multibyte string. Assure that STR contains only /* Mark STR as a multibyte string. Assure that STR contains only
ASCII characters in advance. */ ASCII characters in advance. */
#define STRING_SET_MULTIBYTE(STR) \ #define STRING_SET_MULTIBYTE(STR) \
do { \ do { \
if (XSTRING (STR)->size == 0) \ if (XSTRING (STR)->u.s.size == 0) \
(STR) = empty_multibyte_string; \ (STR) = empty_multibyte_string; \
else \ else \
XSTRING (STR)->size_byte = XSTRING (STR)->size; \ XSTRING (STR)->u.s.size_byte = XSTRING (STR)->u.s.size; \
} while (false) } while (false)
/* Convenience functions for dealing with Lisp strings. */ /* Convenience functions for dealing with Lisp strings. */
@ -1338,7 +1353,7 @@ STRING_MULTIBYTE (Lisp_Object str)
INLINE unsigned char * INLINE unsigned char *
SDATA (Lisp_Object string) SDATA (Lisp_Object string)
{ {
return XSTRING (string)->data; return XSTRING (string)->u.s.data;
} }
INLINE char * INLINE char *
SSDATA (Lisp_Object string) SSDATA (Lisp_Object string)
@ -1359,7 +1374,7 @@ SSET (Lisp_Object string, ptrdiff_t index, unsigned char new)
INLINE ptrdiff_t INLINE ptrdiff_t
SCHARS (Lisp_Object string) SCHARS (Lisp_Object string)
{ {
ptrdiff_t nchars = XSTRING (string)->size; ptrdiff_t nchars = XSTRING (string)->u.s.size;
eassume (0 <= nchars); eassume (0 <= nchars);
return nchars; return nchars;
} }
@ -1373,7 +1388,7 @@ STRING_BYTES (struct Lisp_String *s)
#ifdef GC_CHECK_STRING_BYTES #ifdef GC_CHECK_STRING_BYTES
ptrdiff_t nbytes = string_bytes (s); ptrdiff_t nbytes = string_bytes (s);
#else #else
ptrdiff_t nbytes = s->size_byte < 0 ? s->size : s->size_byte; ptrdiff_t nbytes = s->u.s.size_byte < 0 ? s->u.s.size : s->u.s.size_byte;
#endif #endif
eassume (0 <= nbytes); eassume (0 <= nbytes);
return nbytes; return nbytes;
@ -1392,7 +1407,7 @@ STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize)
eassert (STRING_MULTIBYTE (string) eassert (STRING_MULTIBYTE (string)
? 0 <= newsize && newsize <= SBYTES (string) ? 0 <= newsize && newsize <= SBYTES (string)
: newsize == SCHARS (string)); : newsize == SCHARS (string));
XSTRING (string)->size = newsize; XSTRING (string)->u.s.size = newsize;
} }
/* A regular vector is just a header plus an array of Lisp_Objects. */ /* A regular vector is just a header plus an array of Lisp_Objects. */
@ -1910,20 +1925,20 @@ INLINE Lisp_Object
INLINE struct Lisp_Symbol * INLINE struct Lisp_Symbol *
SYMBOL_ALIAS (struct Lisp_Symbol *sym) SYMBOL_ALIAS (struct Lisp_Symbol *sym)
{ {
eassume (sym->redirect == SYMBOL_VARALIAS && sym->val.alias); eassume (sym->u.s.redirect == SYMBOL_VARALIAS && sym->u.s.val.alias);
return sym->val.alias; return sym->u.s.val.alias;
} }
INLINE struct Lisp_Buffer_Local_Value * INLINE struct Lisp_Buffer_Local_Value *
SYMBOL_BLV (struct Lisp_Symbol *sym) SYMBOL_BLV (struct Lisp_Symbol *sym)
{ {
eassume (sym->redirect == SYMBOL_LOCALIZED && sym->val.blv); eassume (sym->u.s.redirect == SYMBOL_LOCALIZED && sym->u.s.val.blv);
return sym->val.blv; return sym->u.s.val.blv;
} }
INLINE union Lisp_Fwd * INLINE union Lisp_Fwd *
SYMBOL_FWD (struct Lisp_Symbol *sym) SYMBOL_FWD (struct Lisp_Symbol *sym)
{ {
eassume (sym->redirect == SYMBOL_FORWARDED && sym->val.fwd); eassume (sym->u.s.redirect == SYMBOL_FORWARDED && sym->u.s.val.fwd);
return sym->val.fwd; return sym->u.s.val.fwd;
} }
INLINE void INLINE void
@ -1935,26 +1950,26 @@ INLINE void
INLINE void INLINE void
SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v)
{ {
eassume (sym->redirect == SYMBOL_VARALIAS && v); eassume (sym->u.s.redirect == SYMBOL_VARALIAS && v);
sym->val.alias = v; sym->u.s.val.alias = v;
} }
INLINE void INLINE void
SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v) SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v)
{ {
eassume (sym->redirect == SYMBOL_LOCALIZED && v); eassume (sym->u.s.redirect == SYMBOL_LOCALIZED && v);
sym->val.blv = v; sym->u.s.val.blv = v;
} }
INLINE void INLINE void
SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v)
{ {
eassume (sym->redirect == SYMBOL_FORWARDED && v); eassume (sym->u.s.redirect == SYMBOL_FORWARDED && v);
sym->val.fwd = v; sym->u.s.val.fwd = v;
} }
INLINE Lisp_Object INLINE Lisp_Object
SYMBOL_NAME (Lisp_Object sym) SYMBOL_NAME (Lisp_Object sym)
{ {
return XSYMBOL (sym)->name; return XSYMBOL (sym)->u.s.name;
} }
/* Value is true if SYM is an interned symbol. */ /* Value is true if SYM is an interned symbol. */
@ -1962,7 +1977,7 @@ SYMBOL_NAME (Lisp_Object sym)
INLINE bool INLINE bool
SYMBOL_INTERNED_P (Lisp_Object sym) SYMBOL_INTERNED_P (Lisp_Object sym)
{ {
return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED; return XSYMBOL (sym)->u.s.interned != SYMBOL_UNINTERNED;
} }
/* Value is true if SYM is interned in initial_obarray. */ /* Value is true if SYM is interned in initial_obarray. */
@ -1970,7 +1985,7 @@ SYMBOL_INTERNED_P (Lisp_Object sym)
INLINE bool INLINE bool
SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
{ {
return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; return XSYMBOL (sym)->u.s.interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
} }
/* Value is non-zero if symbol cannot be changed through a simple set, /* Value is non-zero if symbol cannot be changed through a simple set,
@ -2948,7 +2963,7 @@ CHECK_NUMBER_CDR (Lisp_Object x)
#ifdef _MSC_VER #ifdef _MSC_VER
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
static struct GCALIGNED Lisp_Subr sname = \ static struct Lisp_Subr sname = \
{ { (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \ { { (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \
| (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \ | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \
{ (Lisp_Object (__cdecl *)(void))fnname }, \ { (Lisp_Object (__cdecl *)(void))fnname }, \
@ -2956,7 +2971,7 @@ CHECK_NUMBER_CDR (Lisp_Object x)
Lisp_Object fnname Lisp_Object fnname
#else /* not _MSC_VER */ #else /* not _MSC_VER */
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
static struct GCALIGNED Lisp_Subr sname = \ static struct Lisp_Subr sname = \
{ { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ { { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \
{ .a ## maxargs = fnname }, \ { .a ## maxargs = fnname }, \
minargs, maxargs, lname, intspec, 0}; \ minargs, maxargs, lname, intspec, 0}; \
@ -3224,25 +3239,25 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
INLINE void INLINE void
set_symbol_function (Lisp_Object sym, Lisp_Object function) set_symbol_function (Lisp_Object sym, Lisp_Object function)
{ {
XSYMBOL (sym)->function = function; XSYMBOL (sym)->u.s.function = function;
} }
INLINE void INLINE void
set_symbol_plist (Lisp_Object sym, Lisp_Object plist) set_symbol_plist (Lisp_Object sym, Lisp_Object plist)
{ {
XSYMBOL (sym)->plist = plist; XSYMBOL (sym)->u.s.plist = plist;
} }
INLINE void INLINE void
set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next) set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
{ {
XSYMBOL (sym)->next = next; XSYMBOL (sym)->u.s.next = next;
} }
INLINE void INLINE void
make_symbol_constant (Lisp_Object sym) make_symbol_constant (Lisp_Object sym)
{ {
XSYMBOL (sym)->trapped_write = SYMBOL_NOWRITE; XSYMBOL (sym)->u.s.trapped_write = SYMBOL_NOWRITE;
} }
/* Buffer-local variable access functions. */ /* Buffer-local variable access functions. */
@ -3267,7 +3282,7 @@ set_overlay_plist (Lisp_Object overlay, Lisp_Object plist)
INLINE INTERVAL INLINE INTERVAL
string_intervals (Lisp_Object s) string_intervals (Lisp_Object s)
{ {
return XSTRING (s)->intervals; return XSTRING (s)->u.s.intervals;
} }
/* Set text properties of S to I. */ /* Set text properties of S to I. */
@ -3275,7 +3290,7 @@ string_intervals (Lisp_Object s)
INLINE void INLINE void
set_string_intervals (Lisp_Object s, INTERVAL i) set_string_intervals (Lisp_Object s, INTERVAL i)
{ {
XSTRING (s)->intervals = i; XSTRING (s)->u.s.intervals = i;
} }
/* Set a Lisp slot in TABLE to VAL. Most code should use this instead /* Set a Lisp slot in TABLE to VAL. Most code should use this instead
@ -4600,20 +4615,6 @@ enum { defined_GC_CHECK_STRING_BYTES = true };
enum { defined_GC_CHECK_STRING_BYTES = false }; enum { defined_GC_CHECK_STRING_BYTES = false };
#endif #endif
/* Struct inside unions that are typically no larger and aligned enough. */
union Aligned_Cons
{
struct Lisp_Cons s;
double d; intmax_t i; void *p;
};
union Aligned_String
{
struct Lisp_String s;
double d; intmax_t i; void *p;
};
/* True for stack-based cons and string implementations, respectively. /* True for stack-based cons and string implementations, respectively.
Use stack-based strings only if stack-based cons also works. Use stack-based strings only if stack-based cons also works.
Otherwise, STACK_CONS would create heap-based cons cells that Otherwise, STACK_CONS would create heap-based cons cells that
@ -4621,18 +4622,16 @@ union Aligned_String
enum enum
{ {
USE_STACK_CONS = (USE_STACK_LISP_OBJECTS USE_STACK_CONS = USE_STACK_LISP_OBJECTS,
&& alignof (union Aligned_Cons) % GCALIGNMENT == 0),
USE_STACK_STRING = (USE_STACK_CONS USE_STACK_STRING = (USE_STACK_CONS
&& !defined_GC_CHECK_STRING_BYTES && !defined_GC_CHECK_STRING_BYTES)
&& alignof (union Aligned_String) % GCALIGNMENT == 0)
}; };
/* Auxiliary macros used for auto allocation of Lisp objects. Please /* Auxiliary macros used for auto allocation of Lisp objects. Please
use these only in macros like AUTO_CONS that declare a local use these only in macros like AUTO_CONS that declare a local
variable whose lifetime will be clear to the programmer. */ variable whose lifetime will be clear to the programmer. */
#define STACK_CONS(a, b) \ #define STACK_CONS(a, b) \
make_lisp_ptr (&((union Aligned_Cons) { { a, { b } } }).s, Lisp_Cons) make_lisp_ptr (&((struct Lisp_Cons) {{{a, {b}}}}), Lisp_Cons)
#define AUTO_CONS_EXPR(a, b) \ #define AUTO_CONS_EXPR(a, b) \
(USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b)) (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b))
@ -4678,7 +4677,7 @@ enum
Lisp_Object name = \ Lisp_Object name = \
(USE_STACK_STRING \ (USE_STACK_STRING \
? (make_lisp_ptr \ ? (make_lisp_ptr \
((&((union Aligned_String) {{len, -1, 0, (unsigned char *) (str)}}).s), \ ((&(struct Lisp_String) {{{len, -1, 0, (unsigned char *) (str)}}}), \
Lisp_String)) \ Lisp_String)) \
: make_unibyte_string (str, len)) : make_unibyte_string (str, len))

48
src/lread.c
View file

@ -4043,14 +4043,14 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
{ {
Lisp_Object *ptr; Lisp_Object *ptr;
XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray) XSYMBOL (sym)->u.s.interned = (EQ (obarray, initial_obarray)
? SYMBOL_INTERNED_IN_INITIAL_OBARRAY ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
: SYMBOL_INTERNED); : SYMBOL_INTERNED);
if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray)) if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
{ {
make_symbol_constant (sym); make_symbol_constant (sym);
XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (XSYMBOL (sym), sym); SET_SYMBOL_VAL (XSYMBOL (sym), sym);
} }
@ -4203,16 +4203,16 @@ usage: (unintern NAME OBARRAY) */)
/* if (EQ (tem, Qnil) || EQ (tem, Qt)) /* if (EQ (tem, Qnil) || EQ (tem, Qt))
error ("Attempt to unintern t or nil"); */ error ("Attempt to unintern t or nil"); */
XSYMBOL (tem)->interned = SYMBOL_UNINTERNED; XSYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED;
hash = oblookup_last_bucket_number; hash = oblookup_last_bucket_number;
if (EQ (AREF (obarray, hash), tem)) if (EQ (AREF (obarray, hash), tem))
{ {
if (XSYMBOL (tem)->next) if (XSYMBOL (tem)->u.s.next)
{ {
Lisp_Object sym; Lisp_Object sym;
XSETSYMBOL (sym, XSYMBOL (tem)->next); XSETSYMBOL (sym, XSYMBOL (tem)->u.s.next);
ASET (obarray, hash, sym); ASET (obarray, hash, sym);
} }
else else
@ -4223,13 +4223,13 @@ usage: (unintern NAME OBARRAY) */)
Lisp_Object tail, following; Lisp_Object tail, following;
for (tail = AREF (obarray, hash); for (tail = AREF (obarray, hash);
XSYMBOL (tail)->next; XSYMBOL (tail)->u.s.next;
tail = following) tail = following)
{ {
XSETSYMBOL (following, XSYMBOL (tail)->next); XSETSYMBOL (following, XSYMBOL (tail)->u.s.next);
if (EQ (following, tem)) if (EQ (following, tem))
{ {
set_symbol_next (tail, XSYMBOL (following)->next); set_symbol_next (tail, XSYMBOL (following)->u.s.next);
break; break;
} }
} }
@ -4264,13 +4264,13 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff
else if (!SYMBOLP (bucket)) else if (!SYMBOLP (bucket))
error ("Bad data in guts of obarray"); /* Like CADR error message. */ error ("Bad data in guts of obarray"); /* Like CADR error message. */
else else
for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next)) for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next))
{ {
if (SBYTES (SYMBOL_NAME (tail)) == size_byte if (SBYTES (SYMBOL_NAME (tail)) == size_byte
&& SCHARS (SYMBOL_NAME (tail)) == size && SCHARS (SYMBOL_NAME (tail)) == size
&& !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte)) && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
return tail; return tail;
else if (XSYMBOL (tail)->next == 0) else if (XSYMBOL (tail)->u.s.next == 0)
break; break;
} }
XSETINT (tem, hash); XSETINT (tem, hash);
@ -4290,9 +4290,9 @@ map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Ob
while (1) while (1)
{ {
(*fn) (tail, arg); (*fn) (tail, arg);
if (XSYMBOL (tail)->next == 0) if (XSYMBOL (tail)->u.s.next == 0)
break; break;
XSETSYMBOL (tail, XSYMBOL (tail)->next); XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
} }
} }
} }
@ -4332,12 +4332,12 @@ init_obarray (void)
DEFSYM (Qnil, "nil"); DEFSYM (Qnil, "nil");
SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
make_symbol_constant (Qnil); make_symbol_constant (Qnil);
XSYMBOL (Qnil)->declared_special = true; XSYMBOL (Qnil)->u.s.declared_special = true;
DEFSYM (Qt, "t"); DEFSYM (Qt, "t");
SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
make_symbol_constant (Qt); make_symbol_constant (Qt);
XSYMBOL (Qt)->declared_special = true; XSYMBOL (Qt)->u.s.declared_special = true;
/* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
Vpurify_flag = Qt; Vpurify_flag = Qt;
@ -4361,7 +4361,7 @@ defalias (struct Lisp_Subr *sname, char *string)
{ {
Lisp_Object sym; Lisp_Object sym;
sym = intern (string); sym = intern (string);
XSETSUBR (XSYMBOL (sym)->function, sname); XSETSUBR (XSYMBOL (sym)->u.s.function, sname);
} }
#endif /* NOTDEF */ #endif /* NOTDEF */
@ -4376,8 +4376,8 @@ defvar_int (struct Lisp_Intfwd *i_fwd,
sym = intern_c_string (namestring); sym = intern_c_string (namestring);
i_fwd->type = Lisp_Fwd_Int; i_fwd->type = Lisp_Fwd_Int;
i_fwd->intvar = address; i_fwd->intvar = address;
XSYMBOL (sym)->declared_special = 1; XSYMBOL (sym)->u.s.declared_special = true;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd); SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
} }
@ -4391,8 +4391,8 @@ defvar_bool (struct Lisp_Boolfwd *b_fwd,
sym = intern_c_string (namestring); sym = intern_c_string (namestring);
b_fwd->type = Lisp_Fwd_Bool; b_fwd->type = Lisp_Fwd_Bool;
b_fwd->boolvar = address; b_fwd->boolvar = address;
XSYMBOL (sym)->declared_special = 1; XSYMBOL (sym)->u.s.declared_special = true;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd); SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
} }
@ -4410,8 +4410,8 @@ defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
sym = intern_c_string (namestring); sym = intern_c_string (namestring);
o_fwd->type = Lisp_Fwd_Obj; o_fwd->type = Lisp_Fwd_Obj;
o_fwd->objvar = address; o_fwd->objvar = address;
XSYMBOL (sym)->declared_special = 1; XSYMBOL (sym)->u.s.declared_special = true;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd); SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
} }
@ -4434,8 +4434,8 @@ defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
sym = intern_c_string (namestring); sym = intern_c_string (namestring);
ko_fwd->type = Lisp_Fwd_Kboard_Obj; ko_fwd->type = Lisp_Fwd_Kboard_Obj;
ko_fwd->offset = offset; ko_fwd->offset = offset;
XSYMBOL (sym)->declared_special = 1; XSYMBOL (sym)->u.s.declared_special = true;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd); SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
} }
@ -4769,7 +4769,7 @@ to find all the symbols in an obarray, use `mapatoms'. */);
DEFVAR_LISP ("values", Vvalues, DEFVAR_LISP ("values", Vvalues,
doc: /* List of values of all expressions which were read, evaluated and printed. doc: /* List of values of all expressions which were read, evaluated and printed.
Order is reverse chronological. */); Order is reverse chronological. */);
XSYMBOL (intern ("values"))->declared_special = 0; XSYMBOL (intern ("values"))->u.s.declared_special = true;
DEFVAR_LISP ("standard-input", Vstandard_input, DEFVAR_LISP ("standard-input", Vstandard_input,
doc: /* Stream for read to get input from. doc: /* Stream for read to get input from.

12
src/minibuf.c
View file

@ -1280,8 +1280,8 @@ is used to further constrain the set of candidates. */)
error ("Bad data in guts of obarray"); error ("Bad data in guts of obarray");
elt = bucket; elt = bucket;
eltstring = elt; eltstring = elt;
if (XSYMBOL (bucket)->next) if (XSYMBOL (bucket)->u.s.next)
XSETSYMBOL (bucket, XSYMBOL (bucket)->next); XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
else else
XSETFASTINT (bucket, 0); XSETFASTINT (bucket, 0);
} }
@ -1533,8 +1533,8 @@ with a space are ignored unless STRING itself starts with a space. */)
error ("Bad data in guts of obarray"); error ("Bad data in guts of obarray");
elt = bucket; elt = bucket;
eltstring = elt; eltstring = elt;
if (XSYMBOL (bucket)->next) if (XSYMBOL (bucket)->u.s.next)
XSETSYMBOL (bucket, XSYMBOL (bucket)->next); XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
else else
XSETFASTINT (bucket, 0); XSETFASTINT (bucket, 0);
} }
@ -1754,9 +1754,9 @@ the values STRING, PREDICATE and `lambda'. */)
tem = tail; tem = tail;
break; break;
} }
if (XSYMBOL (tail)->next == 0) if (XSYMBOL (tail)->u.s.next == 0)
break; break;
XSETSYMBOL (tail, XSYMBOL (tail)->next); XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
} }
} }
} }

2
src/thread.c
View file

@ -26,7 +26,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "coding.h" #include "coding.h"
#include "syssignal.h" #include "syssignal.h"
static struct GCALIGNED thread_state main_thread; static struct thread_state main_thread;
struct thread_state *current_thread = &main_thread; struct thread_state *current_thread = &main_thread;

2
src/xterm.c
View file

@ -12515,7 +12515,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
{ {
terminal->kboard = allocate_kboard (Qx); terminal->kboard = allocate_kboard (Qx);
if (!EQ (XSYMBOL (Qvendor_specific_keysyms)->function, Qunbound)) if (!EQ (XSYMBOL (Qvendor_specific_keysyms)->u.s.function, Qunbound))
{ {
char *vendor = ServerVendor (dpy); char *vendor = ServerVendor (dpy);