From 3c9766682a1d41ac618f147b2353a062a3366a43 Mon Sep 17 00:00:00 2001
From: Kooda <address@hidden>
Date: Fri, 16 Sep 2016 17:20:30 +0200
Subject: [PATCH] Make (time) show the maximum heap usage

Signed-off-by: Peter Bex <address@hidden>
---
 NEWS        |  2 ++
 library.scm | 22 +++++++++++++++++++++-
 runtime.c   | 18 ++++++++++++------
 3 files changed, 35 insertions(+), 7 deletions(-)

diff --git a/NEWS b/NEWS
index c7210dd..5cd9092 100644
--- a/NEWS
+++ b/NEWS
@@ -55,6 +55,8 @@
 
 4.11.2
 
+- Runtime system:
+  - "time" macro now shows peak memory usage (#1318, thanks to Kooda).
 
 4.11.1
 
diff --git a/library.scm b/library.scm
index 2d1673b..9b7463f 100644
--- a/library.scm
+++ b/library.scm
@@ -266,7 +266,14 @@ EOF
   (##sys#gc #t)
   (##core#inline "C_start_timer"))
 
-(define ##sys#stop-timer (##core#primitive "C_stop_timer"))
+(define (##sys#stop-timer)
+  (let ((info ((##core#primitive "C_stop_timer"))))
+    ;; Run a major GC one more time to get memory usage information in
+    ;; case there was no major GC while the timer was running
+    (##sys#gc #t)
+    (##sys#setslot info 6 (##sys#slot ((##core#primitive "C_stop_timer")) 6))
+    info))
+
 (define (##sys#immediate? x) (not (##core#inline "C_blockp" x)))
 (define (##sys#message str) (##core#inline "C_message" str))
 (define (##sys#byte x i) (##core#inline "C_subbyte" x i))
@@ -5744,6 +5751,16 @@ EOF
   (define (pchr chr) (##sys#write-char-0 chr ##sys#standard-error))
   (define (pnum num)
     (##sys#print (if (zero? num) "0" (##sys#number->string num)) #f ##sys#standard-error))
+  (define (round-to x y) ; Convert to fp with y digits after the point
+    (/ (round (* x (expt 10 y))) (expt 10.0 y)))
+  (define (pmem bytes)
+    (cond ((> bytes (expt 1024 3))
+	   (pnum (round-to (/ bytes (expt 1024 3)) 2)) (pstr " GiB"))
+	  ((> bytes (expt 1024 2))
+	   (pnum (round-to (/ bytes (expt 1024 2)) 2)) (pstr " MiB"))
+	  ((> bytes 1024)
+	   (pnum (round-to (/ bytes 1024) 2)) (pstr " KiB"))
+	  (else (pnum bytes) (pstr " bytes"))))
   (##sys#flush-output ##sys#standard-output)
   (pnum (##sys#slot info 0))
   (pstr "s CPU time")
@@ -5768,6 +5785,9 @@ EOF
       (pchr #\/)
       (pnum minor)
       (pstr " GCs (major/minor)")))
+  (let ((maximum-heap-usage (##sys#slot info 6)))
+    (pstr ", maximum live heap: ")
+    (pmem maximum-heap-usage))
   (##sys#write-char-0 #\newline ##sys#standard-error)
   (##sys#flush-output ##sys#standard-error))
 
diff --git a/runtime.c b/runtime.c
index 403ac8f..a9722df 100644
--- a/runtime.c
+++ b/runtime.c
@@ -428,7 +428,8 @@ static C_TLS C_uword
   heap_size,
   scratchspace_size,
   temporary_stack_size,
-  fixed_temporary_stack_size = 0;
+  fixed_temporary_stack_size = 0,
+  maximum_heap_usage;
 static C_TLS C_char
   buffer[ STRING_BUFFER_SIZE ],
   *private_repository = NULL,
@@ -838,7 +839,7 @@ int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel)
 #endif
   }
 
-  tracked_mutation_count = mutation_count = gc_count_1 = gc_count_1_total = gc_count_2 = 0;
+  tracked_mutation_count = mutation_count = gc_count_1 = gc_count_1_total = gc_count_2 = maximum_heap_usage = 0;
   lf_list = NULL;
   C_register_lf2(NULL, 0, create_initial_ptable());
   C_restart_trampoline = (void *)toplevel;
@@ -3613,7 +3614,10 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
     scratchspace_size = 0;
   }
 
-  if(gc_mode == GC_MAJOR) gc_count_1 = 0;
+  if(gc_mode == GC_MAJOR) {
+    gc_count_1 = 0;
+    maximum_heap_usage = count > maximum_heap_usage ? count : maximum_heap_usage;
+  }
 
   if(C_post_gc_hook != NULL) C_post_gc_hook(gc_mode, (C_long)tgc);
 
@@ -4729,6 +4733,7 @@ C_regparm C_word C_fcall C_start_timer(void)
   gc_count_2 = 0;
   timer_start_ms = C_cpu_milliseconds();
   gc_ms = 0;
+  maximum_heap_usage = 0;
   return C_SCHEME_UNDEFINED;
 }
 
@@ -4740,15 +4745,16 @@ void C_ccall C_stop_timer(C_word c, C_word *av)
     k = av[ 1 ];
   double t0 = C_cpu_milliseconds() - timer_start_ms;
   C_word 
-    ab[ WORDS_PER_FLONUM * 2 + C_SIZEOF_VECTOR(6) ],
+    ab[ WORDS_PER_FLONUM * 2 + C_SIZEOF_BIGNUM(1) + C_SIZEOF_VECTOR(7) ],
     *a = ab,
     elapsed = C_flonum(&a, t0 / 1000.0),
     gc_time = C_flonum(&a, gc_ms / 1000.0),
+    heap_usage = C_unsigned_int_to_num(&a, maximum_heap_usage),
     info;
   
-  info = C_vector(&a, 6, elapsed, gc_time, C_fix(mutation_count),
+  info = C_vector(&a, 7, elapsed, gc_time, C_fix(mutation_count),
                   C_fix(tracked_mutation_count), C_fix(gc_count_1_total),
-		  C_fix(gc_count_2));
+		  C_fix(gc_count_2), heap_usage);
   C_kontinue(k, info);
 }
 
-- 
2.1.4