diff --git a/eval/compile.rkt b/eval/compile.rkt index 14152a64..d290b7de 100644 --- a/eval/compile.rkt +++ b/eval/compile.rkt @@ -333,6 +333,7 @@ (make-vector (*rival-profile-executions*)) (make-flvector (*rival-profile-executions*)) (make-vector (*rival-profile-executions*)) + (make-vector (*rival-profile-executions*)) (make-vector (*rival-profile-executions*)))) ;; Defining instructions that do not depend on input arguments diff --git a/eval/machine.rkt b/eval/machine.rkt index bc8cd439..f5b5b0d7 100644 --- a/eval/machine.rkt +++ b/eval/machine.rkt @@ -41,6 +41,7 @@ profile-instruction profile-number profile-time + profile-memory profile-precision profile-iteration)) diff --git a/eval/main.rkt b/eval/main.rkt index 3bc8ca35..d0ab71ea 100644 --- a/eval/main.rkt +++ b/eval/main.rkt @@ -24,7 +24,13 @@ *rival-use-shorthands* *rival-name-constants* rival-profile - (struct-out execution) + make-execution + execution-name + execution-number + execution-precision + execution-time + execution-memory + execution-iteration *rival-profile-executions*) (define (rival-machine-full machine vhint) @@ -40,7 +46,10 @@ (struct exn:rival:invalid exn:rival (pt)) (struct exn:rival:unsamplable exn:rival (pt)) -(struct execution (name number precision time iteration) #:prefab) +(struct execution (name number precision time memory iteration) #:prefab) + +(define (make-execution name number precision time memory iteration) + (execution name number precision time memory iteration)) (define (rival-profile machine param) (match param @@ -52,6 +61,7 @@ (define profile-instruction (rival-machine-profile-instruction machine)) (define profile-number (rival-machine-profile-number machine)) (define profile-time (rival-machine-profile-time machine)) + (define profile-memory (rival-machine-profile-memory machine)) (define profile-precision (rival-machine-profile-precision machine)) (define profile-iteration (rival-machine-profile-iteration machine)) (begin0 (for/vector #:length profile-ptr @@ -59,8 +69,9 @@ [number (in-vector profile-number 0 profile-ptr)] [precision (in-vector profile-precision 0 profile-ptr)] [time (in-flvector profile-time 0 profile-ptr)] + [memory (in-vector profile-memory 0 profile-ptr)] [iter (in-vector profile-iteration 0 profile-ptr)]) - (execution instruction number precision time iter)) + (execution instruction number precision time memory iter)) (set-rival-machine-profile-ptr! machine 0))])) (define (ival-real x) diff --git a/eval/run.rkt b/eval/run.rkt index f2b47716..ccfa2f8c 100644 --- a/eval/run.rkt +++ b/eval/run.rkt @@ -20,16 +20,18 @@ (set-rival-machine-bumps! machine 0) (*bumps-activated* #f)) -(define (rival-machine-record machine name number precision time iter) +(define (rival-machine-record machine name number precision time memory iter) (define profile-ptr (rival-machine-profile-ptr machine)) (define profile-instruction (rival-machine-profile-instruction machine)) (when (< profile-ptr (vector-length profile-instruction)) (define profile-number (rival-machine-profile-number machine)) (define profile-time (rival-machine-profile-time machine)) + (define profile-memory (rival-machine-profile-memory machine)) (define profile-precision (rival-machine-profile-precision machine)) (define profile-iteration (rival-machine-profile-iteration machine)) (vector-set! profile-instruction profile-ptr name) (vector-set! profile-number profile-ptr number) + (vector-set! profile-memory profile-ptr memory) (vector-set! profile-precision profile-ptr precision) (vector-set! profile-iteration profile-ptr iter) (flvector-set! profile-time profile-ptr time) @@ -56,13 +58,15 @@ (define out (match hint [#t ; instruction should be reevaluated - (define start (current-inexact-milliseconds)) + (define start-time (current-inexact-milliseconds)) + (define start-memory (current-memory-use 'cumulative)) (define res (parameterize ([bf-precision precision]) (apply-instruction instr vregs))) (define name (object-name (car instr))) - (define time (- (current-inexact-milliseconds) start)) - (rival-machine-record machine name n precision time iter) + (define time (- (current-inexact-milliseconds) start-time)) + (define memory (- (current-memory-use 'cumulative) start-memory)) + (rival-machine-record machine name n precision time memory iter) res] [(? integer? _) (vector-ref vregs (list-ref instr hint))] ; result is known [(? ival? _) hint])) ; result is known @@ -112,12 +116,14 @@ (define (rival-machine-adjust machine vhint) (define iter (rival-machine-iteration machine)) - (let ([start (current-inexact-milliseconds)]) + (let ([start-time (current-inexact-milliseconds)] + [start-memory (current-memory-use 'cumulative)]) (unless (zero? iter) (backward-pass machine vhint)) (rival-machine-record machine 'adjust -1 (* iter 1000) - (- (current-inexact-milliseconds) start) + (- (current-inexact-milliseconds) start-time) + (- (current-memory-use 'cumulative) start-memory) iter))) diff --git a/info.rkt b/info.rkt index 07ca95cd..8a37713a 100644 --- a/info.rkt +++ b/info.rkt @@ -1,7 +1,7 @@ #lang info (define collection "rival") -(define version "2.2") +(define version "2.3") (define license 'MIT) ;; Packaging information diff --git a/infra/run-baseline.rkt b/infra/run-baseline.rkt index b6e2efd0..e97e4858 100644 --- a/infra/run-baseline.rkt +++ b/infra/run-baseline.rkt @@ -32,6 +32,7 @@ profile-instruction profile-number profile-time + profile-memory profile-precision profile-iteration)) @@ -191,6 +192,7 @@ (make-vector (*rival-profile-executions*)) (make-flvector (*rival-profile-executions*)) (make-vector (*rival-profile-executions*)) + (make-vector (*rival-profile-executions*)) (make-vector (*rival-profile-executions*)))) ; ------------------------------------------- APPLY -------------------------------------------------- @@ -226,7 +228,8 @@ (list (ival (or bad? stuck?) (not good?)) hint* hint*-converged?)) (define (baseline-machine-adjust machine) - (let ([start (current-inexact-milliseconds)]) + (let ([start-time (current-inexact-milliseconds)] + [start-memory (current-memory-use 'cumulative)]) (define new-prec (bf-precision)) (set-baseline-machine-precision! machine new-prec) (vector-fill! (baseline-machine-precisions machine) new-prec) @@ -285,7 +288,8 @@ 'adjust -1 (* iter 1000) - (- (current-inexact-milliseconds) start) + (- (current-inexact-milliseconds) start-time) + (- (current-memory-use 'cumulative) start-memory) iter))) (define (drop-self-pointers tail-regs n) @@ -318,13 +322,15 @@ (define out (match hint [#t - (define start (current-inexact-milliseconds)) + (define start-time (current-inexact-milliseconds)) + (define start-memory (current-memory-use 'cumulative)) (define res (parameterize ([bf-precision precision]) (apply-instruction instr vregs))) (define name (object-name (car instr))) - (define time (- (current-inexact-milliseconds) start)) - (baseline-machine-record machine name n precision time iter) + (define time (- (current-inexact-milliseconds) start-time)) + (define memory (- (current-memory-use 'cumulative) start-memory)) + (baseline-machine-record machine name n precision time memory iter) res] [(? integer? _) (vector-ref vregs (list-ref instr hint))] [(? ival? _) hint])) @@ -382,6 +388,7 @@ (define profile-instruction (baseline-machine-profile-instruction machine)) (define profile-number (baseline-machine-profile-number machine)) (define profile-time (baseline-machine-profile-time machine)) + (define profile-memory (baseline-machine-profile-memory machine)) (define profile-precision (baseline-machine-profile-precision machine)) (define profile-iteration (baseline-machine-profile-iteration machine)) (begin0 (for/vector #:length profile-ptr @@ -389,20 +396,23 @@ [number (in-vector profile-number 0 profile-ptr)] [precision (in-vector profile-precision 0 profile-ptr)] [time (in-flvector profile-time 0 profile-ptr)] + [memory (in-vector profile-memory 0 profile-ptr)] [iter (in-vector profile-iteration 0 profile-ptr)]) - (execution instruction number precision time iter)) + (make-execution instruction number precision time memory iter)) (set-baseline-machine-profile-ptr! machine 0))])) -(define (baseline-machine-record machine name number precision time iter) +(define (baseline-machine-record machine name number precision time memory iter) (define profile-ptr (baseline-machine-profile-ptr machine)) (define profile-instruction (baseline-machine-profile-instruction machine)) (when (< profile-ptr (vector-length profile-instruction)) (define profile-number (baseline-machine-profile-number machine)) (define profile-time (baseline-machine-profile-time machine)) + (define profile-memory (baseline-machine-profile-memory machine)) (define profile-precision (baseline-machine-profile-precision machine)) (define profile-iteration (baseline-machine-profile-iteration machine)) (vector-set! profile-instruction profile-ptr name) (vector-set! profile-number profile-ptr number) + (vector-set! profile-memory profile-ptr memory) (vector-set! profile-precision profile-ptr precision) (vector-set! profile-iteration profile-ptr iter) (flvector-set! profile-time profile-ptr time) diff --git a/main.rkt b/main.rkt index 9d257edb..759cf654 100644 --- a/main.rkt +++ b/main.rkt @@ -122,7 +122,13 @@ *rival-profile-executions* *rival-use-shorthands* *rival-name-constants* - (struct-out execution)) + make-execution + execution-name + execution-number + execution-precision + execution-time + execution-memory + execution-iteration) (require "utils.rkt") (provide flonum-discretization diff --git a/repl.rkt b/repl.rkt index bff239dd..87351167 100644 --- a/repl.rkt +++ b/repl.rkt @@ -28,7 +28,7 @@ (define iter 0) (define last #f) (for/list ([exec (in-vector execs)]) - (match-define (execution name id precision time _) exec) + (define id (execution-number exec)) (when (and last (< id last)) (set! iter (+ iter 1))) (set! last id) @@ -40,13 +40,21 @@ (display (~a (fn row col) #:width width #:align 'right))) (newline))) -(define-syntax-rule (list-find-match l pattern body ...) - (let loop ([l l]) - (match l - [(cons pattern rest) - body ...] - [(cons _ rest) (loop rest)] - ['() ""]))) +(define (lookup-execution execs + #:iter [target-iter #f] + #:id [target-id #f] + #:name [target-name #f] + #:default [default ""] + #:value [value (lambda (_iter exec) exec)]) + (define entry + (for/first ([exec (in-list execs)] + #:when (and (or (not target-iter) (= (car exec) target-iter)) + (or (not target-id) (= (execution-number (cdr exec)) target-id)) + (or (not target-name) (= (execution-name (cdr exec)) target-name)))) + exec)) + (if entry + (value (car entry) (cdr entry)) + default)) (struct repl ([precision #:mutable] context)) @@ -88,58 +96,73 @@ (printf "Executed ~a instructions for ~a iterations:\n\n" num-instructions num-iterations) (define execs* (executions-iterations execs)) - (write-table #:rows (+ 5 num-instructions) ; 1 for the "adjust" row - #:cols (+ 1 (* 2 num-iterations)) - #:width 6 - (lambda (row col) - (match* (row col) - [(0 0) ""] - [(0 col) - #:when (= (modulo col 2) 1) - "Bits"] - [(0 col) - #:when (= (modulo col 2) 0) - "Time"] - [(1 _) "------"] - [(2 0) 'adjust] - [(2 col) - #:when (and (= (modulo col 2) 0) (> col 2)) - (define iter (- (/ col 2) 1)) - (list-find-match execs* - (cons (== iter) (execution 'adjust _ _ time _)) - (~r (* time 1000) #:precision '(= 1)))] - [(2 col) ""] - [((== (+ 3 num-instructions)) _) "------"] - [((== (+ 4 num-instructions)) 0) "Total"] - [((== (+ 4 num-instructions)) col) - #:when (= (modulo col 2) 1) - ""] - [((== (+ 4 num-instructions)) col) - #:when (= (modulo col 2) 0) - (define iter (/ (- col 2) 2)) - (define time - (apply + - (for/list ([exec (in-list execs*)] - #:when (= (car exec) iter)) - (execution-time (cdr exec))))) - (~r (* time 1000) #:precision '(= 1))] - [(row 0) - (define id (+ (- row 3) num-args)) - (list-find-match execs* - (cons _ (execution name (== id) _ _ _)) - (normalize-function-name (~a name)))] - [(row col) - #:when (= (modulo col 2) 1) ; precision - (define id (+ (- row 3) num-args)) - (define iter (/ (- col 1) 2)) - (list-find-match execs* (cons (== iter) (execution _ (== id) prec _ _)) prec)] - [(row col) - #:when (= (modulo col 2) 0) ; time - (define id (+ (- row 3) num-args)) - (define iter (/ (- col 2) 2)) - (list-find-match execs* - (cons (== iter) (execution _ (== id) _ time _)) - (~r (* time 1000) #:precision '(= 1)))])))) + (write-table + #:rows (+ 5 num-instructions) ; 1 for the "adjust" row + #:cols (+ 1 (* 2 num-iterations)) + #:width 6 + (lambda (row col) + (match* (row col) + [(0 0) ""] + [(0 col) + #:when (= (modulo col 2) 1) + "Bits"] + [(0 col) + #:when (= (modulo col 2) 0) + "Time"] + [(1 _) "------"] + [(2 0) 'adjust] + [(2 col) + #:when (and (= (modulo col 2) 0) (> col 2)) + (define iter (- (/ col 2) 1)) + (lookup-execution execs* + #:iter iter + #:name 'adjust + #:default "" + #:value (lambda (_iter exec) + (~r (* (execution-time exec) 1000) #:precision '(= 1))))] + [(2 col) ""] + [((== (+ 3 num-instructions)) _) "------"] + [((== (+ 4 num-instructions)) 0) "Total"] + [((== (+ 4 num-instructions)) col) + #:when (= (modulo col 2) 1) + ""] + [((== (+ 4 num-instructions)) col) + #:when (= (modulo col 2) 0) + (define iter (/ (- col 2) 2)) + (define time + (apply + + (for/list ([exec (in-list execs*)] + #:when (= (car exec) iter)) + (execution-time (cdr exec))))) + (~r (* time 1000) #:precision '(= 1))] + [(row 0) + (define id (+ (- row 3) num-args)) + (lookup-execution execs* + #:id id + #:default "" + #:value (lambda (_iter exec) + (normalize-function-name (~a (execution-name exec)))))] + [(row col) + #:when (= (modulo col 2) 1) ; precision + (define id (+ (- row 3) num-args)) + (define iter (/ (- col 1) 2)) + (lookup-execution execs* + #:iter iter + #:id id + #:default "" + #:value (lambda (_iter exec) (execution-precision exec)))] + [(row col) + #:when (= (modulo col 2) 0) ; time + (define id (+ (- row 3) num-args)) + (define iter (/ (- col 2) 2)) + (define value + (lookup-execution execs* + #:iter iter + #:id id + #:default "" + #:value (lambda (_iter exec) + (~r (* (execution-time exec) 1000) #:precision '(= 1))))) + value])))) (define (rival-repl p) (let/ec k diff --git a/scribblings/profile.scrbl b/scribblings/profile.scrbl index 070d12a8..6a670366 100644 --- a/scribblings/profile.scrbl +++ b/scribblings/profile.scrbl @@ -21,7 +21,7 @@ The currently-supported command symbols and their return values are: @item{@code{instructions} returns the number of register machine instructions in the compiled @racket[machine].} @item{@code{iterations} returns the number of re-evaluation iterations needed for the most recent call to @racket[rival-apply] with the compiled @racket[machine]. This should be a number from 0 to @racket[*rival-max-iterations*], inclusive.} @item{@code{bumps} returns the number of unexpected non-convergences detected during the most recent call to @racket[rival-apply] with the compiled @racket[machine]. These generally represent internal errors in Rival. While Rival will attempt to handle these "bumps" smoothly, they should still be reported to the developers as a bug.} -@item{@code{executions} returns a list of @racket{execution} structs, one for every register machine instruction executed by Rival. These executions are stored in a fixed-size buffer (see @racket[*rival-profile-executions*]) which is retained across @racket[rival-apply] calls and can fill up. The buffer is emptied by calls to @racket[(rival-profile machine 'executions)], so make sure to call this function regularly. If the list of @racket{execution}s returned by @racket[rival-profile] is equal in length to @racket[*rival-profile-executions*], you likely filled the buffer and are missing some executions.} +@item{@code{executions} returns a list of values from which you can obtain execution metadata using the accessor functions @racket[execution-name], @racket[execution-number], @racket[execution-precision], @racket[execution-time], @racket[execution-memory], and @racket[execution-iteration]. These executions are stored in a fixed-size buffer (see @racket[*rival-profile-executions*]) which is retained across @racket[rival-apply] calls and can fill up. The buffer is emptied by calls to @racket[(rival-profile machine 'executions)], so make sure to call this function regularly. If the list of @racket{execution}s returned by @racket[rival-profile] is equal in length to @racket[*rival-profile-executions*], you likely filled the buffer and are missing some executions.} ] } @@ -30,7 +30,9 @@ The currently-supported command symbols and their return values are: ([name symbol?] [number natural?] [precision natural?] - [time flonum?])]{ + [time flonum?] + [memory natural?] + [iteration natural?])]{ Each execution corresponds to a single Rival interval operator being executed. The @racket[name] names the operator, except the special symbol @racket['adjust], @@ -39,7 +41,9 @@ The currently-supported command symbols and their return values are: this allows disambiguating if an expression contains, say, multiple addition operations. The @racket[precision] is the @racket[bf-precision] that the operator is executed at, - and the @racket[time] is the time, in milliseconds, that that execution took. + the @racket[time] is the time, in milliseconds, that the execution took, + and the @racket[memory] is the number of bytes allocated during that execution. + The @racket[iteration] records which sampling iteration triggered the execution. Note that, because Rival executes the register machine multiple times, the same operator (with the same @racket[name] and @racket[number]) can appear multiple times for a single point. @@ -49,6 +53,8 @@ The currently-supported command symbols and their return values are: the same number of times. } +Only the accessor functions (such as @racket[execution-name]) are exported. + @defparam[*rival-profile-executions* executions natural? #:value 1000]{ The executions are, for maximum performance, written into a single diff --git a/time.rkt b/time.rkt index 1202634e..b2663073 100644 --- a/time.rkt +++ b/time.rkt @@ -151,7 +151,9 @@ (define h (make-hash)) (define max-prec 0) (for ([exec (in-vector rival-executions)]) - (match-define (execution name number precision time _) exec) + (define name (execution-name exec)) + (define number (execution-number exec)) + (define precision (execution-precision exec)) (unless (equal? name 'adjust) (define precision* (hash-ref h (list name number) (λ () 0))) (hash-set! h (list name number) (max precision precision*)) @@ -397,9 +399,9 @@ (define total-t (+ total-c total-v total-i total-u)) (define total-mem (/ (exact->inexact total-mem-bytes) (* 1024 1024))) (printf "\nTotal Time: ~as\n" (~r total-t #:precision '(= 3))) - (printf "Total Memory: ~a MiB\n" - (~r total-mem #:precision '(= 3))) - (define footer (list "Total" total-t total-c count-v total-v count-i total-i count-u total-u total-mem)) + (printf "Total Memory: ~a MiB\n" (~r total-mem #:precision '(= 3))) + (define footer + (list "Total" total-t total-c count-v total-v count-i total-i count-u total-u total-mem)) (values table footer)) (define (html-write port)