-22 Apr 2010 Kevin Rosenberg <kevin@rosenberg.net>
+17 Apr 2010 Kevin Rosenberg <kevin@rosenberg.net>
+ * Version 1.102
+ * btree.lisp: New file providing binary tree search for
+ sorted vectors
+ * tests.list: Add tests for binary tree search
+ * mop.lisp: Change pushed cl:*features* to be in KMRCL
+ package, not KEYWORD
+ * attrib-class.lisp: Use new mop *feature* names for reader
+ conditionals
+ * io.lisp: Add def-unsigned-int-io, along with function
+ definitions for binary io of 2 through 8 byte unsigned ints.
+
+22 Mar 2010 Kevin Rosenberg <kevin@rosenberg.net>
+ * Version 1.101
* lists.lisp: Reduce memory use by FLATTEN
20 Aug 2009 Kevin Rosenberg <kevin@rosenberg.net>
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: kmrcl-*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10-*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;; This file, part of KMRCL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;; encapsulating macro for Lispworks
(kmr-mop:process-slot-option attributes-class :attributes)
-#+(or cmu scl sbcl openmcl)
+#+(or cmu scl sbcl ccl)
(defmethod kmr-mop:validate-superclass ((class attributes-class)
(superclass kmr-mop:standard-class))
t)
-(defmethod kmr-mop:direct-slot-definition-class ((cl attributes-class) #+kmr-normal-dsdc &rest initargs)
+(defmethod kmr-mop:direct-slot-definition-class ((cl attributes-class) #+kmrcl::normal-dsdc &rest initargs)
(declare (ignore initargs))
(kmr-mop:find-class 'attributes-dsd))
-(defmethod kmr-mop:effective-slot-definition-class ((cl attributes-class) #+kmr-normal-dsdc &rest initargs)
+(defmethod kmr-mop:effective-slot-definition-class ((cl attributes-class) #+kmrcl::normal-dsdc &rest initargs)
(declare (ignore initargs))
(kmr-mop:find-class 'attributes-esd))
(defmethod kmr-mop:compute-effective-slot-definition
- ((cl attributes-class) #+kmr-normal-cesd name dsds)
- #+kmr-normal-cesd (declare (ignore name))
+ ((cl attributes-class) #+kmrcl::normal-cesd name dsds)
+ #+kmrcl::normal-cesd (declare (ignore name))
(let ((esd (call-next-method)))
(setf (esd-attributes esd) (remove-duplicates (mapappend #'dsd-attributes dsds)))
esd))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
-;;; -*- Syntax: Ansi-Common-Lisp; Base: 10; Mode: lisp; Package: kmrcl -*-
+;;; -*- Syntax: Ansi-Common-Lisp; Base: 10; Mode: lisp -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: June 2003
;;;;
-;;;; $Id$
-;;;;
;;;; Works for CMUCL, SBCL, and AllergoCL only
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2003 by Kevin M. Rosenberg
(in-package #:kmrcl)
-;; Intial CMUCL version by OnShored. Ported to SBCL by Kevin Rosenberg
+;; Intial CMUCL version by OnShored. Ported to AllegroCL, SBCL by Kevin Rosenberg
#+sbcl
(eval-when (:compile-toplevel :load-toplevel :execute)
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: kmrcl -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Oct 2003
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002
;;;;
-;;;; $Id$
-;;;;a
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and by onShore Development, Inc.
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Sep 2003
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
((zerop pos))
(write-sequence buf out :end pos)))
+
+(defmacro def-unsigned-int-io (len r-name w-name &key (big-endian nil))
+ "Defines read and write functions for an unsigned integer with LEN bytes from STREAM."
+ (when (< len 1)
+ (error "Number of bytes must be greater than 0.~%"))
+ (let ((endian-string (if big-endian "big" "little")))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun ,r-name (stream)
+ ,(format nil "Reads an ~A byte unsigned integer (~A-endian)."
+ len endian-string)
+ (declare (optimize (speed 3) (compilation-speed 0) (safety 0)
+ (space 0) (debug 0))
+ (type stream stream))
+ (let ((val 0))
+ (declare (type
+ ,(if (< (expt 256 len) most-positive-fixnum)
+ 'fixnum
+ `(integer 0 ,(1- (expt 256 len))))
+ val))
+ ,@(loop for i from 1 upto len
+ collect
+ `(setf (ldb (byte 8 ,(* (if big-endian (1- i) (- len i))
+ 8)) val) (read-byte stream)))
+ val))
+ (defun ,w-name (val stream &key (bounds-check t))
+ ,(format nil "Writes an ~A byte unsigned integer as binary to STREAM (~A-endian)."
+ len endian-string)
+ (declare (optimize (speed 3) (compilation-speed 0) (safety 0)
+ (space 0) (debug 0))
+ (type stream stream)
+ ,(if (< (expt 256 len) most-positive-fixnum)
+ '(type fixnum val)
+ '(type integer val)))
+ (when bounds-check
+ (when (>= val ,(expt 256 len))
+ (error "Number ~D is too large to fit in ~D bytes.~%" val ,len))
+ (when (minusp val)
+ (error "Number ~D can't be written as unsigned integer." val)))
+ (locally (declare (type (integer 0 ,(1- (expt 256 len))) val))
+ ,@(loop for i from 1 upto len
+ collect
+ `(write-byte (ldb (byte 8 ,(* (if big-endian (1- i) (- len i))
+ 8)) val) stream)))
+ val)
+ nil)))
+
+(defmacro make-unsigned-int-io-fn (len)
+ "Makes reader and writer functions for unsigned byte input/output of
+LEN bytes with both little and big endian order. Function names are in the
+form of {READ,WRITE}-UINT<LEN>-{be,le}."
+ `(progn
+ (def-unsigned-int-io
+ ,len
+ ,(intern (format nil "~A~D-~A" (symbol-name '#:read-uint) len (symbol-name '#:le)))
+ ,(intern (format nil "~A~D-~A" (symbol-name '#:write-uint) len (symbol-name '#:le)))
+ :big-endian nil)
+ (def-unsigned-int-io
+ ,len
+ ,(intern (format nil "~A~D-~A" (symbol-name '#:read-uint) len (symbol-name '#:be)))
+ ,(intern (format nil "~A~D-~A" (symbol-name '#:write-uint) len (symbol-name '#:be)))
+ :big-endian t)))
+
+(make-unsigned-int-io-fn 2)
+(make-unsigned-int-io-fn 3)
+(make-unsigned-int-io-fn 4)
+(make-unsigned-int-io-fn 5)
+(make-unsigned-int-io-fn 6)
+(make-unsigned-int-io-fn 7)
+(make-unsigned-int-io-fn 8)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
(:file "repl" :depends-on ("listener" "strings"))
(:file "os" :depends-on ("macros" "impl"))
(:file "signals" :depends-on ("package"))
+ (:file "btree" :depends-on ("macros"))
))
(defmethod perform ((o test-op) (c (eql (find-system 'kmrcl))))
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Jun 2003
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Nov 2002
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2003
;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of KMRCL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
#+sbcl
(eval-when (:compile-toplevel :load-toplevel :execute)
(if (find-package 'sb-mop)
- (pushnew :kmr-sbcl-mop cl:*features*)
- (pushnew :kmr-sbcl-pcl cl:*features*)))
+ (pushnew 'kmrcl::sbcl-mop cl:*features*)
+ (pushnew 'kmrcl::sbcl-pcl cl:*features*)))
#+cmu
(eval-when (:compile-toplevel :load-toplevel :execute)
(if (eq (symbol-package 'pcl:find-class)
(find-package 'common-lisp))
- (pushnew :kmr-cmucl-mop cl:*features*)
- (pushnew :kmr-cmucl-pcl cl:*features*)))
+ (pushnew 'kmrcl::cmucl-mop cl:*features*)
+ (pushnew 'kmrcl::cmucl-pcl cl:*features*)))
(defpackage #:kmr-mop
(:use
#:cl
#:kmrcl
- #+kmr-sbcl-mop #:sb-mop
- #+kmr-cmucl-mop #:mop
+ #+kmrcl::sbcl-mop #:sb-mop
+ #+kmrcl::cmucl-mop #:mop
#+allegro #:mop
#+lispworks #:clos
#+clisp #:clos
#+scl #:clos
- #+openmcl #:openmcl-mop
+ #+ccl #:openmcl-mop
)
)
#+clisp
'(clos::compute-effective-slot-definition-initargs)
#+sbcl
- '(#+kmr-sbcl-mop class-of #-kmr-sbcl-mop sb-pcl:class-of
- #+kmr-sbcl-mop class-name #-kmr-sbcl-mop sb-pcl:class-name
- #+kmr-sbcl-mop class-slots #-kmr-sbcl-mop sb-pcl:class-slots
- #+kmr-sbcl-mop find-class #-kmr-sbcl-mop sb-pcl:find-class
+ '(#+kmrcl::sbcl-mop class-of #-kmrcl::sbcl-mop sb-pcl:class-of
+ #+kmrcl::sbcl-mop class-name #-kmrcl::sbcl-mop sb-pcl:class-name
+ #+kmrcl::sbcl-mop class-slots #-kmrcl::sbcl-mop sb-pcl:class-slots
+ #+kmrcl::sbcl-mop find-class #-kmrcl::sbcl-mop sb-pcl:find-class
sb-pcl::standard-class
sb-pcl:slot-definition-name sb-pcl::finalize-inheritance
sb-pcl::standard-direct-slot-definition
clos::compute-slots
;; note: make-method-lambda is not fbound
)
- #+openmcl
+ #+ccl
'(openmcl-mop::slot-definition-name openmcl-mop:finalize-inheritance
openmcl-mop::standard-direct-slot-definition openmcl-mop::standard-effective-slot-definition
openmcl-mop::validate-superclass openmcl-mop:direct-slot-definition-class openmcl-mop::effective-slot-definition-class
#+sbcl
(if (find-package 'sb-mop)
- (setq cl:*features* (delete :kmr-sbcl-mop cl:*features*))
- (setq cl:*features* (delete :kmr-sbcl-pcl cl:*features*)))
+ (setq cl:*features* (delete 'kmrcl::sbcl-mop cl:*features*))
+ (setq cl:*features* (delete 'kmrcl::sbcl-pcl cl:*features*)))
#+cmu
(if (find-package 'mop)
- (setq cl:*features* (delete :kmr-cmucl-mop cl:*features*))
- (setq cl:*features* (delete :kmr-cmucl-pcl cl:*features*)))
+ (setq cl:*features* (delete 'kmrcl::cmucl-mop cl:*features*))
+ (setq cl:*features* (delete 'kmrcl::cmucl-pcl cl:*features*)))
- (when (>= (length (generic-function-lambda-list
+ (when (< (length (generic-function-lambda-list
(ensure-generic-function
'compute-effective-slot-definition)))
3)
- (pushnew :kmr-normal-cesd cl:*features*))
+ (pushnew 'short-arg-cesd cl:*features*))
- (when (>= (length (generic-function-lambda-list
- (ensure-generic-function
- 'direct-slot-definition-class)))
- 3)
- (pushnew :kmr-normal-dsdc cl:*features*))
+ (when (< (length (generic-function-lambda-list
+ (ensure-generic-function
+ 'direct-slot-definition-class)))
+ 3)
+ (pushnew 'short-arg-dsdc cl:*features*))
) ;; eval-when
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Jul 2003
;;;;
-;;;; $Id$
-;;;;
;;;; *************************************************************************
(in-package #:kmrcl)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002-2006 by Kevin M. Rosenberg
+;;;; This file, part of KMRCL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
#:+datetime-number-strings+
#:utc-offset
#:copy-binary-stream
+ #:def-unsigned-int-io
+ #:make-unsigned-int-io-fn
+ #:read-uint2-le #:read-uint2-be #:write-uint2-le #:write-uint2-be
+ #:read-uint3-le #:read-uint3-be #:write-uint3-le #:write-uint3-be
+ #:read-uint4-le #:read-uint4-be #:write-uint4-le #:write-uint4-be
+ #:read-uint5-le #:read-uint5-be #:write-uint5-le #:write-uint5-be
+ #:read-uint6-le #:read-uint6-be #:write-uint6-le #:write-uint6-be
+ #:read-uint7-le #:read-uint7-be #:write-uint7-le #:write-uint7-be
+ #:read-uint8-le #:read-uint8-be #:write-uint8-le #:write-uint8-be
;; impl.lisp
#:probe-directory
;; signals.lisp
#:set-signal-handler
#:remove-signal-handler
+
+ ;; btree.lisp
+ #:sorted-vector-find
+ #:string-tricmp
+ #:simple-string-tricmp
+ #:number-tricmp
+ #:complex-number-tricmp
+
+ ;; mop.lisp
+ #:short-arg-cesd
+ #:short-arg-dsdc
))
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Purpose: Multiprocessing functions
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: June 2003
-;;;;
-;;;; $Id$
;;;; *************************************************************************
(in-package #:kmrcl)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package :kmrcl)
+(in-package #:kmrcl)
(defun nsubseq (sequence start &optional end)
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Purpose: Socket functions
;;;; Programmer: Kevin M. Rosenberg with excerpts from portableaserve
;;;; Date Started: Jun 2003
-;;;;
-;;;; $Id$
;;;; *************************************************************************
(in-package #:kmrcl)
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002-2006 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; package: kmrcl -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: kmrcl-tests -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Apr 2003
;;;;
-;;;; $Id$
-;;;;
-;;;; This file is Copyright (c) 2000-2006 by Kevin M. Rosenberg
+;;;; This file is Copyright (c) 2000-2010 by Kevin M. Rosenberg
;;;;
;;;; *************************************************************************
(deftest :pis.4 (prefixed-integer-string 234134 #\C 7) "C0234134")
- ;;; MOP Testing
+;;; Binary tree search tests
+
+(defvar *btree-vector*)
+
+(defun init-btree-vector (len)
+ (make-random-state t)
+ (setq *btree-vector* (make-array (list len)
+ :element-type 'fixnum
+ :initial-element 0))
+ (dotimes (i (length *btree-vector*))
+ (setf (aref *btree-vector* i) (random most-positive-fixnum)))
+ (setq *btree-vector* (sort *btree-vector* #'<)))
+
+(defun test-btree-vector (len)
+ (init-btree-vector len)
+ (dotimes (i (length *btree-vector*) t)
+ (let ((stored (aref *btree-vector* i)))
+ (multiple-value-bind (pos value last-pos count)
+ (sorted-vector-find stored *btree-vector*)
+ (declare (ignore last-pos))
+ (when (or (not (eql i pos)) (not (eql stored value)))
+ (format t "~&Error: btree value ~D at pos ~D: found ~D at pos ~D [count ~D].~%"
+ stored i value pos count)
+ (return nil))))))
+
+(deftest :btree.1
+ (dotimes (i 1000 t)
+ (test-btree-vector i))
+ t)
+
+(defun time-btree (&optional (fn #'sorted-vector-find) (return-on-error nil))
+ (time
+ (let ((total-count 0))
+ (declare (fixnum total-count))
+ (dotimes (i (length *btree-vector*) t)
+ (let ((stored (aref *btree-vector* i)))
+ (multiple-value-bind (value pos count)
+ (funcall fn stored *btree-vector*)
+ (incf total-count count)
+ (when (or (/= i pos) (/= stored value))
+ (format t "~&Error: btree value ~D at pos ~D: found ~D at pos ~D [count ~D].~%"
+ stored i value pos count)
+ (when return-on-error
+ (return-from time-btree nil))))))
+ (float (/ total-count (length *btree-vector*))))))
+
+;;; MOP Testing
;; Disable attrib class until understand changes in sbcl/cmucl
;; using COMPUTE-SLOT-ACCESSOR-INFO and defining method
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id$
-;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software