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