From 0785aaa6c33301cdb5d23ab1a09f262d33dba21d Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Mon, 13 Jan 2003 21:40:20 +0000
Subject: [PATCH] r3750: *** empty log message ***

---
 debian/changelog |  6 ++++++
 genutils.lisp    | 43 ++++++++++++++++++++++++++++++++++++++++++-
 package.lisp     | 12 +++++++++---
 strings.lisp     | 30 +++++++++++++++++++++++++++++-
 4 files changed, 86 insertions(+), 5 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index aa1caf1..5656ddd 100644
--- 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 4565089..cc7935a 100644
--- 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 0781ae5..78f264c 100644
--- 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 231ad69..d91d9ac 100644
--- 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))
+
-- 
2.34.1