From e6ee3f100afacb6d60c8eb22fb730d705d6c1460 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 22 May 2018 22:17:51 -0700 Subject: [PATCH] Fix thinko in hash-simple-object and add primitive-memory-hash. --- src/microcode/prim.c | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/src/microcode/prim.c b/src/microcode/prim.c index 8a4157b84..6d7d4f0b9 100644 --- a/src/microcode/prim.c +++ b/src/microcode/prim.c @@ -448,10 +448,36 @@ DEFINE_PRIMITIVE ("hash-simple-object", Prim_hash_simple_object, 1, 1, 0) } else if (FLONUM_P (object)) { - n_bytes = ((FLOATING_VECTOR_LENGTH (object)) * (sizeof (SCHEME_OBJECT))); + n_bytes = ((FLOATING_VECTOR_LENGTH (object)) * (sizeof (double))); bytes = (FLOATING_VECTOR_LOC (object, 0)); } else PRIMITIVE_RETURN (SHARP_F); PRIMITIVE_RETURN (ULONG_TO_FIXNUM (memory_hash (n_bytes, bytes))); } + +DEFINE_PRIMITIVE ("primitive-memory-hash", Prim_memory_hash, 3, 3, 0) +{ + PRIMITIVE_HEADER (3); + SCHEME_OBJECT object = (ARG_REF (1)); + if (!((GC_TYPE_VECTOR (object)) + && ((OBJECT_TYPE (MEMORY_REF (object, 0))) == TC_MANIFEST_NM_VECTOR))) + error_wrong_type_arg (1); + unsigned long nwords = (VECTOR_LENGTH (object)); + unsigned long start = (arg_ulong_integer (2)); + unsigned long end = (arg_ulong_integer (3)); + + unsigned long min_index = (sizeof (SCHEME_OBJECT)); + unsigned long max_index = (min_index + (nwords * (sizeof (SCHEME_OBJECT)))); + + if (!((start >= min_index) && (start <= max_index))) + error_bad_range_arg (2); + + if (!((end >= start) && (end <= max_index))) + error_bad_range_arg (3); + + PRIMITIVE_RETURN + (ULONG_TO_FIXNUM + (memory_hash ((end - start), + (((const uint8_t *) (OBJECT_ADDRESS (object))) + start)))); +} -- 2.25.1