src/data.c

   1 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
   2    Copyright (C) 1985, 1986, 1988 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 1, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include <signal.h>
  22
  23 #include "config.h"
  24 #include "lisp.h"
  25
  26 #ifndef standalone
  27 #include "buffer.h"
  28 #endif
  29
  30 #ifdef LISP_FLOAT_TYPE
  31 #include <math.h>
  32 #endif /* LISP_FLOAT_TYPE */
  33
  34 Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
  35 Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
  36 Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
  37 Lisp_Object Qvoid_variable, Qvoid_function;
  38 Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
  39 Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
  40 Lisp_Object Qend_of_file, Qarith_error;
  41 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
  42 Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qlistp, Qconsp;
  43 Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
  44 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
  45 Lisp_Object Qboundp, Qfboundp;
  46 Lisp_Object Qcdr;
  47
  48 #ifdef LISP_FLOAT_TYPE
  49 Lisp_Object Qfloatp, Qinteger_or_floatp, Qinteger_or_float_or_marker_p;
  50 Lisp_Object Qnumberp, Qnumber_or_marker_p;
  51 #endif
  52
  53 static Lisp_Object swap_in_symval_forwarding ();
  54
  55 Lisp_Object
  56 wrong_type_argument (predicate, value)
  57      register Lisp_Object predicate, value;
  58 {
  59   register Lisp_Object tem;
  60   do
  61     {
  62       if (!EQ (Vmocklisp_arguments, Qt))
  63         {
  64          if (XTYPE (value) == Lisp_String &&
  65              (EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p)))
  66            return Fstring_to_int (value, Qt);
  67          if (XTYPE (value) == Lisp_Int && EQ (predicate, Qstringp))
  68            return Fint_to_string (value);
  69         }
  70       value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil)));
  71       tem = call1 (predicate, value);
  72     }
  73   while (NULL (tem));
  74   return value;
  75 }
  76
  77 pure_write_error ()
  78 {
  79   error ("Attempt to modify read-only object");
  80 }
  81
  82 void
  83 args_out_of_range (a1, a2)
  84      Lisp_Object a1, a2;
  85 {
  86   while (1)
  87     Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Qnil)));
  88 }
  89
  90 void
  91 args_out_of_range_3 (a1, a2, a3)
  92      Lisp_Object a1, a2, a3;
  93 {
  94   while (1)
  95     Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Fcons (a3, Qnil))));
  96 }
  97
  98 Lisp_Object
  99 make_number (num)
 100      int num;
 101 {
 102   register Lisp_Object val;
 103   XSET (val, Lisp_Int, num);
 104   return val;
 105 }
 106
 107 /* On some machines, XINT needs a temporary location.
 108    Here it is, in case it is needed.  */
 109
 110 int sign_extend_temp;
 111
 112 /* On a few machines, XINT can only be done by calling this.  */
 113
 114 int
 115 sign_extend_lisp_int (num)
 116      int num;
 117 {
 118   if (num & (1 << (VALBITS - 1)))
 119     return num | ((-1) << VALBITS);
 120   else
 121     return num & ((1 << VALBITS) - 1);
 122 }
 123 \f
 124 /* Data type predicates */
 125
 126 DEFUN ("eq", Feq, Seq, 2, 2, 0,
 127   "T if the two args are the same Lisp object.")
 128   (obj1, obj2)
 129      Lisp_Object obj1, obj2;
 130 {
 131   if (EQ (obj1, obj2))
 132     return Qt;
 133   return Qnil;
 134 }
 135
 136 DEFUN ("null", Fnull, Snull, 1, 1, 0, "T if OBJECT is nil.")
 137   (obj)
 138      Lisp_Object obj;
 139 {
 140   if (NULL (obj))
 141     return Qt;
 142   return Qnil;
 143 }
 144
 145 DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, "T if OBJECT is a cons cell.")
 146   (obj)
 147      Lisp_Object obj;
 148 {
 149   if (XTYPE (obj) == Lisp_Cons)
 150     return Qt;
 151   return Qnil;
 152 }
 153
 154 DEFUN ("atom", Fatom, Satom, 1, 1, 0, "T if OBJECT is not a cons cell.  This includes nil.")
 155   (obj)
 156      Lisp_Object obj;
 157 {
 158   if (XTYPE (obj) == Lisp_Cons)
 159     return Qnil;
 160   return Qt;
 161 }
 162
 163 DEFUN ("listp", Flistp, Slistp, 1, 1, 0, "T if OBJECT is a list.  This includes nil.")
 164   (obj)
 165      Lisp_Object obj;
 166 {
 167   if (XTYPE (obj) == Lisp_Cons || NULL (obj))
 168     return Qt;
 169   return Qnil;
 170 }
 171
 172 DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, "T if OBJECT is not a list.  Lists include nil.")
 173   (obj)
 174      Lisp_Object obj;
 175 {
 176   if (XTYPE (obj) == Lisp_Cons || NULL (obj))
 177     return Qnil;
 178   return Qt;
 179 }
 180 \f
 181 DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, "T if OBJECT is a symbol.")
 182   (obj)
 183      Lisp_Object obj;
 184 {
 185   if (XTYPE (obj) == Lisp_Symbol)
 186     return Qt;
 187   return Qnil;
 188 }
 189
 190 DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, "T if OBJECT is a vector.")
 191   (obj)
 192      Lisp_Object obj;
 193 {
 194   if (XTYPE (obj) == Lisp_Vector)
 195     return Qt;
 196   return Qnil;
 197 }
 198
 199 DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, "T if OBJECT is a string.")
 200   (obj)
 201      Lisp_Object obj;
 202 {
 203   if (XTYPE (obj) == Lisp_String)
 204     return Qt;
 205   return Qnil;
 206 }
 207
 208 DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "T if OBJECT is an array (string or vector).")
 209   (obj)
 210      Lisp_Object obj;
 211 {
 212   if (XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String)
 213     return Qt;
 214   return Qnil;
 215 }
 216
 217 DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
 218   "T if OBJECT is a sequence (list or array).")
 219   (obj)
 220      register Lisp_Object obj;
 221 {
 222   if (CONSP (obj) || NULL (obj) ||
 223       XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String)
 224     return Qt;
 225   return Qnil;
 226 }
 227
 228 DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, "T if OBJECT is an editor buffer.")
 229   (obj)
 230      Lisp_Object obj;
 231 {
 232   if (XTYPE (obj) == Lisp_Buffer)
 233     return Qt;
 234   return Qnil;
 235 }
 236
 237 DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, "T if OBJECT is a marker (editor pointer).")
 238   (obj)
 239      Lisp_Object obj;
 240 {
 241   if (XTYPE (obj) == Lisp_Marker)
 242     return Qt;
 243   return Qnil;
 244 }
 245
 246 DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0,
 247   "T if OBJECT is an integer or a marker (editor pointer).")
 248   (obj)
 249      register Lisp_Object obj;
 250 {
 251   if (XTYPE (obj) == Lisp_Marker || XTYPE (obj) == Lisp_Int)
 252     return Qt;
 253   return Qnil;
 254 }
 255
 256 DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "T if OBJECT is a built-in function.")
 257   (obj)
 258      Lisp_Object obj;
 259 {
 260   if (XTYPE (obj) == Lisp_Subr)
 261     return Qt;
 262   return Qnil;
 263 }
 264
 265 DEFUN ("compiled-function-p", Fcompiled_function_p, Scompiled_function_p,
 266        1, 1, 0, "T if OBJECT is a compiled function object.")
 267   (obj)
 268      Lisp_Object obj;
 269 {
 270   if (XTYPE (obj) == Lisp_Compiled)
 271     return Qt;
 272   return Qnil;
 273 }
 274
 275 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.")
 276   (obj)
 277      register Lisp_Object obj;
 278 {
 279   if (XTYPE (obj) == Lisp_Int || XTYPE (obj) == Lisp_String)
 280     return Qt;
 281   return Qnil;
 282 }
 283 \f
 284 DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, "T if OBJECT is a number.")
 285   (obj)
 286      Lisp_Object obj;
 287 {
 288   if (XTYPE (obj) == Lisp_Int)
 289     return Qt;
 290   return Qnil;
 291 }
 292
 293 DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, "T if OBJECT is a nonnegative number.")
 294   (obj)
 295      Lisp_Object obj;
 296 {
 297   if (XTYPE (obj) == Lisp_Int && XINT (obj) >= 0)
 298     return Qt;
 299   return Qnil;
 300 }
 301
 302 #ifdef LISP_FLOAT_TYPE
 303 DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
 304        "T if OBJECT is a floating point number.")
 305   (obj)
 306      Lisp_Object obj;
 307 {
 308   if (XTYPE (obj) == Lisp_Float)
 309     return Qt;
 310   return Qnil;
 311 }
 312
 313 DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
 314        "T if OBJECT is a number (floating point or integer).")
 315   (obj)
 316      Lisp_Object obj;
 317 {
 318   if (XTYPE (obj) == Lisp_Float || XTYPE (obj) == Lisp_Int)
 319     return Qt;
 320   return Qnil;
 321 }
 322
 323 DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
 324        Snumber_or_marker_p, 1, 1, 0,
 325        "T if OBJECT is a number or a marker.")
 326   (obj)
 327      Lisp_Object obj;
 328 {
 329   if (XTYPE (obj) == Lisp_Float
 330       || XTYPE (obj) == Lisp_Int
 331       || XTYPE (obj) == Lisp_Marker)
 332     return Qt;
 333   return Qnil;
 334 }
 335 #endif /* LISP_FLOAT_TYPE */
 336 \f
 337 /* Extract and set components of lists */
 338
 339 DEFUN ("car", Fcar, Scar, 1, 1, 0,
 340   "Return the car of CONSCELL.  If arg is nil, return nil.\n\
 341 Error if arg is not nil and not a cons cell.  See also `car-safe'.")
 342   (list)
 343      register Lisp_Object list;
 344 {
 345   while (1)
 346     {
 347       if (XTYPE (list) == Lisp_Cons)
 348         return XCONS (list)->car;
 349       else if (EQ (list, Qnil))
 350         return Qnil;
 351       else
 352         list = wrong_type_argument (Qlistp, list);
 353     }
 354 }
 355
 356 DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
 357   "Return the car of OBJECT if it is a cons cell, or else nil.")
 358   (object)
 359      Lisp_Object object;
 360 {
 361   if (XTYPE (object) == Lisp_Cons)
 362     return XCONS (object)->car;
 363   else
 364     return Qnil;
 365 }
 366
 367 DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
 368   "Return the cdr of CONSCELL.  If arg is nil, return nil.\n\
 369 Error if arg is not nil and not a cons cell.  See also `cdr-safe'.")
 370
 371   (list)
 372      register Lisp_Object list;
 373 {
 374   while (1)
 375     {
 376       if (XTYPE (list) == Lisp_Cons)
 377         return XCONS (list)->cdr;
 378       else if (EQ (list, Qnil))
 379         return Qnil;
 380       else
 381         list = wrong_type_argument (Qlistp, list);
 382     }
 383 }
 384
 385 DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
 386   "Return the cdr of OBJECT if it is a cons cell, or else  nil.")
 387   (object)
 388      Lisp_Object object;
 389 {
 390   if (XTYPE (object) == Lisp_Cons)
 391     return XCONS (object)->cdr;
 392   else
 393     return Qnil;
 394 }
 395
 396 DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
 397   "Set the car of CONSCELL to be NEWCAR.  Returns NEWCAR.")
 398   (cell, newcar)
 399      register Lisp_Object cell, newcar;
 400 {
 401   if (XTYPE (cell) != Lisp_Cons)
 402     cell = wrong_type_argument (Qconsp, cell);
 403
 404   CHECK_IMPURE (cell);
 405   XCONS (cell)->car = newcar;
 406   return newcar;
 407 }
 408
 409 DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
 410   "Set the cdr of CONSCELL to be NEWCDR.  Returns NEWCDR.")
 411   (cell, newcdr)
 412      register Lisp_Object cell, newcdr;
 413 {
 414   if (XTYPE (cell) != Lisp_Cons)
 415     cell = wrong_type_argument (Qconsp, cell);
 416
 417   CHECK_IMPURE (cell);
 418   XCONS (cell)->cdr = newcdr;
 419   return newcdr;
 420 }
 421 \f
 422 /* Extract and set components of symbols */
 423
 424 DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, "T if SYMBOL's value is not void.")
 425   (sym)
 426      register Lisp_Object sym;
 427 {
 428   Lisp_Object valcontents;
 429   CHECK_SYMBOL (sym, 0);
 430
 431   valcontents = XSYMBOL (sym)->value;
 432
 433 #ifdef SWITCH_ENUM_BUG
 434   switch ((int) XTYPE (valcontents))
 435 #else
 436   switch (XTYPE (valcontents))
 437 #endif
 438     {
 439     case Lisp_Buffer_Local_Value:
 440     case Lisp_Some_Buffer_Local_Value:
 441       valcontents = swap_in_symval_forwarding (sym, valcontents);
 442     }
 443
 444   return (XTYPE (valcontents) == Lisp_Void || EQ (valcontents, Qunbound)
 445           ? Qnil : Qt);
 446 }
 447
 448 DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, "T if SYMBOL's function definition is not void.")
 449   (sym)
 450      register Lisp_Object sym;
 451 {
 452   CHECK_SYMBOL (sym, 0);
 453   return (XTYPE (XSYMBOL (sym)->function) == Lisp_Void
 454           || EQ (XSYMBOL (sym)->function, Qunbound))
 455          ? Qnil : Qt;
 456 }
 457
 458 DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, "Make SYMBOL's value be void.")
 459   (sym)
 460      register Lisp_Object sym;
 461 {
 462   CHECK_SYMBOL (sym, 0);
 463   if (NULL (sym) || EQ (sym, Qt))
 464     return Fsignal (Qsetting_constant, Fcons (sym, Qnil));
 465   Fset (sym, Qunbound);
 466   return sym;
 467 }
 468
 469 DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, "Make SYMBOL's function definition be void.")
 470   (sym)
 471      register Lisp_Object sym;
 472 {
 473   CHECK_SYMBOL (sym, 0);
 474   XSYMBOL (sym)->function = Qunbound;
 475   return sym;
 476 }
 477
 478 DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
 479   "Return SYMBOL's function definition.  Error if that is void.")
 480   (sym)
 481      register Lisp_Object sym;
 482 {
 483   CHECK_SYMBOL (sym, 0);
 484   if (EQ (XSYMBOL (sym)->function, Qunbound))
 485     return Fsignal (Qvoid_function, Fcons (sym, Qnil));
 486   return XSYMBOL (sym)->function;
 487 }
 488
 489 DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, "Return SYMBOL's property list.")
 490   (sym)
 491      register Lisp_Object sym;
 492 {
 493   CHECK_SYMBOL (sym, 0);
 494   return XSYMBOL (sym)->plist;
 495 }
 496
 497 DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, "Return SYMBOL's name, a string.")
 498   (sym)
 499      register Lisp_Object sym;
 500 {
 501   register Lisp_Object name;
 502
 503   CHECK_SYMBOL (sym, 0);
 504   XSET (name, Lisp_String, XSYMBOL (sym)->name);
 505   return name;
 506 }
 507
 508 DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
 509   "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.")
 510   (sym, newdef)
 511      register Lisp_Object sym, newdef;
 512 {
 513   CHECK_SYMBOL (sym, 0);
 514   if (!NULL (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound))
 515     Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
 516                              Vautoload_queue);
 517   XSYMBOL (sym)->function = newdef;
 518   return newdef;
 519 }
 520
 521 DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
 522   "Set SYMBOL's property list to NEWVAL, and return NEWVAL.")
 523   (sym, newplist)
 524      register Lisp_Object sym, newplist;
 525 {
 526   CHECK_SYMBOL (sym, 0);
 527   XSYMBOL (sym)->plist = newplist;
 528   return newplist;
 529 }
 530 \f
 531 /* Getting and setting values of symbols */
 532
 533 /* Given the raw contents of a symbol value cell,
 534    return the Lisp value of the symbol.
 535    This does not handle buffer-local variables; use
 536    swap_in_symval_forwarding for that.  */
 537
 538 Lisp_Object
 539 do_symval_forwarding (valcontents)
 540      register Lisp_Object valcontents;
 541 {
 542   register Lisp_Object val;
 543 #ifdef SWITCH_ENUM_BUG
 544   switch ((int) XTYPE (valcontents))
 545 #else
 546   switch (XTYPE (valcontents))
 547 #endif
 548     {
 549     case Lisp_Intfwd:
 550       XSET (val, Lisp_Int, *XINTPTR (valcontents));
 551       return val;
 552
 553     case Lisp_Boolfwd:
 554       if (*XINTPTR (valcontents))
 555         return Qt;
 556       return Qnil;
 557
 558     case Lisp_Objfwd:
 559       return *XOBJFWD (valcontents);
 560
 561     case Lisp_Buffer_Objfwd:
 562       return *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer);
 563     }
 564   return valcontents;
 565 }
 566
 567 /* Store NEWVAL into SYM, where VALCONTENTS is found in the value cell
 568    of SYM.  If SYM is buffer-local, VALCONTENTS should be the
 569    buffer-independent contents of the value cell: forwarded just one
 570    step past the buffer-localness.  */
 571
 572 void
 573 store_symval_forwarding (sym, valcontents, newval)
 574      Lisp_Object sym;
 575      register Lisp_Object valcontents, newval;
 576 {
 577 #ifdef SWITCH_ENUM_BUG
 578   switch ((int) XTYPE (valcontents))
 579 #else
 580   switch (XTYPE (valcontents))
 581 #endif
 582     {
 583     case Lisp_Intfwd:
 584       CHECK_NUMBER (newval, 1);
 585       *XINTPTR (valcontents) = XINT (newval);
 586       break;
 587
 588     case Lisp_Boolfwd:
 589       *XINTPTR (valcontents) = NULL(newval) ? 0 : 1;
 590       break;
 591
 592     case Lisp_Objfwd:
 593       *XOBJFWD (valcontents) = newval;
 594       break;
 595
 596     case Lisp_Buffer_Objfwd:
 597       *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer) = newval;
 598       break;
 599
 600     default:
 601       valcontents = XSYMBOL (sym)->value;
 602       if (XTYPE (valcontents) == Lisp_Buffer_Local_Value
 603           || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 604         XCONS (XSYMBOL (sym)->value)->car = newval;
 605       else
 606         XSYMBOL (sym)->value = newval;
 607     }
 608 }
 609
 610 /* Set up the buffer-local symbol SYM for validity in the current
 611    buffer.  VALCONTENTS is the contents of its value cell.
 612    Return the value forwarded one step past the buffer-local indicator.  */
 613
 614 static Lisp_Object
 615 swap_in_symval_forwarding (sym, valcontents)
 616      Lisp_Object sym, valcontents;
 617 {
 618   /* valcontents is a list
 619      (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
 620
 621      CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
 622      local_var_alist, that being the element whose car is this variable.
 623      Or it can be a pointer to the (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER
 624      does not have an element in its alist for this variable.
 625
 626      If the current buffer is not BUFFER, we store the current REALVALUE value into
 627      CURRENT-ALIST-ELEMENT, then find the appropriate alist element for
 628      the buffer now current and set up CURRENT-ALIST-ELEMENT.
 629      Then we set REALVALUE out of that element, and store into BUFFER.
 630      Note that REALVALUE can be a forwarding pointer. */
 631
 632   register Lisp_Object tem1;
 633   tem1 = XCONS (XCONS (valcontents)->cdr)->car;
 634
 635   if (NULL (tem1) || current_buffer != XBUFFER (tem1))
 636     {
 637       tem1 = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car;
 638       Fsetcdr (tem1, do_symval_forwarding (XCONS (valcontents)->car));
 639       tem1 = assq_no_quit (sym, current_buffer->local_var_alist);
 640       if (NULL (tem1))
 641         tem1 = XCONS (XCONS (valcontents)->cdr)->cdr;
 642       XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car = tem1;
 643       XSET (XCONS (XCONS (valcontents)->cdr)->car, Lisp_Buffer, current_buffer);
 644       store_symval_forwarding (sym, XCONS (valcontents)->car, Fcdr (tem1));
 645     }
 646   return XCONS (valcontents)->car;
 647 }
 648 \f
 649 /* Note that it must not be possible to quit within this function.
 650    Great care is required for this.  */
 651
 652 DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
 653   "Return SYMBOL's value.  Error if that is void.")
 654   (sym)
 655      Lisp_Object sym;
 656 {
 657   register Lisp_Object valcontents, tem1;
 658   register Lisp_Object val;
 659   CHECK_SYMBOL (sym, 0);
 660   valcontents = XSYMBOL (sym)->value;
 661
 662  retry:
 663 #ifdef SWITCH_ENUM_BUG
 664   switch ((int) XTYPE (valcontents))
 665 #else
 666   switch (XTYPE (valcontents))
 667 #endif
 668     {
 669     case Lisp_Buffer_Local_Value:
 670     case Lisp_Some_Buffer_Local_Value:
 671       valcontents = swap_in_symval_forwarding (sym, valcontents);
 672       goto retry;
 673
 674     case Lisp_Intfwd:
 675       XSET (val, Lisp_Int, *XINTPTR (valcontents));
 676       return val;
 677
 678     case Lisp_Boolfwd:
 679       if (*XINTPTR (valcontents))
 680         return Qt;
 681       return Qnil;
 682
 683     case Lisp_Objfwd:
 684       return *XOBJFWD (valcontents);
 685
 686     case Lisp_Buffer_Objfwd:
 687       return *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer);
 688
 689     case Lisp_Symbol:
 690       /* For a symbol, check whether it is 'unbound. */
 691       if (!EQ (valcontents, Qunbound))
 692         break;
 693       /* drops through! */
 694     case Lisp_Void:
 695       return Fsignal (Qvoid_variable, Fcons (sym, Qnil));
 696     }
 697
 698   return valcontents;
 699 }
 700
 701 DEFUN ("set", Fset, Sset, 2, 2, 0,
 702   "Set SYMBOL's value to NEWVAL, and return NEWVAL.")
 703   (sym, newval)
 704      register Lisp_Object sym, newval;
 705 {
 706   int voide = (XTYPE (newval) == Lisp_Void || EQ (newval, Qunbound));
 707
 708 #ifndef RTPC_REGISTER_BUG
 709   register Lisp_Object valcontents, tem1, current_alist_element;
 710 #else /* RTPC_REGISTER_BUG */
 711   register Lisp_Object tem1;
 712   Lisp_Object valcontents, current_alist_element;
 713 #endif /* RTPC_REGISTER_BUG */
 714
 715   CHECK_SYMBOL (sym, 0);
 716   if (NULL (sym) || EQ (sym, Qt))
 717     return Fsignal (Qsetting_constant, Fcons (sym, Qnil));
 718   valcontents = XSYMBOL (sym)->value;
 719
 720   if (XTYPE (valcontents) == Lisp_Buffer_Objfwd)
 721     {
 722       register int idx = XUINT (valcontents);
 723       register int mask = *(int *)(idx + (char *) &buffer_local_flags);
 724       if (mask > 0)
 725         current_buffer->local_var_flags |= mask;
 726     }
 727
 728   if (XTYPE (valcontents) == Lisp_Buffer_Local_Value
 729       || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 730     {
 731       /* valcontents is a list
 732         (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
 733
 734         CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
 735         local_var_alist, that being the element whose car is this variable.
 736         Or it can be a pointer to the (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER
 737         does not have an element in its alist for this variable.
 738
 739         If the current buffer is not BUFFER, we store the current REALVALUE value into
 740         CURRENT-ALIST-ELEMENT, then find the appropriate alist element for
 741         the buffer now current and set up CURRENT-ALIST-ELEMENT.
 742         Then we set REALVALUE out of that element, and store into BUFFER.
 743         Note that REALVALUE can be a forwarding pointer. */
 744
 745       current_alist_element = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car;
 746       if (current_buffer != ((XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 747                      ? XBUFFER (XCONS (XCONS (valcontents)->cdr)->car)
 748                      : XBUFFER (XCONS (current_alist_element)->car)))
 749         {
 750           Fsetcdr (current_alist_element, do_symval_forwarding (XCONS (valcontents)->car));
 751
 752           tem1 = Fassq (sym, current_buffer->local_var_alist);
 753           if (NULL (tem1))
 754             /* This buffer sees the default value still.
 755                If type is Lisp_Some_Buffer_Local_Value, set the default value.
 756                If type is Lisp_Buffer_Local_Value, give this buffer a local value
 757                 and set that.  */
 758             if (XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 759               tem1 = XCONS (XCONS (valcontents)->cdr)->cdr;
 760             else
 761               {
 762                 tem1 = Fcons (sym, Fcdr (current_alist_element));
 763                 current_buffer->local_var_alist = Fcons (tem1, current_buffer->local_var_alist);
 764               }
 765           XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car = tem1;
 766           XSET (XCONS (XCONS (valcontents)->cdr)->car, Lisp_Buffer, current_buffer);
 767         }
 768       valcontents = XCONS (valcontents)->car;
 769     }
 770   /* If storing void (making the symbol void), forward only through
 771      buffer-local indicator, not through Lisp_Objfwd, etc.  */
 772   if (voide)
 773     store_symval_forwarding (sym, Qnil, newval);
 774   else
 775     store_symval_forwarding (sym, valcontents, newval);
 776   return newval;
 777 }
 778 \f
 779 /* Access or set a buffer-local symbol's default value.  */
 780
 781 /* Return the default value of SYM, but don't check for voidness.
 782    Return Qunbound or a Lisp_Void object if it is void.  */
 783
 784 Lisp_Object
 785 default_value (sym)
 786      Lisp_Object sym;
 787 {
 788   register Lisp_Object valcontents;
 789
 790   CHECK_SYMBOL (sym, 0);
 791   valcontents = XSYMBOL (sym)->value;
 792
 793   /* For a built-in buffer-local variable, get the default value
 794      rather than letting do_symval_forwarding get the current value.  */
 795   if (XTYPE (valcontents) == Lisp_Buffer_Objfwd)
 796     {
 797       register int idx = XUINT (valcontents);
 798
 799       if (*(int *) (idx + (char *) &buffer_local_flags) != 0)
 800         return *(Lisp_Object *)(idx + (char *) &buffer_defaults);
 801     }
 802
 803   /* Handle user-created local variables.  */
 804   if (XTYPE (valcontents) == Lisp_Buffer_Local_Value
 805       || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 806     {
 807       /* If var is set up for a buffer that lacks a local value for it,
 808          the current value is nominally the default value.
 809          But the current value slot may be more up to date, since
 810          ordinary setq stores just that slot.  So use that.  */
 811       Lisp_Object current_alist_element, alist_element_car;
 812       current_alist_element
 813         = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car;
 814       alist_element_car = XCONS (current_alist_element)->car;
 815       if (EQ (alist_element_car, current_alist_element))
 816         return do_symval_forwarding (XCONS (valcontents)->car);
 817       else
 818         return XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->cdr;
 819     }
 820   /* For other variables, get the current value.  */
 821   return do_symval_forwarding (valcontents);
 822 }
 823
 824 DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0,
 825   "Return T if SYMBOL has a non-void default value.\n\
 826 This is the value that is seen in buffers that do not have their own values\n\
 827 for this variable.")
 828   (sym)
 829      Lisp_Object sym;
 830 {
 831   register Lisp_Object value;
 832
 833   value = default_value (sym);
 834   return (XTYPE (value) == Lisp_Void || EQ (value, Qunbound)
 835           ? Qnil : Qt);
 836 }
 837
 838 DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0,
 839   "Return SYMBOL's default value.\n\
 840 This is the value that is seen in buffers that do not have their own values\n\
 841 for this variable.  The default value is meaningful for variables with\n\
 842 local bindings in certain buffers.")
 843   (sym)
 844      Lisp_Object sym;
 845 {
 846   register Lisp_Object value;
 847
 848   value = default_value (sym);
 849   if (XTYPE (value) == Lisp_Void || EQ (value, Qunbound))
 850     return Fsignal (Qvoid_variable, Fcons (sym, Qnil));
 851   return value;
 852 }
 853
 854 DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
 855   "Set SYMBOL's default value to VAL.  SYMBOL and VAL are evaluated.\n\
 856 The default value is seen in buffers that do not have their own values\n\
 857 for this variable.")
 858   (sym, value)
 859      Lisp_Object sym, value;
 860 {
 861   register Lisp_Object valcontents, current_alist_element, alist_element_buffer;
 862
 863   CHECK_SYMBOL (sym, 0);
 864   valcontents = XSYMBOL (sym)->value;
 865
 866   /* Handle variables like case-fold-search that have special slots
 867      in the buffer.  Make them work apparently like Lisp_Buffer_Local_Value
 868      variables.  */
 869   if (XTYPE (valcontents) == Lisp_Buffer_Objfwd)
 870     {
 871       register int idx = XUINT (valcontents);
 872 #ifndef RTPC_REGISTER_BUG
 873       register struct buffer *b;
 874 #else
 875       struct buffer *b;
 876 #endif
 877       register int mask = *(int *) (idx + (char *) &buffer_local_flags);
 878
 879       if (mask > 0)
 880         {
 881           *(Lisp_Object *)(idx + (char *) &buffer_defaults) = value;
 882           for (b = all_buffers; b; b = b->next)
 883             if (!(b->local_var_flags & mask))
 884               *(Lisp_Object *)(idx + (char *) b) = value;
 885         }
 886       return value;
 887     }
 888
 889   if (XTYPE (valcontents) != Lisp_Buffer_Local_Value &&
 890       XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
 891     return Fset (sym, value);
 892
 893   /* Store new value into the DEFAULT-VALUE slot */
 894   XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->cdr = value;
 895
 896   /* If that slot is current, we must set the REALVALUE slot too */
 897   current_alist_element = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car;
 898   alist_element_buffer = Fcar (current_alist_element);
 899   if (EQ (alist_element_buffer, current_alist_element))
 900     store_symval_forwarding (sym, XCONS (valcontents)->car, value);
 901
 902   return value;
 903 }
 904
 905 DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0,
 906        "\
 907 (setq-default SYM VAL SYM VAL ...): set each SYM's default value to its VAL.\n\
 908 VAL is evaluated; SYM is not.  The default value is seen in buffers that do\n\
 909 not have their own values for this variable.")
 910   (args)
 911      Lisp_Object args;
 912 {
 913   register Lisp_Object args_left;
 914   register Lisp_Object val, sym;
 915   struct gcpro gcpro1;
 916
 917   if (NULL (args))
 918     return Qnil;
 919
 920   args_left = args;
 921   GCPRO1 (args);
 922
 923   do
 924     {
 925       val = Feval (Fcar (Fcdr (args_left)));
 926       sym = Fcar (args_left);
 927       Fset_default (sym, val);
 928       args_left = Fcdr (Fcdr (args_left));
 929     }
 930   while (!NULL (args_left));
 931
 932   UNGCPRO;
 933   return val;
 934 }
 935 \f
 936 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local,
 937   1, 1, "vMake Variable Buffer Local: ",
 938   "Make VARIABLE have a separate value for each buffer.\n\
 939 At any time, the value for the current buffer is in effect.\n\
 940 There is also a default value which is seen in any buffer which has not yet\n\
 941 set its own value.\n\
 942 Using `set' or `setq' to set the variable causes it to have a separate value\n\
 943 for the current buffer if it was previously using the default value.\n\
 944 The function `default-value' gets the default value and `set-default' sets it.")
 945   (sym)
 946      register Lisp_Object sym;
 947 {
 948   register Lisp_Object tem, valcontents;
 949
 950   CHECK_SYMBOL (sym, 0);
 951
 952   if (EQ (sym, Qnil) || EQ (sym, Qt))
 953     error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data);
 954
 955   valcontents = XSYMBOL (sym)->value;
 956   if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value) ||
 957       (XTYPE (valcontents) == Lisp_Buffer_Objfwd))
 958     return sym;
 959   if (XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
 960     {
 961       XSETTYPE (XSYMBOL (sym)->value, Lisp_Buffer_Local_Value);
 962       return sym;
 963     }
 964   if (EQ (valcontents, Qunbound))
 965     XSYMBOL (sym)->value = Qnil;
 966   tem = Fcons (Qnil, Fsymbol_value (sym));
 967   XCONS (tem)->car = tem;
 968   XSYMBOL (sym)->value = Fcons (XSYMBOL (sym)->value, Fcons (Fcurrent_buffer (), tem));
 969   XSETTYPE (XSYMBOL (sym)->value, Lisp_Buffer_Local_Value);
 970   return sym;
 971 }
 972
 973 DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
 974   1, 1, "vMake Local Variable: ",
 975   "Make VARIABLE have a separate value in the current buffer.\n\
 976 Other buffers will continue to share a common default value.\n\
 977 See also `make-variable-buffer-local'.\n\n\
 978 If the variable is already arranged to become local when set,\n\
 979 this function causes a local value to exist for this buffer,\n\
 980 just as if the variable were set.")
 981   (sym)
 982      register Lisp_Object sym;
 983 {
 984   register Lisp_Object tem, valcontents;
 985
 986   CHECK_SYMBOL (sym, 0);
 987
 988   if (EQ (sym, Qnil) || EQ (sym, Qt))
 989     error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data);
 990
 991   valcontents = XSYMBOL (sym)->value;
 992   if (XTYPE (valcontents) == Lisp_Buffer_Local_Value
 993       || XTYPE (valcontents) == Lisp_Buffer_Objfwd)
 994     {
 995       tem = Fboundp (sym);
 996
 997       /* Make sure the symbol has a local value in this particular buffer,
 998          by setting it to the same value it already has.  */
 999       Fset (sym, (EQ (tem, Qt) ? Fsymbol_value (sym) : Qunbound));
1000       return sym;
1001     }
1002   /* Make sure sym is set up to hold per-buffer values */
1003   if (XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
1004     {
1005       if (EQ (valcontents, Qunbound))
1006         XSYMBOL (sym)->value = Qnil;
1007       tem = Fcons (Qnil, do_symval_forwarding (valcontents));
1008       XCONS (tem)->car = tem;
1009       XSYMBOL (sym)->value = Fcons (XSYMBOL (sym)->value, Fcons (Qnil, tem));
1010       XSETTYPE (XSYMBOL (sym)->value, Lisp_Some_Buffer_Local_Value);
1011     }
1012   /* Make sure this buffer has its own value of sym */
1013   tem = Fassq (sym, current_buffer->local_var_alist);
1014   if (NULL (tem))
1015     {
1016       current_buffer->local_var_alist
1017         = Fcons (Fcons (sym, XCONS (XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->cdr)->cdr),
1018                  current_buffer->local_var_alist);
1019
1020       /* Make sure symbol does not think it is set up for this buffer;
1021          force it to look once again for this buffer's value */
1022       {
1023         /* This local variable avoids "expression too complex" on IBM RT.  */
1024         Lisp_Object xs;
1025
1026         xs = XSYMBOL (sym)->value;
1027         if (current_buffer == XBUFFER (XCONS (XCONS (xs)->cdr)->car))
1028           XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car = Qnil;
1029       }
1030
1031     }
1032   return sym;
1033 }
1034
1035 DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
1036   1, 1, "vKill Local Variable: ",
1037   "Make VARIABLE no longer have a separate value in the current buffer.\n\
1038 From now on the default value will apply in this buffer.")
1039   (sym)
1040      register Lisp_Object sym;
1041 {
1042   register Lisp_Object tem, valcontents;
1043
1044   CHECK_SYMBOL (sym, 0);
1045
1046   valcontents = XSYMBOL (sym)->value;
1047
1048   if (XTYPE (valcontents) == Lisp_Buffer_Objfwd)
1049     {
1050       register int idx = XUINT (valcontents);
1051       register int mask = *(int *) (idx + (char *) &buffer_local_flags);
1052
1053       if (mask > 0)
1054         {
1055           *(Lisp_Object *)(idx + (char *) current_buffer)
1056             = *(Lisp_Object *)(idx + (char *) &buffer_defaults);
1057           current_buffer->local_var_flags &= ~mask;
1058         }
1059       return sym;
1060     }
1061
1062   if (XTYPE (valcontents) != Lisp_Buffer_Local_Value &&
1063       XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
1064     return sym;
1065
1066   /* Get rid of this buffer's alist element, if any */
1067
1068   tem = Fassq (sym, current_buffer->local_var_alist);
1069   if (!NULL (tem))
1070     current_buffer->local_var_alist = Fdelq (tem, current_buffer->local_var_alist);
1071
1072   /* Make sure symbol does not think it is set up for this buffer;
1073      force it to look once again for this buffer's value */
1074   {
1075     Lisp_Object sv;
1076     sv = XSYMBOL (sym)->value;
1077     if (current_buffer == XBUFFER (XCONS (XCONS (sv)->cdr)->car))
1078       XCONS (XCONS (sv)->cdr)->car = Qnil;
1079   }
1080
1081   return sym;
1082 }
1083 \f
1084 /* Extract and set vector and string elements */
1085
1086 DEFUN ("aref", Faref, Saref, 2, 2, 0,
1087   "Return the element of ARRAY at index INDEX.\n\
1088 ARRAY may be a vector or a string, or a byte-code object.  INDEX starts at 0.")
1089   (array, idx)
1090      register Lisp_Object array;
1091      Lisp_Object idx;
1092 {
1093   register int idxval;
1094
1095   CHECK_NUMBER (idx, 1);
1096   idxval = XINT (idx);
1097   if (XTYPE (array) != Lisp_Vector && XTYPE (array) != Lisp_String
1098       && XTYPE (array) != Lisp_Compiled)
1099     array = wrong_type_argument (Qarrayp, array);
1100   if (idxval < 0 || idxval >= XVECTOR (array)->size)
1101     args_out_of_range (array, idx);
1102   if (XTYPE (array) == Lisp_String)
1103     {
1104       Lisp_Object val;
1105       XFASTINT (val) = (unsigned char) XSTRING (array)->data[idxval];
1106       return val;
1107     }
1108   else
1109     return XVECTOR (array)->contents[idxval];
1110 }
1111
1112 DEFUN ("aset", Faset, Saset, 3, 3, 0,
1113   "Store into the element of ARRAY at index INDEX the value NEWVAL.\n\
1114 ARRAY may be a vector or a string.  INDEX starts at 0.")
1115   (array, idx, newelt)
1116      register Lisp_Object array;
1117      Lisp_Object idx, newelt;
1118 {
1119   register int idxval;
1120
1121   CHECK_NUMBER (idx, 1);
1122   idxval = XINT (idx);
1123   if (XTYPE (array) != Lisp_Vector && XTYPE (array) != Lisp_String)
1124     array = wrong_type_argument (Qarrayp, array);
1125   if (idxval < 0 || idxval >= XVECTOR (array)->size)
1126     args_out_of_range (array, idx);
1127   CHECK_IMPURE (array);
1128
1129   if (XTYPE (array) == Lisp_Vector)
1130     XVECTOR (array)->contents[idxval] = newelt;
1131   else
1132     {
1133       CHECK_NUMBER (newelt, 2);
1134       XSTRING (array)->data[idxval] = XINT (newelt);
1135     }
1136
1137   return newelt;
1138 }
1139
1140 Lisp_Object
1141 Farray_length (array)
1142      register Lisp_Object array;
1143 {
1144   register Lisp_Object size;
1145   if (XTYPE (array) != Lisp_Vector && XTYPE (array) != Lisp_String
1146       && XTYPE (array) != Lisp_Compiled)
1147     array = wrong_type_argument (Qarrayp, array);
1148   XFASTINT (size) = XVECTOR (array)->size;
1149   return size;
1150 }
1151 \f
1152 /* Arithmetic functions */
1153
1154 enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal };
1155
1156 Lisp_Object
1157 arithcompare (num1, num2, comparison)
1158      Lisp_Object num1, num2;
1159      enum comparison comparison;
1160 {
1161   double f1, f2;
1162   int floatp = 0;
1163
1164 #ifdef LISP_FLOAT_TYPE
1165   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0);
1166   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0);
1167
1168   if (XTYPE (num1) == Lisp_Float || XTYPE (num2) == Lisp_Float)
1169     {
1170       floatp = 1;
1171       f1 = (XTYPE (num1) == Lisp_Float) ? XFLOAT (num1)->data : XINT (num1);
1172       f2 = (XTYPE (num2) == Lisp_Float) ? XFLOAT (num2)->data : XINT (num2);
1173     }
1174 #else
1175   CHECK_NUMBER_COERCE_MARKER (num1, 0);
1176   CHECK_NUMBER_COERCE_MARKER (num2, 0);
1177 #endif /* LISP_FLOAT_TYPE */
1178
1179   switch (comparison)
1180     {
1181     case equal:
1182       if (floatp ? f1 == f2 : XINT (num1) == XINT (num2))
1183         return Qt;
1184       return Qnil;
1185
1186     case notequal:
1187       if (floatp ? f1 != f2 : XINT (num1) != XINT (num2))
1188         return Qt;
1189       return Qnil;
1190
1191     case less:
1192       if (floatp ? f1 < f2 : XINT (num1) < XINT (num2))
1193         return Qt;
1194       return Qnil;
1195
1196     case less_or_equal:
1197       if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2))
1198         return Qt;
1199       return Qnil;
1200
1201     case grtr:
1202       if (floatp ? f1 > f2 : XINT (num1) > XINT (num2))
1203         return Qt;
1204       return Qnil;
1205
1206     case grtr_or_equal:
1207       if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2))
1208         return Qt;
1209       return Qnil;
1210     }
1211 }
1212
1213 DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0,
1214   "T if two args, both numbers or markers, are equal.")
1215   (num1, num2)
1216      register Lisp_Object num1, num2;
1217 {
1218   return arithcompare (num1, num2, equal);
1219 }
1220
1221 DEFUN ("<", Flss, Slss, 2, 2, 0,
1222   "T if first arg is less than second arg.  Both must be numbers or markers.")
1223   (num1, num2)
1224      register Lisp_Object num1, num2;
1225 {
1226   return arithcompare (num1, num2, less);
1227 }
1228
1229 DEFUN (">", Fgtr, Sgtr, 2, 2, 0,
1230   "T if first arg is greater than second arg.  Both must be numbers or markers.")
1231   (num1, num2)
1232      register Lisp_Object num1, num2;
1233 {
1234   return arithcompare (num1, num2, grtr);
1235 }
1236
1237 DEFUN ("<=", Fleq, Sleq, 2, 2, 0,
1238   "T if first arg is less than or equal to second arg.\n\
1239 Both must be numbers or markers.")
1240   (num1, num2)
1241      register Lisp_Object num1, num2;
1242 {
1243   return arithcompare (num1, num2, less_or_equal);
1244 }
1245
1246 DEFUN (">=", Fgeq, Sgeq, 2, 2, 0,
1247   "T if first arg is greater than or equal to second arg.\n\
1248 Both must be numbers or markers.")
1249   (num1, num2)
1250      register Lisp_Object num1, num2;
1251 {
1252   return arithcompare (num1, num2, grtr_or_equal);
1253 }
1254
1255 DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
1256   "T if first arg is not equal to second arg.  Both must be numbers or markers.")
1257   (num1, num2)
1258      register Lisp_Object num1, num2;
1259 {
1260   return arithcompare (num1, num2, notequal);
1261 }
1262
1263 DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, "T if NUMBER is zero.")
1264   (num)
1265      register Lisp_Object num;
1266 {
1267 #ifdef LISP_FLOAT_TYPE
1268   CHECK_NUMBER_OR_FLOAT (num, 0);
1269
1270   if (XTYPE(num) == Lisp_Float)
1271     {
1272       if (XFLOAT(num)->data == 0.0)
1273         return Qt;
1274       return Qnil;
1275     }
1276 #else
1277   CHECK_NUMBER (num, 0);
1278 #endif /* LISP_FLOAT_TYPE */
1279
1280   if (!XINT (num))
1281     return Qt;
1282   return Qnil;
1283 }
1284 \f
1285 DEFUN ("int-to-string", Fint_to_string, Sint_to_string, 1, 1, 0,
1286   "Convert INT to a string by printing it in decimal.\n\
1287 Uses a minus sign if negative.")
1288   (num)
1289      Lisp_Object num;
1290 {
1291   char buffer[20];
1292
1293 #ifndef LISP_FLOAT_TYPE
1294   CHECK_NUMBER (num, 0);
1295 #else
1296   CHECK_NUMBER_OR_FLOAT (num, 0);
1297
1298   if (XTYPE(num) == Lisp_Float)
1299     {
1300       char pigbuf[350]; /* see comments in float_to_string */
1301
1302       float_to_string (pigbuf, XFLOAT(num)->data);
1303       return build_string (pigbuf);
1304     }
1305 #endif /* LISP_FLOAT_TYPE */
1306
1307   sprintf (buffer, "%d", XINT (num));
1308   return build_string (buffer);
1309 }
1310
1311 DEFUN ("string-to-int", Fstring_to_int, Sstring_to_int, 1, 1, 0,
1312   "Convert STRING to an integer by parsing it as a decimal number.")
1313   (str)
1314      register Lisp_Object str;
1315 {
1316   CHECK_STRING (str, 0);
1317
1318 #ifdef LISP_FLOAT_TYPE
1319   if (isfloat_string (XSTRING (str)->data))
1320     return make_float (atof (XSTRING (str)->data));
1321 #endif /* LISP_FLOAT_TYPE */
1322
1323   return make_number (atoi (XSTRING (str)->data));
1324 }
1325 \f
1326 enum arithop
1327   { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin };
1328
1329 Lisp_Object
1330 arith_driver
1331   (code, nargs, args)
1332      enum arithop code;
1333      int nargs;
1334      register Lisp_Object *args;
1335 {
1336   register Lisp_Object val;
1337   register int argnum;
1338   register int accum;
1339   register int next;
1340
1341 #ifdef SWITCH_ENUM_BUG
1342   switch ((int) code)
1343 #else
1344   switch (code)
1345 #endif
1346     {
1347     case Alogior:
1348     case Alogxor:
1349     case Aadd:
1350     case Asub:
1351       accum = 0; break;
1352     case Amult:
1353       accum = 1; break;
1354     case Alogand:
1355       accum = -1; break;
1356     }
1357
1358   for (argnum = 0; argnum < nargs; argnum++)
1359     {
1360       val = args[argnum];    /* using args[argnum] as argument to CHECK_NUMBER_... */
1361 #ifdef LISP_FLOAT_TYPE
1362       CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum);
1363
1364       if (XTYPE (val) == Lisp_Float) /* time to do serious math */
1365         return (float_arith_driver ((double) accum, argnum, code,
1366                                     nargs, args));
1367 #else
1368       CHECK_NUMBER_COERCE_MARKER (val, argnum);
1369 #endif /* LISP_FLOAT_TYPE */
1370       args[argnum] = val;    /* runs into a compiler bug. */
1371       next = XINT (args[argnum]);
1372 #ifdef SWITCH_ENUM_BUG
1373       switch ((int) code)
1374 #else
1375       switch (code)
1376 #endif
1377         {
1378         case Aadd: accum += next; break;
1379         case Asub:
1380           if (!argnum && nargs != 1)
1381             next = - next;
1382           accum -= next;
1383           break;
1384         case Amult: accum *= next; break;
1385         case Adiv:
1386           if (!argnum) accum = next;
1387           else accum /= next;
1388           break;
1389         case Alogand: accum &= next; break;
1390         case Alogior: accum |= next; break;
1391         case Alogxor: accum ^= next; break;
1392         case Amax: if (!argnum || next > accum) accum = next; break;
1393         case Amin: if (!argnum || next < accum) accum = next; break;
1394         }
1395     }
1396
1397   XSET (val, Lisp_Int, accum);
1398   return val;
1399 }
1400
1401 #ifdef LISP_FLOAT_TYPE
1402 Lisp_Object
1403 float_arith_driver (accum, argnum, code, nargs, args)
1404      double accum;
1405      register int argnum;
1406      enum arithop code;
1407      int nargs;
1408      register Lisp_Object *args;
1409 {
1410   register Lisp_Object val;
1411   double next;
1412
1413   for (; argnum < nargs; argnum++)
1414     {
1415       val = args[argnum];    /* using args[argnum] as argument to CHECK_NUMBER_... */
1416       CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum);
1417
1418       if (XTYPE (val) == Lisp_Float)
1419         {
1420           next = XFLOAT (val)->data;
1421         }
1422       else
1423         {
1424           args[argnum] = val;    /* runs into a compiler bug. */
1425           next = XINT (args[argnum]);
1426         }
1427 #ifdef SWITCH_ENUM_BUG
1428       switch ((int) code)
1429 #else
1430       switch (code)
1431 #endif
1432         {
1433         case Aadd:
1434           accum += next;
1435           break;
1436         case Asub:
1437           if (!argnum && nargs != 1)
1438             next = - next;
1439           accum -= next;
1440           break;
1441         case Amult:
1442           accum *= next;
1443           break;
1444         case Adiv:
1445           if (!argnum)
1446             accum = next;
1447           else
1448             accum /= next;
1449           break;
1450         case Alogand:
1451         case Alogior:
1452         case Alogxor:
1453           return wrong_type_argument (Qinteger_or_marker_p, val);
1454         case Amax:
1455           if (!argnum || next > accum)
1456             accum = next;
1457           break;
1458         case Amin:
1459           if (!argnum || next < accum)
1460             accum = next;
1461           break;
1462         }
1463     }
1464
1465   return make_float (accum);
1466 }
1467 #endif /* LISP_FLOAT_TYPE */
1468
1469 DEFUN ("+", Fplus, Splus, 0, MANY, 0,
1470   "Return sum of any number of arguments, which are numbers or markers.")
1471   (nargs, args)
1472      int nargs;
1473      Lisp_Object *args;
1474 {
1475   return arith_driver (Aadd, nargs, args);
1476 }
1477
1478 DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
1479   "Negate number or subtract numbers or markers.\n\
1480 With one arg, negates it.  With more than one arg,\n\
1481 subtracts all but the first from the first.")
1482   (nargs, args)
1483      int nargs;
1484      Lisp_Object *args;
1485 {
1486   return arith_driver (Asub, nargs, args);
1487 }
1488
1489 DEFUN ("*", Ftimes, Stimes, 0, MANY, 0,
1490   "Returns product of any number of arguments, which are numbers or markers.")
1491   (nargs, args)
1492      int nargs;
1493      Lisp_Object *args;
1494 {
1495   return arith_driver (Amult, nargs, args);
1496 }
1497
1498 DEFUN ("/", Fquo, Squo, 2, MANY, 0,
1499   "Returns first argument divided by all the remaining arguments.\n\
1500 The arguments must be numbers or markers.")
1501   (nargs, args)
1502      int nargs;
1503      Lisp_Object *args;
1504 {
1505   return arith_driver (Adiv, nargs, args);
1506 }
1507
1508 DEFUN ("%", Frem, Srem, 2, 2, 0,
1509   "Returns remainder of first arg divided by second.\n\
1510 Both must be numbers or markers.")
1511   (num1, num2)
1512      register Lisp_Object num1, num2;
1513 {
1514   Lisp_Object val;
1515
1516 #ifdef LISP_FLOAT_TYPE
1517   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0);
1518   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0);
1519
1520   if (XTYPE (num1) == Lisp_Float || XTYPE (num2) == Lisp_Float)
1521     {
1522       double f1, f2;
1523
1524       f1 = XTYPE (num1) == Lisp_Float ? XFLOAT (num1)->data : XINT (num1);
1525       f2 = XTYPE (num2) == Lisp_Float ? XFLOAT (num2)->data : XINT (num2);
1526       return (make_float (drem (f1,f2)));
1527     }
1528 #else /* not LISP_FLOAT_TYPE */
1529   CHECK_NUMBER_COERCE_MARKER (num1, 0);
1530   CHECK_NUMBER_COERCE_MARKER (num2, 1);
1531 #endif /* not LISP_FLOAT_TYPE */
1532
1533   XSET (val, Lisp_Int, XINT (num1) % XINT (num2));
1534   return val;
1535 }
1536
1537 DEFUN ("max", Fmax, Smax, 1, MANY, 0,
1538   "Return largest of all the arguments (which must be numbers or markers).\n\
1539 The value is always a number; markers are converted to numbers.")
1540   (nargs, args)
1541      int nargs;
1542      Lisp_Object *args;
1543 {
1544   return arith_driver (Amax, nargs, args);
1545 }
1546
1547 DEFUN ("min", Fmin, Smin, 1, MANY, 0,
1548   "Return smallest of all the arguments (which must be numbers or markers).\n\
1549 The value is always a number; markers are converted to numbers.")
1550   (nargs, args)
1551      int nargs;
1552      Lisp_Object *args;
1553 {
1554   return arith_driver (Amin, nargs, args);
1555 }
1556
1557 DEFUN ("logand", Flogand, Slogand, 0, MANY, 0,
1558   "Return bitwise-and of all the arguments.\n\
1559 Arguments may be integers, or markers converted to integers.")
1560   (nargs, args)
1561      int nargs;
1562      Lisp_Object *args;
1563 {
1564   return arith_driver (Alogand, nargs, args);
1565 }
1566
1567 DEFUN ("logior", Flogior, Slogior, 0, MANY, 0,
1568   "Return bitwise-or of all the arguments.\n\
1569 Arguments may be integers, or markers converted to integers.")
1570   (nargs, args)
1571      int nargs;
1572      Lisp_Object *args;
1573 {
1574   return arith_driver (Alogior, nargs, args);
1575 }
1576
1577 DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0,
1578   "Return bitwise-exclusive-or of all the arguments.\n\
1579 Arguments may be integers, or markers converted to integers.")
1580   (nargs, args)
1581      int nargs;
1582      Lisp_Object *args;
1583 {
1584   return arith_driver (Alogxor, nargs, args);
1585 }
1586
1587 DEFUN ("ash", Fash, Sash, 2, 2, 0,
1588   "Return VALUE with its bits shifted left by COUNT.\n\
1589 If COUNT is negative, shifting is actually to the right.\n\
1590 In this case, the sign bit is duplicated.")
1591   (num1, num2)
1592      register Lisp_Object num1, num2;
1593 {
1594   register Lisp_Object val;
1595
1596   CHECK_NUMBER (num1, 0);
1597   CHECK_NUMBER (num2, 1);
1598
1599   if (XINT (num2) > 0)
1600     XSET (val, Lisp_Int, XINT (num1) << XFASTINT (num2));
1601   else
1602     XSET (val, Lisp_Int, XINT (num1) >> -XINT (num2));
1603   return val;
1604 }
1605
1606 DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,
1607   "Return VALUE with its bits shifted left by COUNT.\n\
1608 If COUNT is negative, shifting is actually to the right.\n\
1609 In this case,  zeros are shifted in on the left.")
1610   (num1, num2)
1611      register Lisp_Object num1, num2;
1612 {
1613   register Lisp_Object val;
1614
1615   CHECK_NUMBER (num1, 0);
1616   CHECK_NUMBER (num2, 1);
1617
1618   if (XINT (num2) > 0)
1619     XSET (val, Lisp_Int, (unsigned) XFASTINT (num1) << XFASTINT (num2));
1620   else
1621     XSET (val, Lisp_Int, (unsigned) XFASTINT (num1) >> -XINT (num2));
1622   return val;
1623 }
1624
1625 DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
1626   "Return NUMBER plus one.  NUMBER may be a number or a marker.\n\
1627 Markers are converted to integers.")
1628   (num)
1629      register Lisp_Object num;
1630 {
1631 #ifdef LISP_FLOAT_TYPE
1632   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num, 0);
1633
1634   if (XTYPE (num) == Lisp_Float)
1635     return (make_float (1.0 + XFLOAT (num)->data));
1636 #else
1637   CHECK_NUMBER_COERCE_MARKER (num, 0);
1638 #endif /* LISP_FLOAT_TYPE */
1639
1640   XSETINT (num, XFASTINT (num) + 1);
1641   return num;
1642 }
1643
1644 DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
1645   "Return NUMBER minus one.  NUMBER may be a number or a marker.\n\
1646 Markers are converted to integers.")
1647   (num)
1648      register Lisp_Object num;
1649 {
1650 #ifdef LISP_FLOAT_TYPE
1651   CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num, 0);
1652
1653   if (XTYPE (num) == Lisp_Float)
1654     return (make_float (-1.0 + XFLOAT (num)->data));
1655 #else
1656   CHECK_NUMBER_COERCE_MARKER (num, 0);
1657 #endif /* LISP_FLOAT_TYPE */
1658
1659   XSETINT (num, XFASTINT (num) - 1);
1660   return num;
1661 }
1662
1663 DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
1664   "Return the bitwise complement of ARG.  ARG must be an integer.")
1665   (num)
1666      register Lisp_Object num;
1667 {
1668   CHECK_NUMBER (num, 0);
1669   XSETINT (num, ~XFASTINT (num));
1670   return num;
1671 }
1672 \f
1673 void
1674 syms_of_data ()
1675 {
1676   Qquote = intern ("quote");
1677   Qlambda = intern ("lambda");
1678   Qsubr = intern ("subr");
1679   Qerror_conditions = intern ("error-conditions");
1680   Qerror_message = intern ("error-message");
1681   Qtop_level = intern ("top-level");
1682
1683   Qerror = intern ("error");
1684   Qquit = intern ("quit");
1685   Qwrong_type_argument = intern ("wrong-type-argument");
1686   Qargs_out_of_range = intern ("args-out-of-range");
1687   Qvoid_function = intern ("void-function");
1688   Qvoid_variable = intern ("void-variable");
1689   Qsetting_constant = intern ("setting-constant");
1690   Qinvalid_read_syntax = intern ("invalid-read-syntax");
1691
1692   Qinvalid_function = intern ("invalid-function");
1693   Qwrong_number_of_arguments = intern ("wrong-number-of-arguments");
1694   Qno_catch = intern ("no-catch");
1695   Qend_of_file = intern ("end-of-file");
1696   Qarith_error = intern ("arith-error");
1697   Qbeginning_of_buffer = intern ("beginning-of-buffer");
1698   Qend_of_buffer = intern ("end-of-buffer");
1699   Qbuffer_read_only = intern ("buffer-read-only");
1700
1701   Qlistp = intern ("listp");
1702   Qconsp = intern ("consp");
1703   Qsymbolp = intern ("symbolp");
1704   Qintegerp = intern ("integerp");
1705   Qnatnump = intern ("natnump");
1706   Qstringp = intern ("stringp");
1707   Qarrayp = intern ("arrayp");
1708   Qsequencep = intern ("sequencep");
1709   Qbufferp = intern ("bufferp");
1710   Qvectorp = intern ("vectorp");
1711   Qchar_or_string_p = intern ("char-or-string-p");
1712   Qmarkerp = intern ("markerp");
1713   Qinteger_or_marker_p = intern ("integer-or-marker-p");
1714   Qboundp = intern ("boundp");
1715   Qfboundp = intern ("fboundp");
1716
1717 #ifdef LISP_FLOAT_TYPE
1718   Qfloatp = intern ("floatp");
1719   Qnumberp = intern ("numberp");
1720   Qnumber_or_marker_p = intern ("number-or-marker-p");
1721 #endif /* LISP_FLOAT_TYPE */
1722
1723   Qcdr = intern ("cdr");
1724
1725   /* ERROR is used as a signaler for random errors for which nothing else is right */
1726
1727   Fput (Qerror, Qerror_conditions,
1728         Fcons (Qerror, Qnil));
1729   Fput (Qerror, Qerror_message,
1730         build_string ("error"));
1731
1732   Fput (Qquit, Qerror_conditions,
1733         Fcons (Qquit, Qnil));
1734   Fput (Qquit, Qerror_message,
1735         build_string ("Quit"));
1736
1737   Fput (Qwrong_type_argument, Qerror_conditions,
1738         Fcons (Qwrong_type_argument, Fcons (Qerror, Qnil)));
1739   Fput (Qwrong_type_argument, Qerror_message,
1740         build_string ("Wrong type argument"));
1741
1742   Fput (Qargs_out_of_range, Qerror_conditions,
1743         Fcons (Qargs_out_of_range, Fcons (Qerror, Qnil)));
1744   Fput (Qargs_out_of_range, Qerror_message,
1745         build_string ("Args out of range"));
1746
1747   Fput (Qvoid_function, Qerror_conditions,
1748         Fcons (Qvoid_function, Fcons (Qerror, Qnil)));
1749   Fput (Qvoid_function, Qerror_message,
1750         build_string ("Symbol's function definition is void"));
1751
1752   Fput (Qvoid_variable, Qerror_conditions,
1753         Fcons (Qvoid_variable, Fcons (Qerror, Qnil)));
1754   Fput (Qvoid_variable, Qerror_message,
1755         build_string ("Symbol's value as variable is void"));
1756
1757   Fput (Qsetting_constant, Qerror_conditions,
1758         Fcons (Qsetting_constant, Fcons (Qerror, Qnil)));
1759   Fput (Qsetting_constant, Qerror_message,
1760         build_string ("Attempt to set a constant symbol"));
1761
1762   Fput (Qinvalid_read_syntax, Qerror_conditions,
1763         Fcons (Qinvalid_read_syntax, Fcons (Qerror, Qnil)));
1764   Fput (Qinvalid_read_syntax, Qerror_message,
1765         build_string ("Invalid read syntax"));
1766
1767   Fput (Qinvalid_function, Qerror_conditions,
1768         Fcons (Qinvalid_function, Fcons (Qerror, Qnil)));
1769   Fput (Qinvalid_function, Qerror_message,
1770         build_string ("Invalid function"));
1771
1772   Fput (Qwrong_number_of_arguments, Qerror_conditions,
1773         Fcons (Qwrong_number_of_arguments, Fcons (Qerror, Qnil)));
1774   Fput (Qwrong_number_of_arguments, Qerror_message,
1775         build_string ("Wrong number of arguments"));
1776
1777   Fput (Qno_catch, Qerror_conditions,
1778         Fcons (Qno_catch, Fcons (Qerror, Qnil)));
1779   Fput (Qno_catch, Qerror_message,
1780         build_string ("No catch for tag"));
1781
1782   Fput (Qend_of_file, Qerror_conditions,
1783         Fcons (Qend_of_file, Fcons (Qerror, Qnil)));
1784   Fput (Qend_of_file, Qerror_message,
1785         build_string ("End of file during parsing"));
1786
1787   Fput (Qarith_error, Qerror_conditions,
1788         Fcons (Qarith_error, Fcons (Qerror, Qnil)));
1789   Fput (Qarith_error, Qerror_message,
1790         build_string ("Arithmetic error"));
1791
1792   Fput (Qbeginning_of_buffer, Qerror_conditions,
1793         Fcons (Qbeginning_of_buffer, Fcons (Qerror, Qnil)));
1794   Fput (Qbeginning_of_buffer, Qerror_message,
1795         build_string ("Beginning of buffer"));
1796
1797   Fput (Qend_of_buffer, Qerror_conditions,
1798         Fcons (Qend_of_buffer, Fcons (Qerror, Qnil)));
1799   Fput (Qend_of_buffer, Qerror_message,
1800         build_string ("End of buffer"));
1801
1802   Fput (Qbuffer_read_only, Qerror_conditions,
1803         Fcons (Qbuffer_read_only, Fcons (Qerror, Qnil)));
1804   Fput (Qbuffer_read_only, Qerror_message,
1805         build_string ("Buffer is read-only"));
1806
1807   staticpro (&Qnil);
1808   staticpro (&Qt);
1809   staticpro (&Qquote);
1810   staticpro (&Qlambda);
1811   staticpro (&Qsubr);
1812   staticpro (&Qunbound);
1813   staticpro (&Qerror_conditions);
1814   staticpro (&Qerror_message);
1815   staticpro (&Qtop_level);
1816
1817   staticpro (&Qerror);
1818   staticpro (&Qquit);
1819   staticpro (&Qwrong_type_argument);
1820   staticpro (&Qargs_out_of_range);
1821   staticpro (&Qvoid_function);
1822   staticpro (&Qvoid_variable);
1823   staticpro (&Qsetting_constant);
1824   staticpro (&Qinvalid_read_syntax);
1825   staticpro (&Qwrong_number_of_arguments);
1826   staticpro (&Qinvalid_function);
1827   staticpro (&Qno_catch);
1828   staticpro (&Qend_of_file);
1829   staticpro (&Qarith_error);
1830   staticpro (&Qbeginning_of_buffer);
1831   staticpro (&Qend_of_buffer);
1832   staticpro (&Qbuffer_read_only);
1833
1834   staticpro (&Qlistp);
1835   staticpro (&Qconsp);
1836   staticpro (&Qsymbolp);
1837   staticpro (&Qintegerp);
1838   staticpro (&Qnatnump);
1839   staticpro (&Qstringp);
1840   staticpro (&Qarrayp);
1841   staticpro (&Qsequencep);
1842   staticpro (&Qbufferp);
1843   staticpro (&Qvectorp);
1844   staticpro (&Qchar_or_string_p);
1845   staticpro (&Qmarkerp);
1846   staticpro (&Qinteger_or_marker_p);
1847 #ifdef LISP_FLOAT_TYPE
1848   staticpro (&Qfloatp);
1849   staticpro (&Qinteger_or_floatp);
1850   staticpro (&Qinteger_or_float_or_marker_p);
1851 #endif /* LISP_FLOAT_TYPE */
1852
1853   staticpro (&Qboundp);
1854   staticpro (&Qfboundp);
1855   staticpro (&Qcdr);
1856
1857   defsubr (&Seq);
1858   defsubr (&Snull);
1859   defsubr (&Slistp);
1860   defsubr (&Snlistp);
1861   defsubr (&Sconsp);
1862   defsubr (&Satom);
1863   defsubr (&Sintegerp);
1864 #ifdef LISP_FLOAT_TYPE
1865   defsubr (&Sfloatp);
1866   defsubr (&Snumberp);
1867   defsubr (&Snumber_or_marker_p);
1868 #endif /* LISP_FLOAT_TYPE */
1869   defsubr (&Snatnump);
1870   defsubr (&Ssymbolp);
1871   defsubr (&Sstringp);
1872   defsubr (&Svectorp);
1873   defsubr (&Sarrayp);
1874   defsubr (&Ssequencep);
1875   defsubr (&Sbufferp);
1876   defsubr (&Smarkerp);
1877   defsubr (&Sinteger_or_marker_p);
1878   defsubr (&Ssubrp);
1879   defsubr (&Scompiled_function_p);
1880   defsubr (&Schar_or_string_p);
1881   defsubr (&Scar);
1882   defsubr (&Scdr);
1883   defsubr (&Scar_safe);
1884   defsubr (&Scdr_safe);
1885   defsubr (&Ssetcar);
1886   defsubr (&Ssetcdr);
1887   defsubr (&Ssymbol_function);
1888   defsubr (&Ssymbol_plist);
1889   defsubr (&Ssymbol_name);
1890   defsubr (&Smakunbound);
1891   defsubr (&Sfmakunbound);
1892   defsubr (&Sboundp);
1893   defsubr (&Sfboundp);
1894   defsubr (&Sfset);
1895   defsubr (&Ssetplist);
1896   defsubr (&Ssymbol_value);
1897   defsubr (&Sset);
1898   defsubr (&Sdefault_boundp);
1899   defsubr (&Sdefault_value);
1900   defsubr (&Sset_default);
1901   defsubr (&Ssetq_default);
1902   defsubr (&Smake_variable_buffer_local);
1903   defsubr (&Smake_local_variable);
1904   defsubr (&Skill_local_variable);
1905   defsubr (&Saref);
1906   defsubr (&Saset);
1907   defsubr (&Sint_to_string);
1908   defsubr (&Sstring_to_int);
1909   defsubr (&Seqlsign);
1910   defsubr (&Slss);
1911   defsubr (&Sgtr);
1912   defsubr (&Sleq);
1913   defsubr (&Sgeq);
1914   defsubr (&Sneq);
1915   defsubr (&Szerop);
1916   defsubr (&Splus);
1917   defsubr (&Sminus);
1918   defsubr (&Stimes);
1919   defsubr (&Squo);
1920   defsubr (&Srem);
1921   defsubr (&Smax);
1922   defsubr (&Smin);
1923   defsubr (&Slogand);
1924   defsubr (&Slogior);
1925   defsubr (&Slogxor);
1926   defsubr (&Slsh);
1927   defsubr (&Sash);
1928   defsubr (&Sadd1);
1929   defsubr (&Ssub1);
1930   defsubr (&Slognot);
1931 }
1932
1933 arith_error (signo)
1934      int signo;
1935 {
1936 #ifdef USG
1937   /* USG systems forget handlers when they are used;
1938      must reestablish each time */
1939   signal (signo, arith_error);
1940 #endif /* USG */
1941 #ifdef VMS
1942   /* VMS systems are like USG.  */
1943   signal (signo, arith_error);
1944 #endif /* VMS */
1945 #ifdef BSD4_1
1946   sigrelse (SIGFPE);
1947 #else /* not BSD4_1 */
1948   sigsetmask (0);
1949 #endif /* not BSD4_1 */
1950
1951   Fsignal (Qarith_error, Qnil);
1952 }
1953
1954 init_data ()
1955 {
1956   /* Don't do this if just dumping out.
1957      We don't want to call `signal' in this case
1958      so that we don't have trouble with dumping
1959      signal-delivering routines in an inconsistent state.  */
1960 #ifndef CANNOT_DUMP
1961   if (!initialized)
1962     return;
1963 #endif /* CANNOT_DUMP */
1964   signal (SIGFPE, arith_error);
1965 #ifdef uts
1966   signal (SIGEMT, arith_error);
1967 #endif /* uts */
1968 }