Version 1.102 (other changes not in last commit)
authorKevin M. Rosenberg <kevin@rosenberg.net>
Sun, 18 Apr 2010 16:10:34 +0000 (10:10 -0600)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Sun, 18 Apr 2010 16:10:34 +0000 (10:10 -0600)
* 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.

30 files changed:
ChangeLog
attrib-class.lisp
buff-input.lisp
byte-stream.lisp
color.lisp
console.lisp
datetime.lisp
equal.lisp
functions.lisp
impl.lisp
io.lisp
kmrcl.asd
listener.lisp
lists.lisp
macros.lisp
math.lisp
mop.lisp
os.lisp
package.lisp
processes.lisp
random.lisp
repl.lisp
seqs.lisp
signals.lisp
sockets.lisp
strings.lisp
strmatch.lisp
tests.lisp
web-utils.lisp
xml-utils.lisp

index 773f4cd..5426a9b 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,17 @@
-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>
index b102eca..453da1b 100644 (file)
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: kmrcl-*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10-*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,9 +7,7 @@
 ;;;; 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
@@ -41,22 +39,22 @@ on example from AMOP"))
 ;; 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))
index 0e98ad2..1f2b2f6 100644 (file)
@@ -7,8 +7,6 @@
 ;;;; 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
index e303607..0021022 100644 (file)
@@ -1,4 +1,4 @@
-;;; -*- Syntax: Ansi-Common-Lisp; Base: 10; Mode: lisp; Package: kmrcl -*-
+;;; -*- Syntax: Ansi-Common-Lisp; Base: 10; Mode: lisp -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,8 +7,6 @@
 ;;;; 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
@@ -21,7 +19,7 @@
 
 (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)
index 52d5b46..aa3caae 100644 (file)
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: kmrcl -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,8 +7,6 @@
 ;;;; 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
index 75feac4..acd7723 100644 (file)
@@ -7,8 +7,6 @@
 ;;;; 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.
 ;;;;
index 30c815c..0e587ce 100644 (file)
@@ -7,8 +7,6 @@
 ;;;; 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
index 2b063b9..d58ff29 100644 (file)
@@ -7,8 +7,6 @@
 ;;;; 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
index 9b4f6ed..e9b3074 100644 (file)
@@ -7,8 +7,6 @@
 ;;;; 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
index 762d27f..7135eb0 100644 (file)
--- a/impl.lisp
+++ b/impl.lisp
@@ -7,8 +7,6 @@
 ;;;; 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
diff --git a/io.lisp b/io.lisp
index 851c371..7f06bd9 100644 (file)
--- a/io.lisp
+++ b/io.lisp
@@ -7,8 +7,6 @@
 ;;;; 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)
index 153bf6f..da12a61 100644 (file)
--- a/kmrcl.asd
+++ b/kmrcl.asd
@@ -7,8 +7,6 @@
 ;;;; 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
@@ -59,6 +57,7 @@
      (: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))))
index 6c511cf..042d57f 100644 (file)
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,8 +7,6 @@
 ;;;; 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
index a2ae23f..ecdd003 100644 (file)
@@ -7,8 +7,6 @@
 ;;;; 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
index eb2cef0..cc39ad4 100644 (file)
@@ -7,8 +7,6 @@
 ;;;; 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
index 327de3f..badf329 100644 (file)
--- a/math.lisp
+++ b/math.lisp
@@ -7,8 +7,6 @@
 ;;;; 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
index f6bd037..f8aba54 100644 (file)
--- a/mop.lisp
+++ b/mop.lisp
@@ -7,9 +7,7 @@
 ;;;; 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
diff --git a/os.lisp b/os.lisp
index 9714f5f..feeefc8 100644 (file)
--- a/os.lisp
+++ b/os.lisp
@@ -7,8 +7,6 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Jul 2003
 ;;;;
-;;;; $Id$
-;;;;
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
index 14ca9d6..c8fa236 100644 (file)
@@ -7,9 +7,7 @@
 ;;;; 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
    ))
index b598639..7017ce7 100644 (file)
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -6,8 +6,6 @@
 ;;;; Purpose:       Multiprocessing functions
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  June 2003
-;;;;
-;;;; $Id$
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
index 756cc5f..bc9ca75 100644 (file)
@@ -7,8 +7,6 @@
 ;;;; 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
index 6848b47..5729a57 100644 (file)
--- a/repl.lisp
+++ b/repl.lisp
@@ -7,8 +7,6 @@
 ;;;; 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
index 4cc4659..8ef7467 100644 (file)
--- a/seqs.lisp
+++ b/seqs.lisp
@@ -7,8 +7,6 @@
 ;;;; 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
@@ -16,7 +14,7 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
-(in-package :kmrcl)
+(in-package #:kmrcl)
 
 
 (defun nsubseq (sequence start &optional end)
index 40e144b..cd40a60 100644 (file)
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
index c8c9b58..a75d77d 100644 (file)
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -6,8 +6,6 @@
 ;;;; Purpose:       Socket functions
 ;;;; Programmer:    Kevin M. Rosenberg with excerpts from portableaserve
 ;;;; Date Started:  Jun 2003
-;;;;
-;;;; $Id$
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
index 9a9f42d..4dcda49 100644 (file)
@@ -7,8 +7,6 @@
 ;;;; 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
index e48e230..38a52fe 100644 (file)
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; package: kmrcl -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,8 +7,6 @@
 ;;;; 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
index 0b0daa2..fb6f977 100644 (file)
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: kmrcl-tests -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,9 +7,7 @@
 ;;;; 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
index ecd8565..d22e7b9 100644 (file)
@@ -7,8 +7,6 @@
 ;;;; 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
index 860d675..a3305ca 100644 (file)
@@ -7,8 +7,6 @@
 ;;;; 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