; -*-Lisp-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; viewbench ; ; Description: Simple 3D benchmark for OSDM ; Author: Claus Brod ; Language: Lisp ; ; (C) Copyright 1997-2006 CoCreate Software GmbH & Co KG, all rights reserved. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO list Prio ;; ======================================== ;; Replace calls to undocumented H ;; functionality with official ;; IKIT calls ;; ;; Improve formatting of output L ;; ;; Streamline, then document ;; load-and-test L ;; ;; Integrate other test methods ;; (dyn_exam.rec, zoomcounter.rec, ;; pancounter.rec) L ;; ;; Improve error handling when ;; testsets or models cannot be found M ;; (in-package :viewbench) (use-package '(:frame2 :oli)) (export 'load-and-test) (export 'subscribe-viewbench-event) (export 'unsubscribe-viewbench-event) ;;------------------------------------------- Global constants and variables ;; Version of benchmark (defvar *viewbench-version* (format nil "2.~A" (parse-integer (second (sd-string-split "$Revision: #32 $" "#")) :junk-allowed t))) (defparameter *viewbench-loadpath* (directory-namestring (parse-namestring *load-truename*))) ;;------------------------------------------- Reporting (let ((resultsfile (format nil "~Aviewbench_results_~A.html" (sd-inq-temp-dir) (machine-instance))) (conffile (format nil "~Aviewbench_conf_~A.log" (sd-inq-temp-dir) (machine-instance)))) (defun set-results-file(filename) (setf resultsfile filename)) (defun show-results-file() (sd-display-url (format nil "file:///~A" resultsfile))) (defun open-logstream() (open resultsfile :direction :output :if-exists :append :if-does-not-exist :create)) ;; Print message both to stdout and to results file ;; Opens the logfile for each message, to avoid having to ;; keep the file open for extended periods of time. (defmacro print-msg(msg &rest r) (if r `(let ((logstream (open-logstream))) (format t ,msg ,@r) (format logstream ,msg ,@r) (close logstream)) `(let ((logstream (open-logstream))) (format t ,msg) (format logstream ,msg) (close logstream)))) (defun write-conffile() (unless (sd-sys-getenv "SDREGRESSIONTEST") (sd-with-current-working-directory (sd-inq-temp-dir) (when (sd-inq-file-status conffile :existence) (delete-file conffile)) (system (format nil "~A\\Microsoft Shared\\MSINFO\\msinfo32" (sd-sys-getenv "COMMONPROGRAMFILES")) "/categories" "+SystemSummary+ComponentsDisplay+SWEnvDrivers+SWEnvEnvVars" "/report" (sd-convert-filename-to-platform conffile)) ))) (defun open-logfiles (&key (versioninfo nil)) (when (sd-inq-file-status resultsfile :existence) (delete-file resultsfile)) ;; Print header (print-msg "~%") (print-msg "~%") (print-msg "Viewbench - quick'n'dirty OSDM graphics performance test~%") (print-msg "~%~%") (print-msg "~%") (print-msg "

Viewbench ~A - quick'n'dirty OSDM graphics performance test

~%" *viewbench-version*) ;; Configuration data (print-msg "~%~%") (print-msg "~%

Config data in ~A, ~%" conffile conffile) (print-msg "test results in ~A.

~%~%" resultsfile) (write-conffile) ;; write full system configuration data ) ;; Write trailer, clean up open files etc. (defun close-logfiles () (print-msg "~%") (print-msg "~%")) ) ;; let ;;------------------------------------------- Test setup ;; reset view direction and settings (defun reset-view (vport wpflag) (when (sd-inq-curr-wp) (set_vp_direction_normal_to_wp vport :current)) (set_show vport :workplanes (if wpflag :on :off)) (fit_vp vport) (update_screen)) (defun create-default-vport() (delete_vp :all) (create_vp :name "vport1" :default_appearance) (sd-maximize-vp "vport1")) (defun prepare-test() (uic_reset_session :yes) (sd-hide-toolbox) (display :hide) ;; HACK: Resize app window to standard size (uib::change_wid_property_f uib::*app-shell* :x 0 :y 0 :width 1278 :height 996) ;; HACK: Switch off browser tab (f2::win-hide-browserbar) ;; In both cases above, we're using undocumented and unsupported ;; functions which may (and will) change without prior notice. ;; create standard viewport (create-default-vport) (delete_3d :all_at_top) (create_workplane :new :owner "/" :name "w1") (undo :max_back 1) ;; switch off smooth camera movements (set_smooth_camera_update_mode :off)) (defun load-and-prepare (package wpflag displistflag) (let (mem_before) (reset-view "vport1" wpflag) (setf mem_before (f2::memory-malloced)) (load_package package) (display :hide) (update_screen) (set_displaylist_mode (if displistflag :on :off)) ;; search and load optional recorder file with the same name. (let ((recfile (sd-string-replace package ".pkg" ".rec"))) (when (probe-file recfile) (load recfile))) mem_before)) ;;------------------------------------------- Event handling (let ((viewbench-event (sd-create-event "viewbench-event"))) (defun subscribe-viewbench-event(fn) (sd-subscribe-event "viewbench-event" fn)) (defun unsubscribe-viewbench-event(fn) (sd-unsubscribe-event "viewbench-event" fn)) (defun process-viewbench-event(&rest args) (apply #'sd-process-event "viewbench-event" args)) ) ;;------------------------------------------- Test execution ;; Keep track of (inverted) frame rate results (let ((accumulated-ms-per-frame 0.0)) (defun reset-ms-per-frame() (setf accumulated-ms-per-frame 0.0)) (defun inq-accumulated-ms-per-frame() accumulated-ms-per-frame) (defun add-ms-per-frame(ms-per-frame) (incf accumulated-ms-per-frame ms-per-frame)) ) (trace viewbench::reset-ms-per-frame) (trace viewbench::inq-accumulated-ms-per-frame) (trace viewbench::add-ms-per-frame) (defun start-dynamic(vport) ;; HACK: prim-vp-dynamic is an undocumented function. It may ;; and will change without prior notice. (prim-vp-dynamic vport)) (defun stop-dynamic() ;; HACK: prim-vp-dynamic-end is an undocumented function. ;; It may and will change without prior notice. (prim-vp-dynamic-end 0)) (defun static-test() (let* ((starttime (get-universal-time)) (endtime (+ 15 starttime)) frames) (setf frames (do ((framecnt 0 (+ framecnt 8))) ((> (get-universal-time) endtime) framecnt) (dotimes (i 8) (sd-redraw-vp "vport1")) )) (/ (+ frames 0.0) (- (get-universal-time) starttime)))) (defun framecounter-test() (let* ((starttime (get-universal-time)) (endtime (+ 15 starttime)) frames) (start-dynamic "vport1") (setf frames (do ((framecnt 0 (+ framecnt 32))) ((> (get-universal-time) endtime) framecnt) (dotimes (i 32) (KB :K4 0.015 :k5 -.037 :k6 .01) ))) (stop-dynamic) (/ (+ frames 0.0) (- (get-universal-time) starttime)))) (defun load-and-test (package dispmode framecntflag &key (wpflag t) (statictest nil) (displistflag nil)) "Load a package file and run the recorder file on it. package: Name of package file dispmode: String to display in test result framecntflag: If t, an automatic framecounter test is run wpflag: Show/Don't show workplanes statictest: If t, perform static redraw test displistflag: If t, run test with display lists enabled " (let ((mem_after) (mem_before) (before) (after)) (gbc) (setf before (get-universal-time)) (setf mem_before (load-and-prepare package wpflag displistflag)) (setf after (get-universal-time)) (gbc) (setf mem_after (f2::memory-malloced)) (reset-view "vport1" wpflag) (print-msg "~%

Test case: ~A / ~A

~%" package dispmode) (print-msg "

Loading data: ~A seconds, ~A bytes

~%" (- after before) (- mem_after mem_before)) (when framecntflag (gbc) (let ((fps (framecounter-test))) (print-msg "

Framecounter test: ~6,2F frames/second (~6,2F ms/frame)

~%" fps (/ 1000.0 fps)) (add-ms-per-frame (/ 1000.0 fps)) (process-viewbench-event package "dynamic-redraw" dispmode (- mem_after mem_before) fps))) (when statictest (reset-view "vport1" wpflag) (gbc) (let ((fps (static-test))) (print-msg "

Static redraw test: ~6,2F frames/second (~6,2F ms/frame)

~%" fps (/ 1000.0 fps)) (add-ms-per-frame (/ 1000.0 fps)) (process-viewbench-event package "static-redraw" dispmode (- mem_after mem_before) fps))) ) ) (defun viewbench (versioninfo directories resultsfilename) (when resultsfilename (set-results-file resultsfilename)) (create-default-vport) (open-logfiles :versioninfo versioninfo) (reset-ms-per-frame) (dolist (dir directories) (print-msg "

Testset ~S

~%~%" dir) (set_dynamic_redraw_mode :default) (sd-with-current-working-directory dir ;; enumerate and load *.lsp files in testset directory (dolist (testcase (directory "*.lsp")) (prepare-test) (load testcase) ;; calls load-and-test ))) (set_dynamic_redraw_mode :default) (print-msg "~%
~%") (print-msg "

Viewbench result

~%") (print-msg "

Overall test result: ~6,2F milliseconds/frame

~%" (inq-accumulated-ms-per-frame)) (close-logfiles) (show-results-file)) ;;------------------------------------------- Main test function (defun mei::viewbench(&key (versioninfo nil) (directories (list "models")) resultsfilename) "Performs simple 3D graphics benchmark Keywords: :directories [('models')] - list of testcase directories :resultsfilename [nil] - specify name of logfile :versioninfo [nil] - string written to logfile " (viewbench::viewbench versioninfo directories resultsfilename)) (unless (sd-sys-getenv "SDREGRESSIONTEST") (sd-display-url (format nil "file:///~A/Readme.html" (sd-get-current-working-directory))))