From 251043d4c96c996a35cd48c4452b03fbef2ea21a Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 18 Apr 2010 10:10:34 -0600 Subject: [PATCH] Version 1.102 (other changes not in last commit) * 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. --- ChangeLog | 15 +++++++++- attrib-class.lisp | 16 +++++------ buff-input.lisp | 2 -- byte-stream.lisp | 6 ++-- color.lisp | 4 +-- console.lisp | 2 -- datetime.lisp | 2 -- equal.lisp | 2 -- functions.lisp | 2 -- impl.lisp | 2 -- io.lisp | 71 +++++++++++++++++++++++++++++++++++++++++++++-- kmrcl.asd | 3 +- listener.lisp | 4 +-- lists.lisp | 2 -- macros.lisp | 2 -- math.lisp | 2 -- mop.lisp | 50 ++++++++++++++++----------------- os.lisp | 2 -- package.lisp | 24 ++++++++++++++-- processes.lisp | 4 +-- random.lisp | 2 -- repl.lisp | 2 -- seqs.lisp | 4 +-- signals.lisp | 2 +- sockets.lisp | 4 +-- strings.lisp | 2 -- strmatch.lisp | 4 +-- tests.lisp | 54 +++++++++++++++++++++++++++++++---- web-utils.lisp | 2 -- xml-utils.lisp | 2 -- 30 files changed, 194 insertions(+), 101 deletions(-) diff --git a/ChangeLog b/ChangeLog index 773f4cd..5426a9b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,4 +1,17 @@ -22 Apr 2010 Kevin Rosenberg +17 Apr 2010 Kevin Rosenberg + * 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 + * Version 1.101 * lists.lisp: Reduce memory use by FLATTEN 20 Aug 2009 Kevin Rosenberg diff --git a/attrib-class.lisp b/attrib-class.lisp index b102eca..453da1b 100644 --- a/attrib-class.lisp +++ b/attrib-class.lisp @@ -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)) diff --git a/buff-input.lisp b/buff-input.lisp index 0e98ad2..1f2b2f6 100644 --- a/buff-input.lisp +++ b/buff-input.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 diff --git a/byte-stream.lisp b/byte-stream.lisp index e303607..0021022 100644 --- a/byte-stream.lisp +++ b/byte-stream.lisp @@ -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) diff --git a/color.lisp b/color.lisp index 52d5b46..aa3caae 100644 --- a/color.lisp +++ b/color.lisp @@ -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 diff --git a/console.lisp b/console.lisp index 75feac4..acd7723 100644 --- a/console.lisp +++ b/console.lisp @@ -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. ;;;; diff --git a/datetime.lisp b/datetime.lisp index 30c815c..0e587ce 100644 --- a/datetime.lisp +++ b/datetime.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 diff --git a/equal.lisp b/equal.lisp index 2b063b9..d58ff29 100644 --- a/equal.lisp +++ b/equal.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 diff --git a/functions.lisp b/functions.lisp index 9b4f6ed..e9b3074 100644 --- a/functions.lisp +++ b/functions.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 diff --git a/impl.lisp b/impl.lisp index 762d27f..7135eb0 100644 --- 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 --- 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 @@ -327,3 +325,72 @@ ((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-{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) diff --git a/kmrcl.asd b/kmrcl.asd index 153bf6f..da12a61 100644 --- 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)))) diff --git a/listener.lisp b/listener.lisp index 6c511cf..042d57f 100644 --- a/listener.lisp +++ b/listener.lisp @@ -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 diff --git a/lists.lisp b/lists.lisp index a2ae23f..ecdd003 100644 --- a/lists.lisp +++ b/lists.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 diff --git a/macros.lisp b/macros.lisp index eb2cef0..cc39ad4 100644 --- a/macros.lisp +++ b/macros.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 diff --git a/math.lisp b/math.lisp index 327de3f..badf329 100644 --- 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 diff --git a/mop.lisp b/mop.lisp index f6bd037..f8aba54 100644 --- 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 @@ -24,27 +22,27 @@ #+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 ) ) @@ -88,10 +86,10 @@ #+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 @@ -132,7 +130,7 @@ 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 @@ -164,24 +162,24 @@ #+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 --- a/os.lisp +++ b/os.lisp @@ -7,8 +7,6 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Jul 2003 ;;;; -;;;; $Id$ -;;;; ;;;; ************************************************************************* (in-package #:kmrcl) diff --git a/package.lisp b/package.lisp index 14ca9d6..c8fa236 100644 --- a/package.lisp +++ b/package.lisp @@ -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 @@ -114,6 +112,15 @@ #:+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 @@ -319,4 +326,15 @@ ;; 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 )) diff --git a/processes.lisp b/processes.lisp index b598639..7017ce7 100644 --- a/processes.lisp +++ b/processes.lisp @@ -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) diff --git a/random.lisp b/random.lisp index 756cc5f..bc9ca75 100644 --- a/random.lisp +++ b/random.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 diff --git a/repl.lisp b/repl.lisp index 6848b47..5729a57 100644 --- 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 diff --git a/seqs.lisp b/seqs.lisp index 4cc4659..8ef7467 100644 --- 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) diff --git a/signals.lisp b/signals.lisp index 40e144b..cd40a60 100644 --- a/signals.lisp +++ b/signals.lisp @@ -1,4 +1,4 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*- +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; diff --git a/sockets.lisp b/sockets.lisp index c8c9b58..a75d77d 100644 --- a/sockets.lisp +++ b/sockets.lisp @@ -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) diff --git a/strings.lisp b/strings.lisp index 9a9f42d..4dcda49 100644 --- a/strings.lisp +++ b/strings.lisp @@ -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 diff --git a/strmatch.lisp b/strmatch.lisp index e48e230..38a52fe 100644 --- a/strmatch.lisp +++ b/strmatch.lisp @@ -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 diff --git a/tests.lisp b/tests.lisp index 0b0daa2..fb6f977 100644 --- a/tests.lisp +++ b/tests.lisp @@ -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 ;;;; ;;;; ************************************************************************* @@ -438,7 +436,53 @@ (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 diff --git a/web-utils.lisp b/web-utils.lisp index ecd8565..d22e7b9 100644 --- a/web-utils.lisp +++ b/web-utils.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 diff --git a/xml-utils.lisp b/xml-utils.lisp index 860d675..a3305ca 100644 --- a/xml-utils.lisp +++ b/xml-utils.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 -- 2.34.1