mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-08 15:35:02 +00:00
Code Issues Releases Activity

Make variable forwarding explicit rather the using special values.

Browse Source 
Basically, this makes the structure of buffer-local values and object
forwarding explicit in the type of Lisp_Symbols rather than use
special Lisp_Objects for that.  This tends to lead to slightly more
verbose code, but is more C-like, simpler, and makes it easier to make
sure we handled all cases, among other things by letting the compiler
help us check it.
* lisp.h (enum Lisp_Misc_Type, union Lisp_Misc):
Removing forwarding objects.
(enum Lisp_Fwd_Type, enum symbol_redirect, union Lisp_Fwd): New types.
(struct Lisp_Symbol): Make the various forms of variable-forwarding
explicit rather than hiding them inside Lisp_Object "values".
(XFWDTYPE): New macro.
(XINTFWD, XBOOLFWD, XOBJFWD, XKBOARD_OBJFWD): Redefine.
(XBUFFER_LOCAL_VALUE): Remove.
(SYMBOL_VAL, SYMBOL_ALIAS, SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL)
(SET_SYMBOL_ALIAS, SET_SYMBOL_BLV, SET_SYMBOL_FWD): New macros.
(SYMBOL_VALUE, SET_SYMBOL_VALUE): Remove.
(struct Lisp_Intfwd, struct Lisp_Boolfwd, struct Lisp_Objfwd)
(struct Lisp_Buffer_Objfwd, struct Lisp_Kboard_Objfwd):
Remove the Lisp_Misc_* header.
(struct Lisp_Buffer_Local_Value): Redefine.
(BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE): New macros.
(struct Lisp_Misc_Any): Add filler to get the right size.
(struct Lisp_Free): Use struct Lisp_Misc_Any rather than struct
Lisp_Intfwd.
(DEFVAR_LISP, DEFVAR_LISP_NOPRO, DEFVAR_BOOL, DEFVAR_INT)
(DEFVAR_KBOARD): Allocate a forwarding object.
* data.c (do_blv_forwarding, store_blv_forwarding): New macros.
(let_shadows_global_binding_p): New function.
(union Lisp_Val_Fwd): New type.
(make_blv): New function.
(swap_in_symval_forwarding, indirect_variable, do_symval_forwarding)
(store_symval_forwarding, swap_in_global_binding, Fboundp)
(swap_in_symval_forwarding, find_symbol_value, Fset)
(let_shadows_buffer_binding_p, set_internal, default_value)
(Fset_default, Fmake_variable_buffer_local, Fmake_local_variable)
(Fkill_local_variable, Fmake_variable_frame_local)
(Flocal_variable_p, Flocal_variable_if_set_p)
(Fvariable_binding_locus):
* xdisp.c (select_frame_for_redisplay):
* lread.c (Fintern, Funintern, init_obarray, defvar_int)
(defvar_bool, defvar_lisp_nopro, defvar_lisp, defvar_kboard):
* frame.c (store_frame_param):
* eval.c (Fdefvaralias, Fuser_variable_p, specbind, unbind_to):
* bytecode.c (Fbyte_code) <varref, varset>: Adapt to the new symbol
value structure.
* buffer.c (PER_BUFFER_SYMBOL): Move from buffer.h.
(clone_per_buffer_values): Only adjust markers into the current buffer.
(reset_buffer_local_variables): PER_BUFFER_IDX is never -2.
(Fbuffer_local_value, set_buffer_internal_1)
(swap_out_buffer_local_variables):
Adapt to the new symbol value structure.
(DEFVAR_PER_BUFFER): Allocate a Lisp_Buffer_Objfwd object.
(defvar_per_buffer): Take a new arg for the fwd object.
(buffer_lisp_local_variables): Return a proper alist (different fix
for bug#4138).
* alloc.c (Fmake_symbol): Use SET_SYMBOL_VAL.
(Fgarbage_collect): Don't handle buffer_defaults specially.
(mark_object): Handle new symbol value structure rather than the old
special Lisp_Misc_* objects.
(gc_sweep) <symbols>: Free also the buffer-local-value objects.
* term.c (set_tty_color_mode):
* bidi.c (bidi_initialize): Don't access the ->value field directly.
* buffer.h (PER_BUFFER_VAR_OFFSET): Don't bother with
a buffer_local_flags.
* print.c (print_object): Get rid of impossible forwarding objects.
This commit is contained in:
Stefan Monnier 2010-04-19 21:50:52 -04:00
parent 56d365a93d
commit ce5b453a44
18 changed files with 1295 additions and 1045 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
src/ChangeLog
View File

@ -1,9 +1,79 @@
2010-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
Make variable forwarding explicit rather the using special values.
Basically, this makes the structure of buffer-local values and object
forwarding explicit in the type of Lisp_Symbols rather than use
special Lisp_Objects for that. This tends to lead to slightly more
verbose code, but is more C-like, simpler, and makes it easier to make
sure we handled all cases, among other things by letting the compiler
help us check it.
* lisp.h (enum Lisp_Misc_Type, union Lisp_Misc):
Removing forwarding objects.
(enum Lisp_Fwd_Type, enum symbol_redirect, union Lisp_Fwd): New types.
(struct Lisp_Symbol): Make the various forms of variable-forwarding
explicit rather than hiding them inside Lisp_Object "values".
(XFWDTYPE): New macro.
(XINTFWD, XBOOLFWD, XOBJFWD, XKBOARD_OBJFWD): Redefine.
(XBUFFER_LOCAL_VALUE): Remove.
(SYMBOL_VAL, SYMBOL_ALIAS, SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL)
(SET_SYMBOL_ALIAS, SET_SYMBOL_BLV, SET_SYMBOL_FWD): New macros.
(SYMBOL_VALUE, SET_SYMBOL_VALUE): Remove.
(struct Lisp_Intfwd, struct Lisp_Boolfwd, struct Lisp_Objfwd)
(struct Lisp_Buffer_Objfwd, struct Lisp_Kboard_Objfwd):
Remove the Lisp_Misc_* header.
(struct Lisp_Buffer_Local_Value): Redefine.
(BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE): New macros.
(struct Lisp_Misc_Any): Add filler to get the right size.
(struct Lisp_Free): Use struct Lisp_Misc_Any rather than struct
Lisp_Intfwd.
(DEFVAR_LISP, DEFVAR_LISP_NOPRO, DEFVAR_BOOL, DEFVAR_INT)
(DEFVAR_KBOARD): Allocate a forwarding object.
* data.c (do_blv_forwarding, store_blv_forwarding): New macros.
(let_shadows_global_binding_p): New function.
(union Lisp_Val_Fwd): New type.
(make_blv): New function.
(swap_in_symval_forwarding, indirect_variable, do_symval_forwarding)
(store_symval_forwarding, swap_in_global_binding, Fboundp)
(swap_in_symval_forwarding, find_symbol_value, Fset)
(let_shadows_buffer_binding_p, set_internal, default_value)
(Fset_default, Fmake_variable_buffer_local, Fmake_local_variable)
(Fkill_local_variable, Fmake_variable_frame_local)
(Flocal_variable_p, Flocal_variable_if_set_p)
(Fvariable_binding_locus):
* xdisp.c (select_frame_for_redisplay):
* lread.c (Fintern, Funintern, init_obarray, defvar_int)
(defvar_bool, defvar_lisp_nopro, defvar_lisp, defvar_kboard):
* frame.c (store_frame_param):
* eval.c (Fdefvaralias, Fuser_variable_p, specbind, unbind_to):
* bytecode.c (Fbyte_code) <varref, varset>: Adapt to the new symbol
value structure.
* buffer.c (PER_BUFFER_SYMBOL): Move from buffer.h.
(clone_per_buffer_values): Only adjust markers into the current buffer.
(reset_buffer_local_variables): PER_BUFFER_IDX is never -2.
(Fbuffer_local_value, set_buffer_internal_1)
(swap_out_buffer_local_variables):
Adapt to the new symbol value structure.
(DEFVAR_PER_BUFFER): Allocate a Lisp_Buffer_Objfwd object.
(defvar_per_buffer): Take a new arg for the fwd object.
(buffer_lisp_local_variables): Return a proper alist (different fix
for bug#4138).
* alloc.c (Fmake_symbol): Use SET_SYMBOL_VAL.
(Fgarbage_collect): Don't handle buffer_defaults specially.
(mark_object): Handle new symbol value structure rather than the old
special Lisp_Misc_* objects.
(gc_sweep) <symbols>: Free also the buffer-local-value objects.
* term.c (set_tty_color_mode):
* bidi.c (bidi_initialize): Don't access the ->value field directly.
* buffer.h (PER_BUFFER_VAR_OFFSET): Don't bother with
a buffer_local_flags.
* print.c (print_object): Get rid of impossible forwarding objects.
2010-04-19 Eli Zaretskii <eliz@gnu.org>
* bidi.c (bidi_get_type, bidi_get_category)
(bidi_at_paragraph_end, bidi_resolve_weak, bidi_resolve_neutral)
(bidi_type_of_next_char, bidi_level_of_next_char): Declare
static. Use `INLINE' rather than `inline'.
(bidi_type_of_next_char, bidi_level_of_next_char):
Declare static. Use `INLINE' rather than `inline'.
2010-04-19 Juanma Barranquero <lekktu@gmail.com>

70
src/alloc.c
View File

@ -1365,7 +1365,7 @@ uninterrupt_malloc ()
pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE);
pthread_mutex_init (&alloc_mutex, &attr);
#else /* !DOUG_LEA_MALLOC */
/* Some systems such as Solaris 2.6 doesn't have a recursive mutex,
/* Some systems such as Solaris 2.6 don't have a recursive mutex,
and the bundled gmalloc.c doesn't require it. */
pthread_mutex_init (&alloc_mutex, NULL);
#endif /* !DOUG_LEA_MALLOC */
@ -3193,13 +3193,13 @@ Its value and function definition are void, and its property list is nil. */)
p = XSYMBOL (val);
p->xname = name;
p->plist = Qnil;
p->value = Qunbound;
p->redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (p, Qunbound);
p->function = Qunbound;
p->next = NULL;
p->gcmarkbit = 0;
p->interned = SYMBOL_UNINTERNED;
p->constant = 0;
p->indirect_variable = 0;
consing_since_gc += sizeof (struct Lisp_Symbol);
symbols_consed++;
return val;
@ -5581,17 +5581,42 @@ mark_object (arg)
break;
CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
ptr->gcmarkbit = 1;
mark_object (ptr->value);
mark_object (ptr->function);
mark_object (ptr->plist);
switch (ptr->redirect)
{
case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break;
case SYMBOL_VARALIAS:
{
Lisp_Object tem;
XSETSYMBOL (tem, SYMBOL_ALIAS (ptr));
mark_object (tem);
break;
}
case SYMBOL_LOCALIZED:
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr);
/* If the value is forwarded to a buffer or keyboard field,
these are marked when we see the corresponding object.
And if it's forwarded to a C variable, either it's not
a Lisp_Object var, or it's staticpro'd already. */
mark_object (blv->where);
mark_object (blv->valcell);
mark_object (blv->defcell);
break;
}
case SYMBOL_FORWARDED:
/* If the value is forwarded to a buffer or keyboard field,
these are marked when we see the corresponding object.
And if it's forwarded to a C variable, either it's not
a Lisp_Object var, or it's staticpro'd already. */
break;
default: abort ();
}
if (!PURE_POINTER_P (XSTRING (ptr->xname)))
MARK_STRING (XSTRING (ptr->xname));
MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname));
/* Note that we do not mark the obarray of the symbol.
It is safe not to do so because nothing accesses that
slot except to check whether it is nil. */
ptr = ptr->next;
if (ptr)
{
@ -5610,22 +5635,6 @@ mark_object (arg)
switch (XMISCTYPE (obj))
{
case Lisp_Misc_Buffer_Local_Value:
{
register struct Lisp_Buffer_Local_Value *ptr
= XBUFFER_LOCAL_VALUE (obj);
/* If the cdr is nil, avoid recursion for the car. */
if (EQ (ptr->cdr, Qnil))
{
obj = ptr->realvalue;
goto loop;
}
mark_object (ptr->realvalue);
mark_object (ptr->buffer);
mark_object (ptr->frame);
obj = ptr->cdr;
goto loop;
}
case Lisp_Misc_Marker:
/* DO NOT mark thru the marker's chain.
@ -5633,17 +5642,6 @@ mark_object (arg)
instead, markers are removed from the chain when freed by gc. */
break;
case Lisp_Misc_Intfwd:
case Lisp_Misc_Boolfwd:
case Lisp_Misc_Objfwd:
case Lisp_Misc_Buffer_Objfwd:
case Lisp_Misc_Kboard_Objfwd:
/* Don't bother with Lisp_Buffer_Objfwd,
since all markable slots in current buffer marked anyway. */
/* Don't need to do Lisp_Objfwd, since the places they point
are protected with staticpro. */
break;
case Lisp_Misc_Save_Value:
#if GC_MARK_STACK
{
@ -6048,6 +6046,8 @@ gc_sweep ()
if (!sym->gcmarkbit && !pure_p)
{
if (sym->redirect == SYMBOL_LOCALIZED)
xfree (SYMBOL_BLV (sym));
sym->next = symbol_free_list;
symbol_free_list = sym;
#if GC_MARK_STACK

5
src/bidi.c
View File

@ -400,14 +400,14 @@ bidi_initialize ()
make_number (bidi_type[i].type));
fallback_paragraph_start_re =
XSYMBOL (Fintern_soft (build_string ("paragraph-start"), Qnil))->value;
Fsymbol_value (Fintern_soft (build_string ("paragraph-start"), Qnil));
if (!STRINGP (fallback_paragraph_start_re))
fallback_paragraph_start_re = build_string ("\f\\|[ \t]*$");
staticpro (&fallback_paragraph_start_re);
Qparagraph_start = intern ("paragraph-start");
staticpro (&Qparagraph_start);
fallback_paragraph_separate_re =
XSYMBOL (Fintern_soft (build_string ("paragraph-separate"), Qnil))->value;
Fsymbol_value (Fintern_soft (build_string ("paragraph-separate"), Qnil));
if (!STRINGP (fallback_paragraph_separate_re))
fallback_paragraph_separate_re = build_string ("[ \t\f]*$");
staticpro (&fallback_paragraph_separate_re);
@ -879,7 +879,6 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it)
int ch, ch_len;
EMACS_INT pos;
bidi_type_t type;
EMACS_INT sep_len;
/* If we are inside a paragraph separator, we are just waiting
for the separator to be exhausted; use the previous paragraph

205
src/buffer.c
View File

@ -78,9 +78,6 @@ static Lisp_Object Vbuffer_defaults;
be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
and the corresponding slot in buffer_defaults is not used.
If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
but there is a default value which is copied into each buffer.
If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
zero, that is a bug */
@ -94,6 +91,12 @@ DECL_ALIGN (struct buffer, buffer_local_symbols);
/* A Lisp_Object pointer to the above, used for staticpro */
static Lisp_Object Vbuffer_local_symbols;
/* Return the symbol of the per-buffer variable at offset OFFSET in
the buffer structure. */
#define PER_BUFFER_SYMBOL(OFFSET) \
(*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
/* Flags indicating which built-in buffer-local variables
are permanent locals. */
static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
@ -507,7 +510,7 @@ clone_per_buffer_values (from, to)
continue;
obj = PER_BUFFER_VALUE (from, offset);
if (MARKERP (obj))
if (MARKERP (obj) && XMARKER (obj)->buffer == from)
{
struct Lisp_Marker *m = XMARKER (obj);
obj = Fmake_marker ();
@ -770,9 +773,7 @@ reset_buffer_local_variables (b, permanent_too)
{
Lisp_Object tmp, prop, last = Qnil;
for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp))
if (CONSP (XCAR (tmp))
&& SYMBOLP (XCAR (XCAR (tmp)))
&& !NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
{
/* If permanent-local, keep it. */
last = tmp;
@ -822,9 +823,7 @@ reset_buffer_local_variables (b, permanent_too)
int idx = PER_BUFFER_IDX (offset);
if ((idx > 0
&& (permanent_too
|| buffer_permanent_local_flags[idx] == 0))
/* Is -2 used anywhere? */
|| idx == -2)
|| buffer_permanent_local_flags[idx] == 0)))
PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
}
}
@ -938,59 +937,49 @@ is the default binding of the variable. */)
CHECK_SYMBOL (variable);
CHECK_BUFFER (buffer);
buf = XBUFFER (buffer);
sym = XSYMBOL (variable);
sym = indirect_variable (XSYMBOL (variable));
XSETSYMBOL (variable, sym);
/* Look in local_var_list */
result = Fassoc (variable, buf->local_var_alist);
if (NILP (result))
start:
switch (sym->redirect)
{
int offset, idx;
int found = 0;
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
case SYMBOL_LOCALIZED:
{ /* Look in local_var_alist. */
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
result = Fassoc (variable, buf->local_var_alist);
if (!NILP (result))
{
if (blv->fwd)
{ /* What binding is loaded right now? */
Lisp_Object current_alist_element = blv->valcell;
/* Look in special slots */
/* buffer-local Lisp variables start at `undo_list',
tho only the ones from `name' on are GC'd normally. */
for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
offset < sizeof (struct buffer);
/* sizeof EMACS_INT == sizeof Lisp_Object */
offset += (sizeof (EMACS_INT)))
{
idx = PER_BUFFER_IDX (offset);
if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
&& SYMBOLP (PER_BUFFER_SYMBOL (offset))
&& EQ (PER_BUFFER_SYMBOL (offset), variable))
{
result = PER_BUFFER_VALUE (buf, offset);
found = 1;
break;
}
}
/* The value of the currently loaded binding is not
stored in it, but rather in the realvalue slot.
Store that value into the binding it belongs to
in case that is the one we are about to use. */
if (!found)
result = Fdefault_value (variable);
}
else
{
Lisp_Object valcontents;
Lisp_Object current_alist_element;
/* What binding is loaded right now? */
valcontents = sym->value;
current_alist_element
= XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
/* The value of the currently loaded binding is not
stored in it, but rather in the realvalue slot.
Store that value into the binding it belongs to
in case that is the one we are about to use. */
Fsetcdr (current_alist_element,
do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
/* Now get the (perhaps updated) value out of the binding. */
result = XCDR (result);
XSETCDR (current_alist_element,
do_symval_forwarding (blv->fwd));
}
/* Now get the (perhaps updated) value out of the binding. */
result = XCDR (result);
}
else
result = Fdefault_value (variable);
break;
}
case SYMBOL_FORWARDED:
{
union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
if (BUFFER_OBJFWDP (fwd))
result = PER_BUFFER_VALUE (buf, XBUFFER_OBJFWD (fwd)->offset);
else
result = Fdefault_value (variable);
break;
}
default: abort ();
}
if (!EQ (result, Qunbound))
@ -1025,12 +1014,7 @@ buffer_lisp_local_variables (buf)
if (buf != current_buffer)
val = XCDR (elt);
/* If symbol is unbound, put just the symbol in the list. */
if (EQ (val, Qunbound))
result = Fcons (XCAR (elt), result);
/* Otherwise, put (symbol . value) in the list. */
else
result = Fcons (Fcons (XCAR (elt), val), result);
result = Fcons (Fcons (XCAR (elt), val), result);
}
return result;
@ -1862,8 +1846,7 @@ set_buffer_internal_1 (b)
register struct buffer *b;
{
register struct buffer *old_buf;
register Lisp_Object tail, valcontents;
Lisp_Object tem;
register Lisp_Object tail;
#ifdef USE_MMAP_FOR_BUFFERS
if (b->text->beg == NULL)
@ -1935,34 +1918,21 @@ set_buffer_internal_1 (b)
/* Look down buffer's list of local Lisp variables
to find and update any that forward into C variables. */
for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail))
do
{
if (CONSP (XCAR (tail))
&& SYMBOLP (XCAR (XCAR (tail)))
&& (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
(BUFFER_LOCAL_VALUEP (valcontents)))
&& (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
(BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
/* Just reference the variable to cause it to become set for
this buffer. */
Fsymbol_value (XCAR (XCAR (tail)));
for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object var = XCAR (XCAR (tail));
struct Lisp_Symbol *sym = XSYMBOL (var);
if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */
&& SYMBOL_BLV (sym)->fwd)
/* Just reference the variable
to cause it to become set for this buffer. */
Fsymbol_value (var);
}
}
/* Do the same with any others that were local to the previous buffer */
if (old_buf)
for (tail = old_buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
{
if (CONSP (tail)
&& SYMBOLP (XCAR (XCAR (tail)))
&& (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
(BUFFER_LOCAL_VALUEP (valcontents)))
&& (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
(BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
/* Just reference the variable to cause it to become set for
this buffer. */
Fsymbol_value (XCAR (XCAR (tail)));
}
while (b != old_buf && (b = old_buf, b));
}
/* Switch to buffer B temporarily for redisplay purposes.
@ -2677,23 +2647,22 @@ static void
swap_out_buffer_local_variables (b)
struct buffer *b;
{
Lisp_Object oalist, alist, sym, buffer;
Lisp_Object oalist, alist, buffer;
XSETBUFFER (buffer, b);
oalist = b->local_var_alist;
for (alist = oalist; CONSP (alist); alist = XCDR (alist))
{
if (CONSP (XCAR (alist))
&& (sym = XCAR (XCAR (alist)), SYMBOLP (sym))
/* Need not do anything if some other buffer's binding is
now encached. */
&& EQ (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->buffer,
buffer))
Lisp_Object sym = XCAR (XCAR (alist));
eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED);
/* Need not do anything if some other buffer's binding is
now encached. */
if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
{
/* Symbol is set up for this buffer's old local value:
swap it out! */
swap_in_global_binding (sym);
swap_in_global_binding (XSYMBOL (sym));
}
}
}
@ -5162,7 +5131,9 @@ init_buffer_once ()
/* Make sure all markable slots in buffer_defaults
are initialized reasonably, so mark_buffer won't choke. */
reset_buffer (&buffer_defaults);
eassert (EQ (buffer_defaults.name, make_number (0)));
reset_buffer_local_variables (&buffer_defaults, 1);
eassert (EQ (buffer_local_symbols.name, make_number (0)));
reset_buffer (&buffer_local_symbols);
reset_buffer_local_variables (&buffer_local_symbols, 1);
/* Prevent GC from getting confused. */
@ -5421,33 +5392,41 @@ init_buffer ()
in the buffer that is current now. */
/* TYPE is nil for a general Lisp variable.
An integer specifies a type; then only LIsp values
An integer specifies a type; then only Lisp values
with that type code are allowed (except that nil is allowed too).
LNAME is the LIsp-level variable name.
LNAME is the Lisp-level variable name.
VNAME is the name of the buffer slot.
DOC is a dummy where you write the doc string as a comment. */
#define DEFVAR_PER_BUFFER(lname, vname, type, doc) \
defvar_per_buffer (lname, vname, type, 0)
#define DEFVAR_PER_BUFFER(lname, vname, type, doc) \
do { \
static struct Lisp_Buffer_Objfwd bo_fwd; \
defvar_per_buffer (&bo_fwd, lname, vname, type, 0); \
} while (0)
static void
defvar_per_buffer (namestring, address, type, doc)
defvar_per_buffer (bo_fwd, namestring, address, type, doc)
struct Lisp_Buffer_Objfwd *bo_fwd;
char *namestring;
Lisp_Object *address;
Lisp_Object type;
char *doc;
{
Lisp_Object sym, val;
struct Lisp_Symbol *sym;
int offset;
sym = intern (namestring);
val = allocate_misc ();
sym = XSYMBOL (intern (namestring));
offset = (char *)address - (char *)current_buffer;
XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
XBUFFER_OBJFWD (val)->offset = offset;
XBUFFER_OBJFWD (val)->slottype = type;
SET_SYMBOL_VALUE (sym, val);
PER_BUFFER_SYMBOL (offset) = sym;
bo_fwd->type = Lisp_Fwd_Buffer_Obj;
bo_fwd->offset = offset;
bo_fwd->slottype = type;
sym->redirect = SYMBOL_FORWARDED;
{
/* I tried to do the job without a cast, but it seems impossible.
union Lisp_Fwd *fwd; &(fwd->u_buffer_objfwd) = bo_fwd; */
SET_SYMBOL_FWD (sym, (union Lisp_Fwd *)bo_fwd);
}
XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
if (PER_BUFFER_IDX (offset) == 0)
/* Did a DEFVAR_PER_BUFFER without initializing the corresponding

25
src/buffer.h
View File

@ -107,6 +107,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define BUF_BEG(buf) (BEG)
#define BUF_BEG_BYTE(buf) (BEG_BYTE)
/* !!!FIXME: all the BUF_BEGV/BUF_ZV/BUF_PT macros are flawed:
on indirect (or base) buffers, that value is only correct if that buffer
is the current_buffer, or if the buffer's text hasn't been modified (via
an indirect buffer) since it was last current. */
/* Position of beginning of accessible range of buffer. */
#define BUF_BEGV(buf) ((buf)->begv)
#define BUF_BEGV_BYTE(buf) ((buf)->begv_byte)
@ -313,7 +318,7 @@ while (0)
- (ptr - (current_buffer)->text->beg <= (unsigned) (GPT_BYTE - BEG_BYTE) ? 0 : GAP_SIZE) \
+ BEG_BYTE)
/* Return character at position POS. */
/* Return character at byte position POS. */
#define FETCH_CHAR(pos) \
(!NILP (current_buffer->enable_multibyte_characters) \
@ -327,7 +332,7 @@ while (0)
/* Variables used locally in FETCH_MULTIBYTE_CHAR. */
extern unsigned char *_fetch_multibyte_char_p;
/* Return character code of multi-byte form at position POS. If POS
/* Return character code of multi-byte form at byte position POS. If POS
doesn't point the head of valid multi-byte form, only the byte at
POS is returned. No range checking. */
@ -336,7 +341,7 @@ extern unsigned char *_fetch_multibyte_char_p;
+ (pos) + BEG_ADDR - BEG_BYTE), \
STRING_CHAR (_fetch_multibyte_char_p))
/* Return character at position POS. If the current buffer is unibyte
/* Return character at byte position POS. If the current buffer is unibyte
and the character is not ASCII, make the returning character
multibyte. */
@ -447,7 +452,10 @@ struct buffer_text
/* The markers that refer to this buffer.
This is actually a single marker ---
successive elements in its marker `chain'
are the other markers referring to this buffer. */
are the other markers referring to this buffer.
This is a singly linked unordered list, which means that it's
very cheap to add a marker to the list and it's also very cheap
to move a marker within a buffer. */
struct Lisp_Marker *markers;
/* Usually 0. Temporarily set to 1 in decode_coding_gap to
@ -843,6 +851,7 @@ extern struct buffer buffer_defaults;
be a Lisp-level local variable for the slot, it has no default value,
and the corresponding slot in buffer_defaults is not used. */
extern struct buffer buffer_local_flags;
/* For each buffer slot, this points to the Lisp symbol name
@ -948,7 +957,7 @@ extern int last_per_buffer_idx;
from the start of a buffer structure. */
#define PER_BUFFER_VAR_OFFSET(VAR) \
((char *) &buffer_local_flags.VAR - (char *) &buffer_local_flags)
((char *) &((struct buffer *)0)->VAR - (char *) ((struct buffer *)0))
/* Return the index of buffer-local variable VAR. Each per-buffer
variable has an index > 0 associated with it, except when it always
@ -1013,11 +1022,5 @@ extern int last_per_buffer_idx;
#define PER_BUFFER_VALUE(BUFFER, OFFSET) \
(*(Lisp_Object *)((OFFSET) + (char *) (BUFFER)))
/* Return the symbol of the per-buffer variable at offset OFFSET in
the buffer structure. */
#define PER_BUFFER_SYMBOL(OFFSET) \
(*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
/* arch-tag: 679305dd-d41c-4a50-b170-3caf5c97b2d1
(do not change this comment) */

12
src/bytecode.c
View File

@ -505,8 +505,9 @@ If the third argument is incorrect, Emacs may crash. */)
v1 = vectorp[op];
if (SYMBOLP (v1))
{
v2 = SYMBOL_VALUE (v1);
if (MISCP (v2) || EQ (v2, Qunbound))
if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
|| (v2 = SYMBOL_VAL (XSYMBOL (v1)),
EQ (v2, Qunbound)))
{
BEFORE_POTENTIAL_GC ();
v2 = Fsymbol_value (v1);
@ -597,10 +598,9 @@ If the third argument is incorrect, Emacs may crash. */)
/* Inline the most common case. */
if (SYMBOLP (sym)
&& !EQ (val, Qunbound)
&& !XSYMBOL (sym)->indirect_variable
&& !SYMBOL_CONSTANT_P (sym)
&& !MISCP (XSYMBOL (sym)->value))
XSYMBOL (sym)->value = val;
&& !XSYMBOL (sym)->redirect
&& !SYMBOL_CONSTANT_P (sym))
XSYMBOL (sym)->val.value = val;
else
{
BEFORE_POTENTIAL_GC ();

2
src/character.h
View File

@ -296,7 +296,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* If P is after LIMIT, advance P to the previous character boundary.
Assumes that P is already at a character boundary of the same
mulitbyte form whose beginning address is LIMIT. */
multibyte form whose beginning address is LIMIT. */
#define PREV_CHAR_BOUNDARY(p, limit) \
do { \

2
src/coding.c
View File

@ -6408,7 +6408,7 @@ detect_coding (coding)
{
/* We didn't find an 8-bit code. We may
have found a null-byte, but it's very
rare that a binary file confirm to
rare that a binary file conforms to
ISO-2022. */
src = src_end;
coding->head_ascii = src - coding->source;

1217
src/data.c
View File

File diff suppressed because it is too large Load Diff

210
src/eval.c
View File

@ -767,24 +767,46 @@ The return value is BASE-VARIABLE. */)
CHECK_SYMBOL (new_alias);
CHECK_SYMBOL (base_variable);
if (SYMBOL_CONSTANT_P (new_alias))
error ("Cannot make a constant an alias");
sym = XSYMBOL (new_alias);
if (sym->constant)
if (sym->redirect == SYMBOL_VARALIAS)
sym->constant = 0; /* Reset. */
else
/* Not sure why. */
error ("Cannot make a constant an alias");
switch (sym->redirect)
{
case SYMBOL_FORWARDED:
error ("Cannot make an internal variable an alias");
case SYMBOL_LOCALIZED:
error ("Don't know how to make a localized variable an alias");
}
/* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
If n_a is bound, but b_v is not, set the value of b_v to n_a.
This is for the sake of define-obsolete-variable-alias and user
customizations. */
if (NILP (Fboundp (base_variable)) && !NILP (Fboundp (new_alias)))
XSYMBOL(base_variable)->value = sym->value;
sym->indirect_variable = 1;
sym->value = base_variable;
If n_a is bound, but b_v is not, set the value of b_v to n_a,
so that old-code that affects n_a before the aliasing is setup
still works. */
if (NILP (Fboundp (base_variable)))
set_internal (base_variable, find_symbol_value (new_alias), NULL, 1);
{
struct specbinding *p;
for (p = specpdl_ptr - 1; p >= specpdl; p--)
if (p->func == NULL
&& (EQ (new_alias,
CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
error ("Don't know how to make a let-bound variable an alias");
}
sym->redirect = SYMBOL_VARALIAS;
SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
sym->constant = SYMBOL_CONSTANT_P (base_variable);
LOADHIST_ATTACH (new_alias);
if (!NILP (docstring))
Fput (new_alias, Qvariable_documentation, docstring);
else
Fput (new_alias, Qvariable_documentation, Qnil);
/* Even if docstring is nil: remove old docstring. */
Fput (new_alias, Qvariable_documentation, docstring);
return base_variable;
}
@ -944,7 +966,7 @@ chain of symbols. */)
return Qnil;
/* If indirect and there's an alias loop, don't check anything else. */
if (XSYMBOL (variable)->indirect_variable
if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS
&& NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
Qt, user_variable_p_eh)))
return Qnil;
@ -968,11 +990,11 @@ chain of symbols. */)
|| (!NILP (Fget (variable, intern ("custom-autoload")))))
return Qt;
if (!XSYMBOL (variable)->indirect_variable)
if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS))
return Qnil;
/* An indirect variable? Let's follow the chain. */
variable = XSYMBOL (variable)->value;
XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable)));
}
}
@ -3263,78 +3285,94 @@ void
specbind (symbol, value)
Lisp_Object symbol, value;
{
Lisp_Object valcontents;
struct Lisp_Symbol *sym;
eassert (!handling_signal);
CHECK_SYMBOL (symbol);
sym = XSYMBOL (symbol);
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
/* The most common case is that of a non-constant symbol with a
trivial value. Make that as fast as we can. */
valcontents = SYMBOL_VALUE (symbol);
if (!MISCP (valcontents) && !SYMBOL_CONSTANT_P (symbol))
start:
switch (sym->redirect)
{
specpdl_ptr->symbol = symbol;
specpdl_ptr->old_value = valcontents;
specpdl_ptr->func = NULL;
++specpdl_ptr;
SET_SYMBOL_VALUE (symbol, value);
}
else
{
Lisp_Object ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
specpdl_ptr->old_value = ovalue;
valcontents = XSYMBOL (symbol)->value;
if (BUFFER_LOCAL_VALUEP (valcontents)
|| BUFFER_OBJFWDP (valcontents))
{
Lisp_Object where, current_buffer;
current_buffer = Fcurrent_buffer ();
/* For a local variable, record both the symbol and which
buffer's or frame's value we are saving. */
if (!NILP (Flocal_variable_p (symbol, Qnil)))
where = current_buffer;
else if (BUFFER_LOCAL_VALUEP (valcontents)
&& XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
where = XBUFFER_LOCAL_VALUE (valcontents)->frame;
case SYMBOL_VARALIAS:
sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
case SYMBOL_PLAINVAL:
{ /* The most common case is that of a non-constant symbol with a
trivial value. Make that as fast as we can. */
specpdl_ptr->symbol = symbol;
specpdl_ptr->old_value = SYMBOL_VAL (sym);
specpdl_ptr->func = NULL;
++specpdl_ptr;
if (!sym->constant)
SET_SYMBOL_VAL (sym, value);
else
where = Qnil;
/* We're not using the `unused' slot in the specbinding
structure because this would mean we have to do more
work for simple variables. */
specpdl_ptr->symbol = Fcons (symbol, Fcons (where, current_buffer));
/* If SYMBOL is a per-buffer variable which doesn't have a
buffer-local value here, make the `let' change the global
value by changing the value of SYMBOL in all buffers not
having their own value. This is consistent with what
happens with other buffer-local variables. */
if (NILP (where)
&& BUFFER_OBJFWDP (valcontents))
{
++specpdl_ptr;
Fset_default (symbol, value);
return;
}
set_internal (symbol, value, 0, 1);
break;
}
else
specpdl_ptr->symbol = symbol;
case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED:
{
Lisp_Object ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
specpdl_ptr->old_value = ovalue;
specpdl_ptr++;
/* We used to do
if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
store_symval_forwarding (symbol, ovalue, value, NULL);
else
but ovalue comes from find_symbol_value which should never return
such an internal value. */
eassert (!(BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue)));
set_internal (symbol, value, 0, 1);
eassert (sym->redirect != SYMBOL_LOCALIZED
|| (EQ (SYMBOL_BLV (sym)->where,
SYMBOL_BLV (sym)->frame_local ?
Fselected_frame () : Fcurrent_buffer ())));
if (sym->redirect == SYMBOL_LOCALIZED
|| BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
{
Lisp_Object where, cur_buf = Fcurrent_buffer ();
/* For a local variable, record both the symbol and which
buffer's or frame's value we are saving. */
if (!NILP (Flocal_variable_p (symbol, Qnil)))
{
eassert (sym->redirect != SYMBOL_LOCALIZED
|| (BLV_FOUND (SYMBOL_BLV (sym))
&& EQ (cur_buf, SYMBOL_BLV (sym)->where)));
where = cur_buf;
}
else if (sym->redirect == SYMBOL_LOCALIZED
&& BLV_FOUND (SYMBOL_BLV (sym)))
where = SYMBOL_BLV (sym)->where;
else
where = Qnil;
/* We're not using the `unused' slot in the specbinding
structure because this would mean we have to do more
work for simple variables. */
/* FIXME: The third value `current_buffer' is only used in
let_shadows_buffer_binding_p which is itself only used
in set_internal for local_if_set. */
specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf));
/* If SYMBOL is a per-buffer variable which doesn't have a
buffer-local value here, make the `let' change the global
value by changing the value of SYMBOL in all buffers not
having their own value. This is consistent with what
happens with other buffer-local variables. */
if (NILP (where)
&& sym->redirect == SYMBOL_FORWARDED)
{
eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym)));
++specpdl_ptr;
Fset_default (symbol, value);
return;
}
}
else
specpdl_ptr->symbol = symbol;
specpdl_ptr++;
set_internal (symbol, value, 0, 1);
break;
}
default: abort ();
}
}
@ -3394,7 +3432,12 @@ unbind_to (count, value)
if (NILP (where))
Fset_default (symbol, this_binding.old_value);
else if (BUFFERP (where))
set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
if (!NILP (Flocal_variable_p (symbol, where)))
set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
/* else if (!NILP (Fbuffer_live_p (where)))
error ("Unbinding local %s to global!", symbol); */
else
;
else
set_internal (symbol, this_binding.old_value, NULL, 1);
}
@ -3403,8 +3446,9 @@ unbind_to (count, value)
/* If variable has a trivial value (no forwarding), we can
just set it. No need to check for constant symbols here,
since that was already done by specbind. */
if (!MISCP (SYMBOL_VALUE (this_binding.symbol)))
SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value);
if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL)
SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol),
this_binding.old_value);
else
set_internal (this_binding.symbol, this_binding.old_value, 0, 1);
}

23
src/frame.c
View File

@ -2298,13 +2298,20 @@ store_frame_param (f, prop, val)
without messing up the symbol's status. */
if (SYMBOLP (prop))
{
Lisp_Object valcontents;
valcontents = SYMBOL_VALUE (prop);
if ((BUFFER_LOCAL_VALUEP (valcontents))
&& XBUFFER_LOCAL_VALUE (valcontents)->check_frame
&& XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame
&& XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame) == f)
swap_in_global_binding (prop);
struct Lisp_Symbol *sym = XSYMBOL (prop);
start:
switch (sym->redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
case SYMBOL_LOCALIZED:
{ struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
if (blv->frame_local && BLV_FOUND (blv) && XFRAME (blv->where) == f)
swap_in_global_binding (sym);
break;
}
default: abort ();
}
}
/* The tty color needed to be set before the frame's parameter
@ -2520,6 +2527,8 @@ If FRAME is nil, describe the currently selected frame. */)
|| EQ (parameter, Qbackground_mode))
value = Fcdr (Fassq (parameter, f->param_alist));
else
/* FIXME: Avoid this code path at all (as well as code duplication)
by sharing more code with Fframe_parameters. */
value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
}

2
src/insdel.c
View File

@ -54,7 +54,7 @@ static void adjust_point (EMACS_INT nchars, EMACS_INT nbytes);
Lisp_Object Fcombine_after_change_execute ();
/* Non-nil means don't call the after-change-functions right away,
just record an element in Vcombine_after_change_calls_list. */
just record an element in combine_after_change_list. */
Lisp_Object Vcombine_after_change_calls;
/* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)

1
src/keyboard.c
View File

@ -1520,7 +1520,6 @@ Lisp_Object
command_loop_1 ()
{
Lisp_Object cmd;
int lose;
Lisp_Object keybuf[30];
int i;
int prev_modiff = 0;

297
src/lisp.h
View File

@ -223,13 +223,7 @@ enum Lisp_Misc_Type
{
Lisp_Misc_Free = 0x5eab,
Lisp_Misc_Marker,
Lisp_Misc_Intfwd,
Lisp_Misc_Boolfwd,
Lisp_Misc_Objfwd,
Lisp_Misc_Buffer_Objfwd,
Lisp_Misc_Buffer_Local_Value,
Lisp_Misc_Overlay,
Lisp_Misc_Kboard_Objfwd,
Lisp_Misc_Save_Value,
/* Currently floats are not a misc type,
but let's define this in case we want to change that. */
@ -238,6 +232,18 @@ enum Lisp_Misc_Type
Lisp_Misc_Limit
};
/* These are the types of forwarding objects used in the value slot
of symbols for special built-in variables whose value is stored in
C variables. */
enum Lisp_Fwd_Type
{
Lisp_Fwd_Int, /* Fwd to a C `int' variable. */
Lisp_Fwd_Bool, /* Fwd to a C boolean var. */
Lisp_Fwd_Obj, /* Fwd to a C Lisp_Object variable. */
Lisp_Fwd_Buffer_Obj, /* Fwd to a Lisp_Object field of buffers. */
Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */
};
#ifndef GCTYPEBITS
#define GCTYPEBITS 3
#endif
@ -566,17 +572,19 @@ extern size_t pure_size;
#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC(a)->u_any))
#define XMISCTYPE(a) (XMISCANY (a)->type)
#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC(a)->u_marker))
#define XINTFWD(a) (eassert (INTFWDP (a)), &(XMISC(a)->u_intfwd))
#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &(XMISC(a)->u_boolfwd))
#define XOBJFWD(a) (eassert (OBJFWDP (a)), &(XMISC(a)->u_objfwd))
#define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC(a)->u_overlay))
#define XSAVE_VALUE(a) (eassert (SAVE_VALUEP (a)), &(XMISC(a)->u_save_value))
/* Forwarding object types. */
#define XFWDTYPE(a) (a->u_intfwd.type)
#define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd))
#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd))
#define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd))
#define XBUFFER_OBJFWD(a) \
(eassert (BUFFER_OBJFWDP (a)), &(XMISC(a)->u_buffer_objfwd))
#define XBUFFER_LOCAL_VALUE(a) \
(eassert (BUFFER_LOCAL_VALUEP (a)), &(XMISC(a)->u_buffer_local_value))
(eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd))
#define XKBOARD_OBJFWD(a) \
(eassert (KBOARD_OBJFWDP (a)), &(XMISC(a)->u_kboard_objfwd))
(eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd))
/* Pseudovector types. */
@ -988,19 +996,32 @@ enum symbol_interned
SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
};
enum symbol_redirect
{
SYMBOL_PLAINVAL = 4,
SYMBOL_VARALIAS = 1,
SYMBOL_LOCALIZED = 2,
SYMBOL_FORWARDED = 3
};
/* In a symbol, the markbit of the plist is used as the gc mark bit */
struct Lisp_Symbol
{
unsigned gcmarkbit : 1;
/* Non-zero means symbol serves as a variable alias. The symbol
holding the real value is found in the value slot. */
unsigned indirect_variable : 1;
/* Indicates where the value can be found:
0 : it's a plain var, the value is in the `value' field.
1 : it's a varalias, the value is really in the `alias' symbol.
2 : it's a localized var, the value is in the `blv' object.
3 : it's a forwarding variable, the value is in `forward'.
*/
enum symbol_redirect redirect : 3;
/* Non-zero means symbol is constant, i.e. changing its value
should signal an error. */
unsigned constant : 1;
should signal an error. If the value is 3, then the var
can be changed, but only by `defconst'. */
unsigned constant : 2;
/* Interned state of the symbol. This is an enumerator from
enum symbol_interned. */
@ -1013,10 +1034,15 @@ struct Lisp_Symbol
Lisp_Object xname;
/* Value of the symbol or Qunbound if unbound. If this symbol is a
defvaralias, `value' contains the symbol for which it is an
defvaralias, `alias' contains the symbol for which it is an
alias. Use the SYMBOL_VALUE and SET_SYMBOL_VALUE macros to get
and set a symbol's value, to take defvaralias into account. */
Lisp_Object value;
union {
Lisp_Object value;
struct Lisp_Symbol *alias;
struct Lisp_Buffer_Local_Value *blv;
union Lisp_Fwd *fwd;
} val;
/* Function value of the symbol or Qunbound if not fboundp. */
Lisp_Object function;
@ -1030,6 +1056,23 @@ struct Lisp_Symbol
/* Value is name of symbol. */
#define SYMBOL_VAL(sym) \
(eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
#define SYMBOL_ALIAS(sym) \
(eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias)
#define SYMBOL_BLV(sym) \
(eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv)
#define SYMBOL_FWD(sym) \
(eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd)
#define SET_SYMBOL_VAL(sym, v) \
(eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
#define SET_SYMBOL_ALIAS(sym, v) \
(eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v))
#define SET_SYMBOL_BLV(sym, v) \
(eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v))
#define SET_SYMBOL_FWD(sym, v) \
(eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v))
#define SYMBOL_NAME(sym) \
LISP_MAKE_RVALUE (XSYMBOL (sym)->xname)
@ -1049,24 +1092,6 @@ struct Lisp_Symbol
#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant
/* Value is the value of SYM, with defvaralias taken into
account. */
#define SYMBOL_VALUE(sym) \
(XSYMBOL (sym)->indirect_variable \
? indirect_variable (XSYMBOL (sym))->value \
: XSYMBOL (sym)->value)
/* Set SYM's value to VAL, taking defvaralias into account. */
#define SET_SYMBOL_VALUE(sym, val) \
do { \
if (XSYMBOL (sym)->indirect_variable) \
indirect_variable (XSYMBOL (sym))->value = (val); \
else \
XSYMBOL (sym)->value = (val); \
} while (0)
/***********************************************************************
Hash Tables
@ -1200,9 +1225,11 @@ struct Lisp_Hash_Table
struct Lisp_Misc_Any /* Supertype of all Misc types. */
{
enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Marker */
enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_??? */
unsigned gcmarkbit : 1;
int spacer : 15;
/* Make it as long as "Lisp_Free without padding". */
void *fill;
};
struct Lisp_Marker
@ -1225,7 +1252,7 @@ struct Lisp_Marker
- Fmarker_buffer
- Fset_marker: check eq(oldbuf, newbuf) to avoid unchain+rechain.
- unchain_marker: to find the list from which to unchain.
- Fkill_buffer: to unchain the markers of current indirect buffer.
- Fkill_buffer: to only unchain the markers of current indirect buffer.
*/
struct buffer *buffer;
@ -1239,7 +1266,10 @@ struct Lisp_Marker
struct Lisp_Marker *next;
/* This is the char position where the marker points. */
EMACS_INT charpos;
/* This is the byte position. */
/* This is the byte position.
It's mostly used as a charpos<->bytepos cache (i.e. it's not directly
used to implement the functionality of markers, but rather to (ab)use
markers as a cache for char<->byte mappings). */
EMACS_INT bytepos;
};
@ -1249,9 +1279,7 @@ struct Lisp_Marker
specified int variable. */
struct Lisp_Intfwd
{
int type : 16; /* = Lisp_Misc_Intfwd */
unsigned gcmarkbit : 1;
int spacer : 15;
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Int */
EMACS_INT *intvar;
};
@ -1261,9 +1289,7 @@ struct Lisp_Intfwd
nil if it is zero. */
struct Lisp_Boolfwd
{
int type : 16; /* = Lisp_Misc_Boolfwd */
unsigned gcmarkbit : 1;
int spacer : 15;
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */
int *boolvar;
};
@ -1273,9 +1299,7 @@ struct Lisp_Boolfwd
specified variable. */
struct Lisp_Objfwd
{
int type : 16; /* = Lisp_Misc_Objfwd */
unsigned gcmarkbit : 1;
int spacer : 15;
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Obj */
Lisp_Object *objvar;
};
@ -1283,11 +1307,9 @@ struct Lisp_Objfwd
current buffer. Value is byte index of slot within buffer. */
struct Lisp_Buffer_Objfwd
{
int type : 16; /* = Lisp_Misc_Buffer_Objfwd */
unsigned gcmarkbit : 1;
int spacer : 15;
Lisp_Object slottype; /* Qnil, Lisp_Int, Lisp_Symbol, or Lisp_String. */
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Buffer_Obj */
int offset;
Lisp_Object slottype; /* Qnil, Lisp_Int, Lisp_Symbol, or Lisp_String. */
};
/* struct Lisp_Buffer_Local_Value is used in a symbol value cell when
@ -1316,48 +1338,51 @@ struct Lisp_Buffer_Objfwd
struct Lisp_Buffer_Local_Value
{
int type : 16; /* = Lisp_Misc_Buffer_Local_Value */
unsigned gcmarkbit : 1;
int spacer : 11;
/* 1 means that merely setting the variable creates a local
binding for the current buffer */
unsigned int local_if_set : 1;
/* 1 means this variable is allowed to have frame-local bindings,
so check for them when looking for the proper binding. */
unsigned int check_frame : 1;
/* 1 means that the binding now loaded was found
as a local binding for the buffer in the `buffer' slot. */
unsigned int found_for_buffer : 1;
/* 1 means that the binding now loaded was found
as a local binding for the frame in the `frame' slot. */
unsigned int found_for_frame : 1;
Lisp_Object realvalue;
/* The buffer and frame for which the loaded binding was found. */
/* Having both is only needed if we want to allow variables that are
both buffer local and frame local (in which case, we currently give
precedence to the buffer-local binding). I don't think such
a combination is desirable. --Stef */
Lisp_Object buffer, frame;
/* A cons cell, (LOADED-BINDING . DEFAULT-VALUE).
LOADED-BINDING is the binding now loaded. It is a cons cell
whose cdr is the binding's value. The cons cell may be an
element of a buffer's local-variable alist, or an element of a
frame's parameter alist, or it may be this cons cell.
DEFAULT-VALUE is the variable's default value, seen when the
current buffer and selected frame do not have their own
bindings for the variable. When the default binding is loaded,
LOADED-BINDING is actually this very cons cell; thus, its car
points to itself. */
Lisp_Object cdr;
/* 1 means this variable can have frame-local bindings, otherwise, it is
can have buffer-local bindings. The two cannot be combined. */
unsigned int frame_local : 1;
/* 1 means that the binding now loaded was found.
Presumably equivalent to (defcell!=valcell) */
unsigned int found : 1;
/* If non-NULL, a forwarding to the C var where it should also be set. */
union Lisp_Fwd *fwd; /* Should never be (Buffer|Kboard)_Objfwd. */
/* The buffer or frame for which the loaded binding was found. */
Lisp_Object where;
/* A cons cell that holds the default value. It has the form
(SYMBOL . DEFAULT-VALUE). */
Lisp_Object defcell;
/* The cons cell from `where's parameter alist.
It always has the form (SYMBOL . VALUE)
Note that if `forward' is non-nil, VALUE may be out of date.
Also if the currently loaded binding is the default binding, then
this is `eq'ual to defcell. */
Lisp_Object valcell;
};
#define BLV_FOUND(blv) \
(eassert ((blv)->found == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found)
#define SET_BLV_FOUND(blv, v) \
(eassert ((v) == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found = (v))
#define BLV_VALUE(blv) (XCDR ((blv)->valcell))
#define SET_BLV_VALUE(blv, v) (XSETCDR ((blv)->valcell, v))
/* START and END are markers in the overlay's buffer, and
PLIST is the overlay's property list. */
struct Lisp_Overlay
/* An overlay's real data content is:
- plist
- buffer
- insertion type of both ends
- start & start_byte
- end & end_byte
- next (singly linked list of overlays).
- start_next and end_next (singly linked list of markers).
I.e. 9words plus 2 bits, 3words of which are for external linked lists.
*/
{
enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Overlay */
unsigned gcmarkbit : 1;
@ -1370,9 +1395,7 @@ struct Lisp_Overlay
current kboard. */
struct Lisp_Kboard_Objfwd
{
enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Kboard_Objfwd */
unsigned gcmarkbit : 1;
int spacer : 15;
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Kboard_Obj */
int offset;
};
@ -1401,9 +1424,9 @@ struct Lisp_Free
#ifdef USE_LSB_TAG
/* Try to make sure that sizeof(Lisp_Misc) preserves TYPEBITS-alignment.
This assumes that Lisp_Marker is the largest of the alternatives and
that Lisp_Intfwd has the same size as "Lisp_Free w/o padding". */
that Lisp_Misc_Any has the same size as "Lisp_Free w/o padding". */
char padding[((((sizeof (struct Lisp_Marker) - 1) >> GCTYPEBITS) + 1)
<< GCTYPEBITS) - sizeof (struct Lisp_Intfwd)];
<< GCTYPEBITS) - sizeof (struct Lisp_Misc_Any)];
#endif
};
@ -1414,15 +1437,18 @@ union Lisp_Misc
{
struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */
struct Lisp_Free u_free; /* Includes padding to force alignment. */
struct Lisp_Marker u_marker;
struct Lisp_Intfwd u_intfwd;
struct Lisp_Boolfwd u_boolfwd;
struct Lisp_Objfwd u_objfwd;
struct Lisp_Buffer_Objfwd u_buffer_objfwd;
struct Lisp_Buffer_Local_Value u_buffer_local_value;
struct Lisp_Overlay u_overlay;
struct Lisp_Kboard_Objfwd u_kboard_objfwd;
struct Lisp_Save_Value u_save_value;
struct Lisp_Marker u_marker; /* 5 */
struct Lisp_Overlay u_overlay; /* 5 */
struct Lisp_Save_Value u_save_value; /* 3 */
};
union Lisp_Fwd
{
struct Lisp_Intfwd u_intfwd; /* 2 */
struct Lisp_Boolfwd u_boolfwd; /* 2 */
struct Lisp_Objfwd u_objfwd; /* 2 */
struct Lisp_Buffer_Objfwd u_buffer_objfwd; /* 2 */
struct Lisp_Kboard_Objfwd u_kboard_objfwd; /* 2 */
};
/* Lisp floating point type */
@ -1564,15 +1590,13 @@ typedef struct {
#define VECTORP(x) (VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG))
#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay)
#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
#define INTFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Intfwd)
#define BOOLFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Boolfwd)
#define OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Objfwd)
#define BUFFER_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Objfwd)
#define BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Local_Value)
#define SOME_BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Some_Buffer_Local_Value)
#define KBOARD_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Kboard_Objfwd)
#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value)
#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int)
#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool)
#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj)
#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj)
#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj)
/* True if object X is a pseudovector whose code is CODE. */
#define PSEUDOVECTORP(x, code) \
@ -1789,24 +1813,44 @@ extern void defsubr P_ ((struct Lisp_Subr *));
#define MANY -2
#define UNEVALLED -1
extern void defvar_lisp (const char *, Lisp_Object *);
extern void defvar_lisp_nopro (const char *, Lisp_Object *);
extern void defvar_bool (const char *, int *);
extern void defvar_int (const char *, EMACS_INT *);
extern void defvar_kboard (const char *, int);
extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *);
extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *);
extern void defvar_bool (struct Lisp_Boolfwd *, const char *, int *);
extern void defvar_int (struct Lisp_Intfwd *, const char *, EMACS_INT *);
extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
/* Macros we use to define forwarded Lisp variables.
These are used in the syms_of_FILENAME functions. */
#define DEFVAR_LISP(lname, vname, doc) defvar_lisp (lname, vname)
#define DEFVAR_LISP_NOPRO(lname, vname, doc) defvar_lisp_nopro (lname, vname)
#define DEFVAR_BOOL(lname, vname, doc) defvar_bool (lname, vname)
#define DEFVAR_INT(lname, vname, doc) defvar_int (lname, vname)
#define DEFVAR_LISP(lname, vname, doc) \
do { \
static struct Lisp_Objfwd o_fwd; \
defvar_lisp (&o_fwd, lname, vname); \
} while (0)
#define DEFVAR_LISP_NOPRO(lname, vname, doc) \
do { \
static struct Lisp_Objfwd o_fwd; \
defvar_lisp_nopro (&o_fwd, lname, vname); \
} while (0)
#define DEFVAR_BOOL(lname, vname, doc) \
do { \
static struct Lisp_Boolfwd b_fwd; \
defvar_bool (&b_fwd, lname, vname); \
} while (0)
#define DEFVAR_INT(lname, vname, doc) \
do { \
static struct Lisp_Intfwd i_fwd; \
defvar_int (&i_fwd, lname, vname); \
} while (0)
#define DEFVAR_KBOARD(lname, vname, doc) \
defvar_kboard (lname, \
(int)((char *)(&current_kboard->vname) \
- (char *)current_kboard))
#define DEFVAR_KBOARD(lname, vname, doc) \
do { \
static struct Lisp_Kboard_Objfwd ko_fwd; \
defvar_kboard (&ko_fwd, \
lname, \
(int)((char *)(&current_kboard->vname) \
- (char *)current_kboard)); \
} while (0)
@ -2341,13 +2385,11 @@ extern void args_out_of_range P_ ((Lisp_Object, Lisp_Object)) NO_RETURN;
extern void args_out_of_range_3 P_ ((Lisp_Object, Lisp_Object,
Lisp_Object)) NO_RETURN;
extern Lisp_Object wrong_type_argument P_ ((Lisp_Object, Lisp_Object)) NO_RETURN;
extern void store_symval_forwarding P_ ((Lisp_Object, Lisp_Object,
Lisp_Object, struct buffer *));
extern Lisp_Object do_symval_forwarding P_ ((Lisp_Object));
extern Lisp_Object set_internal P_ ((Lisp_Object, Lisp_Object, struct buffer *, int));
extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
extern void set_internal (Lisp_Object, Lisp_Object, struct buffer *, int);
extern void syms_of_data P_ ((void));
extern void init_data P_ ((void));
extern void swap_in_global_binding P_ ((Lisp_Object));
extern void swap_in_global_binding P_ ((struct Lisp_Symbol *));
/* Defined in cmds.c */
EXFUN (Fend_of_line, 1);
@ -3388,6 +3430,7 @@ extern void syms_of_term P_ ((void));
extern void fatal P_ ((const char *msgid, ...)) NO_RETURN;
/* Defined in terminal.c */
EXFUN (Fframe_terminal, 1);
EXFUN (Fdelete_terminal, 2);
extern void syms_of_terminal P_ ((void));

94
src/lread.c
View File

@ -3687,7 +3687,8 @@ it defaults to the value of `obarray'. */)
&& EQ (obarray, initial_obarray))
{
XSYMBOL (sym)->constant = 1;
XSYMBOL (sym)->value = sym;
XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (XSYMBOL (sym), sym);
}
ptr = &XVECTOR (obarray)->contents[XINT (tem)];
@ -3768,8 +3769,6 @@ OBARRAY defaults to the value of the variable `obarray'. */)
error ("Attempt to unintern t or nil"); */
XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
XSYMBOL (tem)->constant = 0;
XSYMBOL (tem)->indirect_variable = 0;
hash = oblookup_last_bucket_number;
@ -3914,35 +3913,31 @@ void
init_obarray ()
{
Lisp_Object oblength;
int hash;
Lisp_Object *tem;
XSETFASTINT (oblength, OBARRAY_SIZE);
Qnil = Fmake_symbol (make_pure_c_string ("nil"));
Vobarray = Fmake_vector (oblength, make_number (0));
initial_obarray = Vobarray;
staticpro (&initial_obarray);
/* Intern nil in the obarray */
XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
XSYMBOL (Qnil)->constant = 1;
/* These locals are to kludge around a pyramid compiler bug. */
hash = hash_string ("nil", 3);
/* Separate statement here to avoid VAXC bug. */
hash %= OBARRAY_SIZE;
tem = &XVECTOR (Vobarray)->contents[hash];
*tem = Qnil;
Qunbound = Fmake_symbol (make_pure_c_string ("unbound"));
XSYMBOL (Qnil)->function = Qunbound;
XSYMBOL (Qunbound)->value = Qunbound;
/* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
NILP (Vpurify_flag) check in intern_c_string. */
Qnil = make_number (-1); Vpurify_flag = make_number (1);
Qnil = intern_c_string ("nil");
/* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
so those two need to be fixed manally. */
SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
XSYMBOL (Qunbound)->function = Qunbound;
XSYMBOL (Qunbound)->plist = Qnil;
/* XSYMBOL (Qnil)->function = Qunbound; */
SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
XSYMBOL (Qnil)->constant = 1;
XSYMBOL (Qnil)->plist = Qnil;
Qt = intern_c_string ("t");
XSYMBOL (Qnil)->value = Qnil;
XSYMBOL (Qnil)->plist = Qnil;
XSYMBOL (Qt)->value = Qt;
SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
XSYMBOL (Qt)->constant = 1;
/* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
@ -3981,27 +3976,29 @@ defalias (sname, string)
to a C variable of type int. Sample call:
DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
void
defvar_int (const char *namestring, EMACS_INT *address)
defvar_int (struct Lisp_Intfwd *i_fwd,
const char *namestring, EMACS_INT *address)
{
Lisp_Object sym, val;
Lisp_Object sym;
sym = intern_c_string (namestring);
val = allocate_misc ();
XMISCTYPE (val) = Lisp_Misc_Intfwd;
XINTFWD (val)->intvar = address;
SET_SYMBOL_VALUE (sym, val);
i_fwd->type = Lisp_Fwd_Int;
i_fwd->intvar = address;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
}
/* Similar but define a variable whose value is t if address contains 1,
nil if address contains 0. */
void
defvar_bool (const char *namestring, int *address)
defvar_bool (struct Lisp_Boolfwd *b_fwd,
const char *namestring, int *address)
{
Lisp_Object sym, val;
Lisp_Object sym;
sym = intern_c_string (namestring);
val = allocate_misc ();
XMISCTYPE (val) = Lisp_Misc_Boolfwd;
XBOOLFWD (val)->boolvar = address;
SET_SYMBOL_VALUE (sym, val);
b_fwd->type = Lisp_Fwd_Bool;
b_fwd->boolvar = address;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
}
@ -4011,20 +4008,22 @@ defvar_bool (const char *namestring, int *address)
gc-marked for some other reason, since marking the same slot twice
can cause trouble with strings. */
void
defvar_lisp_nopro (const char *namestring, Lisp_Object *address)
defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
const char *namestring, Lisp_Object *address)
{
Lisp_Object sym, val;
Lisp_Object sym;
sym = intern_c_string (namestring);
val = allocate_misc ();
XMISCTYPE (val) = Lisp_Misc_Objfwd;
XOBJFWD (val)->objvar = address;
SET_SYMBOL_VALUE (sym, val);
o_fwd->type = Lisp_Fwd_Obj;
o_fwd->objvar = address;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
}
void
defvar_lisp (const char *namestring, Lisp_Object *address)
defvar_lisp (struct Lisp_Objfwd *o_fwd,
const char *namestring, Lisp_Object *address)
{
defvar_lisp_nopro (namestring, address);
defvar_lisp_nopro (o_fwd, namestring, address);
staticpro (address);
}
@ -4032,14 +4031,15 @@ defvar_lisp (const char *namestring, Lisp_Object *address)
at a particular offset in the current kboard object. */
void
defvar_kboard (const char *namestring, int offset)
defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
const char *namestring, int offset)
{
Lisp_Object sym, val;
Lisp_Object sym;
sym = intern_c_string (namestring);
val = allocate_misc ();
XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd;
XKBOARD_OBJFWD (val)->offset = offset;
SET_SYMBOL_VALUE (sym, val);
ko_fwd->type = Lisp_Fwd_Kboard_Obj;
ko_fwd->offset = offset;
XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
}
/* Record the value of load-path used at the start of dumping

64
src/print.c
View File

@ -2267,70 +2267,6 @@ print_object (obj, printcharfun, escapeflag)
strout ("#<misc free cell>", -1, -1, printcharfun, 0);
break;
case Lisp_Misc_Intfwd:
sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
strout (buf, -1, -1, printcharfun, 0);
break;
case Lisp_Misc_Boolfwd:
sprintf (buf, "#<boolfwd to %s>",
(*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
strout (buf, -1, -1, printcharfun, 0);
break;
case Lisp_Misc_Objfwd:
strout ("#<objfwd to ", -1, -1, printcharfun, 0);
print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
PRINTCHAR ('>');
break;
case Lisp_Misc_Buffer_Objfwd:
strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
print_object (PER_BUFFER_VALUE (current_buffer,
XBUFFER_OBJFWD (obj)->offset),
printcharfun, escapeflag);
PRINTCHAR ('>');
break;
case Lisp_Misc_Kboard_Objfwd:
strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
print_object (*(Lisp_Object *) ((char *) current_kboard
+ XKBOARD_OBJFWD (obj)->offset),
printcharfun, escapeflag);
PRINTCHAR ('>');
break;
case Lisp_Misc_Buffer_Local_Value:
strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
if (XBUFFER_LOCAL_VALUE (obj)->local_if_set)
strout ("[local-if-set] ", -1, -1, printcharfun, 0);
strout ("[realvalue] ", -1, -1, printcharfun, 0);
print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
printcharfun, escapeflag);
if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
strout ("[local in buffer] ", -1, -1, printcharfun, 0);
else
strout ("[buffer] ", -1, -1, printcharfun, 0);
print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
printcharfun, escapeflag);
if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
{
if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
strout ("[local in frame] ", -1, -1, printcharfun, 0);
else
strout ("[frame] ", -1, -1, printcharfun, 0);
print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
printcharfun, escapeflag);
}
strout ("[alist-elt] ", -1, -1, printcharfun, 0);
print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
printcharfun, escapeflag);
strout ("[default-value] ", -1, -1, printcharfun, 0);
print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
printcharfun, escapeflag);
PRINTCHAR ('>');
break;
case Lisp_Misc_Save_Value:
strout ("#<save_value ", -1, -1, printcharfun, 0);
sprintf(buf, "ptr=0x%08lx int=%d",

9
src/term.c
View File

@ -2244,7 +2244,7 @@ set_tty_color_mode (tty, f)
struct tty_display_info *tty;
struct frame *f;
{
Lisp_Object tem, val, color_mode_spec;
Lisp_Object tem, val;
Lisp_Object color_mode;
int mode;
extern Lisp_Object Qtty_color_mode;
@ -2256,12 +2256,13 @@ set_tty_color_mode (tty, f)
if (INTEGERP (val))
color_mode = val;
else
else if (SYMBOLP (tty_color_mode_alist))
{
tem = (NILP (tty_color_mode_alist) ? Qnil
: Fassq (val, XSYMBOL (tty_color_mode_alist)->value));
tem = Fassq (val, Fsymbol_value (tty_color_mode_alist));
color_mode = CONSP (tem) ? XCDR (tem) : Qnil;
}
else
color_mode = Qnil;
mode = INTEGERP (color_mode) ? XINT (color_mode) : 0;

28
src/xdisp.c
View File

@ -11592,7 +11592,7 @@ static void
select_frame_for_redisplay (frame)
Lisp_Object frame;
{
Lisp_Object tail, symbol, val;
Lisp_Object tail, tem;
Lisp_Object old = selected_frame;
struct Lisp_Symbol *sym;
@ -11600,20 +11600,18 @@ select_frame_for_redisplay (frame)
selected_frame = frame;
do
{
for (tail = XFRAME (frame)->param_alist; CONSP (tail); tail = XCDR (tail))
if (CONSP (XCAR (tail))
&& (symbol = XCAR (XCAR (tail)),
SYMBOLP (symbol))
&& (sym = indirect_variable (XSYMBOL (symbol)),
val = sym->value,
(BUFFER_LOCAL_VALUEP (val)))
&& XBUFFER_LOCAL_VALUE (val)->check_frame)
/* Use find_symbol_value rather than Fsymbol_value
to avoid an error if it is void. */
find_symbol_value (symbol);
} while (!EQ (frame, old) && (frame = old, 1));
do {
for (tail = XFRAME (frame)->param_alist; CONSP (tail); tail = XCDR (tail))
if (CONSP (XCAR (tail))
&& (tem = XCAR (XCAR (tail)),
SYMBOLP (tem))
&& (sym = indirect_variable (XSYMBOL (tem)),
sym->redirect == SYMBOL_LOCALIZED)
&& sym->val.blv->frame_local)
/* Use find_symbol_value rather than Fsymbol_value
to avoid an error if it is void. */
find_symbol_value (tem);
} while (!EQ (frame, old) && (frame = old, 1));
}