From d57b4f751babe0277ccc41f2b1965ec73c8bd1ae Mon Sep 17 00:00:00 2001 From: pmai <pmai> Date: Thu, 21 Nov 2002 21:24:14 +0000 Subject: [PATCH] Entomotomy Bug: sxhash-on-pcl-instances-returns-42 Committed a slightly reworked patch by Gerd Moellmann that introduces new hash-code slots into (funcallable-)standard-instances, which get initialized to persistent, sequential numbers upon instance creation, thus providing better sxhash/equal hashing. --- code/hash-new.lisp | 4 ++-- code/hash.lisp | 4 ++-- pcl/fin.lisp | 10 ++++++++-- pcl/low.lisp | 21 +++++++++++++++++++-- 4 files changed, 31 insertions(+), 8 deletions(-) diff --git a/code/hash-new.lisp b/code/hash-new.lisp index e841cfaa9..6c66b6c96 100644 --- a/code/hash-new.lisp +++ b/code/hash-new.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.18 2002/07/10 16:15:59 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.19 2002/11/21 21:24:13 pmai Exp $") ;;; ;;; ********************************************************************** ;;; @@ -913,7 +913,7 @@ (if (typep s-expr 'structure-object) (internal-sxhash (class-name (layout-class (%instance-layout s-expr))) depth) - 42)) + (sxhash-instance s-expr))) ;; Other-pointer types. (simple-string (sxhash-simple-string s-expr)) (symbol (sxhash-simple-string (symbol-name s-expr))) diff --git a/code/hash.lisp b/code/hash.lisp index 9306f590c..729f8c267 100644 --- a/code/hash.lisp +++ b/code/hash.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.39 2000/07/06 18:36:37 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.40 2002/11/21 21:24:14 pmai Exp $") ;;; ;;; ********************************************************************** ;;; @@ -874,7 +874,7 @@ (if (typep s-expr 'structure-object) (internal-sxhash (class-name (layout-class (%instance-layout s-expr))) depth) - 42)) + (sxhash-instance s-expr))) ;; Other-pointer types. (simple-string (sxhash-simple-string s-expr)) (symbol (sxhash-simple-string (symbol-name s-expr))) diff --git a/pcl/fin.lisp b/pcl/fin.lisp index 52acafde8..b9f36cbfe 100644 --- a/pcl/fin.lisp +++ b/pcl/fin.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fin.lisp,v 1.16 2002/10/09 15:32:29 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fin.lisp,v 1.17 2002/11/21 21:24:14 pmai Exp $") ;;; ;; @@ -133,7 +133,13 @@ explicitly marked saying who wrote it. (pcl-funcallable-instance-slots nil) ;; ;; The debug-name for this function. - (funcallable-instance-name nil)) + (funcallable-instance-name nil) + ;; + ;; Hash code. + (hash-code (get-instance-hash-code) :type fixnum)) + +(defmacro fsc-instance-hash-code (fin) + `(kernel:%funcallable-instance-info ,fin 2)) ;;; Note: returns true for non-pcl funcallable structures. (import 'kernel:funcallable-instance-p) diff --git a/pcl/low.lisp b/pcl/low.lisp index 39d85cb50..8db2daa32 100644 --- a/pcl/low.lisp +++ b/pcl/low.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.19 2002/10/19 14:32:44 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.20 2002/11/21 21:24:14 pmai Exp $") ;;; ;;; This file contains optimized low-level constructs for PCL. @@ -218,6 +218,11 @@ the compiler as completely as possible. Currently this means that (defun pcl-instance-p (x) (typep (kernel:layout-of x) 'wrapper)) +;;; Support for sensible sxhash codes for instances +(let ((hash-code 0)) + (declare (fixnum hash-code) (optimize (speed 3) (safety 0))) + (defun get-instance-hash-code () + (setq hash-code (ext:truly-the fixnum (+ hash-code 1))))) ;;; We define this as STANDARD-INSTANCE, since we're going to clobber the ;;; layout with some standard-instance layout as soon as we make it, and we @@ -228,7 +233,19 @@ the compiler as completely as possible. Currently this means that (:constructor %%allocate-instance--class ()) (:alternate-metaclass kernel:instance lisp:standard-class kernel:make-standard-class)) - (slots nil)) + (slots nil) + (hash-code (get-instance-hash-code) :type fixnum)) + +;;; This doesn't work on structures, but is only called from sxhash which +;;; ensures it isn't called with a structure. +(defmacro std-instance-hash-code (x) `(kernel:%instance-ref ,x 2)) + +;;; Implement proper sxhashing of standard instances. +(defun common-lisp::sxhash-instance (instance) + (cond + ((std-instance-p instance) (std-instance-hash-code instance)) + ((fsc-instance-p instance) (fsc-instance-hash-code instance)) + (t (error "What kind of instance is this?")))) ;;; Both of these operations "work" on structures, which allows the above ;;; weakening of std-instance-p. -- GitLab