~ chicken-core (chicken-5) f311543adeddc1a9848bb7e4bdc6b0fb259cc5e8

commit f311543adeddc1a9848bb7e4bdc6b0fb259cc5e8
Author:     Kooda <kooda@upyum.com>
AuthorDate: Fri Sep 16 17:20:30 2016 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Wed Oct 12 21:47:59 2016 +1300

    Make (time) show the maximum heap usage
    
    Signed-off-by: Peter Bex <peter@more-magic.net>
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 658e61e9..3d148a19 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,9 @@
   - Fixed incorrect argvector restoration after GC in directly
     recursive functions (#1317).
 
+- Runtime system:
+  - "time" macro now shows peak memory usage (#1318, thanks to Kooda).
+
 4.11.1
 
 - Security fixes
diff --git a/library.scm b/library.scm
index 6676d03b..ef5bdb06 100644
--- a/library.scm
+++ b/library.scm
@@ -221,7 +221,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))
@@ -5023,6 +5030,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")
@@ -5047,6 +5064,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 320c730f..4b6300f1 100644
--- a/runtime.c
+++ b/runtime.c
@@ -400,8 +400,9 @@ static C_TLS C_uword
   heapspace2_size,
   heap_size,
   temporary_stack_size,
-  fixed_temporary_stack_size = 0;
-static C_TLS C_char 
+  fixed_temporary_stack_size = 0,
+  maximum_heap_usage;
+static C_TLS C_char
   buffer[ STRING_BUFFER_SIZE ],
   *private_repository = NULL,
   *current_module_name,
@@ -767,7 +768,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;
@@ -3201,7 +3202,10 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
     C_dbg("GC", C_text("%d locatives (from %d)\n"), locative_table_count, locative_table_size);
   }
 
-  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);
 
@@ -4295,6 +4299,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;
 }
 
@@ -4306,15 +4311,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 + 7 ], /* 2 flonums, 1 vector of 6 elements */
+    ab[ WORDS_PER_FLONUM * 3 + 8 ], /* 3 flonums, 1 vector of 7 elements */
     *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);
 }