Fix openssl support
[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         write_fmt_str( printcharfun, "#<INTERNAL OBJECT (SXEmacs bug?) (%s type %d) 0x%lx>",
1242                        XRECORD_LHEADER_IMPLEMENTATION(obj)->name,
1243                        XSYMBOL_VALUE_MAGIC_TYPE(obj), (long)XPNTR(obj));
1244 }
1245
1246 static const struct lrecord_description symbol_value_forward_description[] = {
1247         {XD_END}
1248 };
1249
1250 static const struct lrecord_description symbol_value_buffer_local_description[]
1251     = {
1252         {XD_LISP_OBJECT,
1253          offsetof(struct symbol_value_buffer_local, default_value)},
1254         {XD_LISP_OBJECT,
1255          offsetof(struct symbol_value_buffer_local, current_value)},
1256         {XD_LISP_OBJECT,
1257          offsetof(struct symbol_value_buffer_local, current_buffer)},
1258         {XD_LISP_OBJECT,
1259          offsetof(struct symbol_value_buffer_local, current_alist_element)},
1260         {XD_END}
1261 };
1262
1263 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
1264         {XD_LISP_OBJECT_ARRAY,
1265          offsetof(struct symbol_value_lisp_magic, handler),
1266          2 * MAGIC_HANDLER_MAX + 1},
1267         {XD_END}
1268 };
1269
1270 static const struct lrecord_description symbol_value_varalias_description[] = {
1271         {XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, aliasee)},
1272         {XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, shadowed)},
1273         {XD_END}
1274 };
1275
1276 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-forward",
1277                               symbol_value_forward,
1278                               0,
1279                               print_symbol_value_magic, 0, 0, 0,
1280                               symbol_value_forward_description,
1281                               struct symbol_value_forward);
1282
1283 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-buffer-local",
1284                               symbol_value_buffer_local,
1285                               mark_symbol_value_buffer_local,
1286                               print_symbol_value_magic, 0, 0, 0,
1287                               symbol_value_buffer_local_description,
1288                               struct symbol_value_buffer_local);
1289
1290 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-lisp-magic",
1291                               symbol_value_lisp_magic,
1292                               mark_symbol_value_lisp_magic,
1293                               print_symbol_value_magic, 0, 0, 0,
1294                               symbol_value_lisp_magic_description,
1295                               struct symbol_value_lisp_magic);
1296
1297 DEFINE_LRECORD_IMPLEMENTATION("symbol-value-varalias",
1298                               symbol_value_varalias,
1299                               mark_symbol_value_varalias,
1300                               print_symbol_value_magic, 0, 0, 0,
1301                               symbol_value_varalias_description,
1302                               struct symbol_value_varalias);
1303 \f
1304 /* Getting and setting values of symbols */
1305
1306 /* Given the raw contents of a symbol value cell, return the Lisp value of
1307    the symbol.  However, VALCONTENTS cannot be a symbol-value-buffer-local,
1308    symbol-value-lisp-magic, or symbol-value-varalias.
1309
1310    BUFFER specifies a buffer, and is used for built-in buffer-local
1311    variables, which are of type SYMVAL_CURRENT_BUFFER_FORWARD.
1312    Note that such variables are never encapsulated in a
1313    symbol-value-buffer-local structure.
1314
1315    CONSOLE specifies a console, and is used for built-in console-local
1316    variables, which are of type SYMVAL_SELECTED_CONSOLE_FORWARD.
1317    Note that such variables are (currently) never encapsulated in a
1318    symbol-value-buffer-local structure.
1319  */
1320
1321 static Lisp_Object
1322 do_symval_forwarding(Lisp_Object valcontents, struct buffer *buffer,
1323                      struct console *console)
1324 {
1325         const struct symbol_value_forward *fwd;
1326
1327         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1328                 return valcontents;
1329
1330         fwd = XSYMBOL_VALUE_FORWARD(valcontents);
1331         switch (fwd->magic.type) {
1332         case SYMVAL_FIXNUM_FORWARD:
1333         case SYMVAL_CONST_FIXNUM_FORWARD:
1334                 return
1335                     make_int(*((Fixnum *) symbol_value_forward_forward(fwd)));
1336
1337         case SYMVAL_BOOLEAN_FORWARD:
1338         case SYMVAL_CONST_BOOLEAN_FORWARD:
1339                 return *((int *)symbol_value_forward_forward(fwd)) ? Qt : Qnil;
1340
1341         case SYMVAL_OBJECT_FORWARD:
1342         case SYMVAL_CONST_OBJECT_FORWARD:
1343         case SYMVAL_CONST_SPECIFIER_FORWARD:
1344                 return *((Lisp_Object *) symbol_value_forward_forward(fwd));
1345
1346         case SYMVAL_DEFAULT_BUFFER_FORWARD:
1347                 return (*((Lisp_Object *) ((char *)XBUFFER(Vbuffer_defaults)
1348                                            +
1349                                            ((char *)
1350                                             symbol_value_forward_forward(fwd)
1351                                             - (char *)&buffer_local_flags))));
1352
1353         case SYMVAL_CURRENT_BUFFER_FORWARD:
1354         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1355                 assert(buffer);
1356                 return (*((Lisp_Object *) ((char *)buffer
1357                                            +
1358                                            ((char *)
1359                                             symbol_value_forward_forward(fwd)
1360                                             - (char *)&buffer_local_flags))));
1361
1362         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1363                 return (*((Lisp_Object *) ((char *)XCONSOLE(Vconsole_defaults)
1364                                            +
1365                                            ((char *)
1366                                             symbol_value_forward_forward(fwd)
1367                                             - (char *)&console_local_flags))));
1368
1369         case SYMVAL_SELECTED_CONSOLE_FORWARD:
1370         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1371                 assert(console);
1372                 return (*((Lisp_Object *) ((char *)console
1373                                            +
1374                                            ((char *)
1375                                             symbol_value_forward_forward(fwd)
1376                                             - (char *)&console_local_flags))));
1377
1378         case SYMVAL_UNBOUND_MARKER:
1379                 return valcontents;
1380
1381         case SYMVAL_BUFFER_LOCAL:
1382         case SYMVAL_SOME_BUFFER_LOCAL:
1383         case SYMVAL_LISP_MAGIC:
1384         case SYMVAL_VARALIAS:
1385         default:
1386                 abort();
1387         }
1388         return Qnil;            /* suppress compiler warning */
1389 }
1390
1391 /* Set the value of default-buffer-local variable SYM to VALUE. */
1392
1393 static void set_default_buffer_slot_variable(Lisp_Object sym, Lisp_Object value)
1394 {
1395         /* Handle variables like case-fold-search that have special slots in
1396            the buffer. Make them work apparently like buffer_local variables.
1397          */
1398         /* At this point, the value cell may not contain a symbol-value-varalias
1399            or symbol-value-buffer-local, and if there's a handler, we should
1400            have already called it. */
1401         Lisp_Object valcontents = fetch_value_maybe_past_magic(sym, Qt);
1402         const struct symbol_value_forward *fwd
1403             = XSYMBOL_VALUE_FORWARD(valcontents);
1404         int offset = ((char *)symbol_value_forward_forward(fwd)
1405                       - (char *)&buffer_local_flags);
1406         int mask = XINT(*((Lisp_Object *) symbol_value_forward_forward(fwd)));
1407         int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1408                          Lisp_Object in_object, int flags) =
1409             symbol_value_forward_magicfun(fwd);
1410
1411         *((Lisp_Object *) (offset + (char *)XBUFFER(Vbuffer_defaults)))
1412             = value;
1413
1414         if (mask > 0) {         /* Not always per-buffer */
1415                 /* Set value in each buffer which hasn't shadowed the default */
1416                 LIST_LOOP_2(elt, Vbuffer_alist) {
1417                         struct buffer *b = XBUFFER(XCDR(elt));
1418                         if (!(b->local_var_flags & mask)) {
1419                                 if (magicfun)
1420                                         magicfun(sym, &value, make_buffer(b),
1421                                                  0);
1422                                 *((Lisp_Object *) (offset + (char *)b)) = value;
1423                         }
1424                 }
1425         }
1426 }
1427
1428 /* Set the value of default-console-local variable SYM to VALUE. */
1429
1430 static void
1431 set_default_console_slot_variable(Lisp_Object sym, Lisp_Object value)
1432 {
1433         /* Handle variables like case-fold-search that have special slots in
1434            the console. Make them work apparently like console_local variables.
1435          */
1436         /* At this point, the value cell may not contain a symbol-value-varalias
1437            or symbol-value-buffer-local, and if there's a handler, we should
1438            have already called it. */
1439         Lisp_Object valcontents = fetch_value_maybe_past_magic(sym, Qt);
1440         const struct symbol_value_forward *fwd
1441             = XSYMBOL_VALUE_FORWARD(valcontents);
1442         int offset = ((char *)symbol_value_forward_forward(fwd)
1443                       - (char *)&console_local_flags);
1444         int mask = XINT(*((Lisp_Object *) symbol_value_forward_forward(fwd)));
1445         int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1446                          Lisp_Object in_object, int flags) =
1447             symbol_value_forward_magicfun(fwd);
1448
1449         *((Lisp_Object *) (offset + (char *)XCONSOLE(Vconsole_defaults)))
1450             = value;
1451
1452         if (mask > 0) {         /* Not always per-console */
1453                 /* Set value in each console which hasn't shadowed the default */
1454                 LIST_LOOP_2(console, Vconsole_list) {
1455                         struct console *d = XCONSOLE(console);
1456                         if (!(d->local_var_flags & mask)) {
1457                                 if (magicfun)
1458                                         magicfun(sym, &value, console, 0);
1459                                 *((Lisp_Object *) (offset + (char *)d)) = value;
1460                         }
1461                 }
1462         }
1463 }
1464
1465 /* Store NEWVAL into SYM.
1466
1467    SYM's value slot may *not* be types (5) or (6) above,
1468    i.e. no symbol-value-varalias objects. (You should have
1469    forwarded past all of these.)
1470
1471    SYM should not be an unsettable symbol or a symbol with
1472    a magic `set-value' handler (unless you want to explicitly
1473    ignore this handler).
1474
1475    OVALUE is the current value of SYM, but forwarded past any
1476    symbol-value-buffer-local and symbol-value-lisp-magic objects.
1477    (i.e. if SYM is a symbol-value-buffer-local, OVALUE should be
1478    the contents of its current-value cell.) NEWVAL may only be
1479    a simple value or Qunbound.  If SYM is a symbol-value-buffer-local,
1480    this function will only modify its current-value cell, which should
1481    already be set up to point to the current buffer.
1482   */
1483
1484 static void
1485 store_symval_forwarding(Lisp_Object sym, Lisp_Object ovalue, Lisp_Object newval)
1486 {
1487         if (!SYMBOL_VALUE_MAGIC_P(ovalue) || UNBOUNDP(ovalue)) {
1488                 Lisp_Object *store_pointer = value_slot_past_magic(sym);
1489
1490                 if (SYMBOL_VALUE_BUFFER_LOCAL_P(*store_pointer))
1491                         store_pointer =
1492                             &XSYMBOL_VALUE_BUFFER_LOCAL(*store_pointer)->
1493                             current_value;
1494
1495                 assert(UNBOUNDP(*store_pointer)
1496                        || !SYMBOL_VALUE_MAGIC_P(*store_pointer));
1497                 *store_pointer = newval;
1498         } else {
1499                 const struct symbol_value_forward *fwd =
1500                     XSYMBOL_VALUE_FORWARD(ovalue);
1501                 int (*magicfun) (Lisp_Object simm, Lisp_Object * val,
1502                                  Lisp_Object in_object, int flags)
1503                 = symbol_value_forward_magicfun(fwd);
1504
1505                 switch (XSYMBOL_VALUE_MAGIC_TYPE(ovalue)) {
1506                 case SYMVAL_FIXNUM_FORWARD:
1507                         CHECK_INT(newval);
1508                         if (magicfun)
1509                                 magicfun(sym, &newval, Qnil, 0);
1510                         *((Fixnum *) symbol_value_forward_forward(fwd)) =
1511                             XINT(newval);
1512                         return;
1513
1514                 case SYMVAL_BOOLEAN_FORWARD:
1515                         if (magicfun)
1516                                 magicfun(sym, &newval, Qnil, 0);
1517                         *((int *)symbol_value_forward_forward(fwd))
1518                             = !NILP(newval);
1519                         return;
1520
1521                 case SYMVAL_OBJECT_FORWARD:
1522                         if (magicfun)
1523                                 magicfun(sym, &newval, Qnil, 0);
1524                         *((Lisp_Object *) symbol_value_forward_forward(fwd)) =
1525                             newval;
1526                         return;
1527
1528                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
1529                         set_default_buffer_slot_variable(sym, newval);
1530                         return;
1531
1532                 case SYMVAL_CURRENT_BUFFER_FORWARD:
1533                         if (magicfun)
1534                                 magicfun(sym, &newval,
1535                                          make_buffer(current_buffer), 0);
1536                         *((Lisp_Object *) ((char *)current_buffer +
1537                                            ((char *)
1538                                             symbol_value_forward_forward(fwd)
1539                                             - (char *)&buffer_local_flags)))
1540                             = newval;
1541                         return;
1542
1543                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1544                         set_default_console_slot_variable(sym, newval);
1545                         return;
1546
1547                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1548                         if (magicfun)
1549                                 magicfun(sym, &newval, Vselected_console, 0);
1550                         *((Lisp_Object *) ((char *)XCONSOLE(Vselected_console)
1551                                            +
1552                                            ((char *)
1553                                             symbol_value_forward_forward(fwd)
1554                                             - (char *)&console_local_flags)))
1555                             = newval;
1556                         return;
1557
1558                         /* list all cases */
1559                 case SYMVAL_CONST_FIXNUM_FORWARD:
1560                 case SYMVAL_CONST_BOOLEAN_FORWARD:
1561                 case SYMVAL_CONST_OBJECT_FORWARD:
1562                 case SYMVAL_CONST_SPECIFIER_FORWARD:
1563                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1564                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1565                 case SYMVAL_UNBOUND_MARKER:
1566                 case SYMVAL_BUFFER_LOCAL:
1567                 case SYMVAL_SOME_BUFFER_LOCAL:
1568                 case SYMVAL_LISP_MAGIC:
1569                 case SYMVAL_VARALIAS:
1570
1571                 default:
1572                         abort();
1573                 }
1574         }
1575 }
1576
1577 /* Given a per-buffer variable SYMBOL and its raw value-cell contents
1578    BFWD, locate and return a pointer to the element in BUFFER's
1579    local_var_alist for SYMBOL.  The return value will be Qnil if
1580    BUFFER does not have its own value for SYMBOL (i.e. the default
1581    value is seen in that buffer).
1582    */
1583
1584 static Lisp_Object
1585 buffer_local_alist_element(struct buffer *buffer, Lisp_Object symbol,
1586                            struct symbol_value_buffer_local *bfwd)
1587 {
1588         if (!NILP(bfwd->current_buffer) &&
1589             XBUFFER(bfwd->current_buffer) == buffer)
1590                 /* This is just an optimization of the below. */
1591                 return bfwd->current_alist_element;
1592         else
1593                 return assq_no_quit(symbol, buffer->local_var_alist);
1594 }
1595
1596 /* [Remember that the slot that mirrors CURRENT-VALUE in the
1597    symbol-value-buffer-local of a per-buffer variable -- i.e. the
1598    slot in CURRENT-BUFFER's local_var_alist, or the DEFAULT-VALUE
1599    slot -- may be out of date.]
1600
1601    Write out any cached value in buffer-local variable SYMBOL's
1602    buffer-local structure, which is passed in as BFWD.
1603 */
1604
1605 static void
1606 write_out_buffer_local_cache(Lisp_Object symbol,
1607                              struct symbol_value_buffer_local *bfwd)
1608 {
1609         if (!NILP(bfwd->current_buffer)) {
1610                 /* We pass 0 for BUFFER because only SYMVAL_CURRENT_BUFFER_FORWARD
1611                    uses it, and that type cannot be inside a symbol-value-buffer-local */
1612                 Lisp_Object cval =
1613                     do_symval_forwarding(bfwd->current_value, 0, 0);
1614                 if (NILP(bfwd->current_alist_element))
1615                         /* current_value may be updated more recently than default_value */
1616                         bfwd->default_value = cval;
1617                 else
1618                         Fsetcdr(bfwd->current_alist_element, cval);
1619         }
1620 }
1621
1622 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1623    Set up BFWD's cache for validity in buffer BUF.  This assumes that
1624    the cache is currently in a consistent state (this can include
1625    not having any value cached, if BFWD->CURRENT_BUFFER is nil).
1626
1627    If the cache is already set up for BUF, this function does nothing
1628    at all.
1629
1630    Otherwise, if SYM forwards out to a C variable, this also forwards
1631    SYM's value in BUF out to the variable.  Therefore, you generally
1632    only want to call this when BUF is, or is about to become, the
1633    current buffer.
1634
1635    (Otherwise, you can just retrieve the value without changing the
1636    cache, at the expense of slower retrieval.)
1637 */
1638
1639 static void
1640 set_up_buffer_local_cache(Lisp_Object sym,
1641                           struct symbol_value_buffer_local *bfwd,
1642                           struct buffer *buf,
1643                           Lisp_Object new_alist_el, int set_it_p)
1644 {
1645         Lisp_Object new_val;
1646
1647         if (!NILP(bfwd->current_buffer)
1648             && buf == XBUFFER(bfwd->current_buffer))
1649                 /* Cache is already set up. */
1650                 return;
1651
1652         /* Flush out the old cache. */
1653         write_out_buffer_local_cache(sym, bfwd);
1654
1655         /* Retrieve the new alist element and new value. */
1656         if (NILP(new_alist_el)
1657             && set_it_p)
1658                 new_alist_el = buffer_local_alist_element(buf, sym, bfwd);
1659
1660         if (NILP(new_alist_el))
1661                 new_val = bfwd->default_value;
1662         else
1663                 new_val = Fcdr(new_alist_el);
1664
1665         bfwd->current_alist_element = new_alist_el;
1666         XSETBUFFER(bfwd->current_buffer, buf);
1667
1668         /* Now store the value into the current-value slot.
1669            We don't simply write it there, because the current-value
1670            slot might be a forwarding pointer, in which case we need
1671            to instead write the value into the C variable.
1672
1673            We might also want to call a magic function.
1674
1675            So instead, we call this function. */
1676         store_symval_forwarding(sym, bfwd->current_value, new_val);
1677 }
1678
1679 /* SYM is a buffer-local variable, and BFWD is its buffer-local structure.
1680    Flush the cache.  BFWD->CURRENT_BUFFER will be nil after this operation.
1681 */
1682
1683 static void
1684 flush_buffer_local_cache(Lisp_Object sym,
1685                          struct symbol_value_buffer_local *bfwd)
1686 {
1687         if (NILP(bfwd->current_buffer))
1688                 /* Cache is already flushed. */
1689                 return;
1690
1691         /* Flush out the old cache. */
1692         write_out_buffer_local_cache(sym, bfwd);
1693
1694         bfwd->current_alist_element = Qnil;
1695         bfwd->current_buffer = Qnil;
1696
1697         /* Now store default the value into the current-value slot.
1698            We don't simply write it there, because the current-value
1699            slot might be a forwarding pointer, in which case we need
1700            to instead write the value into the C variable.
1701
1702            We might also want to call a magic function.
1703
1704            So instead, we call this function. */
1705         store_symval_forwarding(sym, bfwd->current_value, bfwd->default_value);
1706 }
1707
1708 /* Flush all the buffer-local variable caches.  Whoever has a
1709    non-interned buffer-local variable will be spanked.  Whoever has a
1710    magic variable that interns or uninterns symbols... I don't even
1711    want to think about it.
1712 */
1713
1714 void flush_all_buffer_local_cache(void)
1715 {
1716         Lisp_Object *syms = XVECTOR_DATA(Vobarray);
1717         long count = XVECTOR_LENGTH(Vobarray);
1718         long i;
1719
1720         for (i = 0; i < count; i++) {
1721                 Lisp_Object sym = syms[i];
1722                 Lisp_Object value;
1723
1724                 if (!ZEROP(sym))
1725                         for (;;) {
1726                                 Lisp_Symbol *next;
1727                                 assert(SYMBOLP(sym));
1728                                 value = fetch_value_maybe_past_magic(sym, Qt);
1729                                 if (SYMBOL_VALUE_BUFFER_LOCAL_P(value))
1730                                         flush_buffer_local_cache(sym,
1731                                                                  XSYMBOL_VALUE_BUFFER_LOCAL
1732                                                                  (value));
1733
1734                                 next = symbol_next(XSYMBOL(sym));
1735                                 if (!next)
1736                                         break;
1737                                 XSETSYMBOL(sym, next);
1738                         }
1739         }
1740 }
1741 \f
1742 void kill_buffer_local_variables(struct buffer *buf)
1743 {
1744         Lisp_Object prev = Qnil;
1745         Lisp_Object alist;
1746
1747         /* Any which are supposed to be permanent,
1748            make local again, with the same values they had.  */
1749
1750         for (alist = buf->local_var_alist; !NILP(alist); alist = XCDR(alist)) {
1751                 Lisp_Object sym = XCAR(XCAR(alist));
1752                 struct symbol_value_buffer_local *bfwd;
1753                 /* Variables with a symbol-value-varalias should not be here
1754                    (we should have forwarded past them) and there must be a
1755                    symbol-value-buffer-local.  If there's a symbol-value-lisp-magic,
1756                    just forward past it; if the variable has a handler, it was
1757                    already called. */
1758                 Lisp_Object value = fetch_value_maybe_past_magic(sym, Qt);
1759
1760                 assert(SYMBOL_VALUE_BUFFER_LOCAL_P(value));
1761                 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(value);
1762
1763                 if (!NILP(Fget(sym, Qpermanent_local, Qnil)))
1764                         /* prev points to the last alist element that is still
1765                            staying around, so *only* update it now.  This didn't
1766                            used to be the case; this bug has been around since
1767                            mly's rewrite two years ago! */
1768                         prev = alist;
1769                 else {
1770                         /* Really truly kill it. */
1771                         if (!NILP(prev))
1772                                 XCDR(prev) = XCDR(alist);
1773                         else
1774                                 buf->local_var_alist = XCDR(alist);
1775
1776                         /* We just effectively changed the value for this variable
1777                            in BUF. So: */
1778
1779                         /* (1) If the cache is caching BUF, invalidate the cache. */
1780                         if (!NILP(bfwd->current_buffer) &&
1781                             buf == XBUFFER(bfwd->current_buffer))
1782                                 bfwd->current_buffer = Qnil;
1783
1784                         /* (2) If we changed the value in current_buffer and this
1785                            variable forwards to a C variable, we need to change the
1786                            value of the C variable.  set_up_buffer_local_cache()
1787                            will do this.  It doesn't hurt to do it whenever
1788                            BUF == current_buffer, so just go ahead and do that. */
1789                         if (buf == current_buffer)
1790                                 set_up_buffer_local_cache(sym, bfwd, buf, Qnil,
1791                                                           0);
1792                 }
1793         }
1794 }
1795 \f
1796 static Lisp_Object
1797 find_symbol_value_1(Lisp_Object sym, struct buffer *buf,
1798                     struct console *con, int swap_it_in,
1799                     Lisp_Object symcons, int set_it_p)
1800 {
1801         Lisp_Object valcontents;
1802
1803       retry:
1804         valcontents = XSYMBOL(sym)->value;
1805
1806       retry_2:
1807         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1808                 return valcontents;
1809
1810         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
1811         case SYMVAL_LISP_MAGIC:
1812                 /* #### kludge */
1813                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
1814                 /* semi-change-o */
1815                 goto retry_2;
1816
1817         case SYMVAL_VARALIAS:
1818                 sym = follow_varalias_pointers(sym, Qt /* #### kludge */ );
1819                 symcons = Qnil;
1820                 /* presto change-o! */
1821                 goto retry;
1822
1823         case SYMVAL_BUFFER_LOCAL:
1824         case SYMVAL_SOME_BUFFER_LOCAL:
1825                 {
1826                         struct symbol_value_buffer_local *bfwd
1827                             = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
1828
1829                         if (swap_it_in) {
1830                                 set_up_buffer_local_cache(sym, bfwd, buf,
1831                                                           symcons, set_it_p);
1832                                 valcontents = bfwd->current_value;
1833                         } else {
1834                                 if (!NILP(bfwd->current_buffer) &&
1835                                     buf == XBUFFER(bfwd->current_buffer))
1836                                         valcontents = bfwd->current_value;
1837                                 else if (NILP(symcons)) {
1838                                         if (set_it_p)
1839                                                 valcontents =
1840                                                     assq_no_quit(sym,
1841                                                                  buf->
1842                                                                  local_var_alist);
1843                                         if (NILP(valcontents))
1844                                                 valcontents =
1845                                                     bfwd->default_value;
1846                                         else
1847                                                 valcontents = XCDR(valcontents);
1848                                 } else
1849                                         valcontents = XCDR(symcons);
1850                         }
1851                         break;
1852                 }
1853
1854         case SYMVAL_FIXNUM_FORWARD:
1855         case SYMVAL_CONST_FIXNUM_FORWARD:
1856         case SYMVAL_BOOLEAN_FORWARD:
1857         case SYMVAL_CONST_BOOLEAN_FORWARD:
1858         case SYMVAL_OBJECT_FORWARD:
1859         case SYMVAL_CONST_OBJECT_FORWARD:
1860         case SYMVAL_CONST_SPECIFIER_FORWARD:
1861         case SYMVAL_DEFAULT_BUFFER_FORWARD:
1862         case SYMVAL_CURRENT_BUFFER_FORWARD:
1863         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
1864         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
1865         case SYMVAL_SELECTED_CONSOLE_FORWARD:
1866         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
1867         case SYMVAL_UNBOUND_MARKER:
1868         default:
1869                 break;
1870         }
1871         return do_symval_forwarding(valcontents, buf, con);
1872 }
1873
1874 /* Find the value of a symbol in BUFFER, returning Qunbound if it's not
1875    bound.  Note that it must not be possible to QUIT within this
1876    function. */
1877
1878 Lisp_Object symbol_value_in_buffer(Lisp_Object sym, Lisp_Object buffer)
1879 {
1880         struct buffer *buf;
1881
1882         CHECK_SYMBOL(sym);
1883
1884         if (NILP(buffer))
1885                 buf = current_buffer;
1886         else {
1887                 CHECK_BUFFER(buffer);
1888                 buf = XBUFFER(buffer);
1889         }
1890
1891         return find_symbol_value_1(sym, buf,
1892                                    /* If it bombs out at startup due to a
1893                                       Lisp error, this may be nil. */
1894                                    CONSOLEP(Vselected_console)
1895                                    ? XCONSOLE(Vselected_console) : 0, 0, Qnil,
1896                                    1);
1897 }
1898
1899 static Lisp_Object symbol_value_in_console(Lisp_Object sym, Lisp_Object console)
1900 {
1901         CHECK_SYMBOL(sym);
1902
1903         if (NILP(console))
1904                 console = Vselected_console;
1905         else
1906                 CHECK_CONSOLE(console);
1907
1908         return find_symbol_value_1(sym, current_buffer, XCONSOLE(console), 0,
1909                                    Qnil, 1);
1910 }
1911
1912 static Lisp_Object
1913 search_symbol_macro(Lisp_Object name)
1914 {
1915         return Fget(name, Qsymbol_macro, Qnil);
1916 }
1917
1918 /* Return the current value of SYM.  The difference between this function
1919    and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1920    this updates the CURRENT_VALUE slot of buffer-local variables to
1921    point to the current buffer, while symbol_value_in_buffer doesn't. */
1922
1923 Lisp_Object find_symbol_value(Lisp_Object sym)
1924 {
1925         /* WARNING: This function can be called when current_buffer is 0
1926            and Vselected_console is Qnil, early in initialization. */
1927         struct console *con;
1928         Lisp_Object valcontents;
1929
1930         CHECK_SYMBOL(sym);
1931
1932         valcontents = XSYMBOL(sym)->value;
1933         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
1934                 return valcontents;
1935
1936         if (CONSOLEP(Vselected_console))
1937                 con = XCONSOLE(Vselected_console);
1938         else {
1939                 /* This can also get called while we're preparing to shutdown.
1940                    #### What should really happen in that case?  Should we
1941                    actually fix things so we can't get here in that case? */
1942 #ifndef PDUMP
1943                 assert(!initialized || preparing_for_armageddon);
1944 #endif
1945                 con = 0;
1946         }
1947
1948         return find_symbol_value_1(sym, current_buffer, con, 1, Qnil, 1);
1949 }
1950
1951 /* This is an optimized function for quick lookup of buffer local symbols
1952    by avoiding O(n) search.  This will work when either:
1953      a) We have already found the symbol e.g. by traversing local_var_alist.
1954    or
1955      b) We know that the symbol will not be found in the current buffer's
1956         list of local variables.
1957    In the former case, find_it_p is 1 and symbol_cons is the element from
1958    local_var_alist.  In the latter case, find_it_p is 0 and symbol_cons
1959    is the symbol.
1960
1961    This function is called from set_buffer_internal which does both of these
1962    things. */
1963
1964 Lisp_Object find_symbol_value_quickly(Lisp_Object symbol_cons, int find_it_p)
1965 {
1966         /* WARNING: This function can be called when current_buffer is 0
1967            and Vselected_console is Qnil, early in initialization. */
1968         struct console *con;
1969         Lisp_Object sym = find_it_p ? XCAR(symbol_cons) : symbol_cons;
1970
1971         CHECK_SYMBOL(sym);
1972         if (CONSOLEP(Vselected_console))
1973                 con = XCONSOLE(Vselected_console);
1974         else {
1975                 /* This can also get called while we're preparing to shutdown.
1976                    #### What should really happen in that case?  Should we
1977                    actually fix things so we can't get here in that case? */
1978 #ifndef PDUMP
1979                 assert(!initialized || preparing_for_armageddon);
1980 #endif
1981                 con = 0;
1982         }
1983
1984         return find_symbol_value_1(sym, current_buffer, con, 1,
1985                                    find_it_p ? symbol_cons : Qnil, find_it_p);
1986 }
1987
1988 DEFUN("symbol-value", Fsymbol_value, 1, 1, 0,   /*
1989 Return SYMBOL's value.  Error if that is void.
1990 */
1991       (symbol))
1992 {
1993         Lisp_Object val = find_symbol_value(symbol);
1994
1995         if (UNBOUNDP(val)) {
1996                 Lisp_Object fd = search_symbol_macro(symbol);
1997                 if (!NILP(fd))
1998                         return Feval(fd);
1999                 else
2000                         return Fsignal(Qvoid_variable, list1(symbol));
2001         } else
2002                 return val;
2003 }
2004
2005 DEFUN("set", Fset, 2, 2, 0,     /*
2006 Set SYMBOL's value to NEWVAL, and return NEWVAL.
2007 */
2008       (symbol, newval))
2009 {
2010         REGISTER Lisp_Object valcontents;
2011         Lisp_Object ssm;
2012         Lisp_Symbol *sym;
2013         /* remember, we're called by Fmakunbound() as well */
2014
2015         CHECK_SYMBOL(symbol);
2016
2017       retry:
2018         sym = XSYMBOL(symbol);
2019         valcontents = sym->value;
2020
2021         if (EQ(symbol, Qnil) || EQ(symbol, Qt) || SYMBOL_IS_KEYWORD(symbol))
2022                 reject_constant_symbols(symbol, newval, 0,
2023                                         UNBOUNDP(newval) ? Qmakunbound : Qset);
2024
2025         if (UNBOUNDP(valcontents)) {
2026                 ssm = search_symbol_macro(symbol);
2027                 if (!NILP(ssm))
2028                         return Feval(list3(Qsetf, ssm, list2(Qquote, newval)));
2029         }
2030
2031         if (!SYMBOL_VALUE_MAGIC_P(valcontents) || UNBOUNDP(valcontents)) {
2032                 sym->value = newval;
2033                 return newval;
2034         }
2035
2036         reject_constant_symbols(symbol, newval, 0,
2037                                 UNBOUNDP(newval) ? Qmakunbound : Qset);
2038
2039         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2040         case SYMVAL_LISP_MAGIC: {
2041                 if (UNBOUNDP(newval)) {
2042                         maybe_call_magic_handler(symbol, Qmakunbound,
2043                                                  0);
2044                         return XSYMBOL_VALUE_LISP_MAGIC(valcontents)->
2045                                 shadowed = Qunbound;
2046                 } else {
2047                         maybe_call_magic_handler(symbol, Qset, 1,
2048                                                  newval);
2049                         return XSYMBOL_VALUE_LISP_MAGIC(valcontents)->
2050                                 shadowed = newval;
2051                 }
2052         }
2053
2054         case SYMVAL_VARALIAS:
2055                 symbol = follow_varalias_pointers(symbol, UNBOUNDP(newval)
2056                                                   ? Qmakunbound : Qset);
2057                 /* presto change-o! */
2058                 goto retry;
2059
2060         case SYMVAL_FIXNUM_FORWARD:
2061         case SYMVAL_BOOLEAN_FORWARD:
2062         case SYMVAL_OBJECT_FORWARD:
2063         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2064         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2065                 if (UNBOUNDP(newval))
2066                         signal_error(Qerror,
2067                                      list2(build_string("Cannot makunbound"),
2068                                            symbol));
2069                 break;
2070
2071                 /* case SYMVAL_UNBOUND_MARKER: break; */
2072
2073         case SYMVAL_CURRENT_BUFFER_FORWARD: {
2074                 const struct symbol_value_forward *fwd
2075                         = XSYMBOL_VALUE_FORWARD(valcontents);
2076                 int mask = XINT(*((Lisp_Object *)
2077                                   symbol_value_forward_forward(fwd)));
2078                 if (mask > 0)
2079                         /* Setting this variable makes it buffer-local */
2080                         current_buffer->local_var_flags |= mask;
2081                 break;
2082         }
2083
2084         case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2085                 const struct symbol_value_forward *fwd
2086                         = XSYMBOL_VALUE_FORWARD(valcontents);
2087                 int mask = XINT(*((Lisp_Object *)
2088                                   symbol_value_forward_forward(fwd)));
2089                 if (mask > 0)
2090                         /* Setting this variable makes it console-local */
2091                         XCONSOLE(Vselected_console)->local_var_flags |=
2092                                 mask;
2093                 break;
2094         }
2095
2096         case SYMVAL_BUFFER_LOCAL:
2097         case SYMVAL_SOME_BUFFER_LOCAL: {
2098                 /* If we want to examine or set the value and
2099                    CURRENT-BUFFER is current, we just examine or set
2100                    CURRENT-VALUE. If CURRENT-BUFFER is not current, we
2101                    store the current CURRENT-VALUE value into
2102                    CURRENT-ALIST- ELEMENT, then find the appropriate alist
2103                    element for the buffer now current and set up
2104                    CURRENT-ALIST-ELEMENT.  Then we set CURRENT-VALUE out
2105                    of that element, and store into CURRENT-BUFFER.
2106
2107                    If we are setting the variable and the current buffer does
2108                    not have an alist entry for this variable, an alist entry is
2109                    created.
2110
2111                    Note that CURRENT-VALUE can be a forwarding pointer.
2112                    Each time it is examined or set, forwarding must be
2113                    done. */
2114                 struct symbol_value_buffer_local *bfwd
2115                         = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2116                 int some_buffer_local_p =
2117                         (bfwd->magic.type == SYMVAL_SOME_BUFFER_LOCAL);
2118                 /* What value are we caching right now?  */
2119                 Lisp_Object aelt = bfwd->current_alist_element;
2120
2121                 if (!NILP(bfwd->current_buffer) &&
2122                     current_buffer == XBUFFER(bfwd->current_buffer)
2123                     && ((some_buffer_local_p)
2124                         ? 1     /* doesn't automatically become local */
2125                         : !NILP(aelt)   /* already local */
2126                             )) {
2127                         /* Cache is valid */
2128                         valcontents = bfwd->current_value;
2129                 } else {
2130                         /* If the current buffer is not the buffer whose binding
2131                            is currently cached, or if it's a SYMVAL_BUFFER_LOCAL
2132                            and we're looking at the default value, the cache is
2133                            invalid; we need to write it out, and find the new
2134                            CURRENT-ALIST-ELEMENT
2135                         */
2136
2137                         /* Write out the cached value for the old buffer; copy
2138                            it back to its alist element.  This works if the
2139                            current buffer only sees the default value, too.  */
2140                         write_out_buffer_local_cache(symbol, bfwd);
2141
2142                         /* Find the new value for CURRENT-ALIST-ELEMENT.  */
2143                         aelt = buffer_local_alist_element(current_buffer,
2144                                                            symbol, bfwd);
2145                         if (NILP(aelt)) {
2146                                 /* This buffer is still seeing the default
2147                                    value.  */
2148                                 if (!some_buffer_local_p) {
2149                                         /* If it's a SYMVAL_BUFFER_LOCAL, give
2150                                            this buffer a new assoc for a local
2151                                            value and set CURRENT-ALIST-ELEMENT
2152                                            to point to that.  */
2153                                         aelt = do_symval_forwarding(
2154                                                 bfwd->current_value,
2155                                                 current_buffer,
2156                                                 XCONSOLE(Vselected_console));
2157                                         aelt = Fcons(symbol, aelt);
2158                                         current_buffer->local_var_alist =
2159                                                 Fcons(aelt,
2160                                                       current_buffer->
2161                                                       local_var_alist);
2162                                 } else {
2163                                         /* If the variable is a
2164                                            SYMVAL_SOME_BUFFER_LOCAL, we're
2165                                            currently seeing the default
2166                                            value. */
2167                                         ;
2168                                 }
2169                         }
2170                         /* Cache the new buffer's assoc in
2171                            CURRENT-ALIST-ELEMENT.  */
2172                         bfwd->current_alist_element = aelt;
2173                         /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is
2174                            accurate.  */
2175                         XSETBUFFER(bfwd->current_buffer,
2176                                    current_buffer);
2177                         valcontents = bfwd->current_value;
2178                 }
2179                 break;
2180         }
2181
2182         case SYMVAL_CONST_FIXNUM_FORWARD:
2183         case SYMVAL_CONST_BOOLEAN_FORWARD:
2184         case SYMVAL_CONST_SPECIFIER_FORWARD:
2185         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2186         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2187         case SYMVAL_CONST_OBJECT_FORWARD:
2188         case SYMVAL_UNBOUND_MARKER:
2189         default:
2190                 abort();
2191         }
2192         store_symval_forwarding(symbol, valcontents, newval);
2193
2194         return newval;
2195 }
2196 \f
2197 /* Access or set a buffer-local symbol's default value.  */
2198
2199 /* Return the default value of SYM, but don't check for voidness.
2200    Return Qunbound if it is void.  */
2201
2202 static Lisp_Object default_value(Lisp_Object sym)
2203 {
2204         Lisp_Object valcontents;
2205
2206         CHECK_SYMBOL(sym);
2207
2208 retry:
2209         valcontents = XSYMBOL(sym)->value;
2210
2211 retry_2:
2212         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2213                 return valcontents;
2214
2215         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2216         case SYMVAL_LISP_MAGIC:
2217                 /* #### kludge */
2218                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2219                 /* semi-change-o */
2220                 goto retry_2;
2221
2222         case SYMVAL_VARALIAS:
2223                 sym = follow_varalias_pointers(sym, Qt /* #### kludge */ );
2224                 /* presto change-o! */
2225                 goto retry;
2226
2227         case SYMVAL_UNBOUND_MARKER:
2228                 return valcontents;
2229
2230         case SYMVAL_CURRENT_BUFFER_FORWARD: {
2231                 const struct symbol_value_forward *fwd
2232                         = XSYMBOL_VALUE_FORWARD(valcontents);
2233                 return (*((Lisp_Object *)
2234                           ((char *)XBUFFER(Vbuffer_defaults) +
2235                            ((char *)symbol_value_forward_forward(fwd) -
2236                             (char *)&buffer_local_flags))));
2237         }
2238
2239         case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2240                 const struct symbol_value_forward *fwd =
2241                         XSYMBOL_VALUE_FORWARD(valcontents);
2242                 return (*((Lisp_Object *)
2243                           ((char *)XCONSOLE(Vconsole_defaults) +
2244                            ((char *)symbol_value_forward_forward(fwd) -
2245                             (char *)&console_local_flags))));
2246         }
2247
2248         case SYMVAL_BUFFER_LOCAL:
2249         case SYMVAL_SOME_BUFFER_LOCAL: {
2250                 struct symbol_value_buffer_local *bfwd =
2251                         XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2252
2253                 /* Handle user-created local variables.  */
2254                 /* If var is set up for a buffer that lacks a local value for
2255                    it, the current value is nominally the default value.  But
2256                    the current value slot may be more up to date, since ordinary
2257                    setq stores just that slot.  So use that.  */
2258                 if (NILP(bfwd->current_alist_element))
2259                         return do_symval_forwarding(
2260                                 bfwd->current_value,
2261                                 current_buffer,
2262                                 XCONSOLE(Vselected_console));
2263                 else
2264                         return bfwd->default_value;
2265         }
2266
2267         case SYMVAL_FIXNUM_FORWARD:
2268         case SYMVAL_CONST_FIXNUM_FORWARD:
2269         case SYMVAL_BOOLEAN_FORWARD:
2270         case SYMVAL_CONST_BOOLEAN_FORWARD:
2271         case SYMVAL_OBJECT_FORWARD:
2272         case SYMVAL_CONST_OBJECT_FORWARD:
2273         case SYMVAL_CONST_SPECIFIER_FORWARD:
2274         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2275         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2276         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2277         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2278
2279         default:
2280                 /* For other variables, get the current value.    */
2281                 return do_symval_forwarding(valcontents, current_buffer,
2282                                             XCONSOLE(Vselected_console));
2283         }
2284
2285         RETURN_NOT_REACHED(Qnil)        /* suppress compiler warning */
2286 }
2287
2288 DEFUN("default-boundp", Fdefault_boundp, 1, 1, 0,       /*
2289 Return t if SYMBOL has a non-void default value.
2290 This is the value that is seen in buffers that do not have their own values
2291 for this variable.
2292 */
2293       (symbol))
2294 {
2295         return UNBOUNDP(default_value(symbol)) ? Qnil : Qt;
2296 }
2297
2298 DEFUN("default-value", Fdefault_value, 1, 1, 0, /*
2299 Return SYMBOL's default value.
2300 This is the value that is seen in buffers that do not have their own values
2301 for this variable.  The default value is meaningful for variables with
2302 local bindings in certain buffers.
2303 */
2304       (symbol))
2305 {
2306         Lisp_Object value = default_value(symbol);
2307
2308         return UNBOUNDP(value) ? Fsignal(Qvoid_variable, list1(symbol)) : value;
2309 }
2310
2311 DEFUN("set-default", Fset_default, 2, 2, 0,     /*
2312 Set SYMBOL's default value to VALUE.  SYMBOL and VALUE are evaluated.
2313 The default value is seen in buffers that do not have their own values
2314 for this variable.
2315 */
2316       (symbol, value))
2317 {
2318         Lisp_Object valcontents;
2319
2320         CHECK_SYMBOL(symbol);
2321
2322       retry:
2323         valcontents = XSYMBOL(symbol)->value;
2324
2325       retry_2:
2326         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2327                 return Fset(symbol, value);
2328
2329         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2330         case SYMVAL_LISP_MAGIC:
2331                 RETURN_IF_NOT_UNBOUND(maybe_call_magic_handler
2332                                       (symbol, Qset_default, 1, value));
2333                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2334                 /* semi-change-o */
2335                 goto retry_2;
2336
2337         case SYMVAL_VARALIAS:
2338                 symbol = follow_varalias_pointers(symbol, Qset_default);
2339                 /* presto change-o! */
2340                 goto retry;
2341
2342         case SYMVAL_CURRENT_BUFFER_FORWARD:
2343                 set_default_buffer_slot_variable(symbol, value);
2344                 return value;
2345
2346         case SYMVAL_SELECTED_CONSOLE_FORWARD:
2347                 set_default_console_slot_variable(symbol, value);
2348                 return value;
2349
2350         case SYMVAL_BUFFER_LOCAL:
2351         case SYMVAL_SOME_BUFFER_LOCAL: {
2352                 /* Store new value into the DEFAULT-VALUE slot */
2353                 struct symbol_value_buffer_local *bfwd
2354                         = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2355
2356                 bfwd->default_value = value;
2357                 /* If current-buffer doesn't shadow default_value,
2358                  *  we must set the CURRENT-VALUE slot too */
2359                 if (NILP(bfwd->current_alist_element))
2360                         store_symval_forwarding(symbol,
2361                                                 bfwd->current_value,
2362                                                 value);
2363                 return value;
2364         }
2365
2366         case SYMVAL_FIXNUM_FORWARD:
2367         case SYMVAL_CONST_FIXNUM_FORWARD:
2368         case SYMVAL_BOOLEAN_FORWARD:
2369         case SYMVAL_CONST_BOOLEAN_FORWARD:
2370         case SYMVAL_OBJECT_FORWARD:
2371         case SYMVAL_CONST_OBJECT_FORWARD:
2372         case SYMVAL_CONST_SPECIFIER_FORWARD:
2373         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2374         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2375         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2376         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2377         case SYMVAL_UNBOUND_MARKER:
2378
2379         default:
2380                 return Fset(symbol, value);
2381         }
2382 }
2383
2384 DEFUN("setq-default", Fsetq_default, 0, UNEVALLED, 0,   /*
2385 Set the default value of variable SYMBOL to VALUE.
2386 SYMBOL, the variable name, is literal (not evaluated);
2387 VALUE is an expression and it is evaluated.
2388 The default value of a variable is seen in buffers
2389 that do not have their own values for the variable.
2390
2391 More generally, you can use multiple variables and values, as in
2392 (setq-default SYMBOL VALUE SYMBOL VALUE...)
2393 This sets each SYMBOL's default value to the corresponding VALUE.
2394 The VALUE for the Nth SYMBOL can refer to the new default values
2395 of previous SYMBOLs.
2396 */
2397       (args))
2398 {
2399         /* This function can GC */
2400         Lisp_Object symbol, tail, val = Qnil;
2401         int nargs;
2402         struct gcpro gcpro1;
2403
2404         GET_LIST_LENGTH(args, nargs);
2405
2406         if (nargs & 1)          /* Odd number of arguments? */
2407                 Fsignal(Qwrong_number_of_arguments,
2408                         list2(Qsetq_default, make_int(nargs)));
2409
2410         GCPRO1(val);
2411
2412         PROPERTY_LIST_LOOP(tail, symbol, val, args) {
2413                 val = Feval(val);
2414                 Fset_default(symbol, val);
2415         }
2416
2417         UNGCPRO;
2418         return val;
2419 }
2420 \f
2421 /* Lisp functions for creating and removing buffer-local variables.  */
2422
2423 DEFUN("make-variable-buffer-local", Fmake_variable_buffer_local, 1, 1, "vMake Variable Buffer Local: ", /*
2424 Make VARIABLE have a separate value for each buffer.
2425 At any time, the value for the current buffer is in effect.
2426 There is also a default value which is seen in any buffer which has not yet
2427 set its own value.
2428 Using `set' or `setq' to set the variable causes it to have a separate value
2429 for the current buffer if it was previously using the default value.
2430 The function `default-value' gets the default value and `set-default'
2431 sets it.
2432 */
2433       (variable))
2434 {
2435         Lisp_Object valcontents;
2436
2437         CHECK_SYMBOL(variable);
2438
2439       retry:
2440         verify_ok_for_buffer_local(variable, Qmake_variable_buffer_local);
2441
2442         valcontents = XSYMBOL(variable)->value;
2443
2444       retry_2:
2445         if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2446                 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2447                 case SYMVAL_LISP_MAGIC:
2448                         if (!UNBOUNDP(maybe_call_magic_handler
2449                                       (variable, Qmake_variable_buffer_local,
2450                                        0)))
2451                                 return variable;
2452                         valcontents =
2453                             XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2454                         /* semi-change-o */
2455                         goto retry_2;
2456
2457                 case SYMVAL_VARALIAS:
2458                         variable = follow_varalias_pointers(
2459                                 variable,
2460                                 Qmake_variable_buffer_local);
2461                         /* presto change-o! */
2462                         goto retry;
2463
2464                 case SYMVAL_FIXNUM_FORWARD:
2465                 case SYMVAL_BOOLEAN_FORWARD:
2466                 case SYMVAL_OBJECT_FORWARD:
2467                 case SYMVAL_UNBOUND_MARKER:
2468                         break;
2469
2470                 case SYMVAL_CURRENT_BUFFER_FORWARD:
2471                 case SYMVAL_BUFFER_LOCAL:
2472                         /* Already per-each-buffer */
2473                         return variable;
2474
2475                 case SYMVAL_SOME_BUFFER_LOCAL:
2476                         /* Transmogrify */
2477                         XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)->magic.type =
2478                             SYMVAL_BUFFER_LOCAL;
2479                         return variable;
2480
2481                 case SYMVAL_CONST_FIXNUM_FORWARD:
2482                 case SYMVAL_CONST_BOOLEAN_FORWARD:
2483                 case SYMVAL_CONST_OBJECT_FORWARD:
2484                 case SYMVAL_CONST_SPECIFIER_FORWARD:
2485                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2486                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2487                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2488                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2489                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2490
2491                 default:
2492                         abort();
2493                 }
2494         }
2495
2496         {
2497                 struct symbol_value_buffer_local *bfwd
2498                     = alloc_lcrecord_type(struct symbol_value_buffer_local,
2499                                           &lrecord_symbol_value_buffer_local);
2500                 Lisp_Object foo;
2501                 zero_lcrecord(&bfwd->magic);
2502                 bfwd->magic.type = SYMVAL_BUFFER_LOCAL;
2503
2504                 bfwd->default_value = find_symbol_value(variable);
2505                 bfwd->current_value = valcontents;
2506                 bfwd->current_alist_element = Qnil;
2507                 bfwd->current_buffer = Fcurrent_buffer();
2508                 XSETSYMBOL_VALUE_MAGIC(foo, bfwd);
2509                 *value_slot_past_magic(variable) = foo;
2510 #if 1                           /* #### Yuck!   FSFmacs bug-compatibility */
2511                 /* This sets the default-value of any make-variable-buffer-local to nil.
2512                    That just sucks.  User can just use setq-default to effect that,
2513                    but there's no way to do makunbound-default to undo this lossage. */
2514                 if (UNBOUNDP(valcontents))
2515                         bfwd->default_value = Qnil;
2516 #endif
2517 #if 0                           /* #### Yuck! */
2518                 /* This sets the value to nil in this buffer.
2519                    User could use (setq variable nil) to do this.
2520                    It isn't as egregious to do this automatically
2521                    as it is to do so to the default-value, but it's
2522                    still really dubious. */
2523                 if (UNBOUNDP(valcontents))
2524                         Fset(variable, Qnil);
2525 #endif
2526                 return variable;
2527         }
2528 }
2529
2530 DEFUN("make-local-variable", Fmake_local_variable, 1, 1, "vMake Local Variable: ",      /*
2531 Make VARIABLE have a separate value in the current buffer.
2532 Other buffers will continue to share a common default value.
2533 \(The buffer-local value of VARIABLE starts out as the same value
2534 VARIABLE previously had.  If VARIABLE was void, it remains void.)
2535 See also `make-variable-buffer-local'.
2536
2537 If the variable is already arranged to become local when set,
2538 this function causes a local value to exist for this buffer,
2539 just as setting the variable would do.
2540
2541 Do not use `make-local-variable' to make a hook variable buffer-local.
2542 Use `make-local-hook' instead.
2543 */
2544       (variable))
2545 {
2546         Lisp_Object valcontents;
2547         struct symbol_value_buffer_local *bfwd;
2548
2549         CHECK_SYMBOL(variable);
2550
2551       retry:
2552         verify_ok_for_buffer_local(variable, Qmake_local_variable);
2553
2554         valcontents = XSYMBOL(variable)->value;
2555
2556       retry_2:
2557         if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2558                 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2559                 case SYMVAL_LISP_MAGIC:
2560                         if (!UNBOUNDP(maybe_call_magic_handler
2561                                       (variable, Qmake_local_variable, 0)))
2562                                 return variable;
2563                         valcontents =
2564                             XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2565                         /* semi-change-o */
2566                         goto retry_2;
2567
2568                 case SYMVAL_VARALIAS:
2569                         variable =
2570                             follow_varalias_pointers(variable,
2571                                                      Qmake_local_variable);
2572                         /* presto change-o! */
2573                         goto retry;
2574
2575                 case SYMVAL_FIXNUM_FORWARD:
2576                 case SYMVAL_BOOLEAN_FORWARD:
2577                 case SYMVAL_OBJECT_FORWARD:
2578                 case SYMVAL_UNBOUND_MARKER:
2579                         break;
2580
2581                 case SYMVAL_BUFFER_LOCAL:
2582                 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2583                         /* Make sure the symbol has a local value in this
2584                            particular buffer, by setting it to the same value it
2585                            already has.  */
2586                         Fset(variable, find_symbol_value(variable));
2587                         return variable;
2588                 }
2589
2590                 case SYMVAL_SOME_BUFFER_LOCAL: {
2591                         if (!NILP(buffer_local_alist_element
2592                              (current_buffer, variable,
2593                               (XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)))))
2594                                 goto already_local_to_current_buffer;
2595                         else
2596                                 goto already_local_to_some_other_buffer;
2597                 }
2598
2599                 case SYMVAL_CONST_FIXNUM_FORWARD:
2600                 case SYMVAL_CONST_BOOLEAN_FORWARD:
2601                 case SYMVAL_CONST_OBJECT_FORWARD:
2602                 case SYMVAL_CONST_SPECIFIER_FORWARD:
2603                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2604                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2605                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2606                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2607                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2608                 default:
2609                         abort();
2610                 }
2611         }
2612
2613         /* Make sure variable is set up to hold per-buffer values */
2614         bfwd = alloc_lcrecord_type(struct symbol_value_buffer_local,
2615                                    &lrecord_symbol_value_buffer_local);
2616         zero_lcrecord(&bfwd->magic);
2617         bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL;
2618
2619         bfwd->current_buffer = Qnil;
2620         bfwd->current_alist_element = Qnil;
2621         bfwd->current_value = valcontents;
2622         /* passing 0 is OK because this should never be a
2623            SYMVAL_CURRENT_BUFFER_FORWARD or SYMVAL_SELECTED_CONSOLE_FORWARD
2624            variable. */
2625         bfwd->default_value = do_symval_forwarding(valcontents, 0, 0);
2626
2627 #if 0
2628         if (UNBOUNDP(bfwd->default_value))
2629                 bfwd->default_value = Qnil;     /* Yuck! */
2630 #endif
2631
2632         XSETSYMBOL_VALUE_MAGIC(valcontents, bfwd);
2633         *value_slot_past_magic(variable) = valcontents;
2634
2635       already_local_to_some_other_buffer:
2636
2637         /* Make sure this buffer has its own value of variable */
2638         bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2639
2640         if (UNBOUNDP(bfwd->default_value)) {
2641                 /* If default value is unbound, set local value to nil. */
2642                 XSETBUFFER(bfwd->current_buffer, current_buffer);
2643                 bfwd->current_alist_element = Fcons(variable, Qnil);
2644                 current_buffer->local_var_alist =
2645                     Fcons(bfwd->current_alist_element,
2646                           current_buffer->local_var_alist);
2647                 store_symval_forwarding(variable, bfwd->current_value, Qnil);
2648                 return variable;
2649         }
2650
2651         current_buffer->local_var_alist
2652             = Fcons(Fcons(variable, bfwd->default_value),
2653                     current_buffer->local_var_alist);
2654
2655         /* Make sure symbol does not think it is set up for this buffer;
2656            force it to look once again for this buffer's value */
2657         if (!NILP(bfwd->current_buffer) &&
2658             current_buffer == XBUFFER(bfwd->current_buffer))
2659                 bfwd->current_buffer = Qnil;
2660
2661       already_local_to_current_buffer:
2662
2663         /* If the symbol forwards into a C variable, then swap in the
2664            variable for this buffer immediately.  If C code modifies the
2665            variable before we swap in, then that new value will clobber the
2666            default value the next time we swap.  */
2667         bfwd = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2668         if (SYMBOL_VALUE_MAGIC_P(bfwd->current_value)) {
2669                 switch (XSYMBOL_VALUE_MAGIC_TYPE(bfwd->current_value)) {
2670                 case SYMVAL_FIXNUM_FORWARD:
2671                 case SYMVAL_BOOLEAN_FORWARD:
2672                 case SYMVAL_OBJECT_FORWARD:
2673                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2674                         set_up_buffer_local_cache(variable, bfwd,
2675                                                   current_buffer, Qnil, 1);
2676                         break;
2677
2678                 case SYMVAL_UNBOUND_MARKER:
2679                 case SYMVAL_CURRENT_BUFFER_FORWARD:
2680                         break;
2681
2682                 case SYMVAL_CONST_FIXNUM_FORWARD:
2683                 case SYMVAL_CONST_BOOLEAN_FORWARD:
2684                 case SYMVAL_CONST_OBJECT_FORWARD:
2685                 case SYMVAL_CONST_SPECIFIER_FORWARD:
2686                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2687                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2688                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2689                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2690                 case SYMVAL_BUFFER_LOCAL:
2691                 case SYMVAL_SOME_BUFFER_LOCAL:
2692                 case SYMVAL_LISP_MAGIC:
2693                 case SYMVAL_VARALIAS:
2694
2695                 default:
2696                         abort();
2697                 }
2698         }
2699
2700         return variable;
2701 }
2702
2703 DEFUN("kill-local-variable", Fkill_local_variable, 1, 1, "vKill Local Variable: ",      /*
2704 Make VARIABLE no longer have a separate value in the current buffer.
2705 From now on the default value will apply in this buffer.
2706 */
2707       (variable))
2708 {
2709         Lisp_Object valcontents;
2710
2711         CHECK_SYMBOL(variable);
2712
2713       retry:
2714         valcontents = XSYMBOL(variable)->value;
2715
2716       retry_2:
2717         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2718                 return variable;
2719
2720         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2721         case SYMVAL_LISP_MAGIC:
2722                 if (!UNBOUNDP(maybe_call_magic_handler
2723                               (variable, Qkill_local_variable, 0)))
2724                         return variable;
2725                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2726                 /* semi-change-o */
2727                 goto retry_2;
2728
2729         case SYMVAL_VARALIAS:
2730                 variable =
2731                     follow_varalias_pointers(variable, Qkill_local_variable);
2732                 /* presto change-o! */
2733                 goto retry;
2734
2735         case SYMVAL_CURRENT_BUFFER_FORWARD: {
2736                 const struct symbol_value_forward *fwd
2737                         = XSYMBOL_VALUE_FORWARD(valcontents);
2738                 int offset = ((char *)symbol_value_forward_forward(fwd)
2739                               - (char *)&buffer_local_flags);
2740                 int mask = XINT(*((Lisp_Object *)
2741                                   symbol_value_forward_forward(fwd)));
2742
2743                 if (mask > 0) {
2744                         int (*magicfun) (Lisp_Object sym,
2745                                          Lisp_Object * val,
2746                                          Lisp_Object in_object,
2747                                          int flags) =
2748                                 symbol_value_forward_magicfun(fwd);
2749                         Lisp_Object oldval = *(Lisp_Object *)
2750                                 (offset + (char *)XBUFFER(Vbuffer_defaults));
2751                         if (magicfun) {
2752                                 (magicfun) (variable, &oldval,
2753                                             make_buffer(current_buffer),
2754                                             0);
2755                         }
2756                         *(Lisp_Object *)(offset + (char *)current_buffer) =
2757                                 oldval;
2758                         current_buffer->local_var_flags &= ~mask;
2759                 }
2760                 return variable;
2761         }
2762
2763         case SYMVAL_BUFFER_LOCAL:
2764         case SYMVAL_SOME_BUFFER_LOCAL: {
2765                 /* Get rid of this buffer's alist element, if any */
2766                 struct symbol_value_buffer_local *bfwd
2767                         = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2768                 Lisp_Object alist = current_buffer->local_var_alist;
2769                 Lisp_Object alist_element
2770                         =
2771                         buffer_local_alist_element(current_buffer, variable,
2772                                                    bfwd);
2773
2774                 if (!NILP(alist_element))
2775                         current_buffer->local_var_alist =
2776                                 Fdelq(alist_element, alist);
2777
2778                 /* Make sure symbol does not think it is set up for this buffer;
2779                    force it to look once again for this buffer's value */
2780                 if (!NILP(bfwd->current_buffer) &&
2781                     current_buffer == XBUFFER(bfwd->current_buffer))
2782                         bfwd->current_buffer = Qnil;
2783
2784                 /* We just changed the value in the current_buffer.  If this
2785                    variable forwards to a C variable, we need to change the
2786                    value of the C variable.  set_up_buffer_local_cache() will do
2787                    this.  It doesn't hurt to do it always, so just go ahead and
2788                    do that. */
2789                 set_up_buffer_local_cache(variable, bfwd,
2790                                           current_buffer, Qnil, 1);
2791         }
2792                 return variable;
2793
2794         case SYMVAL_FIXNUM_FORWARD:
2795         case SYMVAL_CONST_FIXNUM_FORWARD:
2796         case SYMVAL_BOOLEAN_FORWARD:
2797         case SYMVAL_CONST_BOOLEAN_FORWARD:
2798         case SYMVAL_OBJECT_FORWARD:
2799         case SYMVAL_CONST_OBJECT_FORWARD:
2800         case SYMVAL_CONST_SPECIFIER_FORWARD:
2801         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2802         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2803         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2804         case SYMVAL_SELECTED_CONSOLE_FORWARD:
2805         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2806         case SYMVAL_UNBOUND_MARKER:
2807
2808         default:
2809                 return variable;
2810         }
2811         RETURN_NOT_REACHED(Qnil)        /* suppress compiler warning */
2812 }
2813
2814 DEFUN("kill-console-local-variable", Fkill_console_local_variable, 1, 1,
2815       "vKill Console Local Variable: ", /*
2816 Make VARIABLE no longer have a separate value in the selected console.
2817 From now on the default value will apply in this console.
2818 */
2819       (variable))
2820 {
2821         Lisp_Object valcontents;
2822
2823         CHECK_SYMBOL(variable);
2824
2825       retry:
2826         valcontents = XSYMBOL(variable)->value;
2827
2828       retry_2:
2829         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
2830                 return variable;
2831
2832         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2833         case SYMVAL_LISP_MAGIC:
2834                 if (!UNBOUNDP(maybe_call_magic_handler
2835                               (variable, Qkill_console_local_variable, 0)))
2836                         return variable;
2837                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2838                 /* semi-change-o */
2839                 goto retry_2;
2840
2841         case SYMVAL_VARALIAS:
2842                 variable = follow_varalias_pointers(variable,
2843                                                     Qkill_console_local_variable);
2844                 /* presto change-o! */
2845                 goto retry;
2846
2847         case SYMVAL_SELECTED_CONSOLE_FORWARD: {
2848                 const struct symbol_value_forward *fwd
2849                         = XSYMBOL_VALUE_FORWARD(valcontents);
2850                 int offset = ((char *)symbol_value_forward_forward(fwd)
2851                               - (char *)&console_local_flags);
2852                 int mask = XINT(*((Lisp_Object *)
2853                                   symbol_value_forward_forward(fwd)));
2854
2855                 if (mask > 0) {
2856                         int (*magicfun) (Lisp_Object sym,
2857                                          Lisp_Object * val,
2858                                          Lisp_Object in_object,
2859                                          int flags) =
2860                                 symbol_value_forward_magicfun(fwd);
2861                         Lisp_Object oldval = *(Lisp_Object *)
2862                                 (offset +
2863                                  (char *)XCONSOLE(Vconsole_defaults));
2864                         if (magicfun) {
2865                                 magicfun(variable, &oldval,
2866                                          Vselected_console, 0);
2867                         }
2868                         *(Lisp_Object *) (offset +
2869                                           (char *)XCONSOLE(Vselected_console)) =
2870                                 oldval;
2871                         XCONSOLE(Vselected_console)->local_var_flags &= ~mask;
2872                 }
2873                 return variable;
2874         }
2875
2876         case SYMVAL_FIXNUM_FORWARD:
2877         case SYMVAL_CONST_FIXNUM_FORWARD:
2878         case SYMVAL_BOOLEAN_FORWARD:
2879         case SYMVAL_CONST_BOOLEAN_FORWARD:
2880         case SYMVAL_OBJECT_FORWARD:
2881         case SYMVAL_CONST_OBJECT_FORWARD:
2882         case SYMVAL_CONST_SPECIFIER_FORWARD:
2883         case SYMVAL_DEFAULT_BUFFER_FORWARD:
2884         case SYMVAL_CURRENT_BUFFER_FORWARD:
2885         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2886         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2887         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2888         case SYMVAL_UNBOUND_MARKER:
2889         case SYMVAL_BUFFER_LOCAL:
2890         case SYMVAL_SOME_BUFFER_LOCAL:
2891
2892         default:
2893                 return variable;
2894         }
2895 }
2896
2897 /* Used by specbind to determine what effects it might have.  Returns:
2898  *   0 if symbol isn't buffer-local, and wouldn't be after it is set
2899  *  <0 if symbol isn't presently buffer-local, but set would make it so
2900  *  >0 if symbol is presently buffer-local
2901  */
2902 int symbol_value_buffer_local_info(Lisp_Object symbol, struct buffer *buffer)
2903 {
2904         Lisp_Object valcontents;
2905
2906       retry:
2907         valcontents = XSYMBOL(symbol)->value;
2908
2909       retry_2:
2910         if (SYMBOL_VALUE_MAGIC_P(valcontents)) {
2911                 switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
2912                 case SYMVAL_LISP_MAGIC:
2913                         /* #### kludge */
2914                         valcontents =
2915                             XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
2916                         /* semi-change-o */
2917                         goto retry_2;
2918
2919                 case SYMVAL_VARALIAS:
2920                         symbol =
2921                             follow_varalias_pointers(symbol,
2922                                                      Qt /* #### kludge */ );
2923                         /* presto change-o! */
2924                         goto retry;
2925
2926                 case SYMVAL_CURRENT_BUFFER_FORWARD: {
2927                         const struct symbol_value_forward *fwd
2928                                 = XSYMBOL_VALUE_FORWARD(valcontents);
2929                         int mask = XINT(*((Lisp_Object *)
2930                                           symbol_value_forward_forward
2931                                           (fwd)));
2932                         if ((mask <= 0) ||
2933                             (buffer && (buffer->local_var_flags & mask))){
2934                                 /* Already buffer-local */
2935                                 return 1;
2936                         } else {
2937                                 /* Would be buffer-local after set */
2938                                 return -1;
2939                         }
2940                 }
2941                 case SYMVAL_BUFFER_LOCAL:
2942                 case SYMVAL_SOME_BUFFER_LOCAL: {
2943                         struct symbol_value_buffer_local *bfwd
2944                                 = XSYMBOL_VALUE_BUFFER_LOCAL(valcontents);
2945                         if (buffer
2946                             &&
2947                             !NILP(buffer_local_alist_element
2948                                   (buffer, symbol, bfwd)))
2949                                 return 1;
2950                         else
2951                                 /* Automatically becomes local when set */
2952                                 return bfwd->magic.type ==
2953                                         SYMVAL_BUFFER_LOCAL ? -1 : 0;
2954                 }
2955
2956                 case SYMVAL_FIXNUM_FORWARD:
2957                 case SYMVAL_CONST_FIXNUM_FORWARD:
2958                 case SYMVAL_BOOLEAN_FORWARD:
2959                 case SYMVAL_CONST_BOOLEAN_FORWARD:
2960                 case SYMVAL_OBJECT_FORWARD:
2961                 case SYMVAL_CONST_OBJECT_FORWARD:
2962                 case SYMVAL_CONST_SPECIFIER_FORWARD:
2963                 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2964                 case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
2965                 case SYMVAL_DEFAULT_CONSOLE_FORWARD:
2966                 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2967                 case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
2968                 case SYMVAL_UNBOUND_MARKER:
2969
2970                 default:
2971                         return 0;
2972                 }
2973         }
2974         return 0;
2975 }
2976
2977 DEFUN("symbol-value-in-buffer", Fsymbol_value_in_buffer, 2, 3, 0,       /*
2978 Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound.
2979 */
2980       (symbol, buffer, unbound_value))
2981 {
2982         Lisp_Object value;
2983         CHECK_SYMBOL(symbol);
2984         CHECK_BUFFER(buffer);
2985         value = symbol_value_in_buffer(symbol, buffer);
2986         return UNBOUNDP(value) ? unbound_value : value;
2987 }
2988
2989 DEFUN("symbol-value-in-console", Fsymbol_value_in_console, 2, 3, 0,     /*
2990 Return the value of SYMBOL in CONSOLE, or UNBOUND-VALUE if it is unbound.
2991 */
2992       (symbol, console, unbound_value))
2993 {
2994         Lisp_Object value;
2995         CHECK_SYMBOL(symbol);
2996         CHECK_CONSOLE(console);
2997         value = symbol_value_in_console(symbol, console);
2998         return UNBOUNDP(value) ? unbound_value : value;
2999 }
3000
3001 DEFUN("built-in-variable-type", Fbuilt_in_variable_type, 1, 1, 0,       /*
3002 -in variable, return info about this; else return nil.
3003 ll be a symbol, one of
3004
3005 A simple built-in variable.
3006         Same, but cannot be set.
3007 A built-in integer variable.
3008         Same, but cannot be set.
3009 A built-in boolean variable.
3010         Same, but cannot be set.
3011 Always contains a specifier; e.g. `has-modeline-p'.
3012 A built-in buffer-local variable.
3013 fer'    Same, but cannot be set.
3014 Forwards to the default value of a built-in
3015 buffer-local variable.
3016         A built-in console-local variable.
3017 nsole' Same, but cannot be set.
3018 Forwards to the default value of a built-in
3019 console-local variable.
3020 */
3021       (symbol))
3022 {
3023         REGISTER Lisp_Object valcontents;
3024
3025         CHECK_SYMBOL(symbol);
3026
3027       retry:
3028         valcontents = XSYMBOL(symbol)->value;
3029
3030       retry_2:
3031         if (!SYMBOL_VALUE_MAGIC_P(valcontents))
3032                 return Qnil;
3033
3034         switch (XSYMBOL_VALUE_MAGIC_TYPE(valcontents)) {
3035         case SYMVAL_LISP_MAGIC:
3036                 valcontents = XSYMBOL_VALUE_LISP_MAGIC(valcontents)->shadowed;
3037                 /* semi-change-o */
3038                 goto retry_2;
3039
3040         case SYMVAL_VARALIAS:
3041                 symbol = follow_varalias_pointers(symbol, Qt);
3042                 /* presto change-o! */
3043                 goto retry;
3044
3045         case SYMVAL_BUFFER_LOCAL:
3046         case SYMVAL_SOME_BUFFER_LOCAL:
3047                 valcontents =
3048                     XSYMBOL_VALUE_BUFFER_LOCAL(valcontents)->current_value;
3049                 /* semi-change-o */
3050                 goto retry_2;
3051
3052         case SYMVAL_FIXNUM_FORWARD:
3053                 return Qinteger;
3054         case SYMVAL_CONST_FIXNUM_FORWARD:
3055                 return Qconst_integer;
3056         case SYMVAL_BOOLEAN_FORWARD:
3057                 return Qboolean;
3058         case SYMVAL_CONST_BOOLEAN_FORWARD:
3059                 return Qconst_boolean;
3060         case SYMVAL_OBJECT_FORWARD:
3061                 return Qobject;
3062         case SYMVAL_CONST_OBJECT_FORWARD:
3063                 return Qconst_object;
3064         case SYMVAL_CONST_SPECIFIER_FORWARD:
3065                 return Qconst_specifier;
3066         case SYMVAL_DEFAULT_BUFFER_FORWARD:
3067                 return Qdefault_buffer;
3068         case SYMVAL_CURRENT_BUFFER_FORWARD:
3069                 return Qcurrent_buffer;
3070         case SYMVAL_CONST_CURRENT_BUFFER_FORWARD:
3071                 return Qconst_current_buffer;
3072         case SYMVAL_DEFAULT_CONSOLE_FORWARD:
3073                 return Qdefault_console;
3074         case SYMVAL_SELECTED_CONSOLE_FORWARD:
3075                 return Qselected_console;
3076         case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD:
3077                 return Qconst_selected_console;
3078         case SYMVAL_UNBOUND_MARKER:
3079                 return Qnil;
3080
3081         default:
3082                 abort();
3083                 return Qnil;
3084         }
3085 }
3086
3087 DEFUN("local-variable-p", Flocal_variable_p, 2, 3, 0,   /*
3088 n t if SYMBOL's value is local to BUFFER.
3089 tional third arg AFTER-SET is non-nil, return t if SYMBOL would be
3090 r-local after it is set, regardless of whether it is so presently.
3091  value for BUFFER is *not* the same as (current-buffer), but means
3092 uffer".  Specifically:
3093
3094 If BUFFER is nil and AFTER-SET is nil, a return value of t indicates that
3095 the variable is one of the special built-in variables that is always
3096 buffer-local. (This includes `buffer-file-name', `buffer-read-only',
3097 `buffer-undo-list', and others.)
3098
3099 If BUFFER is nil and AFTER-SET is t, a return value of t indicates that
3100 the variable has had `make-variable-buffer-local' applied to it.
3101 */
3102       (symbol, buffer, after_set))
3103 {
3104         int local_info;
3105
3106         CHECK_SYMBOL(symbol);
3107         if (!NILP(buffer)) {
3108                 buffer = emacs_get_buffer(buffer, 1);
3109                 local_info =
3110                     symbol_value_buffer_local_info(symbol, XBUFFER(buffer));
3111         } else {
3112                 local_info = symbol_value_buffer_local_info(symbol, 0);
3113         }
3114
3115         if (NILP(after_set))
3116                 return local_info > 0 ? Qt : Qnil;
3117         else
3118                 return local_info != 0 ? Qt : Qnil;
3119 }
3120 \f
3121 /*
3122 I've gone ahead and partially implemented this because it's
3123 super-useful for dealing with the compatibility problems in supporting
3124 the old pointer-shape variables, and preventing people from `setq'ing
3125 the new variables.  Any other way of handling this problem is way
3126 ugly, likely to be slow, and generally not something I want to waste
3127 my time worrying about.
3128
3129 The interface and/or function name is sure to change before this
3130 gets into its final form.  I currently like the way everything is
3131 set up and it has all the features I want it to have, except for
3132 one: I really want to be able to have multiple nested handlers,
3133 to implement an `advice'-like capability.  This would allow,
3134 for example, a clean way of implementing `debug-if-set' or
3135 `debug-if-referenced' and such.
3136
3137 NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
3138 ************************************************************
3139 **Only** the `set-value', `make-unbound', and `make-local'
3140 handler types are currently implemented.  Implementing the
3141 get-value and bound-predicate handlers is somewhat tricky
3142 because there are lots of subfunctions (e.g. find_symbol_value()).
3143 find_symbol_value(), in fact, is called from outside of
3144 this module.  You'd have to have it do this:
3145
3146 -- check for a `bound-predicate' handler, call that if so;
3147    if it returns nil, return Qunbound
3148 -- check for a `get-value' handler and call it and return
3149    that value
3150
3151 It gets even trickier when you have to deal with
3152 sub-subfunctions like find_symbol_value_1(), and esp.
3153 when you have to properly handle variable aliases, which
3154 can lead to lots of tricky situations.  So I've just
3155 punted on this, since the interface isn't officially
3156 exported and we can get by with just a `set-value'
3157 handler.
3158
3159 Actions in unimplemented handler types will correctly
3160 ignore any handlers, and will not fuck anything up or
3161 go awry.
3162
3163 WARNING WARNING: If you do go and implement another
3164 type of handler, make *sure* to change
3165 would_be_magic_handled() so it knows about this,
3166 or dire things could result.
3167 ************************************************************
3168 NOTE NOTE NOTE NOTE NOTE NOTE NOTE
3169
3170 Real documentation is as follows.
3171
3172 Set a magic handler for VARIABLE.
3173 This allows you to specify arbitrary behavior that results from
3174 accessing or setting a variable.  For example, retrieving the
3175 variable's value might actually retrieve the first element off of
3176 a list stored in another variable, and setting the variable's value
3177 might add an element to the front of that list. (This is how the
3178 obsolete variable `unread-command-event' is implemented.)
3179
3180 In general it is NOT good programming practice to use magic variables
3181 in a new package that you are designing.  If you feel the need to
3182 do this, it's almost certainly a sign that you should be using a
3183 function instead of a variable.  This facility is provided to allow
3184 a package to support obsolete variables and provide compatibility
3185 with similar packages with different variable names and semantics.
3186 By using magic handlers, you can cleanly provide obsoleteness and
3187 compatibility support and separate this support from the core
3188 routines in a package.
3189
3190 VARIABLE should be a symbol naming the variable for which the
3191 magic behavior is provided.  HANDLER-TYPE is a symbol specifying
3192 which behavior is being controlled, and HANDLER is the function
3193 that will be called to control this behavior.  HARG is a
3194 value that will be passed to HANDLER but is otherwise
3195 uninterpreted.  KEEP-EXISTING specifies what to do with existing
3196 handlers of the same type; nil means "erase them all", t means
3197 "keep them but insert at the beginning", the list (t) means
3198 "keep them but insert at the end", a function means "keep
3199 them but insert before the specified function", a list containing
3200 a function means "keep them but insert after the specified
3201 function".
3202
3203 You can specify magic behavior for any type of variable at all,
3204 and for any handler types that are unspecified, the standard
3205 behavior applies.  This allows you, for example, to use
3206 `defvaralias' in conjunction with this function. (For that
3207 matter, `defvaralias' could be implemented using this function.)
3208
3209 The behaviors that can be specified in HANDLER-TYPE are
3210
3211 get-value               (SYM ARGS FUN HARG HANDLERS)
3212     This means that one of the functions `symbol-value',
3213     `default-value', `symbol-value-in-buffer', or
3214     `symbol-value-in-console' was called on SYM.
3215
3216 set-value               (SYM ARGS FUN HARG HANDLERS)
3217     This means that one of the functions `set' or `set-default'
3218     was called on SYM.
3219
3220 bound-predicate         (SYM ARGS FUN HARG HANDLERS)
3221     This means that one of the functions `boundp', `globally-boundp',
3222     or `default-boundp' was called on SYM.
3223
3224 make-unbound            (SYM ARGS FUN HARG HANDLERS)
3225     This means that the function `makunbound' was called on SYM.
3226
3227 local-predicate         (SYM ARGS FUN HARG HANDLERS)
3228     This means that the function `local-variable-p' was called
3229     on SYM.
3230
3231 make-local              (SYM ARGS FUN HARG HANDLERS)
3232     This means that one of the functions `make-local-variable',
3233     `make-variable-buffer-local', `kill-local-variable',
3234     or `kill-console-local-variable' was called on SYM.
3235
3236 The meanings of the arguments are as follows:
3237
3238    SYM is the symbol on which the function was called, and is always
3239    the first argument to the function.
3240
3241    ARGS are the remaining arguments in the original call (i.e. all
3242    but the first).  In the case of `set-value' in particular,
3243    the first element of ARGS is the value to which the variable
3244    is being set.  In some cases, ARGS is sanitized from what was
3245    actually given.  For example, whenever `nil' is passed to an
3246    argument and it means `current-buffer', the current buffer is
3247    substituted instead.
3248
3249    FUN is a symbol indicating which function is being called.
3250    For many of the functions, you can determine the corresponding
3251    function of a different class using
3252    `symbol-function-corresponding-function'.
3253
3254    HARG is the argument that was given in the call
3255    to `set-symbol-value-handler' for SYM and HANDLER-TYPE.
3256
3257    HANDLERS is a structure containing the remaining handlers
3258    for the variable; to call one of them, use
3259    `chain-to-symbol-value-handler'.
3260
3261 NOTE: You may *not* modify the list in ARGS, and if you want to
3262 keep it around after the handler function exits, you must make
3263 a copy using `copy-sequence'. (Same caveats for HANDLERS also.)
3264 */
3265
3266 static enum lisp_magic_handler decode_magic_handler_type(Lisp_Object symbol)
3267 {
3268         if (EQ(symbol, Qget_value))
3269                 return MAGIC_HANDLER_GET_VALUE;
3270         if (EQ(symbol, Qset_value))
3271                 return MAGIC_HANDLER_SET_VALUE;
3272         if (EQ(symbol, Qbound_predicate))
3273                 return MAGIC_HANDLER_BOUND_PREDICATE;
3274         if (EQ(symbol, Qmake_unbound))
3275                 return MAGIC_HANDLER_MAKE_UNBOUND;
3276         if (EQ(symbol, Qlocal_predicate))
3277                 return MAGIC_HANDLER_LOCAL_PREDICATE;
3278         if (EQ(symbol, Qmake_local))
3279                 return MAGIC_HANDLER_MAKE_LOCAL;
3280
3281         signal_simple_error("Unrecognized symbol value handler type", symbol);
3282         abort();
3283         return MAGIC_HANDLER_MAX;
3284 }
3285
3286 static enum lisp_magic_handler
3287 handler_type_from_function_symbol(Lisp_Object funsym, int abort_if_not_found)
3288 {
3289         if (EQ(funsym, Qsymbol_value)
3290             || EQ(funsym, Qdefault_value)
3291             || EQ(funsym, Qsymbol_value_in_buffer)
3292             || EQ(funsym, Qsymbol_value_in_console))
3293                 return MAGIC_HANDLER_GET_VALUE;
3294
3295         if (EQ(funsym, Qset)
3296             || EQ(funsym, Qset_default))
3297                 return MAGIC_HANDLER_SET_VALUE;
3298
3299         if (EQ(funsym, Qboundp)
3300             || EQ(funsym, Qglobally_boundp)
3301             || EQ(funsym, Qdefault_boundp))
3302                 return MAGIC_HANDLER_BOUND_PREDICATE;
3303
3304         if (EQ(funsym, Qmakunbound))
3305                 return MAGIC_HANDLER_MAKE_UNBOUND;
3306
3307         if (EQ(funsym, Qlocal_variable_p))
3308                 return MAGIC_HANDLER_LOCAL_PREDICATE;
3309
3310         if (EQ(funsym, Qmake_variable_buffer_local)
3311             || EQ(funsym, Qmake_local_variable))
3312                 return MAGIC_HANDLER_MAKE_LOCAL;
3313
3314         if (abort_if_not_found)
3315                 abort();
3316         signal_simple_error("Unrecognized symbol-value function", funsym);
3317         return MAGIC_HANDLER_MAX;
3318 }
3319
3320 static int would_be_magic_handled(Lisp_Object sym, Lisp_Object funsym)
3321 {
3322         /* does not take into account variable aliasing. */
3323         Lisp_Object valcontents = XSYMBOL(sym)->value;
3324         enum lisp_magic_handler slot;
3325
3326         if (!SYMBOL_VALUE_LISP_MAGIC_P(valcontents))
3327                 return 0;
3328         slot = handler_type_from_function_symbol(funsym, 1);
3329         if (slot != MAGIC_HANDLER_SET_VALUE
3330             && slot != MAGIC_HANDLER_MAKE_UNBOUND
3331             && slot != MAGIC_HANDLER_MAKE_LOCAL)
3332                 /* #### temporary kludge because we haven't implemented
3333                    lisp-magic variables completely */
3334                 return 0;
3335         return !NILP(XSYMBOL_VALUE_LISP_MAGIC(valcontents)->handler[slot]);
3336 }
3337
3338 static Lisp_Object
3339 fetch_value_maybe_past_magic(Lisp_Object sym,
3340                              Lisp_Object follow_past_lisp_magic)
3341 {
3342         Lisp_Object value = XSYMBOL(sym)->value;
3343         if (SYMBOL_VALUE_LISP_MAGIC_P(value)
3344             && (EQ(follow_past_lisp_magic, Qt)
3345                 || (!NILP(follow_past_lisp_magic)
3346                     && !would_be_magic_handled(sym, follow_past_lisp_magic))))
3347                 value = XSYMBOL_VALUE_LISP_MAGIC(value)->shadowed;
3348         return value;
3349 }
3350
3351 static Lisp_Object *value_slot_past_magic(Lisp_Object sym)
3352 {
3353         Lisp_Object *store_pointer = &XSYMBOL(sym)->value;
3354
3355         if (SYMBOL_VALUE_LISP_MAGIC_P(*store_pointer))
3356                 store_pointer = &XSYMBOL_VALUE_LISP_MAGIC(sym)->shadowed;
3357         return store_pointer;
3358 }
3359
3360 static Lisp_Object
3361 maybe_call_magic_handler(Lisp_Object sym, Lisp_Object funsym, int nargs, ...)
3362 {
3363         va_list vargs;
3364         Lisp_Object args[20];   /* should be enough ... */
3365         int i;
3366         enum lisp_magic_handler htype;
3367         Lisp_Object legerdemain;
3368         struct symbol_value_lisp_magic *bfwd;
3369
3370         assert(nargs >= 0 && nargs < countof(args));
3371         legerdemain = XSYMBOL(sym)->value;
3372         assert(SYMBOL_VALUE_LISP_MAGIC_P(legerdemain));
3373         bfwd = XSYMBOL_VALUE_LISP_MAGIC(legerdemain);
3374
3375         va_start(vargs, nargs);
3376         for (i = 0; i < nargs; i++)
3377                 args[i] = va_arg(vargs, Lisp_Object);
3378         va_end(vargs);
3379
3380         htype = handler_type_from_function_symbol(funsym, 1);
3381         if (NILP(bfwd->handler[htype]))
3382                 return Qunbound;
3383         /* #### should be reusing the arglist, not always consing anew.
3384            Repeated handler invocations should not cause repeated consing.
3385            Doesn't matter for now, because this is just a quick implementation
3386            for obsolescence support. */
3387         return call5(bfwd->handler[htype], sym, Flist(nargs, args), funsym,
3388                      bfwd->harg[htype], Qnil);
3389 }
3390
3391 DEFUN("dontusethis-set-symbol-value-handler", Fdontusethis_set_symbol_value_handler, 3, 5, 0,   /*
3392 Don't you dare use this.
3393 If you do, suffer the wrath of Ben, who is likely to rename
3394 this function (or change the semantics of its arguments) without
3395 pity, thereby invalidating your code.
3396 */
3397       (variable, handler_type, handler, harg, keep_existing))
3398 {
3399         Lisp_Object valcontents;
3400         struct symbol_value_lisp_magic *bfwd;
3401         enum lisp_magic_handler htype;
3402         int i;
3403
3404         /* #### WARNING, only some handler types are implemented.  See above.
3405            Actions of other types will ignore a handler if it's there.
3406
3407            #### Also, `chain-to-symbol-value-handler' and
3408            `symbol-function-corresponding-function' are not implemented. */
3409         CHECK_SYMBOL(variable);
3410         CHECK_SYMBOL(handler_type);
3411         htype = decode_magic_handler_type(handler_type);
3412         valcontents = XSYMBOL(variable)->value;
3413         if (!SYMBOL_VALUE_LISP_MAGIC_P(valcontents)) {
3414                 bfwd = alloc_lcrecord_type(struct symbol_value_lisp_magic,
3415                                            &lrecord_symbol_value_lisp_magic);
3416                 zero_lcrecord(&bfwd->magic);
3417                 bfwd->magic.type = SYMVAL_LISP_MAGIC;
3418                 for (i = 0; i < MAGIC_HANDLER_MAX; i++) {
3419                         bfwd->handler[i] = Qnil;
3420                         bfwd->harg[i] = Qnil;
3421                 }
3422                 bfwd->shadowed = valcontents;
3423                 XSETSYMBOL_VALUE_MAGIC(XSYMBOL(variable)->value, bfwd);
3424         } else
3425                 bfwd = XSYMBOL_VALUE_LISP_MAGIC(valcontents);
3426         bfwd->handler[htype] = handler;
3427         bfwd->harg[htype] = harg;
3428
3429         for (i = 0; i < MAGIC_HANDLER_MAX; i++)
3430                 if (!NILP(bfwd->handler[i]))
3431                         break;
3432
3433         if (i == MAGIC_HANDLER_MAX)
3434                 /* there are no remaining handlers, so remove the structure. */
3435                 XSYMBOL(variable)->value = bfwd->shadowed;
3436
3437         return Qnil;
3438 }
3439 \f
3440 /* functions for working with variable aliases.  */
3441
3442 /* Follow the chain of variable aliases for SYMBOL.  Return the
3443    resulting symbol, whose value cell is guaranteed not to be a
3444    symbol-value-varalias.
3445
3446    Also maybe follow past symbol-value-lisp-magic -> symbol-value-varalias.
3447    If FUNSYM is t, always follow in such a case.  If FUNSYM is nil,
3448    never follow; stop right there.  Otherwise FUNSYM should be a
3449    recognized symbol-value function symbol; this means, follow
3450    unless there is a special handler for the named function.
3451
3452    OK, there is at least one reason why it's necessary for
3453    FOLLOW-PAST-LISP-MAGIC to be specified correctly: So that we
3454    can always be sure to catch cyclic variable aliasing.  If we never
3455    follow past Lisp magic, then if the following is done:
3456
3457    (defvaralias 'a 'b)
3458    add some magic behavior to a, but not a "get-value" handler
3459    (defvaralias 'b 'a)
3460
3461    then an attempt to retrieve a's or b's value would cause infinite
3462    looping in `symbol-value'.
3463
3464    We (of course) can't always follow past Lisp magic, because then
3465    we make any variable that is lisp-magic -> varalias behave as if
3466    the lisp-magic is not present at all.
3467  */
3468
3469 static Lisp_Object
3470 follow_varalias_pointers(Lisp_Object symbol, Lisp_Object follow_past_lisp_magic)
3471 {
3472 #define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
3473         Lisp_Object tortoise, hare, val;
3474         int count;
3475
3476         /* quick out just in case */
3477         if (!SYMBOL_VALUE_MAGIC_P(XSYMBOL(symbol)->value))
3478                 return symbol;
3479
3480         /* Compare implementation of indirect_function().  */
3481         for (hare = tortoise = symbol, count = 0;
3482              val = fetch_value_maybe_past_magic(hare, follow_past_lisp_magic),
3483              SYMBOL_VALUE_VARALIAS_P(val);
3484              hare = symbol_value_varalias_aliasee(XSYMBOL_VALUE_VARALIAS(val)),
3485              count++) {
3486                 if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) {
3487                         continue;
3488                 }
3489                 if (count & 1) {
3490                         Lisp_Object tmp =
3491                                 fetch_value_maybe_past_magic(
3492                                         tortoise, follow_past_lisp_magic);
3493                         tortoise = symbol_value_varalias_aliasee(
3494                                 XSYMBOL_VALUE_VARALIAS(tmp));
3495                 }
3496                 if (EQ(hare, tortoise)) {
3497                         return Fsignal(Qcyclic_variable_indirection,
3498                                        list1(symbol));
3499                 }
3500         }
3501
3502         return hare;
3503 }
3504
3505 DEFUN("defvaralias", Fdefvaralias, 2, 2, 0,     /*
3506 Define a variable as an alias for another variable.
3507 Thenceforth, any operations performed on VARIABLE will actually be
3508 performed on ALIAS.  Both VARIABLE and ALIAS should be symbols.
3509 If ALIAS is nil, remove any aliases for VARIABLE.
3510 ALIAS can itself be aliased, and the chain of variable aliases
3511 will be followed appropriately.
3512 If VARIABLE already has a value, this value will be shadowed
3513 until the alias is removed, at which point it will be restored.
3514 Currently VARIABLE cannot be a built-in variable, a variable that
3515 has a buffer-local value in any buffer, or the symbols nil or t.
3516 \(ALIAS, however, can be any type of variable.)
3517 */
3518       (variable, alias))
3519 {
3520         struct symbol_value_varalias *bfwd;
3521         Lisp_Object valcontents;
3522
3523         CHECK_SYMBOL(variable);
3524         reject_constant_symbols(variable, Qunbound, 0, Qt);
3525
3526         valcontents = XSYMBOL(variable)->value;
3527
3528         if (NILP(alias)) {
3529                 if (SYMBOL_VALUE_VARALIAS_P(valcontents)) {
3530                         XSYMBOL(variable)->value =
3531                             symbol_value_varalias_shadowed
3532                             (XSYMBOL_VALUE_VARALIAS(valcontents));
3533                 }
3534                 return Qnil;
3535         }
3536
3537         CHECK_SYMBOL(alias);
3538         if (SYMBOL_VALUE_VARALIAS_P(valcontents)) {
3539                 /* transmogrify */
3540                 XSYMBOL_VALUE_VARALIAS(valcontents)->aliasee = alias;
3541                 return Qnil;
3542         }
3543
3544         if (SYMBOL_VALUE_MAGIC_P(valcontents)
3545             && !UNBOUNDP(valcontents))
3546                 signal_simple_error("Variable is magic and cannot be aliased",
3547                                     variable);
3548         reject_constant_symbols(variable, Qunbound, 0, Qt);
3549
3550         bfwd = alloc_lcrecord_type(struct symbol_value_varalias,
3551                                    &lrecord_symbol_value_varalias);
3552         zero_lcrecord(&bfwd->magic);
3553         bfwd->magic.type = SYMVAL_VARALIAS;
3554         bfwd->aliasee = alias;
3555         bfwd->shadowed = valcontents;
3556
3557         XSETSYMBOL_VALUE_MAGIC(valcontents, bfwd);
3558         XSYMBOL(variable)->value = valcontents;
3559         return Qnil;
3560 }
3561
3562 DEFUN("variable-alias", Fvariable_alias, 1, 2, 0,       /*
3563 If VARIABLE is aliased to another variable, return that variable.
3564 VARIABLE should be a symbol.  If VARIABLE is not aliased, return nil.
3565 Variable aliases are created with `defvaralias'.  See also
3566 `indirect-variable'.
3567 */
3568       (variable, follow_past_lisp_magic))
3569 {
3570         Lisp_Object valcontents;
3571
3572         CHECK_SYMBOL(variable);
3573         if (!NILP(follow_past_lisp_magic) && !EQ(follow_past_lisp_magic, Qt)) {
3574                 CHECK_SYMBOL(follow_past_lisp_magic);
3575                 handler_type_from_function_symbol(follow_past_lisp_magic, 0);
3576         }
3577
3578         valcontents = fetch_value_maybe_past_magic(variable,
3579                                                    follow_past_lisp_magic);
3580
3581         if (SYMBOL_VALUE_VARALIAS_P(valcontents))
3582                 return symbol_value_varalias_aliasee
3583                     (XSYMBOL_VALUE_VARALIAS(valcontents));
3584         else
3585                 return Qnil;
3586 }
3587
3588 DEFUN("indirect-variable", Findirect_variable, 1, 2, 0, /*
3589 Return the variable at the end of OBJECT's variable-alias chain.
3590 If OBJECT is a symbol, follow all variable aliases and return
3591 the final (non-aliased) symbol.  Variable aliases are created with
3592 the function `defvaralias'.
3593 If OBJECT is not a symbol, just return it.
3594 Signal a cyclic-variable-indirection error if there is a loop in the
3595 variable chain of symbols.
3596 */
3597       (object, follow_past_lisp_magic))
3598 {
3599         if (!SYMBOLP(object))
3600                 return object;
3601         if (!NILP(follow_past_lisp_magic) && !EQ(follow_past_lisp_magic, Qt)) {
3602                 CHECK_SYMBOL(follow_past_lisp_magic);
3603                 handler_type_from_function_symbol(follow_past_lisp_magic, 0);
3604         }
3605         return follow_varalias_pointers(object, follow_past_lisp_magic);
3606 }
3607
3608 DEFUN("variable-binding-locus", Fvariable_binding_locus, 1, 1, 0,       /*
3609 Return a value indicating where VARIABLE's current binding comes from.
3610 If the current binding is buffer-local, the value is the current buffer.
3611 If the current binding is global (the default), the value is nil.
3612 */
3613       (variable))
3614 {
3615         Lisp_Object valcontents;
3616
3617         CHECK_SYMBOL(variable);
3618         variable = Findirect_variable(variable, Qnil);
3619
3620         /* Make sure the current binding is actually swapped in.  */
3621         find_symbol_value(variable);
3622
3623         valcontents = XSYMBOL(variable)->value;
3624
3625         if (SYMBOL_VALUE_MAGIC_P(valcontents)
3626             && ((XSYMBOL_VALUE_MAGIC_TYPE(valcontents) == SYMVAL_BUFFER_LOCAL)
3627                 || (XSYMBOL_VALUE_MAGIC_TYPE(valcontents) ==
3628                     SYMVAL_SOME_BUFFER_LOCAL))
3629             && (!NILP(Flocal_variable_p(variable, Fcurrent_buffer(), Qnil))))
3630                 return Fcurrent_buffer();
3631         else
3632                 return Qnil;
3633 }
3634 \f
3635 /************************************************************************/
3636 /*                            initialization                            */
3637 /************************************************************************/
3638
3639 /* A dumped SXEmacs image has a lot more than 1511 symbols.  Last
3640    estimate was that there were actually around 6300.  So let's try
3641    making this bigger and see if we get better hashing behavior. */
3642 #define OBARRAY_SIZE 16411
3643
3644 #ifndef Qzero
3645 Lisp_Object Qzero;
3646 #endif
3647 #ifndef Qnull_pointer
3648 Lisp_Object Qnull_pointer;
3649 #endif
3650
3651 /* some losing systems can't have static vars at function scope... */
3652 static struct symbol_value_magic guts_of_unbound_marker = {
3653         /* struct symbol_value_magic */
3654         {                       /* struct lcrecord_header */
3655          {                      /* struct lrecord_header */
3656           lrecord_type_symbol_value_forward,    /* lrecord_type_index */
3657           1,                    /* mark bit */
3658           1,                    /* c_readonly bit */
3659           1,                    /* lisp_readonly bit */
3660           },
3661 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
3662          0,                     /* next */
3663 #endif  /* !BDWGC */
3664          0,                     /* uid  */
3665          0,                     /* free */
3666          },
3667         0,                      /* value */
3668         SYMVAL_UNBOUND_MARKER
3669 };
3670
3671 static inline void
3672 intern_nil(void)
3673 {
3674         hcode_t hash = hash_string(string_data(XSYMBOL(Qnil)->name), 3);
3675         XVECTOR_DATA(Vobarray)[hash % OBARRAY_SIZE] = Qnil;
3676         return;
3677 }
3678
3679 void init_symbols_once_early(void)
3680 {
3681         INIT_LRECORD_IMPLEMENTATION(symbol);
3682         INIT_LRECORD_IMPLEMENTATION(symbol_value_forward);
3683         INIT_LRECORD_IMPLEMENTATION(symbol_value_buffer_local);
3684         INIT_LRECORD_IMPLEMENTATION(symbol_value_lisp_magic);
3685         INIT_LRECORD_IMPLEMENTATION(symbol_value_varalias);
3686
3687         reinit_symbols_once_early();
3688
3689         /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3690            called the first time. */
3691         Qnil = Fmake_symbol(make_string_nocopy((Bufbyte *)"nil", 3));
3692         XSYMBOL(Qnil)->name->plist = Qnil;
3693         XSYMBOL(Qnil)->value = Qnil;    /* Nihil ex nihil */
3694         XSYMBOL(Qnil)->plist = Qnil;
3695
3696         Vobarray = make_vector(OBARRAY_SIZE, Qzero);
3697         initial_obarray = Vobarray;
3698         staticpro(&initial_obarray);
3699         /* Intern nil in the obarray */
3700         intern_nil();
3701
3702         {
3703                 /* Required to get around a GCC syntax error on certain
3704                    architectures */
3705                 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3706
3707                 XSETSYMBOL_VALUE_MAGIC(Qunbound, tem);
3708         }
3709
3710         XSYMBOL(Qnil)->function = Qunbound;
3711
3712         defsymbol(&Qt, "t");
3713         XSYMBOL(Qt)->value = Qt;        /* Veritas aeterna */
3714         Vquit_flag = Qnil;
3715
3716         dump_add_root_object(&Qnil);
3717         dump_add_root_object(&Qunbound);
3718         dump_add_root_object(&Vquit_flag);
3719 }
3720
3721 void reinit_symbols_once_early(void)
3722 {
3723 #ifndef Qzero
3724         Qzero = make_int(0);    /* Only used if Lisp_Object is a union type */
3725 #endif
3726
3727 #ifndef Qnull_pointer
3728         /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3729            so the following is actually a no-op.  */
3730         XSETOBJ(Qnull_pointer, 0);
3731 #endif
3732 }
3733
3734 static void
3735 defsymbol_massage_name_1(Lisp_Object * location, const char *name, int dump_p,
3736                          int multiword_predicate_p)
3737 {
3738         char temp[1024];
3739         size_t len = strlen(name) - 1;
3740         size_t i;
3741
3742         if (multiword_predicate_p)
3743                 /* If it is a multiword_predicate_p it is expected
3744                    the last char of name is a p, which should be
3745                    removed and replaced with "_p", so the net length
3746                    difference is 1 char, the '_' */
3747                 assert(len + 1 < sizeof(temp));
3748         else
3749                 assert(len < sizeof(temp));
3750         temp[0]='\0';
3751         strncat(temp, name + 1, sizeof(temp)-1);        /* Remove initial Q */
3752         if (multiword_predicate_p) {
3753                 /* Overwrite the 'p' which is the last char of name
3754                    and put "_p" instead. */
3755                 strcpy(temp + len - 1, "_p");
3756                 len++;
3757         }
3758         for (i = 0; i < len; i++)
3759                 if (temp[i] == '_')
3760                         temp[i] = '-';
3761         *location = Fintern(make_string((const Bufbyte *)temp, len), Qnil);
3762         if (dump_p)
3763                 staticpro(location);
3764         else
3765                 staticpro_nodump(location);
3766 }
3767
3768 void defsymbol_massage_name_nodump(Lisp_Object * location, const char *name)
3769 {
3770         defsymbol_massage_name_1(location, name, 0, 0);
3771 }
3772
3773 void defsymbol_massage_name(Lisp_Object * location, const char *name)
3774 {
3775         defsymbol_massage_name_1(location, name, 1, 0);
3776 }
3777
3778 void
3779 defsymbol_massage_multiword_predicate_nodump(Lisp_Object * location,
3780                                              const char *name)
3781 {
3782         defsymbol_massage_name_1(location, name, 0, 1);
3783 }
3784
3785 void
3786 defsymbol_massage_multiword_predicate(Lisp_Object * location, const char *name)
3787 {
3788         defsymbol_massage_name_1(location, name, 1, 1);
3789 }
3790
3791 void defsymbol_nodump(Lisp_Object * location, char *name)
3792 {
3793         *location = Fintern(make_string_nocopy(
3794                                     (Bufbyte *)name, strlen(name)), Qnil);
3795         staticpro_nodump(location);
3796 }
3797
3798 void defsymbol(Lisp_Object * location, char *name)
3799 {
3800         *location = Fintern(make_string_nocopy(
3801                                     (Bufbyte*)name, strlen(name)), Qnil);
3802         staticpro(location);
3803 }
3804
3805 void defkeyword(Lisp_Object * location, char *name)
3806 {
3807         defsymbol(location, name);
3808         Fset(*location, *location);
3809 }
3810
3811 void defkeyword_massage_name(Lisp_Object * location, const char *name)
3812 {
3813         char temp[500];
3814         size_t len = strlen(name);
3815
3816         assert(len < sizeof(temp));
3817         strcpy(temp, name);
3818         temp[1] = ':';          /* it's an underscore in the C variable */
3819
3820         defsymbol_massage_name(location, temp);
3821         Fset(*location, *location);
3822 }
3823
3824 #ifdef DEBUG_SXEMACS
3825 /* Check that nobody spazzed writing a DEFUN. */
3826 static void check_sane_subr(Lisp_Subr * subr, Lisp_Object sym)
3827 {
3828         assert(subr->min_args >= 0);
3829         assert(subr->min_args <= SUBR_MAX_ARGS);
3830
3831         if (subr->max_args != MANY && subr->max_args != UNEVALLED) {
3832                 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3833                 assert(subr->max_args <= SUBR_MAX_ARGS);
3834                 assert(subr->min_args <= subr->max_args);
3835         }
3836
3837 #if defined somebody_can_explain_why_a_symbol_must_not_be_bound &&      \
3838         somebody_can_explain_why_a_symbol_must_not_be_bound
3839         assert(UNBOUNDP(XSYMBOL(sym)->function));
3840 #endif  /* somebody_can_explain_why_a_symbol_must_not_be_bound */
3841 }
3842 #else
3843 #define check_sane_subr(subr, sym)      /* nothing */
3844 #endif
3845
3846
3847 void defsubr(Lisp_Subr * subr)
3848 {
3849         Lisp_Object sym = intern(subr_name(subr));
3850         Lisp_Object fun;
3851
3852         check_sane_subr(subr, sym);
3853
3854         XSETSUBR(fun, subr);
3855         XSYMBOL(sym)->function = fun;
3856
3857         /* work on me!!! */
3858 #ifdef HAVE_SHLIB
3859         /* If it is declared in a module, update the load history */
3860         if (initialized)
3861                 LOADHIST_ATTACH(sym);
3862 #endif
3863         return;
3864 }
3865
3866 void
3867 undefsubr(Lisp_Subr *subr)
3868 {
3869         Lisp_Object sym = intern(subr_name(subr));
3870
3871         check_sane_subr(subr, sym);
3872         XSYMBOL(sym)->function = Qunbound;
3873         return;
3874 }
3875
3876 /* Define a lisp macro using a Lisp_Subr. */
3877 void defsubr_macro(Lisp_Subr * subr)
3878 {
3879         Lisp_Object sym = intern(subr_name(subr));
3880         Lisp_Object fun;
3881
3882         check_sane_subr(subr, sym);
3883
3884         XSETSUBR(fun, subr);
3885         XSYMBOL(sym)->function = Fcons(Qmacro, fun);
3886 }
3887
3888 static void
3889 deferror_1(Lisp_Object * symbol, char *name, const char *messuhhj,
3890            Lisp_Object inherits_from, int massage_p)
3891 {
3892         Lisp_Object conds;
3893         if (massage_p)
3894                 defsymbol_massage_name(symbol, name);
3895         else
3896                 defsymbol(symbol, name);
3897
3898         assert(SYMBOLP(inherits_from));
3899         conds = Fget(inherits_from, Qerror_conditions, Qnil);
3900         Fput(*symbol, Qerror_conditions, Fcons(*symbol, conds));
3901         /* NOT build_translated_string ().  This function is called at load time
3902            and the string needs to get translated at run time.  (This happens
3903            in the function (display-error) in cmdloop.el.) */
3904         Fput(*symbol, Qerror_message, build_string(messuhhj));
3905 }
3906
3907 void
3908 deferror(Lisp_Object *symbol, char *name, const char *messuhhj,
3909          Lisp_Object inherits_from)
3910 {
3911         deferror_1(symbol, name, messuhhj, inherits_from, 0);
3912 }
3913
3914 void
3915 deferror_massage_name(Lisp_Object * symbol, char *name,
3916                       const char *messuhhj, Lisp_Object inherits_from)
3917 {
3918         deferror_1(symbol, name, messuhhj, inherits_from, 1);
3919 }
3920
3921 void
3922 deferror_massage_name_and_message(Lisp_Object * symbol, char *name,
3923                                   Lisp_Object inherits_from)
3924 {
3925         char temp[1024];
3926         size_t i;
3927         size_t len = strlen(name) - 1;
3928
3929         assert(len < sizeof(temp));
3930         temp[0]='\0';
3931         strncat(temp, name + 1, sizeof(temp)-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 }