From ff9e85873c429fbc798ac558ab91ecd2422bd99b Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 26 Nov 2018 23:18:35 -0800 Subject: [PATCH] Implement binary-hash-by-X; some hair to guarantee fixnum result. Not nearly as fast as the underlying unary hash, but for now that's OK. If need be we can make it faster. --- src/microcode/utabmd.c | 10 ++++++++-- src/runtime/hash-table.scm | 25 +++++++++++++++++++++++++ src/runtime/microcode-tables.scm | 6 ++++++ src/runtime/runtime.pkg | 5 +++++ 4 files changed, 44 insertions(+), 2 deletions(-) diff --git a/src/microcode/utabmd.c b/src/microcode/utabmd.c index a587ca64d..b550edfb3 100644 --- a/src/microcode/utabmd.c +++ b/src/microcode/utabmd.c @@ -46,7 +46,7 @@ static SCHEME_OBJECT fixed_objects_syscall_names (void); static SCHEME_OBJECT fixed_objects_syserr_names (void); static SCHEME_OBJECT names_to_vector (unsigned long, const char **); -#define IDENTITY_LENGTH 20 /* Plenty of room */ +#define IDENTITY_LENGTH 20 /* Plenty of room */ #define ID_RELEASE 0 /* System release (string) */ #define ID_MICRO_VERSION 1 /* Microcode version (fixnum) */ /* 2 unused */ @@ -62,8 +62,10 @@ static SCHEME_OBJECT names_to_vector (unsigned long, const char **); #define ID_CC_ARCH 12 /* Compiled-code support (string) */ #define ID_FLONUM_EXP_MIN 13 /* Minimum finite (normal) exponent */ #define ID_FLONUM_EXP_MAX 14 /* Maximum finite exponent */ +#define ID_NONNEG_FIXNUM_LENGTH 15 /* Number of bits in nonneg. fixnum */ +#define ID_NONNEG_FIXNUM_MASK 16 /* Mask for nonneg. fixnum */ -#define N_IDENTITY_NAMES 0x0F +#define N_IDENTITY_NAMES 0x11 static const char * identity_names [] = { /* 0x00 */ "system-release-string", @@ -81,6 +83,8 @@ static const char * identity_names [] = /* 0x0C */ "cc-arch-string", /* 0x0D */ "flonum-exponent-min", /* 0x0E */ "flonum-exponent-max", + /* 0x0F */ "nonnegative-fixnum-length", + /* 0x10 */ "nonnegative-fixnum-mask", }; SCHEME_OBJECT @@ -100,6 +104,8 @@ make_microcode_identification_vector (void) VECTOR_SET (v, ID_MACHINE_TYPE, (char_pointer_to_string (MACHINE_TYPE))); VECTOR_SET (v, ID_FLONUM_EXP_MIN, (LONG_TO_FIXNUM (DBL_MIN_EXP - 1))); VECTOR_SET (v, ID_FLONUM_EXP_MAX, (LONG_TO_FIXNUM (DBL_MAX_EXP - 1))); + VECTOR_SET (v, ID_NONNEG_FIXNUM_LENGTH, (ULONG_TO_FIXNUM (FIXNUM_LENGTH))); + VECTOR_SET (v, ID_NONNEG_FIXNUM_MASK, (ULONG_TO_FIXNUM (FIXNUM_MASK))); { const char * name = (cc_arch_name ()); if (name != 0) diff --git a/src/runtime/hash-table.scm b/src/runtime/hash-table.scm index 080154a9b..8eaff600a 100644 --- a/src/runtime/hash-table.scm +++ b/src/runtime/hash-table.scm @@ -1008,6 +1008,31 @@ USA. (define-integrable (equal-hash-mod key modulus) (fix:remainder (equal-hash key) modulus)) + +(define (binary-hash-by-identity object1 object2 #!optional modulus) + (binary-hash eq-hash object1 object2 modulus)) + +(define (binary-hash-by-eqv object1 object2 #!optional modulus) + (binary-hash eqv-hash object1 object2 modulus)) + +(define (binary-hash-by-equal object1 object2 #!optional modulus) + (binary-hash equal-hash object1 object2 modulus)) + +;;; Assumes that hash-fn always returns a nonnegative fixnum. +(define-integrable (binary-hash hash-fn object1 object2 modulus) + (let ((sum + (+ (* 31 (hash-fn object1)) + (hash-fn object2)))) + (if (default-object? modulus) + (if (fix:fixnum? sum) + sum + (fix:xor (shift-right sum microcode-id/nonnegative-fixnum-length) + (bitwise-and sum microcode-id/nonnegative-fixnum-mask))) + (begin + (guarantee positive-fixnum? modulus 'binary-eq-hash-mod) + (if (fix:fixnum? sum) + (fix:remainder sum modulus) + (modulo sum modulus)))))) ;;;; Constructing and Open-Coding Types and Constructors diff --git a/src/runtime/microcode-tables.scm b/src/runtime/microcode-tables.scm index ff26f220c..ae356daa0 100644 --- a/src/runtime/microcode-tables.scm +++ b/src/runtime/microcode-tables.scm @@ -182,6 +182,8 @@ USA. (define microcode-id/floating-epsilon) (define microcode-id/floating-exponent-min) (define microcode-id/floating-exponent-max) +(define microcode-id/nonnegative-fixnum-length) +(define microcode-id/nonnegative-fixnum-mask) (define microcode-id/operating-system) (define microcode-id/operating-system-name) (define microcode-id/operating-system-variant) @@ -200,6 +202,10 @@ USA. (microcode-identification-item 'flonum-exponent-min)) (set! microcode-id/floating-exponent-max (microcode-identification-item 'flonum-exponent-max)) + (set! microcode-id/nonnegative-fixnum-length + (microcode-identification-item 'nonnegative-fixnum-length)) + (set! microcode-id/nonnegative-fixnum-mask + (microcode-identification-item 'nonnegative-fixnum-mask)) (set! microcode-id/operating-system-name (microcode-identification-item 'os-name-string)) (set! microcode-id/operating-system diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index c73ba2b1c..4c0f7d2ec 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -2451,6 +2451,9 @@ USA. weak-hash-table/constructor) (export () alist->hash-table ;SRFI-69 + binary-hash-by-equal + binary-hash-by-eqv + binary-hash-by-identity datum-weak-eq-hash-table-type datum-weak-eqv-hash-table-type eq-hash @@ -3241,6 +3244,8 @@ USA. microcode-id/floating-exponent-max microcode-id/floating-exponent-min microcode-id/machine-type + microcode-id/nonnegative-fixnum-length + microcode-id/nonnegative-fixnum-mask microcode-id/operating-system microcode-id/operating-system-suffix microcode-id/operating-system-variant -- 2.25.1