r3750: *** empty log message ***

diff --git a/debian/changelog b/debian/changelog
index aa1caf1dc0f3c0049919f59b891d225e3f8c6880..5656ddd912846b70f6b8ff8d76015fa3a576f303 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-kmrcl (1.25-1) unstable; urgency=low
+
+  * strings.lisp: add new functions
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Sat, 28 Dec 2002 00:58:18 -0700
+
 cl-kmrcl (1.24-1) unstable; urgency=low
 
   * strings.lisp: fix typo error

diff --git a/genutils.lisp b/genutils.lisp
index 4565089ddd7f66baba8742dfacddf828e2046531..cc7935a0c21c6f84e7a4f86d293e39b66be0e688 100644 (file)
--- a/genutils.lisp
+++ b/genutils.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: genutils.lisp,v 1.13 2002/12/14 18:51:53 kevin Exp $
+;;;; $Id: genutils.lisp,v 1.14 2003/01/13 21:40:20 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -510,3 +510,44 @@
                year
                hr min sec))))
 
+
+;; Benchmarking
+
+(defun print-float-units (val unit)
+  (cond
+    ((< val 1d-6)
+     (format t "~,2,9F nano~A" val unit))
+    ((< val 1d-3)
+     (format t "~,2,6F micro~A" val unit))
+    ((< val 1)
+     (format t "~,2,3F milli~A" val unit))
+    ((> val 1d9)
+     (format t "~,2,-9F giga~A" val unit))
+    ((> val 1d6)
+     (format t "~,2,-6F mega~A" val unit))
+    ((> val 1d3)
+     (format t "~,2,-3F kilo~A" val unit))
+    (t
+     (format t "~,2F ~A" val unit))))
+
+(defun print-seconds (secs)
+  (print-float-units secs "sec"))
+
+(defmacro time-iterations (n &body body)
+  (let ((i (gensym))
+       (count (gensym)))
+    `(progn
+       (let ((,count ,n))
+        (format t "~&Test with ~d iterations: ~W" ,count (quote ,body))
+        (let ((t1 (get-internal-real-time)))
+          (dotimes (,i ,count)
+            ,@body)
+          (let* ((t2 (get-internal-real-time))
+                 (secs (coerce (/ (- t2 t1)
+                                  internal-time-units-per-second)
+                               'double-float)))
+            (format t "~&Total time: ")
+            (print-seconds secs)
+            (format t ", time per iteration: ")
+            (print-seconds (coerce (/ secs ,n) 'double-float))))))))
+

diff --git a/package.lisp b/package.lisp
index 0781ae5dc628d5ed43d32fef68dfc0913b391c19..78f264c7d9a2f3e4c76c6b837b982407f64b8489 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: package.lisp,v 1.18 2002/12/26 11:57:07 kevin Exp $
+;;;; $Id: package.lisp,v 1.19 2003/01/13 21:40:20 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -72,7 +72,10 @@
          #:in
          #:mean
          #:with-gensyms
-
+         #:time-iterations
+         #:print-float-units
+         #:print-seconds
+         
          ;; strings.lisp
          #:string-append
          #:count-string-words
@@ -86,7 +89,10 @@
          #:string-invert
          #:escape-xml-string
          #:string-replace-char-string
-
+         #:make-usb8-array
+         #:usb8-array-to-string
+         #:string-to-usb8-array
+         
          ;; symbols.lisp
          #:ensure-keyword
          #:concat-symbol

diff --git a/strings.lisp b/strings.lisp
index 231ad6923fc1788d0ccfc5378a03e232a6cdf404..d91d9ac9e1d92a7316d3455fca89c13fb47d7b8d 100644 (file)
--- a/strings.lisp
+++ b/strings.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: strings.lisp,v 1.5 2002/12/28 07:59:37 kevin Exp $
+;;;; $Id: strings.lisp,v 1.6 2003/01/13 21:40:20 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -197,3 +197,31 @@ list of characters and replacement strings."
            new-string)))))
 
     
+
+(defun make-usb8-array (len)
+  (make-array len :adjustable nil
+             :fill-pointer nil
+             :element-type '(unsigned-byte 8)))
+
+(defun usb8-array-to-string (vec)
+  (let* ((len (length vec))
+        (str (make-string len)))
+    (declare (fixnum len)
+            (simple-string str)
+            (optimize (speed 3)))
+    (dotimes (i len)
+      (declare (fixnum i))
+      (setf (schar str i) (code-char (aref vec i))))
+    str))
+
+(defun string-to-usb8-array (str)
+  (let* ((len (length str))
+        (vec (make-usb8-array len)))
+    (declare (fixnum len)
+            (type (array fixnum (*)) vec)
+            (optimize (speed 3)))
+    (dotimes (i len)
+      (declare (fixnum i))
+      (setf (aref vec i) (char-code (schar str i))))
+    vec))
+