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