(scm_take_locale_stringn): Use realloc to make room for

[bpt/guile.git] / libguile / hash.c

diff --git a/libguile/hash.c b/libguile/hash.c
index 26c4fcd..9b73d2f 100644 (file)
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996,1997, 2000, 2001 Free Software Foundation, Inc.
+/*     Copyright (C) 1995,1996,1997, 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -12,7 +12,7 @@
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 
@@ -37,22 +37,13 @@ extern double floor();
 unsigned long 
 scm_string_hash (const unsigned char *str, size_t len)
 {
-  if (len > 5)
-    {
-      size_t i = 5;
-      unsigned long h = 264;
-      while (i--)
-       h = (h << 8) + (unsigned) str[h % len];
-      return h;
-    }
-  else
-    {
-      size_t i = len;
-      unsigned long h = 0;
-      while (i)
-       h = (h << 8) + (unsigned) str[--i];
-      return h;
-    }
+  /* from suggestion at: */
+  /* http://srfi.schemers.org/srfi-13/mail-archive/msg00112.html */
+
+  unsigned long h = 0;
+  while (len-- > 0)
+    h = *str++ + h*37;
+  return h;
 }
 
 
@@ -66,10 +57,10 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
   switch (SCM_ITAG3 (obj)) {
   case scm_tc3_int_1: 
   case scm_tc3_int_2:
-    return SCM_INUM(obj) % n;   /* SCM_INUMP(obj) */
+    return SCM_I_INUM(obj) % n;   /* SCM_INUMP(obj) */
   case scm_tc3_imm24:
     if (SCM_CHARP(obj))
-      return (unsigned)(scm_downcase(SCM_CHAR(obj))) % n;
+      return (unsigned)(scm_c_downcase(SCM_CHAR(obj))) % n;
     switch (SCM_UNPACK (obj)) {
 #ifndef SICP
     case SCM_UNPACK(SCM_EOL):
@@ -96,44 +87,61 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
     default: 
       return 263 % n;
     case scm_tc7_smob:
+      return 263 % n;
+    case scm_tc7_number:
       switch SCM_TYP16 (obj) {
       case scm_tc16_big:
-        return SCM_INUM (scm_modulo (obj, SCM_MAKINUM (n)));
-      default: 
-       return 263 % n;
+        return scm_to_ulong (scm_modulo (obj, scm_from_ulong (n)));
       case scm_tc16_real:
        {
          double r = SCM_REAL_VALUE (obj);
-         if (floor (r) == r) {
-           obj = scm_inexact_to_exact (obj);
-           if SCM_IMP (obj) return SCM_INUM (obj) % n;
-           return SCM_INUM (scm_modulo (obj, SCM_MAKINUM (n)));
-         }
+         if (floor (r) == r) 
+           {
+             obj = scm_inexact_to_exact (obj);
+             return scm_to_ulong (scm_modulo (obj, scm_from_ulong (n)));
+           }
        }
+        /* Fall through */
       case scm_tc16_complex:
-       obj = scm_number_to_string (obj, SCM_MAKINUM (10));
+      case scm_tc16_fraction:
+       obj = scm_number_to_string (obj, scm_from_int (10));
+        /* Fall through */
       }
+      /* Fall through */
     case scm_tc7_string:
-      return scm_string_hash (SCM_STRING_UCHARS (obj), SCM_STRING_LENGTH (obj)) % n;
+      {
+       unsigned long hash =
+         scm_string_hash ((const unsigned char *) scm_i_string_chars (obj),
+                          scm_i_string_length (obj)) % n;
+       scm_remember_upto_here_1 (obj);
+       return hash;
+      }
     case scm_tc7_symbol:
-      return SCM_SYMBOL_HASH (obj) % n;
+      return scm_i_symbol_hash (obj) % n;
     case scm_tc7_wvect:
     case scm_tc7_vector:
       {
-       size_t len = SCM_VECTOR_LENGTH(obj);
-       SCM const *data = SCM_VELTS(obj);
+       size_t len = SCM_SIMPLE_VECTOR_LENGTH (obj);
        if (len > 5)
          {
            size_t i = d/2;
            unsigned long h = 1;
-           while (i--) h = ((h << 8) + (scm_hasher (data[h % len], n, 2))) % n;
+           while (i--)
+             {
+               SCM elt = SCM_SIMPLE_VECTOR_REF (obj, h % len);
+               h = ((h << 8) + (scm_hasher (elt, n, 2))) % n;
+             }
            return h;
          }
        else
          {
            size_t i = len;
            unsigned long h = (n)-1;
-           while (i--) h = ((h << 8) + (scm_hasher (data[i], n, d/len))) % n;
+           while (i--)
+             {
+               SCM elt = SCM_SIMPLE_VECTOR_REF (obj, h % len);
+               h = ((h << 8) + (scm_hasher (elt, n, d/len))) % n;
+             }
            return h;
          }
       }
@@ -176,8 +184,8 @@ SCM_DEFINE (scm_hashq, "hashq", 2, 0, 0,
            "different values, since @code{foo} will be garbage collected.")
 #define FUNC_NAME s_scm_hashq
 {
-  SCM_VALIDATE_INUM_MIN (2, size, 0);
-  return SCM_MAKINUM (scm_ihashq (key, SCM_INUM (size)));
+  unsigned long sz = scm_to_unsigned_integer (size, 1, ULONG_MAX);
+  return scm_from_ulong (scm_ihashq (key, sz));
 }
 #undef FUNC_NAME
 
@@ -189,7 +197,7 @@ unsigned long
 scm_ihashv (SCM obj, unsigned long n)
 {
   if (SCM_CHARP(obj))
-    return ((unsigned long) (scm_downcase (SCM_CHAR (obj)))) % n; /* downcase!?!! */
+    return ((unsigned long) (scm_c_downcase (SCM_CHAR (obj)))) % n; /* downcase!?!! */
 
   if (SCM_NUMP(obj))
     return (unsigned long) scm_hasher(obj, n, 10);
@@ -212,8 +220,8 @@ SCM_DEFINE (scm_hashv, "hashv", 2, 0, 0,
            "different values, since @code{foo} will be garbage collected.")
 #define FUNC_NAME s_scm_hashv
 {
-  SCM_VALIDATE_INUM_MIN (2, size, 0);
-  return SCM_MAKINUM (scm_ihashv (key, SCM_INUM (size)));
+  unsigned long sz = scm_to_unsigned_integer (size, 1, ULONG_MAX);
+  return scm_from_ulong (scm_ihashv (key, sz));
 }
 #undef FUNC_NAME
 
@@ -235,8 +243,8 @@ SCM_DEFINE (scm_hash, "hash", 2, 0, 0,
            "integer in the range 0 to @var{size} - 1.")
 #define FUNC_NAME s_scm_hash
 {
-  SCM_VALIDATE_INUM_MIN (2, size, 0);
-  return SCM_MAKINUM (scm_ihash (key, SCM_INUM (size)));
+  unsigned long sz = scm_to_unsigned_integer (size, 1, ULONG_MAX);
+  return scm_from_ulong (scm_ihash (key, sz));
 }
 #undef FUNC_NAME