profiling

(in-package "ACL2")

(defttag :profiling)

(set-state-ok t)

(defconst *profiling-dir* "advice-profiler/")

(defun with-profiling-ccl-dir-warning
  (state)
  (declare (xargs :mode :program))
  (warning$ 'with-profiling
    nil
    "The CCL profiling routines used by books/misc/profiling.lisp ~
             depend on a directory ~s0, which should exist under the CCL ~
             contrib/huebner/ subdirectory (for earlier CCL versions) or ~
             tools/ subdirectory (for later CCL versions).  There is no ~s0 ~
             directory under either contrib/huebner/ or tools/, as can happen ~
             for earlier github distributions of CCL; it should exist under ~
             tools/ after you update your CCL github distribution."
    *profiling-dir*))

(defun with-profiling-ccl-dir-lst
  (state)
  (declare (xargs :mode :program))
  (cond ((not (eq (f-get-global 'host-lisp state) :ccl)) (er soft
        'with-profiling
        "Function ~x0 should only be called when the host Lisp is CCL. ~
         Something is amiss!"
        'with-profiling-ccl-dir))
    (t (mv-let (erp ccl-dir state)
        (getenv$ "CCL_DEFAULT_DIRECTORY" state)
        (declare (ignore erp))
        (assert$ ccl-dir
          (value (list (concatenate 'string
                ccl-dir
                "/contrib/huebner/"
                *profiling-dir*)
              (concatenate 'string ccl-dir "/tools/" *profiling-dir*))))))))

(progn! (set-raw-mode t)
  (cond ((and (eq (f-get-global 'host-lisp state) :ccl)
       (not (eq (os (w state)) :mswindows))) (mv-let (erp prof-dir-lst state)
        (with-profiling-ccl-dir-lst state)
        (declare (ignore erp))
        (let ((prof-dir (cond ((our-probe-file (nth 0 prof-dir-lst)) (nth 0 prof-dir-lst))
               ((our-probe-file (nth 1 prof-dir-lst)) (nth 1 prof-dir-lst)))))
          (cond (prof-dir (prog2$ (let ((*readtable* *host-readtable*))
                  (load (concatenate 'string prof-dir "package.lisp"))
                  (load (concatenate 'string prof-dir "profiler.lisp"))
                  (load (concatenate 'string (cbd) "profiling-raw.lsp")))
                (value nil)))
            (t (with-profiling-ccl-dir-warning state)
              (eval `(defmacro with-profiling-raw
                  (syms form)
                  (declare (ignore syms form))
                  '(progn (with-profiling-ccl-dir-warning *the-live-state*)
                    (error "Profiling directory does not exist (see warning ~
                             above).~%"))))
              (eval '(defmacro with-sprofiling-internal-raw
                  (options form)
                  (declare (ignore options form))
                  (error "The macro ~s does not do any profiling in CCL."
                    'with-sprofiling))))))))
    (t (load (concatenate 'string (cbd) "profiling-raw.lsp")))))

(defmacro-last with-profiling)

(defmacro-last with-sprofiling-internal)

(defmacro with-sprofiling
  (form &rest options)
  (let ((options (or options '(:report :graph :loop nil))))
    `(with-sprofiling-internal ',OPTIONS ,FORM)))