(in-package :cl-smoke.benchmark)

(defun timing (function &rest arguments)
  (let ((timings))
    (apply #'sb-ext:call-with-timing
           #'(lambda (&rest args)
               (setf timings args))
           function
           arguments)
    (list :processor-cycles (getf timings :processor-cycles)
          :system-run-time-us (getf timings :system-run-time-us)
          :user-run-time-us (getf timings :user-run-time-us))))

(defun print-header (stream data)
  (dolist (d (alexandria:plist-alist (first data)))
    (format stream "~A " (first d)))
  (format stream "~%"))

(defun write-R-table (data file)
  (with-open-file (out file :direction :output)
    (print-header out data)
    (dolist (d data)
      (dolist (e (alexandria:plist-alist d))
        (format out "~S~T" (rest e)))
      (format out "~%"))))

(defun write-lisp-info (file)
  (write-R-table
   `((:type ,(lisp-implementation-type)
            :version ,(lisp-implementation-version)
            :arch ,(machine-type)
            :os ,(software-type)
            :os-version ,(software-version)
            :cl-smoke-version ,(format nil "~{~A~^.~}"
                                       (asdf:component-version (asdf:find-system :cl-smoke.smoke)))))
   file))

(defun benchmark (function iterations)
  (let ((data))
    (dotimes (n 3)
      (funcall function iterations)) ;; startup
    (dotimes (n 20 data)
      (tg:gc :full t)
      (push (nconc (list :iterations iterations)
                   (timing function iterations))
            data))))

(defun run-compare (name function cxx-function iterations multiplier)
  (format t "running ~A." name)
  (let ((data (prog1 (benchmark function iterations) (princ ".")))
        (cxx-data (prog1 (benchmark cxx-function (* multiplier iterations))
                    (princ ".")))
        (file (make-pathname :defaults name
                             :type "dat")))
    (write-R-table data file)
    (write-R-table cxx-data
                   (make-pathname :defaults file
                                  :name (concatenate 'string
                                                     "cxx-"
                                                     (pathname-name file)))))
  (terpri))

(defun run (&optional construct)
  (write-lisp-info "info.dat")
  (run-compare "signal-slot" #'signal-slot
               #'cl-smoke-benchmark-signal-slot 1000 1000)
  (run-compare "inline-call" #'inline-call
               #'cl-smoke-benchmark-byte-array-size 10000 3000)
  (run-compare "simple-call" #'simple-call
               #'cl-smoke-benchmark-simple-call 10000 3000)
  (run-compare "simple-call-compile-time" #'simple-call-compile-time
               #'cl-smoke-benchmark-simple-call 10000 1000)
  (when construct
    (with-benchmark-cxx-construct ((* 50 1000))
      (run-compare "construct" #'construct
                   #'cl-smoke-benchmark-construct 1000 50))))