[climacs-cvs] CVS update: climacs/gui.lisp climacs/buffer-test.lisp

[Aleksandar Bakic]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv29136

Modified Files:
	gui.lisp buffer-test.lisp 
Log Message:
A note/comment about macro use and a few buffer performance tests.

Date: Wed Jan 19 17:22:20 2005
Author: abakic

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.86 climacs/gui.lisp:1.87
--- climacs/gui.lisp:1.86	Wed Jan 19 12:04:39 2005
+++ climacs/gui.lisp	Wed Jan 19 17:22:19 2005
@@ -85,7 +85,7 @@
 	 int)))
   (:top-level (climacs-top-level)))
 
-(defmacro current-window ()
+(defmacro current-window () ; shouldn't this be an inlined function? --amb
   `(car (windows *application-frame*)))
 
 (defmethod redisplay-frame-panes :around ((frame climacs) &rest args)
@@ -284,9 +284,8 @@
   (frame-exit *application-frame*))
 
 (define-named-command com-toggle-overwrite-mode ()
-  (let ((win (current-window)))
-    (setf (slot-value win 'overwrite-mode)
-	  (not (slot-value win 'overwrite-mode)))))
+  (with-slots (overwrite-mode) (current-window)
+    (setf overwrite-mode (not overwrite-mode))))
 
 (defun insert-character (char)
   (let* ((win (current-window))


Index: climacs/buffer-test.lisp
diff -u climacs/buffer-test.lisp:1.6 climacs/buffer-test.lisp:1.7
--- climacs/buffer-test.lisp:1.6	Tue Jan 18 10:59:51 2005
+++ climacs/buffer-test.lisp	Wed Jan 19 17:22:19 2005
@@ -692,4 +692,118 @@
     (error (c)
       (declare (ignore c))
       'caught))
-  caught)
\ No newline at end of file
+  caught)
+
+
+;;;; performance tests
+
+(defmacro deftimetest (name form &rest results)
+  `(deftest ,name
+     (time
+      (progn
+	(format t "~&; Performance test ~a" ',name)
+	,form))
+     , at results))
+
+(deftimetest standard-buffer-performance.test-1
+  (loop with b = (make-instance 'standard-buffer)
+     for i from 0 below 100000
+     do (insert-buffer-object b 0 #\a)
+     finally (return (size b)))
+  100000)
+
+(deftimetest standard-buffer-performance.test-1a
+  (let ((b (loop with b = (make-instance 'standard-buffer)
+	      for i from 0 below 100000
+	      do (insert-buffer-object b 0 #\a)
+	      finally (return b))))
+    (loop for i from 0 below 100000
+       do (delete-buffer-range b 0 1)
+       finally (return (size b))))
+  0)
+
+(deftimetest standard-buffer-performance.test-1b
+  (loop with b = (make-instance 'standard-buffer)
+     for i from 0 below 100000
+     do (insert-buffer-object b (size b) #\a)
+     finally (return (size b)))
+  100000)
+
+(deftimetest standard-buffer-performance.test-1ba
+  (let ((b (loop with b = (make-instance 'standard-buffer)
+	      for i from 0 below 100000
+	      do (insert-buffer-object b (size b) #\a)
+	      finally (return b))))
+    (loop for i from 0 below 100000
+       do (delete-buffer-range b 0 1)
+       finally (return (size b))))
+  0)
+
+(deftimetest standard-buffer-performance.test-1c
+  (loop with b = (make-instance 'standard-buffer)
+     for i from 0 below 100000
+     do (insert-buffer-object b (floor (size b) 2) #\a)
+     finally (return (size b)))
+  100000)
+
+(deftimetest standard-buffer-performance.test-1ca
+  (let ((b (loop with b = (make-instance 'standard-buffer)
+	      for i from 0 below 100000
+	      do (insert-buffer-object b (floor (size b) 2) #\a)
+	      finally (return b))))
+    (loop for i from 0 below 100000
+       do (delete-buffer-range b 0 1)
+       finally (return (size b))))
+  0)
+
+(deftimetest standard-buffer-performance.test-1cb
+  (let ((b (loop with b = (make-instance 'standard-buffer)
+	      for i from 0 below 100000
+	      do (insert-buffer-object b (floor (size b) 2) #\a)
+	      finally (return b))))
+    (loop for i from 0 below 100000
+       do (delete-buffer-range b (floor (size b) 2) 1)
+       finally (return (size b))))
+  0)
+
+(deftimetest standard-buffer-performance.test-2
+  (loop with b = (make-instance 'standard-buffer)
+     for i from 0 below 100000
+     do (insert-buffer-sequence b 0 "a")
+     finally (return (size b)))
+  100000)
+
+(deftimetest standard-buffer-performance.test-2b
+  (loop with b = (make-instance 'standard-buffer)
+     for i from 0 below 100000
+     do (insert-buffer-sequence b (size b) "a")
+     finally (return (size b)))
+  100000)
+
+(deftimetest standard-buffer-performance.test-2c
+  (loop with b = (make-instance 'standard-buffer)
+     for i from 0 below 100000
+     do (insert-buffer-sequence b (floor (size b) 2) "a")
+     finally (return (size b)))
+  100000)
+
+(deftimetest standard-buffer-performance.test-3
+  (loop with b = (make-instance 'standard-buffer)
+     for i from 0 below 100000
+     do (insert-buffer-sequence b 0 "abcdefghij")
+     finally (return (size b)))
+  1000000)
+
+(deftimetest standard-buffer-performance.test-3b
+  (loop with b = (make-instance 'standard-buffer)
+     for i from 0 below 100000
+     do (insert-buffer-sequence b (size b) "abcdefghij")
+     finally (return (size b)))
+  1000000)
+
+(deftimetest standard-buffer-performance.test-3c
+  (loop with b = (make-instance 'standard-buffer)
+     for i from 0 below 100000
+     do (insert-buffer-sequence b (floor (size b) 2) "abcdefghij")
+     finally (return (size b)))
+  1000000)
\ No newline at end of file