Implements memory profiling

Author: obround

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

eval/machine.rkt

@@ -41,6 +41,7 @@
                    profile-instruction
                    profile-number
                    profile-time
+                   profile-memory
                    profile-precision
                    profile-iteration))
 

eval/main.rkt

@@ -40,7 +40,7 @@
 (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 (rival-profile machine param)
   (match param
@@ -52,15 +52,17 @@
      (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
                          ([instruction (in-vector profile-instruction 0 profile-ptr)]
                           [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)

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 #f))
          (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 (max 0 (- (current-memory-use #f) 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 #f)])
     (unless (zero? iter)
       (backward-pass machine vhint))
     (rival-machine-record machine
                           'adjust
                           -1
                           (* iter 1000)
-                          (- (current-inexact-milliseconds) start)
+                          (- (current-inexact-milliseconds) start-time)
+                          (max 0 (- (current-memory-use #f) start-memory))
                           iter)))

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 #f)])
     (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)
+                             (max 0 (- (current-memory-use #f) 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 #f))
          (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 (max 0 (- (current-memory-use #f) start-memory)))
+         (baseline-machine-record machine name n precision time memory iter)
          res]
         [(? integer? _) (vector-ref vregs (list-ref instr hint))]
         [(? ival? _) hint]))
@@ -382,27 +388,31 @@
      (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
                          ([instruction (in-vector profile-instruction 0 profile-ptr)]
                           [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-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)

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)
+    (match-define (execution name id precision time _ _) exec)
     (when (and last (< id last))
       (set! iter (+ iter 1)))
     (set! last id)
@@ -106,7 +106,7 @@
                     #:when (and (= (modulo col 2) 0) (> col 2))
                     (define iter (- (/ col 2) 1))
                     (list-find-match execs*
-                                     (cons (== iter) (execution 'adjust _ _ time _))
+                                     (cons (== iter) (execution 'adjust _ _ time _ _))
                                      (~r (* time 1000) #:precision '(= 1)))]
                    [(2 col) ""]
                    [((== (+ 3 num-instructions)) _) "------"]
@@ -126,19 +126,19 @@
                    [(row 0)
                     (define id (+ (- row 3) num-args))
                     (list-find-match execs*
-                                     (cons _ (execution name (== id) _ _ _))
+                                     (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)]
+                    (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 _))
+                                     (cons (== iter) (execution _ (== id) _ time _ _))
                                      (~r (* time 1000) #:precision '(= 1)))]))))
 
 (define (rival-repl p)

time.rkt

@@ -151,7 +151,7 @@
         (define h (make-hash))
         (define max-prec 0)
         (for ([exec (in-vector rival-executions)])
-          (match-define (execution name number precision time _) exec)
+          (match-define (execution name number precision time _ _) 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 +397,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)