src/fns.c

   1 /* Random utility Lisp functions.
   2    Copyright (C) 1985, 1986, 1987, 1993 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 <config.h>
  22
  23 /* Note on some machines this defines `vector' as a typedef,
  24    so make sure we don't use that name in this file.  */
  25 #undef vector
  26 #define vector *****
  27
  28 #include "lisp.h"
  29 #include "commands.h"
  30
  31 #include "buffer.h"
  32 #include "keyboard.h"
  33 #include "intervals.h"
  34
  35 Lisp_Object Qstring_lessp, Qprovide, Qrequire;
  36 Lisp_Object Qyes_or_no_p_history;
  37
  38 static Lisp_Object internal_equal ();
  39 \f
  40 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
  41   "Return the argument unchanged.")
  42   (arg)
  43      Lisp_Object arg;
  44 {
  45   return arg;
  46 }
  47
  48 DEFUN ("random", Frandom, Srandom, 0, 1, 0,
  49   "Return a pseudo-random number.\n\
  50 On most systems all integers representable in Lisp are equally likely.\n\
  51   This is 24 bits' worth.\n\
  52 With argument N, return random number in interval [0,N).\n\
  53 With argument t, set the random number seed from the current time and pid.")
  54   (limit)
  55      Lisp_Object limit;
  56 {
  57   int val;
  58   unsigned long denominator;
  59   extern long random ();
  60   extern srandom ();
  61   extern long time ();
  62
  63   if (EQ (limit, Qt))
  64     srandom (getpid () + time (0));
  65   if (XTYPE (limit) == Lisp_Int && XINT (limit) > 0)
  66     {
  67       /* Try to take our random number from the higher bits of VAL,
  68          not the lower, since (says Gentzel) the low bits of `random'
  69          are less random than the higher ones.  We do this by using the
  70          quotient rather than the remainder.  At the high end of the RNG
  71          it's possible to get a quotient larger than limit; discarding
  72          these values eliminates the bias that would otherwise appear
  73          when using a large limit.  */
  74       denominator = (unsigned long)0x80000000 / XFASTINT (limit);
  75       do
  76         val = (random () & 0x7fffffff) / denominator;
  77       while (val >= limit);
  78     }
  79   else
  80     val = random ();
  81   return make_number (val);
  82 }
  83 \f
  84 /* Random data-structure functions */
  85
  86 DEFUN ("length", Flength, Slength, 1, 1, 0,
  87   "Return the length of vector, list or string SEQUENCE.\n\
  88 A byte-code function object is also allowed.")
  89   (obj)
  90      register Lisp_Object obj;
  91 {
  92   register Lisp_Object tail, val;
  93   register int i;
  94
  95  retry:
  96   if (XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String
  97       || XTYPE (obj) == Lisp_Compiled)
  98     return Farray_length (obj);
  99   else if (CONSP (obj))
 100     {
 101       for (i = 0, tail = obj; !NILP(tail); i++)
 102         {
 103           QUIT;
 104           tail = Fcdr (tail);
 105         }
 106
 107       XFASTINT (val) = i;
 108       return val;
 109     }
 110   else if (NILP(obj))
 111     {
 112       XFASTINT (val) = 0;
 113       return val;
 114     }
 115   else
 116     {
 117       obj = wrong_type_argument (Qsequencep, obj);
 118       goto retry;
 119     }
 120 }
 121
 122 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
 123   "T if two strings have identical contents.\n\
 124 Case is significant.\n\
 125 Symbols are also allowed; their print names are used instead.")
 126   (s1, s2)
 127      register Lisp_Object s1, s2;
 128 {
 129   if (XTYPE (s1) == Lisp_Symbol)
 130     XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String);
 131   if (XTYPE (s2) == Lisp_Symbol)
 132     XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String);
 133   CHECK_STRING (s1, 0);
 134   CHECK_STRING (s2, 1);
 135
 136   if (XSTRING (s1)->size != XSTRING (s2)->size ||
 137       bcmp (XSTRING (s1)->data, XSTRING (s2)->data, XSTRING (s1)->size))
 138     return Qnil;
 139   return Qt;
 140 }
 141
 142 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
 143   "T if first arg string is less than second in lexicographic order.\n\
 144 Case is significant.\n\
 145 Symbols are also allowed; their print names are used instead.")
 146   (s1, s2)
 147      register Lisp_Object s1, s2;
 148 {
 149   register int i;
 150   register unsigned char *p1, *p2;
 151   register int end;
 152
 153   if (XTYPE (s1) == Lisp_Symbol)
 154     XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String);
 155   if (XTYPE (s2) == Lisp_Symbol)
 156     XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String);
 157   CHECK_STRING (s1, 0);
 158   CHECK_STRING (s2, 1);
 159
 160   p1 = XSTRING (s1)->data;
 161   p2 = XSTRING (s2)->data;
 162   end = XSTRING (s1)->size;
 163   if (end > XSTRING (s2)->size)
 164     end = XSTRING (s2)->size;
 165
 166   for (i = 0; i < end; i++)
 167     {
 168       if (p1[i] != p2[i])
 169         return p1[i] < p2[i] ? Qt : Qnil;
 170     }
 171   return i < XSTRING (s2)->size ? Qt : Qnil;
 172 }
 173 \f
 174 static Lisp_Object concat ();
 175
 176 /* ARGSUSED */
 177 Lisp_Object
 178 concat2 (s1, s2)
 179      Lisp_Object s1, s2;
 180 {
 181 #ifdef NO_ARG_ARRAY
 182   Lisp_Object args[2];
 183   args[0] = s1;
 184   args[1] = s2;
 185   return concat (2, args, Lisp_String, 0);
 186 #else
 187   return concat (2, &s1, Lisp_String, 0);
 188 #endif /* NO_ARG_ARRAY */
 189 }
 190
 191 DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
 192   "Concatenate all the arguments and make the result a list.\n\
 193 The result is a list whose elements are the elements of all the arguments.\n\
 194 Each argument may be a list, vector or string.\n\
 195 The last argument is not copied, just used as the tail of the new list.")
 196   (nargs, args)
 197      int nargs;
 198      Lisp_Object *args;
 199 {
 200   return concat (nargs, args, Lisp_Cons, 1);
 201 }
 202
 203 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
 204   "Concatenate all the arguments and make the result a string.\n\
 205 The result is a string whose elements are the elements of all the arguments.\n\
 206 Each argument may be a string, a list of characters (integers),\n\
 207 or a vector of characters (integers).")
 208   (nargs, args)
 209      int nargs;
 210      Lisp_Object *args;
 211 {
 212   return concat (nargs, args, Lisp_String, 0);
 213 }
 214
 215 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
 216   "Concatenate all the arguments and make the result a vector.\n\
 217 The result is a vector whose elements are the elements of all the arguments.\n\
 218 Each argument may be a list, vector or string.")
 219   (nargs, args)
 220      int nargs;
 221      Lisp_Object *args;
 222 {
 223   return concat (nargs, args, Lisp_Vector, 0);
 224 }
 225
 226 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
 227   "Return a copy of a list, vector or string.\n\
 228 The elements of a list or vector are not copied; they are shared\n\
 229 with the original.")
 230   (arg)
 231      Lisp_Object arg;
 232 {
 233   if (NILP (arg)) return arg;
 234   if (!CONSP (arg) && XTYPE (arg) != Lisp_Vector && XTYPE (arg) != Lisp_String)
 235     arg = wrong_type_argument (Qsequencep, arg);
 236   return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
 237 }
 238
 239 static Lisp_Object
 240 concat (nargs, args, target_type, last_special)
 241      int nargs;
 242      Lisp_Object *args;
 243      enum Lisp_Type target_type;
 244      int last_special;
 245 {
 246   Lisp_Object val;
 247   Lisp_Object len;
 248   register Lisp_Object tail;
 249   register Lisp_Object this;
 250   int toindex;
 251   register int leni;
 252   register int argnum;
 253   Lisp_Object last_tail;
 254   Lisp_Object prev;
 255
 256   /* In append, the last arg isn't treated like the others */
 257   if (last_special && nargs > 0)
 258     {
 259       nargs--;
 260       last_tail = args[nargs];
 261     }
 262   else
 263     last_tail = Qnil;
 264
 265   for (argnum = 0; argnum < nargs; argnum++)
 266     {
 267       this = args[argnum];
 268       if (!(CONSP (this) || NILP (this)
 269             || XTYPE (this) == Lisp_Vector || XTYPE (this) == Lisp_String
 270             || XTYPE (this) == Lisp_Compiled))
 271         {
 272           if (XTYPE (this) == Lisp_Int)
 273             args[argnum] = Fnumber_to_string (this);
 274           else
 275             args[argnum] = wrong_type_argument (Qsequencep, this);
 276         }
 277     }
 278
 279   for (argnum = 0, leni = 0; argnum < nargs; argnum++)
 280     {
 281       this = args[argnum];
 282       len = Flength (this);
 283       leni += XFASTINT (len);
 284     }
 285
 286   XFASTINT (len) = leni;
 287
 288   if (target_type == Lisp_Cons)
 289     val = Fmake_list (len, Qnil);
 290   else if (target_type == Lisp_Vector)
 291     val = Fmake_vector (len, Qnil);
 292   else
 293     val = Fmake_string (len, len);
 294
 295   /* In append, if all but last arg are nil, return last arg */
 296   if (target_type == Lisp_Cons && EQ (val, Qnil))
 297     return last_tail;
 298
 299   if (CONSP (val))
 300     tail = val, toindex = -1;           /* -1 in toindex is flag we are making a list */
 301   else
 302     toindex = 0;
 303
 304   prev = Qnil;
 305
 306   for (argnum = 0; argnum < nargs; argnum++)
 307     {
 308       Lisp_Object thislen;
 309       int thisleni;
 310       register int thisindex = 0;
 311
 312       this = args[argnum];
 313       if (!CONSP (this))
 314         thislen = Flength (this), thisleni = XINT (thislen);
 315
 316       if (XTYPE (this) == Lisp_String && XTYPE (val) == Lisp_String
 317           && ! NULL_INTERVAL_P (XSTRING (this)->intervals))
 318         {
 319           copy_text_properties (make_number (0), thislen, this,
 320                                 make_number (toindex), val, Qnil);
 321         }
 322
 323       while (1)
 324         {
 325           register Lisp_Object elt;
 326
 327           /* Fetch next element of `this' arg into `elt', or break if
 328              `this' is exhausted. */
 329           if (NILP (this)) break;
 330           if (CONSP (this))
 331             elt = Fcar (this), this = Fcdr (this);
 332           else
 333             {
 334               if (thisindex >= thisleni) break;
 335               if (XTYPE (this) == Lisp_String)
 336                 XFASTINT (elt) = XSTRING (this)->data[thisindex++];
 337               else
 338                 elt = XVECTOR (this)->contents[thisindex++];
 339             }
 340
 341           /* Store into result */
 342           if (toindex < 0)
 343             {
 344               XCONS (tail)->car = elt;
 345               prev = tail;
 346               tail = XCONS (tail)->cdr;
 347             }
 348           else if (XTYPE (val) == Lisp_Vector)
 349             XVECTOR (val)->contents[toindex++] = elt;
 350           else
 351             {
 352               while (XTYPE (elt) != Lisp_Int)
 353                 elt = wrong_type_argument (Qintegerp, elt);
 354               {
 355 #ifdef MASSC_REGISTER_BUG
 356                 /* Even removing all "register"s doesn't disable this bug!
 357                    Nothing simpler than this seems to work. */
 358                 unsigned char *p = & XSTRING (val)->data[toindex++];
 359                 *p = XINT (elt);
 360 #else
 361                 XSTRING (val)->data[toindex++] = XINT (elt);
 362 #endif
 363               }
 364             }
 365         }
 366     }
 367   if (!NILP (prev))
 368     XCONS (prev)->cdr = last_tail;
 369
 370   return val;
 371 }
 372 \f
 373 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
 374   "Return a copy of ALIST.\n\
 375 This is an alist which represents the same mapping from objects to objects,\n\
 376 but does not share the alist structure with ALIST.\n\
 377 The objects mapped (cars and cdrs of elements of the alist)\n\
 378 are shared, however.\n\
 379 Elements of ALIST that are not conses are also shared.")
 380   (alist)
 381      Lisp_Object alist;
 382 {
 383   register Lisp_Object tem;
 384
 385   CHECK_LIST (alist, 0);
 386   if (NILP (alist))
 387     return alist;
 388   alist = concat (1, &alist, Lisp_Cons, 0);
 389   for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr)
 390     {
 391       register Lisp_Object car;
 392       car = XCONS (tem)->car;
 393
 394       if (CONSP (car))
 395         XCONS (tem)->car = Fcons (XCONS (car)->car, XCONS (car)->cdr);
 396     }
 397   return alist;
 398 }
 399
 400 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
 401   "Return a substring of STRING, starting at index FROM and ending before TO.\n\
 402 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
 403 If FROM or TO is negative, it counts from the end.")
 404   (string, from, to)
 405      Lisp_Object string;
 406      register Lisp_Object from, to;
 407 {
 408   Lisp_Object res;
 409
 410   CHECK_STRING (string, 0);
 411   CHECK_NUMBER (from, 1);
 412   if (NILP (to))
 413     to = Flength (string);
 414   else
 415     CHECK_NUMBER (to, 2);
 416
 417   if (XINT (from) < 0)
 418     XSETINT (from, XINT (from) + XSTRING (string)->size);
 419   if (XINT (to) < 0)
 420     XSETINT (to, XINT (to) + XSTRING (string)->size);
 421   if (!(0 <= XINT (from) && XINT (from) <= XINT (to)
 422         && XINT (to) <= XSTRING (string)->size))
 423     args_out_of_range_3 (string, from, to);
 424
 425   res = make_string (XSTRING (string)->data + XINT (from),
 426                      XINT (to) - XINT (from));
 427   copy_text_properties (from, to, string, make_number (0), res, Qnil);
 428   return res;
 429 }
 430 \f
 431 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
 432   "Take cdr N times on LIST, returns the result.")
 433   (n, list)
 434      Lisp_Object n;
 435      register Lisp_Object list;
 436 {
 437   register int i, num;
 438   CHECK_NUMBER (n, 0);
 439   num = XINT (n);
 440   for (i = 0; i < num && !NILP (list); i++)
 441     {
 442       QUIT;
 443       list = Fcdr (list);
 444     }
 445   return list;
 446 }
 447
 448 DEFUN ("nth", Fnth, Snth, 2, 2, 0,
 449   "Return the Nth element of LIST.\n\
 450 N counts from zero.  If LIST is not that long, nil is returned.")
 451   (n, list)
 452      Lisp_Object n, list;
 453 {
 454   return Fcar (Fnthcdr (n, list));
 455 }
 456
 457 DEFUN ("elt", Felt, Selt, 2, 2, 0,
 458   "Return element of SEQUENCE at index N.")
 459   (seq, n)
 460      register Lisp_Object seq, n;
 461 {
 462   CHECK_NUMBER (n, 0);
 463   while (1)
 464     {
 465       if (XTYPE (seq) == Lisp_Cons || NILP (seq))
 466         return Fcar (Fnthcdr (n, seq));
 467       else if (XTYPE (seq) == Lisp_String
 468                || XTYPE (seq) == Lisp_Vector)
 469         return Faref (seq, n);
 470       else
 471         seq = wrong_type_argument (Qsequencep, seq);
 472     }
 473 }
 474
 475 DEFUN ("member", Fmember, Smember, 2, 2, 0,
 476   "Return non-nil if ELT is an element of LIST.  Comparison done with EQUAL.\n\
 477 The value is actually the tail of LIST whose car is ELT.")
 478   (elt, list)
 479      register Lisp_Object elt;
 480      Lisp_Object list;
 481 {
 482   register Lisp_Object tail;
 483   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 484     {
 485       register Lisp_Object tem;
 486       tem = Fcar (tail);
 487       if (! NILP (Fequal (elt, tem)))
 488         return tail;
 489       QUIT;
 490     }
 491   return Qnil;
 492 }
 493
 494 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
 495   "Return non-nil if ELT is an element of LIST.  Comparison done with EQ.\n\
 496 The value is actually the tail of LIST whose car is ELT.")
 497   (elt, list)
 498      register Lisp_Object elt;
 499      Lisp_Object list;
 500 {
 501   register Lisp_Object tail;
 502   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 503     {
 504       register Lisp_Object tem;
 505       tem = Fcar (tail);
 506       if (EQ (elt, tem)) return tail;
 507       QUIT;
 508     }
 509   return Qnil;
 510 }
 511
 512 DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
 513   "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
 514 The value is actually the element of LIST whose car is KEY.\n\
 515 Elements of LIST that are not conses are ignored.")
 516   (key, list)
 517      register Lisp_Object key;
 518      Lisp_Object list;
 519 {
 520   register Lisp_Object tail;
 521   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 522     {
 523       register Lisp_Object elt, tem;
 524       elt = Fcar (tail);
 525       if (!CONSP (elt)) continue;
 526       tem = Fcar (elt);
 527       if (EQ (key, tem)) return elt;
 528       QUIT;
 529     }
 530   return Qnil;
 531 }
 532
 533 /* Like Fassq but never report an error and do not allow quits.
 534    Use only on lists known never to be circular.  */
 535
 536 Lisp_Object
 537 assq_no_quit (key, list)
 538      register Lisp_Object key;
 539      Lisp_Object list;
 540 {
 541   register Lisp_Object tail;
 542   for (tail = list; CONSP (tail); tail = Fcdr (tail))
 543     {
 544       register Lisp_Object elt, tem;
 545       elt = Fcar (tail);
 546       if (!CONSP (elt)) continue;
 547       tem = Fcar (elt);
 548       if (EQ (key, tem)) return elt;
 549     }
 550   return Qnil;
 551 }
 552
 553 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
 554   "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
 555 The value is actually the element of LIST whose car is KEY.")
 556   (key, list)
 557      register Lisp_Object key;
 558      Lisp_Object list;
 559 {
 560   register Lisp_Object tail;
 561   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 562     {
 563       register Lisp_Object elt, tem;
 564       elt = Fcar (tail);
 565       if (!CONSP (elt)) continue;
 566       tem = Fequal (Fcar (elt), key);
 567       if (!NILP (tem)) return elt;
 568       QUIT;
 569     }
 570   return Qnil;
 571 }
 572
 573 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
 574   "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
 575 The value is actually the element of LIST whose cdr is ELT.")
 576   (key, list)
 577      register Lisp_Object key;
 578      Lisp_Object list;
 579 {
 580   register Lisp_Object tail;
 581   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 582     {
 583       register Lisp_Object elt, tem;
 584       elt = Fcar (tail);
 585       if (!CONSP (elt)) continue;
 586       tem = Fcdr (elt);
 587       if (EQ (key, tem)) return elt;
 588       QUIT;
 589     }
 590   return Qnil;
 591 }
 592 \f
 593 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
 594   "Delete by side effect any occurrences of ELT as a member of LIST.\n\
 595 The modified LIST is returned.  Comparison is done with `eq'.\n\
 596 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
 597 therefore, write `(setq foo (delq element foo))'\n\
 598 to be sure of changing the value of `foo'.")
 599   (elt, list)
 600      register Lisp_Object elt;
 601      Lisp_Object list;
 602 {
 603   register Lisp_Object tail, prev;
 604   register Lisp_Object tem;
 605
 606   tail = list;
 607   prev = Qnil;
 608   while (!NILP (tail))
 609     {
 610       tem = Fcar (tail);
 611       if (EQ (elt, tem))
 612         {
 613           if (NILP (prev))
 614             list = Fcdr (tail);
 615           else
 616             Fsetcdr (prev, Fcdr (tail));
 617         }
 618       else
 619         prev = tail;
 620       tail = Fcdr (tail);
 621       QUIT;
 622     }
 623   return list;
 624 }
 625
 626 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
 627   "Delete by side effect any occurrences of ELT as a member of LIST.\n\
 628 The modified LIST is returned.  Comparison is done with `equal'.\n\
 629 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
 630 therefore, write `(setq foo (delete element foo))'\n\
 631 to be sure of changing the value of `foo'.")
 632   (elt, list)
 633      register Lisp_Object elt;
 634      Lisp_Object list;
 635 {
 636   register Lisp_Object tail, prev;
 637   register Lisp_Object tem;
 638
 639   tail = list;
 640   prev = Qnil;
 641   while (!NILP (tail))
 642     {
 643       tem = Fcar (tail);
 644       if (! NILP (Fequal (elt, tem)))
 645         {
 646           if (NILP (prev))
 647             list = Fcdr (tail);
 648           else
 649             Fsetcdr (prev, Fcdr (tail));
 650         }
 651       else
 652         prev = tail;
 653       tail = Fcdr (tail);
 654       QUIT;
 655     }
 656   return list;
 657 }
 658
 659 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
 660   "Reverse LIST by modifying cdr pointers.\n\
 661 Returns the beginning of the reversed list.")
 662   (list)
 663      Lisp_Object list;
 664 {
 665   register Lisp_Object prev, tail, next;
 666
 667   if (NILP (list)) return list;
 668   prev = Qnil;
 669   tail = list;
 670   while (!NILP (tail))
 671     {
 672       QUIT;
 673       next = Fcdr (tail);
 674       Fsetcdr (tail, prev);
 675       prev = tail;
 676       tail = next;
 677     }
 678   return prev;
 679 }
 680
 681 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
 682   "Reverse LIST, copying.  Returns the beginning of the reversed list.\n\
 683 See also the function `nreverse', which is used more often.")
 684   (list)
 685      Lisp_Object list;
 686 {
 687   Lisp_Object length;
 688   register Lisp_Object *vec;
 689   register Lisp_Object tail;
 690   register int i;
 691
 692   length = Flength (list);
 693   vec = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object));
 694   for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail))
 695     vec[i] = Fcar (tail);
 696
 697   return Flist (XINT (length), vec);
 698 }
 699 \f
 700 Lisp_Object merge ();
 701
 702 DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
 703   "Sort LIST, stably, comparing elements using PREDICATE.\n\
 704 Returns the sorted list.  LIST is modified by side effects.\n\
 705 PREDICATE is called with two elements of LIST, and should return T\n\
 706 if the first element is \"less\" than the second.")
 707   (list, pred)
 708      Lisp_Object list, pred;
 709 {
 710   Lisp_Object front, back;
 711   register Lisp_Object len, tem;
 712   struct gcpro gcpro1, gcpro2;
 713   register int length;
 714
 715   front = list;
 716   len = Flength (list);
 717   length = XINT (len);
 718   if (length < 2)
 719     return list;
 720
 721   XSETINT (len, (length / 2) - 1);
 722   tem = Fnthcdr (len, list);
 723   back = Fcdr (tem);
 724   Fsetcdr (tem, Qnil);
 725
 726   GCPRO2 (front, back);
 727   front = Fsort (front, pred);
 728   back = Fsort (back, pred);
 729   UNGCPRO;
 730   return merge (front, back, pred);
 731 }
 732
 733 Lisp_Object
 734 merge (org_l1, org_l2, pred)
 735      Lisp_Object org_l1, org_l2;
 736      Lisp_Object pred;
 737 {
 738   Lisp_Object value;
 739   register Lisp_Object tail;
 740   Lisp_Object tem;
 741   register Lisp_Object l1, l2;
 742   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 743
 744   l1 = org_l1;
 745   l2 = org_l2;
 746   tail = Qnil;
 747   value = Qnil;
 748
 749   /* It is sufficient to protect org_l1 and org_l2.
 750      When l1 and l2 are updated, we copy the new values
 751      back into the org_ vars.  */
 752   GCPRO4 (org_l1, org_l2, pred, value);
 753
 754   while (1)
 755     {
 756       if (NILP (l1))
 757         {
 758           UNGCPRO;
 759           if (NILP (tail))
 760             return l2;
 761           Fsetcdr (tail, l2);
 762           return value;
 763         }
 764       if (NILP (l2))
 765         {
 766           UNGCPRO;
 767           if (NILP (tail))
 768             return l1;
 769           Fsetcdr (tail, l1);
 770           return value;
 771         }
 772       tem = call2 (pred, Fcar (l2), Fcar (l1));
 773       if (NILP (tem))
 774         {
 775           tem = l1;
 776           l1 = Fcdr (l1);
 777           org_l1 = l1;
 778         }
 779       else
 780         {
 781           tem = l2;
 782           l2 = Fcdr (l2);
 783           org_l2 = l2;
 784         }
 785       if (NILP (tail))
 786         value = tem;
 787       else
 788         Fsetcdr (tail, tem);
 789       tail = tem;
 790     }
 791 }
 792 \f
 793 DEFUN ("get", Fget, Sget, 2, 2, 0,
 794   "Return the value of SYMBOL's PROPNAME property.\n\
 795 This is the last VALUE stored with `(put SYMBOL PROPNAME VALUE)'.")
 796   (sym, prop)
 797      Lisp_Object sym;
 798      register Lisp_Object prop;
 799 {
 800   register Lisp_Object tail;
 801   for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
 802     {
 803       register Lisp_Object tem;
 804       tem = Fcar (tail);
 805       if (EQ (prop, tem))
 806         return Fcar (Fcdr (tail));
 807     }
 808   return Qnil;
 809 }
 810
 811 DEFUN ("put", Fput, Sput, 3, 3, 0,
 812   "Store SYMBOL's PROPNAME property with value VALUE.\n\
 813 It can be retrieved with `(get SYMBOL PROPNAME)'.")
 814   (sym, prop, val)
 815      Lisp_Object sym;
 816      register Lisp_Object prop;
 817      Lisp_Object val;
 818 {
 819   register Lisp_Object tail, prev;
 820   Lisp_Object newcell;
 821   prev = Qnil;
 822   for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
 823     {
 824       register Lisp_Object tem;
 825       tem = Fcar (tail);
 826       if (EQ (prop, tem))
 827         return Fsetcar (Fcdr (tail), val);
 828       prev = tail;
 829     }
 830   newcell = Fcons (prop, Fcons (val, Qnil));
 831   if (NILP (prev))
 832     Fsetplist (sym, newcell);
 833   else
 834     Fsetcdr (Fcdr (prev), newcell);
 835   return val;
 836 }
 837
 838 DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
 839   "T if two Lisp objects have similar structure and contents.\n\
 840 They must have the same data type.\n\
 841 Conses are compared by comparing the cars and the cdrs.\n\
 842 Vectors and strings are compared element by element.\n\
 843 Numbers are compared by value, but integers cannot equal floats.\n\
 844  (Use `=' if you want integers and floats to be able to be equal.)\n\
 845 Symbols must match exactly.")
 846   (o1, o2)
 847      register Lisp_Object o1, o2;
 848 {
 849   return internal_equal (o1, o2, 0);
 850 }
 851
 852 static Lisp_Object
 853 internal_equal (o1, o2, depth)
 854      register Lisp_Object o1, o2;
 855      int depth;
 856 {
 857   if (depth > 200)
 858     error ("Stack overflow in equal");
 859 do_cdr:
 860   QUIT;
 861   if (EQ (o1, o2)) return Qt;
 862 #ifdef LISP_FLOAT_TYPE
 863   if (FLOATP (o1) && FLOATP (o2))
 864     return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil;
 865 #endif
 866   if (XTYPE (o1) != XTYPE (o2)) return Qnil;
 867   if (XTYPE (o1) == Lisp_Cons
 868       || XTYPE (o1) == Lisp_Overlay)
 869     {
 870       Lisp_Object v1;
 871       v1 = internal_equal (Fcar (o1), Fcar (o2), depth + 1);
 872       if (NILP (v1))
 873         return v1;
 874       o1 = Fcdr (o1), o2 = Fcdr (o2);
 875       goto do_cdr;
 876     }
 877   if (XTYPE (o1) == Lisp_Marker)
 878     {
 879       return ((XMARKER (o1)->buffer == XMARKER (o2)->buffer
 880               && (XMARKER (o1)->buffer == 0
 881                   || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos))
 882               ? Qt : Qnil);
 883     }
 884   if (XTYPE (o1) == Lisp_Vector
 885       || XTYPE (o1) == Lisp_Compiled)
 886     {
 887       register int index;
 888       if (XVECTOR (o1)->size != XVECTOR (o2)->size)
 889         return Qnil;
 890       for (index = 0; index < XVECTOR (o1)->size; index++)
 891         {
 892           Lisp_Object v, v1, v2;
 893           v1 = XVECTOR (o1)->contents [index];
 894           v2 = XVECTOR (o2)->contents [index];
 895           v = internal_equal (v1, v2, depth + 1);
 896           if (NILP (v)) return v;
 897         }
 898       return Qt;
 899     }
 900   if (XTYPE (o1) == Lisp_String)
 901     {
 902       if (XSTRING (o1)->size != XSTRING (o2)->size)
 903         return Qnil;
 904       if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size))
 905         return Qnil;
 906       return Qt;
 907     }
 908   return Qnil;
 909 }
 910 \f
 911 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
 912   "Store each element of ARRAY with ITEM.  ARRAY is a vector or string.")
 913   (array, item)
 914      Lisp_Object array, item;
 915 {
 916   register int size, index, charval;
 917  retry:
 918   if (XTYPE (array) == Lisp_Vector)
 919     {
 920       register Lisp_Object *p = XVECTOR (array)->contents;
 921       size = XVECTOR (array)->size;
 922       for (index = 0; index < size; index++)
 923         p[index] = item;
 924     }
 925   else if (XTYPE (array) == Lisp_String)
 926     {
 927       register unsigned char *p = XSTRING (array)->data;
 928       CHECK_NUMBER (item, 1);
 929       charval = XINT (item);
 930       size = XSTRING (array)->size;
 931       for (index = 0; index < size; index++)
 932         p[index] = charval;
 933     }
 934   else
 935     {
 936       array = wrong_type_argument (Qarrayp, array);
 937       goto retry;
 938     }
 939   return array;
 940 }
 941
 942 /* ARGSUSED */
 943 Lisp_Object
 944 nconc2 (s1, s2)
 945      Lisp_Object s1, s2;
 946 {
 947 #ifdef NO_ARG_ARRAY
 948   Lisp_Object args[2];
 949   args[0] = s1;
 950   args[1] = s2;
 951   return Fnconc (2, args);
 952 #else
 953   return Fnconc (2, &s1);
 954 #endif /* NO_ARG_ARRAY */
 955 }
 956
 957 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
 958   "Concatenate any number of lists by altering them.\n\
 959 Only the last argument is not altered, and need not be a list.")
 960   (nargs, args)
 961      int nargs;
 962      Lisp_Object *args;
 963 {
 964   register int argnum;
 965   register Lisp_Object tail, tem, val;
 966
 967   val = Qnil;
 968
 969   for (argnum = 0; argnum < nargs; argnum++)
 970     {
 971       tem = args[argnum];
 972       if (NILP (tem)) continue;
 973
 974       if (NILP (val))
 975         val = tem;
 976
 977       if (argnum + 1 == nargs) break;
 978
 979       if (!CONSP (tem))
 980         tem = wrong_type_argument (Qlistp, tem);
 981
 982       while (CONSP (tem))
 983         {
 984           tail = tem;
 985           tem = Fcdr (tail);
 986           QUIT;
 987         }
 988
 989       tem = args[argnum + 1];
 990       Fsetcdr (tail, tem);
 991       if (NILP (tem))
 992         args[argnum + 1] = tail;
 993     }
 994
 995   return val;
 996 }
 997 \f
 998 /* This is the guts of all mapping functions.
 999  Apply fn to each element of seq, one by one,
1000  storing the results into elements of vals, a C vector of Lisp_Objects.
1001  leni is the length of vals, which should also be the length of seq. */
1002
1003 static void
1004 mapcar1 (leni, vals, fn, seq)
1005      int leni;
1006      Lisp_Object *vals;
1007      Lisp_Object fn, seq;
1008 {
1009   register Lisp_Object tail;
1010   Lisp_Object dummy;
1011   register int i;
1012   struct gcpro gcpro1, gcpro2, gcpro3;
1013
1014   /* Don't let vals contain any garbage when GC happens.  */
1015   for (i = 0; i < leni; i++)
1016     vals[i] = Qnil;
1017
1018   GCPRO3 (dummy, fn, seq);
1019   gcpro1.var = vals;
1020   gcpro1.nvars = leni;
1021   /* We need not explicitly protect `tail' because it is used only on lists, and
1022     1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
1023
1024   if (XTYPE (seq) == Lisp_Vector)
1025     {
1026       for (i = 0; i < leni; i++)
1027         {
1028           dummy = XVECTOR (seq)->contents[i];
1029           vals[i] = call1 (fn, dummy);
1030         }
1031     }
1032   else if (XTYPE (seq) == Lisp_String)
1033     {
1034       for (i = 0; i < leni; i++)
1035         {
1036           XFASTINT (dummy) = XSTRING (seq)->data[i];
1037           vals[i] = call1 (fn, dummy);
1038         }
1039     }
1040   else   /* Must be a list, since Flength did not get an error */
1041     {
1042       tail = seq;
1043       for (i = 0; i < leni; i++)
1044         {
1045           vals[i] = call1 (fn, Fcar (tail));
1046           tail = Fcdr (tail);
1047         }
1048     }
1049
1050   UNGCPRO;
1051 }
1052
1053 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
1054   "Apply FN to each element of SEQ, and concat the results as strings.\n\
1055 In between each pair of results, stick in SEP.\n\
1056 Thus, \" \" as SEP results in spaces between the values returned by FN.")
1057   (fn, seq, sep)
1058      Lisp_Object fn, seq, sep;
1059 {
1060   Lisp_Object len;
1061   register int leni;
1062   int nargs;
1063   register Lisp_Object *args;
1064   register int i;
1065   struct gcpro gcpro1;
1066
1067   len = Flength (seq);
1068   leni = XINT (len);
1069   nargs = leni + leni - 1;
1070   if (nargs < 0) return build_string ("");
1071
1072   args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
1073
1074   GCPRO1 (sep);
1075   mapcar1 (leni, args, fn, seq);
1076   UNGCPRO;
1077
1078   for (i = leni - 1; i >= 0; i--)
1079     args[i + i] = args[i];
1080
1081   for (i = 1; i < nargs; i += 2)
1082     args[i] = sep;
1083
1084   return Fconcat (nargs, args);
1085 }
1086
1087 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
1088   "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
1089 The result is a list just as long as SEQUENCE.\n\
1090 SEQUENCE may be a list, a vector or a string.")
1091   (fn, seq)
1092      Lisp_Object fn, seq;
1093 {
1094   register Lisp_Object len;
1095   register int leni;
1096   register Lisp_Object *args;
1097
1098   len = Flength (seq);
1099   leni = XFASTINT (len);
1100   args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
1101
1102   mapcar1 (leni, args, fn, seq);
1103
1104   return Flist (leni, args);
1105 }
1106 \f
1107 /* Anything that calls this function must protect from GC!  */
1108
1109 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
1110   "Ask user a \"y or n\" question.  Return t if answer is \"y\".\n\
1111 Takes one argument, which is the string to display to ask the question.\n\
1112 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
1113 No confirmation of the answer is requested; a single character is enough.\n\
1114 Also accepts Space to mean yes, or Delete to mean no.")
1115   (prompt)
1116      Lisp_Object prompt;
1117 {
1118   register Lisp_Object obj, key, def, answer_string, map;
1119   register int answer;
1120   Lisp_Object xprompt;
1121   Lisp_Object args[2];
1122   int ocech = cursor_in_echo_area;
1123   struct gcpro gcpro1, gcpro2;
1124
1125   map = Fsymbol_value (intern ("query-replace-map"));
1126
1127   CHECK_STRING (prompt, 0);
1128   xprompt = prompt;
1129   GCPRO2 (prompt, xprompt);
1130
1131   while (1)
1132     {
1133       if (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
1134         {
1135           Lisp_Object pane, menu;
1136           pane = Fcons (Fcons (build_string ("Yes"), Qt),
1137                         Fcons (Fcons (build_string ("No"), Qnil),
1138                                Qnil));
1139           menu = Fcons (prompt, pane);
1140           obj = Fx_popup_dialog (Qt, menu);
1141           answer = !NILP (obj);
1142           break;
1143         }
1144       else
1145         {
1146           cursor_in_echo_area = 1;
1147           message ("%s(y or n) ", XSTRING (xprompt)->data);
1148
1149           obj = read_filtered_event (1, 0, 0);
1150           cursor_in_echo_area = 0;
1151           /* If we need to quit, quit with cursor_in_echo_area = 0.  */
1152           QUIT;
1153         }
1154
1155       key = Fmake_vector (make_number (1), obj);
1156       def = Flookup_key (map, key);
1157       answer_string = Fsingle_key_description (obj);
1158
1159       if (EQ (def, intern ("skip")))
1160         {
1161           answer = 0;
1162           break;
1163         }
1164       else if (EQ (def, intern ("act")))
1165         {
1166           answer = 1;
1167           break;
1168         }
1169       else if (EQ (def, intern ("recenter")))
1170         {
1171           Frecenter (Qnil);
1172           xprompt = prompt;
1173           continue;
1174         }
1175       else if (EQ (def, intern ("quit")))
1176         Vquit_flag = Qt;
1177
1178       QUIT;
1179
1180       /* If we don't clear this, then the next call to read_char will
1181          return quit_char again, and we'll enter an infinite loop.  */
1182       Vquit_flag = Qnil;
1183
1184       Fding (Qnil);
1185       Fdiscard_input ();
1186       if (EQ (xprompt, prompt))
1187         {
1188           args[0] = build_string ("Please answer y or n.  ");
1189           args[1] = prompt;
1190           xprompt = Fconcat (2, args);
1191         }
1192     }
1193   UNGCPRO;
1194
1195   if (! noninteractive)
1196     {
1197       cursor_in_echo_area = -1;
1198       message ("%s(y or n) %c", XSTRING (xprompt)->data, answer ? 'y' : 'n');
1199       cursor_in_echo_area = ocech;
1200     }
1201
1202   return answer ? Qt : Qnil;
1203 }
1204 \f
1205 /* This is how C code calls `yes-or-no-p' and allows the user
1206    to redefined it.
1207
1208    Anything that calls this function must protect from GC!  */
1209
1210 Lisp_Object
1211 do_yes_or_no_p (prompt)
1212      Lisp_Object prompt;
1213 {
1214   return call1 (intern ("yes-or-no-p"), prompt);
1215 }
1216
1217 /* Anything that calls this function must protect from GC!  */
1218
1219 DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
1220   "Ask user a yes-or-no question.  Return t if answer is yes.\n\
1221 Takes one argument, which is the string to display to ask the question.\n\
1222 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
1223 The user must confirm the answer with RET,\n\
1224 and can edit it until it as been confirmed.")
1225   (prompt)
1226      Lisp_Object prompt;
1227 {
1228   register Lisp_Object ans;
1229   Lisp_Object args[2];
1230   struct gcpro gcpro1;
1231   Lisp_Object menu;
1232
1233   CHECK_STRING (prompt, 0);
1234
1235   if (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
1236     {
1237       Lisp_Object pane, menu, obj;
1238       pane = Fcons (Fcons (build_string ("Yes"), Qt),
1239                     Fcons (Fcons (build_string ("No"), Qnil),
1240                            Qnil));
1241       GCPRO1 (pane);
1242       menu = Fcons (prompt, pane);
1243       obj = Fx_popup_dialog (Qt, menu);
1244       UNGCPRO;
1245       return obj;
1246     }
1247
1248   args[0] = prompt;
1249   args[1] = build_string ("(yes or no) ");
1250   prompt = Fconcat (2, args);
1251
1252   GCPRO1 (prompt);
1253
1254   while (1)
1255     {
1256       ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
1257                                               Qyes_or_no_p_history));
1258       if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
1259         {
1260           UNGCPRO;
1261           return Qt;
1262         }
1263       if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
1264         {
1265           UNGCPRO;
1266           return Qnil;
1267         }
1268
1269       Fding (Qnil);
1270       Fdiscard_input ();
1271       message ("Please answer yes or no.");
1272       Fsleep_for (make_number (2), Qnil);
1273     }
1274 }
1275 \f
1276 DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
1277   "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
1278 Each of the three load averages is multiplied by 100,\n\
1279 then converted to integer.\n\
1280 If the 5-minute or 15-minute load averages are not available, return a\n\
1281 shortened list, containing only those averages which are available.")
1282   ()
1283 {
1284   double load_ave[3];
1285   int loads = getloadavg (load_ave, 3);
1286   Lisp_Object ret;
1287
1288   if (loads < 0)
1289     error ("load-average not implemented for this operating system");
1290
1291   ret = Qnil;
1292   while (loads > 0)
1293     ret = Fcons (make_number ((int) (load_ave[--loads] * 100.0)), ret);
1294
1295   return ret;
1296 }
1297 \f
1298 Lisp_Object Vfeatures;
1299
1300 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
1301   "Returns t if FEATURE is present in this Emacs.\n\
1302 Use this to conditionalize execution of lisp code based on the presence or\n\
1303 absence of emacs or environment extensions.\n\
1304 Use `provide' to declare that a feature is available.\n\
1305 This function looks at the value of the variable `features'.")
1306      (feature)
1307      Lisp_Object feature;
1308 {
1309   register Lisp_Object tem;
1310   CHECK_SYMBOL (feature, 0);
1311   tem = Fmemq (feature, Vfeatures);
1312   return (NILP (tem)) ? Qnil : Qt;
1313 }
1314
1315 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
1316   "Announce that FEATURE is a feature of the current Emacs.")
1317      (feature)
1318      Lisp_Object feature;
1319 {
1320   register Lisp_Object tem;
1321   CHECK_SYMBOL (feature, 0);
1322   if (!NILP (Vautoload_queue))
1323     Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
1324   tem = Fmemq (feature, Vfeatures);
1325   if (NILP (tem))
1326     Vfeatures = Fcons (feature, Vfeatures);
1327   LOADHIST_ATTACH (Fcons (Qprovide, feature));
1328   return feature;
1329 }
1330
1331 DEFUN ("require", Frequire, Srequire, 1, 2, 0,
1332   "If feature FEATURE is not loaded, load it from FILENAME.\n\
1333 If FEATURE is not a member of the list `features', then the feature\n\
1334 is not loaded; so load the file FILENAME.\n\
1335 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
1336      (feature, file_name)
1337      Lisp_Object feature, file_name;
1338 {
1339   register Lisp_Object tem;
1340   CHECK_SYMBOL (feature, 0);
1341   tem = Fmemq (feature, Vfeatures);
1342   LOADHIST_ATTACH (Fcons (Qrequire, feature));
1343   if (NILP (tem))
1344     {
1345       int count = specpdl_ptr - specpdl;
1346
1347       /* Value saved here is to be restored into Vautoload_queue */
1348       record_unwind_protect (un_autoload, Vautoload_queue);
1349       Vautoload_queue = Qt;
1350
1351       Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
1352              Qnil, Qt, Qnil);
1353
1354       tem = Fmemq (feature, Vfeatures);
1355       if (NILP (tem))
1356         error ("Required feature %s was not provided",
1357                XSYMBOL (feature)->name->data );
1358
1359       /* Once loading finishes, don't undo it.  */
1360       Vautoload_queue = Qt;
1361       feature = unbind_to (count, feature);
1362     }
1363   return feature;
1364 }
1365 \f
1366 syms_of_fns ()
1367 {
1368   Qstring_lessp = intern ("string-lessp");
1369   staticpro (&Qstring_lessp);
1370   Qprovide = intern ("provide");
1371   staticpro (&Qprovide);
1372   Qrequire = intern ("require");
1373   staticpro (&Qrequire);
1374   Qyes_or_no_p_history = intern ("yes-or-no-p-history");
1375   staticpro (&Qyes_or_no_p_history);
1376
1377   DEFVAR_LISP ("features", &Vfeatures,
1378     "A list of symbols which are the features of the executing emacs.\n\
1379 Used by `featurep' and `require', and altered by `provide'.");
1380   Vfeatures = Qnil;
1381
1382   defsubr (&Sidentity);
1383   defsubr (&Srandom);
1384   defsubr (&Slength);
1385   defsubr (&Sstring_equal);
1386   defsubr (&Sstring_lessp);
1387   defsubr (&Sappend);
1388   defsubr (&Sconcat);
1389   defsubr (&Svconcat);
1390   defsubr (&Scopy_sequence);
1391   defsubr (&Scopy_alist);
1392   defsubr (&Ssubstring);
1393   defsubr (&Snthcdr);
1394   defsubr (&Snth);
1395   defsubr (&Selt);
1396   defsubr (&Smember);
1397   defsubr (&Smemq);
1398   defsubr (&Sassq);
1399   defsubr (&Sassoc);
1400   defsubr (&Srassq);
1401   defsubr (&Sdelq);
1402   defsubr (&Sdelete);
1403   defsubr (&Snreverse);
1404   defsubr (&Sreverse);
1405   defsubr (&Ssort);
1406   defsubr (&Sget);
1407   defsubr (&Sput);
1408   defsubr (&Sequal);
1409   defsubr (&Sfillarray);
1410   defsubr (&Snconc);
1411   defsubr (&Smapcar);
1412   defsubr (&Smapconcat);
1413   defsubr (&Sy_or_n_p);
1414   defsubr (&Syes_or_no_p);
1415   defsubr (&Sload_average);
1416   defsubr (&Sfeaturep);
1417   defsubr (&Srequire);
1418   defsubr (&Sprovide);
1419 }