4.3BSD - /usr/src/new/emacs/src/data.c

   1: /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
   2:    Copyright (C) 1985 Richard M. Stallman.
   3: 
   4: This file is part of GNU Emacs.
   5: 
   6: GNU Emacs is distributed in the hope that it will be useful,
   7: but WITHOUT ANY WARRANTY.  No author or distributor
   8: accepts responsibility to anyone for the consequences of using it
   9: or for whether it serves any particular purpose or works at all,
  10: unless he says so in writing.  Refer to the GNU Emacs General Public
  11: License for full details.
  12: 
  13: Everyone is granted permission to copy, modify and redistribute
  14: GNU Emacs, but only under the conditions described in the
  15: GNU Emacs General Public License.   A copy of this license is
  16: supposed to have been given to you along with GNU Emacs so you
  17: can know your rights and responsibilities.  It should be in a
  18: file named COPYING.  Among other things, the copyright notice
  19: and this notice must be preserved on all copies.  */
  20: 
  21: 
  22: #include <signal.h>
  23: 
  24: #include "config.h"
  25: #include "lisp.h"
  26: 
  27: #ifndef standalone
  28: #include "buffer.h"
  29: #endif
  30: 
  31: Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
  32: Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
  33: Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
  34: Lisp_Object Qvoid_variable, Qvoid_function;
  35: Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
  36: Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
  37: Lisp_Object Qend_of_file, Qarith_error;
  38: Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
  39: Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qlistp, Qconsp;
  40: Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
  41: Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
  42: Lisp_Object Qboundp, Qfboundp;
  43: Lisp_Object Qcdr;
  44: 
  45: Lisp_Object
  46: wrong_type_argument (predicate, value)
  47:      register Lisp_Object predicate, value;
  48: {
  49:   register Lisp_Object tem;
  50:   do
  51:     {
  52:       if (!EQ (Vmocklisp_arguments, Qt))
  53:     {
  54:      if (XTYPE (value) == Lisp_String &&
  55:          (EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p)))
  56:        return Fstring_to_int (value, Qt);
  57:      if (XTYPE (value) == Lisp_Int && EQ (predicate, Qstringp))
  58:        return Fint_to_string (value);
  59:     }
  60:       value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil)));
  61:       tem = call1 (predicate, value);
  62:     }
  63:   while (NULL (tem));
  64:   return value;
  65: }
  66: 
  67: pure_write_error ()
  68: {
  69:   error ("Attempt to modify read-only object");
  70: }
  71: 
  72: args_out_of_range (a1, a2)
  73:      Lisp_Object a1, a2;
  74: {
  75:   while (1)
  76:     Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Qnil)));
  77: }
  78: 
  79: args_out_of_range_3 (a1, a2, a3)
  80:      Lisp_Object a1, a2, a3;
  81: {
  82:   while (1)
  83:     Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Fcons (a3, Qnil))));
  84: }
  85: 
  86: Lisp_Object
  87: make_number (num)
  88:      int num;
  89: {
  90:   register Lisp_Object val;
  91:   XSET (val, Lisp_Int, num);
  92:   return val;
  93: }
  94: 
  95: /* Data type predicates */
  96: 
  97: DEFUN ("eq", Feq, Seq, 2, 2, 0,
  98:   "T if the two args are the same Lisp object.")
  99:   (obj1, obj2)
 100:      Lisp_Object obj1, obj2;
 101: {
 102:   if (EQ (obj1, obj2))
 103:     return Qt;
 104:   return Qnil;
 105: }
 106: 
 107: DEFUN ("null", Fnull, Snull, 1, 1, 0, "T if OBJECT is nil.")
 108:   (obj)
 109:      Lisp_Object obj;
 110: {
 111:   if (NULL (obj))
 112:     return Qt;
 113:   return Qnil;
 114: }
 115: 
 116: DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, "T if OBJECT is a cons cell.")
 117:   (obj)
 118:      Lisp_Object obj;
 119: {
 120:   if (XTYPE (obj) == Lisp_Cons)
 121:     return Qt;
 122:   return Qnil;
 123: }
 124: 
 125: DEFUN ("atom", Fatom, Satom, 1, 1, 0, "T if OBJECT is not a cons cell.  This includes nil.")
 126:   (obj)
 127:      Lisp_Object obj;
 128: {
 129:   if (XTYPE (obj) == Lisp_Cons)
 130:     return Qnil;
 131:   return Qt;
 132: }
 133: 
 134: DEFUN ("listp", Flistp, Slistp, 1, 1, 0, "T if OBJECT is a list.  This includes nil.")
 135:   (obj)
 136:      Lisp_Object obj;
 137: {
 138:   if (XTYPE (obj) == Lisp_Cons || NULL (obj))
 139:     return Qt;
 140:   return Qnil;
 141: }
 142: 
 143: DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, "T if OBJECT is not a list.  Lists include nil.")
 144:   (obj)
 145:      Lisp_Object obj;
 146: {
 147:   if (XTYPE (obj) == Lisp_Cons || NULL (obj))
 148:     return Qnil;
 149:   return Qt;
 150: }
 151: 
 152: DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, "T if OBJECT is a number.")
 153:   (obj)
 154:      Lisp_Object obj;
 155: {
 156:   if (XTYPE (obj) == Lisp_Int)
 157:     return Qt;
 158:   return Qnil;
 159: }
 160: 
 161: DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, "T if OBJECT is a nonnegative number.")
 162:   (obj)
 163:      Lisp_Object obj;
 164: {
 165:   if (XTYPE (obj) == Lisp_Int && XINT (obj) >= 0)
 166:     return Qt;
 167:   return Qnil;
 168: }
 169: 
 170: DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, "T if OBJECT is a symbol.")
 171:   (obj)
 172:      Lisp_Object obj;
 173: {
 174:   if (XTYPE (obj) == Lisp_Symbol)
 175:     return Qt;
 176:   return Qnil;
 177: }
 178: 
 179: DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, "T if OBJECT is a vector.")
 180:   (obj)
 181:      Lisp_Object obj;
 182: {
 183:   if (XTYPE (obj) == Lisp_Vector)
 184:     return Qt;
 185:   return Qnil;
 186: }
 187: 
 188: DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, "T if OBJECT is a string.")
 189:   (obj)
 190:      Lisp_Object obj;
 191: {
 192:   if (XTYPE (obj) == Lisp_String)
 193:     return Qt;
 194:   return Qnil;
 195: }
 196: 
 197: DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "T if OBJECT is an array (string or vector).")
 198:   (obj)
 199:      Lisp_Object obj;
 200: {
 201:   if (XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String)
 202:     return Qt;
 203:   return Qnil;
 204: }
 205: 
 206: DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
 207:   "T if OBJECT is a sequence (list or array).")
 208:   (obj)
 209:      Lisp_Object obj;
 210: {
 211:   if (LISTP (obj) || XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String)
 212:     return Qt;
 213:   return Qnil;
 214: }
 215: 
 216: DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, "T if OBJECT is an editor buffer.")
 217:   (obj)
 218:      Lisp_Object obj;
 219: {
 220:   if (XTYPE (obj) == Lisp_Buffer)
 221:     return Qt;
 222:   return Qnil;
 223: }
 224: 
 225: DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, "T if OBJECT is a marker (editor pointer).")
 226:   (obj)
 227:      Lisp_Object obj;
 228: {
 229:   if (XTYPE (obj) == Lisp_Marker)
 230:     return Qt;
 231:   return Qnil;
 232: }
 233: 
 234: DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0,
 235:   "T if OBJECT is an integer or a marker (editor pointer).")
 236:   (obj)
 237:      Lisp_Object obj;
 238: {
 239:   if (XTYPE (obj) == Lisp_Marker || XTYPE (obj) == Lisp_Int)
 240:     return Qt;
 241:   return Qnil;
 242: }
 243: 
 244: DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "T if OBJECT is a built-in function.")
 245:   (obj)
 246:      Lisp_Object obj;
 247: {
 248:   if (XTYPE (obj) == Lisp_Subr)
 249:     return Qt;
 250:   return Qnil;
 251: }
 252: 
 253: DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, "T if OBJECT is a character (a number) or a string.")
 254:   (obj)
 255:      Lisp_Object obj;
 256: {
 257:   if (XTYPE (obj) == Lisp_Int || XTYPE (obj) == Lisp_String)
 258:     return Qt;
 259:   return Qnil;
 260: }
 261: 
 262: /* Extract and set components of lists */
 263: 
 264: DEFUN ("car", Fcar, Scar, 1, 1, 0,
 265:   "Return the car of CONSCELL.  If arg is nil, return nil.")
 266:   (list)
 267:      Lisp_Object list;
 268: {
 269:   while (1)
 270:     {
 271:       if (XTYPE (list) == Lisp_Cons)
 272:     return XCONS (list)->car;
 273:       else if (EQ (list, Qnil))
 274:     return Qnil;
 275:       else
 276:     list = wrong_type_argument (Qlistp, list);
 277:     }
 278: }
 279: 
 280: DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
 281:   "Return the car of OBJECT if it is a cons cell, or else  nil.")
 282:   (object)
 283:      Lisp_Object object;
 284: {
 285:   if (XTYPE (object) == Lisp_Cons)
 286:     return XCONS (object)->car;
 287:   else
 288:     return Qnil;
 289: }
 290: 
 291: DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
 292:   "Return the cdr of CONSCELL.  If arg is nil, return nil.")
 293:   (list)
 294:      Lisp_Object list;
 295: {
 296:   while (1)
 297:     {
 298:       if (XTYPE (list) == Lisp_Cons)
 299:     return XCONS (list)->cdr;
 300:       else if (EQ (list, Qnil))
 301:     return Qnil;
 302:       else
 303:     list = wrong_type_argument (Qlistp, list);
 304:     }
 305: }
 306: 
 307: DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
 308:   "Return the cdr of OBJECT if it is a cons cell, or else  nil.")
 309:   (object)
 310:      Lisp_Object object;
 311: {
 312:   if (XTYPE (object) == Lisp_Cons)
 313:     return XCONS (object)->cdr;
 314:   else
 315:     return Qnil;
 316: }
 317: 
 318: DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
 319:   "Set the car of CONSCELL to be NEWCAR.  Returns NEWCAR.")
 320:   (cell, newcar)
 321:      Lisp_Object cell, newcar;
 322: {
 323:   if (XTYPE (cell) != Lisp_Cons)
 324:     cell = wrong_type_argument (Qconsp, cell);
 325: 
 326:   CHECK_IMPURE (cell);
 327:   XCONS (cell)->car = newcar;
 328:   return newcar;
 329: }
 330: 
 331: DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
 332:   "Set the cdr of CONSCELL to be NEWCDR.  Returns NEWCDR.")
 333:   (cell, newcdr)
 334:      Lisp_Object cell, newcdr;
 335: {
 336:   if (XTYPE (cell) != Lisp_Cons)
 337:     cell = wrong_type_argument (Qconsp, cell);
 338: 
 339:   CHECK_IMPURE (cell);
 340:   XCONS (cell)->cdr = newcdr;
 341:   return newcdr;
 342: }
 343: 
 344: /* Extract and set components of symbols */
 345: 
 346: DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, "T if SYMBOL's value is not void.")
 347:   (sym)
 348:      Lisp_Object sym;
 349: {
 350:   CHECK_SYMBOL (sym, 0);
 351:   return (XTYPE (XSYMBOL (sym)->value) == Lisp_Void
 352:       || EQ (XSYMBOL (sym)->value, Qunbound))
 353:      ? Qnil : Qt;
 354: }
 355: 
 356: DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, "T if SYMBOL's function definition is not void.")
 357:   (sym)
 358:      Lisp_Object sym;
 359: {
 360:   CHECK_SYMBOL (sym, 0);
 361:   return (XTYPE (XSYMBOL (sym)->function) == Lisp_Void
 362:       || EQ (XSYMBOL (sym)->function, Qunbound))
 363:      ? Qnil : Qt;
 364: }
 365: 
 366: DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, "Make SYMBOL's value be void.")
 367:   (sym)
 368:      Lisp_Object sym;
 369: {
 370:   CHECK_SYMBOL (sym, 0);
 371:   XSYMBOL (sym)->value = Qunbound;
 372:   return sym;
 373: }
 374: 
 375: DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, "Make SYMBOL's function definition be void.")
 376:   (sym)
 377:      Lisp_Object sym;
 378: {
 379:   CHECK_SYMBOL (sym, 0);
 380:   XSYMBOL (sym)->function = Qunbound;
 381:   return sym;
 382: }
 383: 
 384: DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
 385:   "Return SYMBOL's function definition.")
 386:   (sym)
 387:      Lisp_Object sym;
 388: {
 389:   CHECK_SYMBOL (sym, 0);
 390:   if (EQ (XSYMBOL (sym)->function, Qunbound))
 391:     return Fsignal (Qvoid_function, Fcons (sym, Qnil));
 392:   return XSYMBOL (sym)->function;
 393: }
 394: 
 395: DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, "Return SYMBOL's property list.")
 396:   (sym)
 397:      Lisp_Object sym;
 398: {
 399:   CHECK_SYMBOL (sym, 0);
 400:   return XSYMBOL (sym)->plist;
 401: }
 402: 
 403: DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, "Return SYMBOL's name, a string.")
 404:   (sym)
 405:      Lisp_Object sym;
 406: {
 407:   Lisp_Object name;
 408: 
 409:   CHECK_SYMBOL (sym, 0);
 410:   XSET (name, Lisp_String, XSYMBOL (sym)->name);
 411:   return name;
 412: }
 413: 
 414: DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
 415:   "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.")
 416:   (sym, newdef)
 417:      Lisp_Object sym, newdef;
 418: {
 419:   CHECK_SYMBOL (sym, 0);
 420:   if (!NULL (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound))
 421:     Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
 422:                  Vautoload_queue);
 423:   XSYMBOL (sym)->function = newdef;
 424:   return newdef;
 425: }
 426: 
 427: DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
 428:   "Set SYMBOL's property list to NEWVAL, and return NEWVAL.")
 429:   (sym, newplist)
 430:      Lisp_Object sym, newplist;
 431: {
 432:   CHECK_SYMBOL (sym, 0);
 433:   XSYMBOL (sym)->plist = newplist;
 434:   return newplist;
 435: }
 436: 
 437: /* Getting and setting values of symbols */
 438: 
 439: /* Given the raw contents of a symbol value cell,
 440:  return the Lisp value of the symbol. */
 441: 
 442: Lisp_Object
 443: do_symval_forwarding (valcontents)
 444:      register Lisp_Object valcontents;
 445: {
 446:   Lisp_Object val;
 447: #ifdef SWITCH_ENUM_BUG
 448:   switch ((int) XTYPE (valcontents))
 449: #else
 450:   switch (XTYPE (valcontents))
 451: #endif
 452:     {
 453:     case Lisp_Intfwd:
 454:       XSET (val, Lisp_Int, *XINTPTR (valcontents));
 455:       return val;
 456: 
 457:     case Lisp_Boolfwd:
 458:       if (*XINTPTR (valcontents))
 459:     return Qt;
 460:       return Qnil;
 461: 
 462:     case Lisp_Objfwd:
 463:       return *XOBJFWD (valcontents);
 464: 
 465:     case Lisp_Buffer_Objfwd:
 466:       return *(Lisp_Object *)((int)XOBJFWD (valcontents) + (char *)bf_cur);
 467:     }
 468:   return valcontents;
 469: }
 470: 
 471: store_symval_forwarding (sym, valcontents, newval)
 472:      Lisp_Object sym;
 473:      register Lisp_Object valcontents, newval;
 474: {
 475: #ifdef SWITCH_ENUM_BUG
 476:   switch ((int) XTYPE (valcontents))
 477: #else
 478:   switch (XTYPE (valcontents))
 479: #endif
 480:     {
 481:     case Lisp_Intfwd:
 482:       CHECK_NUMBER (newval, 1);
 483:       *XINTPTR (valcontents) = XINT (newval);
 484:       break;
 485: 
 486:     case Lisp_Boolfwd:
 487:       *XINTPTR (valcontents) = NULL(newval) ? 0 : 1;
 488:       break;
 489: 
 490:     case Lisp_Objfwd:
 491:       *XOBJFWD (valcontents) = newval;
 492:       break;
 493: 
 494:     case Lisp_Buffer_Objfwd:
 495:       *(Lisp_Object *)((int)XOBJFWD (valcontents) + (char *)bf_cur) = newval;
 496:       break;
 497: 
 498:     default:
 499:       valcontents = XSYMBOL (sym)->value;
 500:       if (XTYPE (valcontents) == Lisp_Buffer_Local_Value ||
 501:       XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 502:     XCONS (XSYMBOL (sym)->value)->car = newval;
 503:       else
 504:     XSYMBOL (sym)->value = newval;
 505:     }
 506: }
 507: 
 508: DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0, "Return SYMBOL's value.")
 509:   (sym)
 510:      Lisp_Object sym;
 511: {
 512:   register Lisp_Object valcontents, tem1;
 513:   register Lisp_Object val;
 514:   CHECK_SYMBOL (sym, 0);
 515:   valcontents = XSYMBOL (sym)->value;
 516: 
 517:  retry:
 518: #ifdef SWITCH_ENUM_BUG
 519:   switch ((int) XTYPE (valcontents))
 520: #else
 521:   switch (XTYPE (valcontents))
 522: #endif
 523:     {
 524:     case Lisp_Buffer_Local_Value:
 525:     case Lisp_Some_Buffer_Local_Value:
 526:       /* valcontents is a list
 527:         (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
 528: 
 529:         CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
 530: 	local_var_alist, that being the element whose car is this variable.
 531:         Or it can be a pointer to the (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER
 532: 	does not have an element in its alist for this variable.
 533: 
 534: 	If the current buffer is not BUFFER, we store the current REALVALUE value into
 535: 	CURRENT-ALIST-ELEMENT, then find the appropriate alist element for
 536: 	the buffer now current and set up CURRENT-ALIST-ELEMENT.
 537: 	Then we set REALVALUE out of that element, and store into BUFFER.
 538:  	Note that REALVALUE can be a forwarding pointer. */
 539: 
 540:       if (bf_cur != XBUFFER (XCONS (XCONS (valcontents)->cdr)->car))
 541:     {
 542:       tem1 = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car;
 543:           Fsetcdr (tem1, do_symval_forwarding (XCONS (valcontents)->car));
 544:       tem1 = Fassq (sym, bf_cur->local_var_alist);
 545:       if (NULL (tem1))
 546:         tem1 = XCONS (XCONS (valcontents)->cdr)->cdr;
 547:       XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car = tem1;
 548:       XSET (XCONS (XCONS (valcontents)->cdr)->car, Lisp_Buffer, bf_cur);
 549:       store_symval_forwarding (sym, XCONS (valcontents)->car, Fcdr (tem1));
 550:     }
 551:       valcontents = XCONS (valcontents)->car;
 552:       goto retry;
 553: 
 554:     case Lisp_Intfwd:
 555:       XSET (val, Lisp_Int, *XINTPTR (valcontents));
 556:       return val;
 557: 
 558:     case Lisp_Boolfwd:
 559:       if (*XINTPTR (valcontents))
 560:     return Qt;
 561:       return Qnil;
 562: 
 563:     case Lisp_Objfwd:
 564:       return *XOBJFWD (valcontents);
 565: 
 566:     case Lisp_Buffer_Objfwd:
 567:       return *(Lisp_Object *)((int)XOBJFWD (valcontents) + (char *)bf_cur);
 568: 
 569:     case Lisp_Symbol:
 570:       /* For a symbol, check whether it is 'unbound. */
 571:       if (!EQ (valcontents, Qunbound))
 572:     break;
 573:       /* drops through! */
 574:     case Lisp_Void:
 575:       return Fsignal (Qvoid_variable, Fcons (sym, Qnil));
 576:     }
 577:   return valcontents;
 578: }
 579: 
 580: DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0,
 581:   "Return SYMBOL's default value.\n\
 582: This is the value that is seen in buffers that do not have their own values\n\
 583: for this variable.")
 584:   (sym)
 585:      Lisp_Object sym;
 586: {
 587:   register Lisp_Object valcontents;
 588: 
 589:   CHECK_SYMBOL (sym, 0);
 590:   valcontents = XSYMBOL (sym)->value;
 591:   if (XTYPE (valcontents) == Lisp_Buffer_Local_Value ||
 592:       XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 593:     return XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->cdr;
 594:   return Fsymbol_value (sym);
 595: }
 596: 
 597: DEFUN ("set", Fset, Sset, 2, 2, 0,
 598:   "Set SYMBOL's value to NEWVAL, and return NEWVAL.")
 599:   (sym, newval)
 600:      Lisp_Object sym, newval;
 601: {
 602:   register Lisp_Object valcontents, tem1, current_alist_element;
 603: 
 604:   CHECK_SYMBOL (sym, 0);
 605:   if (NULL (sym) || EQ (sym, Qt))
 606:     return Fsignal (Qsetting_constant, Fcons (sym, Qnil));
 607:   valcontents = XSYMBOL (sym)->value;
 608:   if (XTYPE (valcontents) == Lisp_Buffer_Local_Value ||
 609:       XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 610:     {
 611:       /* valcontents is a list
 612:         (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
 613: 
 614:         CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
 615: 	local_var_alist, that being the element whose car is this variable.
 616:         Or it can be a pointer to the (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER
 617: 	does not have an element in its alist for this variable.
 618: 
 619: 	If the current buffer is not BUFFER, we store the current REALVALUE value into
 620: 	CURRENT-ALIST-ELEMENT, then find the appropriate alist element for
 621: 	the buffer now current and set up CURRENT-ALIST-ELEMENT.
 622: 	Then we set REALVALUE out of that element, and store into BUFFER.
 623: 	Note that REALVALUE can be a forwarding pointer. */
 624: 
 625:       current_alist_element = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car;
 626:       if (bf_cur != ((XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 627:              ? XBUFFER (XCONS (XCONS (valcontents)->cdr)->car)
 628:              : XBUFFER (XCONS (current_alist_element)->car)))
 629:     {
 630:           Fsetcdr (current_alist_element, do_symval_forwarding (XCONS (valcontents)->car));
 631: 
 632:       tem1 = Fassq (sym, bf_cur->local_var_alist);
 633:       if (NULL (tem1))
 634:         /* This buffer sees the default value still.
 635: 	       If type is Lisp_Some_Buffer_Local_Value, set the default value.
 636: 	       If type is Lisp_Buffer_Local_Value, give this buffer a local value
 637: 		and set that.  */
 638:         if (XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 639:           tem1 = XCONS (XCONS (valcontents)->cdr)->cdr;
 640:         else
 641:           {
 642:         tem1 = Fcons (sym, Fcdr (current_alist_element));
 643:         bf_cur->local_var_alist = Fcons (tem1, bf_cur->local_var_alist);
 644:           }
 645:       XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car = tem1;
 646:       XSET (XCONS (XCONS (valcontents)->cdr)->car, Lisp_Buffer, bf_cur);
 647:     }
 648:       valcontents = XCONS (valcontents)->car;
 649:     }
 650:   store_symval_forwarding (sym, valcontents, newval);
 651:   return newval;
 652: }
 653: 
 654: DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
 655:   "Set SYMBOL's default value.\n\
 656: This is the value that is seen in buffers that do not have their own values\n\
 657: for this variable.")
 658:   (sym, value)
 659:      Lisp_Object sym, value;
 660: {
 661:   register Lisp_Object valcontents, current_alist_element, alist_element_buffer;
 662: 
 663:   CHECK_SYMBOL (sym, 0);
 664:   valcontents = XSYMBOL (sym)->value;
 665:   if (XTYPE (valcontents) != Lisp_Buffer_Local_Value &&
 666:       XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
 667:     return Fset (sym, value);
 668: 
 669:   /* Store new value into the DEFAULT-VALUE slot */
 670:   XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->cdr = value;
 671: 
 672:   /* If that slot is current, we must set the REALVALUE slot too */
 673:   current_alist_element = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car;
 674:   alist_element_buffer = Fcar (current_alist_element);
 675:   if (EQ (alist_element_buffer, current_alist_element))
 676:     store_symval_forwarding (sym, XCONS (valcontents)->car, value);
 677: 
 678:   return value;
 679: }
 680: 
 681: DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local,
 682:   1, 1, "vMake Variable Buffer Local: ",
 683:   "Make VARIABLE have a separate value for each buffer.\n\
 684: The value you see with symbol-value at any time is the value for the current buffer.\n\
 685: There is also a default value which is seen in any buffer which has not yet\n\
 686: set its own value.\n\
 687: The function default-value gets the default value and set-default sets it.\n\
 688: Using set or setq to set the variable causes it to have a separate value\n\
 689: for the current buffer if it was previously using the default value.")
 690:   (sym)
 691:      Lisp_Object sym;
 692: {
 693:   register Lisp_Object tem, valcontents;
 694: 
 695:   CHECK_SYMBOL (sym, 0);
 696: 
 697:   valcontents = XSYMBOL (sym)->value;
 698:   if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value) ||
 699:       (XTYPE (valcontents) == Lisp_Buffer_Objfwd))
 700:     return sym;
 701:   if (XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 702:     {
 703:       XSETTYPE (valcontents, Lisp_Buffer_Local_Value);
 704:       return sym;
 705:     }
 706:   if (EQ (valcontents, Qunbound))
 707:     XSYMBOL (sym)->value = Qnil;
 708:   tem = Fcons (Qnil, Fsymbol_value (sym));
 709:   XCONS (tem)->car = tem;
 710:   XSYMBOL (sym)->value = Fcons (XSYMBOL (sym)->value, Fcons (Fcurrent_buffer (), tem));
 711:   XSETTYPE (XSYMBOL (sym)->value, Lisp_Buffer_Local_Value);
 712:   return sym;
 713: }
 714: 
 715: DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
 716:   1, 1, "vMake Local Variable: ",
 717:   "Make VARIABLE have a separate value in the current buffer.")
 718:   (sym)
 719:      Lisp_Object sym;
 720: {
 721:   register Lisp_Object tem, valcontents;
 722: 
 723:   CHECK_SYMBOL (sym, 0);
 724: 
 725:   valcontents = XSYMBOL (sym)->value;
 726:   if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value) ||
 727:       (XTYPE (valcontents) == Lisp_Buffer_Objfwd))
 728:     return sym;
 729:   /* Make sure sym is set up to hold per-buffer values */
 730:   if (XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
 731:     {
 732:       if (EQ (valcontents, Qunbound))
 733:     XSYMBOL (sym)->value = Qnil;
 734:       tem = Fcons (Qnil, Fsymbol_value (sym));
 735:       XCONS (tem)->car = tem;
 736:       XSYMBOL (sym)->value = Fcons (XSYMBOL (sym)->value, Fcons (Qnil, tem));
 737:       XSETTYPE (XSYMBOL (sym)->value, Lisp_Some_Buffer_Local_Value);
 738:     }
 739:   /* Make sure this buffer has its own value of sym */
 740:   tem = Fassq (sym, bf_cur->local_var_alist);
 741:   if (NULL (tem))
 742:     {
 743:       bf_cur->local_var_alist
 744:         = Fcons (Fcons (sym, XCONS (XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->cdr)->cdr),
 745:          bf_cur->local_var_alist);
 746:       /* Make sure symbol does not think it is set up for this buffer;
 747: 	 force it to look once again for this buffer's value */
 748:       if (bf_cur == XBUFFER (XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car))
 749:     XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car = Qnil;
 750:     }
 751:   return sym;
 752: }
 753: 
 754: DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
 755:   1, 1, "vKill Local Variable: ",
 756:   "Make VARIABLE no longer have a separate value in the current buffer.\n\
 757: From now on the default value will apply in this buffer.")
 758:   (sym)
 759:      Lisp_Object sym;
 760: {
 761:   register Lisp_Object tem, valcontents;
 762: 
 763:   CHECK_SYMBOL (sym, 0);
 764: 
 765:   valcontents = XSYMBOL (sym)->value;
 766:   if (XTYPE (valcontents) != Lisp_Buffer_Local_Value &&
 767:       XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
 768:     return sym;
 769: 
 770:   /* Get rid of this buffer's alist element, if any */
 771: 
 772:   tem = Fassq (sym, bf_cur->local_var_alist);
 773:   if (!NULL (tem))
 774:     bf_cur->local_var_alist = Fdelq (tem, bf_cur->local_var_alist);
 775: 
 776:   /* Put the symbol into a consistent state,
 777:      set up for access in the current buffer with the default value */
 778: 
 779:   tem = XCONS (XCONS (valcontents)->cdr)->cdr;
 780:   XCONS (tem)->car = tem;
 781:   XCONS (XCONS (valcontents)->cdr)->car = Fcurrent_buffer ();
 782:   store_symval_forwarding (sym, XCONS (valcontents)->car, XCONS (tem)->cdr);
 783: 
 784:   return sym;
 785: }
 786: 
 787: /* Extract and set vector and string elements */
 788: 
 789: DEFUN ("aref", Faref, Saref, 2, 2, 0,
 790:   "Return the element of ARRAY at index INDEX.\n\
 791: ARRAY may be a vector or a string.  INDEX starts at 0.")
 792:   (vector, idx)
 793:      register Lisp_Object vector;
 794:      Lisp_Object idx;
 795: {
 796:   register int idxval;
 797: 
 798:   CHECK_NUMBER (idx, 1);
 799:   idxval = XINT (idx);
 800:   if (XTYPE (vector) != Lisp_Vector && XTYPE (vector) != Lisp_String)
 801:     vector = wrong_type_argument (Qarrayp, vector);
 802:   if (idxval < 0 || idxval >= XVECTOR (vector)->size)
 803:     while (1)
 804:       Fsignal (Qargs_out_of_range, Fcons (vector, Fcons (idx, Qnil)));
 805:   if (XTYPE (vector) == Lisp_Vector)
 806:     return XVECTOR (vector)->contents[idxval];
 807:   else
 808:     {
 809:       Lisp_Object val;
 810:       XFASTINT (val) = (unsigned char) XSTRING (vector)->data[idxval];
 811:       return val;
 812:     }
 813: }
 814: 
 815: DEFUN ("aset", Faset, Saset, 3, 3, 0,
 816:   "Store into the element of ARRAY at index INDEX the value NEWVAL.\n\
 817: ARRAY may be a vector or a string.  INDEX starts at 0.")
 818:   (vector, idx, newelt)
 819:      Lisp_Object vector, idx, newelt;
 820: {
 821:   register int idxval;
 822: 
 823:   CHECK_NUMBER (idx, 1);
 824:   idxval = XINT (idx);
 825:   if (XTYPE (vector) != Lisp_Vector && XTYPE (vector) != Lisp_String)
 826:     vector = wrong_type_argument (Qarrayp, vector);
 827:   if (idxval < 0 || idxval >= XVECTOR (vector)->size)
 828:     while (1)
 829:       Fsignal (Qargs_out_of_range, Fcons (vector, Fcons (idx, Qnil)));
 830:   CHECK_IMPURE (vector);
 831: 
 832:   if (XTYPE (vector) == Lisp_Vector)
 833:     XVECTOR (vector)->contents[idxval] = newelt;
 834:   else
 835:     XSTRING (vector)->data[idxval] = XINT (newelt);
 836: 
 837:   return newelt;
 838: }
 839: 
 840: Lisp_Object
 841: Farray_length (vector)
 842:      Lisp_Object vector;
 843: {
 844:   register Lisp_Object size;
 845:   if (XTYPE (vector) != Lisp_Vector && XTYPE (vector) != Lisp_String)
 846:     vector = wrong_type_argument (Qarrayp, vector);
 847:   XFASTINT (size) = XVECTOR (vector)->size;
 848:   return size;
 849: }
 850: 
 851: /* Arithmetic functions */
 852: 
 853: DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0,
 854:   "T if two args, both numbers, are equal.")
 855:   (num1, num2)
 856:      Lisp_Object num1, num2;
 857: {
 858:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
 859:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
 860: 
 861:   if (XINT (num1) == XINT (num2))
 862:     return Qt;
 863:   return Qnil;
 864: }
 865: 
 866: DEFUN ("<", Flss, Slss, 2, 2, 0,
 867:   "T if first arg is less than second arg.  Both must be numbers.")
 868:   (num1, num2)
 869:      Lisp_Object num1, num2;
 870: {
 871:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
 872:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
 873: 
 874:   if (XINT (num1) < XINT (num2))
 875:     return Qt;
 876:   return Qnil;
 877: }
 878: 
 879: DEFUN (">", Fgtr, Sgtr, 2, 2, 0,
 880:   "T if first arg is greater than second arg.  Both must be numbers.")
 881:   (num1, num2)
 882:      Lisp_Object num1, num2;
 883: {
 884:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
 885:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
 886: 
 887:   if (XINT (num1) > XINT (num2))
 888:     return Qt;
 889:   return Qnil;
 890: }
 891: 
 892: DEFUN ("<=", Fleq, Sleq, 2, 2, 0,
 893:   "T if first arg is less than or equal to second arg.  Both must be numbers.")
 894:   (num1, num2)
 895:      Lisp_Object num1, num2;
 896: {
 897:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
 898:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
 899: 
 900:   if (XINT (num1) <= XINT (num2))
 901:     return Qt;
 902:   return Qnil;
 903: }
 904: 
 905: DEFUN (">=", Fgeq, Sgeq, 2, 2, 0,
 906:   "T if first arg is greater than or equal to second arg.  Both must be numbers.")
 907:   (num1, num2)
 908:      Lisp_Object num1, num2;
 909: {
 910:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
 911:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
 912: 
 913:   if (XINT (num1) >= XINT (num2))
 914:     return Qt;
 915:   return Qnil;
 916: }
 917: 
 918: DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
 919:   "T if first arg is not equal to second arg.  Both must be numbers.")
 920:   (num1, num2)
 921:      Lisp_Object num1, num2;
 922: {
 923:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
 924:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
 925: 
 926:   if (XINT (num1) != XINT (num2))
 927:     return Qt;
 928:   return Qnil;
 929: }
 930: 
 931: DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, "T if NUMBER is zero.")
 932:   (num)
 933:      Lisp_Object num;
 934: {
 935:   CHECK_NUMBER (num, 0);
 936: 
 937:   if (!XINT (num))
 938:     return Qt;
 939:   return Qnil;
 940: }
 941: 
 942: DEFUN ("int-to-string", Fint_to_string, Sint_to_string, 1, 1, 0,
 943:   "Convert INT to a string by printing it in decimal, with minus sign if negative.")
 944:   (num)
 945:      Lisp_Object num;
 946: {
 947:   char buffer[20];
 948: 
 949:   CHECK_NUMBER (num, 0);
 950:   sprintf (buffer, "%d", XINT (num));
 951:   return build_string (buffer);
 952: }
 953: 
 954: DEFUN ("string-to-int", Fstring_to_int, Sstring_to_int, 1, 1, 0,
 955:   "Convert STRING to an integer by parsing it as a decimal number.\n\
 956: Optional second arg FLAG non-nil means also convert \"yes\" to 1, \"no\" to 0.")
 957:   (str, flag)
 958:      Lisp_Object str, flag;
 959: {
 960:   CHECK_STRING (str, 0);
 961:   if (!NULL (flag) && !strcmp (XSTRING (str)->data, "yes"))
 962:     return make_number (1);
 963:   if (!NULL (flag) && !strcmp (XSTRING (str)->data, "no"))
 964:     return make_number (0);
 965:   return make_number (atoi (XSTRING (str)->data));
 966: }
 967: 
 968: enum arithop
 969:   { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin };
 970: 
 971: Lisp_Object
 972: arith_driver
 973:   (code, nargs, args)
 974:      enum arithop code;
 975:      int nargs;
 976:      Lisp_Object *args;
 977: {
 978:   Lisp_Object val;
 979:   int argnum;
 980:   int accum;
 981:   int next;
 982: 
 983: #ifdef SWITCH_ENUM_BUG
 984:   switch ((int) code)
 985: #else
 986:   switch (code)
 987: #endif
 988:     {
 989:     case Alogior:
 990:     case Alogxor:
 991:     case Aadd:
 992:     case Asub:
 993:       accum = 0; break;
 994:     case Amult:
 995:       accum = 1; break;
 996:     case Alogand:
 997:       accum = -1; break;
 998:     }
 999: 
1000:   for (argnum = 0; argnum < nargs; argnum++)
1001:     {
1002:       val = args[argnum];    /* using args[argnum] as argument to CHECK_NUMBER_... */
1003:       CHECK_NUMBER_COERCE_MARKER (val, argnum);
1004:       args[argnum] = val;    /* runs into a compiler bug. */
1005:       next = XINT (args[argnum]);
1006: #ifdef SWITCH_ENUM_BUG
1007:       switch ((int) code)
1008: #else
1009:       switch (code)
1010: #endif
1011:     {
1012:     case Aadd: accum += next; break;
1013:     case Asub:
1014:       if (!argnum && nargs != 1)
1015:         next = - next;
1016:       accum -= next;
1017:       break;
1018:     case Amult: accum *= next; break;
1019:     case Adiv:
1020:       if (!argnum) accum = next;
1021:       else accum /= next;
1022:       break;
1023:     case Alogand: accum &= next; break;
1024:     case Alogior: accum |= next; break;
1025:     case Alogxor: accum ^= next; break;
1026:     case Amax: if (!argnum || next > accum) accum = next; break;
1027:     case Amin: if (!argnum || next < accum) accum = next; break;
1028:     }
1029:     }
1030: 
1031:   XSET (val, Lisp_Int, accum);
1032:   return val;
1033: }
1034: 
1035: DEFUN ("+", Fplus, Splus, 0, MANY, 0,
1036:   "Return sum of any number of numbers.")
1037:   (nargs, args)
1038:      int nargs;
1039:      Lisp_Object *args;
1040: {
1041:   return arith_driver (Aadd, nargs, args);
1042: }
1043: 
1044: DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
1045:   "Negate number or subtract numbers.\n\
1046: With one arg, negates it.  With more than one arg,\n\
1047: subtracts all but the first from the first.")
1048:   (nargs, args)
1049:      int nargs;
1050:      Lisp_Object *args;
1051: {
1052:   return arith_driver (Asub, nargs, args);
1053: }
1054: 
1055: DEFUN ("*", Ftimes, Stimes, 0, MANY, 0,
1056:   "Returns product of any number of numbers.")
1057:   (nargs, args)
1058:      int nargs;
1059:      Lisp_Object *args;
1060: {
1061:   return arith_driver (Amult, nargs, args);
1062: }
1063: 
1064: DEFUN ("/", Fquo, Squo, 2, MANY, 0,
1065:   "Returns first argument divided by rest of arguments.")
1066:   (nargs, args)
1067:      int nargs;
1068:      Lisp_Object *args;
1069: {
1070:   return arith_driver (Adiv, nargs, args);
1071: }
1072: 
1073: DEFUN ("%", Frem, Srem, 2, 2, 0,
1074:   "Returns remainder of first arg divided by second.")
1075:   (num1, num2)
1076:      Lisp_Object num1, num2;
1077: {
1078:   Lisp_Object val;
1079: 
1080:   CHECK_NUMBER (num1, 0);
1081:   CHECK_NUMBER (num2, 1);
1082: 
1083:   XSET (val, Lisp_Int, XINT (num1) % XINT (num2));
1084:   return val;
1085: }
1086: 
1087: DEFUN ("max", Fmax, Smax, 1, MANY, 0,
1088:   "Return largest of all the arguments (which must be numbers.)")
1089:   (nargs, args)
1090:      int nargs;
1091:      Lisp_Object *args;
1092: {
1093:   return arith_driver (Amax, nargs, args);
1094: }
1095: 
1096: DEFUN ("min", Fmin, Smin, 1, MANY, 0,
1097:   "Return smallest of all the arguments (which must be numbers.)")
1098:   (nargs, args)
1099:      int nargs;
1100:      Lisp_Object *args;
1101: {
1102:   return arith_driver (Amin, nargs, args);
1103: }
1104: 
1105: DEFUN ("logand", Flogand, Slogand, 0, MANY, 0,
1106:   "Return bitwise and of all the arguments (numbers).")
1107:   (nargs, args)
1108:      int nargs;
1109:      Lisp_Object *args;
1110: {
1111:   return arith_driver (Alogand, nargs, args);
1112: }
1113: 
1114: DEFUN ("logior", Flogior, Slogior, 0, MANY, 0,
1115:   "Return bitwise or of all the arguments (numbers).")
1116:   (nargs, args)
1117:      int nargs;
1118:      Lisp_Object *args;
1119: {
1120:   return arith_driver (Alogior, nargs, args);
1121: }
1122: 
1123: DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0,
1124:   "Return bitwise exclusive-or of all the arguments (numbers).")
1125:   (nargs, args)
1126:      int nargs;
1127:      Lisp_Object *args;
1128: {
1129:   return arith_driver (Alogxor, nargs, args);
1130: }
1131: 
1132: DEFUN ("ash", Fash, Sash, 2, 2, 0,
1133:   "Return VALUE with its bits shifted left by COUNT.\n\
1134: If COUNT is negative, shifting is actually to the right.\n\
1135: In this case, the sign bit is duplicated.")
1136:   (num1, num2)
1137:      Lisp_Object num1, num2;
1138: {
1139:   Lisp_Object val;
1140: 
1141:   CHECK_NUMBER (num1, 0);
1142:   CHECK_NUMBER (num2, 1);
1143: 
1144:   if (XINT (num2) > 0)
1145:     XSET (val, Lisp_Int, XINT (num1) << XFASTINT (num2));
1146:   else
1147:     XSET (val, Lisp_Int, XINT (num1) >> -XINT (num2));
1148:   return val;
1149: }
1150: 
1151: DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,
1152:   "Return VALUE with its bits shifted left by COUNT.\n\
1153: If COUNT is negative, shifting is actually to the right.\n\
1154: In this case,  zeros are shifted in on the left.")
1155:   (num1, num2)
1156:      Lisp_Object num1, num2;
1157: {
1158:   Lisp_Object val;
1159: 
1160:   CHECK_NUMBER (num1, 0);
1161:   CHECK_NUMBER (num2, 1);
1162: 
1163:   if (XINT (num2) > 0)
1164:     XSET (val, Lisp_Int, (unsigned) XFASTINT (num1) << XFASTINT (num2));
1165:   else
1166:     XSET (val, Lisp_Int, (unsigned) XFASTINT (num1) >> -XINT (num2));
1167:   return val;
1168: }
1169: 
1170: DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
1171:   "Return NUMBER plus one.")
1172:   (num)
1173:      Lisp_Object num;
1174: {
1175:   CHECK_NUMBER_COERCE_MARKER (num, 0);
1176:   XSETINT (num, XFASTINT (num) + 1);
1177:   return num;
1178: }
1179: 
1180: DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
1181:   "Return NUMBER minus one.")
1182:   (num)
1183:      Lisp_Object num;
1184: {
1185:   CHECK_NUMBER_COERCE_MARKER (num, 0);
1186:   XSETINT (num, XFASTINT (num) - 1);
1187:   return num;
1188: }
1189: DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
1190:   "Return the bitwise complement of ARG.")
1191:   (num)
1192:      Lisp_Object num;
1193: {
1194:   CHECK_NUMBER (num, 0);
1195:   XSETINT (num, ~XFASTINT (num));
1196:   return num;
1197: }
1198: 
1199: void
1200: syms_of_data ()
1201: {
1202:   Qquote = intern ("quote");
1203:   Qlambda = intern ("lambda");
1204:   Qsubr = intern ("subr");
1205:   Qerror_conditions = intern ("error-conditions");
1206:   Qerror_message = intern ("error-message");
1207:   Qtop_level = intern ("top-level");
1208: 
1209:   Qerror = intern ("error");
1210:   Qquit = intern ("quit");
1211:   Qwrong_type_argument = intern ("wrong-type-argument");
1212:   Qargs_out_of_range = intern ("args-out-of-range");
1213:   Qvoid_function = intern ("void-function");
1214:   Qvoid_variable = intern ("void-variable");
1215:   Qsetting_constant = intern ("setting-constant");
1216:   Qinvalid_read_syntax = intern ("invalid-read-syntax");
1217: 
1218:   Qinvalid_function = intern ("invalid-function");
1219:   Qwrong_number_of_arguments = intern ("wrong-number-of-arguments");
1220:   Qno_catch = intern ("no-catch");
1221:   Qend_of_file = intern ("end-of-file");
1222:   Qarith_error = intern ("arith-error");
1223:   Qbeginning_of_buffer = intern ("beginning-of-buffer");
1224:   Qend_of_buffer = intern ("end-of-buffer");
1225:   Qbuffer_read_only = intern ("buffer-read-only");
1226: 
1227:   Qlistp = intern ("listp");
1228:   Qconsp = intern ("consp");
1229:   Qsymbolp = intern ("symbolp");
1230:   Qintegerp = intern ("integerp");
1231:   Qnatnump = intern ("natnump");
1232:   Qstringp = intern ("stringp");
1233:   Qarrayp = intern ("arrayp");
1234:   Qsequencep = intern ("sequencep");
1235:   Qbufferp = intern ("bufferp");
1236:   Qvectorp = intern ("vectorp");
1237:   Qchar_or_string_p = intern ("char-or-string-p");
1238:   Qmarkerp = intern ("markerp");
1239:   Qinteger_or_marker_p = intern ("integer-or-marker-p");
1240:   Qboundp = intern ("boundp");
1241:   Qfboundp = intern ("fboundp");
1242: 
1243:   Qcdr = intern ("cdr");
1244: 
1245:   /* ERROR is used as a signaler for random errors for which nothing else is right */
1246: 
1247:   Fput (Qerror, Qerror_conditions,
1248:     Fcons (Qerror, Qnil));
1249:   Fput (Qerror, Qerror_message,
1250:     build_string ("error"));
1251: 
1252:   Fput (Qquit, Qerror_conditions,
1253:     Fcons (Qquit, Qnil));
1254:   Fput (Qquit, Qerror_message,
1255:     build_string ("Quit"));
1256: 
1257:   Fput (Qwrong_type_argument, Qerror_conditions,
1258:     Fcons (Qwrong_type_argument, Fcons (Qerror, Qnil)));
1259:   Fput (Qwrong_type_argument, Qerror_message,
1260:     build_string ("Wrong type argument"));
1261: 
1262:   Fput (Qargs_out_of_range, Qerror_conditions,
1263:     Fcons (Qargs_out_of_range, Fcons (Qerror, Qnil)));
1264:   Fput (Qargs_out_of_range, Qerror_message,
1265:     build_string ("Args out of range"));
1266: 
1267:   Fput (Qvoid_function, Qerror_conditions,
1268:     Fcons (Qvoid_function, Fcons (Qerror, Qnil)));
1269:   Fput (Qvoid_function, Qerror_message,
1270:     build_string ("Symbol's function definition is void"));
1271: 
1272:   Fput (Qvoid_variable, Qerror_conditions,
1273:     Fcons (Qvoid_variable, Fcons (Qerror, Qnil)));
1274:   Fput (Qvoid_variable, Qerror_message,
1275:     build_string ("Symbol's value as variable is void"));
1276: 
1277:   Fput (Qsetting_constant, Qerror_conditions,
1278:     Fcons (Qsetting_constant, Fcons (Qerror, Qnil)));
1279:   Fput (Qsetting_constant, Qerror_message,
1280:     build_string ("Attempt to set a constant symbol"));
1281: 
1282:   Fput (Qinvalid_read_syntax, Qerror_conditions,
1283:     Fcons (Qinvalid_read_syntax, Fcons (Qerror, Qnil)));
1284:   Fput (Qinvalid_read_syntax, Qerror_message,
1285:     build_string ("Invalid read syntax"));
1286: 
1287:   Fput (Qinvalid_function, Qerror_conditions,
1288:     Fcons (Qinvalid_function, Fcons (Qerror, Qnil)));
1289:   Fput (Qinvalid_function, Qerror_message,
1290:     build_string ("Invalid function"));
1291: 
1292:   Fput (Qwrong_number_of_arguments, Qerror_conditions,
1293:     Fcons (Qwrong_number_of_arguments, Fcons (Qerror, Qnil)));
1294:   Fput (Qwrong_number_of_arguments, Qerror_message,
1295:     build_string ("Wrong number of arguments"));
1296: 
1297:   Fput (Qno_catch, Qerror_conditions,
1298:     Fcons (Qno_catch, Fcons (Qerror, Qnil)));
1299:   Fput (Qno_catch, Qerror_message,
1300:     build_string ("No catch for tag"));
1301: 
1302:   Fput (Qend_of_file, Qerror_conditions,
1303:     Fcons (Qend_of_file, Fcons (Qerror, Qnil)));
1304:   Fput (Qend_of_file, Qerror_message,
1305:     build_string ("End of file during parsing"));
1306: 
1307:   Fput (Qarith_error, Qerror_conditions,
1308:     Fcons (Qarith_error, Fcons (Qerror, Qnil)));
1309:   Fput (Qarith_error, Qerror_message,
1310:     build_string ("Arithmetic error"));
1311: 
1312:   Fput (Qbeginning_of_buffer, Qerror_conditions,
1313:     Fcons (Qbeginning_of_buffer, Fcons (Qerror, Qnil)));
1314:   Fput (Qbeginning_of_buffer, Qerror_message,
1315:     build_string ("Beginning of buffer"));
1316: 
1317:   Fput (Qend_of_buffer, Qerror_conditions,
1318:     Fcons (Qend_of_buffer, Fcons (Qerror, Qnil)));
1319:   Fput (Qend_of_buffer, Qerror_message,
1320:     build_string ("End of buffer"));
1321: 
1322:   Fput (Qbuffer_read_only, Qerror_conditions,
1323:     Fcons (Qbuffer_read_only, Fcons (Qerror, Qnil)));
1324:   Fput (Qbuffer_read_only, Qerror_message,
1325:     build_string ("Buffer is read-only"));
1326: 
1327:   staticpro (&Qnil);
1328:   staticpro (&Qt);
1329:   staticpro (&Qquote);
1330:   staticpro (&Qlambda);
1331:   staticpro (&Qsubr);
1332:   staticpro (&Qunbound);
1333:   staticpro (&Qerror_conditions);
1334:   staticpro (&Qerror_message);
1335:   staticpro (&Qtop_level);
1336: 
1337:   staticpro (&Qerror);
1338:   staticpro (&Qquit);
1339:   staticpro (&Qwrong_type_argument);
1340:   staticpro (&Qargs_out_of_range);
1341:   staticpro (&Qvoid_function);
1342:   staticpro (&Qvoid_variable);
1343:   staticpro (&Qsetting_constant);
1344:   staticpro (&Qinvalid_read_syntax);
1345:   staticpro (&Qwrong_number_of_arguments);
1346:   staticpro (&Qinvalid_function);
1347:   staticpro (&Qno_catch);
1348:   staticpro (&Qend_of_file);
1349:   staticpro (&Qarith_error);
1350:   staticpro (&Qbeginning_of_buffer);
1351:   staticpro (&Qend_of_buffer);
1352:   staticpro (&Qbuffer_read_only);
1353: 
1354:   staticpro (&Qlistp);
1355:   staticpro (&Qconsp);
1356:   staticpro (&Qsymbolp);
1357:   staticpro (&Qintegerp);
1358:   staticpro (&Qnatnump);
1359:   staticpro (&Qstringp);
1360:   staticpro (&Qarrayp);
1361:   staticpro (&Qsequencep);
1362:   staticpro (&Qbufferp);
1363:   staticpro (&Qvectorp);
1364:   staticpro (&Qchar_or_string_p);
1365:   staticpro (&Qmarkerp);
1366:   staticpro (&Qinteger_or_marker_p);
1367:   staticpro (&Qboundp);
1368:   staticpro (&Qfboundp);
1369:   staticpro (&Qcdr);
1370: 
1371:   defsubr (&Seq);
1372:   defalias (&Seq, "eql");
1373:   defsubr (&Snull);
1374:   defalias (&Snull, "not");
1375:   defsubr (&Slistp);
1376:   defsubr (&Snlistp);
1377:   defsubr (&Sconsp);
1378:   defsubr (&Satom);
1379:   defsubr (&Sintegerp);
1380:   defalias (&Sintegerp, "numberp");
1381:   defsubr (&Snatnump);
1382:   defsubr (&Ssymbolp);
1383:   defsubr (&Sstringp);
1384:   defsubr (&Svectorp);
1385:   defsubr (&Sarrayp);
1386:   defsubr (&Ssequencep);
1387:   defsubr (&Sbufferp);
1388:   defsubr (&Smarkerp);
1389:   defsubr (&Sinteger_or_marker_p);
1390:   defsubr (&Ssubrp);
1391:   defsubr (&Schar_or_string_p);
1392:   defsubr (&Scar);
1393:   defsubr (&Scdr);
1394:   defsubr (&Scar_safe);
1395:   defsubr (&Scdr_safe);
1396:   defsubr (&Ssetcar);
1397:   defalias (&Ssetcar, "rplaca");
1398:   defalias (&Ssetcdr, "rplacd");
1399:   defsubr (&Ssetcdr);
1400:   defsubr (&Ssymbol_function);
1401:   defsubr (&Ssymbol_plist);
1402:   defsubr (&Ssymbol_name);
1403:   defsubr (&Smakunbound);
1404:   defsubr (&Sfmakunbound);
1405:   defsubr (&Sboundp);
1406:   defsubr (&Sfboundp);
1407:   defsubr (&Sfset);
1408:   defsubr (&Ssetplist);
1409:   defsubr (&Ssymbol_value);
1410:   defsubr (&Sset);
1411:   defsubr (&Sdefault_value);
1412:   defsubr (&Sset_default);
1413:   defsubr (&Smake_variable_buffer_local);
1414:   defsubr (&Smake_local_variable);
1415:   defsubr (&Skill_local_variable);
1416:   defsubr (&Saref);
1417:   defsubr (&Saset);
1418:   defsubr (&Sint_to_string);
1419:   defsubr (&Sstring_to_int);
1420:   defsubr (&Seqlsign);
1421:   defsubr (&Slss);
1422:   defsubr (&Sgtr);
1423:   defsubr (&Sleq);
1424:   defsubr (&Sgeq);
1425:   defsubr (&Sneq);
1426:   defsubr (&Szerop);
1427:   defsubr (&Splus);
1428:   defsubr (&Sminus);
1429:   defsubr (&Stimes);
1430:   defsubr (&Squo);
1431:   defsubr (&Srem);
1432:   defsubr (&Smax);
1433:   defsubr (&Smin);
1434:   defsubr (&Slogand);
1435:   defsubr (&Slogior);
1436:   defsubr (&Slogxor);
1437:   defsubr (&Slsh);
1438:   defsubr (&Sash);
1439:   defsubr (&Sadd1);
1440:   defsubr (&Ssub1);
1441:   defsubr (&Slognot);
1442: }
1443: 
1444: arith_error (signo)
1445:      int signo;
1446: {
1447: #ifdef USG
1448:   /* USG systems forget handlers when they are used;
1449:      must reestablish each time */
1450:   signal (signo, arith_error);
1451: #endif /* USG */
1452: #ifdef BSD4_1
1453:   sigrelse (SIGFPE);
1454: #else /* not BSD4_1 */
1455:   sigsetmask (0);
1456: #endif /* not BSD4_1 */
1457: 
1458:   Fsignal (Qarith_error, Qnil);
1459: }
1460: 
1461: init_data ()
1462: {
1463:   signal (SIGFPE, arith_error);
1464: }

Defined functions

Defined variables

Defined enum's