Initial git import
[sxemacs] / src / symbols.c
1 /* "intern" and friends -- moved here from lread.c and data.c
2    Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc.
3    Copyright (C) 1995, 2000 Ben Wing.
4    Copyright (C) 2004 Steve Youngs.
5
6 This file is part of SXEmacs
7
8 SXEmacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12
13 SXEmacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
20
21
22 /* Synched up with: FSF 19.30. */
23
24 /* This file has been Mule-ized. */
25
26 /* NOTE:
27
28    The value cell of a symbol can contain a simple value or one of
29    various symbol-value-magic objects.  Some of these objects can
30    chain into other kinds of objects.  Here is a table of possibilities:
31
32    1a) simple value
33    1b) Qunbound
34    1c) symbol-value-forward, excluding Qunbound
35    2) symbol-value-buffer-local -> 1a or 1b or 1c
36    3) symbol-value-lisp-magic -> 1a or 1b or 1c
37    4) symbol-value-lisp-magic -> symbol-value-buffer-local -> 1a or 1b or 1c
38    5) symbol-value-varalias
39    6) symbol-value-lisp-magic -> symbol-value-varalias
40
41    The "chain" of a symbol-value-buffer-local is its current_value slot.
42
43    The "chain" of a symbol-value-lisp-magic is its shadowed slot, which
44    applies for handler types without associated handlers.
45
46    All other fields in all the structures (including the "shadowed" slot
47    in a symbol-value-varalias) can *only* contain a simple value or Qunbound.
48
49 */
50
51 /* #### Ugh, though, this file does awful things with symbol-value-magic
52    objects.  This ought to be cleaned up. */
53
54 #include <config.h>
55 #include "lisp.h"
56
57 #include "buffer.h"             /* for Vbuffer_defaults */
58 #include "ui/console.h"
59 #include "elhash.h"
60
61 Lisp_Object Qad_advice_info, Qad_activate;
62
63 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound;
64 Lisp_Object Qlocal_predicate, Qmake_local;
65
66 Lisp_Object Qboundp, Qglobally_boundp, Qmakunbound;
67 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value;
68 Lisp_Object Qset_default, Qsetq_default;
69 Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable;
70 Lisp_Object Qkill_local_variable, Qkill_console_local_variable;
71 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console;
72 Lisp_Object Qlocal_variable_p;
73
74 Lisp_Object Qconst_integer, Qconst_boolean, Qconst_object;
75 Lisp_Object Qconst_specifier;
76 Lisp_Object Qdefault_buffer, Qcurrent_buffer, Qconst_current_buffer;
77 Lisp_Object Qdefault_console, Qselected_console, Qconst_selected_console;
78 Lisp_Object Qsymbol_macro, Qsetf;
79
80 static Lisp_Object maybe_call_magic_handler(Lisp_Object sym,
81                                             Lisp_Object funsym, int nargs, ...);
82 static Lisp_Object fetch_value_maybe_past_magic(Lisp_Object sym,
83                                                 Lisp_Object
84                                                 follow_past_lisp_magic);
85 static Lisp_Object *value_slot_past_magic(Lisp_Object sym);
86 static Lisp_Object follow_varalias_pointers(Lisp_Object symbol,
87                                             Lisp_Object follow_past_lisp_magic);
88
89 #define USE_BURTLEBURTLE_HASH 0
90 #define USE_HSIEH_HASH 1
91 #define USE_FORMER_HASH 0
92 \f
93 static Lisp_Object mark_symbol(Lisp_Object obj)
94 {
95         Lisp_Symbol *sym = XSYMBOL(obj);
96         Lisp_Object pname;
97
98         mark_object(sym->value);
99         mark_object(sym->function);
100         XSETSTRING(pname, sym->name);
101         mark_object(pname);
102         if (!symbol_next(sym))
103                 return sym->plist;
104         else {
105                 mark_object(sym->plist);
106                 /* Mark the rest of the symbols in the obarray hash-chain */
107                 sym = symbol_next(sym);
108                 XSETSYMBOL(obj, sym);
109                 return obj;
110         }
111 }
112
113 static const struct lrecord_description symbol_description[] = {
114         {XD_LISP_OBJECT, offsetof(Lisp_Symbol, next)},
115         {XD_LISP_OBJECT, offsetof(Lisp_Symbol, name)},
116         {XD_LISP_OBJECT, offsetof(Lisp_Symbol, value)},
117         {XD_LISP_OBJECT, offsetof(Lisp_Symbol, function)},
118         {XD_LISP_OBJECT, offsetof(Lisp_Symbol, plist)},
119         {XD_END}
120 };
121
122 /* Symbol plists are directly accessible, so we need to protect against
123    invalid property list structure */
124
125 static Lisp_Object symbol_getprop(Lisp_Object symbol, Lisp_Object property)
126 {
127         return external_plist_get(&XSYMBOL(symbol)->plist, property, 0,
128                                   ERROR_ME);
129 }
130
131 static int
132 symbol_putprop(Lisp_Object symbol, Lisp_Object property, Lisp_Object value)
133 {
134         external_plist_put(&XSYMBOL(symbol)->plist, property, value, 0,
135                            ERROR_ME);
136         return 1;
137 }
138
139 static int symbol_remprop(Lisp_Object symbol, Lisp_Object property)
140 {
141         return external_remprop(&XSYMBOL(symbol)->plist, property, 0, ERROR_ME);
142 }
143
144 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS("symbol", symbol,
145                                                mark_symbol, print_symbol,
146                                                0, 0, 0, symbol_description,
147                                                symbol_getprop,
148                                                symbol_putprop,
149                                                symbol_remprop,
150                                                Fsymbol_plist, Lisp_Symbol);
151 \f
152 /**********************************************************************/
153 /*                              Intern                                */
154 /**********************************************************************/
155
156 /* #### using a vector here is way bogus.  Use a hash table instead. */
157
158 Lisp_Object Vobarray;
159 Lisp_Object check_obarray(Lisp_Object obarray);
160
161 static Lisp_Object initial_obarray;
162
163 /* oblookup stores the bucket number here, for the sake of Funintern.  */
164
165 static int oblookup_last_bucket_number;
166
167 Lisp_Object
168 check_obarray(Lisp_Object obarray)
169 {
170         while (!VECTORP(obarray) || XVECTOR_LENGTH(obarray) == 0) {
171                 /* If Vobarray is now invalid, force it to be valid.  */
172                 if (EQ(Vobarray, obarray))
173                         Vobarray = initial_obarray;
174
175                 obarray = wrong_type_argument(Qvectorp, obarray);
176         }
177         return obarray;
178 }
179
180 Lisp_Object intern(const char *str)
181 {
182         Bytecount len = strlen(str);
183         const Bufbyte *buf = (const Bufbyte *)str;
184         Lisp_Object obarray = Vobarray;
185
186         if (!VECTORP(obarray) || XVECTOR_LENGTH(obarray) == 0)
187                 obarray = check_obarray(obarray);
188
189         {
190                 Lisp_Object tem = oblookup(obarray, buf, len);
191                 if (SYMBOLP(tem))
192                         return tem;
193         }
194
195         return Fintern(make_string(buf, len), obarray);
196 }
197
198 DEFUN("intern", Fintern, 1, 2, 0,       /*
199 Return the canonical symbol whose name is STRING.
200 If there is none, one is created by this function and returned.
201 Optional second argument OBARRAY specifies the obarray to use;
202 it defaults to the value of the variable `obarray'.
203 */
204       (string, obarray))
205 {
206         Lisp_Object object, *ptr;
207         Lisp_Symbol *symbol;
208         Bytecount len;
209
210         if (NILP(obarray))
211                 obarray = Vobarray;
212         obarray = check_obarray(obarray);
213
214         CHECK_STRING(string);
215
216         len = XSTRING_LENGTH(string);
217         object = oblookup(obarray, XSTRING_DATA(string), len);
218         if (!INTP(object))
219                 /* Found it */
220                 return object;
221
222         ptr = &XVECTOR_DATA(obarray)[XINT(object)];
223
224         object = Fmake_symbol(string);
225         symbol = XSYMBOL(object);
226
227         if (SYMBOLP(*ptr))
228                 symbol_next(symbol) = XSYMBOL(*ptr);
229         else
230                 symbol_next(symbol) = 0;
231         *ptr = object;
232
233         if (string_byte(symbol_name(symbol), 0) == ':' && EQ(obarray, Vobarray)) {
234                 /* The LISP way is to put keywords in their own package, but we
235                    don't have packages, so we do something simpler.  Someday,
236                    maybe we'll have packages and then this will be reworked.
237                    --Stig. */
238                 symbol_value(symbol) = object;
239         }
240
241         return object;
242 }
243
244 DEFUN("intern-soft", Fintern_soft, 1, 2, 0,     /*
245 Return the canonical symbol named NAME, or nil if none exists.
246 NAME may be a string or a symbol.  If it is a symbol, that exact
247 symbol is searched for.
248 Optional second argument OBARRAY specifies the obarray to use;
249 it defaults to the value of the variable `obarray'.
250 */
251       (name, obarray))
252 {
253         /* #### Bug!  (intern-soft "nil") returns nil.  Perhaps we should
254            add a DEFAULT-IF-NOT-FOUND arg, like in get.  */
255         Lisp_Object tem;
256         Lisp_String *string;
257
258         if (NILP(obarray))
259                 obarray = Vobarray;
260         obarray = check_obarray(obarray);
261
262         if (!SYMBOLP(name)) {
263                 CHECK_STRING(name);
264                 string = XSTRING(name);
265         } else
266                 string = symbol_name(XSYMBOL(name));
267
268         tem = oblookup(obarray, string_data(string), string_length(string));
269         if (INTP(tem) || (SYMBOLP(name) && !EQ(name, tem)))
270                 return Qnil;
271         else
272                 return tem;
273 }
274 \f
275 DEFUN("unintern", Funintern, 1, 2, 0,   /*
276 Delete the symbol named NAME, if any, from OBARRAY.
277 The value is t if a symbol was found and deleted, nil otherwise.
278 NAME may be a string or a symbol.  If it is a symbol, that symbol
279 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
280 OBARRAY defaults to the value of the variable `obarray'.
281 */
282       (name, obarray))
283 {
284         Lisp_Object tem;
285         Lisp_String *string;
286         int hash;
287
288         if (NILP(obarray))
289                 obarray = Vobarray;
290         obarray = check_obarray(obarray);
291
292         if (SYMBOLP(name))
293                 string = symbol_name(XSYMBOL(name));
294         else {
295                 CHECK_STRING(name);
296                 string = XSTRING(name);
297         }
298
299         tem = oblookup(obarray, string_data(string), string_length(string));
300         if (INTP(tem))
301                 return Qnil;
302         /* If arg was a symbol, don't delete anything but that symbol itself.  */
303         if (SYMBOLP(name) && !EQ(name, tem))
304                 return Qnil;
305
306         hash = oblookup_last_bucket_number;
307
308         if (EQ(XVECTOR_DATA(obarray)[hash], tem)) {
309                 if (XSYMBOL(tem)->next)
310                         XSETSYMBOL(XVECTOR_DATA(obarray)[hash],
311                                    XSYMBOL(tem)->next);
312                 else
313                         XVECTOR_DATA(obarray)[hash] = Qzero;
314         } else {
315                 Lisp_Object tail, following;
316
317                 for (tail = XVECTOR_DATA(obarray)[hash];
318                      XSYMBOL(tail)->next; tail = following) {
319                         XSETSYMBOL(following, XSYMBOL(tail)->next);
320                         if (EQ(following, tem)) {
321                                 XSYMBOL(tail)->next = XSYMBOL(following)->next;
322                                 break;
323                         }
324                 }
325         }
326         return Qt;
327 }
328 \f
329 /* Return the symbol in OBARRAY whose names matches the string
330    of SIZE characters at PTR.  If there is no such symbol in OBARRAY,
331    return the index into OBARRAY that the string hashes to.
332
333    Also store the bucket number in oblookup_last_bucket_number.  */
334
335 Lisp_Object oblookup(Lisp_Object obarray, const Bufbyte * ptr, Bytecount size)
336 {
337         hcode_t hash;
338         size_t obsize;
339         Lisp_Symbol *tail;
340         Lisp_Object bucket;
341
342         if (!VECTORP(obarray) || (obsize = XVECTOR_LENGTH(obarray)) == 0) {
343                 obarray = check_obarray(obarray);
344                 obsize = XVECTOR_LENGTH(obarray);
345         }
346         hash = hash_string(ptr, size) % obsize;
347         oblookup_last_bucket_number = hash;
348         bucket = XVECTOR_DATA(obarray)[hash];
349         if (ZEROP(bucket)) {
350                 ;
351         } else if (!SYMBOLP(bucket)) {
352                 /* Like CADR error message */
353                 error("Bad data in guts of obarray");
354         } else {
355                 for (tail = XSYMBOL(bucket);;) {
356                         if (string_length(tail->name) == size &&
357                             !memcmp(string_data(tail->name), ptr, size)) {
358                                 XSETSYMBOL(bucket, tail);
359                                 return bucket;
360                         }
361                         tail = symbol_next(tail);
362                         if (!tail)
363                                 break;
364                 }
365         }
366         return make_int(hash);
367 }
368
369 #if 0                           /* Emacs 19.34 */
370 int hash_string(const Bufbyte * ptr, Bytecount len)
371 {
372         const Bufbyte *p = ptr;
373         const Bufbyte *end = p + len;
374         Bufbyte c;
375         int hash = 0;
376
377         while (p != end) {
378                 c = *p++;
379                 if (c >= 0140)
380                         c -= 40;
381                 hash = ((hash << 3) + (hash >> 28) + c);
382         }
383         return hash & 07777777777;
384 }
385 #endif
386
387 #if USE_BURTLEBURTLE_HASH
388
389 typedef  unsigned long  int  ub4;   /* unsigned 4-byte quantities */
390 typedef  unsigned       char ub1;   /* unsigned 1-byte quantities */
391
392 #define hashsize(n) ((ub4)1<<(n))
393 #define hashmask(n) (hashsize(n)-1)
394
395 /*
396 --------------------------------------------------------------------
397 mix -- mix 3 32-bit values reversibly.
398 For every delta with one or two bits set, and the deltas of all three
399   high bits or all three low bits, whether the original value of a,b,c
400   is almost all zero or is uniformly distributed,
401 * If mix() is run forward or backward, at least 32 bits in a,b,c
402   have at least 1/4 probability of changing.
403 * If mix() is run forward, every bit of c will change between 1/3 and
404   2/3 of the time.  (Well, 22/100 and 78/100 for some 2-bit deltas.)
405 mix() was built out of 36 single-cycle latency instructions in a 
406   structure that could supported 2x parallelism, like so:
407       a -= b; 
408       a -= c; x = (c>>13);
409       b -= c; a ^= x;
410       b -= a; x = (a<<8);
411       c -= a; b ^= x;
412       c -= b; x = (b>>13);
413       ...
414   Unfortunately, superscalar Pentiums and Sparcs can't take advantage 
415   of that parallelism.  They've also turned some of those single-cycle
416   latency instructions into multi-cycle latency instructions.  Still,
417   this is the fastest good hash I could find.  There were about 2^^68
418   to choose from.  I only looked at a billion or so.
419 --------------------------------------------------------------------
420 */
421 #define mix(a,b,c) \
422         {                                       \
423                 a -= b; a -= c; a ^= (c>>13);   \
424                 b -= c; b -= a; b ^= (a<<8);    \
425                 c -= a; c -= b; c ^= (b>>13);   \
426                 a -= b; a -= c; a ^= (c>>12);   \
427                 b -= c; b -= a; b ^= (a<<16);   \
428                 c -= a; c -= b; c ^= (b>>5);    \
429                 a -= b; a -= c; a ^= (c>>3);    \
430                 b -= c; b -= a; b ^= (a<<10);   \
431                 c -= a; c -= b; c ^= (b>>15);   \
432         }
433
434 /*
435 --------------------------------------------------------------------
436 hash() -- hash a variable-length key into a 32-bit value
437   k       : the key (the unaligned variable-length array of bytes)
438   len     : the length of the key, counting by bytes
439   initval : can be any 4-byte value
440 Returns a 32-bit value.  Every bit of the key affects every bit of
441 the return value.  Every 1-bit and 2-bit delta achieves avalanche.
442 About 6*len+35 instructions.
443
444 The best hash table sizes are powers of 2.  There is no need to do
445 mod a prime (mod is sooo slow!).  If you need less than 32 bits,
446 use a bitmask.  For example, if you need only 10 bits, do
447   h = (h & hashmask(10));
448 In which case, the hash table should have hashsize(10) elements.
449
450 If you are hashing n strings (ub1 **)k, do it like this:
451   for (i=0, h=0; i<n; ++i) h = hash( k[i], len[i], h);
452
453 By Bob Jenkins, 1996.  bob_jenkins@burtleburtle.net.  You may use this
454 code any way you wish, private, educational, or commercial.  It's free.
455
456 See http://burtleburtle.net/bob/hash/evahash.html
457 Use for hash table lookup, or anything where one collision in 2^^32 is
458 acceptable.  Do NOT use for cryptographic purposes.
459 --------------------------------------------------------------------
460 */
461
462 hcode_t
463 hash_string(const Bufbyte *ptr, Bytecount length)
464 /* this originally had support for an initval, which could have been the
465  * previous hash or an arbitray value ... this way, Jenkins supports hashing
466  * an array of strings or does multi-key hashes ... however this is a bit
467  * beyond the scope of how we use hashes, that's why the signature is as it is
468  * -hrop */
469 {
470         register long int a, b, c, len;
471
472         /* Set up the internal state */
473         len = length;
474         a = b = 0x9e3779b9;  /* the golden ratio; an arbitrary value */
475         c = 0xDEADBEEF;      /* the previous hash value */
476
477         /*---------------------------------------- handle most of the key */
478         while (len >= 12)
479         {
480                 a += (ptr[0] +((int)ptr[1]<<8)
481                       +((int)ptr[2]<<16) +((int)ptr[3]<<24));
482                 b += (ptr[4] +((int)ptr[5]<<8)
483                       +((int)ptr[6]<<16) +((int)ptr[7]<<24));
484                 c += (ptr[8] +((int)ptr[9]<<8)
485                       +((int)ptr[10]<<16)+((int)ptr[11]<<24));
486                 mix(a,b,c);
487                 ptr += 12; len -= 12;
488         }
489
490         /*------------------------------------- handle the last 11 bytes */
491         c += length;
492         switch(len) {              /* all the case statements fall through */
493         case 11: c+=((int)ptr[10]<<24);
494         case 10: c+=((int)ptr[9]<<16);
495         case 9 : c+=((int)ptr[8]<<8);
496                 /* the first byte of c is reserved for the length */
497         case 8 : b+=((int)ptr[7]<<24);
498         case 7 : b+=((int)ptr[6]<<16);
499         case 6 : b+=((int)ptr[5]<<8);
500         case 5 : b+=ptr[4];
501         case 4 : a+=((int)ptr[3]<<24);
502         case 3 : a+=((int)ptr[2]<<16);
503         case 2 : a+=((int)ptr[1]<<8);
504         case 1 : a+=ptr[0];
505                 /* case 0: nothing left to add */
506         }
507         mix(a,b,c);
508         /*-------------------------------------------- report the result */
509         /* load a long -1 and shift it to the right once
510          * normally this isn't needed, but obviously there's lisp code
511          * out there which converts this to an EMACS_INT, in which case
512          * we must not use the most significant bit as otherwise this
513          * would be handled as bignum */
514         return c & (const hcode_t)(-1UL >> 1);
515 }
516
517 #elif USE_HSIEH_HASH
518
519 #undef get16bits
520 #if (defined(__GNUC__) && defined(__i386__))
521 #define get16bits(d) (*((const uint16_t *) (d)))
522 #endif
523 #if !defined (get16bits)
524 #define get16bits(d) ((((const uint8_t *)(d))[1] << UINT32_C(8))\
525                       +((const uint8_t *)(d))[0])
526 #endif
527
528 hcode_t
529 hash_string(const Bufbyte *data, Bytecount len)
530 {
531         hcode_t hash = len, tmp, rem;
532
533         if (len <= 0 || data == NULL)
534                 return 0;
535
536         rem = len & 3;
537         len >>= 2;
538
539         /* Main loop */
540         for (; len > 0; len--) {
541                 hash  += get16bits (data);
542                 tmp    = (get16bits (data+2) << 11) ^ hash;
543                 hash   = (hash << 16) ^ tmp;
544                 data  += 2*sizeof (uint16_t);
545                 hash  += hash >> 11;
546         }
547
548         /* Handle end cases */
549         switch (rem) {
550         case 3: hash += get16bits (data);
551                 hash ^= hash << 16;
552                 hash ^= data[sizeof (uint16_t)] << 18;
553                 hash += hash >> 11;
554                 break;
555         case 2: hash += get16bits (data);
556                 hash ^= hash << 11;
557                 hash += hash >> 17;
558                 break;
559         case 1: hash += *data;
560                 hash ^= hash << 10;
561                 hash += hash >> 1;
562         default:
563                 break;
564         }
565
566         /* Force "avalanching" of final 127 bits */
567         hash ^= hash << 3;
568         hash += hash >> 5;
569         hash ^= hash << 4;
570         hash += hash >> 17;
571         hash ^= hash << 25;
572         hash += hash >> 6;
573
574         /* load a long -1 and shift it to the right once
575          * normally this isn't needed, but obviously there's lisp code
576          * out there which converts this to an EMACS_INT, in which case
577          * we must not use the most significant bit as otherwise this
578          * would be handled as bignum */
579         return hash & (const hcode_t)(-1UL >> 1);
580 }
581
582 #undef get16bits
583
584 #else
585
586 /* derived from hashpjw, Dragon Book P436. */
587 hcode_t
588 hash_string(const Bufbyte * ptr, Bytecount len)
589 {
590         hcode_t hash = 0;
591
592         while (len-- > 0) {
593                 int g;
594                 hash = (hash << 4) + *ptr++;
595                 g = hash & 0xf0000000;
596                 if (g)
597                         hash = (hash ^ (g >> 24)) ^ g;
598         }
599         /* load a long -1 and shift it to the right once
600          * normally this isn't needed, but obviously there's lisp code
601          * out there which converts this to an EMACS_INT, in which case
602          * we must not use the most significant bit as otherwise this
603          * would be handled as bignum */
604         return c & (const hcode_t)(-1UL >> 1);
605 }
606
607 #endif
608
609 DEFUN ("subr-name", Fsubr_name, 1, 1, 0, /*
610 Return name of function SUBR.
611 SUBR must be a built-in function.  
612 */
613        (subr))
614 {
615         const char *name;
616         if (!SUBRP (subr))
617                 wrong_type_argument (Qsubrp, subr);
618         name = XSUBR (subr)->name;
619         return make_string ((Bufbyte *)name, strlen (name));
620 }
621
622
623 /* Map FN over OBARRAY.  The mapping is stopped when FN returns a
624    non-zero value.  */
625 void
626 map_obarray(Lisp_Object obarray, int (*fn) (Lisp_Object, void *), void *arg)
627 {
628         REGISTER int i;
629
630         CHECK_VECTOR(obarray);
631         for (i = XVECTOR_LENGTH(obarray) - 1; i >= 0; i--) {
632                 Lisp_Object tail = XVECTOR_DATA(obarray)[i];
633                 if (SYMBOLP(tail))
634                         while (1) {
635                                 Lisp_Symbol *next;
636                                 if ((*fn) (tail, arg))
637                                         return;
638                                 next = symbol_next(XSYMBOL(tail));
639                                 if (!next)
640                                         break;
641                                 XSETSYMBOL(tail, next);
642                         }
643         }
644 }
645
646 static int mapatoms_1(Lisp_Object sym, void *arg)
647 {
648         call1(*(Lisp_Object *) arg, sym);
649         return 0;
650 }
651
652 DEFUN("mapatoms", Fmapatoms, 1, 2, 0,   /*
653 Call FUNCTION on every symbol in OBARRAY.
654 OBARRAY defaults to the value of `obarray'.
655 */
656       (function, obarray))
657 {
658         struct gcpro gcpro1;
659
660         if (NILP(obarray))
661                 obarray = Vobarray;
662         obarray = check_obarray(obarray);
663
664         GCPRO1(obarray);
665         map_obarray(obarray, mapatoms_1, &function);
666         UNGCPRO;
667         return Qnil;
668 }
669 \f
670 /**********************************************************************/
671 /*                              Apropos                               */
672 /**********************************************************************/
673
674 struct appropos_mapper_closure {
675         Lisp_Object regexp;
676         Lisp_Object predicate;
677         Lisp_Object accumulation;
678 };
679
680 static int apropos_mapper(Lisp_Object symbol, void *arg)
681 {
682         struct appropos_mapper_closure *closure =
683             (struct appropos_mapper_closure *)arg;
684         Bytecount match = fast_lisp_string_match(closure->regexp,
685                                                  Fsymbol_name(symbol));
686
687         if (match >= 0 &&
688             (NILP(closure->predicate) ||
689              !NILP(call1(closure->predicate, symbol))))
690                 closure->accumulation = Fcons(symbol, closure->accumulation);
691
692         return 0;
693 }
694
695 DEFUN("apropos-internal", Fapropos_internal, 1, 2, 0,   /*
696 Return a list of all symbols whose names contain match for REGEXP.
697 If optional 2nd arg PREDICATE is non-nil, only symbols for which
698 \(funcall PREDICATE SYMBOL) returns non-nil are returned.
699 */
700       (regexp, predicate))
701 {
702         struct appropos_mapper_closure closure;
703         struct gcpro gcpro1;
704
705         CHECK_STRING(regexp);
706
707         closure.regexp = regexp;
708         closure.predicate = predicate;
709         closure.accumulation = Qnil;
710         GCPRO1(closure.accumulation);
711         map_obarray(Vobarray, apropos_mapper, &closure);
712         closure.accumulation = Fsort(closure.accumulation, Qstring_lessp);
713         UNGCPRO;
714         return closure.accumulation;
715 }
716 \f
717 /* Extract and set components of symbols */
718
719 static void set_up_buffer_local_cache(Lisp_Object sym,
720                                       struct symbol_value_buffer_local *bfwd,
721                                       struct buffer *buf,
722                                       Lisp_Object new_alist_el, int set_it_p);
723
724 DEFUN("boundp", Fboundp, 1, 1, 0,       /*
725 Return t if SYMBOL's value is not void.
726 */
727       (symbol))
728 {
729         CHECK_SYMBOL(symbol);
730         return UNBOUNDP(find_symbol_value(symbol)) ? Qnil : Qt;
731 }
732
733 DEFUN("globally-boundp", Fglobally_boundp, 1, 1, 0,     /*
734 Return t if SYMBOL has a global (non-bound) value.
735 This is for the byte-compiler; you really shouldn't be using this.
736 */
737       (symbol))
738 {
739         CHECK_SYMBOL(symbol);
740         return UNBOUNDP(top_level_value(symbol)) ? Qnil : Qt;
741 }
742
743 DEFUN("fboundp", Ffboundp, 1, 1, 0,     /*
744 Return t if SYMBOL's function definition is not void.
745 */
746       (symbol))
747 {
748         CHECK_SYMBOL(symbol);
749         return UNBOUNDP(XSYMBOL(symbol)->function) ? Qnil : Qt;
750 }
751
752 /* Return non-zero if SYM's value or function (the current contents of
753    which should be passed in as VAL) is constant, i.e. unsettable. */
754
755 static int symbol_is_constant(Lisp_Object sym, Lisp_Object val)
756 {
757         /* #### - I wonder if it would be better to just have a new magic value
758            type and make nil, t, and all keywords have that same magic
759            constant_symbol value.  This test is awfully specific about what is
760            constant and what isn't.  --Stig */
761         if (EQ(sym, Qnil) || EQ(sym, Qt))
762                 return 1;
763
764         if (SYMBOL_VALUE_MAGIC_P(val))
765                 switch (XSYMBOL_VALUE_MAGIC_TYPE(val)) {
766                 case SYMVAL_CONST_OBJECT_FORWARD:
767                 case SYMVAL_CONST_SPECIFIER_FORWARD:
768                 case SYMVAL_CONST_FIXNUM_FORWARD:
769                 case SYMVAL_CONST_BOOLEAN_FORWARD:
770                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
771                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
772                         return 1;
773
774                         /* list all cases here */
775                 case SYMVAL_FIXNUM_FORWARD:
776                 case SYMVAL_BOOLEAN_FORWARD:
777                 case SYMVAL_OBJECT_FORWARD:
778                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
779                 case SYMVAL_CURRENT_BUFFER_FORWARD:
780                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
781                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
782                 case SYMVAL_UNBOUND_MARKER:
783                 case SYMVAL_BUFFER_LOCAL:
784                 case SYMVAL_SOME_BUFFER_LOCAL:
785                 case SYMVAL_LISP_MAGIC:
786                 case SYMVAL_VARALIAS:
787
788                 default:
789                         break;  /* Warning suppression */
790                 }
791
792         /* We don't return true for keywords here because they are handled
793            specially by reject_constant_symbols().  */
794         return 0;
795 }
796
797 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
798    non-zero) to NEWVAL.  Make sure this is allowed.
799    FOLLOW_PAST_LISP_MAGIC specifies whether we delve past
800    symbol-value-lisp-magic objects.  */
801
802 void
803 reject_constant_symbols(Lisp_Object sym, Lisp_Object newval, int function_p,
804                         Lisp_Object follow_past_lisp_magic)
805 {
806         Lisp_Object val =
807             (function_p ? XSYMBOL(sym)->function
808              : fetch_value_maybe_past_magic(sym, follow_past_lisp_magic));
809
810         if (SYMBOL_VALUE_MAGIC_P(val) &&
811             XSYMBOL_VALUE_MAGIC_TYPE(val) == SYMVAL_CONST_SPECIFIER_FORWARD)
812                 signal_simple_error
813                     ("Use `set-specifier' to change a specifier's value", sym);
814
815         if (symbol_is_constant(sym, val)
816             || (SYMBOL_IS_KEYWORD(sym) && !EQ(newval, sym)))
817                 signal_error(Qsetting_constant,
818                              UNBOUNDP(newval) ? list1(sym) : list2(sym,
819                                                                    newval));
820 }
821
822 /* Verify that it's ok to make SYM buffer-local.  This rejects
823    constants and default-buffer-local variables.  FOLLOW_PAST_LISP_MAGIC
824    specifies whether we delve into symbol-value-lisp-magic objects.
825    (Should be a symbol indicating what action is being taken; that way,
826    we don't delve if there's a handler for that action, but do otherwise.) */
827
828 static void
829 verify_ok_for_buffer_local(Lisp_Object sym, Lisp_Object follow_past_lisp_magic)
830 {
831         Lisp_Object val =
832             fetch_value_maybe_past_magic(sym, follow_past_lisp_magic);
833
834         if (symbol_is_constant(sym, val))
835                 goto not_ok;
836         if (SYMBOL_VALUE_MAGIC_P(val))
837                 switch (XSYMBOL_VALUE_MAGIC_TYPE(val)) {
838                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
839                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
840                         /* #### It's theoretically possible for it to be reasonable
841                            to have both console-local and buffer-local variables,
842                            but I don't want to consider that right now. */
843                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
844                         goto not_ok;
845
846                         /* list all cases here */
847                 case SYMVAL_FIXNUM_FORWARD:
848                 case SYMVAL_CONST_FIXNUM_FORWARD:
849                 case SYMVAL_BOOLEAN_FORWARD:
850                 case SYMVAL_CONST_BOOLEAN_FORWARD:
851                 case SYMVAL_OBJECT_FORWARD:
852                 case SYMVAL_CONST_OBJECT_FORWARD:
853                 case SYMVAL_CONST_SPECIFIER_FORWARD:
854                 case SYMVAL_CURRENT_BUFFER_FORWARD:
855                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
856                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
857                 case SYMVAL_UNBOUND_MARKER:
858                 case SYMVAL_BUFFER_LOCAL:
859                 case SYMVAL_SOME_BUFFER_LOCAL:
860                 case SYMVAL_LISP_MAGIC:
861                 case SYMVAL_VARALIAS:
862                 default:
863                         break;  /* Warning suppression */
864                 }
865
866         return;
867
868       not_ok:
869         signal_error(Qerror,
870                      list2(build_string("Symbol may not be buffer-local"),
871                            sym));
872 }
873
874 DEFUN("makunbound", Fmakunbound, 1, 1, 0,       /*
875 Make SYMBOL's value be void.
876 */
877       (symbol))
878 {
879         Fset(symbol, Qunbound);
880         return symbol;
881 }
882
883 DEFUN("fmakunbound", Ffmakunbound, 1, 1, 0,     /*
884 Make SYMBOL's function definition be void.
885 */
886       (symbol))
887 {
888         CHECK_SYMBOL(symbol);
889         reject_constant_symbols(symbol, Qunbound, 1, Qt);
890         XSYMBOL(symbol)->function = Qunbound;
891         return symbol;
892 }
893
894 DEFUN("symbol-function", Fsymbol_function, 1, 1, 0,     /*
895 Return SYMBOL's function definition.  Error if that is void.
896 */
897       (symbol))
898 {
899         CHECK_SYMBOL(symbol);
900         if (UNBOUNDP(XSYMBOL(symbol)->function))
901                 signal_void_function_error(symbol);
902         return XSYMBOL(symbol)->function;
903 }
904
905 DEFUN("symbol-plist", Fsymbol_plist, 1, 1, 0,   /*
906 Return SYMBOL's property list.
907 */
908       (symbol))
909 {
910         CHECK_SYMBOL(symbol);
911         return XSYMBOL(symbol)->plist;
912 }
913
914 DEFUN("symbol-name", Fsymbol_name, 1, 1, 0,     /*
915 Return SYMBOL's name, a string.
916 */
917       (symbol))
918 {
919         Lisp_Object name;
920
921         CHECK_SYMBOL(symbol);
922         XSETSTRING(name, XSYMBOL(symbol)->name);
923
924         /* This is a CRUTCH, we need some better mechanism to
925          * initialize data like morphisms */
926         XSTRING(name)->lheader.morphisms = 0;
927
928         return name;
929 }
930
931 DEFUN("fset", Ffset, 2, 2, 0,   /*
932 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
933 */
934       (symbol, newdef))
935 {
936         /* This function can GC */
937         CHECK_SYMBOL(symbol);
938         reject_constant_symbols(symbol, newdef, 1, Qt);
939         if (!NILP(Vautoload_queue) && !UNBOUNDP(XSYMBOL(symbol)->function))
940                 Vautoload_queue =
941                     Fcons(Fcons(symbol, XSYMBOL(symbol)->function),
942                           Vautoload_queue);
943         XSYMBOL(symbol)->function = newdef;
944         /* Handle automatic advice activation */
945         if (CONSP(XSYMBOL(symbol)->plist) &&
946             !NILP(Fget(symbol, Qad_advice_info, Qnil))) {
947                 call2(Qad_activate, symbol, Qnil);
948                 newdef = XSYMBOL(symbol)->function;
949         }
950         return newdef;
951 }
952
953 /* FSFmacs */
954 DEFUN("define-function", Fdefine_function, 2, 2, 0,     /*
955 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
956 Associates the function with the current load file, if any.
957 */
958       (symbol, newdef))
959 {
960         /* This function can GC */
961         Ffset(symbol, newdef);
962         LOADHIST_ATTACH (Fcons (Qdefun, symbol));
963         return newdef;
964 }
965
966 DEFUN ("special-form-p", Fspecial_form_p, 1, 1, 0, /*
967 Return whether SUBR is a special form.
968
969 A special form is a built-in function (a subr, that is a function
970 implemented in C, not Lisp) which does not necessarily evaluate all its
971 arguments.  Much of the basic XEmacs Lisp syntax is implemented by means of
972 special forms; examples are `let', `condition-case', `defun', `setq' and so
973 on.
974
975 If you intend to write a Lisp function that does not necessarily evaluate
976 all its arguments, the portable (across emacs variants, and across Lisp
977 implementations) way to go about it is to write a macro instead.  See
978 `defmacro' and `backquote'.
979 */
980        (subr))
981 {
982         subr = indirect_function (subr, 0);
983         return (SUBRP (subr) && XSUBR (subr)->max_args == UNEVALLED) ? Qt : Qnil;
984 }
985
986 DEFUN("setplist", Fsetplist, 2, 2, 0,   /*
987 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
988 */
989       (symbol, newplist))
990 {
991         CHECK_SYMBOL(symbol);
992 #if 0                           /* Inserted for debugging 6/28/1997 -slb */
993         /* Somebody is setting a property list of integer 0, who? */
994         /* Not this way apparently. */
995         if (EQ(newplist, Qzero))
996                 abort();
997 #endif
998
999         XSYMBOL(symbol)->plist = newplist;
1000         return newplist;
1001 }
1002 \f
1003 /**********************************************************************/
1004 /*                           symbol-value                             */
1005 /**********************************************************************/
1006
1007 /* If the contents of the value cell of a symbol is one of the following
1008    three types of objects, then the symbol is "magic" in that setting
1009    and retrieving its value doesn't just set or retrieve the raw
1010    contents of the value cell.  None of these objects can escape to
1011    the user level, so there is no loss of generality.
1012
1013    If a symbol is "unbound", then the contents of its value cell is
1014    Qunbound.  Despite appearances, this is *not* a symbol, but is a
1015    symbol-value-forward object.  This is so that printing it results
1016    in "INTERNAL OBJECT (SXEmacs bug?)", in case it leaks to Lisp, somehow.
1017
1018    Logically all of the following objects are "symbol-value-magic"
1019    objects, and there are some games played w.r.t. this (#### this
1020    should be cleaned up).  SYMBOL_VALUE_MAGIC_P is true for all of
1021    the object types.  XSYMBOL_VALUE_MAGIC_TYPE returns the type of
1022    symbol-value-magic object.  There are more than three types
1023    returned by this macro: in particular, symbol-value-forward
1024    has eight subtypes, and symbol-value-buffer-local has two.  See
1025    symeval.h.
1026
1027    1. symbol-value-forward
1028
1029    symbol-value-forward is used for variables whose actual contents
1030    are stored in a C variable of some sort, and for Qunbound.  The
1031    lcheader.next field (which is only used to chain together free
1032    lcrecords) holds a pointer to the actual C variable.  Included
1033    in this type are "buffer-local" variables that are actually
1034    stored in the buffer object itself; in this case, the "pointer"
1035    is an offset into the struct buffer structure.
1036
1037    The subtypes are as follows:
1038
1039    SYMVAL_OBJECT_FORWARD:
1040       (declare with DEFVAR_LISP)
1041    The value of this variable is stored in a C variable of type
1042    "Lisp_Object".  Setting this variable sets the C variable.
1043    Accessing this variable retrieves a value from the C variable.
1044    These variables can be buffer-local -- in this case, the
1045    raw symbol-value field gets converted into a
1046    symbol-value-buffer-local, whose "current_value" slot contains
1047    the symbol-value-forward. (See below.)
1048
1049 SYMVAL_FIXNUM_FORWARD:
1050    (declare with DEFVAR_INT)
1051    Similar to SYMVAL_OBJECT_FORWARD except that the C variable
1052    is of type "Fixnum", a typedef for "EMACS_INT", and the corresponding
1053    lisp variable is always the corresponding integer.
1054
1055 SYMVAL_BOOLEAN_FORWARD:
1056    (declare with DEFVAR_BOOL)
1057    Similar to SYMVAL_OBJECT_FORWARD except that the C variable
1058    is of type "int" and is a boolean.
1059
1060 SYMVAL_CONST_OBJECT_FORWARD:
1061 SYMVAL_CONST_FIXNUM_FORWARD:
1062 SYMVAL_CONST_BOOLEAN_FORWARD:
1063    (declare with DEFVAR_CONST_LISP, DEFVAR_CONST_INT, or
1064     DEFVAR_CONST_BOOL)
1065    Similar to SYMVAL_OBJECT_FORWARD, SYMVAL_FIXNUM_FORWARD, or
1066    SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
1067    be changed.
1068
1069 SYMVAL_CONST_SPECIFIER_FORWARD:
1070    (declare with DEFVAR_SPECIFIER)
1071    Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error
1072    message you get when attempting to set the value says to use
1073    `set-specifier' instead.
1074
1075 SYMVAL_CURRENT_BUFFER_FORWARD:
1076    (declare with DEFVAR_BUFFER_LOCAL)
1077    This is used for built-in buffer-local variables -- i.e.
1078    Lisp variables whose value is stored in the "struct buffer".
1079    Variables of this sort always forward into C "Lisp_Object"
1080    fields (although there's no reason in principle that other
1081    types for ints and booleans couldn't be added).  Note that
1082    some of these variables are automatically local in each
1083    buffer, while some are only local when they become set
1084    (similar to `make-variable-buffer-local').  In these latter
1085    cases, of course, the default value shows through in all
1086    buffers in which the variable doesn't have a local value.
1087    This is implemented by making sure the "struct buffer" field
1088    always contains the correct value (whether it's local or
1089    a default) and maintaining a mask in the "struct buffer"
1090    indicating which fields are local.  When `set-default' is
1091    called on a variable that's not always local to all buffers,
1092    it loops through each buffer and sets the corresponding
1093    field in each buffer without a local value for the field,
1094    according to the mask.
1095
1096    Calling `make-local-variable' on a variable of this sort
1097    only has the effect of maybe changing the current buffer's mask.
1098    Calling `make-variable-buffer-local' on a variable of this
1099    sort has no effect at all.
1100
1101 SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1102    (declare with DEFVAR_CONST_BUFFER_LOCAL)
1103    Same as SYMVAL_CURRENT_BUFFER_FORWARD except that the
1104    value cannot be set.
1105
1106 SYMVAL_DEFAULT_BUFFER_FORWARD:
1107    (declare with DEFVAR_BUFFER_DEFAULTS)
1108    This is used for the Lisp variables that contain the
1109    default values of built-in buffer-local variables.  Setting
1110    or referencing one of these variables forwards into a slot
1111    in the special struct buffer Vbuffer_defaults.
1112
1113 SYMVAL_UNBOUND_MARKER:
1114    This is used for only one object, Qunbound.
1115
1116 SYMVAL_SELECTED_CONSOLE_FORWARD:
1117    (declare with DEFVAR_CONSOLE_LOCAL)
1118    This is used for built-in console-local variables -- i.e.
1119    Lisp variables whose value is stored in the "struct console".
1120    These work just like built-in buffer-local variables.
1121    However, calling `make-local-variable' or
1122    `make-variable-buffer-local' on one of these variables
1123    is currently disallowed because that would entail having
1124    both console-local and buffer-local variables, which is
1125    trickier to implement.
1126
1127 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1128    (declare with DEFVAR_CONST_CONSOLE_LOCAL)
1129    Same as SYMVAL_SELECTED_CONSOLE_FORWARD except that the
1130    value cannot be set.
1131
1132 SYMVAL_DEFAULT_CONSOLE_FORWARD:
1133    (declare with DEFVAR_CONSOLE_DEFAULTS)
1134    This is used for the Lisp variables that contain the
1135    default values of built-in console-local variables.  Setting
1136    or referencing one of these variables forwards into a slot
1137    in the special struct console Vconsole_defaults.
1138
1139 2. symbol-value-buffer-local
1140
1141 symbol-value-buffer-local is used for variables that have had
1142 `make-local-variable' or `make-variable-buffer-local' applied
1143 to them.  This object contains an alist mapping buffers to
1144 values.  In addition, the object contains a "current value",
1145 which is the value in some buffer.  Whenever you access the
1146 variable with `symbol-value' or set it with `set' or `setq',
1147 things are switched around so that the "current value"
1148 refers to the current buffer, if it wasn't already.  This
1149 way, repeated references to a variable in the same buffer
1150 are almost as efficient as if the variable weren't buffer
1151 local.  Note that the alist may not be up-to-date w.r.t.
1152 the buffer whose value is current, as the "current value"
1153 cache is normally only flushed into the alist when the
1154 buffer it refers to changes.
1155
1156 Note also that it is possible for `make-local-variable'
1157 or `make-variable-buffer-local' to be called on a variable
1158 that forwards into a C variable (i.e. a variable whose
1159 value cell is a symbol-value-forward).  In this case,
1160 the value cell becomes a symbol-value-buffer-local (as
1161 always), and the symbol-value-forward moves into
1162 the "current value" cell in this object.  Also, in
1163 this case the "current value" *always* refers to the
1164 current buffer, so that the values of the C variable
1165 always is the correct value for the current buffer.
1166 set_buffer_internal() automatically updates the current-value
1167 cells of all buffer-local variables that forward into C
1168 variables. (There is a list of all buffer-local variables
1169 that is maintained for this and other purposes.)
1170
1171 Note that only certain types of `symbol-value-forward' objects
1172 can find their way into the "current value" cell of a
1173 `symbol-value-buffer-local' object: SYMVAL_OBJECT_FORWARD,
1174 SYMVAL_FIXNUM_FORWARD, SYMVAL_BOOLEAN_FORWARD, and
1175 SYMVAL_UNBOUND_MARKER.  The SYMVAL_CONST_*_FORWARD cannot
1176 be buffer-local because they are unsettable;
1177 SYMVAL_DEFAULT_*_FORWARD cannot be buffer-local because that
1178 makes no sense; making SYMVAL_CURRENT_BUFFER_FORWARD buffer-local
1179 does not have much of an effect (it's already buffer-local); and
1180 SYMVAL_SELECTED_CONSOLE_FORWARD cannot be buffer-local because
1181 that's not currently implemented.
1182
1183 3. symbol-value-varalias
1184
1185 A symbol-value-varalias object is used for variables that
1186 are aliases for other variables.  This object contains
1187 the symbol that this variable is aliased to.
1188 symbol-value-varalias objects cannot occur anywhere within
1189 a symbol-value-buffer-local object, and most of the
1190 low-level functions below do not accept them; you need
1191 to call follow_varalias_pointers to get the actual
1192    symbol to operate on.  */
1193
1194 static Lisp_Object mark_symbol_value_buffer_local(Lisp_Object obj)
1195 {
1196         struct symbol_value_buffer_local *bfwd;
1197
1198 #ifdef ERROR_CHECK_TYPECHECK
1199         assert(XSYMBOL_VALUE_MAGIC_TYPE(obj) == SYMVAL_BUFFER_LOCAL ||
1200                XSYMBOL_VALUE_MAGIC_TYPE(obj) == SYMVAL_SOME_BUFFER_LOCAL);
1201 #endif
1202
1203         bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(obj);
1204         mark_object(bfwd->default_value);
1205         mark_object(bfwd->current_value);
1206         mark_object(bfwd->current_buffer);
1207         return bfwd->current_alist_element;
1208 }
1209
1210 static Lisp_Object mark_symbol_value_lisp_magic(Lisp_Object obj)
1211 {
1212         struct symbol_value_lisp_magic *bfwd;
1213         int i;
1214
1215         assert(XSYMBOL_VALUE_MAGIC_TYPE(obj) == SYMVAL_LISP_MAGIC);
1216
1217         bfwd = XSYMBOL_VALUE_LISP_MAGIC(obj);
1218         for (i = 0; i < MAGIC_HANDLER_MAX; i++) {
1219                 mark_object(bfwd->handler[i]);
1220                 mark_object(bfwd->harg[i]);
1221         }
1222         return bfwd->shadowed;
1223 }
1224
1225 static Lisp_Object mark_symbol_value_varalias(Lisp_Object obj)
1226 {
1227         struct symbol_value_varalias *bfwd;
1228
1229         assert(XSYMBOL_VALUE_MAGIC_TYPE(obj) == SYMVAL_VARALIAS);
1230
1231         bfwd = XSYMBOL_VALUE_VARALIAS(obj);
1232         mark_object(bfwd->shadowed);
1233         return bfwd->aliasee;
1234 }
1235
1236 /* Should never, ever be called. (except by an external debugger) */
1237 void
1238 print_symbol_value_magic(Lisp_Object obj,
1239                          Lisp_Object printcharfun, int escapeflag)
1240 {
1241         char buf[200];
1242         sprintf(buf, "#<INTERNAL OBJECT (SXEmacs bug?) (%s type %d) 0x%lx>",
1243                 XRECORD_LHEADER_IMPLEMENTATION(obj)->name,
1244                 XSYMBOL_VALUE_MAGIC_TYPE(obj), (long)XPNTR(obj));
1245         write_c_string(buf, printcharfun);
1246 }
1247
1248 static const struct lrecord_description symbol_value_forward_description[] = {
1249         {XD_END}
1250 };
1251
1252 static const struct lrecord_description symbol_value_buffer_local_description[]
1253     = {
1254         {XD_LISP_OBJECT,
1255          offsetof(struct symbol_value_buffer_local, default_value)},
1256         {XD_LISP_OBJECT,
1257          offsetof(struct symbol_value_buffer_local, current_value)},
1258         {XD_LISP_OBJECT,
1259          offsetof(struct symbol_value_buffer_local, current_buffer)},
1260         {XD_LISP_OBJECT,
1261          offsetof(struct symbol_value_buffer_local, current_alist_element)},
1262         {XD_END}
1263 };
1264
1265 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
1266         {XD_LISP_OBJECT_ARRAY,
1267          offsetof(struct symbol_value_lisp_magic, handler),
1268          2 * MAGIC_HANDLER_MAX + 1},
1269         {XD_END}
1270 };
1271
1272 static const struct lrecord_description symbol_value_varalias_description[] = {
1273         {XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, aliasee)},
1274         {XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, shadowed)},
1275         {XD_END}
1276 };
1277
1278 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-forward",
1279                               symbol_value_forward,
1280                               0,
1281                               print_symbol_value_magic, 0, 0, 0,
1282                               symbol_value_forward_description,
1283                               struct symbol_value_forward);
1284
1285 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-buffer-local",
1286                               symbol_value_buffer_local,
1287                               mark_symbol_value_buffer_local,
1288                               print_symbol_value_magic, 0, 0, 0,
1289                               symbol_value_buffer_local_description,
1290                               struct symbol_value_buffer_local);
1291
1292 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-lisp-magic",
1293                               symbol_value_lisp_magic,
1294                               mark_symbol_value_lisp_magic,
1295                               print_symbol_value_magic, 0, 0, 0,
1296                               symbol_value_lisp_magic_description,
1297                               struct symbol_value_lisp_magic);
1298
1299 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-varalias",
1300                               symbol_value_varalias,
1301                               mark_symbol_value_varalias,
1302                               print_symbol_value_magic, 0, 0, 0,
1303                               symbol_value_varalias_description,
1304                               struct symbol_value_varalias);
1305 \f
1306 /* Getting and setting values of symbols */
1307
1308 /* Given the raw contents of a symbol value cell, return the Lisp value of
1309    the symbol.  However, VALCONTENTS cannot be a symbol-value-buffer-local,
1310    symbol-value-lisp-magic, or symbol-value-varalias.
1311
1312    BUFFER specifies a buffer, and is used for built-in buffer-local
1313    variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1314    Note that such variables are never encapsulated in a
1315    symbol-value-buffer-local structure.
1316
1317    CONSOLE specifies a console, and is used for built-in console-local
1318    variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1319    Note that such variables are (currently) never encapsulated in a
1320    symbol-value-buffer-local structure.
1321  */
1322
1323 static Lisp_Object
1324 do_symval_forwarding(Lisp_Object valcontents, struct buffer *buffer,
1325                      struct console *console)
1326 {
1327         const struct symbol_value_forward *fwd;
1328
1329         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1330                 return valcontents;
1331
1332         fwd = XSYMBOL_VALUE_FORWARD(valcontents);
1333         switch (fwd->magic.type) {
1334         case SYMVAL_FIXNUM_FORWARD:
1335         case SYMVAL_CONST_FIXNUM_FORWARD:
1336                 return
1337                     make_int(*((Fixnum *) symbol_value_forward_forward(fwd)));
1338
1339         case SYMVAL_BOOLEAN_FORWARD:
1340         case SYMVAL_CONST_BOOLEAN_FORWARD:
1341                 return *((int *)symbol_value_forward_forward(fwd)) ? Qt : Qnil;
1342
1343         case SYMVAL_OBJECT_FORWARD:
1344         case SYMVAL_CONST_OBJECT_FORWARD:
1345         case SYMVAL_CONST_SPECIFIER_FORWARD:
1346                 return *((Lisp_Object *) symbol_value_forward_forward(fwd));
1347
1348         case SYMVAL_DEFAULT_BUFFER_FORWARD:
1349                 return (*((Lisp_Object *) ((char *)XBUFFER(Vbuffer_defaults)
1350                                            +
1351                                            ((char *)
1352                                             symbol_value_forward_forward(fwd)
1353                                             - (char *)&buffer_local_flags))));
1354
1355         case SYMVAL_CURRENT_BUFFER_FORWARD:
1356         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1357                 assert(buffer);
1358                 return (*((Lisp_Object *) ((char *)buffer
1359                                            +
1360                                            ((char *)
1361                                             symbol_value_forward_forward(fwd)
1362                                             - (char *)&buffer_local_flags))));
1363
1364         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1365                 return (*((Lisp_Object *) ((char *)XCONSOLE(Vconsole_defaults)
1366                                            +
1367                                            ((char *)
1368                                             symbol_value_forward_forward(fwd)
1369                                             - (char *)&console_local_flags))));
1370
1371         case SYMVAL_SELECTED_CONSOLE_FORWARD:
1372         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1373                 assert(console);
1374                 return (*((Lisp_Object *) ((char *)console
1375                                            +
1376                                            ((char *)
1377                                             symbol_value_forward_forward(fwd)
1378                                             - (char *)&console_local_flags))));
1379
1380         case SYMVAL_UNBOUND_MARKER:
1381                 return valcontents;
1382
1383         case SYMVAL_BUFFER_LOCAL:
1384         case SYMVAL_SOME_BUFFER_LOCAL:
1385         case SYMVAL_LISP_MAGIC:
1386         case SYMVAL_VARALIAS:
1387         default:
1388                 abort();
1389         }
1390         return Qnil;            /* suppress compiler warning */
1391 }
1392
1393 /* Set the value of default-buffer-local variable SYM to VALUE. */
1394
1395 static void set_default_buffer_slot_variable(Lisp_Object sym, Lisp_Object value)
1396 {
1397         /* Handle variables like case-fold-search that have special slots in
1398            the buffer. Make them work apparently like buffer_local variables.
1399          */
1400         /* At this point, the value cell may not contain a symbol-value-varalias
1401            or symbol-value-buffer-local, and if there's a handler, we should
1402            have already called it. */
1403         Lisp_Object valcontents = fetch_value_maybe_past_magic(sym, Qt);
1404         const struct symbol_value_forward *fwd
1405             = XSYMBOL_VALUE_FORWARD(valcontents);
1406         int offset = ((char *)symbol_value_forward_forward(fwd)
1407                       - (char *)&buffer_local_flags);
1408         int mask = XINT(*((Lisp_Object *) symbol_value_forward_forward(fwd)));
1409         int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1410                          Lisp_Object in_object, int flags) =
1411             symbol_value_forward_magicfun(fwd);
1412
1413         *((Lisp_Object *) (offset + (char *)XBUFFER(Vbuffer_defaults)))
1414             = value;
1415
1416         if (mask > 0) {         /* Not always per-buffer */
1417                 /* Set value in each buffer which hasn't shadowed the default */
1418                 LIST_LOOP_2(elt, Vbuffer_alist) {
1419                         struct buffer *b = XBUFFER(XCDR(elt));
1420                         if (!(b->local_var_flags & mask)) {
1421                                 if (magicfun)
1422                                         magicfun(sym, &value, make_buffer(b),
1423                                                  0);
1424                                 *((Lisp_Object *) (offset + (char *)b)) = value;
1425                         }
1426                 }
1427         }
1428 }
1429
1430 /* Set the value of default-console-local variable SYM to VALUE. */
1431
1432 static void
1433 set_default_console_slot_variable(Lisp_Object sym, Lisp_Object value)
1434 {
1435         /* Handle variables like case-fold-search that have special slots in
1436            the console. Make them work apparently like console_local variables.
1437          */
1438         /* At this point, the value cell may not contain a symbol-value-varalias
1439            or symbol-value-buffer-local, and if there's a handler, we should
1440            have already called it. */
1441         Lisp_Object valcontents = fetch_value_maybe_past_magic(sym, Qt);
1442         const struct symbol_value_forward *fwd
1443             = XSYMBOL_VALUE_FORWARD(valcontents);
1444         int offset = ((char *)symbol_value_forward_forward(fwd)
1445                       - (char *)&console_local_flags);
1446         int mask = XINT(*((Lisp_Object *) symbol_value_forward_forward(fwd)));
1447         int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1448                          Lisp_Object in_object, int flags) =
1449             symbol_value_forward_magicfun(fwd);
1450
1451         *((Lisp_Object *) (offset + (char *)XCONSOLE(Vconsole_defaults)))
1452             = value;
1453
1454         if (mask > 0) {         /* Not always per-console */
1455                 /* Set value in each console which hasn't shadowed the default */
1456                 LIST_LOOP_2(console, Vconsole_list) {
1457                         struct console *d = XCONSOLE(console);
1458                         if (!(d->local_var_flags & mask)) {
1459                                 if (magicfun)
1460                                         magicfun(sym, &value, console, 0);
1461                                 *((Lisp_Object *) (offset + (char *)d)) = value;
1462                         }
1463                 }
1464         }
1465 }
1466
1467 /* Store NEWVAL into SYM.
1468
1469    SYM's value slot may *not* be types (5) or (6) above,
1470    i.e. no symbol-value-varalias objects. (You should have
1471    forwarded past all of these.)
1472
1473    SYM should not be an unsettable symbol or a symbol with
1474    a magic `set-value' handler (unless you want to explicitly
1475    ignore this handler).
1476
1477    OVALUE is the current value of SYM, but forwarded past any
1478    symbol-value-buffer-local and symbol-value-lisp-magic objects.
1479    (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1480    the contents of its current-value cell.) NEWVAL may only be
1481    a simple value or Qunbound.  If SYM is a symbol-value-buffer-local,
1482    this function will only modify its current-value cell, which should
1483    already be set up to point to the current buffer.
1484   */
1485
1486 static void
1487 store_symval_forwarding(Lisp_Object sym, Lisp_Object ovalue, Lisp_Object newval)
1488 {
1489         if (!SYMBOL_VALUE_MAGIC_P(ovalue) || UNBOUNDP(ovalue)) {
1490                 Lisp_Object *store_pointer = value_slot_past_magic(sym);
1491
1492                 if (SYMBOL_VALUE_BUFFER_LOCAL_P(*store_pointer))
1493                         store_pointer =
1494                             &XSYMBOL_VALUE_BUFFER_LOCAL(*store_pointer)->
1495                             current_value;
1496
1497                 assert(UNBOUNDP(*store_pointer)
1498                        || !SYMBOL_VALUE_MAGIC_P(*store_pointer));
1499                 *store_pointer = newval;
1500         } else {
1501                 const struct symbol_value_forward *fwd =
1502                     XSYMBOL_VALUE_FORWARD(ovalue);
1503                 int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1504                                  Lisp_Object in_object, int flags)
1505                 = symbol_value_forward_magicfun(fwd);
1506
1507                 switch (XSYMBOL_VALUE_MAGIC_TYPE(ovalue)) {
1508                 case SYMVAL_FIXNUM_FORWARD:
1509                         CHECK_INT(newval);
1510                         if (magicfun)
1511                                 magicfun(sym, &newval, Qnil, 0);
1512                         *((Fixnum *) symbol_value_forward_forward(fwd)) =
1513                             XINT(newval);
1514                         return;
1515
1516                 case SYMVAL_BOOLEAN_FORWARD:
1517                         if (magicfun)
1518                                 magicfun(sym, &newval, Qnil, 0);
1519                         *((int *)symbol_value_forward_forward(fwd))
1520                             = !NILP(newval);
1521                         return;
1522
1523                 case SYMVAL_OBJECT_FORWARD:
1524                         if (magicfun)
1525                                 magicfun(sym, &newval, Qnil, 0);
1526                         *((Lisp_Object *) symbol_value_forward_forward(fwd)) =
1527                             newval;
1528                         return;
1529
1530                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1531                         set_default_buffer_slot_variable(sym, newval);
1532                         return;
1533
1534                 case SYMVAL_CURRENT_BUFFER_FORWARD:
1535                         if (magicfun)
1536                                 magicfun(sym, &newval,
1537                                          make_buffer(current_buffer), 0);
1538                         *((Lisp_Object *) ((char *)current_buffer +
1539                                            ((char *)
1540                                             symbol_value_forward_forward(fwd)
1541                                             - (char *)&buffer_local_flags)))
1542                             = newval;
1543                         return;
1544
1545                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1546                         set_default_console_slot_variable(sym, newval);
1547                         return;
1548
1549                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1550                         if (magicfun)
1551                                 magicfun(sym, &newval, Vselected_console, 0);
1552                         *((Lisp_Object *) ((char *)XCONSOLE(Vselected_console)
1553                                            +
1554                                            ((char *)
1555                                             symbol_value_forward_forward(fwd)
1556                                             - (char *)&console_local_flags)))
1557                             = newval;
1558                         return;
1559
1560                         /* list all cases */
1561                 case SYMVAL_CONST_FIXNUM_FORWARD:
1562                 case SYMVAL_CONST_BOOLEAN_FORWARD:
1563                 case SYMVAL_CONST_OBJECT_FORWARD:
1564                 case SYMVAL_CONST_SPECIFIER_FORWARD:
1565                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1566                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1567                 case SYMVAL_UNBOUND_MARKER:
1568                 case SYMVAL_BUFFER_LOCAL:
1569                 case SYMVAL_SOME_BUFFER_LOCAL:
1570                 case SYMVAL_LISP_MAGIC:
1571                 case SYMVAL_VARALIAS:
1572
1573                 default:
1574                         abort();
1575                 }
1576         }
1577 }
1578
1579 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1580    BFWD, locate and return a pointer to the element in BUFFER's
1581    local_var_alist for SYMBOL.  The return value will be Qnil if
1582    BUFFER does not have its own value for SYMBOL (i.e. the default
1583    value is seen in that buffer).
1584    */
1585
1586 static Lisp_Object
1587 buffer_local_alist_element(struct buffer *buffer, Lisp_Object symbol,
1588                            struct symbol_value_buffer_local *bfwd)
1589 {
1590         if (!NILP(bfwd->current_buffer) &&
1591             XBUFFER(bfwd->current_buffer) == buffer)
1592                 /* This is just an optimization of the below. */
1593                 return bfwd->current_alist_element;
1594         else
1595                 return assq_no_quit(symbol, buffer->local_var_alist);
1596 }
1597
1598 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1599    symbol-value-buffer-local of a per-buffer variable -- i.e. the
1600    slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1601    slot -- may be out of date.]
1602
1603    Write out any cached value in buffer-local variable SYMBOL's
1604    buffer-local structure, which is passed in as BFWD.
1605 */
1606
1607 static void
1608 write_out_buffer_local_cache(Lisp_Object symbol,
1609                              struct symbol_value_buffer_local *bfwd)
1610 {
1611         if (!NILP(bfwd->current_buffer)) {
1612                 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1613                    uses it, and that type cannot be inside a symbol-value-buffer-local */
1614                 Lisp_Object cval =
1615                     do_symval_forwarding(bfwd->current_value, 0, 0);
1616                 if (NILP(bfwd->current_alist_element))
1617                         /* current_value may be updated more recently than default_value */
1618                         bfwd->default_value = cval;
1619                 else
1620                         Fsetcdr(bfwd->current_alist_element, cval);
1621         }
1622 }
1623
1624 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1625    Set up BFWD's cache for validity in buffer BUF.  This assumes that
1626    the cache is currently in a consistent state (this can include
1627    not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1628
1629    If the cache is already set up for BUF, this function does nothing
1630    at all.
1631
1632    Otherwise, if SYM forwards out to a C variable, this also forwards
1633    SYM's value in BUF out to the variable.  Therefore, you generally
1634    only want to call this when BUF is, or is about to become, the
1635    current buffer.
1636
1637    (Otherwise, you can just retrieve the value without changing the
1638    cache, at the expense of slower retrieval.)
1639 */
1640
1641 static void
1642 set_up_buffer_local_cache(Lisp_Object sym,
1643                           struct symbol_value_buffer_local *bfwd,
1644                           struct buffer *buf,
1645                           Lisp_Object new_alist_el, int set_it_p)
1646 {
1647         Lisp_Object new_val;
1648
1649         if (!NILP(bfwd->current_buffer)
1650             && buf == XBUFFER(bfwd->current_buffer))
1651                 /* Cache is already set up. */
1652                 return;
1653
1654         /* Flush out the old cache. */
1655         write_out_buffer_local_cache(sym, bfwd);
1656
1657         /* Retrieve the new alist element and new value. */
1658         if (NILP(new_alist_el)
1659             && set_it_p)
1660                 new_alist_el = buffer_local_alist_element(buf, sym, bfwd);
1661
1662         if (NILP(new_alist_el))
1663                 new_val = bfwd->default_value;
1664         else
1665                 new_val = Fcdr(new_alist_el);
1666
1667         bfwd->current_alist_element = new_alist_el;
1668         XSETBUFFER(bfwd->current_buffer, buf);
1669
1670         /* Now store the value into the current-value slot.
1671            We don't simply write it there, because the current-value
1672            slot might be a forwarding pointer, in which case we need
1673            to instead write the value into the C variable.
1674
1675            We might also want to call a magic function.
1676
1677            So instead, we call this function. */
1678         store_symval_forwarding(sym, bfwd->current_value, new_val);
1679 }
1680
1681 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1682    Flush the cache.  BFWD->CURRENT_BUFFER will be nil after this operation.
1683 */
1684
1685 static void
1686 flush_buffer_local_cache(Lisp_Object sym,
1687                          struct symbol_value_buffer_local *bfwd)
1688 {
1689         if (NILP(bfwd->current_buffer))
1690                 /* Cache is already flushed. */
1691                 return;
1692
1693         /* Flush out the old cache. */
1694         write_out_buffer_local_cache(sym, bfwd);
1695
1696         bfwd->current_alist_element = Qnil;
1697         bfwd->current_buffer = Qnil;
1698
1699         /* Now store default the value into the current-value slot.
1700            We don't simply write it there, because the current-value
1701            slot might be a forwarding pointer, in which case we need
1702            to instead write the value into the C variable.
1703
1704            We might also want to call a magic function.
1705
1706            So instead, we call this function. */
1707         store_symval_forwarding(sym, bfwd->current_value, bfwd->default_value);
1708 }
1709
1710 /* Flush all the buffer-local variable caches.  Whoever has a
1711    non-interned buffer-local variable will be spanked.  Whoever has a
1712    magic variable that interns or uninterns symbols... I don't even
1713    want to think about it.
1714 */
1715
1716 void flush_all_buffer_local_cache(void)
1717 {
1718         Lisp_Object *syms = XVECTOR_DATA(Vobarray);
1719         long count = XVECTOR_LENGTH(Vobarray);
1720         long i;
1721
1722         for (i = 0; i < count; i++) {
1723                 Lisp_Object sym = syms[i];
1724                 Lisp_Object value;
1725
1726                 if (!ZEROP(sym))
1727                         for (;;) {
1728                                 Lisp_Symbol *next;
1729                                 assert(SYMBOLP(sym));
1730                                 value = fetch_value_maybe_past_magic(sym, Qt);
1731                                 if (SYMBOL_VALUE_BUFFER_LOCAL_P(value))
1732                                         flush_buffer_local_cache(sym,
1733                                                                  XSYMBOL_VALUE_BUFFER_LOCAL
1734                                                                  (value));
1735
1736                                 next = symbol_next(XSYMBOL(sym));
1737                                 if (!next)
1738                                         break;
1739                                 XSETSYMBOL(sym, next);
1740                         }
1741         }
1742 }
1743 \f
1744 void kill_buffer_local_variables(struct buffer *buf)
1745 {
1746         Lisp_Object prev = Qnil;
1747         Lisp_Object alist;
1748
1749         /* Any which are supposed to be permanent,
1750            make local again, with the same values they had.  */
1751
1752         for (alist = buf->local_var_alist; !NILP(alist); alist = XCDR(alist)) {
1753                 Lisp_Object sym = XCAR(XCAR(alist));
1754                 struct symbol_value_buffer_local *bfwd;
1755                 /* Variables with a symbol-value-varalias should not be here
1756                    (we should have forwarded past them) and there must be a
1757                    symbol-value-buffer-local.  If there's a symbol-value-lisp-magic,
1758                    just forward past it; if the variable has a handler, it was
1759                    already called. */
1760                 Lisp_Object value = fetch_value_maybe_past_magic(sym, Qt);
1761
1762                 assert(SYMBOL_VALUE_BUFFER_LOCAL_P(value));
1763                 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(value);
1764
1765                 if (!NILP(Fget(sym, Qpermanent_local, Qnil)))
1766                         /* prev points to the last alist element that is still
1767                            staying around, so *only* update it now.  This didn't
1768                            used to be the case; this bug has been around since
1769                            mly's rewrite two years ago! */
1770                         prev = alist;
1771                 else {
1772                         /* Really truly kill it. */
1773                         if (!NILP(prev))
1774                                 XCDR(prev) = XCDR(alist);
1775                         else
1776                                 buf->local_var_alist = XCDR(alist);
1777
1778                         /* We just effectively changed the value for this variable
1779                            in BUF. So: */
1780
1781                         /* (1) If the cache is caching BUF, invalidate the cache. */
1782                         if (!NILP(bfwd->current_buffer) &&
1783                             buf == XBUFFER(bfwd->current_buffer))
1784                                 bfwd->current_buffer = Qnil;
1785
1786                         /* (2) If we changed the value in current_buffer and this
1787                            variable forwards to a C variable, we need to change the
1788                            value of the C variable.  set_up_buffer_local_cache()
1789                            will do this.  It doesn't hurt to do it whenever
1790                            BUF == current_buffer, so just go ahead and do that. */
1791                         if (buf == current_buffer)
1792                                 set_up_buffer_local_cache(sym, bfwd, buf, Qnil,
1793                                                           0);
1794                 }
1795         }
1796 }
1797 \f
1798 static Lisp_Object
1799 find_symbol_value_1(Lisp_Object sym, struct buffer *buf,
1800                     struct console *con, int swap_it_in,
1801                     Lisp_Object symcons, int set_it_p)
1802 {
1803         Lisp_Object valcontents;
1804
1805       retry:
1806         valcontents = XSYMBOL(sym)->value;
1807
1808       retry_2:
1809         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1810                 return valcontents;
1811
1812         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
1813         case SYMVAL_LISP_MAGIC:
1814                 /* #### kludge */
1815                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
1816                 /* semi-change-o */
1817                 goto retry_2;
1818
1819         case SYMVAL_VARALIAS:
1820                 sym = follow_varalias_pointers(sym, Qt /* #### kludge */ );
1821                 symcons = Qnil;
1822                 /* presto change-o! */
1823                 goto retry;
1824
1825         case SYMVAL_BUFFER_LOCAL:
1826         case SYMVAL_SOME_BUFFER_LOCAL:
1827                 {
1828                         struct symbol_value_buffer_local *bfwd
1829                             = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
1830
1831                         if (swap_it_in) {
1832                                 set_up_buffer_local_cache(sym, bfwd, buf,
1833                                                           symcons, set_it_p);
1834                                 valcontents = bfwd->current_value;
1835                         } else {
1836                                 if (!NILP(bfwd->current_buffer) &&
1837                                     buf == XBUFFER(bfwd->current_buffer))
1838                                         valcontents = bfwd->current_value;
1839                                 else if (NILP(symcons)) {
1840                                         if (set_it_p)
1841                                                 valcontents =
1842                                                     assq_no_quit(sym,
1843                                                                  buf->
1844                                                                  local_var_alist);
1845                                         if (NILP(valcontents))
1846                                                 valcontents =
1847                                                     bfwd->default_value;
1848                                         else
1849                                                 valcontents = XCDR(valcontents);
1850                                 } else
1851                                         valcontents = XCDR(symcons);
1852                         }
1853                         break;
1854                 }
1855
1856         case SYMVAL_FIXNUM_FORWARD:
1857         case SYMVAL_CONST_FIXNUM_FORWARD:
1858         case SYMVAL_BOOLEAN_FORWARD:
1859         case SYMVAL_CONST_BOOLEAN_FORWARD:
1860         case SYMVAL_OBJECT_FORWARD:
1861         case SYMVAL_CONST_OBJECT_FORWARD:
1862         case SYMVAL_CONST_SPECIFIER_FORWARD:
1863         case SYMVAL_DEFAULT_BUFFER_FORWARD:
1864         case SYMVAL_CURRENT_BUFFER_FORWARD:
1865         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1866         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1867         case SYMVAL_SELECTED_CONSOLE_FORWARD:
1868         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1869         case SYMVAL_UNBOUND_MARKER:
1870         default:
1871                 break;
1872         }
1873         return do_symval_forwarding(valcontents, buf, con);
1874 }
1875
1876 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1877    bound.  Note that it must not be possible to QUIT within this
1878    function. */
1879
1880 Lisp_Object symbol_value_in_buffer(Lisp_Object sym, Lisp_Object buffer)
1881 {
1882         struct buffer *buf;
1883
1884         CHECK_SYMBOL(sym);
1885
1886         if (NILP(buffer))
1887                 buf = current_buffer;
1888         else {
1889                 CHECK_BUFFER(buffer);
1890                 buf = XBUFFER(buffer);
1891         }
1892
1893         return find_symbol_value_1(sym, buf,
1894                                    /* If it bombs out at startup due to a
1895                                       Lisp error, this may be nil. */
1896                                    CONSOLEP(Vselected_console)
1897                                    ? XCONSOLE(Vselected_console) : 0, 0, Qnil,
1898                                    1);
1899 }
1900
1901 static Lisp_Object symbol_value_in_console(Lisp_Object sym, Lisp_Object console)
1902 {
1903         CHECK_SYMBOL(sym);
1904
1905         if (NILP(console))
1906                 console = Vselected_console;
1907         else
1908                 CHECK_CONSOLE(console);
1909
1910         return find_symbol_value_1(sym, current_buffer, XCONSOLE(console), 0,
1911                                    Qnil, 1);
1912 }
1913
1914 static Lisp_Object
1915 search_symbol_macro(Lisp_Object name)
1916 {
1917         return Fget(name, Qsymbol_macro, Qnil);
1918 }
1919
1920 /* Return the current value of SYM.  The difference between this function
1921    and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1922    this updates the CURRENT_VALUE slot of buffer-local variables to
1923    point to the current buffer, while symbol_value_in_buffer doesn't. */
1924
1925 Lisp_Object find_symbol_value(Lisp_Object sym)
1926 {
1927         /* WARNING: This function can be called when current_buffer is 0
1928            and Vselected_console is Qnil, early in initialization. */
1929         struct console *con;
1930         Lisp_Object valcontents;
1931
1932         CHECK_SYMBOL(sym);
1933
1934         valcontents = XSYMBOL(sym)->value;
1935         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1936                 return valcontents;
1937
1938         if (CONSOLEP(Vselected_console))
1939                 con = XCONSOLE(Vselected_console);
1940         else {
1941                 /* This can also get called while we're preparing to shutdown.
1942                    #### What should really happen in that case?  Should we
1943                    actually fix things so we can't get here in that case? */
1944 #ifndef PDUMP
1945                 assert(!initialized || preparing_for_armageddon);
1946 #endif
1947                 con = 0;
1948         }
1949
1950         return find_symbol_value_1(sym, current_buffer, con, 1, Qnil, 1);
1951 }
1952
1953 /* This is an optimized function for quick lookup of buffer local symbols
1954    by avoiding O(n) search.  This will work when either:
1955      a) We have already found the symbol e.g. by traversing local_var_alist.
1956    or
1957      b) We know that the symbol will not be found in the current buffer's
1958         list of local variables.
1959    In the former case, find_it_p is 1 and symbol_cons is the element from
1960    local_var_alist.  In the latter case, find_it_p is 0 and symbol_cons
1961    is the symbol.
1962
1963    This function is called from set_buffer_internal which does both of these
1964    things. */
1965
1966 Lisp_Object find_symbol_value_quickly(Lisp_Object symbol_cons, int find_it_p)
1967 {
1968         /* WARNING: This function can be called when current_buffer is 0
1969            and Vselected_console is Qnil, early in initialization. */
1970         struct console *con;
1971         Lisp_Object sym = find_it_p ? XCAR(symbol_cons) : symbol_cons;
1972
1973         CHECK_SYMBOL(sym);
1974         if (CONSOLEP(Vselected_console))
1975                 con = XCONSOLE(Vselected_console);
1976         else {
1977                 /* This can also get called while we're preparing to shutdown.
1978                    #### What should really happen in that case?  Should we
1979                    actually fix things so we can't get here in that case? */
1980 #ifndef PDUMP
1981                 assert(!initialized || preparing_for_armageddon);
1982 #endif
1983                 con = 0;
1984         }
1985
1986         return find_symbol_value_1(sym, current_buffer, con, 1,
1987                                    find_it_p ? symbol_cons : Qnil, find_it_p);
1988 }
1989
1990 DEFUN("symbol-value", Fsymbol_value, 1, 1, 0,   /*
1991 Return SYMBOL's value.  Error if that is void.
1992 */
1993       (symbol))
1994 {
1995         Lisp_Object val = find_symbol_value(symbol);
1996
1997         if (UNBOUNDP(val)) {
1998                 Lisp_Object fd = search_symbol_macro(symbol);
1999                 if (!NILP(fd))
2000                         return Feval(fd);
2001                 else
2002                         return Fsignal(Qvoid_variable, list1(symbol));
2003         } else
2004                 return val;
2005 }
2006
2007 DEFUN("set", Fset, 2, 2, 0,     /*
2008 Set SYMBOL's value to NEWVAL, and return NEWVAL.
2009 */
2010       (symbol, newval))
2011 {
2012         REGISTER Lisp_Object valcontents;
2013         Lisp_Object ssm;
2014         Lisp_Symbol *sym;
2015         /* remember, we're called by Fmakunbound() as well */
2016
2017         CHECK_SYMBOL(symbol);
2018
2019       retry:
2020         sym = XSYMBOL(symbol);
2021         valcontents = sym->value;
2022
2023         if (EQ(symbol, Qnil) || EQ(symbol, Qt) || SYMBOL_IS_KEYWORD(symbol))
2024                 reject_constant_symbols(symbol, newval, 0,
2025                                         UNBOUNDP(newval) ? Qmakunbound : Qset);
2026
2027         if (UNBOUNDP(valcontents)) {
2028                 ssm = search_symbol_macro(symbol);
2029                 if (!NILP(ssm))
2030                         return Feval(list3(Qsetf, ssm, list2(Qquote, newval)));
2031         }
2032
2033         if (!SYMBOL_VALUE_MAGIC_P(valcontents) || UNBOUNDP(valcontents)) {
2034                 sym->value = newval;
2035                 return newval;
2036         }
2037
2038         reject_constant_symbols(symbol, newval, 0,
2039                                 UNBOUNDP(newval) ? Qmakunbound : Qset);
2040
2041         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2042         case SYMVAL_LISP_MAGIC: {
2043                 if (UNBOUNDP(newval)) {
2044                         maybe_call_magic_handler(symbol, Qmakunbound,
2045                                                  0);
2046                         return XSYMBOL_VALUE_LISP_MAGIC(valcontents)->
2047                                 shadowed = Qunbound;
2048                 } else {
2049                         maybe_call_magic_handler(symbol, Qset, 1,
2050                                                  newval);
2051                         return XSYMBOL_VALUE_LISP_MAGIC(valcontents)->
2052                                 shadowed = newval;
2053                 }
2054         }
2055
2056         case SYMVAL_VARALIAS:
2057                 symbol = follow_varalias_pointers(symbol, UNBOUNDP(newval)
2058                                                   ? Qmakunbound : Qset);
2059                 /* presto change-o! */
2060                 goto retry;
2061
2062         case SYMVAL_FIXNUM_FORWARD:
2063         case SYMVAL_BOOLEAN_FORWARD:
2064         case SYMVAL_OBJECT_FORWARD:
2065         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2066         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2067                 if (UNBOUNDP(newval))
2068                         signal_error(Qerror,
2069                                      list2(build_string("Cannot makunbound"),
2070                                            symbol));
2071                 break;
2072
2073                 /* case SYMVAL_UNBOUND_MARKER: break; */
2074
2075         case SYMVAL_CURRENT_BUFFER_FORWARD: {
2076                 const struct symbol_value_forward *fwd
2077                         = XSYMBOL_VALUE_FORWARD(valcontents);
2078                 int mask = XINT(*((Lisp_Object *)
2079                                   symbol_value_forward_forward(fwd)));
2080                 if (mask > 0)
2081                         /* Setting this variable makes it buffer-local */
2082                         current_buffer->local_var_flags |= mask;
2083                 break;
2084         }
2085
2086         case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2087                 const struct symbol_value_forward *fwd
2088                         = XSYMBOL_VALUE_FORWARD(valcontents);
2089                 int mask = XINT(*((Lisp_Object *)
2090                                   symbol_value_forward_forward(fwd)));
2091                 if (mask > 0)
2092                         /* Setting this variable makes it console-local */
2093                         XCONSOLE(Vselected_console)->local_var_flags |=
2094                                 mask;
2095                 break;
2096         }
2097
2098         case SYMVAL_BUFFER_LOCAL:
2099         case SYMVAL_SOME_BUFFER_LOCAL: {
2100                 /* If we want to examine or set the value and
2101                    CURRENT-BUFFER is current, we just examine or set
2102                    CURRENT-VALUE. If CURRENT-BUFFER is not current, we
2103                    store the current CURRENT-VALUE value into
2104                    CURRENT-ALIST- ELEMENT, then find the appropriate alist
2105                    element for the buffer now current and set up
2106                    CURRENT-ALIST-ELEMENT.  Then we set CURRENT-VALUE out
2107                    of that element, and store into CURRENT-BUFFER.
2108
2109                    If we are setting the variable and the current buffer does
2110                    not have an alist entry for this variable, an alist entry is
2111                    created.
2112
2113                    Note that CURRENT-VALUE can be a forwarding pointer.
2114                    Each time it is examined or set, forwarding must be
2115                    done. */
2116                 struct symbol_value_buffer_local *bfwd
2117                         = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2118                 int some_buffer_local_p =
2119                         (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
2120                 /* What value are we caching right now?  */
2121                 Lisp_Object aelt = bfwd->current_alist_element;
2122
2123                 if (!NILP(bfwd->current_buffer) &&
2124                     current_buffer == XBUFFER(bfwd->current_buffer)
2125                     && ((some_buffer_local_p)
2126                         ? 1     /* doesn't automatically become local */
2127                         : !NILP(aelt)   /* already local */
2128                             )) {
2129                         /* Cache is valid */
2130                         valcontents = bfwd->current_value;
2131                 } else {
2132                         /* If the current buffer is not the buffer whose binding
2133                            is currently cached, or if it's a SYMVAL_BUFFER_LOCAL
2134                            and we're looking at the default value, the cache is
2135                            invalid; we need to write it out, and find the new
2136                            CURRENT-ALIST-ELEMENT
2137                         */
2138
2139                         /* Write out the cached value for the old buffer; copy
2140                            it back to its alist element.  This works if the
2141                            current buffer only sees the default value, too.  */
2142                         write_out_buffer_local_cache(symbol, bfwd);
2143
2144                         /* Find the new value for CURRENT-ALIST-ELEMENT.  */
2145                         aelt = buffer_local_alist_element(current_buffer,
2146                                                            symbol, bfwd);
2147                         if (NILP(aelt)) {
2148                                 /* This buffer is still seeing the default
2149                                    value.  */
2150                                 if (!some_buffer_local_p) {
2151                                         /* If it's a SYMVAL_BUFFER_LOCAL, give
2152                                            this buffer a new assoc for a local
2153                                            value and set CURRENT-ALIST-ELEMENT
2154                                            to point to that.  */
2155                                         aelt = do_symval_forwarding(
2156                                                 bfwd->current_value,
2157                                                 current_buffer,
2158                                                 XCONSOLE(Vselected_console));
2159                                         aelt = Fcons(symbol, aelt);
2160                                         current_buffer->local_var_alist =
2161                                                 Fcons(aelt,
2162                                                       current_buffer->
2163                                                       local_var_alist);
2164                                 } else {
2165                                         /* If the variable is a
2166                                            SYMVAL_SOME_BUFFER_LOCAL, we're
2167                                            currently seeing the default
2168                                            value. */
2169                                         ;
2170                                 }
2171                         }
2172                         /* Cache the new buffer's assoc in
2173                            CURRENT-ALIST-ELEMENT.  */
2174                         bfwd->current_alist_element = aelt;
2175                         /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is
2176                            accurate.  */
2177                         XSETBUFFER(bfwd->current_buffer,
2178                                    current_buffer);
2179                         valcontents = bfwd->current_value;
2180                 }
2181                 break;
2182         }
2183
2184         case SYMVAL_CONST_FIXNUM_FORWARD:
2185         case SYMVAL_CONST_BOOLEAN_FORWARD:
2186         case SYMVAL_CONST_SPECIFIER_FORWARD:
2187         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2188         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2189         case SYMVAL_CONST_OBJECT_FORWARD:
2190         case SYMVAL_UNBOUND_MARKER:
2191         default:
2192                 abort();
2193         }
2194         store_symval_forwarding(symbol, valcontents, newval);
2195
2196         return newval;
2197 }
2198 \f
2199 /* Access or set a buffer-local symbol's default value.  */
2200
2201 /* Return the default value of SYM, but don't check for voidness.
2202    Return Qunbound if it is void.  */
2203
2204 static Lisp_Object default_value(Lisp_Object sym)
2205 {
2206         Lisp_Object valcontents;
2207
2208         CHECK_SYMBOL(sym);
2209
2210 retry:
2211         valcontents = XSYMBOL(sym)->value;
2212
2213 retry_2:
2214         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2215                 return valcontents;
2216
2217         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2218         case SYMVAL_LISP_MAGIC:
2219                 /* #### kludge */
2220                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2221                 /* semi-change-o */
2222                 goto retry_2;
2223
2224         case SYMVAL_VARALIAS:
2225                 sym = follow_varalias_pointers(sym, Qt /* #### kludge */ );
2226                 /* presto change-o! */
2227                 goto retry;
2228
2229         case SYMVAL_UNBOUND_MARKER:
2230                 return valcontents;
2231
2232         case SYMVAL_CURRENT_BUFFER_FORWARD: {
2233                 const struct symbol_value_forward *fwd
2234                         = XSYMBOL_VALUE_FORWARD(valcontents);
2235                 return (*((Lisp_Object *)
2236                           ((char *)XBUFFER(Vbuffer_defaults) +
2237                            ((char *)symbol_value_forward_forward(fwd) -
2238                             (char *)&buffer_local_flags))));
2239         }
2240
2241         case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2242                 const struct symbol_value_forward *fwd =
2243                         XSYMBOL_VALUE_FORWARD(valcontents);
2244                 return (*((Lisp_Object *)
2245                           ((char *)XCONSOLE(Vconsole_defaults) +
2246                            ((char *)symbol_value_forward_forward(fwd) -
2247                             (char *)&console_local_flags))));
2248         }
2249
2250         case SYMVAL_BUFFER_LOCAL:
2251         case SYMVAL_SOME_BUFFER_LOCAL: {
2252                 struct symbol_value_buffer_local *bfwd =
2253                         XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2254
2255                 /* Handle user-created local variables.  */
2256                 /* If var is set up for a buffer that lacks a local value for
2257                    it, the current value is nominally the default value.  But
2258                    the current value slot may be more up to date, since ordinary
2259                    setq stores just that slot.  So use that.  */
2260                 if (NILP(bfwd->current_alist_element))
2261                         return do_symval_forwarding(
2262                                 bfwd->current_value,
2263                                 current_buffer,
2264                                 XCONSOLE(Vselected_console));
2265                 else
2266                         return bfwd->default_value;
2267         }
2268
2269         case SYMVAL_FIXNUM_FORWARD:
2270         case SYMVAL_CONST_FIXNUM_FORWARD:
2271         case SYMVAL_BOOLEAN_FORWARD:
2272         case SYMVAL_CONST_BOOLEAN_FORWARD:
2273         case SYMVAL_OBJECT_FORWARD:
2274         case SYMVAL_CONST_OBJECT_FORWARD:
2275         case SYMVAL_CONST_SPECIFIER_FORWARD:
2276         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2277         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2278         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2279         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2280
2281         default:
2282                 /* For other variables, get the current value.    */
2283                 return do_symval_forwarding(valcontents, current_buffer,
2284                                             XCONSOLE(Vselected_console));
2285         }
2286
2287         RETURN_NOT_REACHED(Qnil)        /* suppress compiler warning */
2288 }
2289
2290 DEFUN("default-boundp", Fdefault_boundp, 1, 1, 0,       /*
2291 Return t if SYMBOL has a non-void default value.
2292 This is the value that is seen in buffers that do not have their own values
2293 for this variable.
2294 */
2295       (symbol))
2296 {
2297         return UNBOUNDP(default_value(symbol)) ? Qnil : Qt;
2298 }
2299
2300 DEFUN("default-value", Fdefault_value, 1, 1, 0, /*
2301 Return SYMBOL's default value.
2302 This is the value that is seen in buffers that do not have their own values
2303 for this variable.  The default value is meaningful for variables with
2304 local bindings in certain buffers.
2305 */
2306       (symbol))
2307 {
2308         Lisp_Object value = default_value(symbol);
2309
2310         return UNBOUNDP(value) ? Fsignal(Qvoid_variable, list1(symbol)) : value;
2311 }
2312
2313 DEFUN("set-default", Fset_default, 2, 2, 0,     /*
2314 Set SYMBOL's default value to VALUE.  SYMBOL and VALUE are evaluated.
2315 The default value is seen in buffers that do not have their own values
2316 for this variable.
2317 */
2318       (symbol, value))
2319 {
2320         Lisp_Object valcontents;
2321
2322         CHECK_SYMBOL(symbol);
2323
2324       retry:
2325         valcontents = XSYMBOL(symbol)->value;
2326
2327       retry_2:
2328         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2329                 return Fset(symbol, value);
2330
2331         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2332         case SYMVAL_LISP_MAGIC:
2333                 RETURN_IF_NOT_UNBOUND(maybe_call_magic_handler
2334                                       (symbol, Qset_default, 1, value));
2335                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2336                 /* semi-change-o */
2337                 goto retry_2;
2338
2339         case SYMVAL_VARALIAS:
2340                 symbol = follow_varalias_pointers(symbol, Qset_default);
2341                 /* presto change-o! */
2342                 goto retry;
2343
2344         case SYMVAL_CURRENT_BUFFER_FORWARD:
2345                 set_default_buffer_slot_variable(symbol, value);
2346                 return value;
2347
2348         case SYMVAL_SELECTED_CONSOLE_FORWARD:
2349                 set_default_console_slot_variable(symbol, value);
2350                 return value;
2351
2352         case SYMVAL_BUFFER_LOCAL:
2353         case SYMVAL_SOME_BUFFER_LOCAL: {
2354                 /* Store new value into the DEFAULT-VALUE slot */
2355                 struct symbol_value_buffer_local *bfwd
2356                         = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2357
2358                 bfwd->default_value = value;
2359                 /* If current-buffer doesn't shadow default_value,
2360                  *  we must set the CURRENT-VALUE slot too */
2361                 if (NILP(bfwd->current_alist_element))
2362                         store_symval_forwarding(symbol,
2363                                                 bfwd->current_value,
2364                                                 value);
2365                 return value;
2366         }
2367
2368         case SYMVAL_FIXNUM_FORWARD:
2369         case SYMVAL_CONST_FIXNUM_FORWARD:
2370         case SYMVAL_BOOLEAN_FORWARD:
2371         case SYMVAL_CONST_BOOLEAN_FORWARD:
2372         case SYMVAL_OBJECT_FORWARD:
2373         case SYMVAL_CONST_OBJECT_FORWARD:
2374         case SYMVAL_CONST_SPECIFIER_FORWARD:
2375         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2376         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2377         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2378         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2379         case SYMVAL_UNBOUND_MARKER:
2380
2381         default:
2382                 return Fset(symbol, value);
2383         }
2384 }
2385
2386 DEFUN("setq-default", Fsetq_default, 0, UNEVALLED, 0,   /*
2387 Set the default value of variable SYMBOL to VALUE.
2388 SYMBOL, the variable name, is literal (not evaluated);
2389 VALUE is an expression and it is evaluated.
2390 The default value of a variable is seen in buffers
2391 that do not have their own values for the variable.
2392
2393 More generally, you can use multiple variables and values, as in
2394 (setq-default SYMBOL VALUE SYMBOL VALUE...)
2395 This sets each SYMBOL's default value to the corresponding VALUE.
2396 The VALUE for the Nth SYMBOL can refer to the new default values
2397 of previous SYMBOLs.
2398 */
2399       (args))
2400 {
2401         /* This function can GC */
2402         Lisp_Object symbol, tail, val = Qnil;
2403         int nargs;
2404         struct gcpro gcpro1;
2405
2406         GET_LIST_LENGTH(args, nargs);
2407
2408         if (nargs & 1)          /* Odd number of arguments? */
2409                 Fsignal(Qwrong_number_of_arguments,
2410                         list2(Qsetq_default, make_int(nargs)));
2411
2412         GCPRO1(val);
2413
2414         PROPERTY_LIST_LOOP(tail, symbol, val, args) {
2415                 val = Feval(val);
2416                 Fset_default(symbol, val);
2417         }
2418
2419         UNGCPRO;
2420         return val;
2421 }
2422 \f
2423 /* Lisp functions for creating and removing buffer-local variables.  */
2424
2425 DEFUN("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1, "vMake Variable Buffer Local: ", /*
2426 Make VARIABLE have a separate value for each buffer.
2427 At any time, the value for the current buffer is in effect.
2428 There is also a default value which is seen in any buffer which has not yet
2429 set its own value.
2430 Using `set' or `setq' to set the variable causes it to have a separate value
2431 for the current buffer if it was previously using the default value.
2432 The function `default-value' gets the default value and `set-default'
2433 sets it.
2434 */
2435       (variable))
2436 {
2437         Lisp_Object valcontents;
2438
2439         CHECK_SYMBOL(variable);
2440
2441       retry:
2442         verify_ok_for_buffer_local(variable, Qmake_variable_buffer_local);
2443
2444         valcontents = XSYMBOL(variable)->value;
2445
2446       retry_2:
2447         if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2448                 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2449                 case SYMVAL_LISP_MAGIC:
2450                         if (!UNBOUNDP(maybe_call_magic_handler
2451                                       (variable, Qmake_variable_buffer_local,
2452                                        0)))
2453                                 return variable;
2454                         valcontents =
2455                             XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2456                         /* semi-change-o */
2457                         goto retry_2;
2458
2459                 case SYMVAL_VARALIAS:
2460                         variable = follow_varalias_pointers(
2461                                 variable,
2462                                 Qmake_variable_buffer_local);
2463                         /* presto change-o! */
2464                         goto retry;
2465
2466                 case SYMVAL_FIXNUM_FORWARD:
2467                 case SYMVAL_BOOLEAN_FORWARD:
2468                 case SYMVAL_OBJECT_FORWARD:
2469                 case SYMVAL_UNBOUND_MARKER:
2470                         break;
2471
2472                 case SYMVAL_CURRENT_BUFFER_FORWARD:
2473                 case SYMVAL_BUFFER_LOCAL:
2474                         /* Already per-each-buffer */
2475                         return variable;
2476
2477                 case SYMVAL_SOME_BUFFER_LOCAL:
2478                         /* Transmogrify */
2479                         XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)->magic.type =
2480                             SYMVAL_BUFFER_LOCAL;
2481                         return variable;
2482
2483                 case SYMVAL_CONST_FIXNUM_FORWARD:
2484                 case SYMVAL_CONST_BOOLEAN_FORWARD:
2485                 case SYMVAL_CONST_OBJECT_FORWARD:
2486                 case SYMVAL_CONST_SPECIFIER_FORWARD:
2487                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2488                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2489                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2490                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2491                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2492
2493                 default:
2494                         abort();
2495                 }
2496         }
2497
2498         {
2499                 struct symbol_value_buffer_local *bfwd
2500                     = alloc_lcrecord_type(struct symbol_value_buffer_local,
2501                                           &lrecord_symbol_value_buffer_local);
2502                 Lisp_Object foo;
2503                 zero_lcrecord(&bfwd->magic);
2504                 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2505
2506                 bfwd->default_value = find_symbol_value(variable);
2507                 bfwd->current_value = valcontents;
2508                 bfwd->current_alist_element = Qnil;
2509                 bfwd->current_buffer = Fcurrent_buffer();
2510                 XSETSYMBOL_VALUE_MAGIC(foo, bfwd);
2511                 *value_slot_past_magic(variable) = foo;
2512 #if 1                           /* #### Yuck!   FSFmacs bug-compatibility */
2513                 /* This sets the default-value of any make-variable-buffer-local to nil.
2514                    That just sucks.  User can just use setq-default to effect that,
2515                    but there's no way to do makunbound-default to undo this lossage. */
2516                 if (UNBOUNDP(valcontents))
2517                         bfwd->default_value = Qnil;
2518 #endif
2519 #if 0                           /* #### Yuck! */
2520                 /* This sets the value to nil in this buffer.
2521                    User could use (setq variable nil) to do this.
2522                    It isn't as egregious to do this automatically
2523                    as it is to do so to the default-value, but it's
2524                    still really dubious. */
2525                 if (UNBOUNDP(valcontents))
2526                         Fset(variable, Qnil);
2527 #endif
2528                 return variable;
2529         }
2530 }
2531
2532 DEFUN("make-local-variable", Fmake_local_variable, 1, 1, "vMake Local Variable: ",      /*
2533 Make VARIABLE have a separate value in the current buffer.
2534 Other buffers will continue to share a common default value.
2535 \(The buffer-local value of VARIABLE starts out as the same value
2536 VARIABLE previously had.  If VARIABLE was void, it remains void.)
2537 See also `make-variable-buffer-local'.
2538
2539 If the variable is already arranged to become local when set,
2540 this function causes a local value to exist for this buffer,
2541 just as setting the variable would do.
2542
2543 Do not use `make-local-variable' to make a hook variable buffer-local.
2544 Use `make-local-hook' instead.
2545 */
2546       (variable))
2547 {
2548         Lisp_Object valcontents;
2549         struct symbol_value_buffer_local *bfwd;
2550
2551         CHECK_SYMBOL(variable);
2552
2553       retry:
2554         verify_ok_for_buffer_local(variable, Qmake_local_variable);
2555
2556         valcontents = XSYMBOL(variable)->value;
2557
2558       retry_2:
2559         if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2560                 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2561                 case SYMVAL_LISP_MAGIC:
2562                         if (!UNBOUNDP(maybe_call_magic_handler
2563                                       (variable, Qmake_local_variable, 0)))
2564                                 return variable;
2565                         valcontents =
2566                             XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2567                         /* semi-change-o */
2568                         goto retry_2;
2569
2570                 case SYMVAL_VARALIAS:
2571                         variable =
2572                             follow_varalias_pointers(variable,
2573                                                      Qmake_local_variable);
2574                         /* presto change-o! */
2575                         goto retry;
2576
2577                 case SYMVAL_FIXNUM_FORWARD:
2578                 case SYMVAL_BOOLEAN_FORWARD:
2579                 case SYMVAL_OBJECT_FORWARD:
2580                 case SYMVAL_UNBOUND_MARKER:
2581                         break;
2582
2583                 case SYMVAL_BUFFER_LOCAL:
2584                 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2585                         /* Make sure the symbol has a local value in this
2586                            particular buffer, by setting it to the same value it
2587                            already has.  */
2588                         Fset(variable, find_symbol_value(variable));
2589                         return variable;
2590                 }
2591
2592                 case SYMVAL_SOME_BUFFER_LOCAL: {
2593                         if (!NILP(buffer_local_alist_element
2594                              (current_buffer, variable,
2595                               (XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)))))
2596                                 goto already_local_to_current_buffer;
2597                         else
2598                                 goto already_local_to_some_other_buffer;
2599                 }
2600
2601                 case SYMVAL_CONST_FIXNUM_FORWARD:
2602                 case SYMVAL_CONST_BOOLEAN_FORWARD:
2603                 case SYMVAL_CONST_OBJECT_FORWARD:
2604                 case SYMVAL_CONST_SPECIFIER_FORWARD:
2605                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2606                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2607                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2608                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2609                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2610                 default:
2611                         abort();
2612                 }
2613         }
2614
2615         /* Make sure variable is set up to hold per-buffer values */
2616         bfwd = alloc_lcrecord_type(struct symbol_value_buffer_local,
2617                                    &lrecord_symbol_value_buffer_local);
2618         zero_lcrecord(&bfwd->magic);
2619         bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2620
2621         bfwd->current_buffer = Qnil;
2622         bfwd->current_alist_element = Qnil;
2623         bfwd->current_value = valcontents;
2624         /* passing 0 is OK because this should never be a
2625            SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2626            variable. */
2627         bfwd->default_value = do_symval_forwarding(valcontents, 0, 0);
2628
2629 #if 0
2630         if (UNBOUNDP(bfwd->default_value))
2631                 bfwd->default_value = Qnil;     /* Yuck! */
2632 #endif
2633
2634         XSETSYMBOL_VALUE_MAGIC(valcontents, bfwd);
2635         *value_slot_past_magic(variable) = valcontents;
2636
2637       already_local_to_some_other_buffer:
2638
2639         /* Make sure this buffer has its own value of variable */
2640         bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2641
2642         if (UNBOUNDP(bfwd->default_value)) {
2643                 /* If default value is unbound, set local value to nil. */
2644                 XSETBUFFER(bfwd->current_buffer, current_buffer);
2645                 bfwd->current_alist_element = Fcons(variable, Qnil);
2646                 current_buffer->local_var_alist =
2647                     Fcons(bfwd->current_alist_element,
2648                           current_buffer->local_var_alist);
2649                 store_symval_forwarding(variable, bfwd->current_value, Qnil);
2650                 return variable;
2651         }
2652
2653         current_buffer->local_var_alist
2654             = Fcons(Fcons(variable, bfwd->default_value),
2655                     current_buffer->local_var_alist);
2656
2657         /* Make sure symbol does not think it is set up for this buffer;
2658            force it to look once again for this buffer's value */
2659         if (!NILP(bfwd->current_buffer) &&
2660             current_buffer == XBUFFER(bfwd->current_buffer))
2661                 bfwd->current_buffer = Qnil;
2662
2663       already_local_to_current_buffer:
2664
2665         /* If the symbol forwards into a C variable, then swap in the
2666            variable for this buffer immediately.  If C code modifies the
2667            variable before we swap in, then that new value will clobber the
2668            default value the next time we swap.  */
2669         bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2670         if (SYMBOL_VALUE_MAGIC_P(bfwd->current_value)) {
2671                 switch (XSYMBOL_VALUE_MAGIC_TYPE(bfwd->current_value)) {
2672                 case SYMVAL_FIXNUM_FORWARD:
2673                 case SYMVAL_BOOLEAN_FORWARD:
2674                 case SYMVAL_OBJECT_FORWARD:
2675                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2676                         set_up_buffer_local_cache(variable, bfwd,
2677                                                   current_buffer, Qnil, 1);
2678                         break;
2679
2680                 case SYMVAL_UNBOUND_MARKER:
2681                 case SYMVAL_CURRENT_BUFFER_FORWARD:
2682                         break;
2683
2684                 case SYMVAL_CONST_FIXNUM_FORWARD:
2685                 case SYMVAL_CONST_BOOLEAN_FORWARD:
2686                 case SYMVAL_CONST_OBJECT_FORWARD:
2687                 case SYMVAL_CONST_SPECIFIER_FORWARD:
2688                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2689                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2690                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2691                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2692                 case SYMVAL_BUFFER_LOCAL:
2693                 case SYMVAL_SOME_BUFFER_LOCAL:
2694                 case SYMVAL_LISP_MAGIC:
2695                 case SYMVAL_VARALIAS:
2696
2697                 default:
2698                         abort();
2699                 }
2700         }
2701
2702         return variable;
2703 }
2704
2705 DEFUN("kill-local-variable", Fkill_local_variable, 1, 1, "vKill Local Variable: ",      /*
2706 Make VARIABLE no longer have a separate value in the current buffer.
2707 From now on the default value will apply in this buffer.
2708 */
2709       (variable))
2710 {
2711         Lisp_Object valcontents;
2712
2713         CHECK_SYMBOL(variable);
2714
2715       retry:
2716         valcontents = XSYMBOL(variable)->value;
2717
2718       retry_2:
2719         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2720                 return variable;
2721
2722         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2723         case SYMVAL_LISP_MAGIC:
2724                 if (!UNBOUNDP(maybe_call_magic_handler
2725                               (variable, Qkill_local_variable, 0)))
2726                         return variable;
2727                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2728                 /* semi-change-o */
2729                 goto retry_2;
2730
2731         case SYMVAL_VARALIAS:
2732                 variable =
2733                     follow_varalias_pointers(variable, Qkill_local_variable);
2734                 /* presto change-o! */
2735                 goto retry;
2736
2737         case SYMVAL_CURRENT_BUFFER_FORWARD: {
2738                 const struct symbol_value_forward *fwd
2739                         = XSYMBOL_VALUE_FORWARD(valcontents);
2740                 int offset = ((char *)symbol_value_forward_forward(fwd)
2741                               - (char *)&buffer_local_flags);
2742                 int mask = XINT(*((Lisp_Object *)
2743                                   symbol_value_forward_forward(fwd)));
2744
2745                 if (mask > 0) {
2746                         int (*magicfun) (Lisp_Object sym,
2747                                          Lisp_Object * val,
2748                                          Lisp_Object in_object,
2749                                          int flags) =
2750                                 symbol_value_forward_magicfun(fwd);
2751                         Lisp_Object oldval = *(Lisp_Object *)
2752                                 (offset + (char *)XBUFFER(Vbuffer_defaults));
2753                         if (magicfun) {
2754                                 (magicfun) (variable, &oldval,
2755                                             make_buffer(current_buffer),
2756                                             0);
2757                         }
2758                         *(Lisp_Object *)(offset + (char *)current_buffer) =
2759                                 oldval;
2760                         current_buffer->local_var_flags &= ~mask;
2761                 }
2762                 return variable;
2763         }
2764
2765         case SYMVAL_BUFFER_LOCAL:
2766         case SYMVAL_SOME_BUFFER_LOCAL: {
2767                 /* Get rid of this buffer's alist element, if any */
2768                 struct symbol_value_buffer_local *bfwd
2769                         = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2770                 Lisp_Object alist = current_buffer->local_var_alist;
2771                 Lisp_Object alist_element
2772                         =
2773                         buffer_local_alist_element(current_buffer, variable,
2774                                                    bfwd);
2775
2776                 if (!NILP(alist_element))
2777                         current_buffer->local_var_alist =
2778                                 Fdelq(alist_element, alist);
2779
2780                 /* Make sure symbol does not think it is set up for this buffer;
2781                    force it to look once again for this buffer's value */
2782                 if (!NILP(bfwd->current_buffer) &&
2783                     current_buffer == XBUFFER(bfwd->current_buffer))
2784                         bfwd->current_buffer = Qnil;
2785
2786                 /* We just changed the value in the current_buffer.  If this
2787                    variable forwards to a C variable, we need to change the
2788                    value of the C variable.  set_up_buffer_local_cache() will do
2789                    this.  It doesn't hurt to do it always, so just go ahead and
2790                    do that. */
2791                 set_up_buffer_local_cache(variable, bfwd,
2792                                           current_buffer, Qnil, 1);
2793         }
2794                 return variable;
2795
2796         case SYMVAL_FIXNUM_FORWARD:
2797         case SYMVAL_CONST_FIXNUM_FORWARD:
2798         case SYMVAL_BOOLEAN_FORWARD:
2799         case SYMVAL_CONST_BOOLEAN_FORWARD:
2800         case SYMVAL_OBJECT_FORWARD:
2801         case SYMVAL_CONST_OBJECT_FORWARD:
2802         case SYMVAL_CONST_SPECIFIER_FORWARD:
2803         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2804         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2805         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2806         case SYMVAL_SELECTED_CONSOLE_FORWARD:
2807         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2808         case SYMVAL_UNBOUND_MARKER:
2809
2810         default:
2811                 return variable;
2812         }
2813         RETURN_NOT_REACHED(Qnil)        /* suppress compiler warning */
2814 }
2815
2816 DEFUN("kill-console-local-variable", Fkill_console_local_variable, 1, 1, 
2817       "vKill Console Local Variable: ", /*
2818 Make VARIABLE no longer have a separate value in the selected console.
2819 From now on the default value will apply in this console.
2820 */
2821       (variable))
2822 {
2823         Lisp_Object valcontents;
2824
2825         CHECK_SYMBOL(variable);
2826
2827       retry:
2828         valcontents = XSYMBOL(variable)->value;
2829
2830       retry_2:
2831         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2832                 return variable;
2833
2834         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2835         case SYMVAL_LISP_MAGIC:
2836                 if (!UNBOUNDP(maybe_call_magic_handler
2837                               (variable, Qkill_console_local_variable, 0)))
2838                         return variable;
2839                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2840                 /* semi-change-o */
2841                 goto retry_2;
2842
2843         case SYMVAL_VARALIAS:
2844                 variable = follow_varalias_pointers(variable,
2845                                                     Qkill_console_local_variable);
2846                 /* presto change-o! */
2847                 goto retry;
2848
2849         case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2850                 const struct symbol_value_forward *fwd
2851                         = XSYMBOL_VALUE_FORWARD(valcontents);
2852                 int offset = ((char *)symbol_value_forward_forward(fwd)
2853                               - (char *)&console_local_flags);
2854                 int mask = XINT(*((Lisp_Object *)
2855                                   symbol_value_forward_forward(fwd)));
2856
2857                 if (mask > 0) {
2858                         int (*magicfun) (Lisp_Object sym,
2859                                          Lisp_Object * val,
2860                                          Lisp_Object in_object,
2861                                          int flags) =
2862                                 symbol_value_forward_magicfun(fwd);
2863                         Lisp_Object oldval = *(Lisp_Object *)
2864                                 (offset +
2865                                  (char *)XCONSOLE(Vconsole_defaults));
2866                         if (magicfun) {
2867                                 magicfun(variable, &oldval,
2868                                          Vselected_console, 0);
2869                         }
2870                         *(Lisp_Object *) (offset +
2871                                           (char *)XCONSOLE(Vselected_console)) =
2872                                 oldval;
2873                         XCONSOLE(Vselected_console)->local_var_flags &= ~mask;
2874                 }
2875                 return variable;
2876         }
2877
2878         case SYMVAL_FIXNUM_FORWARD:
2879         case SYMVAL_CONST_FIXNUM_FORWARD:
2880         case SYMVAL_BOOLEAN_FORWARD:
2881         case SYMVAL_CONST_BOOLEAN_FORWARD:
2882         case SYMVAL_OBJECT_FORWARD:
2883         case SYMVAL_CONST_OBJECT_FORWARD:
2884         case SYMVAL_CONST_SPECIFIER_FORWARD:
2885         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2886         case SYMVAL_CURRENT_BUFFER_FORWARD:
2887         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2888         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2889         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2890         case SYMVAL_UNBOUND_MARKER:
2891         case SYMVAL_BUFFER_LOCAL:
2892         case SYMVAL_SOME_BUFFER_LOCAL:
2893
2894         default:
2895                 return variable;
2896         }
2897 }
2898
2899 /* Used by specbind to determine what effects it might have.  Returns:
2900  *   0 if symbol isn't buffer-local, and wouldn't be after it is set
2901  *  <0 if symbol isn't presently buffer-local, but set would make it so
2902  *  >0 if symbol is presently buffer-local
2903  */
2904 int symbol_value_buffer_local_info(Lisp_Object symbol, struct buffer *buffer)
2905 {
2906         Lisp_Object valcontents;
2907
2908       retry:
2909         valcontents = XSYMBOL(symbol)->value;
2910
2911       retry_2:
2912         if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2913                 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2914                 case SYMVAL_LISP_MAGIC:
2915                         /* #### kludge */
2916                         valcontents =
2917                             XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2918                         /* semi-change-o */
2919                         goto retry_2;
2920
2921                 case SYMVAL_VARALIAS:
2922                         symbol =
2923                             follow_varalias_pointers(symbol,
2924                                                      Qt /* #### kludge */ );
2925                         /* presto change-o! */
2926                         goto retry;
2927
2928                 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2929                         const struct symbol_value_forward *fwd
2930                                 = XSYMBOL_VALUE_FORWARD(valcontents);
2931                         int mask = XINT(*((Lisp_Object *)
2932                                           symbol_value_forward_forward
2933                                           (fwd)));
2934                         if ((mask <= 0) ||
2935                             (buffer && (buffer->local_var_flags & mask))){
2936                                 /* Already buffer-local */
2937                                 return 1;
2938                         } else {
2939                                 /* Would be buffer-local after set */
2940                                 return -1;
2941                         }
2942                 }
2943                 case SYMVAL_BUFFER_LOCAL:
2944                 case SYMVAL_SOME_BUFFER_LOCAL: {
2945                         struct symbol_value_buffer_local *bfwd
2946                                 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2947                         if (buffer
2948                             &&
2949                             !NILP(buffer_local_alist_element
2950                                   (buffer, symbol, bfwd)))
2951                                 return 1;
2952                         else
2953                                 /* Automatically becomes local when set */
2954                                 return bfwd->magic.type ==
2955                                         SYMVAL_BUFFER_LOCAL ? -1 : 0;
2956                 }
2957
2958                 case SYMVAL_FIXNUM_FORWARD:
2959                 case SYMVAL_CONST_FIXNUM_FORWARD:
2960                 case SYMVAL_BOOLEAN_FORWARD:
2961                 case SYMVAL_CONST_BOOLEAN_FORWARD:
2962                 case SYMVAL_OBJECT_FORWARD:
2963                 case SYMVAL_CONST_OBJECT_FORWARD:
2964                 case SYMVAL_CONST_SPECIFIER_FORWARD:
2965                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2966                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2967                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2968                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2969                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2970                 case SYMVAL_UNBOUND_MARKER:
2971
2972                 default:
2973                         return 0;
2974                 }
2975         }
2976         return 0;
2977 }
2978
2979 DEFUN("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0,       /*
2980 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2981 */
2982       (symbol, buffer, unbound_value))
2983 {
2984         Lisp_Object value;
2985         CHECK_SYMBOL(symbol);
2986         CHECK_BUFFER(buffer);
2987         value = symbol_value_in_buffer(symbol, buffer);
2988         return UNBOUNDP(value) ? unbound_value : value;
2989 }
2990
2991 DEFUN("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0,     /*
2992 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2993 */
2994       (symbol, console, unbound_value))
2995 {
2996         Lisp_Object value;
2997         CHECK_SYMBOL(symbol);
2998         CHECK_CONSOLE(console);
2999         value = symbol_value_in_console(symbol, console);
3000         return UNBOUNDP(value) ? unbound_value : value;
3001 }
3002
3003 DEFUN("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0,       /*
3004 -in variable, return info about this; else return nil.
3005 ll be a symbol, one of
3006
3007 A simple built-in variable.
3008         Same, but cannot be set.
3009 A built-in integer variable.
3010         Same, but cannot be set.
3011 A built-in boolean variable.
3012         Same, but cannot be set.
3013 Always contains a specifier; e.g. `has-modeline-p'.
3014 A built-in buffer-local variable.
3015 fer'    Same, but cannot be set.
3016 Forwards to the default value of a built-in
3017 buffer-local variable.
3018         A built-in console-local variable.
3019 nsole' Same, but cannot be set.
3020 Forwards to the default value of a built-in
3021 console-local variable.
3022 */
3023       (symbol))
3024 {
3025         REGISTER Lisp_Object valcontents;
3026
3027         CHECK_SYMBOL(symbol);
3028
3029       retry:
3030         valcontents = XSYMBOL(symbol)->value;
3031
3032       retry_2:
3033         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
3034                 return Qnil;
3035
3036         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
3037         case SYMVAL_LISP_MAGIC:
3038                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
3039                 /* semi-change-o */
3040                 goto retry_2;
3041
3042         case SYMVAL_VARALIAS:
3043                 symbol = follow_varalias_pointers(symbol, Qt);
3044                 /* presto change-o! */
3045                 goto retry;
3046
3047         case SYMVAL_BUFFER_LOCAL:
3048         case SYMVAL_SOME_BUFFER_LOCAL:
3049                 valcontents =
3050                     XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)->current_value;
3051                 /* semi-change-o */
3052                 goto retry_2;
3053
3054         case SYMVAL_FIXNUM_FORWARD:
3055                 return Qinteger;
3056         case SYMVAL_CONST_FIXNUM_FORWARD:
3057                 return Qconst_integer;
3058         case SYMVAL_BOOLEAN_FORWARD:
3059                 return Qboolean;
3060         case SYMVAL_CONST_BOOLEAN_FORWARD:
3061                 return Qconst_boolean;
3062         case SYMVAL_OBJECT_FORWARD:
3063                 return Qobject;
3064         case SYMVAL_CONST_OBJECT_FORWARD:
3065                 return Qconst_object;
3066         case SYMVAL_CONST_SPECIFIER_FORWARD:
3067                 return Qconst_specifier;
3068         case SYMVAL_DEFAULT_BUFFER_FORWARD:
3069                 return Qdefault_buffer;
3070         case SYMVAL_CURRENT_BUFFER_FORWARD:
3071                 return Qcurrent_buffer;
3072         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
3073                 return Qconst_current_buffer;
3074         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
3075                 return Qdefault_console;
3076         case SYMVAL_SELECTED_CONSOLE_FORWARD:
3077                 return Qselected_console;
3078         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
3079                 return Qconst_selected_console;
3080         case SYMVAL_UNBOUND_MARKER:
3081                 return Qnil;
3082
3083         default:
3084                 abort();
3085                 return Qnil;
3086         }
3087 }
3088
3089 DEFUN("local-variable-p", Flocal_variable_p, 2, 3, 0,   /*
3090 n t if SYMBOL's value is local to BUFFER.
3091 tional third arg AFTER-SET is non-nil, return t if SYMBOL would be
3092 r-local after it is set, regardless of whether it is so presently.
3093  value for BUFFER is *not* the same as (current-buffer), but means
3094 uffer".  Specifically:
3095
3096 If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
3097 the variable is one of the special built-in variables that is always
3098 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
3099 `buffer-undo-list', and others.)
3100
3101 If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
3102 the variable has had `make-variable-buffer-local' applied to it.
3103 */
3104       (symbol, buffer, after_set))
3105 {
3106         int local_info;
3107
3108         CHECK_SYMBOL(symbol);
3109         if (!NILP(buffer)) {
3110                 buffer = emacs_get_buffer(buffer, 1);
3111                 local_info =
3112                     symbol_value_buffer_local_info(symbol, XBUFFER(buffer));
3113         } else {
3114                 local_info = symbol_value_buffer_local_info(symbol, 0);
3115         }
3116
3117         if (NILP(after_set))
3118                 return local_info > 0 ? Qt : Qnil;
3119         else
3120                 return local_info != 0 ? Qt : Qnil;
3121 }
3122 \f
3123 /*
3124 I've gone ahead and partially implemented this because it's
3125 super-useful for dealing with the compatibility problems in supporting
3126 the old pointer-shape variables, and preventing people from `setq'ing
3127 the new variables.  Any other way of handling this problem is way
3128 ugly, likely to be slow, and generally not something I want to waste
3129 my time worrying about.
3130
3131 The interface and/or function name is sure to change before this
3132 gets into its final form.  I currently like the way everything is
3133 set up and it has all the features I want it to have, except for
3134 one: I really want to be able to have multiple nested handlers,
3135 to implement an `advice'-like capability.  This would allow,
3136 for example, a clean way of implementing `debug-if-set' or
3137 `debug-if-referenced' and such.
3138
3139 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
3140 ************************************************************
3141 **Only** the `set-value', `make-unbound', and `make-local'
3142 handler types are currently implemented.  Implementing the
3143 get-value and bound-predicate handlers is somewhat tricky
3144 because there are lots of subfunctions (e.g. find_symbol_value()).
3145 find_symbol_value(), in fact, is called from outside of
3146 this module.  You'd have to have it do this:
3147
3148 -- check for a `bound-predicate' handler, call that if so;
3149    if it returns nil, return Qunbound
3150 -- check for a `get-value' handler and call it and return
3151    that value
3152
3153 It gets even trickier when you have to deal with
3154 sub-subfunctions like find_symbol_value_1(), and esp.
3155 when you have to properly handle variable aliases, which
3156 can lead to lots of tricky situations.  So I've just
3157 punted on this, since the interface isn't officially
3158 exported and we can get by with just a `set-value'
3159 handler.
3160
3161 Actions in unimplemented handler types will correctly
3162 ignore any handlers, and will not fuck anything up or
3163 go awry.
3164
3165 WARNING WARNING: If you do go and implement another
3166 type of handler, make *sure* to change
3167 would_be_magic_handled() so it knows about this,
3168 or dire things could result.
3169 ************************************************************
3170 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
3171
3172 Real documentation is as follows.
3173
3174 Set a magic handler for VARIABLE.
3175 This allows you to specify arbitrary behavior that results from
3176 accessing or setting a variable.  For example, retrieving the
3177 variable's value might actually retrieve the first element off of
3178 a list stored in another variable, and setting the variable's value
3179 might add an element to the front of that list. (This is how the
3180 obsolete variable `unread-command-event' is implemented.)
3181
3182 In general it is NOT good programming practice to use magic variables
3183 in a new package that you are designing.  If you feel the need to
3184 do this, it's almost certainly a sign that you should be using a
3185 function instead of a variable.  This facility is provided to allow
3186 a package to support obsolete variables and provide compatibility
3187 with similar packages with different variable names and semantics.
3188 By using magic handlers, you can cleanly provide obsoleteness and
3189 compatibility support and separate this support from the core
3190 routines in a package.
3191
3192 VARIABLE should be a symbol naming the variable for which the
3193 magic behavior is provided.  HANDLER-TYPE is a symbol specifying
3194 which behavior is being controlled, and HANDLER is the function
3195 that will be called to control this behavior.  HARG is a
3196 value that will be passed to HANDLER but is otherwise
3197 uninterpreted.  KEEP-EXISTING specifies what to do with existing
3198 handlers of the same type; nil means "erase them all", t means
3199 "keep them but insert at the beginning", the list (t) means
3200 "keep them but insert at the end", a function means "keep
3201 them but insert before the specified function", a list containing
3202 a function means "keep them but insert after the specified
3203 function".
3204
3205 You can specify magic behavior for any type of variable at all,
3206 and for any handler types that are unspecified, the standard
3207 behavior applies.  This allows you, for example, to use
3208 `defvaralias' in conjunction with this function. (For that
3209 matter, `defvaralias' could be implemented using this function.)
3210
3211 The behaviors that can be specified in HANDLER-TYPE are
3212
3213 get-value               (SYM ARGS FUN HARG HANDLERS)
3214     This means that one of the functions `symbol-value',
3215     `default-value', `symbol-value-in-buffer', or
3216     `symbol-value-in-console' was called on SYM.
3217
3218 set-value               (SYM ARGS FUN HARG HANDLERS)
3219     This means that one of the functions `set' or `set-default'
3220     was called on SYM.
3221
3222 bound-predicate         (SYM ARGS FUN HARG HANDLERS)
3223     This means that one of the functions `boundp', `globally-boundp',
3224     or `default-boundp' was called on SYM.
3225
3226 make-unbound            (SYM ARGS FUN HARG HANDLERS)
3227     This means that the function `makunbound' was called on SYM.
3228
3229 local-predicate         (SYM ARGS FUN HARG HANDLERS)
3230     This means that the function `local-variable-p' was called
3231     on SYM.
3232
3233 make-local              (SYM ARGS FUN HARG HANDLERS)
3234     This means that one of the functions `make-local-variable',
3235     `make-variable-buffer-local', `kill-local-variable',
3236     or `kill-console-local-variable' was called on SYM.
3237
3238 The meanings of the arguments are as follows:
3239
3240    SYM is the symbol on which the function was called, and is always
3241    the first argument to the function.
3242
3243    ARGS are the remaining arguments in the original call (i.e. all
3244    but the first).  In the case of `set-value' in particular,
3245    the first element of ARGS is the value to which the variable
3246    is being set.  In some cases, ARGS is sanitized from what was
3247    actually given.  For example, whenever `nil' is passed to an
3248    argument and it means `current-buffer', the current buffer is
3249    substituted instead.
3250
3251    FUN is a symbol indicating which function is being called.
3252    For many of the functions, you can determine the corresponding
3253    function of a different class using
3254    `symbol-function-corresponding-function'.
3255
3256    HARG is the argument that was given in the call
3257    to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
3258
3259    HANDLERS is a structure containing the remaining handlers
3260    for the variable; to call one of them, use
3261    `chain-to-symbol-value-handler'.
3262
3263 NOTE: You may *not* modify the list in ARGS, and if you want to
3264 keep it around after the handler function exits, you must make
3265 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
3266 */
3267
3268 static enum lisp_magic_handler decode_magic_handler_type(Lisp_Object symbol)
3269 {
3270         if (EQ(symbol, Qget_value))
3271                 return MAGIC_HANDLER_GET_VALUE;
3272         if (EQ(symbol, Qset_value))
3273                 return MAGIC_HANDLER_SET_VALUE;
3274         if (EQ(symbol, Qbound_predicate))
3275                 return MAGIC_HANDLER_BOUND_PREDICATE;
3276         if (EQ(symbol, Qmake_unbound))
3277                 return MAGIC_HANDLER_MAKE_UNBOUND;
3278         if (EQ(symbol, Qlocal_predicate))
3279                 return MAGIC_HANDLER_LOCAL_PREDICATE;
3280         if (EQ(symbol, Qmake_local))
3281                 return MAGIC_HANDLER_MAKE_LOCAL;
3282
3283         signal_simple_error("Unrecognized symbol value handler type", symbol);
3284         abort();
3285         return MAGIC_HANDLER_MAX;
3286 }
3287
3288 static enum lisp_magic_handler
3289 handler_type_from_function_symbol(Lisp_Object funsym, int abort_if_not_found)
3290 {
3291         if (EQ(funsym, Qsymbol_value)
3292             || EQ(funsym, Qdefault_value)
3293             || EQ(funsym, Qsymbol_value_in_buffer)
3294             || EQ(funsym, Qsymbol_value_in_console))
3295                 return MAGIC_HANDLER_GET_VALUE;
3296
3297         if (EQ(funsym, Qset)
3298             || EQ(funsym, Qset_default))
3299                 return MAGIC_HANDLER_SET_VALUE;
3300
3301         if (EQ(funsym, Qboundp)
3302             || EQ(funsym, Qglobally_boundp)
3303             || EQ(funsym, Qdefault_boundp))
3304                 return MAGIC_HANDLER_BOUND_PREDICATE;
3305
3306         if (EQ(funsym, Qmakunbound))
3307                 return MAGIC_HANDLER_MAKE_UNBOUND;
3308
3309         if (EQ(funsym, Qlocal_variable_p))
3310                 return MAGIC_HANDLER_LOCAL_PREDICATE;
3311
3312         if (EQ(funsym, Qmake_variable_buffer_local)
3313             || EQ(funsym, Qmake_local_variable))
3314                 return MAGIC_HANDLER_MAKE_LOCAL;
3315
3316         if (abort_if_not_found)
3317                 abort();
3318         signal_simple_error("Unrecognized symbol-value function", funsym);
3319         return MAGIC_HANDLER_MAX;
3320 }
3321
3322 static int would_be_magic_handled(Lisp_Object sym, Lisp_Object funsym)
3323 {
3324         /* does not take into account variable aliasing. */
3325         Lisp_Object valcontents = XSYMBOL(sym)->value;
3326         enum lisp_magic_handler slot;
3327
3328         if (!SYMBOL_VALUE_LISP_MAGIC_P(valcontents))
3329                 return 0;
3330         slot = handler_type_from_function_symbol(funsym, 1);
3331         if (slot != MAGIC_HANDLER_SET_VALUE
3332             && slot != MAGIC_HANDLER_MAKE_UNBOUND
3333             && slot != MAGIC_HANDLER_MAKE_LOCAL)
3334                 /* #### temporary kludge because we haven't implemented
3335                    lisp-magic variables completely */
3336                 return 0;
3337         return !NILP(XSYMBOL_VALUE_LISP_MAGIC(valcontents)->handler[slot]);
3338 }
3339
3340 static Lisp_Object
3341 fetch_value_maybe_past_magic(Lisp_Object sym,
3342                              Lisp_Object follow_past_lisp_magic)
3343 {
3344         Lisp_Object value = XSYMBOL(sym)->value;
3345         if (SYMBOL_VALUE_LISP_MAGIC_P(value)
3346             && (EQ(follow_past_lisp_magic, Qt)
3347                 || (!NILP(follow_past_lisp_magic)
3348                     && !would_be_magic_handled(sym, follow_past_lisp_magic))))
3349                 value = XSYMBOL_VALUE_LISP_MAGIC(value)->shadowed;
3350         return value;
3351 }
3352
3353 static Lisp_Object *value_slot_past_magic(Lisp_Object sym)
3354 {
3355         Lisp_Object *store_pointer = &XSYMBOL(sym)->value;
3356
3357         if (SYMBOL_VALUE_LISP_MAGIC_P(*store_pointer))
3358                 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC(sym)->shadowed;
3359         return store_pointer;
3360 }
3361
3362 static Lisp_Object
3363 maybe_call_magic_handler(Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
3364 {
3365         va_list vargs;
3366         Lisp_Object args[20];   /* should be enough ... */
3367         int i;
3368         enum lisp_magic_handler htype;
3369         Lisp_Object legerdemain;
3370         struct symbol_value_lisp_magic *bfwd;
3371
3372         assert(nargs >= 0 && nargs < countof(args));
3373         legerdemain = XSYMBOL(sym)->value;
3374         assert(SYMBOL_VALUE_LISP_MAGIC_P(legerdemain));
3375         bfwd = XSYMBOL_VALUE_LISP_MAGIC(legerdemain);
3376
3377         va_start(vargs, nargs);
3378         for (i = 0; i < nargs; i++)
3379                 args[i] = va_arg(vargs, Lisp_Object);
3380         va_end(vargs);
3381
3382         htype = handler_type_from_function_symbol(funsym, 1);
3383         if (NILP(bfwd->handler[htype]))
3384                 return Qunbound;
3385         /* #### should be reusing the arglist, not always consing anew.
3386            Repeated handler invocations should not cause repeated consing.
3387            Doesn't matter for now, because this is just a quick implementation
3388            for obsolescence support. */
3389         return call5(bfwd->handler[htype], sym, Flist(nargs, args), funsym,
3390                      bfwd->harg[htype], Qnil);
3391 }
3392
3393 DEFUN("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler, 3, 5, 0,   /*
3394 Don't you dare use this.
3395 If you do, suffer the wrath of Ben, who is likely to rename
3396 this function (or change the semantics of its arguments) without
3397 pity, thereby invalidating your code.
3398 */
3399       (variable, handler_type, handler, harg, keep_existing))
3400 {
3401         Lisp_Object valcontents;
3402         struct symbol_value_lisp_magic *bfwd;
3403         enum lisp_magic_handler htype;
3404         int i;
3405
3406         /* #### WARNING, only some handler types are implemented.  See above.
3407            Actions of other types will ignore a handler if it's there.
3408
3409            #### Also, `chain-to-symbol-value-handler' and
3410            `symbol-function-corresponding-function' are not implemented. */
3411         CHECK_SYMBOL(variable);
3412         CHECK_SYMBOL(handler_type);
3413         htype = decode_magic_handler_type(handler_type);
3414         valcontents = XSYMBOL(variable)->value;
3415         if (!SYMBOL_VALUE_LISP_MAGIC_P(valcontents)) {
3416                 bfwd = alloc_lcrecord_type(struct symbol_value_lisp_magic,
3417                                            &lrecord_symbol_value_lisp_magic);
3418                 zero_lcrecord(&bfwd->magic);
3419                 bfwd->magic.type = SYMVAL_LISP_MAGIC;
3420                 for (i = 0; i < MAGIC_HANDLER_MAX; i++) {
3421                         bfwd->handler[i] = Qnil;
3422                         bfwd->harg[i] = Qnil;
3423                 }
3424                 bfwd->shadowed = valcontents;
3425                 XSETSYMBOL_VALUE_MAGIC(XSYMBOL(variable)->value, bfwd);
3426         } else
3427                 bfwd = XSYMBOL_VALUE_LISP_MAGIC(valcontents);
3428         bfwd->handler[htype] = handler;
3429         bfwd->harg[htype] = harg;
3430
3431         for (i = 0; i < MAGIC_HANDLER_MAX; i++)
3432                 if (!NILP(bfwd->handler[i]))
3433                         break;
3434
3435         if (i == MAGIC_HANDLER_MAX)
3436                 /* there are no remaining handlers, so remove the structure. */
3437                 XSYMBOL(variable)->value = bfwd->shadowed;
3438
3439         return Qnil;
3440 }
3441 \f
3442 /* functions for working with variable aliases.  */
3443
3444 /* Follow the chain of variable aliases for SYMBOL.  Return the
3445    resulting symbol, whose value cell is guaranteed not to be a
3446    symbol-value-varalias.
3447
3448    Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
3449    If FUNSYM is t, always follow in such a case.  If FUNSYM is nil,
3450    never follow; stop right there.  Otherwise FUNSYM should be a
3451    recognized symbol-value function symbol; this means, follow
3452    unless there is a special handler for the named function.
3453
3454    OK, there is at least one reason why it's necessary for
3455    FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
3456    can always be sure to catch cyclic variable aliasing.  If we never
3457    follow past Lisp magic, then if the following is done:
3458
3459    (defvaralias 'a 'b)
3460    add some magic behavior to a, but not a "get-value" handler
3461    (defvaralias 'b 'a)
3462
3463    then an attempt to retrieve a's or b's value would cause infinite
3464    looping in `symbol-value'.
3465
3466    We (of course) can't always follow past Lisp magic, because then
3467    we make any variable that is lisp-magic -> varalias behave as if
3468    the lisp-magic is not present at all.
3469  */
3470
3471 static Lisp_Object
3472 follow_varalias_pointers(Lisp_Object symbol, Lisp_Object follow_past_lisp_magic)
3473 {
3474 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
3475         Lisp_Object tortoise, hare, val;
3476         int count;
3477
3478         /* quick out just in case */
3479         if (!SYMBOL_VALUE_MAGIC_P(XSYMBOL(symbol)->value))
3480                 return symbol;
3481
3482         /* Compare implementation of indirect_function().  */
3483         for (hare = tortoise = symbol, count = 0;
3484              val = fetch_value_maybe_past_magic(hare, follow_past_lisp_magic),
3485              SYMBOL_VALUE_VARALIAS_P(val);
3486              hare = symbol_value_varalias_aliasee(XSYMBOL_VALUE_VARALIAS(val)),
3487              count++) {
3488                 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) {
3489                         continue;
3490                 }
3491                 if (count & 1) {
3492                         Lisp_Object tmp =
3493                                 fetch_value_maybe_past_magic(
3494                                         tortoise, follow_past_lisp_magic);
3495                         tortoise = symbol_value_varalias_aliasee(
3496                                 XSYMBOL_VALUE_VARALIAS(tmp));
3497                 }
3498                 if (EQ(hare, tortoise)) {
3499                         return Fsignal(Qcyclic_variable_indirection,
3500                                        list1(symbol));
3501                 }
3502         }
3503
3504         return hare;
3505 }
3506
3507 DEFUN("defvaralias", Fdefvaralias, 2, 2, 0,     /*
3508 Define a variable as an alias for another variable.
3509 Thenceforth, any operations performed on VARIABLE will actually be
3510 performed on ALIAS.  Both VARIABLE and ALIAS should be symbols.
3511 If ALIAS is nil, remove any aliases for VARIABLE.
3512 ALIAS can itself be aliased, and the chain of variable aliases
3513 will be followed appropriately.
3514 If VARIABLE already has a value, this value will be shadowed
3515 until the alias is removed, at which point it will be restored.
3516 Currently VARIABLE cannot be a built-in variable, a variable that
3517 has a buffer-local value in any buffer, or the symbols nil or t.
3518 \(ALIAS, however, can be any type of variable.)
3519 */
3520       (variable, alias))
3521 {
3522         struct symbol_value_varalias *bfwd;
3523         Lisp_Object valcontents;
3524
3525         CHECK_SYMBOL(variable);
3526         reject_constant_symbols(variable, Qunbound, 0, Qt);
3527
3528         valcontents = XSYMBOL(variable)->value;
3529
3530         if (NILP(alias)) {
3531                 if (SYMBOL_VALUE_VARALIAS_P(valcontents)) {
3532                         XSYMBOL(variable)->value =
3533                             symbol_value_varalias_shadowed
3534                             (XSYMBOL_VALUE_VARALIAS(valcontents));
3535                 }
3536                 return Qnil;
3537         }
3538
3539         CHECK_SYMBOL(alias);
3540         if (SYMBOL_VALUE_VARALIAS_P(valcontents)) {
3541                 /* transmogrify */
3542                 XSYMBOL_VALUE_VARALIAS(valcontents)->aliasee = alias;
3543                 return Qnil;
3544         }
3545
3546         if (SYMBOL_VALUE_MAGIC_P(valcontents)
3547             && !UNBOUNDP(valcontents))
3548                 signal_simple_error("Variable is magic and cannot be aliased",
3549                                     variable);
3550         reject_constant_symbols(variable, Qunbound, 0, Qt);
3551
3552         bfwd = alloc_lcrecord_type(struct symbol_value_varalias,
3553                                    &lrecord_symbol_value_varalias);
3554         zero_lcrecord(&bfwd->magic);
3555         bfwd->magic.type = SYMVAL_VARALIAS;
3556         bfwd->aliasee = alias;
3557         bfwd->shadowed = valcontents;
3558
3559         XSETSYMBOL_VALUE_MAGIC(valcontents, bfwd);
3560         XSYMBOL(variable)->value = valcontents;
3561         return Qnil;
3562 }
3563
3564 DEFUN("variable-alias", Fvariable_alias, 1, 2, 0,       /*
3565 If VARIABLE is aliased to another variable, return that variable.
3566 VARIABLE should be a symbol.  If VARIABLE is not aliased, return nil.
3567 Variable aliases are created with `defvaralias'.  See also
3568 `indirect-variable'.
3569 */
3570       (variable, follow_past_lisp_magic))
3571 {
3572         Lisp_Object valcontents;
3573
3574         CHECK_SYMBOL(variable);
3575         if (!NILP(follow_past_lisp_magic) && !EQ(follow_past_lisp_magic, Qt)) {
3576                 CHECK_SYMBOL(follow_past_lisp_magic);
3577                 handler_type_from_function_symbol(follow_past_lisp_magic, 0);
3578         }
3579
3580         valcontents = fetch_value_maybe_past_magic(variable,
3581                                                    follow_past_lisp_magic);
3582
3583         if (SYMBOL_VALUE_VARALIAS_P(valcontents))
3584                 return symbol_value_varalias_aliasee
3585                     (XSYMBOL_VALUE_VARALIAS(valcontents));
3586         else
3587                 return Qnil;
3588 }
3589
3590 DEFUN("indirect-variable", Findirect_variable, 1, 2, 0, /*
3591 Return the variable at the end of OBJECT's variable-alias chain.
3592 If OBJECT is a symbol, follow all variable aliases and return
3593 the final (non-aliased) symbol.  Variable aliases are created with
3594 the function `defvaralias'.
3595 If OBJECT is not a symbol, just return it.
3596 Signal a cyclic-variable-indirection error if there is a loop in the
3597 variable chain of symbols.
3598 */
3599       (object, follow_past_lisp_magic))
3600 {
3601         if (!SYMBOLP(object))
3602                 return object;
3603         if (!NILP(follow_past_lisp_magic) && !EQ(follow_past_lisp_magic, Qt)) {
3604                 CHECK_SYMBOL(follow_past_lisp_magic);
3605                 handler_type_from_function_symbol(follow_past_lisp_magic, 0);
3606         }
3607         return follow_varalias_pointers(object, follow_past_lisp_magic);
3608 }
3609
3610 DEFUN("variable-binding-locus", Fvariable_binding_locus, 1, 1, 0,       /*
3611 Return a value indicating where VARIABLE's current binding comes from.
3612 If the current binding is buffer-local, the value is the current buffer.
3613 If the current binding is global (the default), the value is nil. 
3614 */
3615       (variable))
3616 {
3617         Lisp_Object valcontents;
3618
3619         CHECK_SYMBOL(variable);
3620         variable = Findirect_variable(variable, Qnil);
3621
3622         /* Make sure the current binding is actually swapped in.  */
3623         find_symbol_value(variable);
3624
3625         valcontents = XSYMBOL(variable)->value;
3626
3627         if (SYMBOL_VALUE_MAGIC_P(valcontents)
3628             && ((XSYMBOL_VALUE_MAGIC_TYPE(valcontents) == SYMVAL_BUFFER_LOCAL)
3629                 || (XSYMBOL_VALUE_MAGIC_TYPE(valcontents) ==
3630                     SYMVAL_SOME_BUFFER_LOCAL))
3631             && (!NILP(Flocal_variable_p(variable, Fcurrent_buffer(), Qnil))))
3632                 return Fcurrent_buffer();
3633         else
3634                 return Qnil;
3635 }
3636 \f
3637 /************************************************************************/
3638 /*                            initialization                            */
3639 /************************************************************************/
3640
3641 /* A dumped SXEmacs image has a lot more than 1511 symbols.  Last
3642    estimate was that there were actually around 6300.  So let's try
3643    making this bigger and see if we get better hashing behavior. */
3644 #define OBARRAY_SIZE 16411
3645
3646 #ifndef Qzero
3647 Lisp_Object Qzero;
3648 #endif
3649 #ifndef Qnull_pointer
3650 Lisp_Object Qnull_pointer;
3651 #endif
3652
3653 /* some losing systems can't have static vars at function scope... */
3654 static struct symbol_value_magic guts_of_unbound_marker = {
3655         /* struct symbol_value_magic */
3656         {                       /* struct lcrecord_header */
3657          {                      /* struct lrecord_header */
3658           lrecord_type_symbol_value_forward,    /* lrecord_type_index */
3659           1,                    /* mark bit */
3660           1,                    /* c_readonly bit */
3661           1,                    /* lisp_readonly bit */
3662           },
3663 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
3664          0,                     /* next */
3665 #endif  /* !BDWGC */
3666          0,                     /* uid  */
3667          0,                     /* free */
3668          },
3669         0,                      /* value */
3670         SYMVAL_UNBOUND_MARKER
3671 };
3672
3673 static inline void
3674 intern_nil(void)
3675 {
3676         hcode_t hash = hash_string(string_data(XSYMBOL(Qnil)->name), 3);
3677         XVECTOR_DATA(Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3678         return;
3679 }
3680
3681 void init_symbols_once_early(void)
3682 {
3683         INIT_LRECORD_IMPLEMENTATION(symbol);
3684         INIT_LRECORD_IMPLEMENTATION(symbol_value_forward);
3685         INIT_LRECORD_IMPLEMENTATION(symbol_value_buffer_local);
3686         INIT_LRECORD_IMPLEMENTATION(symbol_value_lisp_magic);
3687         INIT_LRECORD_IMPLEMENTATION(symbol_value_varalias);
3688
3689         reinit_symbols_once_early();
3690
3691         /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3692            called the first time. */
3693         Qnil = Fmake_symbol(make_string_nocopy((Bufbyte *)"nil", 3));
3694         XSYMBOL(Qnil)->name->plist = Qnil;
3695         XSYMBOL(Qnil)->value = Qnil;    /* Nihil ex nihil */
3696         XSYMBOL(Qnil)->plist = Qnil;
3697
3698         Vobarray = make_vector(OBARRAY_SIZE, Qzero);
3699         initial_obarray = Vobarray;
3700         staticpro(&initial_obarray);
3701         /* Intern nil in the obarray */
3702         intern_nil();
3703
3704         {
3705                 /* Required to get around a GCC syntax error on certain
3706                    architectures */
3707                 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3708
3709                 XSETSYMBOL_VALUE_MAGIC(Qunbound, tem);
3710         }
3711
3712         XSYMBOL(Qnil)->function = Qunbound;
3713
3714         defsymbol(&Qt, "t");
3715         XSYMBOL(Qt)->value = Qt;        /* Veritas aeterna */
3716         Vquit_flag = Qnil;
3717
3718         dump_add_root_object(&Qnil);
3719         dump_add_root_object(&Qunbound);
3720         dump_add_root_object(&Vquit_flag);
3721 }
3722
3723 void reinit_symbols_once_early(void)
3724 {
3725 #ifndef Qzero
3726         Qzero = make_int(0);    /* Only used if Lisp_Object is a union type */
3727 #endif
3728
3729 #ifndef Qnull_pointer
3730         /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3731            so the following is actually a no-op.  */
3732         XSETOBJ(Qnull_pointer, 0);
3733 #endif
3734 }
3735
3736 static void
3737 defsymbol_massage_name_1(Lisp_Object * location, const char *name, int dump_p,
3738                          int multiword_predicate_p)
3739 {
3740         char temp[1024];
3741         size_t len = strlen(name) - 1;
3742         size_t i;
3743
3744         if (multiword_predicate_p)
3745                 /* If it is a multiword_predicate_p it is expected
3746                    the last char of name is a p, which should be
3747                    removed and replaced with "_p", so the net length
3748                    difference is 1 char, the '_' */
3749                 assert(len + 1 < sizeof(temp));
3750         else
3751                 assert(len < sizeof(temp));
3752         strcpy(temp, name + 1); /* Remove initial Q */
3753         if (multiword_predicate_p) {
3754                 /* Overwrite the 'p' which is the last char of name
3755                    and put "_p" instead. */
3756                 strcpy(temp + len - 1, "_p");
3757                 len++;
3758         }
3759         for (i = 0; i < len; i++)
3760                 if (temp[i] == '_')
3761                         temp[i] = '-';
3762         *location = Fintern(make_string((const Bufbyte *)temp, len), Qnil);
3763         if (dump_p)
3764                 staticpro(location);
3765         else
3766                 staticpro_nodump(location);
3767 }
3768
3769 void defsymbol_massage_name_nodump(Lisp_Object * location, const char *name)
3770 {
3771         defsymbol_massage_name_1(location, name, 0, 0);
3772 }
3773
3774 void defsymbol_massage_name(Lisp_Object * location, const char *name)
3775 {
3776         defsymbol_massage_name_1(location, name, 1, 0);
3777 }
3778
3779 void
3780 defsymbol_massage_multiword_predicate_nodump(Lisp_Object * location,
3781                                              const char *name)
3782 {
3783         defsymbol_massage_name_1(location, name, 0, 1);
3784 }
3785
3786 void
3787 defsymbol_massage_multiword_predicate(Lisp_Object * location, const char *name)
3788 {
3789         defsymbol_massage_name_1(location, name, 1, 1);
3790 }
3791
3792 void defsymbol_nodump(Lisp_Object * location, char *name)
3793 {
3794         *location = Fintern(make_string_nocopy(
3795                                     (Bufbyte *)name, strlen(name)), Qnil);
3796         staticpro_nodump(location);
3797 }
3798
3799 void defsymbol(Lisp_Object * location, char *name)
3800 {
3801         *location = Fintern(make_string_nocopy(
3802                                     (Bufbyte*)name, strlen(name)), Qnil);
3803         staticpro(location);
3804 }
3805
3806 void defkeyword(Lisp_Object * location, char *name)
3807 {
3808         defsymbol(location, name);
3809         Fset(*location, *location);
3810 }
3811
3812 void defkeyword_massage_name(Lisp_Object * location, const char *name)
3813 {
3814         char temp[500];
3815         size_t len = strlen(name);
3816
3817         assert(len < sizeof(temp));
3818         strcpy(temp, name);
3819         temp[1] = ':';          /* it's an underscore in the C variable */
3820
3821         defsymbol_massage_name(location, temp);
3822         Fset(*location, *location);
3823 }
3824
3825 #ifdef DEBUG_SXEMACS
3826 /* Check that nobody spazzed writing a DEFUN. */
3827 static void check_sane_subr(Lisp_Subr * subr, Lisp_Object sym)
3828 {
3829         assert(subr->min_args >= 0);
3830         assert(subr->min_args <= SUBR_MAX_ARGS);
3831
3832         if (subr->max_args != MANY && subr->max_args != UNEVALLED) {
3833                 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3834                 assert(subr->max_args <= SUBR_MAX_ARGS);
3835                 assert(subr->min_args <= subr->max_args);
3836         }
3837
3838 #if defined somebody_can_explain_why_a_symbol_must_not_be_bound &&      \
3839         somebody_can_explain_why_a_symbol_must_not_be_bound
3840         assert(UNBOUNDP(XSYMBOL(sym)->function));
3841 #endif  /* somebody_can_explain_why_a_symbol_must_not_be_bound */
3842 }
3843 #else
3844 #define check_sane_subr(subr, sym)      /* nothing */
3845 #endif
3846
3847
3848 void defsubr(Lisp_Subr * subr)
3849 {
3850         Lisp_Object sym = intern(subr_name(subr));
3851         Lisp_Object fun;
3852
3853         check_sane_subr(subr, sym);
3854
3855         XSETSUBR(fun, subr);
3856         XSYMBOL(sym)->function = fun;
3857
3858         /* work on me!!! */
3859 #ifdef HAVE_SHLIB
3860         /* If it is declared in a module, update the load history */
3861         if (initialized)
3862                 LOADHIST_ATTACH(sym);
3863 #endif
3864         return;
3865 }
3866
3867 void
3868 undefsubr(Lisp_Subr *subr)
3869 {
3870         Lisp_Object sym = intern(subr_name(subr));
3871
3872         check_sane_subr(subr, sym);
3873         XSYMBOL(sym)->function = Qunbound;
3874         return;
3875 }
3876
3877 /* Define a lisp macro using a Lisp_Subr. */
3878 void defsubr_macro(Lisp_Subr * subr)
3879 {
3880         Lisp_Object sym = intern(subr_name(subr));
3881         Lisp_Object fun;
3882
3883         check_sane_subr(subr, sym);
3884
3885         XSETSUBR(fun, subr);
3886         XSYMBOL(sym)->function = Fcons(Qmacro, fun);
3887 }
3888
3889 static void
3890 deferror_1(Lisp_Object * symbol, char *name, const char *messuhhj,
3891            Lisp_Object inherits_from, int massage_p)
3892 {
3893         Lisp_Object conds;
3894         if (massage_p)
3895                 defsymbol_massage_name(symbol, name);
3896         else
3897                 defsymbol(symbol, name);
3898
3899         assert(SYMBOLP(inherits_from));
3900         conds = Fget(inherits_from, Qerror_conditions, Qnil);
3901         Fput(*symbol, Qerror_conditions, Fcons(*symbol, conds));
3902         /* NOT build_translated_string ().  This function is called at load time
3903            and the string needs to get translated at run time.  (This happens
3904            in the function (display-error) in cmdloop.el.) */
3905         Fput(*symbol, Qerror_message, build_string(messuhhj));
3906 }
3907
3908 void
3909 deferror(Lisp_Object *symbol, char *name, const char *messuhhj,
3910          Lisp_Object inherits_from)
3911 {
3912         deferror_1(symbol, name, messuhhj, inherits_from, 0);
3913 }
3914
3915 void
3916 deferror_massage_name(Lisp_Object * symbol, char *name,
3917                       const char *messuhhj, Lisp_Object inherits_from)
3918 {
3919         deferror_1(symbol, name, messuhhj, inherits_from, 1);
3920 }
3921
3922 void
3923 deferror_massage_name_and_message(Lisp_Object * symbol, char *name,
3924                                   Lisp_Object inherits_from)
3925 {
3926         char temp[500];
3927         size_t i;
3928         size_t len = strlen(name) - 1;
3929
3930         assert(len < sizeof(temp));
3931         strcpy(temp, name + 1); /* Remove initial Q */
3932         temp[0] = toupper(temp[0]);
3933         for (i = 0; i < len; i++)
3934                 if (temp[i] == '_')
3935                         temp[i] = ' ';
3936
3937         deferror_1(symbol, name, temp, inherits_from, 1);
3938 }
3939
3940 void syms_of_symbols(void)
3941 {
3942         DEFSYMBOL(Qvariable_documentation);
3943         DEFSYMBOL(Qvariable_domain);    /* I18N3 */
3944         DEFSYMBOL(Qad_advice_info);
3945         DEFSYMBOL(Qad_activate);
3946
3947         DEFSYMBOL(Qget_value);
3948         DEFSYMBOL(Qset_value);
3949         DEFSYMBOL(Qbound_predicate);
3950         DEFSYMBOL(Qmake_unbound);
3951         DEFSYMBOL(Qlocal_predicate);
3952         DEFSYMBOL(Qmake_local);
3953
3954         DEFSYMBOL(Qboundp);
3955         DEFSYMBOL(Qglobally_boundp);
3956         DEFSYMBOL(Qmakunbound);
3957         DEFSYMBOL(Qsymbol_value);
3958         DEFSYMBOL(Qset);
3959         DEFSYMBOL(Qsetq_default);
3960         DEFSYMBOL(Qdefault_boundp);
3961         DEFSYMBOL(Qdefault_value);
3962         DEFSYMBOL(Qset_default);
3963         DEFSYMBOL(Qmake_variable_buffer_local);
3964         DEFSYMBOL(Qmake_local_variable);
3965         DEFSYMBOL(Qkill_local_variable);
3966         DEFSYMBOL(Qkill_console_local_variable);
3967         DEFSYMBOL(Qsymbol_value_in_buffer);
3968         DEFSYMBOL(Qsymbol_value_in_console);
3969         DEFSYMBOL(Qlocal_variable_p);
3970         DEFSYMBOL(Qconst_integer);
3971         DEFSYMBOL(Qconst_boolean);
3972         DEFSYMBOL(Qconst_object);
3973         DEFSYMBOL(Qconst_specifier);
3974         DEFSYMBOL(Qdefault_buffer);
3975         DEFSYMBOL(Qcurrent_buffer);
3976         DEFSYMBOL(Qconst_current_buffer);
3977         DEFSYMBOL(Qdefault_console);
3978         DEFSYMBOL(Qselected_console);
3979         DEFSYMBOL(Qconst_selected_console);
3980         DEFSYMBOL(Qsetf);
3981         DEFSYMBOL(Qsymbol_macro);
3982
3983         DEFSUBR(Fintern);
3984         DEFSUBR(Fintern_soft);
3985         DEFSUBR(Funintern);
3986         DEFSUBR(Fmapatoms);
3987         DEFSUBR(Fapropos_internal);
3988
3989         DEFSUBR(Fsymbol_function);
3990         DEFSUBR(Fsymbol_plist);
3991         DEFSUBR(Fsymbol_name);
3992         DEFSUBR(Fmakunbound);
3993         DEFSUBR(Ffmakunbound);
3994         DEFSUBR(Fboundp);
3995         DEFSUBR(Fglobally_boundp);
3996         DEFSUBR(Ffboundp);
3997         DEFSUBR(Ffset);
3998         DEFSUBR(Fdefine_function);
3999         Ffset(intern("defalias"), intern("define-function"));
4000         DEFSUBR (Fspecial_form_p);
4001         DEFSUBR (Fsubr_name);
4002         DEFSUBR(Fsetplist);
4003         DEFSUBR(Fsymbol_value_in_buffer);
4004         DEFSUBR(Fsymbol_value_in_console);
4005         DEFSUBR(Fbuilt_in_variable_type);
4006         DEFSUBR(Fsymbol_value);
4007         DEFSUBR(Fset);
4008         DEFSUBR(Fdefault_boundp);
4009         DEFSUBR(Fdefault_value);
4010         DEFSUBR(Fset_default);
4011         DEFSUBR(Fsetq_default);
4012         DEFSUBR(Fmake_variable_buffer_local);
4013         DEFSUBR(Fmake_local_variable);
4014         DEFSUBR(Fkill_local_variable);
4015         DEFSUBR(Fkill_console_local_variable);
4016         DEFSUBR(Flocal_variable_p);
4017         DEFSUBR(Fdefvaralias);
4018         DEFSUBR(Fvariable_alias);
4019         DEFSUBR(Findirect_variable);
4020         DEFSUBR(Fvariable_binding_locus);
4021         DEFSUBR(Fdontusethis_set_symbol_value_handler);
4022 }
4023
4024 /* Create and initialize a Lisp variable whose value is forwarded to C data */
4025 void
4026 defvar_magic(char *symbol_name, const struct symbol_value_forward *magic)
4027 {
4028         Lisp_Object sym;
4029
4030 #if defined WITH_EMODULES && defined HAVE_EMODULES
4031         /*
4032          * As with defsubr(), this will only be called in a dumped Emacs when
4033          * we are adding variables from a dynamically loaded module. That means
4034          * we can't use purespace. Take that into account.
4035          */
4036         if (initialized)
4037                 sym = Fintern(build_string(symbol_name), Qnil);
4038         else
4039 #endif
4040                 sym = Fintern(make_string_nocopy((Bufbyte *)symbol_name,
4041                                                  strlen(symbol_name)), Qnil);
4042         XSYMBOL(sym)->value = (Lisp_Object)(const void*)magic;
4043         return;
4044 }
4045
4046 void vars_of_symbols(void)
4047 {
4048         DEFVAR_LISP("obarray", &Vobarray        /*
4049 Symbol table for use by `intern' and `read'.
4050 It is a vector whose length ought to be prime for best results.
4051 The vector's contents don't make sense if examined from Lisp programs;
4052 to find all the symbols in an obarray, use `mapatoms'.
4053                                                  */ );
4054         /* obarray has been initialized long before */
4055 }