suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Scale badness using profile data.

Browse Source
This commit is contained in:
Vincent St-Amour 2012-11-03 14:53:28 -04:00
parent 4271675f69
commit a2f1e33d00
2 changed files with 49 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/typed-racket/optimizer/tool/mzc.rkt
View File

@ -163,14 +163,16 @@
append
(append
(for/list ([group (in-list grouped-events)])
(process-function group profile hot-functions TR-log))
(process-function group profile hot-functions
(and profile (profile-total-time profile))))
(if profile
(for/list ([node (in-list (profile-nodes profile))])
(process-profile-node node grouped-events hot-functions TR-log))
(process-profile-node node grouped-events hot-functions TR-log
(profile-total-time profile)))
'()))))
;; Process the inlining logs corresponding to a single function.
(define (process-function log profile hot-functions TR-log)
(define (process-function log profile hot-functions total-time)
(define produced-entries '())
(let/ec escape
;; prune this entry from the logs, but return what we produced so far
@ -190,6 +192,11 @@
p)))
(define profile-entry (pos->node pos))
(define badness-multiplier
(if profile-entry
(/ (node-self profile-entry) total-time)
1))
;; We consider that a function is a loop if it gets inlined in itself
;; at least once.
(define is-a-loop?
@ -297,7 +304,9 @@
recommendation)
stx located-stx pos provenance
'() '()
badness)))
;; uses ceiling to never go down to 0
;; both badness and badness-multiplier are non-0
(ceiling (* badness badness-multiplier)))))
(define (emit-success)
(emit (opt-log-entry
kind
@ -359,8 +368,8 @@
produced-entries]))) ; return the list of new entries
(define (process-profile-node profile-entry grouped-events hot-functions TR-log)
(define (process-profile-node profile-entry grouped-events hot-functions TR-log
total-time)
(define produced-entries '())
(define (emit e) (set! produced-entries (cons e produced-entries)))
@ -371,6 +380,14 @@
(define our-span (node-span profile-entry))
(and pos our-pos our-span (<= our-pos pos (+ our-pos our-span))))
(define badness-multiplier (/ (node-self profile-entry) total-time))
;; base values below are arbitrary
;; uses ceiling to never go down to 0
;; both badness and badness-multiplier are non-0
(define parameter-access-badness (ceiling (* 20 badness-multiplier)))
(define struct-construction-badness (ceiling (* 20 badness-multiplier)))
(define exact-real-arith-badness (ceiling (* 20 badness-multiplier)))
(when inside-hot-function?
(for ([TR-entry (in-list TR-log)]
#:when (info-log-entry? TR-entry)
@ -386,7 +403,7 @@
(log-entry-located-stx TR-entry) (log-entry-located-stx TR-entry)
(log-entry-pos TR-entry) 'typed-racket
'() '()
20)))) ;; TODO have actual badness
parameter-access-badness))))
(when inside-hot-function?
(for ([TR-entry (in-list TR-log)]
@ -404,7 +421,7 @@
(log-entry-located-stx TR-entry) (log-entry-located-stx TR-entry)
(log-entry-pos TR-entry) 'typed-racket
'() '()
20)))) ;; TODO have actual badness
struct-construction-badness))))
(when inside-hot-function?
(for ([TR-entry (in-list TR-log)]
@ -421,7 +438,7 @@
(log-entry-located-stx TR-entry) (log-entry-located-stx TR-entry)
(log-entry-pos TR-entry) 'typed-racket
'() '()
20)))) ;; TODO have actual badness
exact-real-arith-badness))))
produced-entries)

31
collects/typed-racket/optimizer/tool/report.rkt
View File

@ -29,7 +29,8 @@
(define (generate-report this profile)
(define-values (TR-log mzc-log) (generate-logs this))
(log->report
(append (prune-cold-TR-failures TR-log profile)
(append (prune-cold-TR-failures TR-log profile
(and profile (profile-total-time profile)))
(post-process-inline-log mzc-log profile TR-log))))
@ -217,7 +218,7 @@
;;--------------------------------------------------------------------
(require "profiling.rkt")
(define (prune-cold-TR-failures TR-log profile)
(define (prune-cold-TR-failures TR-log profile total-time)
(define hot-functions (and profile (prune-profile profile)))
;; #f if no profiling info is available for this function
@ -232,9 +233,23 @@
(<= from pos (+ from span)))))
p)))
(define (in-hot-function? l)
(or (not profile) ; keep everything if we don't have profile info
(opt-log-entry? l) ; don't prune successes
(memq (pos->node (log-entry-pos l)) hot-functions)))
(filter in-hot-function? TR-log))
(if (not profile)
TR-log ; keep everything if we don't have profile info
(for/list ([l (in-list TR-log)]
#:when (or (opt-log-entry? l) ; don't prune successes
;; in hot function?
(memq (pos->node (log-entry-pos l)) hot-functions)))
(define profile-entry (memq (pos->node (log-entry-pos l)) hot-functions))
(define badness-multiplier
(if profile-entry
(/ (node-self (car profile-entry)) total-time)
1))
(match l
[(missed-opt-log-entry kind msg stx located-stx pos provenance
irritants merged-irritants badness)
(missed-opt-log-entry kind msg stx located-stx pos provenance
irritants merged-irritants
;; uses ceiling to never go down to 0
;; both badness and badness-multiplier are non-0
(ceiling (* badness badness-multiplier)))]
[_ l])))) ; keep as is