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