diff --git a/collects/typed-racket/base-env/prims.rkt b/collects/typed-racket/base-env/prims.rkt index 1dc141a0d6..ac3d836dfa 100644 --- a/collects/typed-racket/base-env/prims.rkt +++ b/collects/typed-racket/base-env/prims.rkt @@ -1194,3 +1194,20 @@ This file defines two sorts of primitives. All of them are provided into any mod (define-syntax-rule (for*/flvector: e ...) (base-for/flvector: for*: e ...)) + + +(provide optimization-coach-profile) +(require profile/sampler profile/analyzer profile/render-text) +(require racket/serialize) +(define-syntax (optimization-coach-profile stx) + (syntax-parse stx + [(_ body ...) + (ignore + #`(let ([sampler (create-sampler (current-thread) 0.005)]) + body ... + (sampler 'stop) + (define samples (sampler 'get-snapshots)) + (render (analyze-samples samples)) + (with-output-to-file #,(string-append (path->string (syntax-source stx)) ".profile") + #:exists 'replace + (lambda () (write (serialize samples))))))])) diff --git a/collects/typed-racket/optimizer/tool/profiling.rkt b/collects/typed-racket/optimizer/tool/profiling.rkt index af574bddbe..1128f06527 100644 --- a/collects/typed-racket/optimizer/tool/profiling.rkt +++ b/collects/typed-racket/optimizer/tool/profiling.rkt @@ -1,13 +1,15 @@ #lang racket/base -(require profile/analyzer racket/gui/base) +(require profile/analyzer profile/sampler racket/class racket/serialize) (require "sandbox.rkt") -(provide generate-profile +(provide generate-profile prune-profile node-source node-line node-col node-pos node-span - prune-profile - (all-from-out profile/analyzer)) + ;; from profile/analyzer + (struct-out profile) + (struct-out node) + (struct-out edge)) (define ((mk accessor) node) (define src (node-src node)) @@ -18,25 +20,20 @@ (define node-pos (mk srcloc-position)) (define node-span (mk srcloc-span)) -(define compiled-module-name 'optimization-coach-compiled-module) +;; For best results, run `optimization-coach-profile' (provided from TR/prims) +;; from inside DrRacket (with errortrace on, IIRC) +;; Other things I've tried that didn't work as well: +;; - `optimization-coach-profile' from command line (TODO was it with errortrace?) +;; - profiling executable generated by the instrumentation phase inside an +;; OC sandbox (in version control history, plus an attempt with +;; `dynamic-require' that was not committed) (define (generate-profile this source) - (define res-mpi (make-resolved-module-path compiled-module-name)) (define snapshots - (run-inside-optimization-coach-sandbox - this - (lambda () - (parameterize ([current-module-declare-name res-mpi]) - (eval (let ([input (open-input-text-editor source)]) - (port-count-lines! input) - (read-syntax res-mpi input))) - ;; Require, to run the body, without actually adding anything to the - ;; current namespace, in case the module calls `eval'. - (eval '(require profile/sampler)) - (eval `(let ([sampler (create-sampler (current-thread) 0.05)]) - (dynamic-require '',compiled-module-name #f) - (sampler 'stop) - (sampler 'get-snapshots))))))) + (with-input-from-file + (string-append (path->string (send source get-port-name)) ".profile") + (lambda () + (deserialize (read))))) ;; We can't prune what's outside the file yet. We need the entire profile ;; to identify hot functions, and to get meaningful caller-callee stats. (analyze-samples snapshots))