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, deleting it is not a side effect;\n\
 630 it is simply using a different list.\n\
 631 Therefore, write `(setq foo (delete element foo))'\n\
 632 to be sure of changing the value of `foo'.")
 633   (elt, list)
 634      register Lisp_Object elt;
 635      Lisp_Object list;
 636 {
 637   register Lisp_Object tail, prev;
 638   register Lisp_Object tem;
 639
 640   tail = list;
 641   prev = Qnil;
 642   while (!NILP (tail))
 643     {
 644       tem = Fcar (tail);
 645       if (! NILP (Fequal (elt, tem)))
 646         {
 647           if (NILP (prev))
 648             list = Fcdr (tail);
 649           else
 650             Fsetcdr (prev, Fcdr (tail));
 651         }
 652       else
 653         prev = tail;
 654       tail = Fcdr (tail);
 655       QUIT;
 656     }
 657   return list;
 658 }
 659
 660 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
 661   "Reverse LIST by modifying cdr pointers.\n\
 662 Returns the beginning of the reversed list.")
 663   (list)
 664      Lisp_Object list;
 665 {
 666   register Lisp_Object prev, tail, next;
 667
 668   if (NILP (list)) return list;
 669   prev = Qnil;
 670   tail = list;
 671   while (!NILP (tail))
 672     {
 673       QUIT;
 674       next = Fcdr (tail);
 675       Fsetcdr (tail, prev);
 676       prev = tail;
 677       tail = next;
 678     }
 679   return prev;
 680 }
 681
 682 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
 683   "Reverse LIST, copying.  Returns the beginning of the reversed list.\n\
 684 See also the function `nreverse', which is used more often.")
 685   (list)
 686      Lisp_Object list;
 687 {
 688   Lisp_Object length;
 689   register Lisp_Object *vec;
 690   register Lisp_Object tail;
 691   register int i;
 692
 693   length = Flength (list);
 694   vec = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object));
 695   for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail))
 696     vec[i] = Fcar (tail);
 697
 698   return Flist (XINT (length), vec);
 699 }
 700 \f
 701 Lisp_Object merge ();
 702
 703 DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
 704   "Sort LIST, stably, comparing elements using PREDICATE.\n\
 705 Returns the sorted list.  LIST is modified by side effects.\n\
 706 PREDICATE is called with two elements of LIST, and should return T\n\
 707 if the first element is \"less\" than the second.")
 708   (list, pred)
 709      Lisp_Object list, pred;
 710 {
 711   Lisp_Object front, back;
 712   register Lisp_Object len, tem;
 713   struct gcpro gcpro1, gcpro2;
 714   register int length;
 715
 716   front = list;
 717   len = Flength (list);
 718   length = XINT (len);
 719   if (length < 2)
 720     return list;
 721
 722   XSETINT (len, (length / 2) - 1);
 723   tem = Fnthcdr (len, list);
 724   back = Fcdr (tem);
 725   Fsetcdr (tem, Qnil);
 726
 727   GCPRO2 (front, back);
 728   front = Fsort (front, pred);
 729   back = Fsort (back, pred);
 730   UNGCPRO;
 731   return merge (front, back, pred);
 732 }
 733
 734 Lisp_Object
 735 merge (org_l1, org_l2, pred)
 736      Lisp_Object org_l1, org_l2;
 737      Lisp_Object pred;
 738 {
 739   Lisp_Object value;
 740   register Lisp_Object tail;
 741   Lisp_Object tem;
 742   register Lisp_Object l1, l2;
 743   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 744
 745   l1 = org_l1;
 746   l2 = org_l2;
 747   tail = Qnil;
 748   value = Qnil;
 749
 750   /* It is sufficient to protect org_l1 and org_l2.
 751      When l1 and l2 are updated, we copy the new values
 752      back into the org_ vars.  */
 753   GCPRO4 (org_l1, org_l2, pred, value);
 754
 755   while (1)
 756     {
 757       if (NILP (l1))
 758         {
 759           UNGCPRO;
 760           if (NILP (tail))
 761             return l2;
 762           Fsetcdr (tail, l2);
 763           return value;
 764         }
 765       if (NILP (l2))
 766         {
 767           UNGCPRO;
 768           if (NILP (tail))
 769             return l1;
 770           Fsetcdr (tail, l1);
 771           return value;
 772         }
 773       tem = call2 (pred, Fcar (l2), Fcar (l1));
 774       if (NILP (tem))
 775         {
 776           tem = l1;
 777           l1 = Fcdr (l1);
 778           org_l1 = l1;
 779         }
 780       else
 781         {
 782           tem = l2;
 783           l2 = Fcdr (l2);
 784           org_l2 = l2;
 785         }
 786       if (NILP (tail))
 787         value = tem;
 788       else
 789         Fsetcdr (tail, tem);
 790       tail = tem;
 791     }
 792 }
 793 \f
 794 DEFUN ("get", Fget, Sget, 2, 2, 0,
 795   "Return the value of SYMBOL's PROPNAME property.\n\
 796 This is the last VALUE stored with `(put SYMBOL PROPNAME VALUE)'.")
 797   (sym, prop)
 798      Lisp_Object sym;
 799      register Lisp_Object prop;
 800 {
 801   register Lisp_Object tail;
 802   for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
 803     {
 804       register Lisp_Object tem;
 805       tem = Fcar (tail);
 806       if (EQ (prop, tem))
 807         return Fcar (Fcdr (tail));
 808     }
 809   return Qnil;
 810 }
 811
 812 DEFUN ("put", Fput, Sput, 3, 3, 0,
 813   "Store SYMBOL's PROPNAME property with value VALUE.\n\
 814 It can be retrieved with `(get SYMBOL PROPNAME)'.")
 815   (sym, prop, val)
 816      Lisp_Object sym;
 817      register Lisp_Object prop;
 818      Lisp_Object val;
 819 {
 820   register Lisp_Object tail, prev;
 821   Lisp_Object newcell;
 822   prev = Qnil;
 823   for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
 824     {
 825       register Lisp_Object tem;
 826       tem = Fcar (tail);
 827       if (EQ (prop, tem))
 828         return Fsetcar (Fcdr (tail), val);
 829       prev = tail;
 830     }
 831   newcell = Fcons (prop, Fcons (val, Qnil));
 832   if (NILP (prev))
 833     Fsetplist (sym, newcell);
 834   else
 835     Fsetcdr (Fcdr (prev), newcell);
 836   return val;
 837 }
 838
 839 DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
 840   "T if two Lisp objects have similar structure and contents.\n\
 841 They must have the same data type.\n\
 842 Conses are compared by comparing the cars and the cdrs.\n\
 843 Vectors and strings are compared element by element.\n\
 844 Numbers are compared by value, but integers cannot equal floats.\n\
 845  (Use `=' if you want integers and floats to be able to be equal.)\n\
 846 Symbols must match exactly.")
 847   (o1, o2)
 848      register Lisp_Object o1, o2;
 849 {
 850   return internal_equal (o1, o2, 0);
 851 }
 852
 853 static Lisp_Object
 854 internal_equal (o1, o2, depth)
 855      register Lisp_Object o1, o2;
 856      int depth;
 857 {
 858   if (depth > 200)
 859     error ("Stack overflow in equal");
 860 do_cdr:
 861   QUIT;
 862   if (EQ (o1, o2)) return Qt;
 863 #ifdef LISP_FLOAT_TYPE
 864   if (FLOATP (o1) && FLOATP (o2))
 865     return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil;
 866 #endif
 867   if (XTYPE (o1) != XTYPE (o2)) return Qnil;
 868   if (XTYPE (o1) == Lisp_Cons
 869       || XTYPE (o1) == Lisp_Overlay)
 870     {
 871       Lisp_Object v1;
 872       v1 = internal_equal (Fcar (o1), Fcar (o2), depth + 1);
 873       if (NILP (v1))
 874         return v1;
 875       o1 = Fcdr (o1), o2 = Fcdr (o2);
 876       goto do_cdr;
 877     }
 878   if (XTYPE (o1) == Lisp_Marker)
 879     {
 880       return ((XMARKER (o1)->buffer == XMARKER (o2)->buffer
 881               && (XMARKER (o1)->buffer == 0
 882                   || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos))
 883               ? Qt : Qnil);
 884     }
 885   if (XTYPE (o1) == Lisp_Vector
 886       || XTYPE (o1) == Lisp_Compiled)
 887     {
 888       register int index;
 889       if (XVECTOR (o1)->size != XVECTOR (o2)->size)
 890         return Qnil;
 891       for (index = 0; index < XVECTOR (o1)->size; index++)
 892         {
 893           Lisp_Object v, v1, v2;
 894           v1 = XVECTOR (o1)->contents [index];
 895           v2 = XVECTOR (o2)->contents [index];
 896           v = internal_equal (v1, v2, depth + 1);
 897           if (NILP (v)) return v;
 898         }
 899       return Qt;
 900     }
 901   if (XTYPE (o1) == Lisp_String)
 902     {
 903       if (XSTRING (o1)->size != XSTRING (o2)->size)
 904         return Qnil;
 905       if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size))
 906         return Qnil;
 907       return Qt;
 908     }
 909   return Qnil;
 910 }
 911 \f
 912 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
 913   "Store each element of ARRAY with ITEM.  ARRAY is a vector or string.")
 914   (array, item)
 915      Lisp_Object array, item;
 916 {
 917   register int size, index, charval;
 918  retry:
 919   if (XTYPE (array) == Lisp_Vector)
 920     {
 921       register Lisp_Object *p = XVECTOR (array)->contents;
 922       size = XVECTOR (array)->size;
 923       for (index = 0; index < size; index++)
 924         p[index] = item;
 925     }
 926   else if (XTYPE (array) == Lisp_String)
 927     {
 928       register unsigned char *p = XSTRING (array)->data;
 929       CHECK_NUMBER (item, 1);
 930       charval = XINT (item);
 931       size = XSTRING (array)->size;
 932       for (index = 0; index < size; index++)
 933         p[index] = charval;
 934     }
 935   else
 936     {
 937       array = wrong_type_argument (Qarrayp, array);
 938       goto retry;
 939     }
 940   return array;
 941 }
 942
 943 /* ARGSUSED */
 944 Lisp_Object
 945 nconc2 (s1, s2)
 946      Lisp_Object s1, s2;
 947 {
 948 #ifdef NO_ARG_ARRAY
 949   Lisp_Object args[2];
 950   args[0] = s1;
 951   args[1] = s2;
 952   return Fnconc (2, args);
 953 #else
 954   return Fnconc (2, &s1);
 955 #endif /* NO_ARG_ARRAY */
 956 }
 957
 958 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
 959   "Concatenate any number of lists by altering them.\n\
 960 Only the last argument is not altered, and need not be a list.")
 961   (nargs, args)
 962      int nargs;
 963      Lisp_Object *args;
 964 {
 965   register int argnum;
 966   register Lisp_Object tail, tem, val;
 967
 968   val = Qnil;
 969
 970   for (argnum = 0; argnum < nargs; argnum++)
 971     {
 972       tem = args[argnum];
 973       if (NILP (tem)) continue;
 974
 975       if (NILP (val))
 976         val = tem;
 977
 978       if (argnum + 1 == nargs) break;
 979
 980       if (!CONSP (tem))
 981         tem = wrong_type_argument (Qlistp, tem);
 982
 983       while (CONSP (tem))
 984         {
 985           tail = tem;
 986           tem = Fcdr (tail);
 987           QUIT;
 988         }
 989
 990       tem = args[argnum + 1];
 991       Fsetcdr (tail, tem);
 992       if (NILP (tem))
 993         args[argnum + 1] = tail;
 994     }
 995
 996   return val;
 997 }
 998 \f
 999 /* This is the guts of all mapping functions.
1000  Apply fn to each element of seq, one by one,
1001  storing the results into elements of vals, a C vector of Lisp_Objects.
1002  leni is the length of vals, which should also be the length of seq. */
1003
1004 static void
1005 mapcar1 (leni, vals, fn, seq)
1006      int leni;
1007      Lisp_Object *vals;
1008      Lisp_Object fn, seq;
1009 {
1010   register Lisp_Object tail;
1011   Lisp_Object dummy;
1012   register int i;
1013   struct gcpro gcpro1, gcpro2, gcpro3;
1014
1015   /* Don't let vals contain any garbage when GC happens.  */
1016   for (i = 0; i < leni; i++)
1017     vals[i] = Qnil;
1018
1019   GCPRO3 (dummy, fn, seq);
1020   gcpro1.var = vals;
1021   gcpro1.nvars = leni;
1022   /* We need not explicitly protect `tail' because it is used only on lists, and
1023     1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
1024
1025   if (XTYPE (seq) == Lisp_Vector)
1026     {
1027       for (i = 0; i < leni; i++)
1028         {
1029           dummy = XVECTOR (seq)->contents[i];
1030           vals[i] = call1 (fn, dummy);
1031         }
1032     }
1033   else if (XTYPE (seq) == Lisp_String)
1034     {
1035       for (i = 0; i < leni; i++)
1036         {
1037           XFASTINT (dummy) = XSTRING (seq)->data[i];
1038           vals[i] = call1 (fn, dummy);
1039         }
1040     }
1041   else   /* Must be a list, since Flength did not get an error */
1042     {
1043       tail = seq;
1044       for (i = 0; i < leni; i++)
1045         {
1046           vals[i] = call1 (fn, Fcar (tail));
1047           tail = Fcdr (tail);
1048         }
1049     }
1050
1051   UNGCPRO;
1052 }
1053
1054 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
1055   "Apply FN to each element of SEQ, and concat the results as strings.\n\
1056 In between each pair of results, stick in SEP.\n\
1057 Thus, \" \" as SEP results in spaces between the values returned by FN.")
1058   (fn, seq, sep)
1059      Lisp_Object fn, seq, sep;
1060 {
1061   Lisp_Object len;
1062   register int leni;
1063   int nargs;
1064   register Lisp_Object *args;
1065   register int i;
1066   struct gcpro gcpro1;
1067
1068   len = Flength (seq);
1069   leni = XINT (len);
1070   nargs = leni + leni - 1;
1071   if (nargs < 0) return build_string ("");
1072
1073   args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
1074
1075   GCPRO1 (sep);
1076   mapcar1 (leni, args, fn, seq);
1077   UNGCPRO;
1078
1079   for (i = leni - 1; i >= 0; i--)
1080     args[i + i] = args[i];
1081
1082   for (i = 1; i < nargs; i += 2)
1083     args[i] = sep;
1084
1085   return Fconcat (nargs, args);
1086 }
1087
1088 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
1089   "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
1090 The result is a list just as long as SEQUENCE.\n\
1091 SEQUENCE may be a list, a vector or a string.")
1092   (fn, seq)
1093      Lisp_Object fn, seq;
1094 {
1095   register Lisp_Object len;
1096   register int leni;
1097   register Lisp_Object *args;
1098
1099   len = Flength (seq);
1100   leni = XFASTINT (len);
1101   args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
1102
1103   mapcar1 (leni, args, fn, seq);
1104
1105   return Flist (leni, args);
1106 }
1107 \f
1108 /* Anything that calls this function must protect from GC!  */
1109
1110 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
1111   "Ask user a \"y or n\" question.  Return t if answer is \"y\".\n\
1112 Takes one argument, which is the string to display to ask the question.\n\
1113 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
1114 No confirmation of the answer is requested; a single character is enough.\n\
1115 Also accepts Space to mean yes, or Delete to mean no.")
1116   (prompt)
1117      Lisp_Object prompt;
1118 {
1119   register Lisp_Object obj, key, def, answer_string, map;
1120   register int answer;
1121   Lisp_Object xprompt;
1122   Lisp_Object args[2];
1123   int ocech = cursor_in_echo_area;
1124   struct gcpro gcpro1, gcpro2;
1125
1126   map = Fsymbol_value (intern ("query-replace-map"));
1127
1128   CHECK_STRING (prompt, 0);
1129   xprompt = prompt;
1130   GCPRO2 (prompt, xprompt);
1131
1132   while (1)
1133     {
1134 #ifdef HAVE_X_MENU
1135       if (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
1136         {
1137           Lisp_Object pane, menu;
1138           pane = Fcons (Fcons (build_string ("Yes"), Qt),
1139                         Fcons (Fcons (build_string ("No"), Qnil),
1140                                Qnil));
1141           menu = Fcons (prompt, pane);
1142           obj = Fx_popup_dialog (Qt, menu);
1143           answer = !NILP (obj);
1144           break;
1145         }
1146 #endif
1147       cursor_in_echo_area = 1;
1148       message ("%s(y or n) ", XSTRING (xprompt)->data);
1149
1150       obj = read_filtered_event (1, 0, 0);
1151       cursor_in_echo_area = 0;
1152       /* If we need to quit, quit with cursor_in_echo_area = 0.  */
1153       QUIT;
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 #ifdef HAVE_X_MENU
1236   if (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
1237     {
1238       Lisp_Object pane, menu, obj;
1239       pane = Fcons (Fcons (build_string ("Yes"), Qt),
1240                     Fcons (Fcons (build_string ("No"), Qnil),
1241                            Qnil));
1242       GCPRO1 (pane);
1243       menu = Fcons (prompt, pane);
1244       obj = Fx_popup_dialog (Qt, menu);
1245       UNGCPRO;
1246       return obj;
1247     }
1248 #endif
1249
1250   args[0] = prompt;
1251   args[1] = build_string ("(yes or no) ");
1252   prompt = Fconcat (2, args);
1253
1254   GCPRO1 (prompt);
1255
1256   while (1)
1257     {
1258       ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
1259                                               Qyes_or_no_p_history));
1260       if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
1261         {
1262           UNGCPRO;
1263           return Qt;
1264         }
1265       if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
1266         {
1267           UNGCPRO;
1268           return Qnil;
1269         }
1270
1271       Fding (Qnil);
1272       Fdiscard_input ();
1273       message ("Please answer yes or no.");
1274       Fsleep_for (make_number (2), Qnil);
1275     }
1276 }
1277 \f
1278 DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
1279   "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
1280 Each of the three load averages is multiplied by 100,\n\
1281 then converted to integer.\n\
1282 If the 5-minute or 15-minute load averages are not available, return a\n\
1283 shortened list, containing only those averages which are available.")
1284   ()
1285 {
1286   double load_ave[3];
1287   int loads = getloadavg (load_ave, 3);
1288   Lisp_Object ret;
1289
1290   if (loads < 0)
1291     error ("load-average not implemented for this operating system");
1292
1293   ret = Qnil;
1294   while (loads > 0)
1295     ret = Fcons (make_number ((int) (load_ave[--loads] * 100.0)), ret);
1296
1297   return ret;
1298 }
1299 \f
1300 Lisp_Object Vfeatures;
1301
1302 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
1303   "Returns t if FEATURE is present in this Emacs.\n\
1304 Use this to conditionalize execution of lisp code based on the presence or\n\
1305 absence of emacs or environment extensions.\n\
1306 Use `provide' to declare that a feature is available.\n\
1307 This function looks at the value of the variable `features'.")
1308      (feature)
1309      Lisp_Object feature;
1310 {
1311   register Lisp_Object tem;
1312   CHECK_SYMBOL (feature, 0);
1313   tem = Fmemq (feature, Vfeatures);
1314   return (NILP (tem)) ? Qnil : Qt;
1315 }
1316
1317 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
1318   "Announce that FEATURE is a feature of the current Emacs.")
1319      (feature)
1320      Lisp_Object feature;
1321 {
1322   register Lisp_Object tem;
1323   CHECK_SYMBOL (feature, 0);
1324   if (!NILP (Vautoload_queue))
1325     Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
1326   tem = Fmemq (feature, Vfeatures);
1327   if (NILP (tem))
1328     Vfeatures = Fcons (feature, Vfeatures);
1329   LOADHIST_ATTACH (Fcons (Qprovide, feature));
1330   return feature;
1331 }
1332
1333 DEFUN ("require", Frequire, Srequire, 1, 2, 0,
1334   "If feature FEATURE is not loaded, load it from FILENAME.\n\
1335 If FEATURE is not a member of the list `features', then the feature\n\
1336 is not loaded; so load the file FILENAME.\n\
1337 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
1338      (feature, file_name)
1339      Lisp_Object feature, file_name;
1340 {
1341   register Lisp_Object tem;
1342   CHECK_SYMBOL (feature, 0);
1343   tem = Fmemq (feature, Vfeatures);
1344   LOADHIST_ATTACH (Fcons (Qrequire, feature));
1345   if (NILP (tem))
1346     {
1347       int count = specpdl_ptr - specpdl;
1348
1349       /* Value saved here is to be restored into Vautoload_queue */
1350       record_unwind_protect (un_autoload, Vautoload_queue);
1351       Vautoload_queue = Qt;
1352
1353       Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
1354              Qnil, Qt, Qnil);
1355
1356       tem = Fmemq (feature, Vfeatures);
1357       if (NILP (tem))
1358         error ("Required feature %s was not provided",
1359                XSYMBOL (feature)->name->data );
1360
1361       /* Once loading finishes, don't undo it.  */
1362       Vautoload_queue = Qt;
1363       feature = unbind_to (count, feature);
1364     }
1365   return feature;
1366 }
1367 \f
1368 syms_of_fns ()
1369 {
1370   Qstring_lessp = intern ("string-lessp");
1371   staticpro (&Qstring_lessp);
1372   Qprovide = intern ("provide");
1373   staticpro (&Qprovide);
1374   Qrequire = intern ("require");
1375   staticpro (&Qrequire);
1376   Qyes_or_no_p_history = intern ("yes-or-no-p-history");
1377   staticpro (&Qyes_or_no_p_history);
1378
1379   DEFVAR_LISP ("features", &Vfeatures,
1380     "A list of symbols which are the features of the executing emacs.\n\
1381 Used by `featurep' and `require', and altered by `provide'.");
1382   Vfeatures = Qnil;
1383
1384   defsubr (&Sidentity);
1385   defsubr (&Srandom);
1386   defsubr (&Slength);
1387   defsubr (&Sstring_equal);
1388   defsubr (&Sstring_lessp);
1389   defsubr (&Sappend);
1390   defsubr (&Sconcat);
1391   defsubr (&Svconcat);
1392   defsubr (&Scopy_sequence);
1393   defsubr (&Scopy_alist);
1394   defsubr (&Ssubstring);
1395   defsubr (&Snthcdr);
1396   defsubr (&Snth);
1397   defsubr (&Selt);
1398   defsubr (&Smember);
1399   defsubr (&Smemq);
1400   defsubr (&Sassq);
1401   defsubr (&Sassoc);
1402   defsubr (&Srassq);
1403   defsubr (&Sdelq);
1404   defsubr (&Sdelete);
1405   defsubr (&Snreverse);
1406   defsubr (&Sreverse);
1407   defsubr (&Ssort);
1408   defsubr (&Sget);
1409   defsubr (&Sput);
1410   defsubr (&Sequal);
1411   defsubr (&Sfillarray);
1412   defsubr (&Snconc);
1413   defsubr (&Smapcar);
1414   defsubr (&Smapconcat);
1415   defsubr (&Sy_or_n_p);
1416   defsubr (&Syes_or_no_p);
1417   defsubr (&Sload_average);
1418   defsubr (&Sfeaturep);
1419   defsubr (&Srequire);
1420   defsubr (&Sprovide);
1421 }