(Frequire): Mention get-load-suffixes.
[bpt/emacs.git] / src / fns.c
index 4e22276..8cccd74 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -23,6 +23,8 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <time.h>
 #include <setjmp.h>
 
+#include <intprops.h>
+
 #include "lisp.h"
 #include "commands.h"
 #include "character.h"
@@ -51,6 +53,8 @@ Lisp_Object Qcursor_in_echo_area;
 static Lisp_Object Qwidget_type;
 static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
 
+static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512;
+
 static int internal_equal (Lisp_Object , Lisp_Object, int, int);
 
 #ifndef HAVE_UNISTD_H
@@ -99,6 +103,10 @@ Other values of LIMIT are ignored.  */)
   return lispy_val;
 }
 \f
+/* Heuristic on how many iterations of a tight loop can be safely done
+   before it's time to do a QUIT.  This must be a power of 2.  */
+enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
+
 /* Random data-structure functions */
 
 DEFUN ("length", Flength, Slength, 1, 1, 0,
@@ -110,7 +118,6 @@ To get the number of bytes, use `string-bytes'.  */)
   (register Lisp_Object sequence)
 {
   register Lisp_Object val;
-  register int i;
 
   if (STRINGP (sequence))
     XSETFASTINT (val, SCHARS (sequence));
@@ -124,19 +131,20 @@ To get the number of bytes, use `string-bytes'.  */)
     XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
   else if (CONSP (sequence))
     {
-      i = 0;
-      while (CONSP (sequence))
+      EMACS_INT i = 0;
+
+      do
        {
-         sequence = XCDR (sequence);
          ++i;
-
-         if (!CONSP (sequence))
-           break;
-
+         if ((i & (QUIT_COUNT_HEURISTIC - 1)) == 0)
+           {
+             if (MOST_POSITIVE_FIXNUM < i)
+               error ("List too long");
+             QUIT;
+           }
          sequence = XCDR (sequence);
-         ++i;
-         QUIT;
        }
+      while (CONSP (sequence));
 
       CHECK_LIST_END (sequence, sequence);
 
@@ -159,22 +167,38 @@ it returns 0.  If LIST is circular, it returns a finite value
 which is at least the number of distinct elements.  */)
   (Lisp_Object list)
 {
-  Lisp_Object tail, halftail, length;
-  int len = 0;
+  Lisp_Object tail, halftail;
+  double hilen = 0;
+  uintmax_t lolen = 1;
+
+  if (! CONSP (list))
+    return make_number (0);
 
   /* halftail is used to detect circular lists.  */
-  halftail = list;
-  for (tail = list; CONSP (tail); tail = XCDR (tail))
+  for (tail = halftail = list; ; )
     {
-      if (EQ (tail, halftail) && len != 0)
+      tail = XCDR (tail);
+      if (! CONSP (tail))
        break;
-      len++;
-      if ((len & 1) == 0)
-       halftail = XCDR (halftail);
+      if (EQ (tail, halftail))
+       break;
+      lolen++;
+      if ((lolen & 1) == 0)
+       {
+         halftail = XCDR (halftail);
+         if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
+           {
+             QUIT;
+             if (lolen == 0)
+               hilen += UINTMAX_MAX + 1.0;
+           }
+       }
     }
 
-  XSETINT (length, len);
-  return length;
+  /* If the length does not fit into a fixnum, return a float.
+     On all known practical machines this returns an upper bound on
+     the true length.  */
+  return hilen ? make_float (hilen + lolen) : make_fixnum_or_float (lolen);
 }
 
 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
@@ -344,7 +368,7 @@ Symbols are also allowed; their print names are used instead.  */)
   return i1 < SCHARS (s2) ? Qt : Qnil;
 }
 \f
-static Lisp_Object concat (size_t nargs, Lisp_Object *args,
+static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
                           enum Lisp_Type target_type, int last_special);
 
 /* ARGSUSED */
@@ -374,7 +398,7 @@ The result is a list whose elements are the elements of all the arguments.
 Each argument may be a list, vector or string.
 The last argument is not copied, just used as the tail of the new list.
 usage: (append &rest SEQUENCES)  */)
-  (size_t nargs, Lisp_Object *args)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   return concat (nargs, args, Lisp_Cons, 1);
 }
@@ -384,7 +408,7 @@ DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
 The result is a string whose elements are the elements of all the arguments.
 Each argument may be a string or a list or vector of characters (integers).
 usage: (concat &rest SEQUENCES)  */)
-  (size_t nargs, Lisp_Object *args)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   return concat (nargs, args, Lisp_String, 0);
 }
@@ -394,7 +418,7 @@ DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
 The result is a vector whose elements are the elements of all the arguments.
 Each argument may be a list, vector or string.
 usage: (vconcat &rest SEQUENCES)   */)
-  (size_t nargs, Lisp_Object *args)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   return concat (nargs, args, Lisp_Vectorlike, 0);
 }
@@ -416,7 +440,7 @@ with the original.  */)
   if (BOOL_VECTOR_P (arg))
     {
       Lisp_Object val;
-      int size_in_chars
+      ptrdiff_t size_in_chars
        = ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
           / BOOL_VECTOR_BITS_PER_CHAR);
 
@@ -436,13 +460,13 @@ with the original.  */)
    a string and has text properties to be copied.  */
 struct textprop_rec
 {
-  int argnum;                  /* refer to ARGS (arguments of `concat') */
+  ptrdiff_t argnum;            /* refer to ARGS (arguments of `concat') */
   EMACS_INT from;              /* refer to ARGS[argnum] (argument string) */
   EMACS_INT to;                        /* refer to VAL (the target string) */
 };
 
 static Lisp_Object
-concat (size_t nargs, Lisp_Object *args,
+concat (ptrdiff_t nargs, Lisp_Object *args,
        enum Lisp_Type target_type, int last_special)
 {
   Lisp_Object val;
@@ -452,7 +476,7 @@ concat (size_t nargs, Lisp_Object *args,
   EMACS_INT toindex_byte = 0;
   register EMACS_INT result_len;
   register EMACS_INT result_len_byte;
-  register size_t argnum;
+  ptrdiff_t argnum;
   Lisp_Object last_tail;
   Lisp_Object prev;
   int some_multibyte;
@@ -463,7 +487,7 @@ concat (size_t nargs, Lisp_Object *args,
      here, and copy the text properties after the concatenation.  */
   struct textprop_rec  *textprops = NULL;
   /* Number of elements in textprops.  */
-  int num_textprops = 0;
+  ptrdiff_t num_textprops = 0;
   USE_SAFE_ALLOCA;
 
   tail = Qnil;
@@ -504,6 +528,7 @@ concat (size_t nargs, Lisp_Object *args,
             as well as the number of characters.  */
          EMACS_INT i;
          Lisp_Object ch;
+         int c;
          EMACS_INT this_len_byte;
 
          if (VECTORP (this) || COMPILEDP (this))
@@ -511,9 +536,10 @@ concat (size_t nargs, Lisp_Object *args,
              {
                ch = AREF (this, i);
                CHECK_CHARACTER (ch);
-               this_len_byte = CHAR_BYTES (XINT (ch));
+               c = XFASTINT (ch);
+               this_len_byte = CHAR_BYTES (c);
                result_len_byte += this_len_byte;
-               if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
+               if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
                  some_multibyte = 1;
              }
          else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0)
@@ -523,9 +549,10 @@ concat (size_t nargs, Lisp_Object *args,
              {
                ch = XCAR (this);
                CHECK_CHARACTER (ch);
-               this_len_byte = CHAR_BYTES (XINT (ch));
+               c = XFASTINT (ch);
+               this_len_byte = CHAR_BYTES (c);
                result_len_byte += this_len_byte;
-               if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
+               if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c))
                  some_multibyte = 1;
              }
          else if (STRINGP (this))
@@ -542,8 +569,8 @@ concat (size_t nargs, Lisp_Object *args,
        }
 
       result_len += len;
-      if (result_len < 0)
-       error ("String overflow");
+      if (STRING_BYTES_BOUND < result_len)
+       string_overflow ();
     }
 
   if (! some_multibyte)
@@ -631,23 +658,16 @@ concat (size_t nargs, Lisp_Object *args,
              {
                int c;
                if (STRING_MULTIBYTE (this))
-                 {
-                   FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
-                                                       thisindex,
-                                                       thisindex_byte);
-                   XSETFASTINT (elt, c);
-                 }
+                 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
+                                                     thisindex,
+                                                     thisindex_byte);
                else
                  {
-                   XSETFASTINT (elt, SREF (this, thisindex)); thisindex++;
-                   if (some_multibyte
-                       && !ASCII_CHAR_P (XINT (elt))
-                       && XINT (elt) < 0400)
-                     {
-                       c = BYTE8_TO_CHAR (XINT (elt));
-                       XSETINT (elt, c);
-                     }
+                   c = SREF (this, thisindex); thisindex++;
+                   if (some_multibyte && !ASCII_CHAR_P (c))
+                     c = BYTE8_TO_CHAR (c);
                  }
+               XSETFASTINT (elt, c);
              }
            else if (BOOL_VECTOR_P (this))
              {
@@ -679,12 +699,13 @@ concat (size_t nargs, Lisp_Object *args,
              }
            else
              {
-               CHECK_NUMBER (elt);
+               int c;
+               CHECK_CHARACTER (elt);
+               c = XFASTINT (elt);
                if (some_multibyte)
-                 toindex_byte += CHAR_STRING (XINT (elt),
-                                              SDATA (val) + toindex_byte);
+                 toindex_byte += CHAR_STRING (c, SDATA (val) + toindex_byte);
                else
-                 SSET (val, toindex_byte++, XINT (elt));
+                 SSET (val, toindex_byte++, c);
                toindex++;
              }
          }
@@ -1269,7 +1290,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
        doc: /* Take cdr N times on LIST, return the result.  */)
   (Lisp_Object n, Lisp_Object list)
 {
-  register int i, num;
+  EMACS_INT i, num;
   CHECK_NUMBER (n);
   num = XINT (n);
   for (i = 0; i < num && !NILP (list); i++)
@@ -1734,7 +1755,7 @@ if the first element should sort before the second.  */)
   Lisp_Object front, back;
   register Lisp_Object len, tem;
   struct gcpro gcpro1, gcpro2;
-  register int length;
+  EMACS_INT length;
 
   front = list;
   len = Flength (list);
@@ -2122,7 +2143,6 @@ ARRAY is a vector, string, char-table, or bool-vector.  */)
   (Lisp_Object array, Lisp_Object item)
 {
   register EMACS_INT size, idx;
-  int charval;
 
   if (VECTORP (array))
     {
@@ -2142,27 +2162,21 @@ ARRAY is a vector, string, char-table, or bool-vector.  */)
   else if (STRINGP (array))
     {
       register unsigned char *p = SDATA (array);
-      CHECK_NUMBER (item);
-      charval = XINT (item);
+      int charval;
+      CHECK_CHARACTER (item);
+      charval = XFASTINT (item);
       size = SCHARS (array);
       if (STRING_MULTIBYTE (array))
        {
          unsigned char str[MAX_MULTIBYTE_LENGTH];
          int len = CHAR_STRING (charval, str);
          EMACS_INT size_byte = SBYTES (array);
-         unsigned char *p1 = p, *endp = p + size_byte;
-         int i;
 
-         if (size != size_byte)
-           while (p1 < endp)
-             {
-               int this_len = BYTES_BY_CHAR_HEAD (*p1);
-               if (len != this_len)
-                 error ("Attempt to change byte length of a string");
-               p1 += this_len;
-             }
-         for (i = 0; i < size_byte; i++)
-           *p++ = str[i % len];
+         if (INT_MULTIPLY_OVERFLOW (SCHARS (array), len)
+             || SCHARS (array) * len != size_byte)
+           error ("Attempt to change byte length of a string");
+         for (idx = 0; idx < size_byte; idx++)
+           *p++ = str[idx % len];
        }
       else
        for (idx = 0; idx < size; idx++)
@@ -2171,19 +2185,18 @@ ARRAY is a vector, string, char-table, or bool-vector.  */)
   else if (BOOL_VECTOR_P (array))
     {
       register unsigned char *p = XBOOL_VECTOR (array)->data;
-      int size_in_chars
-       = ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+      EMACS_INT size_in_chars;
+      size = XBOOL_VECTOR (array)->size;
+      size_in_chars
+       = ((size + BOOL_VECTOR_BITS_PER_CHAR - 1)
           / BOOL_VECTOR_BITS_PER_CHAR);
 
-      charval = (! NILP (item) ? -1 : 0);
-      for (idx = 0; idx < size_in_chars - 1; idx++)
-       p[idx] = charval;
-      if (idx < size_in_chars)
+      if (size_in_chars)
        {
-         /* Mask out bits beyond the vector size.  */
-         if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)
-           charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
-         p[idx] = charval;
+         memset (p, ! NILP (item) ? -1 : 0, size_in_chars);
+
+         /* Clear any extraneous bits in the last byte.  */
+         p[size_in_chars - 1] &= (1 << (size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
        }
     }
   else
@@ -2220,9 +2233,9 @@ DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
        doc: /* Concatenate any number of lists by altering them.
 Only the last argument is not altered, and need not be a list.
 usage: (nconc &rest LISTS)  */)
-  (size_t nargs, Lisp_Object *args)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
-  register size_t argnum;
+  ptrdiff_t argnum;
   register Lisp_Object tail, tem, val;
 
   val = tail = Qnil;
@@ -2297,7 +2310,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
     {
       for (i = 0; i < leni; i++)
        {
-         int byte;
+         unsigned char byte;
          byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR];
          dummy = (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) ? Qt : Qnil;
          dummy = call1 (fn, dummy);
@@ -2345,9 +2358,8 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string.  */)
 {
   Lisp_Object len;
   register EMACS_INT leni;
-  int nargs;
+  ptrdiff_t i, nargs;
   register Lisp_Object *args;
-  register EMACS_INT i;
   struct gcpro gcpro1;
   Lisp_Object ret;
   USE_SAFE_ALLOCA;
@@ -2526,8 +2538,8 @@ advisable.  */)
 
   while (loads-- > 0)
     {
-      Lisp_Object load = (NILP (use_floats) ?
-                         make_number ((int) (100.0 * load_ave[loads]))
+      Lisp_Object load = (NILP (use_floats)
+                         ? make_number (100.0 * load_ave[loads])
                          : make_float (load_ave[loads]));
       ret = Fcons (load, ret);
     }
@@ -2601,6 +2613,8 @@ is not loaded; so load the file FILENAME.
 If FILENAME is omitted, the printname of FEATURE is used as the file name,
 and `load' will try to load this name appended with the suffix `.elc' or
 `.el', in that order.  The name without appended suffix will not be used.
+If your system supports it, `.elc.gz' and `.el.gz' files will also be
+considered.  See `get-load-suffixes' for the complete list of suffixes.
 If the optional third argument NOERROR is non-nil,
 then return nil if the file is not found instead of signaling an error.
 Normally the return value is FEATURE.
@@ -2751,7 +2765,7 @@ DEFUN ("widget-apply", Fwidget_apply, Swidget_apply, 2, MANY, 0,
        doc: /* Apply the value of WIDGET's PROPERTY to the widget itself.
 ARGS are passed as extra arguments to the function.
 usage: (widget-apply WIDGET PROPERTY &rest ARGS)  */)
-  (size_t nargs, Lisp_Object *args)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   /* This function can GC. */
   Lisp_Object newargs[3];
@@ -3356,7 +3370,7 @@ static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
 /* Function prototypes.  */
 
 static struct Lisp_Hash_Table *check_hash_table (Lisp_Object);
-static size_t get_key_arg (Lisp_Object, size_t, Lisp_Object *, char *);
+static ptrdiff_t get_key_arg (Lisp_Object, ptrdiff_t, Lisp_Object *, char *);
 static void maybe_resize_hash_table (struct Lisp_Hash_Table *);
 static int sweep_weak_table (struct Lisp_Hash_Table *, int);
 
@@ -3383,13 +3397,9 @@ check_hash_table (Lisp_Object obj)
 EMACS_INT
 next_almost_prime (EMACS_INT n)
 {
-  if (n % 2 == 0)
-    n += 1;
-  if (n % 3 == 0)
-    n += 2;
-  if (n % 7 == 0)
-    n += 4;
-  return n;
+  for (n |= 1; ; n += 2)
+    if (n % 3 != 0 && n % 5 != 0 && n % 7 != 0)
+      return n;
 }
 
 
@@ -3399,10 +3409,10 @@ next_almost_prime (EMACS_INT n)
    0.  This function is used to extract a keyword/argument pair from
    a DEFUN parameter list.  */
 
-static size_t
-get_key_arg (Lisp_Object key, size_t nargs, Lisp_Object *args, char *used)
+static ptrdiff_t
+get_key_arg (Lisp_Object key, ptrdiff_t nargs, Lisp_Object *args, char *used)
 {
-  size_t i;
+  ptrdiff_t i;
 
   for (i = 1; i < nargs; i++)
     if (!used[i - 1] && EQ (args[i - 1], key))
@@ -4300,12 +4310,12 @@ WEAK.  WEAK t is equivalent to `key-and-value'.  Default value of WEAK
 is nil.
 
 usage: (make-hash-table &rest KEYWORD-ARGS)  */)
-  (size_t nargs, Lisp_Object *args)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   Lisp_Object test, size, rehash_size, rehash_threshold, weak;
   Lisp_Object user_test, user_hash;
   char *used;
-  size_t i;
+  ptrdiff_t i;
 
   /* The vector `used' is used to keep track of arguments that
      have been consumed.  */
@@ -4469,7 +4479,7 @@ If KEY is not found, return DFLT which defaults to nil.  */)
 DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
        doc: /* Associate KEY with VALUE in hash table TABLE.
 If KEY is already present in table, replace its current value with
-VALUE.  */)
+VALUE.  In any case, return VALUE.  */)
   (Lisp_Object key, Lisp_Object value, Lisp_Object table)
 {
   struct Lisp_Hash_Table *h = check_hash_table (table);
@@ -4538,21 +4548,18 @@ including negative integers.  */)
 
 \f
 /************************************************************************
-                            MD5 and SHA1
+                       MD5, SHA-1, and SHA-2
  ************************************************************************/
 
 #include "md5.h"
 #include "sha1.h"
+#include "sha256.h"
+#include "sha512.h"
 
-/* Convert a possibly-signed character to an unsigned character.  This is
-   a bit safer than casting to unsigned char, since it catches some type
-   errors that the cast doesn't.  */
-static inline unsigned char to_uchar (char ch) { return ch; }
-
-/* TYPE: 0 for md5, 1 for sha1. */
+/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */
 
 static Lisp_Object
-crypto_hash_function (int type, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary)
+secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary)
 {
   int i;
   EMACS_INT size;
@@ -4562,7 +4569,11 @@ crypto_hash_function (int type, Lisp_Object object, Lisp_Object start, Lisp_Obje
   register EMACS_INT b, e;
   register struct buffer *bp;
   EMACS_INT temp;
-  Lisp_Object res=Qnil;
+  int digest_size;
+  void *(*hash_func) (const char *, size_t, void *);
+  Lisp_Object digest;
+
+  CHECK_SYMBOL (algorithm);
 
   if (STRINGP (object))
     {
@@ -4733,47 +4744,61 @@ crypto_hash_function (int type, Lisp_Object object, Lisp_Object start, Lisp_Obje
        object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
     }
 
-  switch (type)
+  if (EQ (algorithm, Qmd5))
     {
-    case 0:                    /* MD5 */
-      {
-       char digest[16];
-       md5_buffer (SSDATA (object) + start_byte,
-                   SBYTES (object) - (size_byte - end_byte),
-                   digest);
+      digest_size = MD5_DIGEST_SIZE;
+      hash_func          = md5_buffer;
+    }
+  else if (EQ (algorithm, Qsha1))
+    {
+      digest_size = SHA1_DIGEST_SIZE;
+      hash_func          = sha1_buffer;
+    }
+  else if (EQ (algorithm, Qsha224))
+    {
+      digest_size = SHA224_DIGEST_SIZE;
+      hash_func          = sha224_buffer;
+    }
+  else if (EQ (algorithm, Qsha256))
+    {
+      digest_size = SHA256_DIGEST_SIZE;
+      hash_func          = sha256_buffer;
+    }
+  else if (EQ (algorithm, Qsha384))
+    {
+      digest_size = SHA384_DIGEST_SIZE;
+      hash_func          = sha384_buffer;
+    }
+  else if (EQ (algorithm, Qsha512))
+    {
+      digest_size = SHA512_DIGEST_SIZE;
+      hash_func          = sha512_buffer;
+    }
+  else
+    error ("Invalid algorithm arg: %s", SDATA (Fsymbol_name (algorithm)));
 
-       if (NILP (binary))
-         {
-           char value[33];
-           for (i = 0; i < 16; i++)
-             sprintf (&value[2 * i], "%02x", to_uchar (digest[i]));
-           res = make_string (value, 32);
-         }
-       else
-         res = make_string (digest, 16);
-       break;
-      }
+  /* allocate 2 x digest_size so that it can be re-used to hold the
+     hexified value */
+  digest = make_uninit_string (digest_size * 2);
 
-    case 1:                    /* SHA1 */
-      {
-       char digest[20];
-       sha1_buffer (SSDATA (object) + start_byte,
-                    SBYTES (object) - (size_byte - end_byte),
-                    digest);
-       if (NILP (binary))
-         {
-           char value[41];
-           for (i = 0; i < 20; i++)
-             sprintf (&value[2 * i], "%02x", to_uchar (digest[i]));
-           res = make_string (value, 40);
-         }
-       else
-         res = make_string (digest, 20);
-       break;
-      }
-    }
+  hash_func (SSDATA (object) + start_byte,
+            SBYTES (object) - (size_byte - end_byte),
+            SSDATA (digest));
 
-  return res;
+  if (NILP (binary))
+    {
+      unsigned char *p = SDATA (digest);
+      for (i = digest_size - 1; i >= 0; i--)
+       {
+         static char const hexdigit[16] = "0123456789abcdef";
+         int p_i = p[i];
+         p[2 * i] = hexdigit[p_i >> 4];
+         p[2 * i + 1] = hexdigit[p_i & 0xf];
+       }
+      return digest;
+    }
+  else
+    return make_unibyte_string (SSDATA (digest), digest_size);
 }
 
 DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
@@ -4805,54 +4830,46 @@ If NOERROR is non-nil, silently assume the `raw-text' coding if the
 guesswork fails.  Normally, an error is signaled in such case.  */)
   (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror)
 {
-  return crypto_hash_function (0, object, start, end, coding_system, noerror, Qnil);
+  return secure_hash (Qmd5, object, start, end, coding_system, noerror, Qnil);
 }
 
-DEFUN ("sha1", Fsha1, Ssha1, 1, 4, 0,
-       doc: /* Return the SHA-1 (Secure Hash Algorithm) of an OBJECT.
-
-OBJECT is either a string or a buffer.  Optional arguments START and
-END are character positions specifying which portion of OBJECT for
-computing the hash.  If BINARY is non-nil, return a string in binary
-form.  */)
-     (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary)
+DEFUN ("secure-hash", Fsecure_hash, Ssecure_hash, 2, 5, 0,
+       doc: /* Return the secure hash of an OBJECT.
+ALGORITHM is a symbol: md5, sha1, sha224, sha256, sha384 or sha512.
+OBJECT is either a string or a buffer.
+Optional arguments START and END are character positions specifying
+which portion of OBJECT for computing the hash.  If BINARY is non-nil,
+return a string in binary form.  */)
+  (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary)
 {
-  return crypto_hash_function (1, object, start, end, Qnil, Qnil, binary);
+  return secure_hash (algorithm, object, start, end, Qnil, Qnil, binary);
 }
-
 \f
 void
 syms_of_fns (void)
 {
+  DEFSYM (Qmd5,    "md5");
+  DEFSYM (Qsha1,   "sha1");
+  DEFSYM (Qsha224, "sha224");
+  DEFSYM (Qsha256, "sha256");
+  DEFSYM (Qsha384, "sha384");
+  DEFSYM (Qsha512, "sha512");
+
   /* Hash table stuff.  */
-  Qhash_table_p = intern_c_string ("hash-table-p");
-  staticpro (&Qhash_table_p);
-  Qeq = intern_c_string ("eq");
-  staticpro (&Qeq);
-  Qeql = intern_c_string ("eql");
-  staticpro (&Qeql);
-  Qequal = intern_c_string ("equal");
-  staticpro (&Qequal);
-  QCtest = intern_c_string (":test");
-  staticpro (&QCtest);
-  QCsize = intern_c_string (":size");
-  staticpro (&QCsize);
-  QCrehash_size = intern_c_string (":rehash-size");
-  staticpro (&QCrehash_size);
-  QCrehash_threshold = intern_c_string (":rehash-threshold");
-  staticpro (&QCrehash_threshold);
-  QCweakness = intern_c_string (":weakness");
-  staticpro (&QCweakness);
-  Qkey = intern_c_string ("key");
-  staticpro (&Qkey);
-  Qvalue = intern_c_string ("value");
-  staticpro (&Qvalue);
-  Qhash_table_test = intern_c_string ("hash-table-test");
-  staticpro (&Qhash_table_test);
-  Qkey_or_value = intern_c_string ("key-or-value");
-  staticpro (&Qkey_or_value);
-  Qkey_and_value = intern_c_string ("key-and-value");
-  staticpro (&Qkey_and_value);
+  DEFSYM (Qhash_table_p, "hash-table-p");
+  DEFSYM (Qeq, "eq");
+  DEFSYM (Qeql, "eql");
+  DEFSYM (Qequal, "equal");
+  DEFSYM (QCtest, ":test");
+  DEFSYM (QCsize, ":size");
+  DEFSYM (QCrehash_size, ":rehash-size");
+  DEFSYM (QCrehash_threshold, ":rehash-threshold");
+  DEFSYM (QCweakness, ":weakness");
+  DEFSYM (Qkey, "key");
+  DEFSYM (Qvalue, "value");
+  DEFSYM (Qhash_table_test, "hash-table-test");
+  DEFSYM (Qkey_or_value, "key-or-value");
+  DEFSYM (Qkey_and_value, "key-and-value");
 
   defsubr (&Ssxhash);
   defsubr (&Smake_hash_table);
@@ -4871,18 +4888,12 @@ syms_of_fns (void)
   defsubr (&Smaphash);
   defsubr (&Sdefine_hash_table_test);
 
-  Qstring_lessp = intern_c_string ("string-lessp");
-  staticpro (&Qstring_lessp);
-  Qprovide = intern_c_string ("provide");
-  staticpro (&Qprovide);
-  Qrequire = intern_c_string ("require");
-  staticpro (&Qrequire);
-  Qyes_or_no_p_history = intern_c_string ("yes-or-no-p-history");
-  staticpro (&Qyes_or_no_p_history);
-  Qcursor_in_echo_area = intern_c_string ("cursor-in-echo-area");
-  staticpro (&Qcursor_in_echo_area);
-  Qwidget_type = intern_c_string ("widget-type");
-  staticpro (&Qwidget_type);
+  DEFSYM (Qstring_lessp, "string-lessp");
+  DEFSYM (Qprovide, "provide");
+  DEFSYM (Qrequire, "require");
+  DEFSYM (Qyes_or_no_p_history, "yes-or-no-p-history");
+  DEFSYM (Qcursor_in_echo_area, "cursor-in-echo-area");
+  DEFSYM (Qwidget_type, "widget-type");
 
   staticpro (&string_char_byte_cache_string);
   string_char_byte_cache_string = Qnil;
@@ -4896,18 +4907,13 @@ syms_of_fns (void)
     doc: /* A list of symbols which are the features of the executing Emacs.
 Used by `featurep' and `require', and altered by `provide'.  */);
   Vfeatures = Fcons (intern_c_string ("emacs"), Qnil);
-  Qsubfeatures = intern_c_string ("subfeatures");
-  staticpro (&Qsubfeatures);
+  DEFSYM (Qsubfeatures, "subfeatures");
 
 #ifdef HAVE_LANGINFO_CODESET
-  Qcodeset = intern_c_string ("codeset");
-  staticpro (&Qcodeset);
-  Qdays = intern_c_string ("days");
-  staticpro (&Qdays);
-  Qmonths = intern_c_string ("months");
-  staticpro (&Qmonths);
-  Qpaper = intern_c_string ("paper");
-  staticpro (&Qpaper);
+  DEFSYM (Qcodeset, "codeset");
+  DEFSYM (Qdays, "days");
+  DEFSYM (Qmonths, "months");
+  DEFSYM (Qpaper, "paper");
 #endif /* HAVE_LANGINFO_CODESET */
 
   DEFVAR_BOOL ("use-dialog-box", use_dialog_box,
@@ -4992,7 +4998,7 @@ this variable.  */);
   defsubr (&Sbase64_encode_string);
   defsubr (&Sbase64_decode_string);
   defsubr (&Smd5);
-  defsubr (&Ssha1);
+  defsubr (&Ssecure_hash);
   defsubr (&Slocale_info);
 }