aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog74
-rw-r--r--src/alloc.c70
-rw-r--r--src/bidi.c5
-rw-r--r--src/buffer.c205
-rw-r--r--src/buffer.h25
-rw-r--r--src/bytecode.c12
-rw-r--r--src/character.h2
-rw-r--r--src/coding.c2
-rw-r--r--src/data.c1225
-rw-r--r--src/eval.c214
-rw-r--r--src/frame.c23
-rw-r--r--src/insdel.c2
-rw-r--r--src/keyboard.c1
-rw-r--r--src/lisp.h297
-rw-r--r--src/lread.c94
-rw-r--r--src/print.c64
-rw-r--r--src/term.c9
-rw-r--r--src/xdisp.c28
18 files changed, 1301 insertions, 1051 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 27cc282145b..3c2a39cb7c9 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,9 +1,79 @@
12010-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 Make variable forwarding explicit rather the using special values.
4 Basically, this makes the structure of buffer-local values and object
5 forwarding explicit in the type of Lisp_Symbols rather than use
6 special Lisp_Objects for that. This tends to lead to slightly more
7 verbose code, but is more C-like, simpler, and makes it easier to make
8 sure we handled all cases, among other things by letting the compiler
9 help us check it.
10 * lisp.h (enum Lisp_Misc_Type, union Lisp_Misc):
11 Removing forwarding objects.
12 (enum Lisp_Fwd_Type, enum symbol_redirect, union Lisp_Fwd): New types.
13 (struct Lisp_Symbol): Make the various forms of variable-forwarding
14 explicit rather than hiding them inside Lisp_Object "values".
15 (XFWDTYPE): New macro.
16 (XINTFWD, XBOOLFWD, XOBJFWD, XKBOARD_OBJFWD): Redefine.
17 (XBUFFER_LOCAL_VALUE): Remove.
18 (SYMBOL_VAL, SYMBOL_ALIAS, SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL)
19 (SET_SYMBOL_ALIAS, SET_SYMBOL_BLV, SET_SYMBOL_FWD): New macros.
20 (SYMBOL_VALUE, SET_SYMBOL_VALUE): Remove.
21 (struct Lisp_Intfwd, struct Lisp_Boolfwd, struct Lisp_Objfwd)
22 (struct Lisp_Buffer_Objfwd, struct Lisp_Kboard_Objfwd):
23 Remove the Lisp_Misc_* header.
24 (struct Lisp_Buffer_Local_Value): Redefine.
25 (BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE): New macros.
26 (struct Lisp_Misc_Any): Add filler to get the right size.
27 (struct Lisp_Free): Use struct Lisp_Misc_Any rather than struct
28 Lisp_Intfwd.
29 (DEFVAR_LISP, DEFVAR_LISP_NOPRO, DEFVAR_BOOL, DEFVAR_INT)
30 (DEFVAR_KBOARD): Allocate a forwarding object.
31 * data.c (do_blv_forwarding, store_blv_forwarding): New macros.
32 (let_shadows_global_binding_p): New function.
33 (union Lisp_Val_Fwd): New type.
34 (make_blv): New function.
35 (swap_in_symval_forwarding, indirect_variable, do_symval_forwarding)
36 (store_symval_forwarding, swap_in_global_binding, Fboundp)
37 (swap_in_symval_forwarding, find_symbol_value, Fset)
38 (let_shadows_buffer_binding_p, set_internal, default_value)
39 (Fset_default, Fmake_variable_buffer_local, Fmake_local_variable)
40 (Fkill_local_variable, Fmake_variable_frame_local)
41 (Flocal_variable_p, Flocal_variable_if_set_p)
42 (Fvariable_binding_locus):
43 * xdisp.c (select_frame_for_redisplay):
44 * lread.c (Fintern, Funintern, init_obarray, defvar_int)
45 (defvar_bool, defvar_lisp_nopro, defvar_lisp, defvar_kboard):
46 * frame.c (store_frame_param):
47 * eval.c (Fdefvaralias, Fuser_variable_p, specbind, unbind_to):
48 * bytecode.c (Fbyte_code) <varref, varset>: Adapt to the new symbol
49 value structure.
50 * buffer.c (PER_BUFFER_SYMBOL): Move from buffer.h.
51 (clone_per_buffer_values): Only adjust markers into the current buffer.
52 (reset_buffer_local_variables): PER_BUFFER_IDX is never -2.
53 (Fbuffer_local_value, set_buffer_internal_1)
54 (swap_out_buffer_local_variables):
55 Adapt to the new symbol value structure.
56 (DEFVAR_PER_BUFFER): Allocate a Lisp_Buffer_Objfwd object.
57 (defvar_per_buffer): Take a new arg for the fwd object.
58 (buffer_lisp_local_variables): Return a proper alist (different fix
59 for bug#4138).
60 * alloc.c (Fmake_symbol): Use SET_SYMBOL_VAL.
61 (Fgarbage_collect): Don't handle buffer_defaults specially.
62 (mark_object): Handle new symbol value structure rather than the old
63 special Lisp_Misc_* objects.
64 (gc_sweep) <symbols>: Free also the buffer-local-value objects.
65 * term.c (set_tty_color_mode):
66 * bidi.c (bidi_initialize): Don't access the ->value field directly.
67 * buffer.h (PER_BUFFER_VAR_OFFSET): Don't bother with
68 a buffer_local_flags.
69 * print.c (print_object): Get rid of impossible forwarding objects.
70
12010-04-19 Eli Zaretskii <eliz@gnu.org> 712010-04-19 Eli Zaretskii <eliz@gnu.org>
2 72
3 * bidi.c (bidi_get_type, bidi_get_category) 73 * bidi.c (bidi_get_type, bidi_get_category)
4 (bidi_at_paragraph_end, bidi_resolve_weak, bidi_resolve_neutral) 74 (bidi_at_paragraph_end, bidi_resolve_weak, bidi_resolve_neutral)
5 (bidi_type_of_next_char, bidi_level_of_next_char): Declare 75 (bidi_type_of_next_char, bidi_level_of_next_char):
6 static. Use `INLINE' rather than `inline'. 76 Declare static. Use `INLINE' rather than `inline'.
7 77
82010-04-19 Juanma Barranquero <lekktu@gmail.com> 782010-04-19 Juanma Barranquero <lekktu@gmail.com>
9 79
diff --git a/src/alloc.c b/src/alloc.c
index 37ec06c7be1..c1f1094d15f 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1365,7 +1365,7 @@ uninterrupt_malloc ()
1365 pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE); 1365 pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE);
1366 pthread_mutex_init (&alloc_mutex, &attr); 1366 pthread_mutex_init (&alloc_mutex, &attr);
1367#else /* !DOUG_LEA_MALLOC */ 1367#else /* !DOUG_LEA_MALLOC */
1368 /* Some systems such as Solaris 2.6 doesn't have a recursive mutex, 1368 /* Some systems such as Solaris 2.6 don't have a recursive mutex,
1369 and the bundled gmalloc.c doesn't require it. */ 1369 and the bundled gmalloc.c doesn't require it. */
1370 pthread_mutex_init (&alloc_mutex, NULL); 1370 pthread_mutex_init (&alloc_mutex, NULL);
1371#endif /* !DOUG_LEA_MALLOC */ 1371#endif /* !DOUG_LEA_MALLOC */
@@ -3193,13 +3193,13 @@ Its value and function definition are void, and its property list is nil. */)
3193 p = XSYMBOL (val); 3193 p = XSYMBOL (val);
3194 p->xname = name; 3194 p->xname = name;
3195 p->plist = Qnil; 3195 p->plist = Qnil;
3196 p->value = Qunbound; 3196 p->redirect = SYMBOL_PLAINVAL;
3197 SET_SYMBOL_VAL (p, Qunbound);
3197 p->function = Qunbound; 3198 p->function = Qunbound;
3198 p->next = NULL; 3199 p->next = NULL;
3199 p->gcmarkbit = 0; 3200 p->gcmarkbit = 0;
3200 p->interned = SYMBOL_UNINTERNED; 3201 p->interned = SYMBOL_UNINTERNED;
3201 p->constant = 0; 3202 p->constant = 0;
3202 p->indirect_variable = 0;
3203 consing_since_gc += sizeof (struct Lisp_Symbol); 3203 consing_since_gc += sizeof (struct Lisp_Symbol);
3204 symbols_consed++; 3204 symbols_consed++;
3205 return val; 3205 return val;
@@ -5581,17 +5581,42 @@ mark_object (arg)
5581 break; 5581 break;
5582 CHECK_ALLOCATED_AND_LIVE (live_symbol_p); 5582 CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
5583 ptr->gcmarkbit = 1; 5583 ptr->gcmarkbit = 1;
5584 mark_object (ptr->value);
5585 mark_object (ptr->function); 5584 mark_object (ptr->function);
5586 mark_object (ptr->plist); 5585 mark_object (ptr->plist);
5587 5586 switch (ptr->redirect)
5587 {
5588 case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break;
5589 case SYMBOL_VARALIAS:
5590 {
5591 Lisp_Object tem;
5592 XSETSYMBOL (tem, SYMBOL_ALIAS (ptr));
5593 mark_object (tem);
5594 break;
5595 }
5596 case SYMBOL_LOCALIZED:
5597 {
5598 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr);
5599 /* If the value is forwarded to a buffer or keyboard field,
5600 these are marked when we see the corresponding object.
5601 And if it's forwarded to a C variable, either it's not
5602 a Lisp_Object var, or it's staticpro'd already. */
5603 mark_object (blv->where);
5604 mark_object (blv->valcell);
5605 mark_object (blv->defcell);
5606 break;
5607 }
5608 case SYMBOL_FORWARDED:
5609 /* If the value is forwarded to a buffer or keyboard field,
5610 these are marked when we see the corresponding object.
5611 And if it's forwarded to a C variable, either it's not
5612 a Lisp_Object var, or it's staticpro'd already. */
5613 break;
5614 default: abort ();
5615 }
5588 if (!PURE_POINTER_P (XSTRING (ptr->xname))) 5616 if (!PURE_POINTER_P (XSTRING (ptr->xname)))
5589 MARK_STRING (XSTRING (ptr->xname)); 5617 MARK_STRING (XSTRING (ptr->xname));
5590 MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname)); 5618 MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname));
5591 5619
5592 /* Note that we do not mark the obarray of the symbol.
5593 It is safe not to do so because nothing accesses that
5594 slot except to check whether it is nil. */
5595 ptr = ptr->next; 5620 ptr = ptr->next;
5596 if (ptr) 5621 if (ptr)
5597 { 5622 {
@@ -5610,22 +5635,6 @@ mark_object (arg)
5610 5635
5611 switch (XMISCTYPE (obj)) 5636 switch (XMISCTYPE (obj))
5612 { 5637 {
5613 case Lisp_Misc_Buffer_Local_Value:
5614 {
5615 register struct Lisp_Buffer_Local_Value *ptr
5616 = XBUFFER_LOCAL_VALUE (obj);
5617 /* If the cdr is nil, avoid recursion for the car. */
5618 if (EQ (ptr->cdr, Qnil))
5619 {
5620 obj = ptr->realvalue;
5621 goto loop;
5622 }
5623 mark_object (ptr->realvalue);
5624 mark_object (ptr->buffer);
5625 mark_object (ptr->frame);
5626 obj = ptr->cdr;
5627 goto loop;
5628 }
5629 5638
5630 case Lisp_Misc_Marker: 5639 case Lisp_Misc_Marker:
5631 /* DO NOT mark thru the marker's chain. 5640 /* DO NOT mark thru the marker's chain.
@@ -5633,17 +5642,6 @@ mark_object (arg)
5633 instead, markers are removed from the chain when freed by gc. */ 5642 instead, markers are removed from the chain when freed by gc. */
5634 break; 5643 break;
5635 5644
5636 case Lisp_Misc_Intfwd:
5637 case Lisp_Misc_Boolfwd:
5638 case Lisp_Misc_Objfwd:
5639 case Lisp_Misc_Buffer_Objfwd:
5640 case Lisp_Misc_Kboard_Objfwd:
5641 /* Don't bother with Lisp_Buffer_Objfwd,
5642 since all markable slots in current buffer marked anyway. */
5643 /* Don't need to do Lisp_Objfwd, since the places they point
5644 are protected with staticpro. */
5645 break;
5646
5647 case Lisp_Misc_Save_Value: 5645 case Lisp_Misc_Save_Value:
5648#if GC_MARK_STACK 5646#if GC_MARK_STACK
5649 { 5647 {
@@ -6048,6 +6046,8 @@ gc_sweep ()
6048 6046
6049 if (!sym->gcmarkbit && !pure_p) 6047 if (!sym->gcmarkbit && !pure_p)
6050 { 6048 {
6049 if (sym->redirect == SYMBOL_LOCALIZED)
6050 xfree (SYMBOL_BLV (sym));
6051 sym->next = symbol_free_list; 6051 sym->next = symbol_free_list;
6052 symbol_free_list = sym; 6052 symbol_free_list = sym;
6053#if GC_MARK_STACK 6053#if GC_MARK_STACK
diff --git a/src/bidi.c b/src/bidi.c
index 058daba3e5a..fee97ae0c8e 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -400,14 +400,14 @@ bidi_initialize ()
400 make_number (bidi_type[i].type)); 400 make_number (bidi_type[i].type));
401 401
402 fallback_paragraph_start_re = 402 fallback_paragraph_start_re =
403 XSYMBOL (Fintern_soft (build_string ("paragraph-start"), Qnil))->value; 403 Fsymbol_value (Fintern_soft (build_string ("paragraph-start"), Qnil));
404 if (!STRINGP (fallback_paragraph_start_re)) 404 if (!STRINGP (fallback_paragraph_start_re))
405 fallback_paragraph_start_re = build_string ("\f\\|[ \t]*$"); 405 fallback_paragraph_start_re = build_string ("\f\\|[ \t]*$");
406 staticpro (&fallback_paragraph_start_re); 406 staticpro (&fallback_paragraph_start_re);
407 Qparagraph_start = intern ("paragraph-start"); 407 Qparagraph_start = intern ("paragraph-start");
408 staticpro (&Qparagraph_start); 408 staticpro (&Qparagraph_start);
409 fallback_paragraph_separate_re = 409 fallback_paragraph_separate_re =
410 XSYMBOL (Fintern_soft (build_string ("paragraph-separate"), Qnil))->value; 410 Fsymbol_value (Fintern_soft (build_string ("paragraph-separate"), Qnil));
411 if (!STRINGP (fallback_paragraph_separate_re)) 411 if (!STRINGP (fallback_paragraph_separate_re))
412 fallback_paragraph_separate_re = build_string ("[ \t\f]*$"); 412 fallback_paragraph_separate_re = build_string ("[ \t\f]*$");
413 staticpro (&fallback_paragraph_separate_re); 413 staticpro (&fallback_paragraph_separate_re);
@@ -879,7 +879,6 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it)
879 int ch, ch_len; 879 int ch, ch_len;
880 EMACS_INT pos; 880 EMACS_INT pos;
881 bidi_type_t type; 881 bidi_type_t type;
882 EMACS_INT sep_len;
883 882
884 /* If we are inside a paragraph separator, we are just waiting 883 /* If we are inside a paragraph separator, we are just waiting
885 for the separator to be exhausted; use the previous paragraph 884 for the separator to be exhausted; use the previous paragraph
diff --git a/src/buffer.c b/src/buffer.c
index 0759ce1c43c..9932c649044 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -78,9 +78,6 @@ static Lisp_Object Vbuffer_defaults;
78 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it; 78 be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
79 and the corresponding slot in buffer_defaults is not used. 79 and the corresponding slot in buffer_defaults is not used.
80 80
81 If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
82 but there is a default value which is copied into each buffer.
83
84 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is 81 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
85 zero, that is a bug */ 82 zero, that is a bug */
86 83
@@ -94,6 +91,12 @@ DECL_ALIGN (struct buffer, buffer_local_symbols);
94/* A Lisp_Object pointer to the above, used for staticpro */ 91/* A Lisp_Object pointer to the above, used for staticpro */
95static Lisp_Object Vbuffer_local_symbols; 92static Lisp_Object Vbuffer_local_symbols;
96 93
94/* Return the symbol of the per-buffer variable at offset OFFSET in
95 the buffer structure. */
96
97#define PER_BUFFER_SYMBOL(OFFSET) \
98 (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
99
97/* Flags indicating which built-in buffer-local variables 100/* Flags indicating which built-in buffer-local variables
98 are permanent locals. */ 101 are permanent locals. */
99static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS]; 102static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
@@ -507,7 +510,7 @@ clone_per_buffer_values (from, to)
507 continue; 510 continue;
508 511
509 obj = PER_BUFFER_VALUE (from, offset); 512 obj = PER_BUFFER_VALUE (from, offset);
510 if (MARKERP (obj)) 513 if (MARKERP (obj) && XMARKER (obj)->buffer == from)
511 { 514 {
512 struct Lisp_Marker *m = XMARKER (obj); 515 struct Lisp_Marker *m = XMARKER (obj);
513 obj = Fmake_marker (); 516 obj = Fmake_marker ();
@@ -770,9 +773,7 @@ reset_buffer_local_variables (b, permanent_too)
770 { 773 {
771 Lisp_Object tmp, prop, last = Qnil; 774 Lisp_Object tmp, prop, last = Qnil;
772 for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp)) 775 for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp))
773 if (CONSP (XCAR (tmp)) 776 if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
774 && SYMBOLP (XCAR (XCAR (tmp)))
775 && !NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
776 { 777 {
777 /* If permanent-local, keep it. */ 778 /* If permanent-local, keep it. */
778 last = tmp; 779 last = tmp;
@@ -822,9 +823,7 @@ reset_buffer_local_variables (b, permanent_too)
822 int idx = PER_BUFFER_IDX (offset); 823 int idx = PER_BUFFER_IDX (offset);
823 if ((idx > 0 824 if ((idx > 0
824 && (permanent_too 825 && (permanent_too
825 || buffer_permanent_local_flags[idx] == 0)) 826 || buffer_permanent_local_flags[idx] == 0)))
826 /* Is -2 used anywhere? */
827 || idx == -2)
828 PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset); 827 PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
829 } 828 }
830} 829}
@@ -938,59 +937,49 @@ is the default binding of the variable. */)
938 CHECK_SYMBOL (variable); 937 CHECK_SYMBOL (variable);
939 CHECK_BUFFER (buffer); 938 CHECK_BUFFER (buffer);
940 buf = XBUFFER (buffer); 939 buf = XBUFFER (buffer);
940 sym = XSYMBOL (variable);
941 941
942 sym = indirect_variable (XSYMBOL (variable)); 942 start:
943 XSETSYMBOL (variable, sym); 943 switch (sym->redirect)
944
945 /* Look in local_var_list */
946 result = Fassoc (variable, buf->local_var_alist);
947 if (NILP (result))
948 {
949 int offset, idx;
950 int found = 0;
951
952 /* Look in special slots */
953 /* buffer-local Lisp variables start at `undo_list',
954 tho only the ones from `name' on are GC'd normally. */
955 for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
956 offset < sizeof (struct buffer);
957 /* sizeof EMACS_INT == sizeof Lisp_Object */
958 offset += (sizeof (EMACS_INT)))
959 {
960 idx = PER_BUFFER_IDX (offset);
961 if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
962 && SYMBOLP (PER_BUFFER_SYMBOL (offset))
963 && EQ (PER_BUFFER_SYMBOL (offset), variable))
964 {
965 result = PER_BUFFER_VALUE (buf, offset);
966 found = 1;
967 break;
968 }
969 }
970
971 if (!found)
972 result = Fdefault_value (variable);
973 }
974 else
975 { 944 {
976 Lisp_Object valcontents; 945 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
977 Lisp_Object current_alist_element; 946 case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
978 947 case SYMBOL_LOCALIZED:
979 /* What binding is loaded right now? */ 948 { /* Look in local_var_alist. */
980 valcontents = sym->value; 949 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
981 current_alist_element 950 XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
982 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); 951 result = Fassoc (variable, buf->local_var_alist);
983 952 if (!NILP (result))
984 /* The value of the currently loaded binding is not 953 {
985 stored in it, but rather in the realvalue slot. 954 if (blv->fwd)
986 Store that value into the binding it belongs to 955 { /* What binding is loaded right now? */
987 in case that is the one we are about to use. */ 956 Lisp_Object current_alist_element = blv->valcell;
988 957
989 Fsetcdr (current_alist_element, 958 /* The value of the currently loaded binding is not
990 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)); 959 stored in it, but rather in the realvalue slot.
960 Store that value into the binding it belongs to
961 in case that is the one we are about to use. */
991 962
992 /* Now get the (perhaps updated) value out of the binding. */ 963 XSETCDR (current_alist_element,
993 result = XCDR (result); 964 do_symval_forwarding (blv->fwd));
965 }
966 /* Now get the (perhaps updated) value out of the binding. */
967 result = XCDR (result);
968 }
969 else
970 result = Fdefault_value (variable);
971 break;
972 }
973 case SYMBOL_FORWARDED:
974 {
975 union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
976 if (BUFFER_OBJFWDP (fwd))
977 result = PER_BUFFER_VALUE (buf, XBUFFER_OBJFWD (fwd)->offset);
978 else
979 result = Fdefault_value (variable);
980 break;
981 }
982 default: abort ();
994 } 983 }
995 984
996 if (!EQ (result, Qunbound)) 985 if (!EQ (result, Qunbound))
@@ -1025,12 +1014,7 @@ buffer_lisp_local_variables (buf)
1025 if (buf != current_buffer) 1014 if (buf != current_buffer)
1026 val = XCDR (elt); 1015 val = XCDR (elt);
1027 1016
1028 /* If symbol is unbound, put just the symbol in the list. */ 1017 result = Fcons (Fcons (XCAR (elt), val), result);
1029 if (EQ (val, Qunbound))
1030 result = Fcons (XCAR (elt), result);
1031 /* Otherwise, put (symbol . value) in the list. */
1032 else
1033 result = Fcons (Fcons (XCAR (elt), val), result);
1034 } 1018 }
1035 1019
1036 return result; 1020 return result;
@@ -1862,8 +1846,7 @@ set_buffer_internal_1 (b)
1862 register struct buffer *b; 1846 register struct buffer *b;
1863{ 1847{
1864 register struct buffer *old_buf; 1848 register struct buffer *old_buf;
1865 register Lisp_Object tail, valcontents; 1849 register Lisp_Object tail;
1866 Lisp_Object tem;
1867 1850
1868#ifdef USE_MMAP_FOR_BUFFERS 1851#ifdef USE_MMAP_FOR_BUFFERS
1869 if (b->text->beg == NULL) 1852 if (b->text->beg == NULL)
@@ -1935,34 +1918,21 @@ set_buffer_internal_1 (b)
1935 /* Look down buffer's list of local Lisp variables 1918 /* Look down buffer's list of local Lisp variables
1936 to find and update any that forward into C variables. */ 1919 to find and update any that forward into C variables. */
1937 1920
1938 for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail)) 1921 do
1939 { 1922 {
1940 if (CONSP (XCAR (tail)) 1923 for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail))
1941 && SYMBOLP (XCAR (XCAR (tail))) 1924 {
1942 && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))), 1925 Lisp_Object var = XCAR (XCAR (tail));
1943 (BUFFER_LOCAL_VALUEP (valcontents))) 1926 struct Lisp_Symbol *sym = XSYMBOL (var);
1944 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue, 1927 if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */
1945 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem)))) 1928 && SYMBOL_BLV (sym)->fwd)
1946 /* Just reference the variable to cause it to become set for 1929 /* Just reference the variable
1947 this buffer. */ 1930 to cause it to become set for this buffer. */
1948 Fsymbol_value (XCAR (XCAR (tail))); 1931 Fsymbol_value (var);
1932 }
1949 } 1933 }
1950
1951 /* Do the same with any others that were local to the previous buffer */ 1934 /* Do the same with any others that were local to the previous buffer */
1952 1935 while (b != old_buf && (b = old_buf, b));
1953 if (old_buf)
1954 for (tail = old_buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
1955 {
1956 if (CONSP (tail)
1957 && SYMBOLP (XCAR (XCAR (tail)))
1958 && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
1959 (BUFFER_LOCAL_VALUEP (valcontents)))
1960 && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1961 (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
1962 /* Just reference the variable to cause it to become set for
1963 this buffer. */
1964 Fsymbol_value (XCAR (XCAR (tail)));
1965 }
1966} 1936}
1967 1937
1968/* Switch to buffer B temporarily for redisplay purposes. 1938/* Switch to buffer B temporarily for redisplay purposes.
@@ -2677,23 +2647,22 @@ static void
2677swap_out_buffer_local_variables (b) 2647swap_out_buffer_local_variables (b)
2678 struct buffer *b; 2648 struct buffer *b;
2679{ 2649{
2680 Lisp_Object oalist, alist, sym, buffer; 2650 Lisp_Object oalist, alist, buffer;
2681 2651
2682 XSETBUFFER (buffer, b); 2652 XSETBUFFER (buffer, b);
2683 oalist = b->local_var_alist; 2653 oalist = b->local_var_alist;
2684 2654
2685 for (alist = oalist; CONSP (alist); alist = XCDR (alist)) 2655 for (alist = oalist; CONSP (alist); alist = XCDR (alist))
2686 { 2656 {
2687 if (CONSP (XCAR (alist)) 2657 Lisp_Object sym = XCAR (XCAR (alist));
2688 && (sym = XCAR (XCAR (alist)), SYMBOLP (sym)) 2658 eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED);
2689 /* Need not do anything if some other buffer's binding is 2659 /* Need not do anything if some other buffer's binding is
2690 now encached. */ 2660 now encached. */
2691 && EQ (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->buffer, 2661 if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
2692 buffer))
2693 { 2662 {
2694 /* Symbol is set up for this buffer's old local value: 2663 /* Symbol is set up for this buffer's old local value:
2695 swap it out! */ 2664 swap it out! */
2696 swap_in_global_binding (sym); 2665 swap_in_global_binding (XSYMBOL (sym));
2697 } 2666 }
2698 } 2667 }
2699} 2668}
@@ -5162,7 +5131,9 @@ init_buffer_once ()
5162 /* Make sure all markable slots in buffer_defaults 5131 /* Make sure all markable slots in buffer_defaults
5163 are initialized reasonably, so mark_buffer won't choke. */ 5132 are initialized reasonably, so mark_buffer won't choke. */
5164 reset_buffer (&buffer_defaults); 5133 reset_buffer (&buffer_defaults);
5134 eassert (EQ (buffer_defaults.name, make_number (0)));
5165 reset_buffer_local_variables (&buffer_defaults, 1); 5135 reset_buffer_local_variables (&buffer_defaults, 1);
5136 eassert (EQ (buffer_local_symbols.name, make_number (0)));
5166 reset_buffer (&buffer_local_symbols); 5137 reset_buffer (&buffer_local_symbols);
5167 reset_buffer_local_variables (&buffer_local_symbols, 1); 5138 reset_buffer_local_variables (&buffer_local_symbols, 1);
5168 /* Prevent GC from getting confused. */ 5139 /* Prevent GC from getting confused. */
@@ -5421,33 +5392,41 @@ init_buffer ()
5421 in the buffer that is current now. */ 5392 in the buffer that is current now. */
5422 5393
5423/* TYPE is nil for a general Lisp variable. 5394/* TYPE is nil for a general Lisp variable.
5424 An integer specifies a type; then only LIsp values 5395 An integer specifies a type; then only Lisp values
5425 with that type code are allowed (except that nil is allowed too). 5396 with that type code are allowed (except that nil is allowed too).
5426 LNAME is the LIsp-level variable name. 5397 LNAME is the Lisp-level variable name.
5427 VNAME is the name of the buffer slot. 5398 VNAME is the name of the buffer slot.
5428 DOC is a dummy where you write the doc string as a comment. */ 5399 DOC is a dummy where you write the doc string as a comment. */
5429#define DEFVAR_PER_BUFFER(lname, vname, type, doc) \ 5400#define DEFVAR_PER_BUFFER(lname, vname, type, doc) \
5430 defvar_per_buffer (lname, vname, type, 0) 5401 do { \
5402 static struct Lisp_Buffer_Objfwd bo_fwd; \
5403 defvar_per_buffer (&bo_fwd, lname, vname, type, 0); \
5404 } while (0)
5431 5405
5432static void 5406static void
5433defvar_per_buffer (namestring, address, type, doc) 5407defvar_per_buffer (bo_fwd, namestring, address, type, doc)
5408 struct Lisp_Buffer_Objfwd *bo_fwd;
5434 char *namestring; 5409 char *namestring;
5435 Lisp_Object *address; 5410 Lisp_Object *address;
5436 Lisp_Object type; 5411 Lisp_Object type;
5437 char *doc; 5412 char *doc;
5438{ 5413{
5439 Lisp_Object sym, val; 5414 struct Lisp_Symbol *sym;
5440 int offset; 5415 int offset;
5441 5416
5442 sym = intern (namestring); 5417 sym = XSYMBOL (intern (namestring));
5443 val = allocate_misc ();
5444 offset = (char *)address - (char *)current_buffer; 5418 offset = (char *)address - (char *)current_buffer;
5445 5419
5446 XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd; 5420 bo_fwd->type = Lisp_Fwd_Buffer_Obj;
5447 XBUFFER_OBJFWD (val)->offset = offset; 5421 bo_fwd->offset = offset;
5448 XBUFFER_OBJFWD (val)->slottype = type; 5422 bo_fwd->slottype = type;
5449 SET_SYMBOL_VALUE (sym, val); 5423 sym->redirect = SYMBOL_FORWARDED;
5450 PER_BUFFER_SYMBOL (offset) = sym; 5424 {
5425 /* I tried to do the job without a cast, but it seems impossible.
5426 union Lisp_Fwd *fwd; &(fwd->u_buffer_objfwd) = bo_fwd; */
5427 SET_SYMBOL_FWD (sym, (union Lisp_Fwd *)bo_fwd);
5428 }
5429 XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
5451 5430
5452 if (PER_BUFFER_IDX (offset) == 0) 5431 if (PER_BUFFER_IDX (offset) == 0)
5453 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding 5432 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
diff --git a/src/buffer.h b/src/buffer.h
index fa3fc6dafb8..b750e490078 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -107,6 +107,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
107#define BUF_BEG(buf) (BEG) 107#define BUF_BEG(buf) (BEG)
108#define BUF_BEG_BYTE(buf) (BEG_BYTE) 108#define BUF_BEG_BYTE(buf) (BEG_BYTE)
109 109
110/* !!!FIXME: all the BUF_BEGV/BUF_ZV/BUF_PT macros are flawed:
111 on indirect (or base) buffers, that value is only correct if that buffer
112 is the current_buffer, or if the buffer's text hasn't been modified (via
113 an indirect buffer) since it was last current. */
114
110/* Position of beginning of accessible range of buffer. */ 115/* Position of beginning of accessible range of buffer. */
111#define BUF_BEGV(buf) ((buf)->begv) 116#define BUF_BEGV(buf) ((buf)->begv)
112#define BUF_BEGV_BYTE(buf) ((buf)->begv_byte) 117#define BUF_BEGV_BYTE(buf) ((buf)->begv_byte)
@@ -313,7 +318,7 @@ while (0)
313 - (ptr - (current_buffer)->text->beg <= (unsigned) (GPT_BYTE - BEG_BYTE) ? 0 : GAP_SIZE) \ 318 - (ptr - (current_buffer)->text->beg <= (unsigned) (GPT_BYTE - BEG_BYTE) ? 0 : GAP_SIZE) \
314 + BEG_BYTE) 319 + BEG_BYTE)
315 320
316/* Return character at position POS. */ 321/* Return character at byte position POS. */
317 322
318#define FETCH_CHAR(pos) \ 323#define FETCH_CHAR(pos) \
319 (!NILP (current_buffer->enable_multibyte_characters) \ 324 (!NILP (current_buffer->enable_multibyte_characters) \
@@ -327,7 +332,7 @@ while (0)
327/* Variables used locally in FETCH_MULTIBYTE_CHAR. */ 332/* Variables used locally in FETCH_MULTIBYTE_CHAR. */
328extern unsigned char *_fetch_multibyte_char_p; 333extern unsigned char *_fetch_multibyte_char_p;
329 334
330/* Return character code of multi-byte form at position POS. If POS 335/* Return character code of multi-byte form at byte position POS. If POS
331 doesn't point the head of valid multi-byte form, only the byte at 336 doesn't point the head of valid multi-byte form, only the byte at
332 POS is returned. No range checking. */ 337 POS is returned. No range checking. */
333 338
@@ -336,7 +341,7 @@ extern unsigned char *_fetch_multibyte_char_p;
336 + (pos) + BEG_ADDR - BEG_BYTE), \ 341 + (pos) + BEG_ADDR - BEG_BYTE), \
337 STRING_CHAR (_fetch_multibyte_char_p)) 342 STRING_CHAR (_fetch_multibyte_char_p))
338 343
339/* Return character at position POS. If the current buffer is unibyte 344/* Return character at byte position POS. If the current buffer is unibyte
340 and the character is not ASCII, make the returning character 345 and the character is not ASCII, make the returning character
341 multibyte. */ 346 multibyte. */
342 347
@@ -447,7 +452,10 @@ struct buffer_text
447 /* The markers that refer to this buffer. 452 /* The markers that refer to this buffer.
448 This is actually a single marker --- 453 This is actually a single marker ---
449 successive elements in its marker `chain' 454 successive elements in its marker `chain'
450 are the other markers referring to this buffer. */ 455 are the other markers referring to this buffer.
456 This is a singly linked unordered list, which means that it's
457 very cheap to add a marker to the list and it's also very cheap
458 to move a marker within a buffer. */
451 struct Lisp_Marker *markers; 459 struct Lisp_Marker *markers;
452 460
453 /* Usually 0. Temporarily set to 1 in decode_coding_gap to 461 /* Usually 0. Temporarily set to 1 in decode_coding_gap to
@@ -843,6 +851,7 @@ extern struct buffer buffer_defaults;
843 be a Lisp-level local variable for the slot, it has no default value, 851 be a Lisp-level local variable for the slot, it has no default value,
844 and the corresponding slot in buffer_defaults is not used. */ 852 and the corresponding slot in buffer_defaults is not used. */
845 853
854
846extern struct buffer buffer_local_flags; 855extern struct buffer buffer_local_flags;
847 856
848/* For each buffer slot, this points to the Lisp symbol name 857/* For each buffer slot, this points to the Lisp symbol name
@@ -948,7 +957,7 @@ extern int last_per_buffer_idx;
948 from the start of a buffer structure. */ 957 from the start of a buffer structure. */
949 958
950#define PER_BUFFER_VAR_OFFSET(VAR) \ 959#define PER_BUFFER_VAR_OFFSET(VAR) \
951 ((char *) &buffer_local_flags.VAR - (char *) &buffer_local_flags) 960 ((char *) &((struct buffer *)0)->VAR - (char *) ((struct buffer *)0))
952 961
953/* Return the index of buffer-local variable VAR. Each per-buffer 962/* Return the index of buffer-local variable VAR. Each per-buffer
954 variable has an index > 0 associated with it, except when it always 963 variable has an index > 0 associated with it, except when it always
@@ -1013,11 +1022,5 @@ extern int last_per_buffer_idx;
1013#define PER_BUFFER_VALUE(BUFFER, OFFSET) \ 1022#define PER_BUFFER_VALUE(BUFFER, OFFSET) \
1014 (*(Lisp_Object *)((OFFSET) + (char *) (BUFFER))) 1023 (*(Lisp_Object *)((OFFSET) + (char *) (BUFFER)))
1015 1024
1016/* Return the symbol of the per-buffer variable at offset OFFSET in
1017 the buffer structure. */
1018
1019#define PER_BUFFER_SYMBOL(OFFSET) \
1020 (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))
1021
1022/* arch-tag: 679305dd-d41c-4a50-b170-3caf5c97b2d1 1025/* arch-tag: 679305dd-d41c-4a50-b170-3caf5c97b2d1
1023 (do not change this comment) */ 1026 (do not change this comment) */
diff --git a/src/bytecode.c b/src/bytecode.c
index e95614c72a9..c59f75dc78e 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -505,8 +505,9 @@ If the third argument is incorrect, Emacs may crash. */)
505 v1 = vectorp[op]; 505 v1 = vectorp[op];
506 if (SYMBOLP (v1)) 506 if (SYMBOLP (v1))
507 { 507 {
508 v2 = SYMBOL_VALUE (v1); 508 if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
509 if (MISCP (v2) || EQ (v2, Qunbound)) 509 || (v2 = SYMBOL_VAL (XSYMBOL (v1)),
510 EQ (v2, Qunbound)))
510 { 511 {
511 BEFORE_POTENTIAL_GC (); 512 BEFORE_POTENTIAL_GC ();
512 v2 = Fsymbol_value (v1); 513 v2 = Fsymbol_value (v1);
@@ -597,10 +598,9 @@ If the third argument is incorrect, Emacs may crash. */)
597 /* Inline the most common case. */ 598 /* Inline the most common case. */
598 if (SYMBOLP (sym) 599 if (SYMBOLP (sym)
599 && !EQ (val, Qunbound) 600 && !EQ (val, Qunbound)
600 && !XSYMBOL (sym)->indirect_variable 601 && !XSYMBOL (sym)->redirect
601 && !SYMBOL_CONSTANT_P (sym) 602 && !SYMBOL_CONSTANT_P (sym))
602 && !MISCP (XSYMBOL (sym)->value)) 603 XSYMBOL (sym)->val.value = val;
603 XSYMBOL (sym)->value = val;
604 else 604 else
605 { 605 {
606 BEFORE_POTENTIAL_GC (); 606 BEFORE_POTENTIAL_GC ();
diff --git a/src/character.h b/src/character.h
index 1f1f6eade84..41f47e4b179 100644
--- a/src/character.h
+++ b/src/character.h
@@ -296,7 +296,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
296 296
297/* If P is after LIMIT, advance P to the previous character boundary. 297/* If P is after LIMIT, advance P to the previous character boundary.
298 Assumes that P is already at a character boundary of the same 298 Assumes that P is already at a character boundary of the same
299 mulitbyte form whose beginning address is LIMIT. */ 299 multibyte form whose beginning address is LIMIT. */
300 300
301#define PREV_CHAR_BOUNDARY(p, limit) \ 301#define PREV_CHAR_BOUNDARY(p, limit) \
302 do { \ 302 do { \
diff --git a/src/coding.c b/src/coding.c
index bdc37cb7c53..6435fa1ddb1 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -6408,7 +6408,7 @@ detect_coding (coding)
6408 { 6408 {
6409 /* We didn't find an 8-bit code. We may 6409 /* We didn't find an 8-bit code. We may
6410 have found a null-byte, but it's very 6410 have found a null-byte, but it's very
6411 rare that a binary file confirm to 6411 rare that a binary file conforms to
6412 ISO-2022. */ 6412 ISO-2022. */
6413 src = src_end; 6413 src = src_end;
6414 coding->head_ascii = src - coding->source; 6414 coding->head_ascii = src - coding->source;
diff --git a/src/data.c b/src/data.c
index bdba3a9bb36..a56b112196d 100644
--- a/src/data.c
+++ b/src/data.c
@@ -91,7 +91,7 @@ Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
91 91
92Lisp_Object Qinteractive_form; 92Lisp_Object Qinteractive_form;
93 93
94static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object)); 94static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
95 95
96Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum; 96Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum;
97 97
@@ -582,12 +582,35 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
582 register Lisp_Object symbol; 582 register Lisp_Object symbol;
583{ 583{
584 Lisp_Object valcontents; 584 Lisp_Object valcontents;
585 struct Lisp_Symbol *sym;
585 CHECK_SYMBOL (symbol); 586 CHECK_SYMBOL (symbol);
587 sym = XSYMBOL (symbol);
586 588
587 valcontents = SYMBOL_VALUE (symbol); 589 start:
588 590 switch (sym->redirect)
589 if (BUFFER_LOCAL_VALUEP (valcontents)) 591 {
590 valcontents = swap_in_symval_forwarding (symbol, valcontents); 592 case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break;
593 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
594 case SYMBOL_LOCALIZED:
595 {
596 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
597 if (blv->fwd)
598 /* In set_internal, we un-forward vars when their value is
599 set to Qunbound. */
600 return Qt;
601 else
602 {
603 swap_in_symval_forwarding (sym, blv);
604 valcontents = BLV_VALUE (blv);
605 }
606 break;
607 }
608 case SYMBOL_FORWARDED:
609 /* In set_internal, we un-forward vars when their value is
610 set to Qunbound. */
611 return Qt;
612 default: abort ();
613 }
591 614
592 return (EQ (valcontents, Qunbound) ? Qnil : Qt); 615 return (EQ (valcontents, Qunbound) ? Qnil : Qt);
593} 616}
@@ -824,14 +847,14 @@ indirect_variable (symbol)
824 847
825 hare = tortoise = symbol; 848 hare = tortoise = symbol;
826 849
827 while (hare->indirect_variable) 850 while (hare->redirect == SYMBOL_VARALIAS)
828 { 851 {
829 hare = XSYMBOL (hare->value); 852 hare = SYMBOL_ALIAS (hare);
830 if (!hare->indirect_variable) 853 if (hare->redirect != SYMBOL_VARALIAS)
831 break; 854 break;
832 855
833 hare = XSYMBOL (hare->value); 856 hare = SYMBOL_ALIAS (hare);
834 tortoise = XSYMBOL (tortoise->value); 857 tortoise = SYMBOL_ALIAS (tortoise);
835 858
836 if (hare == tortoise) 859 if (hare == tortoise)
837 { 860 {
@@ -865,44 +888,46 @@ variable chain of symbols. */)
865 This does not handle buffer-local variables; use 888 This does not handle buffer-local variables; use
866 swap_in_symval_forwarding for that. */ 889 swap_in_symval_forwarding for that. */
867 890
891#define do_blv_forwarding(blv) \
892 ((blv)->forwarded ? do_symval_forwarding (BLV_FWD (blv)) : BLV_VALUE (blv))
893
868Lisp_Object 894Lisp_Object
869do_symval_forwarding (valcontents) 895do_symval_forwarding (valcontents)
870 register Lisp_Object valcontents; 896 register union Lisp_Fwd *valcontents;
871{ 897{
872 register Lisp_Object val; 898 register Lisp_Object val;
873 if (MISCP (valcontents)) 899 switch (XFWDTYPE (valcontents))
874 switch (XMISCTYPE (valcontents)) 900 {
875 { 901 case Lisp_Fwd_Int:
876 case Lisp_Misc_Intfwd: 902 XSETINT (val, *XINTFWD (valcontents)->intvar);
877 XSETINT (val, *XINTFWD (valcontents)->intvar); 903 return val;
878 return val; 904
879 905 case Lisp_Fwd_Bool:
880 case Lisp_Misc_Boolfwd: 906 return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
881 return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil); 907
882 908 case Lisp_Fwd_Obj:
883 case Lisp_Misc_Objfwd: 909 return *XOBJFWD (valcontents)->objvar;
884 return *XOBJFWD (valcontents)->objvar; 910
885 911 case Lisp_Fwd_Buffer_Obj:
886 case Lisp_Misc_Buffer_Objfwd: 912 return PER_BUFFER_VALUE (current_buffer,
887 return PER_BUFFER_VALUE (current_buffer, 913 XBUFFER_OBJFWD (valcontents)->offset);
888 XBUFFER_OBJFWD (valcontents)->offset); 914
889 915 case Lisp_Fwd_Kboard_Obj:
890 case Lisp_Misc_Kboard_Objfwd: 916 /* We used to simply use current_kboard here, but from Lisp
891 /* We used to simply use current_kboard here, but from Lisp 917 code, it's value is often unexpected. It seems nicer to
892 code, it's value is often unexpected. It seems nicer to 918 allow constructions like this to work as intuitively expected:
893 allow constructions like this to work as intuitively expected: 919
894 920 (with-selected-frame frame
895 (with-selected-frame frame 921 (define-key local-function-map "\eOP" [f1]))
896 (define-key local-function-map "\eOP" [f1])) 922
897 923 On the other hand, this affects the semantics of
898 On the other hand, this affects the semantics of 924 last-command and real-last-command, and people may rely on
899 last-command and real-last-command, and people may rely on 925 that. I took a quick look at the Lisp codebase, and I
900 that. I took a quick look at the Lisp codebase, and I 926 don't think anything will break. --lorentey */
901 don't think anything will break. --lorentey */ 927 return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
902 return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset 928 + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
903 + (char *)FRAME_KBOARD (SELECTED_FRAME ())); 929 default: abort ();
904 } 930 }
905 return valcontents;
906} 931}
907 932
908/* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell 933/* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
@@ -913,102 +938,93 @@ do_symval_forwarding (valcontents)
913 BUF non-zero means set the value in buffer BUF instead of the 938 BUF non-zero means set the value in buffer BUF instead of the
914 current buffer. This only plays a role for per-buffer variables. */ 939 current buffer. This only plays a role for per-buffer variables. */
915 940
916void 941#define store_blv_forwarding(blv, newval, buf) \
917store_symval_forwarding (symbol, valcontents, newval, buf) 942 do { \
918 Lisp_Object symbol; 943 if ((blv)->forwarded) \
919 register Lisp_Object valcontents, newval; 944 store_symval_forwarding (BLV_FWD (blv), (newval), (buf)); \
945 else \
946 SET_BLV_VALUE (blv, newval); \
947 } while (0)
948
949static void
950store_symval_forwarding (/* symbol, */ valcontents, newval, buf)
951 /* struct Lisp_Symbol *symbol; */
952 union Lisp_Fwd *valcontents;
953 register Lisp_Object newval;
920 struct buffer *buf; 954 struct buffer *buf;
921{ 955{
922 switch (SWITCH_ENUM_CAST (XTYPE (valcontents))) 956 switch (XFWDTYPE (valcontents))
923 { 957 {
924 case Lisp_Misc: 958 case Lisp_Fwd_Int:
925 switch (XMISCTYPE (valcontents)) 959 CHECK_NUMBER (newval);
960 *XINTFWD (valcontents)->intvar = XINT (newval);
961 break;
962
963 case Lisp_Fwd_Bool:
964 *XBOOLFWD (valcontents)->boolvar = !NILP (newval);
965 break;
966
967 case Lisp_Fwd_Obj:
968 *XOBJFWD (valcontents)->objvar = newval;
969
970 /* If this variable is a default for something stored
971 in the buffer itself, such as default-fill-column,
972 find the buffers that don't have local values for it
973 and update them. */
974 if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
975 && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1))
926 { 976 {
927 case Lisp_Misc_Intfwd: 977 int offset = ((char *) XOBJFWD (valcontents)->objvar
928 CHECK_NUMBER (newval); 978 - (char *) &buffer_defaults);
929 *XINTFWD (valcontents)->intvar = XINT (newval); 979 int idx = PER_BUFFER_IDX (offset);
930 /* This can never happen since intvar points to an EMACS_INT 980
931 which is at least large enough to hold a Lisp_Object. 981 Lisp_Object tail;
932 if (*XINTFWD (valcontents)->intvar != XINT (newval)) 982
933 error ("Value out of range for variable `%s'", 983 if (idx <= 0)
934 SDATA (SYMBOL_NAME (symbol))); */ 984 break;
935 break; 985
936 986 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
937 case Lisp_Misc_Boolfwd:
938 *XBOOLFWD (valcontents)->boolvar = !NILP (newval);
939 break;
940
941 case Lisp_Misc_Objfwd:
942 *XOBJFWD (valcontents)->objvar = newval;
943
944 /* If this variable is a default for something stored
945 in the buffer itself, such as default-fill-column,
946 find the buffers that don't have local values for it
947 and update them. */
948 if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
949 && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1))
950 { 987 {
951 int offset = ((char *) XOBJFWD (valcontents)->objvar 988 Lisp_Object buf;
952 - (char *) &buffer_defaults); 989 struct buffer *b;
953 int idx = PER_BUFFER_IDX (offset);
954 990
955 Lisp_Object tail; 991 buf = Fcdr (XCAR (tail));
992 if (!BUFFERP (buf)) continue;
993 b = XBUFFER (buf);
956 994
957 if (idx <= 0) 995 if (! PER_BUFFER_VALUE_P (b, idx))
958 break; 996 PER_BUFFER_VALUE (b, offset) = newval;
959
960 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
961 {
962 Lisp_Object buf;
963 struct buffer *b;
964
965 buf = Fcdr (XCAR (tail));
966 if (!BUFFERP (buf)) continue;
967 b = XBUFFER (buf);
968
969 if (! PER_BUFFER_VALUE_P (b, idx))
970 PER_BUFFER_VALUE (b, offset) = newval;
971 }
972 } 997 }
973 break; 998 }
974 999 break;
975 case Lisp_Misc_Buffer_Objfwd:
976 {
977 int offset = XBUFFER_OBJFWD (valcontents)->offset;
978 Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
979
980 if (!(NILP (type) || NILP (newval)
981 || (XINT (type) == LISP_INT_TAG
982 ? INTEGERP (newval)
983 : XTYPE (newval) == XINT (type))))
984 buffer_slot_type_mismatch (newval, XINT (type));
985
986 if (buf == NULL)
987 buf = current_buffer;
988 PER_BUFFER_VALUE (buf, offset) = newval;
989 }
990 break;
991 1000
992 case Lisp_Misc_Kboard_Objfwd: 1001 case Lisp_Fwd_Buffer_Obj:
993 { 1002 {
994 char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ()); 1003 int offset = XBUFFER_OBJFWD (valcontents)->offset;
995 char *p = base + XKBOARD_OBJFWD (valcontents)->offset; 1004 Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
996 *(Lisp_Object *) p = newval; 1005
997 } 1006 if (!(NILP (type) || NILP (newval)
998 break; 1007 || (XINT (type) == LISP_INT_TAG
1008 ? INTEGERP (newval)
1009 : XTYPE (newval) == XINT (type))))
1010 buffer_slot_type_mismatch (newval, XINT (type));
1011
1012 if (buf == NULL)
1013 buf = current_buffer;
1014 PER_BUFFER_VALUE (buf, offset) = newval;
1015 }
1016 break;
999 1017
1000 default: 1018 case Lisp_Fwd_Kboard_Obj:
1001 goto def; 1019 {
1002 } 1020 char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ());
1021 char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
1022 *(Lisp_Object *) p = newval;
1023 }
1003 break; 1024 break;
1004 1025
1005 default: 1026 default:
1006 def: 1027 abort (); /* goto def; */
1007 valcontents = SYMBOL_VALUE (symbol);
1008 if (BUFFER_LOCAL_VALUEP (valcontents))
1009 XBUFFER_LOCAL_VALUE (valcontents)->realvalue = newval;
1010 else
1011 SET_SYMBOL_VALUE (symbol, newval);
1012 } 1028 }
1013} 1029}
1014 1030
@@ -1017,25 +1033,22 @@ store_symval_forwarding (symbol, valcontents, newval, buf)
1017 1033
1018void 1034void
1019swap_in_global_binding (symbol) 1035swap_in_global_binding (symbol)
1020 Lisp_Object symbol; 1036 struct Lisp_Symbol *symbol;
1021{ 1037{
1022 Lisp_Object valcontents = SYMBOL_VALUE (symbol); 1038 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (symbol);
1023 struct Lisp_Buffer_Local_Value *blv = XBUFFER_LOCAL_VALUE (valcontents);
1024 Lisp_Object cdr = blv->cdr;
1025 1039
1026 /* Unload the previously loaded binding. */ 1040 /* Unload the previously loaded binding. */
1027 Fsetcdr (XCAR (cdr), 1041 if (blv->fwd)
1028 do_symval_forwarding (blv->realvalue)); 1042 SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
1029 1043
1030 /* Select the global binding in the symbol. */ 1044 /* Select the global binding in the symbol. */
1031 XSETCAR (cdr, cdr); 1045 blv->valcell = blv->defcell;
1032 store_symval_forwarding (symbol, blv->realvalue, XCDR (cdr), NULL); 1046 if (blv->fwd)
1047 store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL);
1033 1048
1034 /* Indicate that the global binding is set up now. */ 1049 /* Indicate that the global binding is set up now. */
1035 blv->frame = Qnil; 1050 blv->where = Qnil;
1036 blv->buffer = Qnil; 1051 SET_BLV_FOUND (blv, 0);
1037 blv->found_for_frame = 0;
1038 blv->found_for_buffer = 0;
1039} 1052}
1040 1053
1041/* Set up the buffer-local symbol SYMBOL for validity in the current buffer. 1054/* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
@@ -1045,55 +1058,50 @@ swap_in_global_binding (symbol)
1045 Return the value forwarded one step past the buffer-local stage. 1058 Return the value forwarded one step past the buffer-local stage.
1046 This could be another forwarding pointer. */ 1059 This could be another forwarding pointer. */
1047 1060
1048static Lisp_Object 1061static void
1049swap_in_symval_forwarding (symbol, valcontents) 1062swap_in_symval_forwarding (symbol, blv)
1050 Lisp_Object symbol, valcontents; 1063 struct Lisp_Symbol *symbol;
1064 struct Lisp_Buffer_Local_Value *blv;
1051{ 1065{
1052 register Lisp_Object tem1; 1066 register Lisp_Object tem1;
1053 1067
1054 tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer; 1068 eassert (blv == SYMBOL_BLV (symbol));
1069
1070 tem1 = blv->where;
1055 1071
1056 if (NILP (tem1) 1072 if (NILP (tem1)
1057 || current_buffer != XBUFFER (tem1) 1073 || (blv->frame_local
1058 || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame 1074 ? !EQ (selected_frame, tem1)
1059 && ! EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame))) 1075 : current_buffer != XBUFFER (tem1)))
1060 { 1076 {
1061 struct Lisp_Symbol *sym = XSYMBOL (symbol);
1062 if (sym->indirect_variable)
1063 {
1064 sym = indirect_variable (sym);
1065 XSETSYMBOL (symbol, sym);
1066 }
1067 1077
1068 /* Unload the previously loaded binding. */ 1078 /* Unload the previously loaded binding. */
1069 tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); 1079 tem1 = blv->valcell;
1070 Fsetcdr (tem1, 1080 if (blv->fwd)
1071 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue)); 1081 SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
1072 /* Choose the new binding. */ 1082 /* Choose the new binding. */
1073 tem1 = assq_no_quit (symbol, current_buffer->local_var_alist); 1083 {
1074 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0; 1084 Lisp_Object var;
1075 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; 1085 XSETSYMBOL (var, symbol);
1076 if (NILP (tem1)) 1086 if (blv->frame_local)
1077 { 1087 {
1078 if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame) 1088 tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist);
1079 tem1 = assq_no_quit (symbol, XFRAME (selected_frame)->param_alist); 1089 blv->where = selected_frame;
1080 if (! NILP (tem1)) 1090 }
1081 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1; 1091 else
1082 else 1092 {
1083 tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr; 1093 tem1 = assq_no_quit (var, current_buffer->local_var_alist);
1084 } 1094 XSETBUFFER (blv->where, current_buffer);
1085 else 1095 }
1086 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1; 1096 }
1097 if (!(blv->found = !NILP (tem1)))
1098 tem1 = blv->defcell;
1087 1099
1088 /* Load the new binding. */ 1100 /* Load the new binding. */
1089 XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1); 1101 blv->valcell = tem1;
1090 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, current_buffer); 1102 if (blv->fwd)
1091 XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame; 1103 store_symval_forwarding (blv->fwd, BLV_VALUE (blv), NULL);
1092 store_symval_forwarding (symbol,
1093 XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1094 Fcdr (tem1), NULL);
1095 } 1104 }
1096 return XBUFFER_LOCAL_VALUE (valcontents)->realvalue;
1097} 1105}
1098 1106
1099/* Find the value of a symbol, returning Qunbound if it's not bound. 1107/* Find the value of a symbol, returning Qunbound if it's not bound.
@@ -1106,16 +1114,27 @@ Lisp_Object
1106find_symbol_value (symbol) 1114find_symbol_value (symbol)
1107 Lisp_Object symbol; 1115 Lisp_Object symbol;
1108{ 1116{
1109 register Lisp_Object valcontents; 1117 struct Lisp_Symbol *sym;
1110 register Lisp_Object val;
1111 1118
1112 CHECK_SYMBOL (symbol); 1119 CHECK_SYMBOL (symbol);
1113 valcontents = SYMBOL_VALUE (symbol); 1120 sym = XSYMBOL (symbol);
1114
1115 if (BUFFER_LOCAL_VALUEP (valcontents))
1116 valcontents = swap_in_symval_forwarding (symbol, valcontents);
1117 1121
1118 return do_symval_forwarding (valcontents); 1122 start:
1123 switch (sym->redirect)
1124 {
1125 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1126 case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
1127 case SYMBOL_LOCALIZED:
1128 {
1129 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1130 swap_in_symval_forwarding (sym, blv);
1131 return blv->fwd ? do_symval_forwarding (blv->fwd) : BLV_VALUE (blv);
1132 }
1133 /* FALLTHROUGH */
1134 case SYMBOL_FORWARDED:
1135 return do_symval_forwarding (SYMBOL_FWD (sym));
1136 default: abort ();
1137 }
1119} 1138}
1120 1139
1121DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0, 1140DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
@@ -1137,26 +1156,25 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
1137 (symbol, newval) 1156 (symbol, newval)
1138 register Lisp_Object symbol, newval; 1157 register Lisp_Object symbol, newval;
1139{ 1158{
1140 return set_internal (symbol, newval, current_buffer, 0); 1159 set_internal (symbol, newval, current_buffer, 0);
1160 return newval;
1141} 1161}
1142 1162
1143/* Return 1 if SYMBOL currently has a let-binding 1163/* Return 1 if SYMBOL currently has a let-binding
1144 which was made in the buffer that is now current. */ 1164 which was made in the buffer that is now current. */
1145 1165
1146static int 1166static int
1147let_shadows_buffer_binding_p (symbol) 1167let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
1148 struct Lisp_Symbol *symbol;
1149{ 1168{
1150 volatile struct specbinding *p; 1169 struct specbinding *p;
1151 1170
1152 for (p = specpdl_ptr - 1; p >= specpdl; p--) 1171 for (p = specpdl_ptr - 1; p >= specpdl; p--)
1153 if (p->func == NULL 1172 if (p->func == NULL
1154 && CONSP (p->symbol)) 1173 && CONSP (p->symbol))
1155 { 1174 {
1156 struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol)); 1175 struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
1157 if ((symbol == let_bound_symbol 1176 eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
1158 || (let_bound_symbol->indirect_variable 1177 if (symbol == let_bound_symbol
1159 && symbol == indirect_variable (let_bound_symbol)))
1160 && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer) 1178 && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
1161 break; 1179 break;
1162 } 1180 }
@@ -1164,6 +1182,19 @@ let_shadows_buffer_binding_p (symbol)
1164 return p >= specpdl; 1182 return p >= specpdl;
1165} 1183}
1166 1184
1185static int
1186let_shadows_global_binding_p (symbol)
1187 Lisp_Object symbol;
1188{
1189 struct specbinding *p;
1190
1191 for (p = specpdl_ptr - 1; p >= specpdl; p--)
1192 if (p->func == NULL && EQ (p->symbol, symbol))
1193 break;
1194
1195 return p >= specpdl;
1196}
1197
1167/* Store the value NEWVAL into SYMBOL. 1198/* Store the value NEWVAL into SYMBOL.
1168 If buffer-locality is an issue, BUF specifies which buffer to use. 1199 If buffer-locality is an issue, BUF specifies which buffer to use.
1169 (0 stands for the current buffer.) 1200 (0 stands for the current buffer.)
@@ -1172,133 +1203,155 @@ let_shadows_buffer_binding_p (symbol)
1172 local in every buffer where it is set, then we make it local. 1203 local in every buffer where it is set, then we make it local.
1173 If BINDFLAG is nonzero, we don't do that. */ 1204 If BINDFLAG is nonzero, we don't do that. */
1174 1205
1175Lisp_Object 1206void
1176set_internal (symbol, newval, buf, bindflag) 1207set_internal (symbol, newval, buf, bindflag)
1177 register Lisp_Object symbol, newval; 1208 register Lisp_Object symbol, newval;
1178 struct buffer *buf; 1209 struct buffer *buf;
1179 int bindflag; 1210 int bindflag;
1180{ 1211{
1181 int voide = EQ (newval, Qunbound); 1212 int voide = EQ (newval, Qunbound);
1182 1213 struct Lisp_Symbol *sym;
1183 register Lisp_Object valcontents, innercontents, tem1, current_alist_element; 1214 Lisp_Object tem1;
1184 1215
1185 if (buf == 0) 1216 if (buf == 0)
1186 buf = current_buffer; 1217 buf = current_buffer;
1187 1218
1188 /* If restoring in a dead buffer, do nothing. */ 1219 /* If restoring in a dead buffer, do nothing. */
1189 if (NILP (buf->name)) 1220 if (NILP (buf->name))
1190 return newval; 1221 return;
1191 1222
1192 CHECK_SYMBOL (symbol); 1223 CHECK_SYMBOL (symbol);
1193 if (SYMBOL_CONSTANT_P (symbol) 1224 if (SYMBOL_CONSTANT_P (symbol))
1194 && (NILP (Fkeywordp (symbol))
1195 || !EQ (newval, SYMBOL_VALUE (symbol))))
1196 xsignal1 (Qsetting_constant, symbol);
1197
1198 innercontents = valcontents = SYMBOL_VALUE (symbol);
1199
1200 if (BUFFER_OBJFWDP (valcontents))
1201 { 1225 {
1202 int offset = XBUFFER_OBJFWD (valcontents)->offset; 1226 if (NILP (Fkeywordp (symbol))
1203 int idx = PER_BUFFER_IDX (offset); 1227 || !EQ (newval, Fsymbol_value (symbol)))
1204 if (idx > 0 1228 xsignal1 (Qsetting_constant, symbol);
1205 && !bindflag 1229 else
1206 && !let_shadows_buffer_binding_p (XSYMBOL (symbol))) 1230 /* Allow setting keywords to their own value. */
1207 SET_PER_BUFFER_VALUE_P (buf, idx, 1); 1231 return;
1208 } 1232 }
1209 else if (BUFFER_LOCAL_VALUEP (valcontents))
1210 {
1211 /* valcontents is a struct Lisp_Buffer_Local_Value. */
1212 if (XSYMBOL (symbol)->indirect_variable)
1213 XSETSYMBOL (symbol, indirect_variable (XSYMBOL (symbol)));
1214
1215 /* What binding is loaded right now? */
1216 current_alist_element
1217 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
1218
1219 /* If the current buffer is not the buffer whose binding is
1220 loaded, or if there may be frame-local bindings and the frame
1221 isn't the right one, or if it's a Lisp_Buffer_Local_Value and
1222 the default binding is loaded, the loaded binding may be the
1223 wrong one. */
1224 if (!BUFFERP (XBUFFER_LOCAL_VALUE (valcontents)->buffer)
1225 || buf != XBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer)
1226 || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame
1227 && !EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame))
1228 /* Also unload a global binding (if the var is local_if_set). */
1229 || (EQ (XCAR (current_alist_element),
1230 current_alist_element)))
1231 {
1232 /* The currently loaded binding is not necessarily valid.
1233 We need to unload it, and choose a new binding. */
1234 1233
1235 /* Write out `realvalue' to the old loaded binding. */ 1234 sym = XSYMBOL (symbol);
1236 Fsetcdr (current_alist_element,
1237 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
1238 1235
1239 /* Find the new binding. */ 1236 start:
1240 tem1 = Fassq (symbol, buf->local_var_alist); 1237 switch (sym->redirect)
1241 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1; 1238 {
1242 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0; 1239 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1240 case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
1241 case SYMBOL_LOCALIZED:
1242 {
1243 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1244 Lisp_Object tmp; XSETBUFFER (tmp, buf);
1245
1246 /* If the current buffer is not the buffer whose binding is
1247 loaded, or if there may be frame-local bindings and the frame
1248 isn't the right one, or if it's a Lisp_Buffer_Local_Value and
1249 the default binding is loaded, the loaded binding may be the
1250 wrong one. */
1251 if (!EQ (blv->where,
1252 blv->frame_local ? selected_frame : tmp)
1253 /* Also unload a global binding (if the var is local_if_set). */
1254 || (EQ (blv->valcell, blv->defcell)))
1255 {
1256 /* The currently loaded binding is not necessarily valid.
1257 We need to unload it, and choose a new binding. */
1258
1259 /* Write out `realvalue' to the old loaded binding. */
1260 if (blv->fwd)
1261 SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
1243 1262
1244 if (NILP (tem1)) 1263 /* Find the new binding. */
1245 { 1264 {
1246 /* This buffer still sees the default value. */ 1265 XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */
1247 1266 if (blv->frame_local)
1248 /* If the variable is not local_if_set,
1249 or if this is `let' rather than `set',
1250 make CURRENT-ALIST-ELEMENT point to itself,
1251 indicating that we're seeing the default value.
1252 Likewise if the variable has been let-bound
1253 in the current buffer. */
1254 if (bindflag || !XBUFFER_LOCAL_VALUE (valcontents)->local_if_set
1255 || let_shadows_buffer_binding_p (XSYMBOL (symbol)))
1256 { 1267 {
1257 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; 1268 tem1 = Fassq (symbol, XFRAME (selected_frame)->param_alist);
1258 1269 blv->where = selected_frame;
1259 if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
1260 tem1 = Fassq (symbol,
1261 XFRAME (selected_frame)->param_alist);
1262
1263 if (! NILP (tem1))
1264 XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1;
1265 else
1266 tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
1267 } 1270 }
1268 /* If it's a Lisp_Buffer_Local_Value, being set not bound,
1269 and we're not within a let that was made for this buffer,
1270 create a new buffer-local binding for the variable.
1271 That means, give this buffer a new assoc for a local value
1272 and load that binding. */
1273 else 1271 else
1274 { 1272 {
1275 tem1 = Fcons (symbol, XCDR (current_alist_element)); 1273 tem1 = Fassq (symbol, buf->local_var_alist);
1276 buf->local_var_alist 1274 blv->where = tmp;
1277 = Fcons (tem1, buf->local_var_alist);
1278 } 1275 }
1279 } 1276 }
1277 blv->found = 1;
1278
1279 if (NILP (tem1))
1280 {
1281 /* This buffer still sees the default value. */
1282
1283 /* If the variable is a Lisp_Some_Buffer_Local_Value,
1284 or if this is `let' rather than `set',
1285 make CURRENT-ALIST-ELEMENT point to itself,
1286 indicating that we're seeing the default value.
1287 Likewise if the variable has been let-bound
1288 in the current buffer. */
1289 if (bindflag || !blv->local_if_set
1290 || let_shadows_buffer_binding_p (sym))
1291 {
1292 blv->found = 0;
1293 tem1 = blv->defcell;
1294 }
1295 /* If it's a local_if_set, being set not bound,
1296 and we're not within a let that was made for this buffer,
1297 create a new buffer-local binding for the variable.
1298 That means, give this buffer a new assoc for a local value
1299 and load that binding. */
1300 else
1301 {
1302 /* local_if_set is only supported for buffer-local
1303 bindings, not for frame-local bindings. */
1304 eassert (!blv->frame_local);
1305 tem1 = Fcons (symbol, XCDR (blv->defcell));
1306 buf->local_var_alist
1307 = Fcons (tem1, buf->local_var_alist);
1308 }
1309 }
1310
1311 /* Record which binding is now loaded. */
1312 blv->valcell = tem1;
1313 }
1280 1314
1281 /* Record which binding is now loaded. */ 1315 /* Store the new value in the cons cell. */
1282 XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1); 1316 SET_BLV_VALUE (blv, newval);
1283 1317
1284 /* Set `buffer' and `frame' slots for the binding now loaded. */ 1318 if (blv->fwd)
1285 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, buf); 1319 {
1286 XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame; 1320 if (voide)
1287 } 1321 /* If storing void (making the symbol void), forward only through
1288 innercontents = XBUFFER_LOCAL_VALUE (valcontents)->realvalue; 1322 buffer-local indicator, not through Lisp_Objfwd, etc. */
1323 blv->fwd = NULL;
1324 else
1325 store_symval_forwarding (blv->fwd, newval, buf);
1326 }
1327 break;
1328 }
1329 case SYMBOL_FORWARDED:
1330 {
1331 union Lisp_Fwd *innercontents = SYMBOL_FWD (sym);
1332 if (BUFFER_OBJFWDP (innercontents))
1333 {
1334 int offset = XBUFFER_OBJFWD (innercontents)->offset;
1335 int idx = PER_BUFFER_IDX (offset);
1336 if (idx > 0
1337 && !bindflag
1338 && !let_shadows_buffer_binding_p (sym))
1339 SET_PER_BUFFER_VALUE_P (buf, idx, 1);
1340 }
1289 1341
1290 /* Store the new value in the cons-cell. */ 1342 if (voide)
1291 XSETCDR (XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr), newval); 1343 { /* If storing void (making the symbol void), forward only through
1344 buffer-local indicator, not through Lisp_Objfwd, etc. */
1345 sym->redirect = SYMBOL_PLAINVAL;
1346 SET_SYMBOL_VAL (sym, newval);
1347 }
1348 else
1349 store_symval_forwarding (/* sym, */ innercontents, newval, buf);
1350 break;
1351 }
1352 default: abort ();
1292 } 1353 }
1293 1354 return;
1294 /* If storing void (making the symbol void), forward only through
1295 buffer-local indicator, not through Lisp_Objfwd, etc. */
1296 if (voide)
1297 store_symval_forwarding (symbol, Qnil, newval, buf);
1298 else
1299 store_symval_forwarding (symbol, innercontents, newval, buf);
1300
1301 return newval;
1302} 1355}
1303 1356
1304/* Access or set a buffer-local symbol's default value. */ 1357/* Access or set a buffer-local symbol's default value. */
@@ -1310,38 +1363,46 @@ Lisp_Object
1310default_value (symbol) 1363default_value (symbol)
1311 Lisp_Object symbol; 1364 Lisp_Object symbol;
1312{ 1365{
1313 register Lisp_Object valcontents; 1366 struct Lisp_Symbol *sym;
1314 1367
1315 CHECK_SYMBOL (symbol); 1368 CHECK_SYMBOL (symbol);
1316 valcontents = SYMBOL_VALUE (symbol); 1369 sym = XSYMBOL (symbol);
1317 1370
1318 /* For a built-in buffer-local variable, get the default value 1371 start:
1319 rather than letting do_symval_forwarding get the current value. */ 1372 switch (sym->redirect)
1320 if (BUFFER_OBJFWDP (valcontents))
1321 { 1373 {
1322 int offset = XBUFFER_OBJFWD (valcontents)->offset; 1374 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1323 if (PER_BUFFER_IDX (offset) != 0) 1375 case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
1324 return PER_BUFFER_DEFAULT (offset); 1376 case SYMBOL_LOCALIZED:
1325 } 1377 {
1378 /* If var is set up for a buffer that lacks a local value for it,
1379 the current value is nominally the default value.
1380 But the `realvalue' slot may be more up to date, since
1381 ordinary setq stores just that slot. So use that. */
1382 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1383 if (blv->fwd && EQ (blv->valcell, blv->defcell))
1384 return do_symval_forwarding (blv->fwd);
1385 else
1386 return XCDR (blv->defcell);
1387 }
1388 case SYMBOL_FORWARDED:
1389 {
1390 union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
1326 1391
1327 /* Handle user-created local variables. */ 1392 /* For a built-in buffer-local variable, get the default value
1328 if (BUFFER_LOCAL_VALUEP (valcontents)) 1393 rather than letting do_symval_forwarding get the current value. */
1329 { 1394 if (BUFFER_OBJFWDP (valcontents))
1330 /* If var is set up for a buffer that lacks a local value for it, 1395 {
1331 the current value is nominally the default value. 1396 int offset = XBUFFER_OBJFWD (valcontents)->offset;
1332 But the `realvalue' slot may be more up to date, since 1397 if (PER_BUFFER_IDX (offset) != 0)
1333 ordinary setq stores just that slot. So use that. */ 1398 return PER_BUFFER_DEFAULT (offset);
1334 Lisp_Object current_alist_element, alist_element_car; 1399 }
1335 current_alist_element 1400
1336 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); 1401 /* For other variables, get the current value. */
1337 alist_element_car = XCAR (current_alist_element); 1402 return do_symval_forwarding (valcontents);
1338 if (EQ (alist_element_car, current_alist_element)) 1403 }
1339 return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue); 1404 default: abort ();
1340 else
1341 return XCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
1342 } 1405 }
1343 /* For other variables, get the current value. */
1344 return do_symval_forwarding (valcontents);
1345} 1406}
1346 1407
1347DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0, 1408DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0,
@@ -1381,50 +1442,68 @@ for this variable. */)
1381 (symbol, value) 1442 (symbol, value)
1382 Lisp_Object symbol, value; 1443 Lisp_Object symbol, value;
1383{ 1444{
1384 register Lisp_Object valcontents, current_alist_element, alist_element_buffer; 1445 struct Lisp_Symbol *sym;
1385 1446
1386 CHECK_SYMBOL (symbol); 1447 CHECK_SYMBOL (symbol);
1387 valcontents = SYMBOL_VALUE (symbol); 1448 if (SYMBOL_CONSTANT_P (symbol))
1388
1389 /* Handle variables like case-fold-search that have special slots
1390 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
1391 variables. */
1392 if (BUFFER_OBJFWDP (valcontents))
1393 { 1449 {
1394 int offset = XBUFFER_OBJFWD (valcontents)->offset; 1450 if (NILP (Fkeywordp (symbol))
1395 int idx = PER_BUFFER_IDX (offset); 1451 || !EQ (value, Fdefault_value (symbol)))
1452 xsignal1 (Qsetting_constant, symbol);
1453 else
1454 /* Allow setting keywords to their own value. */
1455 return value;
1456 }
1457 sym = XSYMBOL (symbol);
1396 1458
1397 PER_BUFFER_DEFAULT (offset) = value; 1459 start:
1460 switch (sym->redirect)
1461 {
1462 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1463 case SYMBOL_PLAINVAL: return Fset (symbol, value);
1464 case SYMBOL_LOCALIZED:
1465 {
1466 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1398 1467
1399 /* If this variable is not always local in all buffers, 1468 /* Store new value into the DEFAULT-VALUE slot. */
1400 set it in the buffers that don't nominally have a local value. */ 1469 XSETCDR (blv->defcell, value);
1401 if (idx > 0)
1402 {
1403 struct buffer *b;
1404 1470
1405 for (b = all_buffers; b; b = b->next) 1471 /* If the default binding is now loaded, set the REALVALUE slot too. */
1406 if (!PER_BUFFER_VALUE_P (b, idx)) 1472 if (blv->fwd && EQ (blv->defcell, blv->valcell))
1407 PER_BUFFER_VALUE (b, offset) = value; 1473 store_symval_forwarding (blv->fwd, value, NULL);
1408 } 1474 return value;
1409 return value; 1475 }
1410 } 1476 case SYMBOL_FORWARDED:
1477 {
1478 union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
1411 1479
1412 if (!BUFFER_LOCAL_VALUEP (valcontents)) 1480 /* Handle variables like case-fold-search that have special slots
1413 return Fset (symbol, value); 1481 in the buffer.
1482 Make them work apparently like Lisp_Buffer_Local_Value variables. */
1483 if (BUFFER_OBJFWDP (valcontents))
1484 {
1485 int offset = XBUFFER_OBJFWD (valcontents)->offset;
1486 int idx = PER_BUFFER_IDX (offset);
1414 1487
1415 /* Store new value into the DEFAULT-VALUE slot. */ 1488 PER_BUFFER_DEFAULT (offset) = value;
1416 XSETCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, value);
1417 1489
1418 /* If the default binding is now loaded, set the REALVALUE slot too. */ 1490 /* If this variable is not always local in all buffers,
1419 current_alist_element 1491 set it in the buffers that don't nominally have a local value. */
1420 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); 1492 if (idx > 0)
1421 alist_element_buffer = Fcar (current_alist_element); 1493 {
1422 if (EQ (alist_element_buffer, current_alist_element)) 1494 struct buffer *b;
1423 store_symval_forwarding (symbol,
1424 XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
1425 value, NULL);
1426 1495
1427 return value; 1496 for (b = all_buffers; b; b = b->next)
1497 if (!PER_BUFFER_VALUE_P (b, idx))
1498 PER_BUFFER_VALUE (b, offset) = value;
1499 }
1500 return value;
1501 }
1502 else
1503 return Fset (symbol, value);
1504 }
1505 default: abort ();
1506 }
1428} 1507}
1429 1508
1430DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0, 1509DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0,
@@ -1468,6 +1547,35 @@ usage: (setq-default [VAR VALUE]...) */)
1468 1547
1469/* Lisp functions for creating and removing buffer-local variables. */ 1548/* Lisp functions for creating and removing buffer-local variables. */
1470 1549
1550union Lisp_Val_Fwd
1551 {
1552 Lisp_Object value;
1553 union Lisp_Fwd *fwd;
1554 };
1555
1556static struct Lisp_Buffer_Local_Value *
1557make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents)
1558{
1559 struct Lisp_Buffer_Local_Value *blv
1560 = xmalloc (sizeof (struct Lisp_Buffer_Local_Value));
1561 Lisp_Object symbol; XSETSYMBOL (symbol, sym);
1562 Lisp_Object tem = Fcons (symbol, (forwarded
1563 ? do_symval_forwarding (valcontents.fwd)
1564 : valcontents.value));
1565 /* Buffer_Local_Values cannot have as realval a buffer-local
1566 or keyboard-local forwarding. */
1567 eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd)));
1568 eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd)));
1569 blv->fwd = forwarded ? valcontents.fwd : NULL;
1570 blv->where = Qnil;
1571 blv->frame_local = 0;
1572 blv->local_if_set = 0;
1573 blv->defcell = tem;
1574 blv->valcell = tem;
1575 SET_BLV_FOUND (blv, 0);
1576 return blv;
1577}
1578
1471DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local, 1579DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local,
1472 1, 1, "vMake Variable Buffer Local: ", 1580 1, 1, "vMake Variable Buffer Local: ",
1473 doc: /* Make VARIABLE become buffer-local whenever it is set. 1581 doc: /* Make VARIABLE become buffer-local whenever it is set.
@@ -1485,42 +1593,58 @@ The function `default-value' gets the default value and `set-default' sets it.
1485 (variable) 1593 (variable)
1486 register Lisp_Object variable; 1594 register Lisp_Object variable;
1487{ 1595{
1488 register Lisp_Object tem, valcontents, newval;
1489 struct Lisp_Symbol *sym; 1596 struct Lisp_Symbol *sym;
1597 struct Lisp_Buffer_Local_Value *blv = NULL;
1598 union Lisp_Val_Fwd valcontents;
1599 int forwarded;
1490 1600
1491 CHECK_SYMBOL (variable); 1601 CHECK_SYMBOL (variable);
1492 sym = indirect_variable (XSYMBOL (variable)); 1602 sym = XSYMBOL (variable);
1493
1494 valcontents = sym->value;
1495 if (sym->constant || KBOARD_OBJFWDP (valcontents))
1496 error ("Symbol %s may not be buffer-local", SDATA (sym->xname));
1497 1603
1498 if (BUFFER_OBJFWDP (valcontents)) 1604 start:
1499 return variable; 1605 switch (sym->redirect)
1500 else if (BUFFER_LOCAL_VALUEP (valcontents))
1501 { 1606 {
1502 if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame) 1607 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1503 error ("Symbol %s may not be buffer-local", SDATA (sym->xname)); 1608 case SYMBOL_PLAINVAL:
1504 newval = valcontents; 1609 forwarded = 0; valcontents.value = SYMBOL_VAL (sym);
1610 if (EQ (valcontents.value, Qunbound))
1611 valcontents.value = Qnil;
1612 break;
1613 case SYMBOL_LOCALIZED:
1614 blv = SYMBOL_BLV (sym);
1615 if (blv->frame_local)
1616 error ("Symbol %s may not be buffer-local",
1617 SDATA (SYMBOL_NAME (variable)));
1618 break;
1619 case SYMBOL_FORWARDED:
1620 forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym);
1621 if (KBOARD_OBJFWDP (valcontents.fwd))
1622 error ("Symbol %s may not be buffer-local",
1623 SDATA (SYMBOL_NAME (variable)));
1624 else if (BUFFER_OBJFWDP (valcontents.fwd))
1625 return variable;
1626 break;
1627 default: abort ();
1505 } 1628 }
1506 else 1629
1630 if (sym->constant)
1631 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
1632
1633 if (!blv)
1507 { 1634 {
1508 if (EQ (valcontents, Qunbound)) 1635 blv = make_blv (sym, forwarded, valcontents);
1509 sym->value = Qnil; 1636 sym->redirect = SYMBOL_LOCALIZED;
1510 tem = Fcons (Qnil, Fsymbol_value (variable)); 1637 SET_SYMBOL_BLV (sym, blv);
1511 XSETCAR (tem, tem); 1638 {
1512 newval = allocate_misc (); 1639 Lisp_Object symbol;
1513 XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; 1640 XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */
1514 XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value; 1641 if (let_shadows_global_binding_p (symbol))
1515 XBUFFER_LOCAL_VALUE (newval)->buffer = Fcurrent_buffer (); 1642 error ("Making %s buffer-local while let-bound!",
1516 XBUFFER_LOCAL_VALUE (newval)->frame = Qnil; 1643 SDATA (SYMBOL_NAME (variable)));
1517 XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0; 1644 }
1518 XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
1519 XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
1520 XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
1521 sym->value = newval;
1522 } 1645 }
1523 XBUFFER_LOCAL_VALUE (newval)->local_if_set = 1; 1646
1647 blv->local_if_set = 1;
1524 return variable; 1648 return variable;
1525} 1649}
1526 1650
@@ -1547,82 +1671,95 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
1547 (variable) 1671 (variable)
1548 register Lisp_Object variable; 1672 register Lisp_Object variable;
1549{ 1673{
1550 register Lisp_Object tem, valcontents; 1674 register Lisp_Object tem;
1675 int forwarded;
1676 union Lisp_Val_Fwd valcontents;
1551 struct Lisp_Symbol *sym; 1677 struct Lisp_Symbol *sym;
1678 struct Lisp_Buffer_Local_Value *blv = NULL;
1552 1679
1553 CHECK_SYMBOL (variable); 1680 CHECK_SYMBOL (variable);
1554 sym = indirect_variable (XSYMBOL (variable)); 1681 sym = XSYMBOL (variable);
1555 1682
1556 valcontents = sym->value; 1683 start:
1557 if (sym->constant || KBOARD_OBJFWDP (valcontents) 1684 switch (sym->redirect)
1558 || (BUFFER_LOCAL_VALUEP (valcontents) 1685 {
1559 && (XBUFFER_LOCAL_VALUE (valcontents)->check_frame))) 1686 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1560 error ("Symbol %s may not be buffer-local", SDATA (sym->xname)); 1687 case SYMBOL_PLAINVAL:
1688 forwarded = 0; valcontents.value = SYMBOL_VAL (sym); break;
1689 case SYMBOL_LOCALIZED:
1690 blv = SYMBOL_BLV (sym);
1691 if (blv->frame_local)
1692 error ("Symbol %s may not be buffer-local",
1693 SDATA (SYMBOL_NAME (variable)));
1694 break;
1695 case SYMBOL_FORWARDED:
1696 forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym);
1697 if (KBOARD_OBJFWDP (valcontents.fwd))
1698 error ("Symbol %s may not be buffer-local",
1699 SDATA (SYMBOL_NAME (variable)));
1700 break;
1701 default: abort ();
1702 }
1561 1703
1562 if ((BUFFER_LOCAL_VALUEP (valcontents) 1704 if (sym->constant)
1563 && XBUFFER_LOCAL_VALUE (valcontents)->local_if_set) 1705 error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
1564 || BUFFER_OBJFWDP (valcontents)) 1706
1707 if (blv ? blv->local_if_set
1708 : (forwarded && BUFFER_OBJFWDP (valcontents.fwd)))
1565 { 1709 {
1566 tem = Fboundp (variable); 1710 tem = Fboundp (variable);
1567
1568 /* Make sure the symbol has a local value in this particular buffer, 1711 /* Make sure the symbol has a local value in this particular buffer,
1569 by setting it to the same value it already has. */ 1712 by setting it to the same value it already has. */
1570 Fset (variable, (EQ (tem, Qt) ? Fsymbol_value (variable) : Qunbound)); 1713 Fset (variable, (EQ (tem, Qt) ? Fsymbol_value (variable) : Qunbound));
1571 return variable; 1714 return variable;
1572 } 1715 }
1573 /* Make sure symbol is set up to hold per-buffer values. */ 1716 if (!blv)
1574 if (!BUFFER_LOCAL_VALUEP (valcontents))
1575 { 1717 {
1576 Lisp_Object newval; 1718 blv = make_blv (sym, forwarded, valcontents);
1577 tem = Fcons (Qnil, do_symval_forwarding (valcontents)); 1719 sym->redirect = SYMBOL_LOCALIZED;
1578 XSETCAR (tem, tem); 1720 SET_SYMBOL_BLV (sym, blv);
1579 newval = allocate_misc (); 1721 {
1580 XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; 1722 Lisp_Object symbol;
1581 XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value; 1723 XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */
1582 XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil; 1724 if (let_shadows_global_binding_p (symbol))
1583 XBUFFER_LOCAL_VALUE (newval)->frame = Qnil; 1725 error ("Making %s local to %s while let-bound!",
1584 XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0; 1726 SDATA (SYMBOL_NAME (variable)), SDATA (current_buffer->name));
1585 XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0; 1727 }
1586 XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
1587 XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
1588 XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
1589 sym->value = newval;
1590 } 1728 }
1729
1591 /* Make sure this buffer has its own value of symbol. */ 1730 /* Make sure this buffer has its own value of symbol. */
1592 XSETSYMBOL (variable, sym); /* Propagate variable indirections. */ 1731 XSETSYMBOL (variable, sym); /* Update in case of aliasing. */
1593 tem = Fassq (variable, current_buffer->local_var_alist); 1732 tem = Fassq (variable, current_buffer->local_var_alist);
1594 if (NILP (tem)) 1733 if (NILP (tem))
1595 { 1734 {
1735 if (let_shadows_buffer_binding_p (sym))
1736 message ("Making %s buffer-local while locally let-bound!",
1737 SDATA (SYMBOL_NAME (variable)));
1738
1596 /* Swap out any local binding for some other buffer, and make 1739 /* Swap out any local binding for some other buffer, and make
1597 sure the current value is permanently recorded, if it's the 1740 sure the current value is permanently recorded, if it's the
1598 default value. */ 1741 default value. */
1599 find_symbol_value (variable); 1742 find_symbol_value (variable);
1600 1743
1601 current_buffer->local_var_alist 1744 current_buffer->local_var_alist
1602 = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE (sym->value)->cdr)), 1745 = Fcons (Fcons (variable, XCDR (blv->defcell)),
1603 current_buffer->local_var_alist); 1746 current_buffer->local_var_alist);
1604 1747
1605 /* Make sure symbol does not think it is set up for this buffer; 1748 /* Make sure symbol does not think it is set up for this buffer;
1606 force it to look once again for this buffer's value. */ 1749 force it to look once again for this buffer's value. */
1607 { 1750 if (current_buffer == XBUFFER (blv->where))
1608 Lisp_Object *pvalbuf; 1751 blv->where = Qnil;
1609 1752 /* blv->valcell = blv->defcell;
1610 valcontents = sym->value; 1753 * SET_BLV_FOUND (blv, 0); */
1611 1754 blv->found = 0;
1612 pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
1613 if (current_buffer == XBUFFER (*pvalbuf))
1614 *pvalbuf = Qnil;
1615 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
1616 }
1617 } 1755 }
1618 1756
1619 /* If the symbol forwards into a C variable, then load the binding 1757 /* If the symbol forwards into a C variable, then load the binding
1620 for this buffer now. If C code modifies the variable before we 1758 for this buffer now. If C code modifies the variable before we
1621 load the binding in, then that new value will clobber the default 1759 load the binding in, then that new value will clobber the default
1622 binding the next time we unload it. */ 1760 binding the next time we unload it. */
1623 valcontents = XBUFFER_LOCAL_VALUE (sym->value)->realvalue; 1761 if (blv->fwd)
1624 if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents)) 1762 swap_in_symval_forwarding (sym, blv);
1625 swap_in_symval_forwarding (variable, sym->value);
1626 1763
1627 return variable; 1764 return variable;
1628} 1765}
@@ -1634,31 +1771,43 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
1634 (variable) 1771 (variable)
1635 register Lisp_Object variable; 1772 register Lisp_Object variable;
1636{ 1773{
1637 register Lisp_Object tem, valcontents; 1774 register Lisp_Object tem;
1775 struct Lisp_Buffer_Local_Value *blv;
1638 struct Lisp_Symbol *sym; 1776 struct Lisp_Symbol *sym;
1639 1777
1640 CHECK_SYMBOL (variable); 1778 CHECK_SYMBOL (variable);
1641 sym = indirect_variable (XSYMBOL (variable)); 1779 sym = XSYMBOL (variable);
1642
1643 valcontents = sym->value;
1644 1780
1645 if (BUFFER_OBJFWDP (valcontents)) 1781 start:
1782 switch (sym->redirect)
1646 { 1783 {
1647 int offset = XBUFFER_OBJFWD (valcontents)->offset; 1784 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1648 int idx = PER_BUFFER_IDX (offset); 1785 case SYMBOL_PLAINVAL: return variable;
1649 1786 case SYMBOL_FORWARDED:
1650 if (idx > 0) 1787 {
1651 { 1788 union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
1652 SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0); 1789 if (BUFFER_OBJFWDP (valcontents))
1653 PER_BUFFER_VALUE (current_buffer, offset) 1790 {
1654 = PER_BUFFER_DEFAULT (offset); 1791 int offset = XBUFFER_OBJFWD (valcontents)->offset;
1655 } 1792 int idx = PER_BUFFER_IDX (offset);
1656 return variable; 1793
1794 if (idx > 0)
1795 {
1796 SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
1797 PER_BUFFER_VALUE (current_buffer, offset)
1798 = PER_BUFFER_DEFAULT (offset);
1799 }
1800 }
1801 return variable;
1802 }
1803 case SYMBOL_LOCALIZED:
1804 blv = SYMBOL_BLV (sym);
1805 if (blv->frame_local)
1806 return variable;
1807 break;
1808 default: abort ();
1657 } 1809 }
1658 1810
1659 if (!BUFFER_LOCAL_VALUEP (valcontents))
1660 return variable;
1661
1662 /* Get rid of this buffer's alist element, if any. */ 1811 /* Get rid of this buffer's alist element, if any. */
1663 XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ 1812 XSETSYMBOL (variable, sym); /* Propagate variable indirection. */
1664 tem = Fassq (variable, current_buffer->local_var_alist); 1813 tem = Fassq (variable, current_buffer->local_var_alist);
@@ -1670,14 +1819,13 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
1670 loaded, recompute its value. We have to do it now, or else 1819 loaded, recompute its value. We have to do it now, or else
1671 forwarded objects won't work right. */ 1820 forwarded objects won't work right. */
1672 { 1821 {
1673 Lisp_Object *pvalbuf, buf; 1822 Lisp_Object buf; XSETBUFFER (buf, current_buffer);
1674 valcontents = sym->value; 1823 if (EQ (buf, blv->where))
1675 pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
1676 XSETBUFFER (buf, current_buffer);
1677 if (EQ (buf, *pvalbuf))
1678 { 1824 {
1679 *pvalbuf = Qnil; 1825 blv->where = Qnil;
1680 XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0; 1826 /* blv->valcell = blv->defcell;
1827 * SET_BLV_FOUND (blv, 0); */
1828 blv->found = 0;
1681 find_symbol_value (variable); 1829 find_symbol_value (variable);
1682 } 1830 }
1683 } 1831 }
@@ -1712,39 +1860,45 @@ frame-local bindings). */)
1712 (variable) 1860 (variable)
1713 register Lisp_Object variable; 1861 register Lisp_Object variable;
1714{ 1862{
1715 register Lisp_Object tem, valcontents, newval; 1863 int forwarded;
1864 union Lisp_Val_Fwd valcontents;
1716 struct Lisp_Symbol *sym; 1865 struct Lisp_Symbol *sym;
1866 struct Lisp_Buffer_Local_Value *blv = NULL;
1717 1867
1718 CHECK_SYMBOL (variable); 1868 CHECK_SYMBOL (variable);
1719 sym = indirect_variable (XSYMBOL (variable)); 1869 sym = XSYMBOL (variable);
1720
1721 valcontents = sym->value;
1722 if (sym->constant || KBOARD_OBJFWDP (valcontents)
1723 || BUFFER_OBJFWDP (valcontents))
1724 error ("Symbol %s may not be frame-local", SDATA (sym->xname));
1725 1870
1726 if (BUFFER_LOCAL_VALUEP (valcontents)) 1871 start:
1872 switch (sym->redirect)
1727 { 1873 {
1728 if (!XBUFFER_LOCAL_VALUE (valcontents)->check_frame) 1874 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1729 error ("Symbol %s may not be frame-local", SDATA (sym->xname)); 1875 case SYMBOL_PLAINVAL:
1730 return variable; 1876 forwarded = 0; valcontents.value = SYMBOL_VAL (sym);
1877 if (EQ (valcontents.value, Qunbound))
1878 valcontents.value = Qnil;
1879 break;
1880 case SYMBOL_LOCALIZED:
1881 if (SYMBOL_BLV (sym)->frame_local)
1882 return variable;
1883 else
1884 error ("Symbol %s may not be frame-local",
1885 SDATA (SYMBOL_NAME (variable)));
1886 case SYMBOL_FORWARDED:
1887 forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym);
1888 if (KBOARD_OBJFWDP (valcontents.fwd) || BUFFER_OBJFWDP (valcontents.fwd))
1889 error ("Symbol %s may not be frame-local",
1890 SDATA (SYMBOL_NAME (variable)));
1891 break;
1892 default: abort ();
1731 } 1893 }
1732 1894
1733 if (EQ (valcontents, Qunbound)) 1895 if (sym->constant)
1734 sym->value = Qnil; 1896 error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
1735 tem = Fcons (Qnil, Fsymbol_value (variable)); 1897
1736 XSETCAR (tem, tem); 1898 blv = make_blv (sym, forwarded, valcontents);
1737 newval = allocate_misc (); 1899 blv->frame_local = 1;
1738 XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value; 1900 sym->redirect = SYMBOL_LOCALIZED;
1739 XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value; 1901 SET_SYMBOL_BLV (sym, blv);
1740 XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil;
1741 XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
1742 XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0;
1743 XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
1744 XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
1745 XBUFFER_LOCAL_VALUE (newval)->check_frame = 1;
1746 XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
1747 sym->value = newval;
1748 return variable; 1902 return variable;
1749} 1903}
1750 1904
@@ -1755,7 +1909,6 @@ BUFFER defaults to the current buffer. */)
1755 (variable, buffer) 1909 (variable, buffer)
1756 register Lisp_Object variable, buffer; 1910 register Lisp_Object variable, buffer;
1757{ 1911{
1758 Lisp_Object valcontents;
1759 register struct buffer *buf; 1912 register struct buffer *buf;
1760 struct Lisp_Symbol *sym; 1913 struct Lisp_Symbol *sym;
1761 1914
@@ -1768,29 +1921,46 @@ BUFFER defaults to the current buffer. */)
1768 } 1921 }
1769 1922
1770 CHECK_SYMBOL (variable); 1923 CHECK_SYMBOL (variable);
1771 sym = indirect_variable (XSYMBOL (variable)); 1924 sym = XSYMBOL (variable);
1772 XSETSYMBOL (variable, sym);
1773
1774 valcontents = sym->value;
1775 if (BUFFER_LOCAL_VALUEP (valcontents))
1776 {
1777 Lisp_Object tail, elt;
1778 1925
1779 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) 1926 start:
1780 { 1927 switch (sym->redirect)
1781 elt = XCAR (tail);
1782 if (EQ (variable, XCAR (elt)))
1783 return Qt;
1784 }
1785 }
1786 if (BUFFER_OBJFWDP (valcontents))
1787 { 1928 {
1788 int offset = XBUFFER_OBJFWD (valcontents)->offset; 1929 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1789 int idx = PER_BUFFER_IDX (offset); 1930 case SYMBOL_PLAINVAL: return Qnil;
1790 if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx)) 1931 case SYMBOL_LOCALIZED:
1791 return Qt; 1932 {
1933 Lisp_Object tail, elt, tmp;
1934 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1935 XSETBUFFER (tmp, buf);
1936
1937 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
1938 {
1939 elt = XCAR (tail);
1940 if (EQ (variable, XCAR (elt)))
1941 {
1942 eassert (!blv->frame_local);
1943 eassert (BLV_FOUND (blv) || !EQ (blv->where, tmp));
1944 return Qt;
1945 }
1946 }
1947 eassert (!BLV_FOUND (blv) || !EQ (blv->where, tmp));
1948 return Qnil;
1949 }
1950 case SYMBOL_FORWARDED:
1951 {
1952 union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
1953 if (BUFFER_OBJFWDP (valcontents))
1954 {
1955 int offset = XBUFFER_OBJFWD (valcontents)->offset;
1956 int idx = PER_BUFFER_IDX (offset);
1957 if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
1958 return Qt;
1959 }
1960 return Qnil;
1961 }
1962 default: abort ();
1792 } 1963 }
1793 return Qnil;
1794} 1964}
1795 1965
1796DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p, 1966DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
@@ -1804,40 +1974,29 @@ BUFFER defaults to the current buffer. */)
1804 (variable, buffer) 1974 (variable, buffer)
1805 register Lisp_Object variable, buffer; 1975 register Lisp_Object variable, buffer;
1806{ 1976{
1807 Lisp_Object valcontents;
1808 register struct buffer *buf;
1809 struct Lisp_Symbol *sym; 1977 struct Lisp_Symbol *sym;
1810 1978
1811 if (NILP (buffer))
1812 buf = current_buffer;
1813 else
1814 {
1815 CHECK_BUFFER (buffer);
1816 buf = XBUFFER (buffer);
1817 }
1818
1819 CHECK_SYMBOL (variable); 1979 CHECK_SYMBOL (variable);
1820 sym = indirect_variable (XSYMBOL (variable)); 1980 sym = XSYMBOL (variable);
1821 XSETSYMBOL (variable, sym);
1822
1823 valcontents = sym->value;
1824 1981
1825 if (BUFFER_OBJFWDP (valcontents)) 1982 start:
1826 /* All these slots become local if they are set. */ 1983 switch (sym->redirect)
1827 return Qt;
1828 else if (BUFFER_LOCAL_VALUEP (valcontents))
1829 { 1984 {
1830 Lisp_Object tail, elt; 1985 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
1831 if (XBUFFER_LOCAL_VALUE (valcontents)->local_if_set) 1986 case SYMBOL_PLAINVAL: return Qnil;
1832 return Qt; 1987 case SYMBOL_LOCALIZED:
1833 for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) 1988 {
1834 { 1989 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1835 elt = XCAR (tail); 1990 if (blv->local_if_set)
1836 if (EQ (variable, XCAR (elt))) 1991 return Qt;
1837 return Qt; 1992 XSETSYMBOL (variable, sym); /* Update in case of aliasing. */
1838 } 1993 return Flocal_variable_p (variable, buffer);
1994 }
1995 case SYMBOL_FORWARDED:
1996 /* All BUFFER_OBJFWD slots become local if they are set. */
1997 return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil);
1998 default: abort ();
1839 } 1999 }
1840 return Qnil;
1841} 2000}
1842 2001
1843DEFUN ("variable-binding-locus", Fvariable_binding_locus, Svariable_binding_locus, 2002DEFUN ("variable-binding-locus", Fvariable_binding_locus, Svariable_binding_locus,
@@ -1849,30 +2008,40 @@ If the current binding is global (the default), the value is nil. */)
1849 (variable) 2008 (variable)
1850 register Lisp_Object variable; 2009 register Lisp_Object variable;
1851{ 2010{
1852 Lisp_Object valcontents;
1853 struct Lisp_Symbol *sym; 2011 struct Lisp_Symbol *sym;
1854 2012
1855 CHECK_SYMBOL (variable); 2013 CHECK_SYMBOL (variable);
1856 sym = indirect_variable (XSYMBOL (variable)); 2014 sym = XSYMBOL (variable);
1857 2015
1858 /* Make sure the current binding is actually swapped in. */ 2016 /* Make sure the current binding is actually swapped in. */
1859 find_symbol_value (variable); 2017 find_symbol_value (variable);
1860 2018
1861 valcontents = sym->value; 2019 start:
1862 2020 switch (sym->redirect)
1863 if (BUFFER_LOCAL_VALUEP (valcontents)
1864 || BUFFER_OBJFWDP (valcontents))
1865 { 2021 {
2022 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2023 case SYMBOL_PLAINVAL: return Qnil;
2024 case SYMBOL_FORWARDED:
2025 {
2026 union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
2027 if (KBOARD_OBJFWDP (valcontents))
2028 return Fframe_terminal (Fselected_frame ());
2029 else if (!BUFFER_OBJFWDP (valcontents))
2030 return Qnil;
2031 }
2032 /* FALLTHROUGH */
2033 case SYMBOL_LOCALIZED:
1866 /* For a local variable, record both the symbol and which 2034 /* For a local variable, record both the symbol and which
1867 buffer's or frame's value we are saving. */ 2035 buffer's or frame's value we are saving. */
1868 if (!NILP (Flocal_variable_p (variable, Qnil))) 2036 if (!NILP (Flocal_variable_p (variable, Qnil)))
1869 return Fcurrent_buffer (); 2037 return Fcurrent_buffer ();
1870 else if (BUFFER_LOCAL_VALUEP (valcontents) 2038 else if (sym->redirect == SYMBOL_LOCALIZED
1871 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame) 2039 && BLV_FOUND (SYMBOL_BLV (sym)))
1872 return XBUFFER_LOCAL_VALUE (valcontents)->frame; 2040 return SYMBOL_BLV (sym)->where;
2041 else
2042 return Qnil;
2043 default: abort ();
1873 } 2044 }
1874
1875 return Qnil;
1876} 2045}
1877 2046
1878/* This code is disabled now that we use the selected frame to return 2047/* This code is disabled now that we use the selected frame to return
diff --git a/src/eval.c b/src/eval.c
index 6609d3b5c8a..cb1d435cb8b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -767,24 +767,46 @@ The return value is BASE-VARIABLE. */)
767 CHECK_SYMBOL (new_alias); 767 CHECK_SYMBOL (new_alias);
768 CHECK_SYMBOL (base_variable); 768 CHECK_SYMBOL (base_variable);
769 769
770 if (SYMBOL_CONSTANT_P (new_alias))
771 error ("Cannot make a constant an alias");
772
773 sym = XSYMBOL (new_alias); 770 sym = XSYMBOL (new_alias);
771
772 if (sym->constant)
773 if (sym->redirect == SYMBOL_VARALIAS)
774 sym->constant = 0; /* Reset. */
775 else
776 /* Not sure why. */
777 error ("Cannot make a constant an alias");
778
779 switch (sym->redirect)
780 {
781 case SYMBOL_FORWARDED:
782 error ("Cannot make an internal variable an alias");
783 case SYMBOL_LOCALIZED:
784 error ("Don't know how to make a localized variable an alias");
785 }
786
774 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html 787 /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
775 If n_a is bound, but b_v is not, set the value of b_v to n_a. 788 If n_a is bound, but b_v is not, set the value of b_v to n_a,
776 This is for the sake of define-obsolete-variable-alias and user 789 so that old-code that affects n_a before the aliasing is setup
777 customizations. */ 790 still works. */
778 if (NILP (Fboundp (base_variable)) && !NILP (Fboundp (new_alias))) 791 if (NILP (Fboundp (base_variable)))
779 XSYMBOL(base_variable)->value = sym->value; 792 set_internal (base_variable, find_symbol_value (new_alias), NULL, 1);
780 sym->indirect_variable = 1; 793
781 sym->value = base_variable; 794 {
795 struct specbinding *p;
796
797 for (p = specpdl_ptr - 1; p >= specpdl; p--)
798 if (p->func == NULL
799 && (EQ (new_alias,
800 CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
801 error ("Don't know how to make a let-bound variable an alias");
802 }
803
804 sym->redirect = SYMBOL_VARALIAS;
805 SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
782 sym->constant = SYMBOL_CONSTANT_P (base_variable); 806 sym->constant = SYMBOL_CONSTANT_P (base_variable);
783 LOADHIST_ATTACH (new_alias); 807 LOADHIST_ATTACH (new_alias);
784 if (!NILP (docstring)) 808 /* Even if docstring is nil: remove old docstring. */
785 Fput (new_alias, Qvariable_documentation, docstring); 809 Fput (new_alias, Qvariable_documentation, docstring);
786 else
787 Fput (new_alias, Qvariable_documentation, Qnil);
788 810
789 return base_variable; 811 return base_variable;
790} 812}
@@ -944,7 +966,7 @@ chain of symbols. */)
944 return Qnil; 966 return Qnil;
945 967
946 /* If indirect and there's an alias loop, don't check anything else. */ 968 /* If indirect and there's an alias loop, don't check anything else. */
947 if (XSYMBOL (variable)->indirect_variable 969 if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS
948 && NILP (internal_condition_case_1 (lisp_indirect_variable, variable, 970 && NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
949 Qt, user_variable_p_eh))) 971 Qt, user_variable_p_eh)))
950 return Qnil; 972 return Qnil;
@@ -968,11 +990,11 @@ chain of symbols. */)
968 || (!NILP (Fget (variable, intern ("custom-autoload"))))) 990 || (!NILP (Fget (variable, intern ("custom-autoload")))))
969 return Qt; 991 return Qt;
970 992
971 if (!XSYMBOL (variable)->indirect_variable) 993 if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS))
972 return Qnil; 994 return Qnil;
973 995
974 /* An indirect variable? Let's follow the chain. */ 996 /* An indirect variable? Let's follow the chain. */
975 variable = XSYMBOL (variable)->value; 997 XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable)));
976 } 998 }
977} 999}
978 1000
@@ -3263,78 +3285,94 @@ void
3263specbind (symbol, value) 3285specbind (symbol, value)
3264 Lisp_Object symbol, value; 3286 Lisp_Object symbol, value;
3265{ 3287{
3266 Lisp_Object valcontents; 3288 struct Lisp_Symbol *sym;
3289
3290 eassert (!handling_signal);
3267 3291
3268 CHECK_SYMBOL (symbol); 3292 CHECK_SYMBOL (symbol);
3293 sym = XSYMBOL (symbol);
3269 if (specpdl_ptr == specpdl + specpdl_size) 3294 if (specpdl_ptr == specpdl + specpdl_size)
3270 grow_specpdl (); 3295 grow_specpdl ();
3271 3296
3272 /* The most common case is that of a non-constant symbol with a 3297 start:
3273 trivial value. Make that as fast as we can. */ 3298 switch (sym->redirect)
3274 valcontents = SYMBOL_VALUE (symbol); 3299 {
3275 if (!MISCP (valcontents) && !SYMBOL_CONSTANT_P (symbol)) 3300 case SYMBOL_VARALIAS:
3276 { 3301 sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
3277 specpdl_ptr->symbol = symbol; 3302 case SYMBOL_PLAINVAL:
3278 specpdl_ptr->old_value = valcontents; 3303 { /* The most common case is that of a non-constant symbol with a
3279 specpdl_ptr->func = NULL; 3304 trivial value. Make that as fast as we can. */
3280 ++specpdl_ptr; 3305 specpdl_ptr->symbol = symbol;
3281 SET_SYMBOL_VALUE (symbol, value); 3306 specpdl_ptr->old_value = SYMBOL_VAL (sym);
3282 } 3307 specpdl_ptr->func = NULL;
3283 else 3308 ++specpdl_ptr;
3284 { 3309 if (!sym->constant)
3285 Lisp_Object ovalue = find_symbol_value (symbol); 3310 SET_SYMBOL_VAL (sym, value);
3286 specpdl_ptr->func = 0;
3287 specpdl_ptr->old_value = ovalue;
3288
3289 valcontents = XSYMBOL (symbol)->value;
3290
3291 if (BUFFER_LOCAL_VALUEP (valcontents)
3292 || BUFFER_OBJFWDP (valcontents))
3293 {
3294 Lisp_Object where, current_buffer;
3295
3296 current_buffer = Fcurrent_buffer ();
3297
3298 /* For a local variable, record both the symbol and which
3299 buffer's or frame's value we are saving. */
3300 if (!NILP (Flocal_variable_p (symbol, Qnil)))
3301 where = current_buffer;
3302 else if (BUFFER_LOCAL_VALUEP (valcontents)
3303 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
3304 where = XBUFFER_LOCAL_VALUE (valcontents)->frame;
3305 else 3311 else
3306 where = Qnil; 3312 set_internal (symbol, value, 0, 1);
3307 3313 break;
3308 /* We're not using the `unused' slot in the specbinding
3309 structure because this would mean we have to do more
3310 work for simple variables. */
3311 specpdl_ptr->symbol = Fcons (symbol, Fcons (where, current_buffer));
3312
3313 /* If SYMBOL is a per-buffer variable which doesn't have a
3314 buffer-local value here, make the `let' change the global
3315 value by changing the value of SYMBOL in all buffers not
3316 having their own value. This is consistent with what
3317 happens with other buffer-local variables. */
3318 if (NILP (where)
3319 && BUFFER_OBJFWDP (valcontents))
3320 {
3321 ++specpdl_ptr;
3322 Fset_default (symbol, value);
3323 return;
3324 }
3325 } 3314 }
3326 else 3315 case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED:
3327 specpdl_ptr->symbol = symbol; 3316 {
3328 3317 Lisp_Object ovalue = find_symbol_value (symbol);
3329 specpdl_ptr++; 3318 specpdl_ptr->func = 0;
3330 /* We used to do 3319 specpdl_ptr->old_value = ovalue;
3331 if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue)) 3320
3332 store_symval_forwarding (symbol, ovalue, value, NULL); 3321 eassert (sym->redirect != SYMBOL_LOCALIZED
3333 else 3322 || (EQ (SYMBOL_BLV (sym)->where,
3334 but ovalue comes from find_symbol_value which should never return 3323 SYMBOL_BLV (sym)->frame_local ?
3335 such an internal value. */ 3324 Fselected_frame () : Fcurrent_buffer ())));
3336 eassert (!(BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))); 3325
3337 set_internal (symbol, value, 0, 1); 3326 if (sym->redirect == SYMBOL_LOCALIZED
3327 || BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
3328 {
3329 Lisp_Object where, cur_buf = Fcurrent_buffer ();
3330
3331 /* For a local variable, record both the symbol and which
3332 buffer's or frame's value we are saving. */
3333 if (!NILP (Flocal_variable_p (symbol, Qnil)))
3334 {
3335 eassert (sym->redirect != SYMBOL_LOCALIZED
3336 || (BLV_FOUND (SYMBOL_BLV (sym))
3337 && EQ (cur_buf, SYMBOL_BLV (sym)->where)));
3338 where = cur_buf;
3339 }
3340 else if (sym->redirect == SYMBOL_LOCALIZED
3341 && BLV_FOUND (SYMBOL_BLV (sym)))
3342 where = SYMBOL_BLV (sym)->where;
3343 else
3344 where = Qnil;
3345
3346 /* We're not using the `unused' slot in the specbinding
3347 structure because this would mean we have to do more
3348 work for simple variables. */
3349 /* FIXME: The third value `current_buffer' is only used in
3350 let_shadows_buffer_binding_p which is itself only used
3351 in set_internal for local_if_set. */
3352 specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf));
3353
3354 /* If SYMBOL is a per-buffer variable which doesn't have a
3355 buffer-local value here, make the `let' change the global
3356 value by changing the value of SYMBOL in all buffers not
3357 having their own value. This is consistent with what
3358 happens with other buffer-local variables. */
3359 if (NILP (where)
3360 && sym->redirect == SYMBOL_FORWARDED)
3361 {
3362 eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym)));
3363 ++specpdl_ptr;
3364 Fset_default (symbol, value);
3365 return;
3366 }
3367 }
3368 else
3369 specpdl_ptr->symbol = symbol;
3370
3371 specpdl_ptr++;
3372 set_internal (symbol, value, 0, 1);
3373 break;
3374 }
3375 default: abort ();
3338 } 3376 }
3339} 3377}
3340 3378
@@ -3394,7 +3432,12 @@ unbind_to (count, value)
3394 if (NILP (where)) 3432 if (NILP (where))
3395 Fset_default (symbol, this_binding.old_value); 3433 Fset_default (symbol, this_binding.old_value);
3396 else if (BUFFERP (where)) 3434 else if (BUFFERP (where))
3397 set_internal (symbol, this_binding.old_value, XBUFFER (where), 1); 3435 if (!NILP (Flocal_variable_p (symbol, where)))
3436 set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
3437 /* else if (!NILP (Fbuffer_live_p (where)))
3438 error ("Unbinding local %s to global!", symbol); */
3439 else
3440 ;
3398 else 3441 else
3399 set_internal (symbol, this_binding.old_value, NULL, 1); 3442 set_internal (symbol, this_binding.old_value, NULL, 1);
3400 } 3443 }
@@ -3403,8 +3446,9 @@ unbind_to (count, value)
3403 /* If variable has a trivial value (no forwarding), we can 3446 /* If variable has a trivial value (no forwarding), we can
3404 just set it. No need to check for constant symbols here, 3447 just set it. No need to check for constant symbols here,
3405 since that was already done by specbind. */ 3448 since that was already done by specbind. */
3406 if (!MISCP (SYMBOL_VALUE (this_binding.symbol))) 3449 if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL)
3407 SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value); 3450 SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol),
3451 this_binding.old_value);
3408 else 3452 else
3409 set_internal (this_binding.symbol, this_binding.old_value, 0, 1); 3453 set_internal (this_binding.symbol, this_binding.old_value, 0, 1);
3410 } 3454 }
diff --git a/src/frame.c b/src/frame.c
index 757ed8f01a3..3e1b2daf556 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -2298,13 +2298,20 @@ store_frame_param (f, prop, val)
2298 without messing up the symbol's status. */ 2298 without messing up the symbol's status. */
2299 if (SYMBOLP (prop)) 2299 if (SYMBOLP (prop))
2300 { 2300 {
2301 Lisp_Object valcontents; 2301 struct Lisp_Symbol *sym = XSYMBOL (prop);
2302 valcontents = SYMBOL_VALUE (prop); 2302 start:
2303 if ((BUFFER_LOCAL_VALUEP (valcontents)) 2303 switch (sym->redirect)
2304 && XBUFFER_LOCAL_VALUE (valcontents)->check_frame 2304 {
2305 && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame 2305 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
2306 && XFRAME (XBUFFER_LOCAL_VALUE (valcontents)->frame) == f) 2306 case SYMBOL_PLAINVAL: case SYMBOL_FORWARDED: break;
2307 swap_in_global_binding (prop); 2307 case SYMBOL_LOCALIZED:
2308 { struct Lisp_Buffer_Local_Value *blv = sym->val.blv;
2309 if (blv->frame_local && BLV_FOUND (blv) && XFRAME (blv->where) == f)
2310 swap_in_global_binding (sym);
2311 break;
2312 }
2313 default: abort ();
2314 }
2308 } 2315 }
2309 2316
2310 /* The tty color needed to be set before the frame's parameter 2317 /* The tty color needed to be set before the frame's parameter
@@ -2520,6 +2527,8 @@ If FRAME is nil, describe the currently selected frame. */)
2520 || EQ (parameter, Qbackground_mode)) 2527 || EQ (parameter, Qbackground_mode))
2521 value = Fcdr (Fassq (parameter, f->param_alist)); 2528 value = Fcdr (Fassq (parameter, f->param_alist));
2522 else 2529 else
2530 /* FIXME: Avoid this code path at all (as well as code duplication)
2531 by sharing more code with Fframe_parameters. */
2523 value = Fcdr (Fassq (parameter, Fframe_parameters (frame))); 2532 value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
2524 } 2533 }
2525 2534
diff --git a/src/insdel.c b/src/insdel.c
index ededd597b0d..6cc797a12ff 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -54,7 +54,7 @@ static void adjust_point (EMACS_INT nchars, EMACS_INT nbytes);
54Lisp_Object Fcombine_after_change_execute (); 54Lisp_Object Fcombine_after_change_execute ();
55 55
56/* Non-nil means don't call the after-change-functions right away, 56/* Non-nil means don't call the after-change-functions right away,
57 just record an element in Vcombine_after_change_calls_list. */ 57 just record an element in combine_after_change_list. */
58Lisp_Object Vcombine_after_change_calls; 58Lisp_Object Vcombine_after_change_calls;
59 59
60/* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT) 60/* List of elements of the form (BEG-UNCHANGED END-UNCHANGED CHANGE-AMOUNT)
diff --git a/src/keyboard.c b/src/keyboard.c
index f2aeff89542..1d99c31999f 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1520,7 +1520,6 @@ Lisp_Object
1520command_loop_1 () 1520command_loop_1 ()
1521{ 1521{
1522 Lisp_Object cmd; 1522 Lisp_Object cmd;
1523 int lose;
1524 Lisp_Object keybuf[30]; 1523 Lisp_Object keybuf[30];
1525 int i; 1524 int i;
1526 int prev_modiff = 0; 1525 int prev_modiff = 0;
diff --git a/src/lisp.h b/src/lisp.h
index 7f5d5df66c6..d7e88e7c8b8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -223,13 +223,7 @@ enum Lisp_Misc_Type
223 { 223 {
224 Lisp_Misc_Free = 0x5eab, 224 Lisp_Misc_Free = 0x5eab,
225 Lisp_Misc_Marker, 225 Lisp_Misc_Marker,
226 Lisp_Misc_Intfwd,
227 Lisp_Misc_Boolfwd,
228 Lisp_Misc_Objfwd,
229 Lisp_Misc_Buffer_Objfwd,
230 Lisp_Misc_Buffer_Local_Value,
231 Lisp_Misc_Overlay, 226 Lisp_Misc_Overlay,
232 Lisp_Misc_Kboard_Objfwd,
233 Lisp_Misc_Save_Value, 227 Lisp_Misc_Save_Value,
234 /* Currently floats are not a misc type, 228 /* Currently floats are not a misc type,
235 but let's define this in case we want to change that. */ 229 but let's define this in case we want to change that. */
@@ -238,6 +232,18 @@ enum Lisp_Misc_Type
238 Lisp_Misc_Limit 232 Lisp_Misc_Limit
239 }; 233 };
240 234
235/* These are the types of forwarding objects used in the value slot
236 of symbols for special built-in variables whose value is stored in
237 C variables. */
238enum Lisp_Fwd_Type
239 {
240 Lisp_Fwd_Int, /* Fwd to a C `int' variable. */
241 Lisp_Fwd_Bool, /* Fwd to a C boolean var. */
242 Lisp_Fwd_Obj, /* Fwd to a C Lisp_Object variable. */
243 Lisp_Fwd_Buffer_Obj, /* Fwd to a Lisp_Object field of buffers. */
244 Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */
245 };
246
241#ifndef GCTYPEBITS 247#ifndef GCTYPEBITS
242#define GCTYPEBITS 3 248#define GCTYPEBITS 3
243#endif 249#endif
@@ -566,17 +572,19 @@ extern size_t pure_size;
566#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC(a)->u_any)) 572#define XMISCANY(a) (eassert (MISCP (a)), &(XMISC(a)->u_any))
567#define XMISCTYPE(a) (XMISCANY (a)->type) 573#define XMISCTYPE(a) (XMISCANY (a)->type)
568#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC(a)->u_marker)) 574#define XMARKER(a) (eassert (MARKERP (a)), &(XMISC(a)->u_marker))
569#define XINTFWD(a) (eassert (INTFWDP (a)), &(XMISC(a)->u_intfwd))
570#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &(XMISC(a)->u_boolfwd))
571#define XOBJFWD(a) (eassert (OBJFWDP (a)), &(XMISC(a)->u_objfwd))
572#define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC(a)->u_overlay)) 575#define XOVERLAY(a) (eassert (OVERLAYP (a)), &(XMISC(a)->u_overlay))
573#define XSAVE_VALUE(a) (eassert (SAVE_VALUEP (a)), &(XMISC(a)->u_save_value)) 576#define XSAVE_VALUE(a) (eassert (SAVE_VALUEP (a)), &(XMISC(a)->u_save_value))
577
578/* Forwarding object types. */
579
580#define XFWDTYPE(a) (a->u_intfwd.type)
581#define XINTFWD(a) (eassert (INTFWDP (a)), &((a)->u_intfwd))
582#define XBOOLFWD(a) (eassert (BOOLFWDP (a)), &((a)->u_boolfwd))
583#define XOBJFWD(a) (eassert (OBJFWDP (a)), &((a)->u_objfwd))
574#define XBUFFER_OBJFWD(a) \ 584#define XBUFFER_OBJFWD(a) \
575 (eassert (BUFFER_OBJFWDP (a)), &(XMISC(a)->u_buffer_objfwd)) 585 (eassert (BUFFER_OBJFWDP (a)), &((a)->u_buffer_objfwd))
576#define XBUFFER_LOCAL_VALUE(a) \
577 (eassert (BUFFER_LOCAL_VALUEP (a)), &(XMISC(a)->u_buffer_local_value))
578#define XKBOARD_OBJFWD(a) \ 586#define XKBOARD_OBJFWD(a) \
579 (eassert (KBOARD_OBJFWDP (a)), &(XMISC(a)->u_kboard_objfwd)) 587 (eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd))
580 588
581/* Pseudovector types. */ 589/* Pseudovector types. */
582 590
@@ -988,19 +996,32 @@ enum symbol_interned
988 SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2 996 SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
989}; 997};
990 998
999enum symbol_redirect
1000{
1001 SYMBOL_PLAINVAL = 4,
1002 SYMBOL_VARALIAS = 1,
1003 SYMBOL_LOCALIZED = 2,
1004 SYMBOL_FORWARDED = 3
1005};
1006
991/* In a symbol, the markbit of the plist is used as the gc mark bit */ 1007/* In a symbol, the markbit of the plist is used as the gc mark bit */
992 1008
993struct Lisp_Symbol 1009struct Lisp_Symbol
994{ 1010{
995 unsigned gcmarkbit : 1; 1011 unsigned gcmarkbit : 1;
996 1012
997 /* Non-zero means symbol serves as a variable alias. The symbol 1013 /* Indicates where the value can be found:
998 holding the real value is found in the value slot. */ 1014 0 : it's a plain var, the value is in the `value' field.
999 unsigned indirect_variable : 1; 1015 1 : it's a varalias, the value is really in the `alias' symbol.
1016 2 : it's a localized var, the value is in the `blv' object.
1017 3 : it's a forwarding variable, the value is in `forward'.
1018 */
1019 enum symbol_redirect redirect : 3;
1000 1020
1001 /* Non-zero means symbol is constant, i.e. changing its value 1021 /* Non-zero means symbol is constant, i.e. changing its value
1002 should signal an error. */ 1022 should signal an error. If the value is 3, then the var
1003 unsigned constant : 1; 1023 can be changed, but only by `defconst'. */
1024 unsigned constant : 2;
1004 1025
1005 /* Interned state of the symbol. This is an enumerator from 1026 /* Interned state of the symbol. This is an enumerator from
1006 enum symbol_interned. */ 1027 enum symbol_interned. */
@@ -1013,10 +1034,15 @@ struct Lisp_Symbol
1013 Lisp_Object xname; 1034 Lisp_Object xname;
1014 1035
1015 /* Value of the symbol or Qunbound if unbound. If this symbol is a 1036 /* Value of the symbol or Qunbound if unbound. If this symbol is a
1016 defvaralias, `value' contains the symbol for which it is an 1037 defvaralias, `alias' contains the symbol for which it is an
1017 alias. Use the SYMBOL_VALUE and SET_SYMBOL_VALUE macros to get 1038 alias. Use the SYMBOL_VALUE and SET_SYMBOL_VALUE macros to get
1018 and set a symbol's value, to take defvaralias into account. */ 1039 and set a symbol's value, to take defvaralias into account. */
1019 Lisp_Object value; 1040 union {
1041 Lisp_Object value;
1042 struct Lisp_Symbol *alias;
1043 struct Lisp_Buffer_Local_Value *blv;
1044 union Lisp_Fwd *fwd;
1045 } val;
1020 1046
1021 /* Function value of the symbol or Qunbound if not fboundp. */ 1047 /* Function value of the symbol or Qunbound if not fboundp. */
1022 Lisp_Object function; 1048 Lisp_Object function;
@@ -1030,6 +1056,23 @@ struct Lisp_Symbol
1030 1056
1031/* Value is name of symbol. */ 1057/* Value is name of symbol. */
1032 1058
1059#define SYMBOL_VAL(sym) \
1060 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
1061#define SYMBOL_ALIAS(sym) \
1062 (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias)
1063#define SYMBOL_BLV(sym) \
1064 (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv)
1065#define SYMBOL_FWD(sym) \
1066 (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd)
1067#define SET_SYMBOL_VAL(sym, v) \
1068 (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
1069#define SET_SYMBOL_ALIAS(sym, v) \
1070 (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v))
1071#define SET_SYMBOL_BLV(sym, v) \
1072 (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v))
1073#define SET_SYMBOL_FWD(sym, v) \
1074 (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v))
1075
1033#define SYMBOL_NAME(sym) \ 1076#define SYMBOL_NAME(sym) \
1034 LISP_MAKE_RVALUE (XSYMBOL (sym)->xname) 1077 LISP_MAKE_RVALUE (XSYMBOL (sym)->xname)
1035 1078
@@ -1049,24 +1092,6 @@ struct Lisp_Symbol
1049 1092
1050#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant 1093#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant
1051 1094
1052/* Value is the value of SYM, with defvaralias taken into
1053 account. */
1054
1055#define SYMBOL_VALUE(sym) \
1056 (XSYMBOL (sym)->indirect_variable \
1057 ? indirect_variable (XSYMBOL (sym))->value \
1058 : XSYMBOL (sym)->value)
1059
1060/* Set SYM's value to VAL, taking defvaralias into account. */
1061
1062#define SET_SYMBOL_VALUE(sym, val) \
1063 do { \
1064 if (XSYMBOL (sym)->indirect_variable) \
1065 indirect_variable (XSYMBOL (sym))->value = (val); \
1066 else \
1067 XSYMBOL (sym)->value = (val); \
1068 } while (0)
1069
1070 1095
1071/*********************************************************************** 1096/***********************************************************************
1072 Hash Tables 1097 Hash Tables
@@ -1200,9 +1225,11 @@ struct Lisp_Hash_Table
1200 1225
1201struct Lisp_Misc_Any /* Supertype of all Misc types. */ 1226struct Lisp_Misc_Any /* Supertype of all Misc types. */
1202{ 1227{
1203 enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Marker */ 1228 enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_??? */
1204 unsigned gcmarkbit : 1; 1229 unsigned gcmarkbit : 1;
1205 int spacer : 15; 1230 int spacer : 15;
1231 /* Make it as long as "Lisp_Free without padding". */
1232 void *fill;
1206}; 1233};
1207 1234
1208struct Lisp_Marker 1235struct Lisp_Marker
@@ -1225,7 +1252,7 @@ struct Lisp_Marker
1225 - Fmarker_buffer 1252 - Fmarker_buffer
1226 - Fset_marker: check eq(oldbuf, newbuf) to avoid unchain+rechain. 1253 - Fset_marker: check eq(oldbuf, newbuf) to avoid unchain+rechain.
1227 - unchain_marker: to find the list from which to unchain. 1254 - unchain_marker: to find the list from which to unchain.
1228 - Fkill_buffer: to unchain the markers of current indirect buffer. 1255 - Fkill_buffer: to only unchain the markers of current indirect buffer.
1229 */ 1256 */
1230 struct buffer *buffer; 1257 struct buffer *buffer;
1231 1258
@@ -1239,7 +1266,10 @@ struct Lisp_Marker
1239 struct Lisp_Marker *next; 1266 struct Lisp_Marker *next;
1240 /* This is the char position where the marker points. */ 1267 /* This is the char position where the marker points. */
1241 EMACS_INT charpos; 1268 EMACS_INT charpos;
1242 /* This is the byte position. */ 1269 /* This is the byte position.
1270 It's mostly used as a charpos<->bytepos cache (i.e. it's not directly
1271 used to implement the functionality of markers, but rather to (ab)use
1272 markers as a cache for char<->byte mappings). */
1243 EMACS_INT bytepos; 1273 EMACS_INT bytepos;
1244}; 1274};
1245 1275
@@ -1249,9 +1279,7 @@ struct Lisp_Marker
1249 specified int variable. */ 1279 specified int variable. */
1250struct Lisp_Intfwd 1280struct Lisp_Intfwd
1251 { 1281 {
1252 int type : 16; /* = Lisp_Misc_Intfwd */ 1282 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Int */
1253 unsigned gcmarkbit : 1;
1254 int spacer : 15;
1255 EMACS_INT *intvar; 1283 EMACS_INT *intvar;
1256 }; 1284 };
1257 1285
@@ -1261,9 +1289,7 @@ struct Lisp_Intfwd
1261 nil if it is zero. */ 1289 nil if it is zero. */
1262struct Lisp_Boolfwd 1290struct Lisp_Boolfwd
1263 { 1291 {
1264 int type : 16; /* = Lisp_Misc_Boolfwd */ 1292 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */
1265 unsigned gcmarkbit : 1;
1266 int spacer : 15;
1267 int *boolvar; 1293 int *boolvar;
1268 }; 1294 };
1269 1295
@@ -1273,9 +1299,7 @@ struct Lisp_Boolfwd
1273 specified variable. */ 1299 specified variable. */
1274struct Lisp_Objfwd 1300struct Lisp_Objfwd
1275 { 1301 {
1276 int type : 16; /* = Lisp_Misc_Objfwd */ 1302 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Obj */
1277 unsigned gcmarkbit : 1;
1278 int spacer : 15;
1279 Lisp_Object *objvar; 1303 Lisp_Object *objvar;
1280 }; 1304 };
1281 1305
@@ -1283,11 +1307,9 @@ struct Lisp_Objfwd
1283 current buffer. Value is byte index of slot within buffer. */ 1307 current buffer. Value is byte index of slot within buffer. */
1284struct Lisp_Buffer_Objfwd 1308struct Lisp_Buffer_Objfwd
1285 { 1309 {
1286 int type : 16; /* = Lisp_Misc_Buffer_Objfwd */ 1310 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Buffer_Obj */
1287 unsigned gcmarkbit : 1;
1288 int spacer : 15;
1289 Lisp_Object slottype; /* Qnil, Lisp_Int, Lisp_Symbol, or Lisp_String. */
1290 int offset; 1311 int offset;
1312 Lisp_Object slottype; /* Qnil, Lisp_Int, Lisp_Symbol, or Lisp_String. */
1291 }; 1313 };
1292 1314
1293/* struct Lisp_Buffer_Local_Value is used in a symbol value cell when 1315/* struct Lisp_Buffer_Local_Value is used in a symbol value cell when
@@ -1316,48 +1338,51 @@ struct Lisp_Buffer_Objfwd
1316 1338
1317struct Lisp_Buffer_Local_Value 1339struct Lisp_Buffer_Local_Value
1318 { 1340 {
1319 int type : 16; /* = Lisp_Misc_Buffer_Local_Value */
1320 unsigned gcmarkbit : 1;
1321 int spacer : 11;
1322
1323 /* 1 means that merely setting the variable creates a local 1341 /* 1 means that merely setting the variable creates a local
1324 binding for the current buffer */ 1342 binding for the current buffer */
1325 unsigned int local_if_set : 1; 1343 unsigned int local_if_set : 1;
1326 /* 1 means this variable is allowed to have frame-local bindings, 1344 /* 1 means this variable can have frame-local bindings, otherwise, it is
1327 so check for them when looking for the proper binding. */ 1345 can have buffer-local bindings. The two cannot be combined. */
1328 unsigned int check_frame : 1; 1346 unsigned int frame_local : 1;
1329 /* 1 means that the binding now loaded was found 1347 /* 1 means that the binding now loaded was found.
1330 as a local binding for the buffer in the `buffer' slot. */ 1348 Presumably equivalent to (defcell!=valcell) */
1331 unsigned int found_for_buffer : 1; 1349 unsigned int found : 1;
1332 /* 1 means that the binding now loaded was found 1350 /* If non-NULL, a forwarding to the C var where it should also be set. */
1333 as a local binding for the frame in the `frame' slot. */ 1351 union Lisp_Fwd *fwd; /* Should never be (Buffer|Kboard)_Objfwd. */
1334 unsigned int found_for_frame : 1; 1352 /* The buffer or frame for which the loaded binding was found. */
1335 Lisp_Object realvalue; 1353 Lisp_Object where;
1336 /* The buffer and frame for which the loaded binding was found. */ 1354 /* A cons cell that holds the default value. It has the form
1337 /* Having both is only needed if we want to allow variables that are 1355 (SYMBOL . DEFAULT-VALUE). */
1338 both buffer local and frame local (in which case, we currently give 1356 Lisp_Object defcell;
1339 precedence to the buffer-local binding). I don't think such 1357 /* The cons cell from `where's parameter alist.
1340 a combination is desirable. --Stef */ 1358 It always has the form (SYMBOL . VALUE)
1341 Lisp_Object buffer, frame; 1359 Note that if `forward' is non-nil, VALUE may be out of date.
1342 1360 Also if the currently loaded binding is the default binding, then
1343 /* A cons cell, (LOADED-BINDING . DEFAULT-VALUE). 1361 this is `eq'ual to defcell. */
1344 1362 Lisp_Object valcell;
1345 LOADED-BINDING is the binding now loaded. It is a cons cell
1346 whose cdr is the binding's value. The cons cell may be an
1347 element of a buffer's local-variable alist, or an element of a
1348 frame's parameter alist, or it may be this cons cell.
1349
1350 DEFAULT-VALUE is the variable's default value, seen when the
1351 current buffer and selected frame do not have their own
1352 bindings for the variable. When the default binding is loaded,
1353 LOADED-BINDING is actually this very cons cell; thus, its car
1354 points to itself. */
1355 Lisp_Object cdr;
1356 }; 1363 };
1357 1364
1365#define BLV_FOUND(blv) \
1366 (eassert ((blv)->found == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found)
1367#define SET_BLV_FOUND(blv, v) \
1368 (eassert ((v) == !EQ ((blv)->defcell, (blv)->valcell)), (blv)->found = (v))
1369
1370#define BLV_VALUE(blv) (XCDR ((blv)->valcell))
1371#define SET_BLV_VALUE(blv, v) (XSETCDR ((blv)->valcell, v))
1372
1358/* START and END are markers in the overlay's buffer, and 1373/* START and END are markers in the overlay's buffer, and
1359 PLIST is the overlay's property list. */ 1374 PLIST is the overlay's property list. */
1360struct Lisp_Overlay 1375struct Lisp_Overlay
1376/* An overlay's real data content is:
1377 - plist
1378 - buffer
1379 - insertion type of both ends
1380 - start & start_byte
1381 - end & end_byte
1382 - next (singly linked list of overlays).
1383 - start_next and end_next (singly linked list of markers).
1384 I.e. 9words plus 2 bits, 3words of which are for external linked lists.
1385*/
1361 { 1386 {
1362 enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Overlay */ 1387 enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Overlay */
1363 unsigned gcmarkbit : 1; 1388 unsigned gcmarkbit : 1;
@@ -1370,9 +1395,7 @@ struct Lisp_Overlay
1370 current kboard. */ 1395 current kboard. */
1371struct Lisp_Kboard_Objfwd 1396struct Lisp_Kboard_Objfwd
1372 { 1397 {
1373 enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Kboard_Objfwd */ 1398 enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Kboard_Obj */
1374 unsigned gcmarkbit : 1;
1375 int spacer : 15;
1376 int offset; 1399 int offset;
1377 }; 1400 };
1378 1401
@@ -1401,9 +1424,9 @@ struct Lisp_Free
1401#ifdef USE_LSB_TAG 1424#ifdef USE_LSB_TAG
1402 /* Try to make sure that sizeof(Lisp_Misc) preserves TYPEBITS-alignment. 1425 /* Try to make sure that sizeof(Lisp_Misc) preserves TYPEBITS-alignment.
1403 This assumes that Lisp_Marker is the largest of the alternatives and 1426 This assumes that Lisp_Marker is the largest of the alternatives and
1404 that Lisp_Intfwd has the same size as "Lisp_Free w/o padding". */ 1427 that Lisp_Misc_Any has the same size as "Lisp_Free w/o padding". */
1405 char padding[((((sizeof (struct Lisp_Marker) - 1) >> GCTYPEBITS) + 1) 1428 char padding[((((sizeof (struct Lisp_Marker) - 1) >> GCTYPEBITS) + 1)
1406 << GCTYPEBITS) - sizeof (struct Lisp_Intfwd)]; 1429 << GCTYPEBITS) - sizeof (struct Lisp_Misc_Any)];
1407#endif 1430#endif
1408 }; 1431 };
1409 1432
@@ -1414,15 +1437,18 @@ union Lisp_Misc
1414 { 1437 {
1415 struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */ 1438 struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */
1416 struct Lisp_Free u_free; /* Includes padding to force alignment. */ 1439 struct Lisp_Free u_free; /* Includes padding to force alignment. */
1417 struct Lisp_Marker u_marker; 1440 struct Lisp_Marker u_marker; /* 5 */
1418 struct Lisp_Intfwd u_intfwd; 1441 struct Lisp_Overlay u_overlay; /* 5 */
1419 struct Lisp_Boolfwd u_boolfwd; 1442 struct Lisp_Save_Value u_save_value; /* 3 */
1420 struct Lisp_Objfwd u_objfwd; 1443 };
1421 struct Lisp_Buffer_Objfwd u_buffer_objfwd; 1444
1422 struct Lisp_Buffer_Local_Value u_buffer_local_value; 1445union Lisp_Fwd
1423 struct Lisp_Overlay u_overlay; 1446 {
1424 struct Lisp_Kboard_Objfwd u_kboard_objfwd; 1447 struct Lisp_Intfwd u_intfwd; /* 2 */
1425 struct Lisp_Save_Value u_save_value; 1448 struct Lisp_Boolfwd u_boolfwd; /* 2 */
1449 struct Lisp_Objfwd u_objfwd; /* 2 */
1450 struct Lisp_Buffer_Objfwd u_buffer_objfwd; /* 2 */
1451 struct Lisp_Kboard_Objfwd u_kboard_objfwd; /* 2 */
1426 }; 1452 };
1427 1453
1428/* Lisp floating point type */ 1454/* Lisp floating point type */
@@ -1564,15 +1590,13 @@ typedef struct {
1564#define VECTORP(x) (VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG)) 1590#define VECTORP(x) (VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG))
1565#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) 1591#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay)
1566#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) 1592#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
1567#define INTFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Intfwd)
1568#define BOOLFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Boolfwd)
1569#define OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Objfwd)
1570#define BUFFER_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Objfwd)
1571#define BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Local_Value)
1572#define SOME_BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Some_Buffer_Local_Value)
1573#define KBOARD_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Kboard_Objfwd)
1574#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value) 1593#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value)
1575 1594
1595#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int)
1596#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool)
1597#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj)
1598#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj)
1599#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj)
1576 1600
1577/* True if object X is a pseudovector whose code is CODE. */ 1601/* True if object X is a pseudovector whose code is CODE. */
1578#define PSEUDOVECTORP(x, code) \ 1602#define PSEUDOVECTORP(x, code) \
@@ -1789,24 +1813,44 @@ extern void defsubr P_ ((struct Lisp_Subr *));
1789#define MANY -2 1813#define MANY -2
1790#define UNEVALLED -1 1814#define UNEVALLED -1
1791 1815
1792extern void defvar_lisp (const char *, Lisp_Object *); 1816extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *);
1793extern void defvar_lisp_nopro (const char *, Lisp_Object *); 1817extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *);
1794extern void defvar_bool (const char *, int *); 1818extern void defvar_bool (struct Lisp_Boolfwd *, const char *, int *);
1795extern void defvar_int (const char *, EMACS_INT *); 1819extern void defvar_int (struct Lisp_Intfwd *, const char *, EMACS_INT *);
1796extern void defvar_kboard (const char *, int); 1820extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
1797 1821
1798/* Macros we use to define forwarded Lisp variables. 1822/* Macros we use to define forwarded Lisp variables.
1799 These are used in the syms_of_FILENAME functions. */ 1823 These are used in the syms_of_FILENAME functions. */
1800 1824
1801#define DEFVAR_LISP(lname, vname, doc) defvar_lisp (lname, vname) 1825#define DEFVAR_LISP(lname, vname, doc) \
1802#define DEFVAR_LISP_NOPRO(lname, vname, doc) defvar_lisp_nopro (lname, vname) 1826 do { \
1803#define DEFVAR_BOOL(lname, vname, doc) defvar_bool (lname, vname) 1827 static struct Lisp_Objfwd o_fwd; \
1804#define DEFVAR_INT(lname, vname, doc) defvar_int (lname, vname) 1828 defvar_lisp (&o_fwd, lname, vname); \
1829 } while (0)
1830#define DEFVAR_LISP_NOPRO(lname, vname, doc) \
1831 do { \
1832 static struct Lisp_Objfwd o_fwd; \
1833 defvar_lisp_nopro (&o_fwd, lname, vname); \
1834 } while (0)
1835#define DEFVAR_BOOL(lname, vname, doc) \
1836 do { \
1837 static struct Lisp_Boolfwd b_fwd; \
1838 defvar_bool (&b_fwd, lname, vname); \
1839 } while (0)
1840#define DEFVAR_INT(lname, vname, doc) \
1841 do { \
1842 static struct Lisp_Intfwd i_fwd; \
1843 defvar_int (&i_fwd, lname, vname); \
1844 } while (0)
1805 1845
1806#define DEFVAR_KBOARD(lname, vname, doc) \ 1846#define DEFVAR_KBOARD(lname, vname, doc) \
1807 defvar_kboard (lname, \ 1847 do { \
1808 (int)((char *)(&current_kboard->vname) \ 1848 static struct Lisp_Kboard_Objfwd ko_fwd; \
1809 - (char *)current_kboard)) 1849 defvar_kboard (&ko_fwd, \
1850 lname, \
1851 (int)((char *)(&current_kboard->vname) \
1852 - (char *)current_kboard)); \
1853 } while (0)
1810 1854
1811 1855
1812 1856
@@ -2341,13 +2385,11 @@ extern void args_out_of_range P_ ((Lisp_Object, Lisp_Object)) NO_RETURN;
2341extern void args_out_of_range_3 P_ ((Lisp_Object, Lisp_Object, 2385extern void args_out_of_range_3 P_ ((Lisp_Object, Lisp_Object,
2342 Lisp_Object)) NO_RETURN; 2386 Lisp_Object)) NO_RETURN;
2343extern Lisp_Object wrong_type_argument P_ ((Lisp_Object, Lisp_Object)) NO_RETURN; 2387extern Lisp_Object wrong_type_argument P_ ((Lisp_Object, Lisp_Object)) NO_RETURN;
2344extern void store_symval_forwarding P_ ((Lisp_Object, Lisp_Object, 2388extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
2345 Lisp_Object, struct buffer *)); 2389extern void set_internal (Lisp_Object, Lisp_Object, struct buffer *, int);
2346extern Lisp_Object do_symval_forwarding P_ ((Lisp_Object));
2347extern Lisp_Object set_internal P_ ((Lisp_Object, Lisp_Object, struct buffer *, int));
2348extern void syms_of_data P_ ((void)); 2390extern void syms_of_data P_ ((void));
2349extern void init_data P_ ((void)); 2391extern void init_data P_ ((void));
2350extern void swap_in_global_binding P_ ((Lisp_Object)); 2392extern void swap_in_global_binding P_ ((struct Lisp_Symbol *));
2351 2393
2352/* Defined in cmds.c */ 2394/* Defined in cmds.c */
2353EXFUN (Fend_of_line, 1); 2395EXFUN (Fend_of_line, 1);
@@ -3388,6 +3430,7 @@ extern void syms_of_term P_ ((void));
3388extern void fatal P_ ((const char *msgid, ...)) NO_RETURN; 3430extern void fatal P_ ((const char *msgid, ...)) NO_RETURN;
3389 3431
3390/* Defined in terminal.c */ 3432/* Defined in terminal.c */
3433EXFUN (Fframe_terminal, 1);
3391EXFUN (Fdelete_terminal, 2); 3434EXFUN (Fdelete_terminal, 2);
3392extern void syms_of_terminal P_ ((void)); 3435extern void syms_of_terminal P_ ((void));
3393 3436
diff --git a/src/lread.c b/src/lread.c
index 83ebc8b3b10..a04b9679d83 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3687,7 +3687,8 @@ it defaults to the value of `obarray'. */)
3687 && EQ (obarray, initial_obarray)) 3687 && EQ (obarray, initial_obarray))
3688 { 3688 {
3689 XSYMBOL (sym)->constant = 1; 3689 XSYMBOL (sym)->constant = 1;
3690 XSYMBOL (sym)->value = sym; 3690 XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
3691 SET_SYMBOL_VAL (XSYMBOL (sym), sym);
3691 } 3692 }
3692 3693
3693 ptr = &XVECTOR (obarray)->contents[XINT (tem)]; 3694 ptr = &XVECTOR (obarray)->contents[XINT (tem)];
@@ -3768,8 +3769,6 @@ OBARRAY defaults to the value of the variable `obarray'. */)
3768 error ("Attempt to unintern t or nil"); */ 3769 error ("Attempt to unintern t or nil"); */
3769 3770
3770 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED; 3771 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
3771 XSYMBOL (tem)->constant = 0;
3772 XSYMBOL (tem)->indirect_variable = 0;
3773 3772
3774 hash = oblookup_last_bucket_number; 3773 hash = oblookup_last_bucket_number;
3775 3774
@@ -3914,35 +3913,31 @@ void
3914init_obarray () 3913init_obarray ()
3915{ 3914{
3916 Lisp_Object oblength; 3915 Lisp_Object oblength;
3917 int hash;
3918 Lisp_Object *tem;
3919 3916
3920 XSETFASTINT (oblength, OBARRAY_SIZE); 3917 XSETFASTINT (oblength, OBARRAY_SIZE);
3921 3918
3922 Qnil = Fmake_symbol (make_pure_c_string ("nil"));
3923 Vobarray = Fmake_vector (oblength, make_number (0)); 3919 Vobarray = Fmake_vector (oblength, make_number (0));
3924 initial_obarray = Vobarray; 3920 initial_obarray = Vobarray;
3925 staticpro (&initial_obarray); 3921 staticpro (&initial_obarray);
3926 /* Intern nil in the obarray */
3927 XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3928 XSYMBOL (Qnil)->constant = 1;
3929
3930 /* These locals are to kludge around a pyramid compiler bug. */
3931 hash = hash_string ("nil", 3);
3932 /* Separate statement here to avoid VAXC bug. */
3933 hash %= OBARRAY_SIZE;
3934 tem = &XVECTOR (Vobarray)->contents[hash];
3935 *tem = Qnil;
3936 3922
3937 Qunbound = Fmake_symbol (make_pure_c_string ("unbound")); 3923 Qunbound = Fmake_symbol (make_pure_c_string ("unbound"));
3938 XSYMBOL (Qnil)->function = Qunbound; 3924 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3939 XSYMBOL (Qunbound)->value = Qunbound; 3925 NILP (Vpurify_flag) check in intern_c_string. */
3926 Qnil = make_number (-1); Vpurify_flag = make_number (1);
3927 Qnil = intern_c_string ("nil");
3928
3929 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3930 so those two need to be fixed manally. */
3931 SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
3940 XSYMBOL (Qunbound)->function = Qunbound; 3932 XSYMBOL (Qunbound)->function = Qunbound;
3933 XSYMBOL (Qunbound)->plist = Qnil;
3934 /* XSYMBOL (Qnil)->function = Qunbound; */
3935 SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
3936 XSYMBOL (Qnil)->constant = 1;
3937 XSYMBOL (Qnil)->plist = Qnil;
3941 3938
3942 Qt = intern_c_string ("t"); 3939 Qt = intern_c_string ("t");
3943 XSYMBOL (Qnil)->value = Qnil; 3940 SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
3944 XSYMBOL (Qnil)->plist = Qnil;
3945 XSYMBOL (Qt)->value = Qt;
3946 XSYMBOL (Qt)->constant = 1; 3941 XSYMBOL (Qt)->constant = 1;
3947 3942
3948 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ 3943 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
@@ -3981,27 +3976,29 @@ defalias (sname, string)
3981 to a C variable of type int. Sample call: 3976 to a C variable of type int. Sample call:
3982 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */ 3977 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3983void 3978void
3984defvar_int (const char *namestring, EMACS_INT *address) 3979defvar_int (struct Lisp_Intfwd *i_fwd,
3980 const char *namestring, EMACS_INT *address)
3985{ 3981{
3986 Lisp_Object sym, val; 3982 Lisp_Object sym;
3987 sym = intern_c_string (namestring); 3983 sym = intern_c_string (namestring);
3988 val = allocate_misc (); 3984 i_fwd->type = Lisp_Fwd_Int;
3989 XMISCTYPE (val) = Lisp_Misc_Intfwd; 3985 i_fwd->intvar = address;
3990 XINTFWD (val)->intvar = address; 3986 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
3991 SET_SYMBOL_VALUE (sym, val); 3987 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
3992} 3988}
3993 3989
3994/* Similar but define a variable whose value is t if address contains 1, 3990/* Similar but define a variable whose value is t if address contains 1,
3995 nil if address contains 0. */ 3991 nil if address contains 0. */
3996void 3992void
3997defvar_bool (const char *namestring, int *address) 3993defvar_bool (struct Lisp_Boolfwd *b_fwd,
3994 const char *namestring, int *address)
3998{ 3995{
3999 Lisp_Object sym, val; 3996 Lisp_Object sym;
4000 sym = intern_c_string (namestring); 3997 sym = intern_c_string (namestring);
4001 val = allocate_misc (); 3998 b_fwd->type = Lisp_Fwd_Bool;
4002 XMISCTYPE (val) = Lisp_Misc_Boolfwd; 3999 b_fwd->boolvar = address;
4003 XBOOLFWD (val)->boolvar = address; 4000 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4004 SET_SYMBOL_VALUE (sym, val); 4001 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
4005 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); 4002 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
4006} 4003}
4007 4004
@@ -4011,20 +4008,22 @@ defvar_bool (const char *namestring, int *address)
4011 gc-marked for some other reason, since marking the same slot twice 4008 gc-marked for some other reason, since marking the same slot twice
4012 can cause trouble with strings. */ 4009 can cause trouble with strings. */
4013void 4010void
4014defvar_lisp_nopro (const char *namestring, Lisp_Object *address) 4011defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
4012 const char *namestring, Lisp_Object *address)
4015{ 4013{
4016 Lisp_Object sym, val; 4014 Lisp_Object sym;
4017 sym = intern_c_string (namestring); 4015 sym = intern_c_string (namestring);
4018 val = allocate_misc (); 4016 o_fwd->type = Lisp_Fwd_Obj;
4019 XMISCTYPE (val) = Lisp_Misc_Objfwd; 4017 o_fwd->objvar = address;
4020 XOBJFWD (val)->objvar = address; 4018 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4021 SET_SYMBOL_VALUE (sym, val); 4019 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
4022} 4020}
4023 4021
4024void 4022void
4025defvar_lisp (const char *namestring, Lisp_Object *address) 4023defvar_lisp (struct Lisp_Objfwd *o_fwd,
4024 const char *namestring, Lisp_Object *address)
4026{ 4025{
4027 defvar_lisp_nopro (namestring, address); 4026 defvar_lisp_nopro (o_fwd, namestring, address);
4028 staticpro (address); 4027 staticpro (address);
4029} 4028}
4030 4029
@@ -4032,14 +4031,15 @@ defvar_lisp (const char *namestring, Lisp_Object *address)
4032 at a particular offset in the current kboard object. */ 4031 at a particular offset in the current kboard object. */
4033 4032
4034void 4033void
4035defvar_kboard (const char *namestring, int offset) 4034defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
4035 const char *namestring, int offset)
4036{ 4036{
4037 Lisp_Object sym, val; 4037 Lisp_Object sym;
4038 sym = intern_c_string (namestring); 4038 sym = intern_c_string (namestring);
4039 val = allocate_misc (); 4039 ko_fwd->type = Lisp_Fwd_Kboard_Obj;
4040 XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd; 4040 ko_fwd->offset = offset;
4041 XKBOARD_OBJFWD (val)->offset = offset; 4041 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4042 SET_SYMBOL_VALUE (sym, val); 4042 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
4043} 4043}
4044 4044
4045/* Record the value of load-path used at the start of dumping 4045/* Record the value of load-path used at the start of dumping
diff --git a/src/print.c b/src/print.c
index ccbf8d8c0c7..6d403e00fe0 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2267,70 +2267,6 @@ print_object (obj, printcharfun, escapeflag)
2267 strout ("#<misc free cell>", -1, -1, printcharfun, 0); 2267 strout ("#<misc free cell>", -1, -1, printcharfun, 0);
2268 break; 2268 break;
2269 2269
2270 case Lisp_Misc_Intfwd:
2271 sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
2272 strout (buf, -1, -1, printcharfun, 0);
2273 break;
2274
2275 case Lisp_Misc_Boolfwd:
2276 sprintf (buf, "#<boolfwd to %s>",
2277 (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
2278 strout (buf, -1, -1, printcharfun, 0);
2279 break;
2280
2281 case Lisp_Misc_Objfwd:
2282 strout ("#<objfwd to ", -1, -1, printcharfun, 0);
2283 print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
2284 PRINTCHAR ('>');
2285 break;
2286
2287 case Lisp_Misc_Buffer_Objfwd:
2288 strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
2289 print_object (PER_BUFFER_VALUE (current_buffer,
2290 XBUFFER_OBJFWD (obj)->offset),
2291 printcharfun, escapeflag);
2292 PRINTCHAR ('>');
2293 break;
2294
2295 case Lisp_Misc_Kboard_Objfwd:
2296 strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
2297 print_object (*(Lisp_Object *) ((char *) current_kboard
2298 + XKBOARD_OBJFWD (obj)->offset),
2299 printcharfun, escapeflag);
2300 PRINTCHAR ('>');
2301 break;
2302
2303 case Lisp_Misc_Buffer_Local_Value:
2304 strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
2305 if (XBUFFER_LOCAL_VALUE (obj)->local_if_set)
2306 strout ("[local-if-set] ", -1, -1, printcharfun, 0);
2307 strout ("[realvalue] ", -1, -1, printcharfun, 0);
2308 print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
2309 printcharfun, escapeflag);
2310 if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
2311 strout ("[local in buffer] ", -1, -1, printcharfun, 0);
2312 else
2313 strout ("[buffer] ", -1, -1, printcharfun, 0);
2314 print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
2315 printcharfun, escapeflag);
2316 if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
2317 {
2318 if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
2319 strout ("[local in frame] ", -1, -1, printcharfun, 0);
2320 else
2321 strout ("[frame] ", -1, -1, printcharfun, 0);
2322 print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
2323 printcharfun, escapeflag);
2324 }
2325 strout ("[alist-elt] ", -1, -1, printcharfun, 0);
2326 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2327 printcharfun, escapeflag);
2328 strout ("[default-value] ", -1, -1, printcharfun, 0);
2329 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2330 printcharfun, escapeflag);
2331 PRINTCHAR ('>');
2332 break;
2333
2334 case Lisp_Misc_Save_Value: 2270 case Lisp_Misc_Save_Value:
2335 strout ("#<save_value ", -1, -1, printcharfun, 0); 2271 strout ("#<save_value ", -1, -1, printcharfun, 0);
2336 sprintf(buf, "ptr=0x%08lx int=%d", 2272 sprintf(buf, "ptr=0x%08lx int=%d",
diff --git a/src/term.c b/src/term.c
index df7dc9ee464..20f746decdb 100644
--- a/src/term.c
+++ b/src/term.c
@@ -2244,7 +2244,7 @@ set_tty_color_mode (tty, f)
2244 struct tty_display_info *tty; 2244 struct tty_display_info *tty;
2245 struct frame *f; 2245 struct frame *f;
2246{ 2246{
2247 Lisp_Object tem, val, color_mode_spec; 2247 Lisp_Object tem, val;
2248 Lisp_Object color_mode; 2248 Lisp_Object color_mode;
2249 int mode; 2249 int mode;
2250 extern Lisp_Object Qtty_color_mode; 2250 extern Lisp_Object Qtty_color_mode;
@@ -2256,12 +2256,13 @@ set_tty_color_mode (tty, f)
2256 2256
2257 if (INTEGERP (val)) 2257 if (INTEGERP (val))
2258 color_mode = val; 2258 color_mode = val;
2259 else 2259 else if (SYMBOLP (tty_color_mode_alist))
2260 { 2260 {
2261 tem = (NILP (tty_color_mode_alist) ? Qnil 2261 tem = Fassq (val, Fsymbol_value (tty_color_mode_alist));
2262 : Fassq (val, XSYMBOL (tty_color_mode_alist)->value));
2263 color_mode = CONSP (tem) ? XCDR (tem) : Qnil; 2262 color_mode = CONSP (tem) ? XCDR (tem) : Qnil;
2264 } 2263 }
2264 else
2265 color_mode = Qnil;
2265 2266
2266 mode = INTEGERP (color_mode) ? XINT (color_mode) : 0; 2267 mode = INTEGERP (color_mode) ? XINT (color_mode) : 0;
2267 2268
diff --git a/src/xdisp.c b/src/xdisp.c
index 5a16d07944b..6728e01f3bd 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -11592,7 +11592,7 @@ static void
11592select_frame_for_redisplay (frame) 11592select_frame_for_redisplay (frame)
11593 Lisp_Object frame; 11593 Lisp_Object frame;
11594{ 11594{
11595 Lisp_Object tail, symbol, val; 11595 Lisp_Object tail, tem;
11596 Lisp_Object old = selected_frame; 11596 Lisp_Object old = selected_frame;
11597 struct Lisp_Symbol *sym; 11597 struct Lisp_Symbol *sym;
11598 11598
@@ -11600,20 +11600,18 @@ select_frame_for_redisplay (frame)
11600 11600
11601 selected_frame = frame; 11601 selected_frame = frame;
11602 11602
11603 do 11603 do {
11604 { 11604 for (tail = XFRAME (frame)->param_alist; CONSP (tail); tail = XCDR (tail))
11605 for (tail = XFRAME (frame)->param_alist; CONSP (tail); tail = XCDR (tail)) 11605 if (CONSP (XCAR (tail))
11606 if (CONSP (XCAR (tail)) 11606 && (tem = XCAR (XCAR (tail)),
11607 && (symbol = XCAR (XCAR (tail)), 11607 SYMBOLP (tem))
11608 SYMBOLP (symbol)) 11608 && (sym = indirect_variable (XSYMBOL (tem)),
11609 && (sym = indirect_variable (XSYMBOL (symbol)), 11609 sym->redirect == SYMBOL_LOCALIZED)
11610 val = sym->value, 11610 && sym->val.blv->frame_local)
11611 (BUFFER_LOCAL_VALUEP (val))) 11611 /* Use find_symbol_value rather than Fsymbol_value
11612 && XBUFFER_LOCAL_VALUE (val)->check_frame) 11612 to avoid an error if it is void. */
11613 /* Use find_symbol_value rather than Fsymbol_value 11613 find_symbol_value (tem);
11614 to avoid an error if it is void. */ 11614 } while (!EQ (frame, old) && (frame = old, 1));
11615 find_symbol_value (symbol);
11616 } while (!EQ (frame, old) && (frame = old, 1));
11617} 11615}
11618 11616
11619 11617
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-16 07:42:30 +0000