X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=genutils.lisp;h=cee438bcbf53ff4f5235015a45455aedf8efbc5d;hb=035a2dea74b2c740b073b5f0f86e62489fbb7478;hp=4565089ddd7f66baba8742dfacddf828e2046531;hpb=c0fe2c8fed48e08ef1ebb324f50d13db0d6d5042;p=kmrcl.git

diff --git a/genutils.lisp b/genutils.lisp
index 4565089..cee438b 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.15 2003/02/07 14:21:55 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -510,3 +510,50 @@
 		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))))))))
+
+
+(defun nsubseq (sequence start &optional (end (length sequence)))
+  (make-array (- end start)
+	      :element-type (array-element-type sequence)
+	      :displaced-to sequence
+	      :displaced-index-offset start))