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)->buffer == 0
 875                   || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos))
 876               ? Qt : Qnil);
 877     }
 878   if (XTYPE (o1) == Lisp_Vector
 879       || XTYPE (o1) == Lisp_Compiled)
 880     {
 881       register int index;
 882       if (XVECTOR (o1)->size != XVECTOR (o2)->size)
 883         return Qnil;
 884       for (index = 0; index < XVECTOR (o1)->size; index++)
 885         {
 886           Lisp_Object v, v1, v2;
 887           v1 = XVECTOR (o1)->contents [index];
 888           v2 = XVECTOR (o2)->contents [index];
 889           v = internal_equal (v1, v2, depth + 1);
 890           if (NILP (v)) return v;
 891         }
 892       return Qt;
 893     }
 894   if (XTYPE (o1) == Lisp_String)
 895     {
 896       if (XSTRING (o1)->size != XSTRING (o2)->size)
 897         return Qnil;
 898       if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size))
 899         return Qnil;
 900       return Qt;
 901     }
 902   return Qnil;
 903 }
 904 \f
 905 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
 906   "Store each element of ARRAY with ITEM.  ARRAY is a vector or string.")
 907   (array, item)
 908      Lisp_Object array, item;
 909 {
 910   register int size, index, charval;
 911  retry:
 912   if (XTYPE (array) == Lisp_Vector)
 913     {
 914       register Lisp_Object *p = XVECTOR (array)->contents;
 915       size = XVECTOR (array)->size;
 916       for (index = 0; index < size; index++)
 917         p[index] = item;
 918     }
 919   else if (XTYPE (array) == Lisp_String)
 920     {
 921       register unsigned char *p = XSTRING (array)->data;
 922       CHECK_NUMBER (item, 1);
 923       charval = XINT (item);
 924       size = XSTRING (array)->size;
 925       for (index = 0; index < size; index++)
 926         p[index] = charval;
 927     }
 928   else
 929     {
 930       array = wrong_type_argument (Qarrayp, array);
 931       goto retry;
 932     }
 933   return array;
 934 }
 935
 936 /* ARGSUSED */
 937 Lisp_Object
 938 nconc2 (s1, s2)
 939      Lisp_Object s1, s2;
 940 {
 941 #ifdef NO_ARG_ARRAY
 942   Lisp_Object args[2];
 943   args[0] = s1;
 944   args[1] = s2;
 945   return Fnconc (2, args);
 946 #else
 947   return Fnconc (2, &s1);
 948 #endif /* NO_ARG_ARRAY */
 949 }
 950
 951 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
 952   "Concatenate any number of lists by altering them.\n\
 953 Only the last argument is not altered, and need not be a list.")
 954   (nargs, args)
 955      int nargs;
 956      Lisp_Object *args;
 957 {
 958   register int argnum;
 959   register Lisp_Object tail, tem, val;
 960
 961   val = Qnil;
 962
 963   for (argnum = 0; argnum < nargs; argnum++)
 964     {
 965       tem = args[argnum];
 966       if (NILP (tem)) continue;
 967
 968       if (NILP (val))
 969         val = tem;
 970
 971       if (argnum + 1 == nargs) break;
 972
 973       if (!CONSP (tem))
 974         tem = wrong_type_argument (Qlistp, tem);
 975
 976       while (CONSP (tem))
 977         {
 978           tail = tem;
 979           tem = Fcdr (tail);
 980           QUIT;
 981         }
 982
 983       tem = args[argnum + 1];
 984       Fsetcdr (tail, tem);
 985       if (NILP (tem))
 986         args[argnum + 1] = tail;
 987     }
 988
 989   return val;
 990 }
 991 \f
 992 /* This is the guts of all mapping functions.
 993  Apply fn to each element of seq, one by one,
 994  storing the results into elements of vals, a C vector of Lisp_Objects.
 995  leni is the length of vals, which should also be the length of seq. */
 996
 997 static void
 998 mapcar1 (leni, vals, fn, seq)
 999      int leni;
1000      Lisp_Object *vals;
1001      Lisp_Object fn, seq;
1002 {
1003   register Lisp_Object tail;
1004   Lisp_Object dummy;
1005   register int i;
1006   struct gcpro gcpro1, gcpro2, gcpro3;
1007
1008   /* Don't let vals contain any garbage when GC happens.  */
1009   for (i = 0; i < leni; i++)
1010     vals[i] = Qnil;
1011
1012   GCPRO3 (dummy, fn, seq);
1013   gcpro1.var = vals;
1014   gcpro1.nvars = leni;
1015   /* We need not explicitly protect `tail' because it is used only on lists, and
1016     1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
1017
1018   if (XTYPE (seq) == Lisp_Vector)
1019     {
1020       for (i = 0; i < leni; i++)
1021         {
1022           dummy = XVECTOR (seq)->contents[i];
1023           vals[i] = call1 (fn, dummy);
1024         }
1025     }
1026   else if (XTYPE (seq) == Lisp_String)
1027     {
1028       for (i = 0; i < leni; i++)
1029         {
1030           XFASTINT (dummy) = XSTRING (seq)->data[i];
1031           vals[i] = call1 (fn, dummy);
1032         }
1033     }
1034   else   /* Must be a list, since Flength did not get an error */
1035     {
1036       tail = seq;
1037       for (i = 0; i < leni; i++)
1038         {
1039           vals[i] = call1 (fn, Fcar (tail));
1040           tail = Fcdr (tail);
1041         }
1042     }
1043
1044   UNGCPRO;
1045 }
1046
1047 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
1048   "Apply FN to each element of SEQ, and concat the results as strings.\n\
1049 In between each pair of results, stick in SEP.\n\
1050 Thus, \" \" as SEP results in spaces between the values return by FN.")
1051   (fn, seq, sep)
1052      Lisp_Object fn, seq, sep;
1053 {
1054   Lisp_Object len;
1055   register int leni;
1056   int nargs;
1057   register Lisp_Object *args;
1058   register int i;
1059   struct gcpro gcpro1;
1060
1061   len = Flength (seq);
1062   leni = XINT (len);
1063   nargs = leni + leni - 1;
1064   if (nargs < 0) return build_string ("");
1065
1066   args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
1067
1068   GCPRO1 (sep);
1069   mapcar1 (leni, args, fn, seq);
1070   UNGCPRO;
1071
1072   for (i = leni - 1; i >= 0; i--)
1073     args[i + i] = args[i];
1074
1075   for (i = 1; i < nargs; i += 2)
1076     args[i] = sep;
1077
1078   return Fconcat (nargs, args);
1079 }
1080
1081 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
1082   "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
1083 The result is a list just as long as SEQUENCE.\n\
1084 SEQUENCE may be a list, a vector or a string.")
1085   (fn, seq)
1086      Lisp_Object fn, seq;
1087 {
1088   register Lisp_Object len;
1089   register int leni;
1090   register Lisp_Object *args;
1091
1092   len = Flength (seq);
1093   leni = XFASTINT (len);
1094   args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
1095
1096   mapcar1 (leni, args, fn, seq);
1097
1098   return Flist (leni, args);
1099 }
1100 \f
1101 /* Anything that calls this function must protect from GC!  */
1102
1103 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
1104   "Ask user a \"y or n\" question.  Return t if answer is \"y\".\n\
1105 Takes one argument, which is the string to display to ask the question.\n\
1106 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
1107 No confirmation of the answer is requested; a single character is enough.\n\
1108 Also accepts Space to mean yes, or Delete to mean no.")
1109   (prompt)
1110      Lisp_Object prompt;
1111 {
1112   register Lisp_Object obj, key, def, answer_string, map;
1113   register int answer;
1114   Lisp_Object xprompt;
1115   Lisp_Object args[2];
1116   int ocech = cursor_in_echo_area;
1117   struct gcpro gcpro1, gcpro2;
1118
1119   map = Fsymbol_value (intern ("query-replace-map"));
1120
1121   CHECK_STRING (prompt, 0);
1122   xprompt = prompt;
1123   GCPRO2 (prompt, xprompt);
1124
1125   while (1)
1126     {
1127       cursor_in_echo_area = 1;
1128       message ("%s(y or n) ", XSTRING (xprompt)->data);
1129
1130       obj = read_filtered_event (1, 0, 0);
1131       cursor_in_echo_area = 0;
1132       /* If we need to quit, quit with cursor_in_echo_area = 0.  */
1133       QUIT;
1134
1135       key = Fmake_vector (make_number (1), obj);
1136       def = Flookup_key (map, key);
1137       answer_string = Fsingle_key_description (obj);
1138
1139       if (EQ (def, intern ("skip")))
1140         {
1141           answer = 0;
1142           break;
1143         }
1144       else if (EQ (def, intern ("act")))
1145         {
1146           answer = 1;
1147           break;
1148         }
1149       else if (EQ (def, intern ("recenter")))
1150         {
1151           Frecenter (Qnil);
1152           xprompt = prompt;
1153           continue;
1154         }
1155       else if (EQ (def, intern ("quit")))
1156         Vquit_flag = Qt;
1157
1158       QUIT;
1159
1160       /* If we don't clear this, then the next call to read_char will
1161          return quit_char again, and we'll enter an infinite loop.  */
1162       Vquit_flag = Qnil;
1163
1164       Fding (Qnil);
1165       Fdiscard_input ();
1166       if (EQ (xprompt, prompt))
1167         {
1168           args[0] = build_string ("Please answer y or n.  ");
1169           args[1] = prompt;
1170           xprompt = Fconcat (2, args);
1171         }
1172     }
1173   UNGCPRO;
1174
1175   if (! noninteractive)
1176     {
1177       cursor_in_echo_area = -1;
1178       message ("%s(y or n) %c", XSTRING (xprompt)->data, answer ? 'y' : 'n');
1179       cursor_in_echo_area = ocech;
1180     }
1181
1182   return answer ? Qt : Qnil;
1183 }
1184 \f
1185 /* This is how C code calls `yes-or-no-p' and allows the user
1186    to redefined it.
1187
1188    Anything that calls this function must protect from GC!  */
1189
1190 Lisp_Object
1191 do_yes_or_no_p (prompt)
1192      Lisp_Object prompt;
1193 {
1194   return call1 (intern ("yes-or-no-p"), prompt);
1195 }
1196
1197 /* Anything that calls this function must protect from GC!  */
1198
1199 DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
1200   "Ask user a yes-or-no question.  Return t if answer is yes.\n\
1201 Takes one argument, which is the string to display to ask the question.\n\
1202 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
1203 The user must confirm the answer with RET,\n\
1204 and can edit it until it as been confirmed.")
1205   (prompt)
1206      Lisp_Object prompt;
1207 {
1208   register Lisp_Object ans;
1209   Lisp_Object args[2];
1210   struct gcpro gcpro1;
1211
1212   CHECK_STRING (prompt, 0);
1213
1214   args[0] = prompt;
1215   args[1] = build_string ("(yes or no) ");
1216   prompt = Fconcat (2, args);
1217
1218   GCPRO1 (prompt);
1219   while (1)
1220     {
1221       ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
1222                                               Qyes_or_no_p_history));
1223       if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
1224         {
1225           UNGCPRO;
1226           return Qt;
1227         }
1228       if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
1229         {
1230           UNGCPRO;
1231           return Qnil;
1232         }
1233
1234       Fding (Qnil);
1235       Fdiscard_input ();
1236       message ("Please answer yes or no.");
1237       Fsleep_for (make_number (2), Qnil);
1238     }
1239 }
1240 \f
1241 DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
1242   "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
1243 Each of the three load averages is multiplied by 100,\n\
1244 then converted to integer.\n\
1245 If the 5-minute or 15-minute load averages are not available, return a\n\
1246 shortened list, containing only those averages which are available.")
1247   ()
1248 {
1249   double load_ave[3];
1250   int loads = getloadavg (load_ave, 3);
1251   Lisp_Object ret;
1252
1253   if (loads < 0)
1254     error ("load-average not implemented for this operating system");
1255
1256   ret = Qnil;
1257   while (loads > 0)
1258     ret = Fcons (make_number ((int) (load_ave[--loads] * 100.0)), ret);
1259
1260   return ret;
1261 }
1262 \f
1263 Lisp_Object Vfeatures;
1264
1265 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
1266   "Returns t if FEATURE is present in this Emacs.\n\
1267 Use this to conditionalize execution of lisp code based on the presence or\n\
1268 absence of emacs or environment extensions.\n\
1269 Use `provide' to declare that a feature is available.\n\
1270 This function looks at the value of the variable `features'.")
1271      (feature)
1272      Lisp_Object feature;
1273 {
1274   register Lisp_Object tem;
1275   CHECK_SYMBOL (feature, 0);
1276   tem = Fmemq (feature, Vfeatures);
1277   return (NILP (tem)) ? Qnil : Qt;
1278 }
1279
1280 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
1281   "Announce that FEATURE is a feature of the current Emacs.")
1282      (feature)
1283      Lisp_Object feature;
1284 {
1285   register Lisp_Object tem;
1286   CHECK_SYMBOL (feature, 0);
1287   if (!NILP (Vautoload_queue))
1288     Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
1289   tem = Fmemq (feature, Vfeatures);
1290   if (NILP (tem))
1291     Vfeatures = Fcons (feature, Vfeatures);
1292   LOADHIST_ATTACH (Fcons (Qprovide, feature));
1293   return feature;
1294 }
1295
1296 DEFUN ("require", Frequire, Srequire, 1, 2, 0,
1297   "If feature FEATURE is not loaded, load it from FILENAME.\n\
1298 If FEATURE is not a member of the list `features', then the feature\n\
1299 is not loaded; so load the file FILENAME.\n\
1300 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
1301      (feature, file_name)
1302      Lisp_Object feature, file_name;
1303 {
1304   register Lisp_Object tem;
1305   CHECK_SYMBOL (feature, 0);
1306   tem = Fmemq (feature, Vfeatures);
1307   LOADHIST_ATTACH (Fcons (Qrequire, feature));
1308   if (NILP (tem))
1309     {
1310       int count = specpdl_ptr - specpdl;
1311
1312       /* Value saved here is to be restored into Vautoload_queue */
1313       record_unwind_protect (un_autoload, Vautoload_queue);
1314       Vautoload_queue = Qt;
1315
1316       Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
1317              Qnil, Qt, Qnil);
1318
1319       tem = Fmemq (feature, Vfeatures);
1320       if (NILP (tem))
1321         error ("Required feature %s was not provided",
1322                XSYMBOL (feature)->name->data );
1323
1324       /* Once loading finishes, don't undo it.  */
1325       Vautoload_queue = Qt;
1326       feature = unbind_to (count, feature);
1327     }
1328   return feature;
1329 }
1330 \f
1331 syms_of_fns ()
1332 {
1333   Qstring_lessp = intern ("string-lessp");
1334   staticpro (&Qstring_lessp);
1335   Qprovide = intern ("provide");
1336   staticpro (&Qprovide);
1337   Qrequire = intern ("require");
1338   staticpro (&Qrequire);
1339   Qyes_or_no_p_history = intern ("yes-or-no-p-history");
1340   staticpro (&Qyes_or_no_p_history);
1341
1342   DEFVAR_LISP ("features", &Vfeatures,
1343     "A list of symbols which are the features of the executing emacs.\n\
1344 Used by `featurep' and `require', and altered by `provide'.");
1345   Vfeatures = Qnil;
1346
1347   defsubr (&Sidentity);
1348   defsubr (&Srandom);
1349   defsubr (&Slength);
1350   defsubr (&Sstring_equal);
1351   defsubr (&Sstring_lessp);
1352   defsubr (&Sappend);
1353   defsubr (&Sconcat);
1354   defsubr (&Svconcat);
1355   defsubr (&Scopy_sequence);
1356   defsubr (&Scopy_alist);
1357   defsubr (&Ssubstring);
1358   defsubr (&Snthcdr);
1359   defsubr (&Snth);
1360   defsubr (&Selt);
1361   defsubr (&Smember);
1362   defsubr (&Smemq);
1363   defsubr (&Sassq);
1364   defsubr (&Sassoc);
1365   defsubr (&Srassq);
1366   defsubr (&Sdelq);
1367   defsubr (&Sdelete);
1368   defsubr (&Snreverse);
1369   defsubr (&Sreverse);
1370   defsubr (&Ssort);
1371   defsubr (&Sget);
1372   defsubr (&Sput);
1373   defsubr (&Sequal);
1374   defsubr (&Sfillarray);
1375   defsubr (&Snconc);
1376   defsubr (&Smapcar);
1377   defsubr (&Smapconcat);
1378   defsubr (&Sy_or_n_p);
1379   defsubr (&Syes_or_no_p);
1380   defsubr (&Sload_average);
1381   defsubr (&Sfeaturep);
1382   defsubr (&Srequire);
1383   defsubr (&Sprovide);
1384 }