[climacs-cvs] CVS update: climacs/gui.lisp climacs/buffer-test.lisp
Aleksandar Bakic
abakic at common-lisp.net
Thu Jan 20 01:22:21 UTC 2005
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
More information about the Climacs-cvs
mailing list