data.c 76.3 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
2
   Copyright (C) 1985, 86, 88, 93, 94, 95 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
3 4 5 6 7

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
Karl Heuer's avatar
Karl Heuer committed
8
the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
9 10 11 12 13 14 15 16 17
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
18 19
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */
Jim Blandy's avatar
Jim Blandy committed
20 21 22 23


#include <signal.h>

24
#include <config.h>
Jim Blandy's avatar
Jim Blandy committed
25
#include "lisp.h"
Jim Blandy's avatar
Jim Blandy committed
26
#include "puresize.h"
Karl Heuer's avatar
Karl Heuer committed
27
#include "charset.h"
Jim Blandy's avatar
Jim Blandy committed
28 29 30

#ifndef standalone
#include "buffer.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
31
#include "keyboard.h"
Jim Blandy's avatar
Jim Blandy committed
32 33
#endif

Jim Blandy's avatar
Jim Blandy committed
34
#include "syssignal.h"
Jim Blandy's avatar
Jim Blandy committed
35

Jim Blandy's avatar
Jim Blandy committed
36
#ifdef LISP_FLOAT_TYPE
37

38 39
#ifdef STDC_HEADERS
#include <stdlib.h>
40
#include <float.h>
41
#endif
42

43 44 45 46 47 48 49 50 51 52
/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
#ifndef IEEE_FLOATING_POINT
#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
     && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
#define IEEE_FLOATING_POINT 1
#else
#define IEEE_FLOATING_POINT 0
#endif
#endif

53 54 55 56 57 58 59 60 61 62
/* Work around a problem that happens because math.h on hpux 7
   defines two static variables--which, in Emacs, are not really static,
   because `static' is defined as nothing.  The problem is that they are
   here, in floatfns.c, and in lread.c.
   These macros prevent the name conflict.  */
#if defined (HPUX) && !defined (HPUX8)
#define _MAXLDBL data_c_maxldbl
#define _NMAXLDBL data_c_nmaxldbl
#endif

Jim Blandy's avatar
Jim Blandy committed
63 64 65
#include <math.h>
#endif /* LISP_FLOAT_TYPE */

66 67 68 69
#if !defined (atof)
extern double atof ();
#endif /* !atof */

Jim Blandy's avatar
Jim Blandy committed
70 71 72
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
Jim Blandy's avatar
Jim Blandy committed
73
Lisp_Object Qvoid_variable, Qvoid_function, Qcyclic_function_indirection;
Jim Blandy's avatar
Jim Blandy committed
74 75
Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
Roland McGrath's avatar
Roland McGrath committed
76
Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
Jim Blandy's avatar
Jim Blandy committed
77
Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
78
Lisp_Object Qintegerp, Qnatnump, Qwholenump, Qsymbolp, Qlistp, Qconsp;
Jim Blandy's avatar
Jim Blandy committed
79 80
Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
81
Lisp_Object Qbuffer_or_string_p;
Jim Blandy's avatar
Jim Blandy committed
82
Lisp_Object Qboundp, Qfboundp;
83
Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
84

Jim Blandy's avatar
Jim Blandy committed
85
Lisp_Object Qcdr;
86
Lisp_Object Qad_advice_info, Qad_activate;
Jim Blandy's avatar
Jim Blandy committed
87

88 89 90
Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
Lisp_Object Qoverflow_error, Qunderflow_error;

Jim Blandy's avatar
Jim Blandy committed
91
#ifdef LISP_FLOAT_TYPE
92
Lisp_Object Qfloatp;
Jim Blandy's avatar
Jim Blandy committed
93 94 95
Lisp_Object Qnumberp, Qnumber_or_marker_p;
#endif

96
static Lisp_Object Qinteger, Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
Karl Heuer's avatar
Karl Heuer committed
97 98
static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
Lisp_Object Qprocess;
99
static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
100
static Lisp_Object Qchar_table, Qbool_vector;
101

Jim Blandy's avatar
Jim Blandy committed
102 103
static Lisp_Object swap_in_symval_forwarding ();

104 105
Lisp_Object set_internal ();

Jim Blandy's avatar
Jim Blandy committed
106 107 108 109 110 111 112 113 114
Lisp_Object
wrong_type_argument (predicate, value)
     register Lisp_Object predicate, value;
{
  register Lisp_Object tem;
  do
    {
      if (!EQ (Vmocklisp_arguments, Qt))
	{
115
	 if (STRINGP (value) &&
Jim Blandy's avatar
Jim Blandy committed
116
	     (EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p)))
117
	   return Fstring_to_number (value, Qnil);
118
	 if (INTEGERP (value) && EQ (predicate, Qstringp))
119
	   return Fnumber_to_string (value);
Jim Blandy's avatar
Jim Blandy committed
120
	}
121 122 123

      /* If VALUE is not even a valid Lisp object, abort here
	 where we can get a backtrace showing where it came from.  */
124
      if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit)
125 126
	abort ();

Jim Blandy's avatar
Jim Blandy committed
127 128 129
      value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil)));
      tem = call1 (predicate, value);
    }
Jim Blandy's avatar
Jim Blandy committed
130
  while (NILP (tem));
Jim Blandy's avatar
Jim Blandy committed
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
  return value;
}

pure_write_error ()
{
  error ("Attempt to modify read-only object");
}

void
args_out_of_range (a1, a2)
     Lisp_Object a1, a2;
{
  while (1)
    Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Qnil)));
}

void
args_out_of_range_3 (a1, a2, a3)
     Lisp_Object a1, a2, a3;
{
  while (1)
    Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Fcons (a3, Qnil))));
}

/* On some machines, XINT needs a temporary location.
   Here it is, in case it is needed.  */

int sign_extend_temp;

/* On a few machines, XINT can only be done by calling this.  */

int
sign_extend_lisp_int (num)
164
     EMACS_INT num;
Jim Blandy's avatar
Jim Blandy committed
165
{
166 167
  if (num & (((EMACS_INT) 1) << (VALBITS - 1)))
    return num | (((EMACS_INT) (-1)) << VALBITS);
Jim Blandy's avatar
Jim Blandy committed
168
  else
169
    return num & ((((EMACS_INT) 1) << VALBITS) - 1);
Jim Blandy's avatar
Jim Blandy committed
170 171 172 173 174
}

/* Data type predicates */

DEFUN ("eq", Feq, Seq, 2, 2, 0,
Richard M. Stallman's avatar
Richard M. Stallman committed
175
  "Return t if the two args are the same Lisp object.")
Jim Blandy's avatar
Jim Blandy committed
176 177 178 179 180 181 182 183
  (obj1, obj2)
     Lisp_Object obj1, obj2;
{
  if (EQ (obj1, obj2))
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
184
DEFUN ("null", Fnull, Snull, 1, 1, 0, "Return t if OBJECT is nil.")
185 186
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
187
{
188
  if (NILP (object))
Jim Blandy's avatar
Jim Blandy committed
189 190 191 192
    return Qt;
  return Qnil;
}

193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214
DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
  "Return a symbol representing the type of OBJECT.\n\
The symbol returned names the object's basic type;\n\
for example, (type-of 1) returns `integer'.")
  (object)
     Lisp_Object object;
{
  switch (XGCTYPE (object))
    {
    case Lisp_Int:
      return Qinteger;

    case Lisp_Symbol:
      return Qsymbol;

    case Lisp_String:
      return Qstring;

    case Lisp_Cons:
      return Qcons;

    case Lisp_Misc:
215
      switch (XMISCTYPE (object))
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238
	{
	case Lisp_Misc_Marker:
	  return Qmarker;
	case Lisp_Misc_Overlay:
	  return Qoverlay;
	case Lisp_Misc_Float:
	  return Qfloat;
	}
      abort ();

    case Lisp_Vectorlike:
      if (GC_WINDOW_CONFIGURATIONP (object))
	return Qwindow_configuration;
      if (GC_PROCESSP (object))
	return Qprocess;
      if (GC_WINDOWP (object))
	return Qwindow;
      if (GC_SUBRP (object))
	return Qsubr;
      if (GC_COMPILEDP (object))
	return Qcompiled_function;
      if (GC_BUFFERP (object))
	return Qbuffer;
239 240 241 242
      if (GC_CHAR_TABLE_P (object))
	return Qchar_table;
      if (GC_BOOL_VECTOR_P (object))
	return Qbool_vector;
243 244 245 246 247 248 249 250 251 252 253 254 255 256
      if (GC_FRAMEP (object))
	return Qframe;
      return Qvector;

#ifdef LISP_FLOAT_TYPE
    case Lisp_Float:
      return Qfloat;
#endif

    default:
      abort ();
    }
}

Richard M. Stallman's avatar
Richard M. Stallman committed
257
DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, "Return t if OBJECT is a cons cell.")
258 259
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
260
{
261
  if (CONSP (object))
Jim Blandy's avatar
Jim Blandy committed
262 263 264 265
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
266
DEFUN ("atom", Fatom, Satom, 1, 1, 0, "Return t if OBJECT is not a cons cell.  This includes nil.")
267 268
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
269
{
270
  if (CONSP (object))
Jim Blandy's avatar
Jim Blandy committed
271 272 273 274
    return Qnil;
  return Qt;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
275
DEFUN ("listp", Flistp, Slistp, 1, 1, 0, "Return t if OBJECT is a list.  This includes nil.")
276 277
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
278
{
279
  if (CONSP (object) || NILP (object))
Jim Blandy's avatar
Jim Blandy committed
280 281 282 283
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
284
DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, "Return t if OBJECT is not a list.  Lists include nil.")
285 286
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
287
{
288
  if (CONSP (object) || NILP (object))
Jim Blandy's avatar
Jim Blandy committed
289 290 291 292
    return Qnil;
  return Qt;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
293
DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, "Return t if OBJECT is a symbol.")
294 295
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
296
{
297
  if (SYMBOLP (object))
Jim Blandy's avatar
Jim Blandy committed
298 299 300 301
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
302
DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, "Return t if OBJECT is a vector.")
303 304
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
305
{
306
  if (VECTORP (object))
Jim Blandy's avatar
Jim Blandy committed
307 308 309 310
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
311
DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, "Return t if OBJECT is a string.")
312 313
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
314
{
315
  if (STRINGP (object))
Jim Blandy's avatar
Jim Blandy committed
316 317 318 319
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
320
DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0, "Return t if OBJECT is a char-table.")
321 322 323 324 325 326 327 328
  (object)
     Lisp_Object object;
{
  if (CHAR_TABLE_P (object))
    return Qt;
  return Qnil;
}

329 330
DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p,
       Svector_or_char_table_p, 1, 1, 0,
Richard M. Stallman's avatar
Richard M. Stallman committed
331
       "Return t if OBJECT is a char-table or vector.")
332 333 334 335 336 337 338 339
  (object)
     Lisp_Object object;
{
  if (VECTORP (object) || CHAR_TABLE_P (object))
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
340
DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0, "Return t if OBJECT is a bool-vector.")
341 342 343 344 345 346 347 348
  (object)
     Lisp_Object object;
{
  if (BOOL_VECTOR_P (object))
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
349
DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "Return t if OBJECT is an array (string or vector).")
350 351
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
352
{
353 354
  if (VECTORP (object) || STRINGP (object)
      || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
Jim Blandy's avatar
Jim Blandy committed
355 356 357 358 359
    return Qt;
  return Qnil;
}

DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
Richard M. Stallman's avatar
Richard M. Stallman committed
360
  "Return t if OBJECT is a sequence (list or array).")
361 362
  (object)
     register Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
363
{
364 365
  if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object)
      || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
Jim Blandy's avatar
Jim Blandy committed
366 367 368 369
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
370
DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, "Return t if OBJECT is an editor buffer.")
371 372
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
373
{
374
  if (BUFFERP (object))
Jim Blandy's avatar
Jim Blandy committed
375 376 377 378
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
379
DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, "Return t if OBJECT is a marker (editor pointer).")
380 381
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
382
{
383
  if (MARKERP (object))
Jim Blandy's avatar
Jim Blandy committed
384 385 386 387
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
388
DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "Return t if OBJECT is a built-in function.")
389 390
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
391
{
392
  if (SUBRP (object))
Jim Blandy's avatar
Jim Blandy committed
393 394 395 396
    return Qt;
  return Qnil;
}

Jim Blandy's avatar
Jim Blandy committed
397
DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
Richard M. Stallman's avatar
Richard M. Stallman committed
398
       1, 1, 0, "Return t if OBJECT is a byte-compiled function object.")
399 400
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
401
{
402
  if (COMPILEDP (object))
Jim Blandy's avatar
Jim Blandy committed
403 404 405 406
    return Qt;
  return Qnil;
}

407
DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
Richard M. Stallman's avatar
Richard M. Stallman committed
408
  "Return t if OBJECT is a character (an integer) or a string.")
409 410
  (object)
     register Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
411
{
412
  if (INTEGERP (object) || STRINGP (object))
Jim Blandy's avatar
Jim Blandy committed
413 414 415 416
    return Qt;
  return Qnil;
}

Richard M. Stallman's avatar
Richard M. Stallman committed
417
DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, "Return t if OBJECT is an integer.")
418 419
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
420
{
421
  if (INTEGERP (object))
Jim Blandy's avatar
Jim Blandy committed
422 423 424 425
    return Qt;
  return Qnil;
}

426
DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0,
Richard M. Stallman's avatar
Richard M. Stallman committed
427
  "Return t if OBJECT is an integer or a marker (editor pointer).")
428 429
  (object)
     register Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
430
{
431
  if (MARKERP (object) || INTEGERP (object))
Jim Blandy's avatar
Jim Blandy committed
432 433 434 435
    return Qt;
  return Qnil;
}

436
DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
Richard M. Stallman's avatar
Richard M. Stallman committed
437
  "Return t if OBJECT is a nonnegative integer.")
438 439
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
440
{
441
  if (NATNUMP (object))
Jim Blandy's avatar
Jim Blandy committed
442 443 444 445 446
    return Qt;
  return Qnil;
}

DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
Richard M. Stallman's avatar
Richard M. Stallman committed
447
       "Return t if OBJECT is a number (floating point or integer).")
448 449
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
450
{
451
  if (NUMBERP (object))
Jim Blandy's avatar
Jim Blandy committed
452
    return Qt;
Jim Blandy's avatar
Jim Blandy committed
453 454
  else
    return Qnil;
Jim Blandy's avatar
Jim Blandy committed
455 456 457 458
}

DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
       Snumber_or_marker_p, 1, 1, 0,
Richard M. Stallman's avatar
Richard M. Stallman committed
459
       "Return t if OBJECT is a number or a marker.")
460 461
  (object)
     Lisp_Object object;
Jim Blandy's avatar
Jim Blandy committed
462
{
463
  if (NUMBERP (object) || MARKERP (object))
Jim Blandy's avatar
Jim Blandy committed
464 465 466
    return Qt;
  return Qnil;
}
467 468 469

#ifdef LISP_FLOAT_TYPE
DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
Richard M. Stallman's avatar
Richard M. Stallman committed
470
       "Return t if OBJECT is a floating point number.")
471 472
  (object)
     Lisp_Object object;
473
{
474
  if (FLOATP (object))
475 476 477
    return Qt;
  return Qnil;
}
Jim Blandy's avatar
Jim Blandy committed
478 479 480 481 482
#endif /* LISP_FLOAT_TYPE */

/* Extract and set components of lists */

DEFUN ("car", Fcar, Scar, 1, 1, 0,
483
  "Return the car of LIST.  If arg is nil, return nil.\n\
Jim Blandy's avatar
Jim Blandy committed
484 485 486 487 488 489
Error if arg is not nil and not a cons cell.  See also `car-safe'.")
  (list)
     register Lisp_Object list;
{
  while (1)
    {
490
      if (CONSP (list))
Jim Blandy's avatar
Jim Blandy committed
491 492 493 494 495 496 497 498 499 500 501 502 503
	return XCONS (list)->car;
      else if (EQ (list, Qnil))
	return Qnil;
      else
	list = wrong_type_argument (Qlistp, list);
    }
}

DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
  "Return the car of OBJECT if it is a cons cell, or else nil.")
  (object)
     Lisp_Object object;
{
504
  if (CONSP (object))
Jim Blandy's avatar
Jim Blandy committed
505 506 507 508 509 510
    return XCONS (object)->car;
  else
    return Qnil;
}

DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
511
  "Return the cdr of LIST.  If arg is nil, return nil.\n\
Jim Blandy's avatar
Jim Blandy committed
512 513 514 515 516 517 518
Error if arg is not nil and not a cons cell.  See also `cdr-safe'.")

  (list)
     register Lisp_Object list;
{
  while (1)
    {
519
      if (CONSP (list))
Jim Blandy's avatar
Jim Blandy committed
520 521 522 523 524 525 526 527 528
	return XCONS (list)->cdr;
      else if (EQ (list, Qnil))
	return Qnil;
      else
	list = wrong_type_argument (Qlistp, list);
    }
}

DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
529
  "Return the cdr of OBJECT if it is a cons cell, or else nil.")
Jim Blandy's avatar
Jim Blandy committed
530 531 532
  (object)
     Lisp_Object object;
{
533
  if (CONSP (object))
Jim Blandy's avatar
Jim Blandy committed
534 535 536 537 538 539
    return XCONS (object)->cdr;
  else
    return Qnil;
}

DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
540
  "Set the car of CELL to be NEWCAR.  Returns NEWCAR.")
Jim Blandy's avatar
Jim Blandy committed
541 542 543
  (cell, newcar)
     register Lisp_Object cell, newcar;
{
544
  if (!CONSP (cell))
Jim Blandy's avatar
Jim Blandy committed
545 546 547 548 549 550 551 552
    cell = wrong_type_argument (Qconsp, cell);

  CHECK_IMPURE (cell);
  XCONS (cell)->car = newcar;
  return newcar;
}

DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
553
  "Set the cdr of CELL to be NEWCDR.  Returns NEWCDR.")
Jim Blandy's avatar
Jim Blandy committed
554 555 556
  (cell, newcdr)
     register Lisp_Object cell, newcdr;
{
557
  if (!CONSP (cell))
Jim Blandy's avatar
Jim Blandy committed
558 559 560 561 562 563 564 565 566
    cell = wrong_type_argument (Qconsp, cell);

  CHECK_IMPURE (cell);
  XCONS (cell)->cdr = newcdr;
  return newcdr;
}

/* Extract and set components of symbols */

Richard M. Stallman's avatar
Richard M. Stallman committed
567
DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, "Return t if SYMBOL's value is not void.")
568 569
  (symbol)
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
570 571
{
  Lisp_Object valcontents;
572
  CHECK_SYMBOL (symbol, 0);
Jim Blandy's avatar
Jim Blandy committed
573

574
  valcontents = XSYMBOL (symbol)->value;
Jim Blandy's avatar
Jim Blandy committed
575

Karl Heuer's avatar
Karl Heuer committed
576 577
  if (BUFFER_LOCAL_VALUEP (valcontents)
      || SOME_BUFFER_LOCAL_VALUEP (valcontents))
578
    valcontents = swap_in_symval_forwarding (symbol, valcontents);
Jim Blandy's avatar
Jim Blandy committed
579

580
  return (EQ (valcontents, Qunbound) ? Qnil : Qt);
Jim Blandy's avatar
Jim Blandy committed
581 582
}

Richard M. Stallman's avatar
Richard M. Stallman committed
583
DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, "Return t if SYMBOL's function definition is not void.")
584 585
  (symbol)
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
586
{
587 588
  CHECK_SYMBOL (symbol, 0);
  return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt);
Jim Blandy's avatar
Jim Blandy committed
589 590 591
}

DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, "Make SYMBOL's value be void.")
592 593
  (symbol)
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
594
{
595 596 597 598 599
  CHECK_SYMBOL (symbol, 0);
  if (NILP (symbol) || EQ (symbol, Qt))
    return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
  Fset (symbol, Qunbound);
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
600 601 602
}

DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, "Make SYMBOL's function definition be void.")
603 604
  (symbol)
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
605
{
606 607 608 609 610
  CHECK_SYMBOL (symbol, 0);
  if (NILP (symbol) || EQ (symbol, Qt))
    return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
  XSYMBOL (symbol)->function = Qunbound;
  return symbol;
Jim Blandy's avatar
Jim Blandy committed
611 612 613 614
}

DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
  "Return SYMBOL's function definition.  Error if that is void.")
Jim Blandy's avatar
Jim Blandy committed
615 616
  (symbol)
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
617
{
Jim Blandy's avatar
Jim Blandy committed
618 619 620 621
  CHECK_SYMBOL (symbol, 0);
  if (EQ (XSYMBOL (symbol)->function, Qunbound))
    return Fsignal (Qvoid_function, Fcons (symbol, Qnil));
  return XSYMBOL (symbol)->function;
Jim Blandy's avatar
Jim Blandy committed
622 623 624
}

DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, "Return SYMBOL's property list.")
625 626
  (symbol)
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
627
{
628 629
  CHECK_SYMBOL (symbol, 0);
  return XSYMBOL (symbol)->plist;
Jim Blandy's avatar
Jim Blandy committed
630 631 632
}

DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, "Return SYMBOL's name, a string.")
633 634
  (symbol)
     register Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
635 636 637
{
  register Lisp_Object name;

638 639
  CHECK_SYMBOL (symbol, 0);
  XSETSTRING (name, XSYMBOL (symbol)->name);
Jim Blandy's avatar
Jim Blandy committed
640 641 642 643
  return name;
}

DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
644 645 646
  "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.")
  (symbol, definition)
     register Lisp_Object symbol, definition;
647 648 649 650 651 652
{
  CHECK_SYMBOL (symbol, 0);
  if (NILP (symbol) || EQ (symbol, Qt))
    return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
  if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound))
    Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
Jim Blandy's avatar
Jim Blandy committed
653
			     Vautoload_queue);
654
  XSYMBOL (symbol)->function = definition;
655
  /* Handle automatic advice activation */
656
  if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
657
    {
658
      call2 (Qad_activate, symbol, Qnil);
659
      definition = XSYMBOL (symbol)->function;
660
    }
661
  return definition;
Jim Blandy's avatar
Jim Blandy committed
662 663
}

664
DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0,
665
  "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.\n\
666
Associates the function with the current load file, if any.")
667 668
  (symbol, definition)
     register Lisp_Object symbol, definition;
669
{
670 671 672
  CHECK_SYMBOL (symbol, 0);
  if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound))
    Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function),
673
			     Vautoload_queue);
674
  XSYMBOL (symbol)->function = definition;
675
  /* Handle automatic advice activation */
676
  if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
677
    {
678
      call2 (Qad_activate, symbol, Qnil);
679
      definition = XSYMBOL (symbol)->function;
680
    }
681
  LOADHIST_ATTACH (symbol);
682
  return definition;
683 684
}

Jim Blandy's avatar
Jim Blandy committed
685 686
DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
  "Set SYMBOL's property list to NEWVAL, and return NEWVAL.")
687 688
  (symbol, newplist)
     register Lisp_Object symbol, newplist;
Jim Blandy's avatar
Jim Blandy committed
689
{
690 691
  CHECK_SYMBOL (symbol, 0);
  XSYMBOL (symbol)->plist = newplist;
Jim Blandy's avatar
Jim Blandy committed
692 693
  return newplist;
}
Jim Blandy's avatar
Jim Blandy committed
694

Jim Blandy's avatar
Jim Blandy committed
695 696 697 698 699 700 701 702 703 704 705 706 707

/* Getting and setting values of symbols */

/* Given the raw contents of a symbol value cell,
   return the Lisp value of the symbol.
   This does not handle buffer-local variables; use
   swap_in_symval_forwarding for that.  */

Lisp_Object
do_symval_forwarding (valcontents)
     register Lisp_Object valcontents;
{
  register Lisp_Object val;
708 709
  int offset;
  if (MISCP (valcontents))
710
    switch (XMISCTYPE (valcontents))
711 712 713 714
      {
      case Lisp_Misc_Intfwd:
	XSETINT (val, *XINTFWD (valcontents)->intvar);
	return val;
Jim Blandy's avatar
Jim Blandy committed
715

716 717
      case Lisp_Misc_Boolfwd:
	return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
Jim Blandy's avatar
Jim Blandy committed
718

719 720
      case Lisp_Misc_Objfwd:
	return *XOBJFWD (valcontents)->objvar;
Jim Blandy's avatar
Jim Blandy committed
721

722 723 724
      case Lisp_Misc_Buffer_Objfwd:
	offset = XBUFFER_OBJFWD (valcontents)->offset;
	return *(Lisp_Object *)(offset + (char *)current_buffer);
725

726 727 728
      case Lisp_Misc_Kboard_Objfwd:
	offset = XKBOARD_OBJFWD (valcontents)->offset;
	return *(Lisp_Object *)(offset + (char *)current_kboard);
729
      }
Jim Blandy's avatar
Jim Blandy committed
730 731 732
  return valcontents;
}

733 734
/* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
   of SYMBOL.  If SYMBOL is buffer-local, VALCONTENTS should be the
Jim Blandy's avatar
Jim Blandy committed
735 736 737 738
   buffer-independent contents of the value cell: forwarded just one
   step past the buffer-localness.  */

void
739 740
store_symval_forwarding (symbol, valcontents, newval)
     Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
741 742
     register Lisp_Object valcontents, newval;
{
743
  switch (SWITCH_ENUM_CAST (XTYPE (valcontents)))
Jim Blandy's avatar
Jim Blandy committed
744
    {
745
    case Lisp_Misc:
746
      switch (XMISCTYPE (valcontents))
747 748 749 750
	{
	case Lisp_Misc_Intfwd:
	  CHECK_NUMBER (newval, 1);
	  *XINTFWD (valcontents)->intvar = XINT (newval);
751 752
	  if (*XINTFWD (valcontents)->intvar != XINT (newval))
	    error ("Value out of range for variable `%s'",
753
		   XSYMBOL (symbol)->name->data);
754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775
	  break;

	case Lisp_Misc_Boolfwd:
	  *XBOOLFWD (valcontents)->boolvar = NILP (newval) ? 0 : 1;
	  break;

	case Lisp_Misc_Objfwd:
	  *XOBJFWD (valcontents)->objvar = newval;
	  break;

	case Lisp_Misc_Buffer_Objfwd:
	  {
	    int offset = XBUFFER_OBJFWD (valcontents)->offset;
	    Lisp_Object type;

	    type = *(Lisp_Object *)(offset + (char *)&buffer_local_types);
	    if (! NILP (type) && ! NILP (newval)
		&& XTYPE (newval) != XINT (type))
	      buffer_slot_type_mismatch (offset);

	    *(Lisp_Object *)(offset + (char *)current_buffer) = newval;
	  }
776 777
	  break;

778 779 780
	case Lisp_Misc_Kboard_Objfwd:
	  (*(Lisp_Object *)((char *)current_kboard
			    + XKBOARD_OBJFWD (valcontents)->offset))
781 782 783
	    = newval;
	  break;

784 785 786
	default:
	  goto def;
	}
Jim Blandy's avatar
Jim Blandy committed
787 788 789
      break;

    default:
790
    def:
791
      valcontents = XSYMBOL (symbol)->value;
792 793
      if (BUFFER_LOCAL_VALUEP (valcontents)
	  || SOME_BUFFER_LOCAL_VALUEP (valcontents))
794
	XBUFFER_LOCAL_VALUE (valcontents)->car = newval;
Jim Blandy's avatar
Jim Blandy committed
795
      else
796
	XSYMBOL (symbol)->value = newval;
Jim Blandy's avatar
Jim Blandy committed
797 798 799
    }
}

800
/* Set up the buffer-local symbol SYMBOL for validity in the current
Jim Blandy's avatar
Jim Blandy committed
801 802 803 804
   buffer.  VALCONTENTS is the contents of its value cell.
   Return the value forwarded one step past the buffer-local indicator.  */

static Lisp_Object
805 806
swap_in_symval_forwarding (symbol, valcontents)
     Lisp_Object symbol, valcontents;
Jim Blandy's avatar
Jim Blandy committed
807
{
808
  /* valcontents is a pointer to a struct resembling the cons
Jim Blandy's avatar
Jim Blandy committed
809
     (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
810

Jim Blandy's avatar
Jim Blandy committed
811
     CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
812 813 814 815 816 817 818 819 820 821 822
     local_var_alist, that being the element whose car is this
     variable.  Or it can be a pointer to the
     (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have
     an element in its alist for this variable.

     If the current buffer is not BUFFER, we store the current
     REALVALUE value into CURRENT-ALIST-ELEMENT, then find the
     appropriate alist element for the buffer now current and set up
     CURRENT-ALIST-ELEMENT.  Then we set REALVALUE out of that
     element, and store into BUFFER.

Jim Blandy's avatar
Jim Blandy committed
823 824 825
     Note that REALVALUE can be a forwarding pointer. */

  register Lisp_Object tem1;
826
  tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car;
Jim Blandy's avatar
Jim Blandy committed
827

Jim Blandy's avatar
Jim Blandy committed
828
  if (NILP (tem1) || current_buffer != XBUFFER (tem1))
Jim Blandy's avatar
Jim Blandy committed
829
    {
830 831 832
      tem1 = XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car;
      Fsetcdr (tem1,
	       do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car));
833
      tem1 = assq_no_quit (symbol, current_buffer->local_var_alist);
Jim Blandy's avatar
Jim Blandy committed
834
      if (NILP (tem1))
835 836 837 838
	tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr;
      XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car = tem1;
      XSETBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car,
		  current_buffer);
839
      store_symval_forwarding (symbol, XBUFFER_LOCAL_VALUE (valcontents)->car,
840
			       Fcdr (tem1));
Jim Blandy's avatar
Jim Blandy committed
841
    }
842
  return XBUFFER_LOCAL_VALUE (valcontents)->car;
Jim Blandy's avatar
Jim Blandy committed
843 844
}

Jim Blandy's avatar
Jim Blandy committed
845 846
/* Find the value of a symbol, returning Qunbound if it's not bound.
   This is helpful for code which just wants to get a variable's value
Karl Heuer's avatar
Karl Heuer committed
847
   if it has one, without signaling an error.
Jim Blandy's avatar
Jim Blandy committed
848 849
   Note that it must not be possible to quit
   within this function.  Great care is required for this.  */
Jim Blandy's avatar
Jim Blandy committed
850

Jim Blandy's avatar
Jim Blandy committed
851
Lisp_Object
852 853
find_symbol_value (symbol)
     Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
854 855 856
{
  register Lisp_Object valcontents, tem1;
  register Lisp_Object val;
857 858
  CHECK_SYMBOL (symbol, 0);
  valcontents = XSYMBOL (symbol)->value;
Jim Blandy's avatar
Jim Blandy committed
859

Karl Heuer's avatar
Karl Heuer committed
860 861
  if (BUFFER_LOCAL_VALUEP (valcontents)
      || SOME_BUFFER_LOCAL_VALUEP (valcontents))
862
    valcontents = swap_in_symval_forwarding (symbol, valcontents);
Jim Blandy's avatar
Jim Blandy committed
863

864 865
  if (MISCP (valcontents))
    {
866
      switch (XMISCTYPE (valcontents))
867 868 869 870
	{
	case Lisp_Misc_Intfwd:
	  XSETINT (val, *XINTFWD (valcontents)->intvar);
	  return val;
Jim Blandy's avatar
Jim Blandy committed
871

872 873
	case Lisp_Misc_Boolfwd:
	  return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
Jim Blandy's avatar
Jim Blandy committed
874

875 876
	case Lisp_Misc_Objfwd:
	  return *XOBJFWD (valcontents)->objvar;
Jim Blandy's avatar
Jim Blandy committed
877

878 879 880
	case Lisp_Misc_Buffer_Objfwd:
	  return *(Lisp_Object *)(XBUFFER_OBJFWD (valcontents)->offset
				  + (char *)current_buffer);
881

882 883 884
	case Lisp_Misc_Kboard_Objfwd:
	  return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
				  + (char *)current_kboard);
885
	}
Jim Blandy's avatar
Jim Blandy committed
886 887 888 889 890
    }

  return valcontents;
}

Jim Blandy's avatar
Jim Blandy committed
891 892
DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
  "Return SYMBOL's value.  Error if that is void.")
893 894
  (symbol)
     Lisp_Object symbol;
Jim Blandy's avatar
Jim Blandy committed
895
{
896
  Lisp_Object val;
Jim Blandy's avatar
Jim Blandy committed
897

898
  val = find_symbol_value (symbol);
Jim Blandy's avatar
Jim Blandy committed
899
  if (EQ (val, Qunbound))
900
    return Fsignal (Qvoid_variable, Fcons (symbol, Qnil));
Jim Blandy's avatar
Jim Blandy committed
901 902 903 904
  else
    return val;
}

Jim Blandy's avatar
Jim Blandy committed
905 906
DEFUN ("set", Fset, Sset, 2, 2, 0,
  "Set SYMBOL's value to NEWVAL, and return NEWVAL.")
907 908
  (symbol, newval)
     register Lisp_Object symbol, newval;
909 910 911 912 913 914 915 916 917 918 919 920 921
{
  return set_internal (symbol, newval, 0);
}

/* Stpre the value NEWVAL into SYMBOL.
   If BINDFLAG is zero, then if this symbol is supposed to become
   local in every buffer where it is set, then we make it local.
   If BINDFLAG is nonzero, we don't do that.  */

Lisp_Object
set_internal (symbol, newval, bindflag)
     register Lisp_Object symbol, newval;
     int bindflag;
Jim Blandy's avatar
Jim Blandy committed
922
{
923
  int voide = EQ (newval, Qunbound);
Jim Blandy's avatar
Jim Blandy committed
924 925 926

  register Lisp_Object valcontents, tem1, current_alist_element;

927 928 929 930
  CHECK_SYMBOL (symbol, 0);
  if (NILP (symbol) || EQ (symbol, Qt))
    return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
  valcontents = XSYMBOL (symbol)->value;
Jim Blandy's avatar
Jim Blandy committed
931

932
  if (BUFFER_OBJFWDP (valcontents))
Jim Blandy's avatar
Jim Blandy committed
933
    {
934
      register int idx = XBUFFER_OBJFWD (valcontents)->offset;
935 936
      register int mask = XINT (*((Lisp_Object *)
				  (idx + (char *)&buffer_local_flags)));
Jim Blandy's avatar
Jim Blandy committed
937 938 939 940
      if (mask > 0)
	current_buffer->local_var_flags |= mask;
    }

941 942
  else if (BUFFER_LOCAL_VALUEP (valcontents)
	   || SOME_BUFFER_LOCAL_VALUEP (valcontents))
Jim Blandy's avatar
Jim Blandy committed
943
    {
944 945
      /* valcontents is actually a pointer to a struct resembling a cons,
	 with contents something like:
Jim Blandy's avatar
Jim Blandy committed
946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973
	 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE).

	 BUFFER is the last buffer for which this symbol's value was
	 made up to date.

	 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
	 local_var_alist, that being the element whose car is this
	 variable.  Or it can be a pointer to the
	 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not
	 have an element in its alist for this variable (that is, if
	 BUFFER sees the default value of this variable).

	 If we want to examine or set the value and BUFFER is current,
	 we just examine or set REALVALUE. If BUFFER is not current, we
	 store the current REALVALUE value into CURRENT-ALIST-ELEMENT,
	 then find the appropriate alist element for the buffer now
	 current and set up CURRENT-ALIST-ELEMENT.  Then we set
	 REALVALUE out of that element, and store into BUFFER.

	 If we are setting the variable and the current buffer does
	 not have an alist entry for this variable, an alist entry is
	 created.

	 Note that REALVALUE can be a forwarding pointer.  Each time
	 it is examined or set, forwarding must be done.  */

      /* What value are we caching right now?  */
      current_alist_element =
974
	XCONS (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr)->car;
Jim Blandy's avatar
Jim Blandy committed
975 976 977 978 979 980

      /* If the current buffer is not the buffer whose binding is
	 currently cached, or if it's a Lisp_Buffer_Local_Value and
	 we're looking at the default value, the cache is invalid; we
	 need to write it out, and find the new CURRENT-ALIST-ELEMENT.  */
      if ((current_buffer
981
	   != XBUFFER (XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->car))
982
	  || (BUFFER_LOCAL_VALUEP (valcontents)
983 984
	      && EQ (XCONS (current_alist_element)->car,
		     current_alist_element)))
Jim Blandy's avatar
Jim Blandy committed
985
	{
Jim Blandy's avatar
Jim Blandy committed
986 987 988 989
	  /* Write out the cached value for the old buffer; copy it
	     back to its alist element.  This works if the current
	     buffer only sees the default value, too.  */
          Fsetcdr (current_alist_element,
990
		   do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->car));
Jim Blandy's avatar
Jim Blandy committed
991

Jim Blandy's avatar
Jim Blandy committed
992
	  /* Find the new value for CURRENT-ALIST-ELEMENT.  */
993
	  tem1 = Fassq (symbol, current_buffer->local_var_alist);
Jim Blandy's avatar
Jim Blandy committed
994
	  if (NILP (tem1))
Jim Blandy's avatar
Jim Blandy committed
995 996 997 998
	    {
	      /* This buffer still sees the default value.  */

	      /* If the variable is a Lisp_Some_Buffer_Local_Value,
999
		 or if this is `let' rather than `set',
Jim Blandy's avatar
Jim Blandy committed
1000 1001
		 make CURRENT-ALIST-ELEMENT point to itself,
		 indicating that we're seeing the default value.  */
1002
	      if (bindflag || SOME_BUFFER_LOCAL_VALUEP (valcontents))
1003
		tem1 = XCONS (XBUFFER_LOCAL_VALUE (valcontents)->cdr)->cdr;
Jim Blandy's avatar
Jim Blandy committed
1004

1005 1006
	      /* If it's a Lisp_Buffer_Local_Value, being set not bound,
		 give this buffer a new assoc for a local value and set
Jim Blandy's avatar
Jim Blandy committed
1007 1008 1009
		 CURRENT-ALIST-ELEMENT to point to that.  */
	      else
		{
1010
		  tem1 = Fcons (symbol, Fcdr (current_alist_element));
Jim Blandy's avatar
Jim Blandy committed
1011 1012 1013 1014 1015
		  current_buffer->local_var_alist =
		    Fcons (tem1, current_buffer->local_var_alist);
		}
	    }
	  /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT.  */