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