[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r99947: Make variable forwarding expl
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r99947: Make variable forwarding explicit rather the using special values. |
|
Date: |
Mon, 19 Apr 2010 21:50:52 -0400 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 99947
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2010-04-19 21:50:52 -0400
message:
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.
modified:
src/ChangeLog
src/alloc.c
src/bidi.c
src/buffer.c
src/buffer.h
src/bytecode.c
src/character.h
src/coding.c
src/data.c
src/eval.c
src/frame.c
src/insdel.c
src/keyboard.c
src/lisp.h
src/lread.c
src/print.c
src/term.c
src/xdisp.c
=== modified file 'src/ChangeLog'
--- a/src/ChangeLog 2010-04-19 16:22:55 +0000
+++ b/src/ChangeLog 2010-04-20 01:50:52 +0000
@@ -1,9 +1,79 @@
+2010-04-20 Stefan Monnier <address@hidden>
+
+ 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 <address@hidden>
* 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 <address@hidden>
=== modified file 'src/alloc.c'
--- a/src/alloc.c 2010-04-18 21:49:33 +0000
+++ b/src/alloc.c 2010-04-20 01:50:52 +0000
@@ -1365,7 +1365,7 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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
=== modified file 'src/bidi.c'
--- a/src/bidi.c 2010-04-19 16:22:55 +0000
+++ b/src/bidi.c 2010-04-20 01:50:52 +0000
@@ -400,14 +400,14 @@
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 @@
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
=== modified file 'src/buffer.c'
--- a/src/buffer.c 2010-04-13 01:47:40 +0000
+++ b/src/buffer.c 2010-04-20 01:50:52 +0000
@@ -78,9 +78,6 @@
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 @@
/* 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 @@
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 @@
{
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 @@
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 @@
CHECK_SYMBOL (variable);
CHECK_BUFFER (buffer);
buf = XBUFFER (buffer);
-
- sym = indirect_variable (XSYMBOL (variable));
- XSETSYMBOL (variable, sym);
-
- /* Look in local_var_list */
- result = Fassoc (variable, buf->local_var_alist);
- if (NILP (result))
- {
- int offset, idx;
- int found = 0;
-
- /* 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;
- }
- }
-
- 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);
+ sym = XSYMBOL (variable);
+
+ start:
+ switch (sym->redirect)
+ {
+ 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;
+
+ /* 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. */
+
+ 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 @@
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 @@
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 @@
/* 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 @@
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 @@
/* 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 @@
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
=== modified file 'src/buffer.h'
--- a/src/buffer.h 2010-04-13 01:47:40 +0000
+++ b/src/buffer.h 2010-04-20 01:50:52 +0000
@@ -107,6 +107,11 @@
#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 @@
- (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 @@
/* 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 @@
+ (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 @@
/* 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 @@
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 @@
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 @@
#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) */
=== modified file 'src/bytecode.c'
--- a/src/bytecode.c 2010-03-05 23:08:18 +0000
+++ b/src/bytecode.c 2010-04-20 01:50:52 +0000
@@ -505,8 +505,9 @@
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 @@
/* 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 ();
=== modified file 'src/character.h'
--- a/src/character.h 2010-01-30 10:32:39 +0000
+++ b/src/character.h 2010-04-20 01:50:52 +0000
@@ -296,7 +296,7 @@
/* 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 { \
=== modified file 'src/coding.c'
--- a/src/coding.c 2010-03-16 05:48:41 +0000
+++ b/src/coding.c 2010-04-20 01:50:52 +0000
@@ -6408,7 +6408,7 @@
{
/* 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;
=== modified file 'src/data.c'
--- a/src/data.c 2010-03-22 19:51:59 +0000
+++ b/src/data.c 2010-04-20 01:50:52 +0000
@@ -91,7 +91,7 @@
Lisp_Object Qinteractive_form;
-static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object));
+static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct
Lisp_Buffer_Local_Value *);
Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum;
@@ -582,12 +582,35 @@
register Lisp_Object symbol;
{
Lisp_Object valcontents;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (symbol);
-
- valcontents = SYMBOL_VALUE (symbol);
-
- if (BUFFER_LOCAL_VALUEP (valcontents))
- valcontents = swap_in_symval_forwarding (symbol, valcontents);
+ sym = XSYMBOL (symbol);
+
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break;
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_LOCALIZED:
+ {
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ if (blv->fwd)
+ /* In set_internal, we un-forward vars when their value is
+ set to Qunbound. */
+ return Qt;
+ else
+ {
+ swap_in_symval_forwarding (sym, blv);
+ valcontents = BLV_VALUE (blv);
+ }
+ break;
+ }
+ case SYMBOL_FORWARDED:
+ /* In set_internal, we un-forward vars when their value is
+ set to Qunbound. */
+ return Qt;
+ default: abort ();
+ }
return (EQ (valcontents, Qunbound) ? Qnil : Qt);
}
@@ -824,14 +847,14 @@
hare = tortoise = symbol;
- while (hare->indirect_variable)
+ while (hare->redirect == SYMBOL_VARALIAS)
{
- hare = XSYMBOL (hare->value);
- if (!hare->indirect_variable)
+ hare = SYMBOL_ALIAS (hare);
+ if (hare->redirect != SYMBOL_VARALIAS)
break;
- hare = XSYMBOL (hare->value);
- tortoise = XSYMBOL (tortoise->value);
+ hare = SYMBOL_ALIAS (hare);
+ tortoise = SYMBOL_ALIAS (tortoise);
if (hare == tortoise)
{
@@ -865,44 +888,46 @@
This does not handle buffer-local variables; use
swap_in_symval_forwarding for that. */
+#define do_blv_forwarding(blv) \
+ ((blv)->forwarded ? do_symval_forwarding (BLV_FWD (blv)) : BLV_VALUE (blv))
+
Lisp_Object
do_symval_forwarding (valcontents)
- register Lisp_Object valcontents;
+ register union Lisp_Fwd *valcontents;
{
register Lisp_Object val;
- if (MISCP (valcontents))
- switch (XMISCTYPE (valcontents))
- {
- case Lisp_Misc_Intfwd:
- XSETINT (val, *XINTFWD (valcontents)->intvar);
- return val;
-
- case Lisp_Misc_Boolfwd:
- return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
-
- case Lisp_Misc_Objfwd:
- return *XOBJFWD (valcontents)->objvar;
-
- case Lisp_Misc_Buffer_Objfwd:
- return PER_BUFFER_VALUE (current_buffer,
- XBUFFER_OBJFWD (valcontents)->offset);
-
- case Lisp_Misc_Kboard_Objfwd:
- /* We used to simply use current_kboard here, but from Lisp
- code, it's value is often unexpected. It seems nicer to
- allow constructions like this to work as intuitively expected:
-
- (with-selected-frame frame
- (define-key local-function-map "\eOP" [f1]))
-
- On the other hand, this affects the semantics of
- last-command and real-last-command, and people may rely on
- that. I took a quick look at the Lisp codebase, and I
- don't think anything will break. --lorentey */
- return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
- + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
- }
- return valcontents;
+ switch (XFWDTYPE (valcontents))
+ {
+ case Lisp_Fwd_Int:
+ XSETINT (val, *XINTFWD (valcontents)->intvar);
+ return val;
+
+ case Lisp_Fwd_Bool:
+ return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
+
+ case Lisp_Fwd_Obj:
+ return *XOBJFWD (valcontents)->objvar;
+
+ case Lisp_Fwd_Buffer_Obj:
+ return PER_BUFFER_VALUE (current_buffer,
+ XBUFFER_OBJFWD (valcontents)->offset);
+
+ case Lisp_Fwd_Kboard_Obj:
+ /* We used to simply use current_kboard here, but from Lisp
+ code, it's value is often unexpected. It seems nicer to
+ allow constructions like this to work as intuitively expected:
+
+ (with-selected-frame frame
+ (define-key local-function-map "\eOP" [f1]))
+
+ On the other hand, this affects the semantics of
+ last-command and real-last-command, and people may rely on
+ that. I took a quick look at the Lisp codebase, and I
+ don't think anything will break. --lorentey */
+ return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
+ + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
+ default: abort ();
+ }
}
/* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
@@ -913,102 +938,93 @@
BUF non-zero means set the value in buffer BUF instead of the
current buffer. This only plays a role for per-buffer variables. */
-void
-store_symval_forwarding (symbol, valcontents, newval, buf)
- Lisp_Object symbol;
- register Lisp_Object valcontents, newval;
+#define store_blv_forwarding(blv, newval, buf) \
+ do { \
+ if ((blv)->forwarded) \
+ store_symval_forwarding (BLV_FWD (blv), (newval), (buf)); \
+ else \
+ SET_BLV_VALUE (blv, newval); \
+ } while (0)
+
+static void
+store_symval_forwarding (/* symbol, */ valcontents, newval, buf)
+ /* struct Lisp_Symbol *symbol; */
+ union Lisp_Fwd *valcontents;
+ register Lisp_Object newval;
struct buffer *buf;
{
- switch (SWITCH_ENUM_CAST (XTYPE (valcontents)))
+ switch (XFWDTYPE (valcontents))
{
- case Lisp_Misc:
- switch (XMISCTYPE (valcontents))
+ case Lisp_Fwd_Int:
+ CHECK_NUMBER (newval);
+ *XINTFWD (valcontents)->intvar = XINT (newval);
+ break;
+
+ case Lisp_Fwd_Bool:
+ *XBOOLFWD (valcontents)->boolvar = !NILP (newval);
+ break;
+
+ case Lisp_Fwd_Obj:
+ *XOBJFWD (valcontents)->objvar = newval;
+
+ /* If this variable is a default for something stored
+ in the buffer itself, such as default-fill-column,
+ find the buffers that don't have local values for it
+ and update them. */
+ if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
+ && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults
+ 1))
{
- case Lisp_Misc_Intfwd:
- CHECK_NUMBER (newval);
- *XINTFWD (valcontents)->intvar = XINT (newval);
- /* This can never happen since intvar points to an EMACS_INT
- which is at least large enough to hold a Lisp_Object.
- if (*XINTFWD (valcontents)->intvar != XINT (newval))
- error ("Value out of range for variable `%s'",
- SDATA (SYMBOL_NAME (symbol))); */
- break;
-
- case Lisp_Misc_Boolfwd:
- *XBOOLFWD (valcontents)->boolvar = !NILP (newval);
- break;
-
- case Lisp_Misc_Objfwd:
- *XOBJFWD (valcontents)->objvar = newval;
-
- /* If this variable is a default for something stored
- in the buffer itself, such as default-fill-column,
- find the buffers that don't have local values for it
- and update them. */
- if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
- && XOBJFWD (valcontents)->objvar < (Lisp_Object *)
(&buffer_defaults + 1))
+ int offset = ((char *) XOBJFWD (valcontents)->objvar
+ - (char *) &buffer_defaults);
+ int idx = PER_BUFFER_IDX (offset);
+
+ Lisp_Object tail;
+
+ if (idx <= 0)
+ break;
+
+ for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
{
- int offset = ((char *) XOBJFWD (valcontents)->objvar
- - (char *) &buffer_defaults);
- int idx = PER_BUFFER_IDX (offset);
-
- Lisp_Object tail;
-
- if (idx <= 0)
- break;
-
- for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
- {
- Lisp_Object buf;
- struct buffer *b;
-
- buf = Fcdr (XCAR (tail));
- if (!BUFFERP (buf)) continue;
- b = XBUFFER (buf);
-
- if (! PER_BUFFER_VALUE_P (b, idx))
- PER_BUFFER_VALUE (b, offset) = newval;
- }
+ Lisp_Object buf;
+ struct buffer *b;
+
+ buf = Fcdr (XCAR (tail));
+ if (!BUFFERP (buf)) continue;
+ b = XBUFFER (buf);
+
+ if (! PER_BUFFER_VALUE_P (b, idx))
+ PER_BUFFER_VALUE (b, offset) = newval;
}
- break;
-
- case Lisp_Misc_Buffer_Objfwd:
- {
- int offset = XBUFFER_OBJFWD (valcontents)->offset;
- Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
-
- if (!(NILP (type) || NILP (newval)
- || (XINT (type) == LISP_INT_TAG
- ? INTEGERP (newval)
- : XTYPE (newval) == XINT (type))))
- buffer_slot_type_mismatch (newval, XINT (type));
-
- if (buf == NULL)
- buf = current_buffer;
- PER_BUFFER_VALUE (buf, offset) = newval;
- }
- break;
-
- case Lisp_Misc_Kboard_Objfwd:
- {
- char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ());
- char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
- *(Lisp_Object *) p = newval;
- }
- break;
-
- default:
- goto def;
}
break;
+ case Lisp_Fwd_Buffer_Obj:
+ {
+ int offset = XBUFFER_OBJFWD (valcontents)->offset;
+ Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
+
+ if (!(NILP (type) || NILP (newval)
+ || (XINT (type) == LISP_INT_TAG
+ ? INTEGERP (newval)
+ : XTYPE (newval) == XINT (type))))
+ buffer_slot_type_mismatch (newval, XINT (type));
+
+ if (buf == NULL)
+ buf = current_buffer;
+ PER_BUFFER_VALUE (buf, offset) = newval;
+ }
+ break;
+
+ case Lisp_Fwd_Kboard_Obj:
+ {
+ char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ());
+ char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
+ *(Lisp_Object *) p = newval;
+ }
+ break;
+
default:
- def:
- valcontents = SYMBOL_VALUE (symbol);
- if (BUFFER_LOCAL_VALUEP (valcontents))
- XBUFFER_LOCAL_VALUE (valcontents)->realvalue = newval;
- else
- SET_SYMBOL_VALUE (symbol, newval);
+ abort (); /* goto def; */
}
}
@@ -1017,25 +1033,22 @@
void
swap_in_global_binding (symbol)
- Lisp_Object symbol;
+ struct Lisp_Symbol *symbol;
{
- Lisp_Object valcontents = SYMBOL_VALUE (symbol);
- struct Lisp_Buffer_Local_Value *blv = XBUFFER_LOCAL_VALUE (valcontents);
- Lisp_Object cdr = blv->cdr;
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (symbol);
/* Unload the previously loaded binding. */
- Fsetcdr (XCAR (cdr),
- do_symval_forwarding (blv->realvalue));
+ if (blv->fwd)
+ SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
/* Select the global binding in the symbol. */
- XSETCAR (cdr, cdr);
- store_symval_forwarding (symbol, blv->realvalue, XCDR (cdr), NULL);
+ blv->valcell = blv->defcell;
+ if (blv->fwd)
+ store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL);
/* Indicate that the global binding is set up now. */
- blv->frame = Qnil;
- blv->buffer = Qnil;
- blv->found_for_frame = 0;
- blv->found_for_buffer = 0;
+ blv->where = Qnil;
+ SET_BLV_FOUND (blv, 0);
}
/* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
@@ -1045,55 +1058,50 @@
Return the value forwarded one step past the buffer-local stage.
This could be another forwarding pointer. */
-static Lisp_Object
-swap_in_symval_forwarding (symbol, valcontents)
- Lisp_Object symbol, valcontents;
+static void
+swap_in_symval_forwarding (symbol, blv)
+ struct Lisp_Symbol *symbol;
+ struct Lisp_Buffer_Local_Value *blv;
{
register Lisp_Object tem1;
- tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer;
+ eassert (blv == SYMBOL_BLV (symbol));
+
+ tem1 = blv->where;
if (NILP (tem1)
- || current_buffer != XBUFFER (tem1)
- || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame
- && ! EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame)))
+ || (blv->frame_local
+ ? !EQ (selected_frame, tem1)
+ : current_buffer != XBUFFER (tem1)))
{
- struct Lisp_Symbol *sym = XSYMBOL (symbol);
- if (sym->indirect_variable)
- {
- sym = indirect_variable (sym);
- XSETSYMBOL (symbol, sym);
- }
/* Unload the previously loaded binding. */
- tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
- Fsetcdr (tem1,
- do_symval_forwarding (XBUFFER_LOCAL_VALUE
(valcontents)->realvalue));
+ tem1 = blv->valcell;
+ if (blv->fwd)
+ SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
/* Choose the new binding. */
- tem1 = assq_no_quit (symbol, current_buffer->local_var_alist);
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0;
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
- if (NILP (tem1))
- {
- if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
- tem1 = assq_no_quit (symbol, XFRAME (selected_frame)->param_alist);
- if (! NILP (tem1))
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1;
- else
- tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
- }
- else
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1;
+ {
+ Lisp_Object var;
+ XSETSYMBOL (var, symbol);
+ if (blv->frame_local)
+ {
+ tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist);
+ blv->where = selected_frame;
+ }
+ else
+ {
+ tem1 = assq_no_quit (var, current_buffer->local_var_alist);
+ XSETBUFFER (blv->where, current_buffer);
+ }
+ }
+ if (!(blv->found = !NILP (tem1)))
+ tem1 = blv->defcell;
/* Load the new binding. */
- XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1);
- XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, current_buffer);
- XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame;
- store_symval_forwarding (symbol,
- XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
- Fcdr (tem1), NULL);
+ blv->valcell = tem1;
+ if (blv->fwd)
+ store_symval_forwarding (blv->fwd, BLV_VALUE (blv), NULL);
}
- return XBUFFER_LOCAL_VALUE (valcontents)->realvalue;
}
/* Find the value of a symbol, returning Qunbound if it's not bound.
@@ -1106,16 +1114,27 @@
find_symbol_value (symbol)
Lisp_Object symbol;
{
- register Lisp_Object valcontents;
- register Lisp_Object val;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (symbol);
- valcontents = SYMBOL_VALUE (symbol);
-
- if (BUFFER_LOCAL_VALUEP (valcontents))
- valcontents = swap_in_symval_forwarding (symbol, valcontents);
-
- return do_symval_forwarding (valcontents);
+ sym = XSYMBOL (symbol);
+
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
+ case SYMBOL_LOCALIZED:
+ {
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ swap_in_symval_forwarding (sym, blv);
+ return blv->fwd ? do_symval_forwarding (blv->fwd) : BLV_VALUE (blv);
+ }
+ /* FALLTHROUGH */
+ case SYMBOL_FORWARDED:
+ return do_symval_forwarding (SYMBOL_FWD (sym));
+ default: abort ();
+ }
}
DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
@@ -1137,26 +1156,25 @@
(symbol, newval)
register Lisp_Object symbol, newval;
{
- return set_internal (symbol, newval, current_buffer, 0);
+ set_internal (symbol, newval, current_buffer, 0);
+ return newval;
}
/* Return 1 if SYMBOL currently has a let-binding
which was made in the buffer that is now current. */
static int
-let_shadows_buffer_binding_p (symbol)
- struct Lisp_Symbol *symbol;
+let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
{
- volatile struct specbinding *p;
+ struct specbinding *p;
for (p = specpdl_ptr - 1; p >= specpdl; p--)
if (p->func == NULL
&& CONSP (p->symbol))
{
struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
- if ((symbol == let_bound_symbol
- || (let_bound_symbol->indirect_variable
- && symbol == indirect_variable (let_bound_symbol)))
+ eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
+ if (symbol == let_bound_symbol
&& XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
break;
}
@@ -1164,6 +1182,19 @@
return p >= specpdl;
}
+static int
+let_shadows_global_binding_p (symbol)
+ Lisp_Object symbol;
+{
+ struct specbinding *p;
+
+ for (p = specpdl_ptr - 1; p >= specpdl; p--)
+ if (p->func == NULL && EQ (p->symbol, symbol))
+ break;
+
+ return p >= specpdl;
+}
+
/* Store the value NEWVAL into SYMBOL.
If buffer-locality is an issue, BUF specifies which buffer to use.
(0 stands for the current buffer.)
@@ -1172,133 +1203,155 @@
local in every buffer where it is set, then we make it local.
If BINDFLAG is nonzero, we don't do that. */
-Lisp_Object
+void
set_internal (symbol, newval, buf, bindflag)
register Lisp_Object symbol, newval;
struct buffer *buf;
int bindflag;
{
int voide = EQ (newval, Qunbound);
-
- register Lisp_Object valcontents, innercontents, tem1, current_alist_element;
+ struct Lisp_Symbol *sym;
+ Lisp_Object tem1;
if (buf == 0)
buf = current_buffer;
/* If restoring in a dead buffer, do nothing. */
if (NILP (buf->name))
- return newval;
+ return;
CHECK_SYMBOL (symbol);
- if (SYMBOL_CONSTANT_P (symbol)
- && (NILP (Fkeywordp (symbol))
- || !EQ (newval, SYMBOL_VALUE (symbol))))
- xsignal1 (Qsetting_constant, symbol);
-
- innercontents = valcontents = SYMBOL_VALUE (symbol);
-
- if (BUFFER_OBJFWDP (valcontents))
+ if (SYMBOL_CONSTANT_P (symbol))
{
- int offset = XBUFFER_OBJFWD (valcontents)->offset;
- int idx = PER_BUFFER_IDX (offset);
- if (idx > 0
- && !bindflag
- && !let_shadows_buffer_binding_p (XSYMBOL (symbol)))
- SET_PER_BUFFER_VALUE_P (buf, idx, 1);
+ if (NILP (Fkeywordp (symbol))
+ || !EQ (newval, Fsymbol_value (symbol)))
+ xsignal1 (Qsetting_constant, symbol);
+ else
+ /* Allow setting keywords to their own value. */
+ return;
}
- else if (BUFFER_LOCAL_VALUEP (valcontents))
+
+ sym = XSYMBOL (symbol);
+
+ start:
+ switch (sym->redirect)
{
- /* valcontents is a struct Lisp_Buffer_Local_Value. */
- if (XSYMBOL (symbol)->indirect_variable)
- XSETSYMBOL (symbol, indirect_variable (XSYMBOL (symbol)));
-
- /* What binding is loaded right now? */
- current_alist_element
- = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
-
- /* If the current buffer is not the buffer whose binding is
- loaded, or if there may be frame-local bindings and the frame
- isn't the right one, or if it's a Lisp_Buffer_Local_Value and
- the default binding is loaded, the loaded binding may be the
- wrong one. */
- if (!BUFFERP (XBUFFER_LOCAL_VALUE (valcontents)->buffer)
- || buf != XBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer)
- || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame
- && !EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame))
- /* Also unload a global binding (if the var is local_if_set). */
- || (EQ (XCAR (current_alist_element),
- current_alist_element)))
- {
- /* The currently loaded binding is not necessarily valid.
- We need to unload it, and choose a new binding. */
-
- /* Write out `realvalue' to the old loaded binding. */
- Fsetcdr (current_alist_element,
- do_symval_forwarding (XBUFFER_LOCAL_VALUE
(valcontents)->realvalue));
-
- /* Find the new binding. */
- tem1 = Fassq (symbol, buf->local_var_alist);
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1;
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0;
-
- if (NILP (tem1))
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
+ case SYMBOL_LOCALIZED:
+ {
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ Lisp_Object tmp; XSETBUFFER (tmp, buf);
+
+ /* If the current buffer is not the buffer whose binding is
+ loaded, or if there may be frame-local bindings and the frame
+ isn't the right one, or if it's a Lisp_Buffer_Local_Value and
+ the default binding is loaded, the loaded binding may be the
+ wrong one. */
+ if (!EQ (blv->where,
+ blv->frame_local ? selected_frame : tmp)
+ /* Also unload a global binding (if the var is local_if_set). */
+ || (EQ (blv->valcell, blv->defcell)))
+ {
+ /* The currently loaded binding is not necessarily valid.
+ We need to unload it, and choose a new binding. */
+
+ /* Write out `realvalue' to the old loaded binding. */
+ if (blv->fwd)
+ SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
+
+ /* Find the new binding. */
{
- /* This buffer still sees the default value. */
-
- /* If the variable is not local_if_set,
- or if this is `let' rather than `set',
- make CURRENT-ALIST-ELEMENT point to itself,
- indicating that we're seeing the default value.
- Likewise if the variable has been let-bound
- in the current buffer. */
- if (bindflag || !XBUFFER_LOCAL_VALUE (valcontents)->local_if_set
- || let_shadows_buffer_binding_p (XSYMBOL (symbol)))
+ XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */
+ if (blv->frame_local)
{
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
-
- if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
- tem1 = Fassq (symbol,
- XFRAME (selected_frame)->param_alist);
-
- if (! NILP (tem1))
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1;
- else
- tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
+ tem1 = Fassq (symbol, XFRAME (selected_frame)->param_alist);
+ blv->where = selected_frame;
}
- /* If it's a Lisp_Buffer_Local_Value, being set not bound,
- and we're not within a let that was made for this buffer,
- create a new buffer-local binding for the variable.
- That means, give this buffer a new assoc for a local value
- and load that binding. */
else
{
- tem1 = Fcons (symbol, XCDR (current_alist_element));
- buf->local_var_alist
- = Fcons (tem1, buf->local_var_alist);
+ tem1 = Fassq (symbol, buf->local_var_alist);
+ blv->where = tmp;
}
}
-
- /* Record which binding is now loaded. */
- XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1);
-
- /* Set `buffer' and `frame' slots for the binding now loaded. */
- XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, buf);
- XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame;
- }
- innercontents = XBUFFER_LOCAL_VALUE (valcontents)->realvalue;
-
- /* Store the new value in the cons-cell. */
- XSETCDR (XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr), newval);
+ blv->found = 1;
+
+ if (NILP (tem1))
+ {
+ /* This buffer still sees the default value. */
+
+ /* If the variable is a Lisp_Some_Buffer_Local_Value,
+ or if this is `let' rather than `set',
+ make CURRENT-ALIST-ELEMENT point to itself,
+ indicating that we're seeing the default value.
+ Likewise if the variable has been let-bound
+ in the current buffer. */
+ if (bindflag || !blv->local_if_set
+ || let_shadows_buffer_binding_p (sym))
+ {
+ blv->found = 0;
+ tem1 = blv->defcell;
+ }
+ /* If it's a local_if_set, being set not bound,
+ and we're not within a let that was made for this buffer,
+ create a new buffer-local binding for the variable.
+ That means, give this buffer a new assoc for a local value
+ and load that binding. */
+ else
+ {
+ /* local_if_set is only supported for buffer-local
+ bindings, not for frame-local bindings. */
+ eassert (!blv->frame_local);
+ tem1 = Fcons (symbol, XCDR (blv->defcell));
+ buf->local_var_alist
+ = Fcons (tem1, buf->local_var_alist);
+ }
+ }
+
+ /* Record which binding is now loaded. */
+ blv->valcell = tem1;
+ }
+
+ /* Store the new value in the cons cell. */
+ SET_BLV_VALUE (blv, newval);
+
+ if (blv->fwd)
+ {
+ if (voide)
+ /* If storing void (making the symbol void), forward only through
+ buffer-local indicator, not through Lisp_Objfwd, etc. */
+ blv->fwd = NULL;
+ else
+ store_symval_forwarding (blv->fwd, newval, buf);
+ }
+ break;
+ }
+ case SYMBOL_FORWARDED:
+ {
+ union Lisp_Fwd *innercontents = SYMBOL_FWD (sym);
+ if (BUFFER_OBJFWDP (innercontents))
+ {
+ int offset = XBUFFER_OBJFWD (innercontents)->offset;
+ int idx = PER_BUFFER_IDX (offset);
+ if (idx > 0
+ && !bindflag
+ && !let_shadows_buffer_binding_p (sym))
+ SET_PER_BUFFER_VALUE_P (buf, idx, 1);
+ }
+
+ if (voide)
+ { /* If storing void (making the symbol void), forward only through
+ buffer-local indicator, not through Lisp_Objfwd, etc. */
+ sym->redirect = SYMBOL_PLAINVAL;
+ SET_SYMBOL_VAL (sym, newval);
+ }
+ else
+ store_symval_forwarding (/* sym, */ innercontents, newval, buf);
+ break;
+ }
+ default: abort ();
}
-
- /* If storing void (making the symbol void), forward only through
- buffer-local indicator, not through Lisp_Objfwd, etc. */
- if (voide)
- store_symval_forwarding (symbol, Qnil, newval, buf);
- else
- store_symval_forwarding (symbol, innercontents, newval, buf);
-
- return newval;
+ return;
}
/* Access or set a buffer-local symbol's default value. */
@@ -1310,38 +1363,46 @@
default_value (symbol)
Lisp_Object symbol;
{
- register Lisp_Object valcontents;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (symbol);
- valcontents = SYMBOL_VALUE (symbol);
-
- /* For a built-in buffer-local variable, get the default value
- rather than letting do_symval_forwarding get the current value. */
- if (BUFFER_OBJFWDP (valcontents))
- {
- int offset = XBUFFER_OBJFWD (valcontents)->offset;
- if (PER_BUFFER_IDX (offset) != 0)
- return PER_BUFFER_DEFAULT (offset);
- }
-
- /* Handle user-created local variables. */
- if (BUFFER_LOCAL_VALUEP (valcontents))
- {
- /* If var is set up for a buffer that lacks a local value for it,
- the current value is nominally the default value.
- But the `realvalue' slot may be more up to date, since
- ordinary setq stores just that slot. So use that. */
- Lisp_Object current_alist_element, alist_element_car;
- current_alist_element
- = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
- alist_element_car = XCAR (current_alist_element);
- if (EQ (alist_element_car, current_alist_element))
- return do_symval_forwarding (XBUFFER_LOCAL_VALUE
(valcontents)->realvalue);
- else
- return XCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
- }
- /* For other variables, get the current value. */
- return do_symval_forwarding (valcontents);
+ sym = XSYMBOL (symbol);
+
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
+ case SYMBOL_LOCALIZED:
+ {
+ /* If var is set up for a buffer that lacks a local value for it,
+ the current value is nominally the default value.
+ But the `realvalue' slot may be more up to date, since
+ ordinary setq stores just that slot. So use that. */
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ if (blv->fwd && EQ (blv->valcell, blv->defcell))
+ return do_symval_forwarding (blv->fwd);
+ else
+ return XCDR (blv->defcell);
+ }
+ case SYMBOL_FORWARDED:
+ {
+ union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+
+ /* For a built-in buffer-local variable, get the default value
+ rather than letting do_symval_forwarding get the current value. */
+ if (BUFFER_OBJFWDP (valcontents))
+ {
+ int offset = XBUFFER_OBJFWD (valcontents)->offset;
+ if (PER_BUFFER_IDX (offset) != 0)
+ return PER_BUFFER_DEFAULT (offset);
+ }
+
+ /* For other variables, get the current value. */
+ return do_symval_forwarding (valcontents);
+ }
+ default: abort ();
+ }
}
DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0,
@@ -1381,50 +1442,68 @@
(symbol, value)
Lisp_Object symbol, value;
{
- register Lisp_Object valcontents, current_alist_element,
alist_element_buffer;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (symbol);
- valcontents = SYMBOL_VALUE (symbol);
-
- /* Handle variables like case-fold-search that have special slots
- in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
- variables. */
- if (BUFFER_OBJFWDP (valcontents))
- {
- int offset = XBUFFER_OBJFWD (valcontents)->offset;
- int idx = PER_BUFFER_IDX (offset);
-
- PER_BUFFER_DEFAULT (offset) = value;
-
- /* If this variable is not always local in all buffers,
- set it in the buffers that don't nominally have a local value. */
- if (idx > 0)
- {
- struct buffer *b;
-
- for (b = all_buffers; b; b = b->next)
- if (!PER_BUFFER_VALUE_P (b, idx))
- PER_BUFFER_VALUE (b, offset) = value;
- }
- return value;
- }
-
- if (!BUFFER_LOCAL_VALUEP (valcontents))
- return Fset (symbol, value);
-
- /* Store new value into the DEFAULT-VALUE slot. */
- XSETCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, value);
-
- /* If the default binding is now loaded, set the REALVALUE slot too. */
- current_alist_element
- = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
- alist_element_buffer = Fcar (current_alist_element);
- if (EQ (alist_element_buffer, current_alist_element))
- store_symval_forwarding (symbol,
- XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
- value, NULL);
-
- return value;
+ if (SYMBOL_CONSTANT_P (symbol))
+ {
+ if (NILP (Fkeywordp (symbol))
+ || !EQ (value, Fdefault_value (symbol)))
+ xsignal1 (Qsetting_constant, symbol);
+ else
+ /* Allow setting keywords to their own value. */
+ return value;
+ }
+ sym = XSYMBOL (symbol);
+
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return Fset (symbol, value);
+ case SYMBOL_LOCALIZED:
+ {
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+
+ /* Store new value into the DEFAULT-VALUE slot. */
+ XSETCDR (blv->defcell, value);
+
+ /* If the default binding is now loaded, set the REALVALUE slot too. */
+ if (blv->fwd && EQ (blv->defcell, blv->valcell))
+ store_symval_forwarding (blv->fwd, value, NULL);
+ return value;
+ }
+ case SYMBOL_FORWARDED:
+ {
+ union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+
+ /* Handle variables like case-fold-search that have special slots
+ in the buffer.
+ Make them work apparently like Lisp_Buffer_Local_Value variables. */
+ if (BUFFER_OBJFWDP (valcontents))
+ {
+ int offset = XBUFFER_OBJFWD (valcontents)->offset;
+ int idx = PER_BUFFER_IDX (offset);
+
+ PER_BUFFER_DEFAULT (offset) = value;
+
+ /* If this variable is not always local in all buffers,
+ set it in the buffers that don't nominally have a local value.
*/
+ if (idx > 0)
+ {
+ struct buffer *b;
+
+ for (b = all_buffers; b; b = b->next)
+ if (!PER_BUFFER_VALUE_P (b, idx))
+ PER_BUFFER_VALUE (b, offset) = value;
+ }
+ return value;
+ }
+ else
+ return Fset (symbol, value);
+ }
+ default: abort ();
+ }
}
DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0,
@@ -1468,6 +1547,35 @@
/* Lisp functions for creating and removing buffer-local variables. */
+union Lisp_Val_Fwd
+ {
+ Lisp_Object value;
+ union Lisp_Fwd *fwd;
+ };
+
+static struct Lisp_Buffer_Local_Value *
+make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd
valcontents)
+{
+ struct Lisp_Buffer_Local_Value *blv
+ = xmalloc (sizeof (struct Lisp_Buffer_Local_Value));
+ Lisp_Object symbol; XSETSYMBOL (symbol, sym);
+ Lisp_Object tem = Fcons (symbol, (forwarded
+ ? do_symval_forwarding (valcontents.fwd)
+ : valcontents.value));
+ /* Buffer_Local_Values cannot have as realval a buffer-local
+ or keyboard-local forwarding. */
+ eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd)));
+ eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd)));
+ blv->fwd = forwarded ? valcontents.fwd : NULL;
+ blv->where = Qnil;
+ blv->frame_local = 0;
+ blv->local_if_set = 0;
+ blv->defcell = tem;
+ blv->valcell = tem;
+ SET_BLV_FOUND (blv, 0);
+ return blv;
+}
+
DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local,
Smake_variable_buffer_local,
1, 1, "vMake Variable Buffer Local: ",
doc: /* Make VARIABLE become buffer-local whenever it is set.
@@ -1485,42 +1593,58 @@
(variable)
register Lisp_Object variable;
{
- register Lisp_Object tem, valcontents, newval;
struct Lisp_Symbol *sym;
+ struct Lisp_Buffer_Local_Value *blv = NULL;
+ union Lisp_Val_Fwd valcontents;
+ int forwarded;
CHECK_SYMBOL (variable);
- sym = indirect_variable (XSYMBOL (variable));
-
- valcontents = sym->value;
- if (sym->constant || KBOARD_OBJFWDP (valcontents))
- error ("Symbol %s may not be buffer-local", SDATA (sym->xname));
-
- if (BUFFER_OBJFWDP (valcontents))
- return variable;
- else if (BUFFER_LOCAL_VALUEP (valcontents))
- {
- if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
- error ("Symbol %s may not be buffer-local", SDATA (sym->xname));
- newval = valcontents;
- }
- else
- {
- if (EQ (valcontents, Qunbound))
- sym->value = Qnil;
- tem = Fcons (Qnil, Fsymbol_value (variable));
- XSETCAR (tem, tem);
- newval = allocate_misc ();
- XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
- XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value;
- XBUFFER_LOCAL_VALUE (newval)->buffer = Fcurrent_buffer ();
- XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
- XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
- XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
- XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
- XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
- sym->value = newval;
- }
- XBUFFER_LOCAL_VALUE (newval)->local_if_set = 1;
+ sym = XSYMBOL (variable);
+
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL:
+ forwarded = 0; valcontents.value = SYMBOL_VAL (sym);
+ if (EQ (valcontents.value, Qunbound))
+ valcontents.value = Qnil;
+ break;
+ case SYMBOL_LOCALIZED:
+ blv = SYMBOL_BLV (sym);
+ if (blv->frame_local)
+ error ("Symbol %s may not be buffer-local",
+ SDATA (SYMBOL_NAME (variable)));
+ break;
+ case SYMBOL_FORWARDED:
+ forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym);
+ if (KBOARD_OBJFWDP (valcontents.fwd))
+ error ("Symbol %s may not be buffer-local",
+ SDATA (SYMBOL_NAME (variable)));
+ else if (BUFFER_OBJFWDP (valcontents.fwd))
+ return variable;
+ break;
+ default: abort ();
+ }
+
+ if (sym->constant)
+ error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME
(variable)));
+
+ if (!blv)
+ {
+ blv = make_blv (sym, forwarded, valcontents);
+ sym->redirect = SYMBOL_LOCALIZED;
+ SET_SYMBOL_BLV (sym, blv);
+ {
+ Lisp_Object symbol;
+ XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */
+ if (let_shadows_global_binding_p (symbol))
+ error ("Making %s buffer-local while let-bound!",
+ SDATA (SYMBOL_NAME (variable)));
+ }
+ }
+
+ blv->local_if_set = 1;
return variable;
}
@@ -1547,82 +1671,95 @@
(variable)
register Lisp_Object variable;
{
- register Lisp_Object tem, valcontents;
+ register Lisp_Object tem;
+ int forwarded;
+ union Lisp_Val_Fwd valcontents;
struct Lisp_Symbol *sym;
+ struct Lisp_Buffer_Local_Value *blv = NULL;
CHECK_SYMBOL (variable);
- sym = indirect_variable (XSYMBOL (variable));
-
- valcontents = sym->value;
- if (sym->constant || KBOARD_OBJFWDP (valcontents)
- || (BUFFER_LOCAL_VALUEP (valcontents)
- && (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)))
- error ("Symbol %s may not be buffer-local", SDATA (sym->xname));
-
- if ((BUFFER_LOCAL_VALUEP (valcontents)
- && XBUFFER_LOCAL_VALUE (valcontents)->local_if_set)
- || BUFFER_OBJFWDP (valcontents))
+ sym = XSYMBOL (variable);
+
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL:
+ forwarded = 0; valcontents.value = SYMBOL_VAL (sym); break;
+ case SYMBOL_LOCALIZED:
+ blv = SYMBOL_BLV (sym);
+ if (blv->frame_local)
+ error ("Symbol %s may not be buffer-local",
+ SDATA (SYMBOL_NAME (variable)));
+ break;
+ case SYMBOL_FORWARDED:
+ forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym);
+ if (KBOARD_OBJFWDP (valcontents.fwd))
+ error ("Symbol %s may not be buffer-local",
+ SDATA (SYMBOL_NAME (variable)));
+ break;
+ default: abort ();
+ }
+
+ if (sym->constant)
+ error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME
(variable)));
+
+ if (blv ? blv->local_if_set
+ : (forwarded && BUFFER_OBJFWDP (valcontents.fwd)))
{
tem = Fboundp (variable);
-
/* Make sure the symbol has a local value in this particular buffer,
by setting it to the same value it already has. */
Fset (variable, (EQ (tem, Qt) ? Fsymbol_value (variable) : Qunbound));
return variable;
}
- /* Make sure symbol is set up to hold per-buffer values. */
- if (!BUFFER_LOCAL_VALUEP (valcontents))
+ if (!blv)
{
- Lisp_Object newval;
- tem = Fcons (Qnil, do_symval_forwarding (valcontents));
- XSETCAR (tem, tem);
- newval = allocate_misc ();
- XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
- XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value;
- XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil;
- XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
- XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0;
- XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
- XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
- XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
- XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
- sym->value = newval;
+ blv = make_blv (sym, forwarded, valcontents);
+ sym->redirect = SYMBOL_LOCALIZED;
+ SET_SYMBOL_BLV (sym, blv);
+ {
+ Lisp_Object symbol;
+ XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */
+ if (let_shadows_global_binding_p (symbol))
+ error ("Making %s local to %s while let-bound!",
+ SDATA (SYMBOL_NAME (variable)), SDATA (current_buffer->name));
+ }
}
+
/* Make sure this buffer has its own value of symbol. */
- XSETSYMBOL (variable, sym); /* Propagate variable indirections. */
+ XSETSYMBOL (variable, sym); /* Update in case of aliasing. */
tem = Fassq (variable, current_buffer->local_var_alist);
if (NILP (tem))
{
+ if (let_shadows_buffer_binding_p (sym))
+ message ("Making %s buffer-local while locally let-bound!",
+ SDATA (SYMBOL_NAME (variable)));
+
/* Swap out any local binding for some other buffer, and make
sure the current value is permanently recorded, if it's the
default value. */
find_symbol_value (variable);
current_buffer->local_var_alist
- = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE
(sym->value)->cdr)),
+ = Fcons (Fcons (variable, XCDR (blv->defcell)),
current_buffer->local_var_alist);
/* Make sure symbol does not think it is set up for this buffer;
force it to look once again for this buffer's value. */
- {
- Lisp_Object *pvalbuf;
-
- valcontents = sym->value;
-
- pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
- if (current_buffer == XBUFFER (*pvalbuf))
- *pvalbuf = Qnil;
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
- }
+ if (current_buffer == XBUFFER (blv->where))
+ blv->where = Qnil;
+ /* blv->valcell = blv->defcell;
+ * SET_BLV_FOUND (blv, 0); */
+ blv->found = 0;
}
/* If the symbol forwards into a C variable, then load the binding
for this buffer now. If C code modifies the variable before we
load the binding in, then that new value will clobber the default
binding the next time we unload it. */
- valcontents = XBUFFER_LOCAL_VALUE (sym->value)->realvalue;
- if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents))
- swap_in_symval_forwarding (variable, sym->value);
+ if (blv->fwd)
+ swap_in_symval_forwarding (sym, blv);
return variable;
}
@@ -1634,31 +1771,43 @@
(variable)
register Lisp_Object variable;
{
- register Lisp_Object tem, valcontents;
+ register Lisp_Object tem;
+ struct Lisp_Buffer_Local_Value *blv;
struct Lisp_Symbol *sym;
CHECK_SYMBOL (variable);
- sym = indirect_variable (XSYMBOL (variable));
-
- valcontents = sym->value;
-
- if (BUFFER_OBJFWDP (valcontents))
+ sym = XSYMBOL (variable);
+
+ start:
+ switch (sym->redirect)
{
- int offset = XBUFFER_OBJFWD (valcontents)->offset;
- int idx = PER_BUFFER_IDX (offset);
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return variable;
+ case SYMBOL_FORWARDED:
+ {
+ union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+ if (BUFFER_OBJFWDP (valcontents))
+ {
+ int offset = XBUFFER_OBJFWD (valcontents)->offset;
+ int idx = PER_BUFFER_IDX (offset);
- if (idx > 0)
- {
- SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
- PER_BUFFER_VALUE (current_buffer, offset)
- = PER_BUFFER_DEFAULT (offset);
- }
- return variable;
+ if (idx > 0)
+ {
+ SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
+ PER_BUFFER_VALUE (current_buffer, offset)
+ = PER_BUFFER_DEFAULT (offset);
+ }
+ }
+ return variable;
+ }
+ case SYMBOL_LOCALIZED:
+ blv = SYMBOL_BLV (sym);
+ if (blv->frame_local)
+ return variable;
+ break;
+ default: abort ();
}
- if (!BUFFER_LOCAL_VALUEP (valcontents))
- return variable;
-
/* Get rid of this buffer's alist element, if any. */
XSETSYMBOL (variable, sym); /* Propagate variable indirection. */
tem = Fassq (variable, current_buffer->local_var_alist);
@@ -1670,14 +1819,13 @@
loaded, recompute its value. We have to do it now, or else
forwarded objects won't work right. */
{
- Lisp_Object *pvalbuf, buf;
- valcontents = sym->value;
- pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
- XSETBUFFER (buf, current_buffer);
- if (EQ (buf, *pvalbuf))
+ Lisp_Object buf; XSETBUFFER (buf, current_buffer);
+ if (EQ (buf, blv->where))
{
- *pvalbuf = Qnil;
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
+ blv->where = Qnil;
+ /* blv->valcell = blv->defcell;
+ * SET_BLV_FOUND (blv, 0); */
+ blv->found = 0;
find_symbol_value (variable);
}
}
@@ -1712,39 +1860,45 @@
(variable)
register Lisp_Object variable;
{
- register Lisp_Object tem, valcontents, newval;
+ int forwarded;
+ union Lisp_Val_Fwd valcontents;
struct Lisp_Symbol *sym;
+ struct Lisp_Buffer_Local_Value *blv = NULL;
CHECK_SYMBOL (variable);
- sym = indirect_variable (XSYMBOL (variable));
-
- valcontents = sym->value;
- if (sym->constant || KBOARD_OBJFWDP (valcontents)
- || BUFFER_OBJFWDP (valcontents))
- error ("Symbol %s may not be frame-local", SDATA (sym->xname));
-
- if (BUFFER_LOCAL_VALUEP (valcontents))
+ sym = XSYMBOL (variable);
+
+ start:
+ switch (sym->redirect)
{
- if (!XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
- error ("Symbol %s may not be frame-local", SDATA (sym->xname));
- return variable;
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL:
+ forwarded = 0; valcontents.value = SYMBOL_VAL (sym);
+ if (EQ (valcontents.value, Qunbound))
+ valcontents.value = Qnil;
+ break;
+ case SYMBOL_LOCALIZED:
+ if (SYMBOL_BLV (sym)->frame_local)
+ return variable;
+ else
+ error ("Symbol %s may not be frame-local",
+ SDATA (SYMBOL_NAME (variable)));
+ case SYMBOL_FORWARDED:
+ forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym);
+ if (KBOARD_OBJFWDP (valcontents.fwd) || BUFFER_OBJFWDP (valcontents.fwd))
+ error ("Symbol %s may not be frame-local",
+ SDATA (SYMBOL_NAME (variable)));
+ break;
+ default: abort ();
}
- if (EQ (valcontents, Qunbound))
- sym->value = Qnil;
- tem = Fcons (Qnil, Fsymbol_value (variable));
- XSETCAR (tem, tem);
- newval = allocate_misc ();
- XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
- XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value;
- XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil;
- XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
- XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0;
- XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
- XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
- XBUFFER_LOCAL_VALUE (newval)->check_frame = 1;
- XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
- sym->value = newval;
+ if (sym->constant)
+ error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
+
+ blv = make_blv (sym, forwarded, valcontents);
+ blv->frame_local = 1;
+ sym->redirect = SYMBOL_LOCALIZED;
+ SET_SYMBOL_BLV (sym, blv);
return variable;
}
@@ -1755,7 +1909,6 @@
(variable, buffer)
register Lisp_Object variable, buffer;
{
- Lisp_Object valcontents;
register struct buffer *buf;
struct Lisp_Symbol *sym;
@@ -1768,29 +1921,46 @@
}
CHECK_SYMBOL (variable);
- sym = indirect_variable (XSYMBOL (variable));
- XSETSYMBOL (variable, sym);
-
- valcontents = sym->value;
- if (BUFFER_LOCAL_VALUEP (valcontents))
- {
- Lisp_Object tail, elt;
-
- for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
- {
- elt = XCAR (tail);
- if (EQ (variable, XCAR (elt)))
- return Qt;
- }
- }
- if (BUFFER_OBJFWDP (valcontents))
- {
- int offset = XBUFFER_OBJFWD (valcontents)->offset;
- int idx = PER_BUFFER_IDX (offset);
- if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
- return Qt;
- }
- return Qnil;
+ sym = XSYMBOL (variable);
+
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return Qnil;
+ case SYMBOL_LOCALIZED:
+ {
+ Lisp_Object tail, elt, tmp;
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ XSETBUFFER (tmp, buf);
+
+ for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ if (EQ (variable, XCAR (elt)))
+ {
+ eassert (!blv->frame_local);
+ eassert (BLV_FOUND (blv) || !EQ (blv->where, tmp));
+ return Qt;
+ }
+ }
+ eassert (!BLV_FOUND (blv) || !EQ (blv->where, tmp));
+ return Qnil;
+ }
+ case SYMBOL_FORWARDED:
+ {
+ union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+ if (BUFFER_OBJFWDP (valcontents))
+ {
+ int offset = XBUFFER_OBJFWD (valcontents)->offset;
+ int idx = PER_BUFFER_IDX (offset);
+ if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
+ return Qt;
+ }
+ return Qnil;
+ }
+ default: abort ();
+ }
}
DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p,
Slocal_variable_if_set_p,
@@ -1804,40 +1974,29 @@
(variable, buffer)
register Lisp_Object variable, buffer;
{
- Lisp_Object valcontents;
- register struct buffer *buf;
struct Lisp_Symbol *sym;
- if (NILP (buffer))
- buf = current_buffer;
- else
- {
- CHECK_BUFFER (buffer);
- buf = XBUFFER (buffer);
- }
-
CHECK_SYMBOL (variable);
- sym = indirect_variable (XSYMBOL (variable));
- XSETSYMBOL (variable, sym);
-
- valcontents = sym->value;
-
- if (BUFFER_OBJFWDP (valcontents))
- /* All these slots become local if they are set. */
- return Qt;
- else if (BUFFER_LOCAL_VALUEP (valcontents))
+ sym = XSYMBOL (variable);
+
+ start:
+ switch (sym->redirect)
{
- Lisp_Object tail, elt;
- if (XBUFFER_LOCAL_VALUE (valcontents)->local_if_set)
- return Qt;
- for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
- {
- elt = XCAR (tail);
- if (EQ (variable, XCAR (elt)))
- return Qt;
- }
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return Qnil;
+ case SYMBOL_LOCALIZED:
+ {
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ if (blv->local_if_set)
+ return Qt;
+ XSETSYMBOL (variable, sym); /* Update in case of aliasing. */
+ return Flocal_variable_p (variable, buffer);
+ }
+ case SYMBOL_FORWARDED:
+ /* All BUFFER_OBJFWD slots become local if they are set. */
+ return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil);
+ default: abort ();
}
- return Qnil;
}
DEFUN ("variable-binding-locus", Fvariable_binding_locus,
Svariable_binding_locus,
@@ -1849,30 +2008,40 @@
(variable)
register Lisp_Object variable;
{
- Lisp_Object valcontents;
struct Lisp_Symbol *sym;
CHECK_SYMBOL (variable);
- sym = indirect_variable (XSYMBOL (variable));
+ sym = XSYMBOL (variable);
/* Make sure the current binding is actually swapped in. */
find_symbol_value (variable);
- valcontents = sym->value;
-
- if (BUFFER_LOCAL_VALUEP (valcontents)
- || BUFFER_OBJFWDP (valcontents))
+ start:
+ switch (sym->redirect)
{
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return Qnil;
+ case SYMBOL_FORWARDED:
+ {
+ union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+ if (KBOARD_OBJFWDP (valcontents))
+ return Fframe_terminal (Fselected_frame ());
+ else if (!BUFFER_OBJFWDP (valcontents))
+ return Qnil;
+ }
+ /* FALLTHROUGH */
+ case SYMBOL_LOCALIZED:
/* For a local variable, record both the symbol and which
buffer's or frame's value we are saving. */
if (!NILP (Flocal_variable_p (variable, Qnil)))
return Fcurrent_buffer ();
- else if (BUFFER_LOCAL_VALUEP (valcontents)
- && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
- return XBUFFER_LOCAL_VALUE (valcontents)->frame;
+ else if (sym->redirect == SYMBOL_LOCALIZED
+ && BLV_FOUND (SYMBOL_BLV (sym)))
+ return SYMBOL_BLV (sym)->where;
+ else
+ return Qnil;
+ default: abort ();
}
-
- return Qnil;
}
/* This code is disabled now that we use the selected frame to return
=== modified file 'src/eval.c'
--- a/src/eval.c 2010-01-13 08:35:10 +0000
+++ b/src/eval.c 2010-04-20 01:50:52 +0000
@@ -767,24 +767,46 @@
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 @@
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 @@
|| (!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 @@
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))
- {
- 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;
+ start:
+ switch (sym->redirect)
+ {
+ 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;
-
- 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);
+ case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED:
+ {
+ Lisp_Object ovalue = find_symbol_value (symbol);
+ specpdl_ptr->func = 0;
+ specpdl_ptr->old_value = ovalue;
+
+ 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 @@
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 @@
/* 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);
}
=== modified file 'src/frame.c'
--- a/src/frame.c 2010-03-24 18:02:56 +0000
+++ b/src/frame.c 2010-04-20 01:50:52 +0000
@@ -2298,13 +2298,20 @@
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 @@
|| 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)));
}
=== modified file 'src/insdel.c'
--- a/src/insdel.c 2010-01-13 08:35:10 +0000
+++ b/src/insdel.c 2010-04-20 01:50:52 +0000
@@ -54,7 +54,7 @@
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)
=== modified file 'src/keyboard.c'
--- a/src/keyboard.c 2010-04-02 03:10:33 +0000
+++ b/src/keyboard.c 2010-04-20 01:50:52 +0000
@@ -1520,7 +1520,6 @@
command_loop_1 ()
{
Lisp_Object cmd;
- int lose;
Lisp_Object keybuf[30];
int i;
int prev_modiff = 0;
=== modified file 'src/lisp.h'
--- a/src/lisp.h 2010-03-05 23:08:18 +0000
+++ b/src/lisp.h 2010-04-20 01:50:52 +0000
@@ -223,13 +223,7 @@
{
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 @@
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 @@
#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 @@
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 @@
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 @@
/* 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 @@
#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_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 @@
- 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 *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 @@
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 @@
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 @@
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 @@
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;
+ enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Buffer_Obj */
+ int offset;
Lisp_Object slottype; /* Qnil, Lisp_Int, Lisp_Symbol, or Lisp_String. */
- int offset;
};
/* struct Lisp_Buffer_Local_Value is used in a symbol value cell when
@@ -1316,48 +1338,51 @@
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 @@
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 @@
#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 @@
{
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 @@
#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 @@
#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 *)(¤t_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 *)(¤t_kboard->vname) \
+ - (char *)current_kboard)); \
+ } while (0)
@@ -2341,13 +2385,11 @@
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 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));
=== modified file 'src/lread.c'
--- a/src/lread.c 2010-04-02 03:10:33 +0000
+++ b/src/lread.c 2010-04-20 01:50:52 +0000
@@ -3687,7 +3687,8 @@
&& 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 @@
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 @@
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 @@
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 @@
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 @@
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
=== modified file 'src/print.c'
--- a/src/print.c 2010-01-13 08:35:10 +0000
+++ b/src/print.c 2010-04-20 01:50:52 +0000
@@ -2267,70 +2267,6 @@
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",
=== modified file 'src/term.c'
--- a/src/term.c 2010-04-13 02:19:17 +0000
+++ b/src/term.c 2010-04-20 01:50:52 +0000
@@ -2244,7 +2244,7 @@
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 @@
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;
=== modified file 'src/xdisp.c'
--- a/src/xdisp.c 2010-04-19 15:35:15 +0000
+++ b/src/xdisp.c 2010-04-20 01:50:52 +0000
@@ -11592,7 +11592,7 @@
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 @@
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));
}
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r99947: Make variable forwarding explicit rather the using special values.,
Stefan Monnier <=