diff --git a/code/hash.lisp b/code/hash.lisp
index cbf4959c19815fd06e133fd6b6d461903664fe08..486e92c855c8ef9f522e2d420315c35d3599b705 100644
--- a/code/hash.lisp
+++ b/code/hash.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.20 1992/10/26 03:44:16 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.21 1992/11/04 17:51:03 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -25,7 +25,7 @@
 	  sxhash))
 
 (in-package :ext)
-(export '(*hash-table-tests*))
+(export '(define-hash-table-test))
 
 (in-package :common-lisp)
 
@@ -136,12 +136,26 @@
 
 
 
-;;;; Construction and simple accessors.
+;;;; User defined hash table tests.
 
-;;; *HASH-TABLE-TESTS* -- Public.
+;;; *HASH-TABLE-TESTS* -- Internal.
 ;;; 
 (defvar *hash-table-tests* nil)
 
+;;; DEFINE-HASH-TABLE-TEST -- Public.
+;;;
+(defun define-hash-table-test (name test-fun hash-fun)
+  "Define a new kind of hash table test."
+  (declare (type symbol name)
+	   (type function test-fun hash-fun))
+  (setf *hash-table-tests*
+	(cons (list name test-fun hash-fun)
+	      (remove name *hash-table-tests* :test #'eq :key #'car)))
+  name)
+
+
+;;;; Construction and simple accessors.
+
 ;;; MAKE-HASH-TABLE -- public.
 ;;; 
 (defun make-hash-table (&key (test 'eql) (size 65) (rehash-size 1.5)