Implement hash-simple-object.

This works for any object that can be viewed as a contiguous sequence of bytes
in memory, so includes strings, bytevectors, symbols, bignums, flonums, and
non-pointer objects.

This is not tested but also not yet used.

diff --git a/src/microcode/extern.h b/src/microcode/extern.h
index 1f1fa877bd49f28f1b6a84cb5fad08e378067e61..bead4542e4c7f39416a77e049e7da8c41bf7fc0d 100644 (file)
--- a/src/microcode/extern.h
+++ b/src/microcode/extern.h
@@ -315,6 +315,7 @@ extern unsigned long compute_extra_ephemeron_space (unsigned long);
 extern void guarantee_extra_ephemeron_space (unsigned long);
 
 /* Random and OS utilities */
+extern uint32_t memory_hash (unsigned long, const void *);
 extern int strcmp_ci (const char *, const char *);
 extern bool interpreter_applicable_p (SCHEME_OBJECT);
 extern void add_reload_cleanup (void (*) (void));

diff --git a/src/microcode/intern.c b/src/microcode/intern.c
index 7762051a47630c9c4bdb66e1d1ed2119012f3b86..9109441f8d8cdbd526c649d80a6e473edf3e0143 100644 (file)
--- a/src/microcode/intern.c
+++ b/src/microcode/intern.c
@@ -30,31 +30,13 @@ USA.
 #include "prims.h"
 #include "trap.h"
 \f
-/* The FNV hash, short for Fowler/Noll/Vo in honor of its creators.  */
-
-static uint32_t
-string_hash (long length, const char * string)
-{
-  const unsigned char * scan = ((const unsigned char *) string);
-  const unsigned char * end = (scan + length);
-  uint32_t result = 2166136261U;
-  while (scan < end)
-    result = ((result * 16777619U) ^ ((uint32_t) (*scan++)));
-#if (FIXNUM_LENGTH >= 32)
-  return (result);
-#else
-  /* Shorten the result using xor-folding.  */
-  return ((result >> FIXNUM_LENGTH) ^ (result & FIXNUM_MASK));
-#endif
-}
-
 static SCHEME_OBJECT *
 find_symbol_internal (unsigned long length, const char * string)
 {
   SCHEME_OBJECT obarray = (VECTOR_REF (fixed_objects, OBARRAY));
   SCHEME_OBJECT * bucket
     = (VECTOR_LOC (obarray,
-                  ((string_hash (length, string))
+                  ((memory_hash (length, string))
                    % (VECTOR_LENGTH (obarray)))));
   while (true)
     {
@@ -96,7 +78,7 @@ replace_symbol_bucket_type (SCHEME_OBJECT symbol, unsigned int type)
   char_pointer = (STRING_POINTER (string));
   bucket
     = (VECTOR_LOC (obarray,
-                   ((string_hash (length, char_pointer))
+                   ((memory_hash (length, char_pointer))
                     % (VECTOR_LENGTH (obarray)))));
   while (true)
     {
@@ -245,7 +227,7 @@ interning symbols.")
   {
     SCHEME_OBJECT string = (ARG_REF (1));
     PRIMITIVE_RETURN
-      (ULONG_TO_FIXNUM (string_hash ((STRING_LENGTH (string)),
+      (ULONG_TO_FIXNUM (memory_hash ((STRING_LENGTH (string)),
                                     (STRING_POINTER (string)))));
   }
 }
@@ -260,7 +242,7 @@ Equivalent to (MODULO (STRING-HASH STRING) DENOMINATOR).")
   {
     SCHEME_OBJECT string = (ARG_REF (1));
     PRIMITIVE_RETURN
-      (ULONG_TO_FIXNUM ((string_hash ((STRING_LENGTH (string)),
+      (ULONG_TO_FIXNUM ((memory_hash ((STRING_LENGTH (string)),
                                      (STRING_POINTER (string))))
                        % (arg_ulong_integer (2))));
   }

diff --git a/src/microcode/prim.c b/src/microcode/prim.c
index 916a123205b04c6462328be46f5f118ac08ed3b1..8a4157b84c401f6fa63df1407391fb66f40d7ce5 100644 (file)
--- a/src/microcode/prim.c
+++ b/src/microcode/prim.c
@@ -28,6 +28,7 @@ USA.
 
 #include "scheme.h"
 #include "prims.h"
+#include "bignmint.h"
 
 static unsigned long
 arg_type (int arg)
@@ -412,3 +413,45 @@ DEFINE_PRIMITIVE ("SET-CELL-CONTENTS!", Prim_set_cell_contents, 2, 2, 0)
   MEMORY_SET (cell, CELL_CONTENTS, object);
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
+
+DEFINE_PRIMITIVE ("hash-simple-object", Prim_hash_simple_object, 1, 1, 0)
+{
+  PRIMITIVE_HEADER (1);
+  SCHEME_OBJECT object = (ARG_REF (1));
+  unsigned long n_bytes;
+  const void * bytes;
+  if (GC_TYPE_NON_POINTER (object))
+    {
+      n_bytes = (sizeof (SCHEME_OBJECT));
+      bytes = (&object);
+    }
+  else if ((LEGACY_STRING_P (object)) || (BYTEVECTOR_P (object)))
+    {
+      n_bytes = (BYTEVECTOR_LENGTH (object));
+      bytes = (BYTEVECTOR_POINTER (object));
+    }
+  else if (UNICODE_STRING_P (object))
+    {
+      n_bytes = (UNICODE_STRING_BYTE_LENGTH (object));
+      bytes = (UNICODE_STRING_POINTER (object));
+    }
+  else if (SYMBOL_P (object))
+    {
+      SCHEME_OBJECT name = (MEMORY_REF (object, SYMBOL_NAME));
+      n_bytes = (BYTEVECTOR_LENGTH (name));
+      bytes = (BYTEVECTOR_POINTER (name));
+    }
+  else if (BIGNUM_P (object))
+    {
+      n_bytes = ((BIGNUM_LENGTH (object)) * (sizeof (bignum_digit_type)));
+      bytes = (BIGNUM_START_PTR (object));
+    }
+  else if (FLONUM_P (object))
+    {
+      n_bytes = ((FLOATING_VECTOR_LENGTH (object)) * (sizeof (SCHEME_OBJECT)));
+      bytes = (FLOATING_VECTOR_LOC (object, 0));
+    }
+  else
+    PRIMITIVE_RETURN (SHARP_F);
+  PRIMITIVE_RETURN (ULONG_TO_FIXNUM (memory_hash (n_bytes, bytes)));
+}

diff --git a/src/microcode/utils.c b/src/microcode/utils.c
index 8052c5500cb401bea9a5281ba8c5f21e2312e3d6..7018d43749765bcddc98ebfae12f373abd6aa98f 100644 (file)
--- a/src/microcode/utils.c
+++ b/src/microcode/utils.c
@@ -488,6 +488,24 @@ arg_real_in_range (int arg_number, double lower_limit, double upper_limit)
     error_bad_range_arg (arg_number);
   return (result);
 }
+
+/* The FNV hash, short for Fowler/Noll/Vo in honor of its creators.  */
+
+uint32_t
+memory_hash (unsigned long length, const void * vp)
+{
+  const uint8_t * scan = ((const uint8_t *) vp);
+  const uint8_t * end = (scan + length);
+  uint32_t result = 2166136261U;
+  while (scan < end)
+    result = ((result * 16777619U) ^ ((uint32_t) (*scan++)));
+#if (FIXNUM_LENGTH >= 32)
+  return (result);
+#else
+  /* Shorten the result using xor-folding.  */
+  return ((result >> FIXNUM_LENGTH) ^ (result & FIXNUM_MASK));
+#endif
+}
 \f
 bool
 interpreter_applicable_p (SCHEME_OBJECT object)