diff --git a/code/hash-new.lisp b/code/hash-new.lisp index e841cfaa96c29e4affe43941624c0bc41946ee83..6c66b6c96946da14f23cf78154db401ff416df4b 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 9306f590c47e77d26f9ceca1212528a8259fbca6..729f8c2674bbdf179bc8dfa0e32013df5472a19c 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 52acafde8793cfb9495bdef59f12c0aff6895815..b9f36cbfeea4a11ea70bceec137bfb72f6578a83 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 39d85cb50484dc926c0d75eb0afe86ea5f8f5d39..8db2daa324767a83e4b26aea34976d6ca274b0d3 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.