Update of /project/flexichain/cvsroot/flexichain In directory clnet:/tmp/cvs-serv18847 Modified Files: flexirank.lisp utilities.lisp Log Message: Improvements from Tim Moore with respect to weak pointers on Allegro. Date: Mon Mar 13 13:13:33 2006 Author: rstrandh Index: flexichain/flexirank.lisp diff -u flexichain/flexirank.lisp:1.1.1.1 flexichain/flexirank.lisp:1.2 --- flexichain/flexirank.lisp:1.1.1.1 Wed Feb 8 21:51:06 2006 +++ flexichain/flexirank.lisp Mon Mar 13 13:13:33 2006 @@ -75,5 +75,5 @@ (defmethod insert-vector* :after ((chain flexirank-mixin) position vector) (loop for elem across vector for pos from position - do (setf (index elem) (position-index pos) + do (setf (index elem) (position-index chain pos) (chain elem) chain))) Index: flexichain/utilities.lisp diff -u flexichain/utilities.lisp:1.1.1.1 flexichain/utilities.lisp:1.2 --- flexichain/utilities.lisp:1.1.1.1 Wed Feb 8 21:51:06 2006 +++ flexichain/utilities.lisp Mon Mar 13 13:13:33 2006 @@ -34,14 +34,17 @@ (values nil nil) (values (elt sequence position) t)))) -;;; CMUCL and SBCL have direct support for weak pointers. In OpenMCL weak -;;; references are only supported via weak hash tables. This class provides -;;; the means for other classes to manage their weak references. -;;; +;;; CMUCL and SBCL have direct support for weak pointers. In OpenMCL and +;;; Allegro weak references are only supported via weak hash tables. This class +;;; provides the means for other classes to manage their weak references. ;;; TODO: check other CL implementations behavior wrt. return values (defclass weak-pointer-container-mixin () - (#+openmcl - (weak-hash :initform (make-hash-table :test #'eq :weak :value))) + (#+(or openmcl allegro) + (weak-hash :initform (make-hash-table :test #'eql + ;; Get it together guys! + #+openmcl :weak #+openmcl :value + #+allegro :values #+allegro :weak)) + (key-counter :initform 0)) (:documentation "Support for weak references, if needed")) (defgeneric make-weak-pointer (object container)) @@ -52,9 +55,9 @@ #+cmu (extensions:make-weak-pointer object) #+sbcl (sb-ext:make-weak-pointer object)) -#+openmcl +#+(or openmcl allegro) (defmethod make-weak-pointer (object (container weak-pointer-container-mixin)) - (let ((key (cons nil nil))) + (let ((key (incf (slot-value container 'key-counter)))) (setf (gethash key (slot-value container 'weak-hash)) object) key)) @@ -66,15 +69,20 @@ #+cmu (extensions:weak-pointer-value weak-pointer) #+sbcl (sb-ext:weak-pointer-value weak-pointer)) -#+openmcl +#+(or openmcl allegro) (defmethod weak-pointer-value (weak-pointer (container weak-pointer-container-mixin)) - (gethash weak-pointer (slot-value container 'weak-hash) nil)) + (let* ((table (slot-value container 'weak-hash)) + (val (gethash weak-pointer table))) + #+allegro + (unless val + (remhash weak-pointer table)) + val)) #-(or sbcl cmu openmcl) (progn (eval-when (:evaluate :compile-toplevel :load-toplevel) - (warning "No support for weak pointers in this implementation. Things may + (warn "No support for weak pointers in this implementation. Things may get big and slow") ) (defmethod make-weak-pointer (object container)