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)) + ,@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