diff --git a/scheme/ikarus.hash-tables.ss b/scheme/ikarus.hash-tables.ss
index 31e2849..e7d849b 100644
--- a/scheme/ikarus.hash-tables.ss
+++ b/scheme/ikarus.hash-tables.ss
@@ -15,23 +15,28 @@
 
 
 (library (ikarus hash-tables)
-  (export make-eq-hashtable hashtable-ref hashtable-set! hashtable?
+  (export make-eq-hashtable make-hashtable
+          hashtable-ref hashtable-set! hashtable?
           hashtable-size hashtable-delete! hashtable-contains?
           hashtable-update! hashtable-keys hashtable-mutable?
           hashtable-clear! hashtable-entries hashtable-copy
+          hashtable-equivalence-function hashtable-hash-function
           string-hash string-ci-hash symbol-hash)
   (import 
     (ikarus system $pairs)
     (ikarus system $vectors)
     (ikarus system $tcbuckets)
     (ikarus system $fx)
-    (except (ikarus) make-eq-hashtable hashtable-ref hashtable-set! hashtable?
+    (except (ikarus)
+            make-eq-hashtable make-hashtable
+            hashtable-ref hashtable-set! hashtable?
             hashtable-size hashtable-delete! hashtable-contains?
             hashtable-update! hashtable-keys hashtable-mutable?
             hashtable-clear! hashtable-entries hashtable-copy
+            hashtable-equivalence-function hashtable-hash-function
             string-hash string-ci-hash symbol-hash))
 
-  (define-struct hasht (vec count tc mutable?))
+  (define-struct hasht (vec count tc mutable? hashf equivf))
 
   ;;; directly from Dybvig's paper
   (define tc-pop
@@ -112,13 +117,26 @@
                 (void))))))))
 
   (define (get-bucket h x)
-    (let ([pv (pointer-value x)]
-          [vec (hasht-vec h)])
-      (let ([ih pv])
-        (let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))])
-          (let ([b ($vector-ref vec idx)])
-            (or (direct-lookup x b)
-                (rehash-lookup h (hasht-tc h) x)))))))
+    (cond
+      [(hasht-hashf h) =>
+       (lambda (hashf)
+         (let ([ih (hashf x)])
+           (let ([equiv? (hasht-equivf h)]
+                 [vec (hasht-vec h)])
+             (let ([idx (bitwise-and ih ($fx- ($vector-length vec) 1))])
+               (let f ([b ($vector-ref vec idx)])
+                 (cond
+                   [(fixnum? b) #f]
+                   [(equiv? x ($tcbucket-key b)) b]
+                   [else (f ($tcbucket-next b))]))))))]
+      [else
+       (let ([pv (pointer-value x)]
+             [vec (hasht-vec h)])
+         (let ([ih pv])
+           (let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))])
+             (let ([b ($vector-ref vec idx)])
+               (or (direct-lookup x b)
+                   (rehash-lookup h (hasht-tc h) x))))))]))
 
   (define (get-hash h x v)
     (cond
@@ -156,31 +174,52 @@
 
   (define put-hash!
     (lambda (h x v)
-      (let ([pv (pointer-value x)]
-            [vec (hasht-vec h)])
-        (let ([ih pv])
-          (let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))])
-            (let ([b ($vector-ref vec idx)])
-              (cond
-                [(or (direct-lookup x b) (rehash-lookup h (hasht-tc h) x))
-                 =>
-                 (lambda (b) 
-                   ($set-tcbucket-val! b v)
-                   (void))]
-                [else 
-                 (let ([bucket
-                        ($make-tcbucket (hasht-tc h) x v ($vector-ref vec idx))])
-                   (if ($fx= (pointer-value x) pv)
-                       ($vector-set! vec idx bucket)
-                       (let* ([ih (pointer-value x)]
-                              [idx 
-                               ($fxlogand ih ($fx- ($vector-length vec) 1))])
-                         ($set-tcbucket-next! bucket ($vector-ref vec idx))
-                         ($vector-set! vec idx bucket))))
-                 (let ([ct (hasht-count h)])
-                   (set-hasht-count! h ($fxadd1 ct))
-                   (when ($fx> ct ($vector-length vec))
-                     (enlarge-table h)))])))))))
+      (cond
+        [(hasht-hashf h) =>
+         (lambda (hashf)
+           (let ([ih (hashf x)])
+             (let ([equiv? (hasht-equivf h)]
+                   [vec (hasht-vec h)])
+               (let ([idx (bitwise-and ih ($fx- ($vector-length vec) 1))])
+                 (let f ([b ($vector-ref vec idx)])
+                   (cond
+                     [(fixnum? b)
+                      ($vector-set! vec idx 
+                        (vector x v ($vector-ref vec idx)))
+                      (let ([ct (hasht-count h)])
+                        (set-hasht-count! h ($fxadd1 ct))
+                        (when ($fx> ct ($vector-length vec))
+                          (enlarge-table h)))]
+                     [(equiv? x ($tcbucket-key b))
+                      ($set-tcbucket-val! b v)]
+                     [else (f ($tcbucket-next b))]))))))]
+        [else
+         (let ([pv (pointer-value x)]
+               [vec (hasht-vec h)])
+           (let ([ih pv])
+             (let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))])
+               (let ([b ($vector-ref vec idx)])
+                 (cond
+                   [(or (direct-lookup x b) (rehash-lookup h (hasht-tc h) x))
+                    =>
+                    (lambda (b) 
+                      ($set-tcbucket-val! b v)
+                      (void))]
+                   [else 
+                    (let ([bucket
+                           ($make-tcbucket (hasht-tc h) x v 
+                             ($vector-ref vec idx))])
+                      (if ($fx= (pointer-value x) pv)
+                          ($vector-set! vec idx bucket)
+                          (let* ([ih (pointer-value x)]
+                                 [idx 
+                                  ($fxlogand ih ($fx- ($vector-length vec) 1))])
+                            ($set-tcbucket-next! bucket ($vector-ref vec idx))
+                            ($vector-set! vec idx bucket))))
+                    (let ([ct (hasht-count h)])
+                      (set-hasht-count! h ($fxadd1 ct))
+                      (when ($fx> ct ($vector-length vec))
+                        (enlarge-table h)))])))))])))
           
   (define (update-hash! h x proc default)
     (cond
@@ -188,34 +227,63 @@
        (lambda (b) ($set-tcbucket-val! b (proc ($tcbucket-val b))))]
       [else (put-hash! h x (proc default))]))
 
-  (define insert-b
-    (lambda (b vec mask)
-      (let* ([x ($tcbucket-key b)]
-             [pv (pointer-value x)]
-             [ih pv]
-             [idx ($fxlogand ih mask)]
-             [next ($tcbucket-next b)])
-        ($set-tcbucket-next! b ($vector-ref vec idx))
-        ($vector-set! vec idx b)
-        (unless (fixnum? next)
-          (insert-b next vec mask)))))
-
-  (define move-all
-    (lambda (vec1 i n vec2 mask)
-      (unless ($fx= i n)
-        (let ([b ($vector-ref vec1 i)])
-          (unless (fixnum? b)
-            (insert-b b vec2 mask))
-          (move-all vec1 ($fxadd1 i) n vec2 mask)))))
-
   (define enlarge-table
     (lambda (h)
-      (let* ([vec1 (hasht-vec h)]
-             [n1 ($vector-length vec1)]
-             [n2 ($fxsll n1 1)]
-             [vec2 (make-base-vec n2)])
-        (move-all vec1 0 n1 vec2 ($fx- n2 1))
-        (set-hasht-vec! h vec2))))
+      (define (enlarge-eq-table h)
+        (define insert-b
+          (lambda (b vec mask)
+            (let* ([x ($tcbucket-key b)]
+                   [pv (pointer-value x)]
+                   [ih pv]
+                   [idx ($fxlogand ih mask)]
+                   [next ($tcbucket-next b)])
+              ($set-tcbucket-next! b ($vector-ref vec idx))
+              ($vector-set! vec idx b)
+              (unless (fixnum? next)
+                (insert-b next vec mask)))))
+        (define move-all
+          (lambda (vec1 i n vec2 mask)
+            (unless ($fx= i n)
+              (let ([b ($vector-ref vec1 i)])
+                (unless (fixnum? b)
+                  (insert-b b vec2 mask))
+                (move-all vec1 ($fxadd1 i) n vec2 mask)))))
+        (let* ([vec1 (hasht-vec h)]
+               [n1 ($vector-length vec1)]
+               [n2 ($fxsll n1 1)]
+               [vec2 (make-base-vec n2)])
+          (move-all vec1 0 n1 vec2 ($fx- n2 1))
+          (set-hasht-vec! h vec2)))
+      (define (enlarge-hashtable h hashf)
+        (define insert-b
+          (lambda (b vec mask)
+            (let* ([x ($tcbucket-key b)]
+                   [ih (hashf x)]
+                   [idx (bitwise-and ih mask)]
+                   [next ($tcbucket-next b)])
+              ($set-tcbucket-next! b ($vector-ref vec idx))
+              ($vector-set! vec idx b)
+              (unless (fixnum? next)
+                (insert-b next vec mask)))))
+        (define move-all
+          (lambda (vec1 i n vec2 mask)
+            (unless ($fx= i n)
+              (let ([b ($vector-ref vec1 i)])
+                (unless (fixnum? b)
+                  (insert-b b vec2 mask))
+                (move-all vec1 ($fxadd1 i) n vec2 mask)))))
+        (let* ([vec1 (hasht-vec h)]
+               [n1 ($vector-length vec1)]
+               [n2 ($fxsll n1 1)]
+               [vec2 (make-base-vec n2)])
+          (move-all vec1 0 n1 vec2 ($fx- n2 1))
+          (set-hasht-vec! h vec2)))
+      (cond
+        [(hasht-hashf h) =>
+         (lambda (hashf)
+           (enlarge-hashtable h hashf))]
+        [else
+         (enlarge-eq-table h)])))
 
   (define init-vec
     (lambda (v i n)
@@ -278,9 +346,9 @@
 
   (define (hasht-copy h mutable?)
     (define (dup-hasht h mutable? n)
-      (let ([x (cons #f #f)])
-        (let ([tc (cons x x)])
-          (make-hasht (make-base-vec n) 0 tc mutable?))))
+      (let* ([hashf (hasht-hashf h)]
+             [tc (and hashf (let ([x (cons #f #f)]) (cons x x)))])
+        (make-hasht (make-base-vec n) 0 tc mutable? hashf (hasht-equivf h))))
     (let ([v (hasht-vec h)] [n (hasht-count h)])
       (let ([r (dup-hasht h mutable? (vector-length v))])
         (let f ([i ($fxsub1 n)] [j ($fxsub1 (vector-length v))] [r r] [v v])
@@ -306,13 +374,36 @@
       [()
        (let ([x (cons #f #f)])
          (let ([tc (cons x x)])
-           (make-hasht (make-base-vec 32) 0 tc #t)))]
-      [(k) 
-       (if (and (or (fixnum? k) (bignum? k))
-                (>= k 0))
+           (make-hasht (make-base-vec 32) 0 tc #t #f eq?)))]
+      [(k)
+       (if (and (or (fixnum? k) (bignum? k)) (>= k 0))
            (make-eq-hashtable)
-           (die 'make-eq-hashtable
-             "invalid initial capacity" k))]))
+           (die 'make-eq-hashtable "invalid initial capacity" k))]))
+
+  (define make-hashtable
+    (case-lambda
+      [(hashf equivf) (make-hashtable hashf equivf 0)]
+      [(hashf equivf k)
+       (define who 'make-hashtable)
+       (define (wrap f)
+         (cond
+           [(or (eq? f symbol-hash)
+                (eq? f string-hash)
+                (eq? f string-ci-hash))
+            f]
+           [else 
+            (lambda (k)
+              (let ([i (f k)])
+                (if (and (or (fixnum? i) (bignum? i)) (>= i 0))
+                    i
+                    (die #f "invalid return value from hash function" i))))]))
+       (unless (procedure? hashf)
+         (die who "hash function is not a procedure" hashf))
+       (unless (procedure? equivf)
+         (die who "equivalence function is not a procedure" equivf))
+       (if (and (or (fixnum? k) (bignum? k)) (>= k 0))
+           (make-hasht (make-base-vec 32) 0 #f #t (wrap hashf) equivf)
+           (die who "invalid initial capacity" k))]))
 
   (define hashtable-ref
     (lambda (h x v)
@@ -357,11 +448,11 @@
       (if (hasht? h)
           (if (hasht-mutable? h)
               (del-hash h x)
-              (die 'hashtable-delete! "hashtable is immutable" h))
+              (die 'hashtable-delete! "hash table is immutable" h))
           (die 'hashtable-delete! "not a hash table" h))))
 
   (define (hashtable-entries h)
-    (if (hasht? h) 
+    (if (hasht? h)
         (get-entries h)
         (die 'hashtable-entries "not a hash table" h)))
 
@@ -379,14 +470,14 @@
     (if (hasht? h) 
         (if (hasht-mutable? h)
             (clear-hash! h)
-            (die 'hashtable-clear! "hashtable is immutable" h))
+            (die 'hashtable-clear! "hash table is immutable" h))
         (die 'hashtable-clear! "not a hash table" h)))
 
   (define hashtable-copy 
     (case-lambda
       [(h) 
        (if (hasht? h)
-           (if (hasht-mutable? h) 
+           (if (hasht-mutable? h)
                (hasht-copy h #f)
                h)
            (die 'hashtable-copy "not a hash table" h))]
@@ -397,8 +488,18 @@
                h)
            (die 'hashtable-copy "not a hash table" h))]))
 
+  (define (hashtable-equivalence-function h)
+    (if (hasht? h)
+        (hasht-equivf h)
+        (die 'hashtable-equivalence-function "not a hash table" h)))
+
+  (define (hashtable-hash-function h)
+    (if (hasht? h)
+        (hasht-hashf h)
+        (die 'hashtable-hash-function "not a hash table" h)))
+
   (define (string-hash s)
-    (if (string? s) 
+    (if (string? s)
         (foreign-call "ikrt_string_hash" s)
         (die 'string-hash "not a string" s)))
 
diff --git a/scheme/ikarus.not-yet-implemented.ss b/scheme/ikarus.not-yet-implemented.ss
index 24c3053..08a4ff3 100644
--- a/scheme/ikarus.not-yet-implemented.ss
+++ b/scheme/ikarus.not-yet-implemented.ss
@@ -7,9 +7,8 @@
     make-custom-textual-input/output-port
     open-file-input/output-port output-port-buffer-mode
     port-has-set-port-position!?
-    set-port-position!  make-eqv-hashtable
-    hashtable-hash-function make-hashtable
-    hashtable-equivalence-function equal-hash
+    set-port-position!  
+    make-eqv-hashtable equal-hash
     string-normalize-nfc string-normalize-nfd
     string-normalize-nfkc string-normalize-nfkd string-titlecase
     )
@@ -21,9 +20,8 @@
     make-custom-textual-input/output-port
     open-file-input/output-port output-port-buffer-mode
     port-has-set-port-position!?
-    set-port-position!  make-eqv-hashtable
-    hashtable-hash-function make-hashtable
-    hashtable-equivalence-function equal-hash
+    set-port-position! 
+    make-eqv-hashtable equal-hash
     string-normalize-nfc string-normalize-nfd
     string-normalize-nfkc string-normalize-nfkd string-titlecase
     ))
@@ -56,8 +54,7 @@
     bitwise-rotate-bit-field bitwise-reverse-bit-field
     fxreverse-bit-field 
     ;;; not top priority at the moment
-    make-eqv-hashtable make-hashtable equal-hash
-    hashtable-hash-function hashtable-equivalence-function
+    make-eqv-hashtable equal-hash
     string-normalize-nfc string-normalize-nfd
     string-normalize-nfkc string-normalize-nfkd 
     ;;; won't be implemented
diff --git a/scheme/last-revision b/scheme/last-revision
index d65a7d9..a0af042 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1638
+1641
diff --git a/scheme/todo-r6rs.ss b/scheme/todo-r6rs.ss
index c119cda..f71ee30 100755
--- a/scheme/todo-r6rs.ss
+++ b/scheme/todo-r6rs.ss
@@ -15,6 +15,7 @@
 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 
+this-file-is-out-of-date!
 (import (ikarus))
 
 ;;; library names: