Commit ce5b453a authored by Stefan Monnier's avatar Stefan Monnier
Browse files

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.
parent 56d365a9
2010-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
Make variable forwarding explicit rather the using special values.
Basically, this makes the structure of buffer-local values and object
forwarding explicit in the type of Lisp_Symbols rather than use
special Lisp_Objects for that. This tends to lead to slightly more
verbose code, but is more C-like, simpler, and makes it easier to make
sure we handled all cases, among other things by letting the compiler
help us check it.
* lisp.h (enum Lisp_Misc_Type, union Lisp_Misc):
Removing forwarding objects.
(enum Lisp_Fwd_Type, enum symbol_redirect, union Lisp_Fwd): New types.
(struct Lisp_Symbol): Make the various forms of variable-forwarding
explicit rather than hiding them inside Lisp_Object "values".
(XFWDTYPE): New macro.
(XINTFWD, XBOOLFWD, XOBJFWD, XKBOARD_OBJFWD): Redefine.
(XBUFFER_LOCAL_VALUE): Remove.
(SYMBOL_VAL, SYMBOL_ALIAS, SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL)
(SET_SYMBOL_ALIAS, SET_SYMBOL_BLV, SET_SYMBOL_FWD): New macros.
(SYMBOL_VALUE, SET_SYMBOL_VALUE): Remove.
(struct Lisp_Intfwd, struct Lisp_Boolfwd, struct Lisp_Objfwd)
(struct Lisp_Buffer_Objfwd, struct Lisp_Kboard_Objfwd):
Remove the Lisp_Misc_* header.
(struct Lisp_Buffer_Local_Value): Redefine.
(BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE): New macros.
(struct Lisp_Misc_Any): Add filler to get the right size.
(struct Lisp_Free): Use struct Lisp_Misc_Any rather than struct
Lisp_Intfwd.
(DEFVAR_LISP, DEFVAR_LISP_NOPRO, DEFVAR_BOOL, DEFVAR_INT)
(DEFVAR_KBOARD): Allocate a forwarding object.
* data.c (do_blv_forwarding, store_blv_forwarding): New macros.
(let_shadows_global_binding_p): New function.
(union Lisp_Val_Fwd): New type.
(make_blv): New function.
(swap_in_symval_forwarding, indirect_variable, do_symval_forwarding)
(store_symval_forwarding, swap_in_global_binding, Fboundp)
(swap_in_symval_forwarding, find_symbol_value, Fset)
(let_shadows_buffer_binding_p, set_internal, default_value)
(Fset_default, Fmake_variable_buffer_local, Fmake_local_variable)
(Fkill_local_variable, Fmake_variable_frame_local)
(Flocal_variable_p, Flocal_variable_if_set_p)
(Fvariable_binding_locus):
* xdisp.c (select_frame_for_redisplay):
* lread.c (Fintern, Funintern, init_obarray, defvar_int)
(defvar_bool, defvar_lisp_nopro, defvar_lisp, defvar_kboard):
* frame.c (store_frame_param):
* eval.c (Fdefvaralias, Fuser_variable_p, specbind, unbind_to):
* bytecode.c (Fbyte_code) <varref, varset>: Adapt to the new symbol
value structure.
* buffer.c (PER_BUFFER_SYMBOL): Move from buffer.h.
(clone_per_buffer_values): Only adjust markers into the current buffer.
(reset_buffer_local_variables): PER_BUFFER_IDX is never -2.
(Fbuffer_local_value, set_buffer_internal_1)
(swap_out_buffer_local_variables):
Adapt to the new symbol value structure.
(DEFVAR_PER_BUFFER): Allocate a Lisp_Buffer_Objfwd object.
(defvar_per_buffer): Take a new arg for the fwd object.
(buffer_lisp_local_variables): Return a proper alist (different fix
for bug#4138).
* alloc.c (Fmake_symbol): Use SET_SYMBOL_VAL.
(Fgarbage_collect): Don't handle buffer_defaults specially.
(mark_object): Handle new symbol value structure rather than the old
special Lisp_Misc_* objects.
(gc_sweep) <symbols>: Free also the buffer-local-value objects.
* term.c (set_tty_color_mode):
* bidi.c (bidi_initialize): Don't access the ->value field directly.
* buffer.h (PER_BUFFER_VAR_OFFSET): Don't bother with
a buffer_local_flags.
* print.c (print_object): Get rid of impossible forwarding objects.
2010-04-19 Eli Zaretskii <eliz@gnu.org>
* bidi.c (bidi_get_type, bidi_get_category)
(bidi_at_paragraph_end, bidi_resolve_weak, bidi_resolve_neutral)
(bidi_type_of_next_char, bidi_level_of_next_char): Declare
static. Use `INLINE' rather than `inline'.
(bidi_type_of_next_char, bidi_level_of_next_char):
Declare static. Use `INLINE' rather than `inline'.
2010-04-19 Juanma Barranquero <lekktu@gmail.com>
......
......@@ -1365,7 +1365,7 @@ uninterrupt_malloc ()
pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE);
pthread_mutex_init (&alloc_mutex, &attr);
#else /* !DOUG_LEA_MALLOC */
/* Some systems such as Solaris 2.6 doesn't have a recursive mutex,
/* Some systems such as Solaris 2.6 don't have a recursive mutex,
and the bundled gmalloc.c doesn't require it. */
pthread_mutex_init (&alloc_mutex, NULL);
#endif /* !DOUG_LEA_MALLOC */
......@@ -3193,13 +3193,13 @@ Its value and function definition are void, and its property list is nil. */)
p = XSYMBOL (val);
p->xname = name;
p->plist = Qnil;
p->value = Qunbound;
p->redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (p, Qunbound);
p->function = Qunbound;
p->next = NULL;
p->gcmarkbit = 0;
p->interned = SYMBOL_UNINTERNED;
p->constant = 0;
p->indirect_variable = 0;
consing_since_gc += sizeof (struct Lisp_Symbol);
symbols_consed++;
return val;
......@@ -5581,17 +5581,42 @@ mark_object (arg)
break;
CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
ptr->gcmarkbit = 1;
mark_object (ptr->value);
mark_object (ptr->function);
mark_object (ptr->plist);
switch (ptr->redirect)
{
case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break;
case SYMBOL_VARALIAS:
{
Lisp_Object tem;
XSETSYMBOL (tem, SYMBOL_ALIAS (ptr));
mark_object (tem);
break;
}
case SYMBOL_LOCALIZED:
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr);
/* If the value is forwarded to a buffer or keyboard field,
these are marked when we see the corresponding object.
And if it's forwarded to a C variable, either it's not
a Lisp_Object var, or it's staticpro'd already. */
mark_object (blv->where);
mark_object (blv->valcell);
mark_object (blv->defcell);
break;
}
case SYMBOL_FORWARDED:
/* If the value is forwarded to a buffer or keyboard field,
these are marked when we see the corresponding object.
And if it's forwarded to a C variable, either it's not
a Lisp_Object var, or it's staticpro'd already. */
break;
default: abort ();
}
if (!PURE_POINTER_P (XSTRING (ptr->xname)))
MARK_STRING (XSTRING (ptr->xname));
MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname));
/* Note that we do not mark the obarray of the symbol.
It is safe not to do so because nothing accesses that
slot except to check whether it is nil. */
ptr = ptr->next;
if (ptr)
{
......@@ -5610,22 +5635,6 @@ mark_object (arg)
switch (XMISCTYPE (obj))
{
case Lisp_Misc_Buffer_Local_Value:
{
register struct Lisp_Buffer_Local_Value *ptr
= XBUFFER_LOCAL_VALUE (obj);
/* If the cdr is nil, avoid recursion for the car. */
if (EQ (ptr->cdr, Qnil))
{
obj = ptr->realvalue;
goto loop;
}
mark_object (ptr->realvalue);
mark_object (ptr->buffer);
mark_object (ptr->frame);
obj = ptr->cdr;
goto loop;
}
case Lisp_Misc_Marker:
/* DO NOT mark thru the marker's chain.
......@@ -5633,17 +5642,6 @@ mark_object (arg)
instead, markers are removed from the chain when freed by gc. */
break;
case Lisp_Misc_Intfwd:
case Lisp_Misc_Boolfwd:
case Lisp_Misc_Objfwd:
case Lisp_Misc_Buffer_Objfwd:
case Lisp_Misc_Kboard_Objfwd:
/* Don't bother with Lisp_Buffer_Objfwd,
since all markable slots in current buffer marked anyway. */
/* Don't need to do Lisp_Objfwd, since the places they point
are protected with staticpro. */
break;
case Lisp_Misc_Save_Value:
#if GC_MARK_STACK
{
......@@ -6048,6 +6046,8 @@ gc_sweep ()
if (!sym->gcmarkbit && !pure_p)
{
if (sym->redirect == SYMBOL_LOCALIZED)
xfree (SYMBOL_BLV (sym));
sym->next = symbol_free_list;
symbol_free_list = sym;
#if GC_MARK_STACK
......
......@@ -400,14 +400,14 @@ bidi_initialize ()
make_number (bidi_type[i].type));
fallback_paragraph_start_re =
XSYMBOL (Fintern_soft (build_string ("paragraph-start"), Qnil))->value;
Fsymbol_value (Fintern_soft (build_string ("paragraph-start"), Qnil));
if (!STRINGP (fallback_paragraph_start_re))
fallback_paragraph_start_re = build_string ("\f\\|[ \t]*$");
staticpro (&fallback_paragraph_start_re);
Qparagraph_start = intern ("paragraph-start");
staticpro (&Qparagraph_start);
fallback_paragraph_separate_re =
XSYMBOL (Fintern_soft (build_string ("paragraph-separate"), Qnil))->value;
Fsymbol_value (Fintern_soft (build_string ("paragraph-separate"), Qnil));
if (!STRINGP (fallback_paragraph_separate_re))
fallback_paragraph_separate_re = build_string ("[ \t\f]*$");
staticpro (&fallback_paragraph_separate_re);
......@@ -879,7 +879,6 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it)
int ch, ch_len;
EMACS_INT pos;
bidi_type_t type;
EMACS_INT sep_len;
/* If we are inside a paragraph separator, we are just waiting
for the separator to be exhausted; use the previous paragraph
......
......@@ -78,9 +78,6 @@ static Lisp_Object Vbuffer_defaults;
be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
and the corresponding slot in buffer_defaults is not used.
If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
but there is a default value which is copied into each buffer.
If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
zero, that is a bug */
......@@ -94,6 +91,12 @@ DECL_ALIGN (struct buffer, buffer_local_symbols);
/* A Lisp_Object pointer to the above, used for staticpro */
static Lisp_Object Vbuffer_local_symbols;
/* Return the symbol of the per-buffer variable at offset OFFSET in
the buffer structure. */
#define PER_BUFFER_SYMBOL(OFFSET) \
(*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
/* Flags indicating which built-in buffer-local variables
are permanent locals. */
static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
......@@ -507,7 +510,7 @@ clone_per_buffer_values (from, to)
continue;
obj = PER_BUFFER_VALUE (from, offset);
if (MARKERP (obj))
if (MARKERP (obj) && XMARKER (obj)->buffer == from)
{
struct Lisp_Marker *m = XMARKER (obj);
obj = Fmake_marker ();
......@@ -770,9 +773,7 @@ reset_buffer_local_variables (b, permanent_too)
{
Lisp_Object tmp, prop, last = Qnil;
for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp))
if (CONSP (XCAR (tmp))
&& SYMBOLP (XCAR (XCAR (tmp)))
&& !NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
{
/* If permanent-local, keep it. */
last = tmp;
......@@ -822,9 +823,7 @@ reset_buffer_local_variables (b, permanent_too)
int idx = PER_BUFFER_IDX (offset);
if ((idx > 0
&& (permanent_too
|| buffer_permanent_local_flags[idx] == 0))
/* Is -2 used anywhere? */
|| idx == -2)
|| buffer_permanent_local_flags[idx] == 0)))
PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
}
}
......@@ -938,59 +937,49 @@ is the default binding of the variable. */)
CHECK_SYMBOL (variable);
CHECK_BUFFER (buffer);
buf = XBUFFER (buffer);
sym = XSYMBOL (variable);
sym = indirect_variable (XSYMBOL (variable));
XSETSYMBOL (variable, sym);
/* Look in local_var_list */
result = Fassoc (variable, buf->local_var_alist);
if (NILP (result))
{
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
start:
switch (sym->redirect)
{
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. */
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;
Fsetcdr (current_alist_element,
do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
/* 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. */
/* Now get the (perhaps updated) value out of the binding. */
result = XCDR (result);
XSETCDR (current_alist_element,
do_symval_forwarding (blv->fwd));
}
/* Now get the (perhaps updated) value out of the binding. */
result = XCDR (result);
}
else
result = Fdefault_value (variable);
break;
}
case SYMBOL_FORWARDED:
{
union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
if (BUFFER_OBJFWDP (fwd))
result = PER_BUFFER_VALUE (buf, XBUFFER_OBJFWD (fwd)->offset);
else
result = Fdefault_value (variable);
break;
}
default: abort ();
}
if (!EQ (result, Qunbound))
......@@ -1025,12 +1014,7 @@ buffer_lisp_local_variables (buf)
if (buf != current_buffer)
val = XCDR (elt);
/* If symbol is unbound, put just the symbol in the list. */
if (EQ (val, Qunbound))
result = Fcons (XCAR (elt), result);
/* Otherwise, put (symbol . value) in the list. */
else
result = Fcons (Fcons (XCAR (elt), val), result);
result = Fcons (Fcons (XCAR (elt), val), result);
}
return result;
......@@ -1862,8 +1846,7 @@ set_buffer_internal_1 (b)
register struct buffer *b;
{
register struct buffer *old_buf;
register Lisp_Object tail, valcontents;
Lisp_Object tem;
register Lisp_Object tail;
#ifdef USE_MMAP_FOR_BUFFERS
if (b->text->beg == NULL)
......@@ -1935,34 +1918,21 @@ set_buffer_internal_1 (b)
/* Look down buffer's list of local Lisp variables
to find and update any that forward into C variables. */
for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail))
do
{
if (CONSP (XCAR (tail))
&& SYMBOLP (XCAR (XCAR (tail)))
&& (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
(BUFFER_LOCAL_VALUEP (valcontents)))
&& (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
(BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
/* Just reference the variable to cause it to become set for
this buffer. */
Fsymbol_value (XCAR (XCAR (tail)));
for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object var = XCAR (XCAR (tail));
struct Lisp_Symbol *sym = XSYMBOL (var);
if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */
&& SYMBOL_BLV (sym)->fwd)
/* Just reference the variable
to cause it to become set for this buffer. */
Fsymbol_value (var);
}
}
/* Do the same with any others that were local to the previous buffer */
if (old_buf)
for (tail = old_buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
{
if (CONSP (tail)
&& SYMBOLP (XCAR (XCAR (tail)))
&& (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
(BUFFER_LOCAL_VALUEP (valcontents)))
&& (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
(BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
/* Just reference the variable to cause it to become set for
this buffer. */
Fsymbol_value (XCAR (XCAR (tail)));
}
while (b != old_buf && (b = old_buf, b));
}
/* Switch to buffer B temporarily for redisplay purposes.
......@@ -2677,23 +2647,22 @@ static void
swap_out_buffer_local_variables (b)
struct buffer *b;
{
Lisp_Object oalist, alist, sym, buffer;
Lisp_Object oalist, alist, buffer;
XSETBUFFER (buffer, b);
oalist = b->local_var_alist;
for (alist = oalist; CONSP (alist); alist = XCDR (alist))
{
if (CONSP (XCAR (alist))
&& (sym = XCAR (XCAR (alist)), SYMBOLP (sym))
/* Need not do anything if some other buffer's binding is
now encached. */
&& EQ (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->buffer,
buffer))
Lisp_Object sym = XCAR (XCAR (alist));
eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED);
/* Need not do anything if some other buffer's binding is
now encached. */
if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
{
/* Symbol is set up for this buffer's old local value:
swap it out! */
swap_in_global_binding (sym);
swap_in_global_binding (XSYMBOL (sym));
}
}
}
......@@ -5162,7 +5131,9 @@ init_buffer_once ()
/* Make sure all markable slots in buffer_defaults
are initialized reasonably, so mark_buffer won't choke. */
reset_buffer (&buffer_defaults);
eassert (EQ (buffer_defaults.name, make_number (0)));
reset_buffer_local_variables (&buffer_defaults, 1);
eassert (EQ (buffer_local_symbols.name, make_number (0)));
reset_buffer (&buffer_local_symbols);
reset_buffer_local_variables (&buffer_local_symbols, 1);
/* Prevent GC from getting confused. */
......@@ -5421,33 +5392,41 @@ init_buffer ()
in the buffer that is current now. */
/* TYPE is nil for a general Lisp variable.
An integer specifies a type; then only LIsp values
An integer specifies a type; then only Lisp values
with that type code are allowed (except that nil is allowed too).
LNAME is the LIsp-level variable name.
LNAME is the Lisp-level variable name.
VNAME is the name of the buffer slot.
DOC is a dummy where you write the doc string as a comment. */
#define DEFVAR_PER_BUFFER(lname, vname, type, doc) \
defvar_per_buffer (lname, vname, type, 0)
#define DEFVAR_PER_BUFFER(lname, vname, type, doc) \
do { \
static struct Lisp_Buffer_Objfwd bo_fwd; \
defvar_per_buffer (&bo_fwd, lname, vname, type, 0); \
} while (0)
static void
defvar_per_buffer (namestring, address, type, doc)
defvar_per_buffer (bo_fwd, namestring, address, type, doc)
struct Lisp_Buffer_Objfwd *bo_fwd;
char *namestring;
Lisp_Object *address;
Lisp_Object type;
char *doc;
{
Lisp_Object sym, val;
struct Lisp_Symbol *sym;
int offset;
sym = intern (namestring);
val = allocate_misc ();
sym = XSYMBOL (intern (namestring));
offset = (char *)address - (char *)current_buffer;
XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
XBUFFER_OBJFWD (val)->offset = offset;
XBUFFER_OBJFWD (val)->slottype = type;
SET_SYMBOL_VALUE (sym, val);
PER_BUFFER_SYMBOL (offset) = sym;
bo_fwd->type = Lisp_Fwd_Buffer_Obj;
bo_fwd->offset = offset;
bo_fwd->slottype = type;
sym->redirect = SYMBOL_FORWARDED;
{
/* I tried to do the job without a cast, but it seems impossible.
union Lisp_Fwd *fwd; &(fwd->u_buffer_objfwd) = bo_fwd; */
SET_SYMBOL_FWD (sym, (union Lisp_Fwd *)bo_fwd);
}
XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
if (PER_BUFFER_IDX (offset) == 0)
/* Did a DEFVAR_PER_BUFFER without initializing the corresponding
......
......@@ -107,6 +107,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define BUF_BEG(buf) (BEG)
#define BUF_BEG_BYTE(buf) (BEG_BYTE)
/* !!!FIXME: all the BUF_BEGV/BUF_ZV/BUF_PT macros are flawed:
on indirect (or base) buffers, that value is only correct if that buffer
is the current_buffer, or if the buffer's text hasn't been modified (via
an indirect buffer) since it was last current. */
/* Position of beginning of accessible range of buffer. */
#define BUF_BEGV(buf) ((buf)->begv)
#define BUF_BEGV_BYTE(buf) ((buf)->begv_byte)
......@@ -313,7 +318,7 @@ while (0)
- (ptr - (current_buffer)->text->beg <= (unsigned) (GPT_BYTE - BEG_BYTE) ? 0 : GAP_SIZE) \
+ BEG_BYTE)
/* Return character at position POS. */
/* Return character at byte position POS. */
#define FETCH_CHAR(pos) \
(!NILP (current_buffer->enable_multibyte_characters) \
......@@ -327,7 +332,7 @@ while (0)
/* Variables used locally in FETCH_MULTIBYTE_CHAR. */
extern unsigned char *_fetch_multibyte_char_p;
/* Return character code of multi-byte form at position POS. If POS
/* Return character code of multi-byte form at byte position POS. If POS
doesn't point the head of valid multi-byte form, only the byte at
POS is returned. No range checking. */
......@@ -336,7 +341,7 @@ extern unsigned char *_fetch_multibyte_char_p;
+ (pos) + BEG_ADDR - BEG_BYTE), \
STRING_CHAR (_fetch_multibyte_char_p))
/* Return character at position POS. If the current buffer is unibyte
/* Return character at byte position POS. If the current buffer is unibyte
and the character is not ASCII, make the returning character
multibyte. */
......@@ -447,7 +452,10 @@ struct buffer_text
/* The markers that refer to this buffer.
This is actually a single marker ---
successive elements in its marker `chain'
are the other markers referring to this buffer. */
are the other markers referring to this buffer.
This is a singly linked unordered list, which means that it's
very cheap to add a marker to the list and it's also very cheap
to move a marker within a buffer. */
struct Lisp_Marker *markers;
/* Usually 0. Temporarily set to 1 in decode_coding_gap to
......@@ -843,6 +851,7 @@ extern struct buffer buffer_defaults;
be a Lisp-level local variable for the slot, it has no default value,
and the corresponding slot in buffer_defaults is not used. */
extern struct buffer buffer_local_flags;
/* For each buffer slot, this points to the Lisp symbol name
......@@ -948,7 +957,7 @@ extern int last_per_buffer_idx;
from the start of a buffer structure. */
#define PER_BUFFER_VAR_OFFSET(VAR) \
((char *) &buffer_local_flags.VAR - (char *) &buffer_local_flags)
((char *) &((struct buffer *)0)->VAR - (char *) ((struct buffer *)0))
/* Return the index of buffer-local variable VAR. Each per-buffer
variable has an index > 0 associated with it, except when it always
......@@ -1013,11 +1022,5 @@ extern int last_per_buffer_idx;
#define PER_BUFFER_VALUE(BUFFER, OFFSET) \
(*(Lisp_Object *)((OFFSET) + (char *) (BUFFER)))
/* Return the symbol of the per-buffer variable at offset OFFSET in
the buffer structure. */
#define PER_BUFFER_SYMBOL(OFFSET) \
(*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
/* arch-tag: 679305dd-d41c-4a50-b170-3caf5c97b2d1
(do not change this comment) */
......@@ -505,8 +505,9 @@ If the third argument is incorrect, Emacs may crash. */)
v1 = vectorp[op];
if (SYMBOLP (v1))
{
v2 = SYMBOL_VALUE (v1);
if (MISCP (v2) || EQ (v2, Qunbound))
if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
|| (v2 = SYMBOL_VAL (XSYMBOL (v1)),
EQ (v2, Qunbound)))
{
BEFORE_POTENTIAL_GC ();
v2 = Fsymbol_value (v1);
......@@ -597,10 +598,9 @@ If the third argument is incorrect, Emacs may crash. */)
/* Inline the most common case. */
if (SYMBOLP (sym)
&& !EQ (val, Qunbound)
&& !XSYMBOL (sym)->indirect_variable
&& !SYMBOL_CONSTANT_P (sym)
&& !MISCP (XSYMBOL (sym)->value))
XSYMBOL (sym)->value = val;
&& !XSYMBOL (sym)->redirect
&& !SYMBOL_CONSTANT_P (sym))
XSYMBOL (sym)->val.value = val;
else