# HG changeset patch # User Steve Losh # Date 1472076828 0 # Node ID 16b422487296e7e401a42902641bb305712667ec # Parent 1c134f25b12a070ec195e4eb46d413406bb737c2 Add profiling to the GDL benchmark diff -r 1c134f25b12a -r 16b422487296 contrib/gdl-benchmark/run-temperance.ros --- a/contrib/gdl-benchmark/run-temperance.ros Wed Aug 24 20:43:10 2016 +0000 +++ b/contrib/gdl-benchmark/run-temperance.ros Wed Aug 24 22:13:48 2016 +0000 @@ -9,6 +9,7 @@ (ql:quickload :unix-opts :silent t) (ql:quickload :split-sequence :silent t) (ql:quickload :losh :silent t) +#+sbcl (require :sb-sprof) (defmacro shut-up (&body body) `(let ((*standard-output* (make-broadcast-stream)) @@ -39,6 +40,44 @@ (in-package #:temperance.contrib.gdl-benchmark) +;;;; Config ------------------------------------------------------------------- +(defparameter *verbose* nil) +(defparameter *profile* nil) + + +;;;; Profiling ---------------------------------------------------------------- +#+sbcl +(defmacro with-profiling (&body body) + ; (declare (optimize (speed 1) (debug 1) (safety 1))) + `(progn + (sb-ext:gc :full t) + (require :sb-sprof) + ; (sb-sprof::profile-call-counts "TEMPERANCE.WAM") + ; (sb-sprof::profile-call-counts "TEMPERANCE.CIRCLE") + ; (sb-sprof::profile-call-counts "TEMPERANCE.CONTRIB.GDL-BENCHMARK") + (sb-sprof::with-profiling (:max-samples 50000 + :reset t + ; :mode :alloc + :mode :cpu + :sample-interval 0.006 + :alloc-interval 1) + ,@body) + (with-open-file (*standard-output* "gdl.prof" + :direction :output + :if-exists :supersede) + (sb-sprof:report :type :graph + :sort-by :cumulative-samples + :sort-order :ascending) + (sb-sprof:report :type :flat + :min-percent 0.5)) + nil)) + + +#-sbcl +(defmacro with-profiling (&body body) + `(progn ,@body nil)) + + ;;;; Benchmarking ------------------------------------------------------------- (defun read-file (path) (with-open-file (file path :direction :input) @@ -203,36 +242,6 @@ :finally (format t "#simulations: ~D~%" simulation-count))) -; def minimax(state, depth): -; global nb_legals, nb_updates -; if checkTimeout(): return False - -; # check for termination condition -; if state.isTerminal(): -; if checkTimeout(): return False -; # compute goal values -; evalgoals(state) -; return True -; if depth <= 0: -; return False - -; isTerminal = True - -; # compute all possible joint moves (combinations of legal moves of all players) -; moves = state.getMoves() -; nb_legals+=1 -; if checkTimeout(): return False - -; # for each joint move -; for move in moves: -; # go to the successor state -; successor = state.getSuccessor(move) -; nb_updates+=1 -; # search the successor state (recursively) -; isTerminal = minimax(successor, depth-1) and isTerminal # order matters here -; if checkTimeout(): return False -; return isTerminal - (defun minimax (state depth) ;; I know this is horrible, but I wanted to do as straight a port of the other ;; benchmarks as possible to minimize differences between benchmarks. @@ -337,12 +346,16 @@ (defun run (modes limit gdl-file trace-file) (build-database (read-gdl gdl-file)) - (dolist (mode modes) - (run-trace (build-traces (read-trace trace-file)) - (ecase mode - (:mc (curry #'run-monte-carlo limit)) - (:dfs (curry #'run-dfs limit)) - (:fdfs (curry #'fixed-depth-dfs limit)))))) + (flet ((%run () + (dolist (mode modes) + (run-trace (build-traces (read-trace trace-file)) + (ecase mode + (:mc (curry #'run-monte-carlo limit)) + (:dfs (curry #'run-dfs limit)) + (:fdfs (curry #'fixed-depth-dfs limit))))))) + (if *profile* + (with-profiling (%run)) + (%run)))) ;;;; CLI ---------------------------------------------------------------------- @@ -362,6 +375,10 @@ :description "print this help text" :short #\h :long "help") + (:name :profile + :description "profile the run and dump the report to gdl.prof" + :short #\p + :long "profile") (:name :verbose :description "verbose output" :short #\v @@ -381,8 +398,6 @@ TRACE-FILE Path to the corresponding trace file.")) -(defparameter *verbose* nil) - (defun usage () (let ((prog (program-name))) @@ -418,7 +433,8 @@ (multiple-value-bind (options arguments) (opts:get-opts argv) - (setf *verbose* (getf options :verbose)) + (setf *verbose* (getf options :verbose) + *profile* (getf options :profile)) (when (getf options :help) (usage)