From 6efbc280c56a1c318717723423e2b4e2654c353a Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Fri, 7 Jan 2011 08:36:39 -0800
Subject: [PATCH] add scm_hash_fn_get_handle_by_hash

* libguile/hashtab.h:
* libguile/hashtab.c (scm_hash_fn_get_handle_by_hash): New internal
  procedure, which should make symbol table lookup faster.
---
 libguile/hashtab.c | 89 ++++++++++++++++++++++++++++++++++++++++++++++
 libguile/hashtab.h |  8 +++++
 2 files changed, 97 insertions(+)

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 3b6dc0c09..ce155e99e 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -213,6 +213,37 @@ weak_bucket_assoc (SCM table, SCM buckets, size_t bucket_index,
 }
 
 
+/* Packed arguments for `weak_bucket_assoc_by_hash'.  */
+struct assoc_by_hash_data
+{
+  SCM alist;
+  SCM ret;
+  scm_t_hash_predicate_fn predicate;
+  void *closure;
+};
+
+/* See scm_hash_fn_get_handle_by_hash below.  */
+static void*
+weak_bucket_assoc_by_hash (void *args)
+{
+  struct assoc_by_hash_data *data = args;
+  SCM alist = data->alist;
+
+  for (; scm_is_pair (alist); alist = SCM_CDR (alist))
+    {
+      SCM pair = SCM_CAR (alist);
+      
+      if (!SCM_WEAK_PAIR_DELETED_P (pair)
+          && data->predicate (SCM_CAR (pair), data->closure))
+        {
+          data->ret = pair;
+          break;
+        }
+    }
+  return args;
+}
+        
+
 
 static SCM
 make_hash_table (int flags, unsigned long k, const char *func_name) 
@@ -497,6 +528,64 @@ scm_hash_fn_get_handle (SCM table, SCM obj,
 #undef FUNC_NAME
 
 
+/* This procedure implements three optimizations, with respect to the
+   raw get_handle():
+
+   1. For weak tables, it's assumed that calling the predicate in the
+      allocation lock is safe. In practice this means that the predicate
+      cannot call arbitrary scheme functions. 
+
+   2. We don't check for overflow / underflow and rehash.
+
+   3. We don't actually have to allocate a key -- instead we get the
+      hash value directly. This is useful for, for example, looking up
+      strings in the symbol table.
+ */
+SCM
+scm_hash_fn_get_handle_by_hash (SCM table, unsigned long raw_hash,
+                                scm_t_hash_predicate_fn predicate_fn,
+                                void *closure)
+#define FUNC_NAME "scm_hash_fn_ref_by_hash"
+{
+  unsigned long k;
+  SCM buckets, alist, h = SCM_BOOL_F;
+
+  SCM_VALIDATE_HASHTABLE (SCM_ARG1, table);
+  buckets = SCM_HASHTABLE_VECTOR (table);
+
+  if (SCM_SIMPLE_VECTOR_LENGTH (buckets) == 0)
+    return SCM_BOOL_F;
+
+  k = raw_hash % SCM_SIMPLE_VECTOR_LENGTH (buckets);
+  alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
+
+  if (SCM_HASHTABLE_WEAK_P (table))
+    {
+      struct assoc_by_hash_data args;
+
+      args.alist = alist;
+      args.ret = SCM_BOOL_F;
+      args.predicate = predicate_fn;
+      args.closure = closure;
+      GC_call_with_alloc_lock (weak_bucket_assoc_by_hash, &args);
+      h = args.ret;
+    }
+  else
+    for (; scm_is_pair (alist); alist = SCM_CDR (alist))
+      {
+        SCM pair = SCM_CAR (alist);
+        if (predicate_fn (SCM_CAR (pair), closure))
+          {
+            h = pair;
+            break;
+          }
+      }
+
+  return h;
+}
+#undef FUNC_NAME
+
+
 SCM
 scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
 			     scm_t_hash_fn hash_fn, scm_t_assoc_fn assoc_fn,
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index 75b60e9ad..314994630 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -70,6 +70,10 @@ typedef unsigned long (*scm_t_hash_fn) (SCM obj, unsigned long max,
    some equality predicate.  */
 typedef SCM (*scm_t_assoc_fn) (SCM obj, SCM alist, void *closure);
 
+/* Function that returns true if the given object is the one we are
+   looking for, for scm_hash_fn_ref_by_hash.  */
+typedef int (*scm_t_hash_predicate_fn) (SCM obj, void *closure);
+
 /* Function to fold over the entries of a hash table.  */
 typedef SCM (*scm_t_hash_fold_fn) (void *closure, SCM key, SCM value,
 				   SCM result);
@@ -110,6 +114,10 @@ SCM_API SCM scm_hash_fn_get_handle (SCM table, SCM obj,
 				    scm_t_hash_fn hash_fn,
 				    scm_t_assoc_fn assoc_fn,
 				    void *closure);
+SCM_INTERNAL
+SCM scm_hash_fn_get_handle_by_hash (SCM table, unsigned long raw_hash,
+                                    scm_t_hash_predicate_fn predicate_fn,
+                                    void *closure);
 SCM_API SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
 					 scm_t_hash_fn hash_fn,
 					 scm_t_assoc_fn assoc_fn,
-- 
2.20.1