core: Add gc-stats.

* include/mes/mes.h (gc_start_time, gc_end_time, gc_time): New
variables.
* src/mes.c (init): Initialize them.
* src/gc.c: Use them.
* src/gc.c (gc_stats): New function.
* include/mes/builtins.h: Declare it.
* src/builtins.c (mes_builtins): Register it.
* tests/gc.test: Use it.

include/mes/builtins.h

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -57,6 +57,7 @@ struct scm *set_env_x (struct scm *x, struct scm *e, struct scm *a);
 struct scm *add_formals (struct scm *formals, struct scm *x);
 struct scm *eval_apply ();
 /* src/gc.c */
+struct scm *gc_stats ();
 struct scm *cons (struct scm *x, struct scm *y);
 struct scm *gc_check ();
 struct scm *gc ();

include/mes/mes.h

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -94,6 +94,10 @@ struct scm **g_stack_array;
 struct scm *g_cells;
 struct scm *g_news;
 long g_stack;
+size_t gc_count;
+struct timespec *gc_start_time;
+struct timespec *gc_end_time;
+size_t gc_time;
 
 char **__execl_c_argv;
 char *__getcwd_buf;
@@ -169,6 +173,7 @@ void gc_pop_frame ();
 void gc_push_frame ();
 void gc_stats_ (char const* where);
 void init_symbols_ ();
+long seconds_and_nanoseconds_to_long (long s, long ns);
 
 #include "mes/builtins.h"
 #include "mes/constants.h"

src/builtins.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -167,6 +167,7 @@ mes_builtins (struct scm *a)            /*:((internal)) */
   a = init_builtin (builtin_type, "add-formals", 2, &add_formals, a);
   a = init_builtin (builtin_type, "eval-apply", 0, &eval_apply, a);
   /* src/gc.c */
+  a = init_builtin (builtin_type, "gc-stats", 0, &gc_stats, a);
   a = init_builtin (builtin_type, "cons", 2, &cons, a);
   a = init_builtin (builtin_type, "gc-check", 0, &gc_check, a);
   a = init_builtin (builtin_type, "gc", 0, &gc, a);

src/gc.c

@@ -25,6 +25,8 @@
 #include <fcntl.h>
 #include <string.h>
 #include <stdlib.h>
+#include <sys/time.h>
+#include <time.h>
 
 int g_dump_filedes;
 
@@ -120,14 +122,33 @@ gc_free ()
 void
 gc_stats_ (char const* where)
 {
-  long i = g_free - g_cells;
+  size_t i = g_free - g_cells;
   i = i / M2_CELL_SIZE;
+  if (where)
+    {
       eputs (where);
-  eputs (": [");
+      eputs (": ");
+    }
+  eputs ("[");
   eputs (ltoa (i));
   eputs ("]\n");
 }
 
+struct scm *
+gc_stats ()
+{
+  gc_stats_ (0);
+  size_t arena_used = g_free - g_cells;
+  arena_used = arena_used / M2_CELL_SIZE;
+  size_t arena_free = ARENA_SIZE - arena_used;
+  struct scm *r = cell_nil;
+  r =  acons (cstring_to_symbol ("gc-count"), make_number (gc_count), r);
+  r =  acons (cstring_to_symbol ("gc-time"), make_number (gc_time), r);
+  r =  acons (cstring_to_symbol ("arena-free"), make_number (arena_free), r);
+  r =  acons (cstring_to_symbol ("arena-size"), make_number (ARENA_SIZE), r);
+  return r;
+}
+
 struct scm *
 alloc (long n)
 {
@@ -642,9 +663,16 @@ gc ()
       write_error_ (R0);
       eputs ("\n");
     }
+  clock_gettime (CLOCK_PROCESS_CPUTIME_ID, gc_start_time);
   gc_push_frame ();
   gc_ ();
   gc_pop_frame ();
+  clock_gettime (CLOCK_PROCESS_CPUTIME_ID, gc_end_time);
+  long time = seconds_and_nanoseconds_to_long
+    (gc_end_time->tv_sec - gc_start_time->tv_sec,
+     gc_end_time->tv_nsec - gc_start_time->tv_nsec);
+  gc_time = gc_time + time;
+  gc_count = gc_count + 1;
   if (g_debug > 5)
     {
       eputs ("symbols: ");

src/mes.c

@@ -1,6 +1,6 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
- * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
  *
  * This file is part of GNU Mes.
  *
@@ -171,6 +171,8 @@ init (char **envp)
   g_datadir = malloc (1024);
   g_start_time = malloc (sizeof (struct timespec));
   memset (g_start_time, 0, sizeof (struct timespec));
+  gc_start_time = malloc (sizeof (struct timespec));
+  gc_end_time = malloc (sizeof (struct timespec));
 
   char *p = getenv ("MES_DEBUG");
   if (p != 0)

tests/base.test

@@ -142,4 +142,9 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
     (getenv "bar")
     (getenv "foo")))
 
+(display (gc-stats))
+(newline)
+(gc)
+(display (gc-stats))
+(newline)
 (result 'report)

tests/gc.test

@@ -5,13 +5,13 @@ MES_MAX_ARENA=$MES_ARENA
 export MES_ARENA
 export MES_MAX_ARENA
 if [ "$MES" != guile ]; then
-    MES_BOOT=$0 exec ${MES-mes}
+    MES_BOOT=$0 exec ${MES-bin/mes}
 fi
-exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot)' -s "$0" "$@"
+exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -s "$0" "$@"
 !#
 
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -28,12 +28,13 @@ exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
+(define mes? (pair? (current-module)))
 (gc)
-;; (display (gc-stats))
+((if mes? core:display display) (gc-stats))
-;; (newline)
+((if mes? core:display display) "\n")
 (define (loop n)
   (if (> n 0) (loop (- n 1))))
 (loop 100000)
 (gc)
-;; (display (gc-stats))
+((if mes? core:display display) (gc-stats))
-;; (newline)
+((if mes? core:display display) "\n")