From f6b60b2f9084003c5a30ac5ea68ed56c3ba24c67 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Fri, 31 Aug 2012 15:20:37 -0400 Subject: [PATCH] Propagate profile information to inlining analysis. --- collects/typed-racket/optimizer/tool/mzc.rkt | 16 +++++++++++---- .../typed-racket/optimizer/tool/profiling.rkt | 20 +++++++++++++------ .../typed-racket/optimizer/tool/report.rkt | 6 ++++-- collects/typed-racket/optimizer/tool/tool.rkt | 14 +++++++++---- 4 files changed, 40 insertions(+), 16 deletions(-) diff --git a/collects/typed-racket/optimizer/tool/mzc.rkt b/collects/typed-racket/optimizer/tool/mzc.rkt index ff364edebd..399ffcddc6 100644 --- a/collects/typed-racket/optimizer/tool/mzc.rkt +++ b/collects/typed-racket/optimizer/tool/mzc.rkt @@ -4,7 +4,8 @@ (require typed-racket/optimizer/logging unstable/syntax racket/match unstable/match racket/list racket/string - unstable/list) + unstable/list + "profiling.rkt") (provide mzc-opt-log-message->log-entry post-process-inline-log) @@ -140,7 +141,7 @@ ;; We aggregate results for each function. ;; Log messages produced by the inliner are very raw, unlike the TR logs, ;; which have gone through some aggregation. We do the aggregation here. -(define (post-process-inline-log log) +(define (post-process-inline-log log profile) (define-values (inliner-logs tr-logs) (partition inliner-log-entry? log)) (define grouped-events @@ -152,10 +153,17 @@ (not (self-out-of-fuel? x))) g))] #:when (not (null? group))) - (define head (car group)) - (match head ; events are grouped, first element is representative + (match (car group) ; events are grouped, first element is representative [(log-entry kind msg stx located-stx pos provenance) + ;; #f if no profiling info is available for this function + (define (pos->node pos) + (and profile + (for/first ([p (in-list (profile-nodes profile))] + #:when (equal? pos (node-pos p))) + p))) + (define profile-entry (pos->node pos)) + ;; We consider that a function is a loop if it gets inlined in itself ;; at least once. ;; We treat loops specially, mostly to avoid spurious reports. diff --git a/collects/typed-racket/optimizer/tool/profiling.rkt b/collects/typed-racket/optimizer/tool/profiling.rkt index a51d32a512..e8f19f042a 100644 --- a/collects/typed-racket/optimizer/tool/profiling.rkt +++ b/collects/typed-racket/optimizer/tool/profiling.rkt @@ -4,7 +4,18 @@ (require "sandbox.rkt") -(provide generate-profile) +(provide generate-profile + node-source node-line node-col node-pos node-span + (all-from-out profile/analyzer)) + +(define ((mk accessor) node) + (define src (node-src node)) + (and src (accessor src))) +(define node-source (mk srcloc-source)) +(define node-line (mk srcloc-line)) +(define node-col (mk srcloc-column)) +(define node-pos (mk srcloc-position)) +(define node-span (mk srcloc-span)) (define compiled-module-name 'optimization-coach-compiled-module) @@ -28,8 +39,5 @@ (define (right-file? node) (define src (node-src node)) (equal? (and src (srcloc-source src)) res-mpi)) - (define nodes - (filter right-file? (profile-nodes (analyze-samples snapshots)))) - (for ([n nodes]) - (printf "~a -- ~a -- ~a -- ~a\n" (node-id n) (node-total n) (node-self n) (node-src n))) - nodes) + (define orig-profile (analyze-samples snapshots)) + (filter right-file? (profile-nodes orig-profile))) diff --git a/collects/typed-racket/optimizer/tool/report.rkt b/collects/typed-racket/optimizer/tool/report.rkt index b2b51c539d..96b22ff3ae 100644 --- a/collects/typed-racket/optimizer/tool/report.rkt +++ b/collects/typed-racket/optimizer/tool/report.rkt @@ -25,10 +25,12 @@ (struct opt-report-entry sub-report-entry ()) (struct missed-opt-report-entry sub-report-entry (badness irritants)) -(define (generate-report this) +;; profile is currently only used to refine the inlining logs +(define (generate-report this profile) (log->report (post-process-inline-log - (generate-log this)))) + (generate-log this) + profile))) (define (generate-log this) diff --git a/collects/typed-racket/optimizer/tool/tool.rkt b/collects/typed-racket/optimizer/tool/tool.rkt index abab6ecaf2..71f896913c 100644 --- a/collects/typed-racket/optimizer/tool/tool.rkt +++ b/collects/typed-racket/optimizer/tool/tool.rkt @@ -120,10 +120,14 @@ ;; source is either a copy of the definitions text (we're not in the ;; main thread, so operating on the definitions directly is a bad idea) ;; or #f, in which case the report cache is used. - (define/public (add-highlights #:source [source #f]) + ;; profile is either a list of analyzed profile nodes (in which case we + ;; use it to refine the report) or #f. Profile information causes the + ;; report to be recomputed, invalidating the cache. + (define/public (add-highlights #:source [source #f] + #:profile [profile #f]) (clear-highlights) - (unless (and report-cache (not source)) - (set! report-cache (generate-report source))) + (unless (and report-cache (not source) (not profile)) + (set! report-cache (generate-report source profile))) (define report (collapse-report (for/list ([entry (in-list report-cache)] @@ -171,8 +175,10 @@ [callback (lambda _ (popup-fun text start end))])))))) + ;; gather profiling information, and use it to generate a refined report (define/public (optimization-coach-profile source) - (generate-profile this source)) + (add-highlights #:source source + #:profile (generate-profile this source))) (super-new)))