core: Move some debugging to MES_DEBUG=2.

* module/mes/base-0.mes (load): Add ;;;.
* src/gc.c (gc_flip): Test on g_debug > 1.
  (gc): Likewise.
* src/mes.c (mes_builtins): Likewise.
  (main): Likewise.
* src/reader.c (dump): Likewise.

diff --git a/module/mes/base-0.mes b/module/mes/base-0.mes
index 41d20b31c6c1cba11c2de53108ba987111e15704..01a8b466ffe4dce83ed60937961cf7a60aaab488 100644 (file)
--- a/module/mes/base-0.mes
+++ b/module/mes/base-0.mes
@@ -97,7 +97,7 @@
   (list 'begin
         (list 'if (list getenv "MES_DEBUG")
               (list 'begin
-                    (list core:display-error "read ")
+                    (list core:display-error ";;; read ")
                     (list core:display-error file)
                     (list core:display-error "\n")))
      (list 'push! '*input-ports* (list current-input-port))
@@ -126,7 +126,7 @@
 
 (if (getenv "MES_DEBUG")
     (begin
-      (core:display-error "%moduledir=")
+      (core:display-error ";;; %moduledir=")
       (core:display-error %moduledir)
       (core:display-error "\n")))
 

diff --git a/src/gc.c b/src/gc.c
index fcf38118632fd0529b49432e820b056910486211..2e8fef77a184711304d09bddd774714d1d903f89 100644 (file)
--- a/src/gc.c
+++ b/src/gc.c
@@ -45,7 +45,7 @@ gc_flip () ///((internal))
   struct scm *cells = g_cells;
   g_cells = g_news;
   g_news = cells;
-  if (g_debug)
+  if (g_debug > 1)
     {
       eputs (";;;   => jam[");
       eputs (itoa (g_free));
@@ -131,7 +131,8 @@ gc_check ()
 SCM
 gc ()
 {
-  if (g_debug)
+  if (g_debug == 1) eputs (".");
+  if (g_debug > 1)
     {
       eputs (";;; gc[");
       eputs (itoa (g_free));
@@ -146,7 +147,7 @@ gc ()
   make_tmps (g_news);
   g_symbols = gc_copy (g_symbols);
   SCM new = gc_copy (g_stack);
-  if (g_debug)
+  if (g_debug > 1)
     {
       eputs ("new=");
       eputs (itoa (new));

diff --git a/src/mes.c b/src/mes.c
index da8c201a837c888fc0196bd2b35cb22115b0fb9d..747ce191ea1f7273e5c42065b040ae7045880f36 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -1224,7 +1224,7 @@ mes_builtins (SCM a) ///((internal))
 #include "vector.environment.i"
 #endif
 
-  if (g_debug)
+  if (g_debug > 1)
     {
       fputs ("functions: ", STDERR);
       fputs (itoa (g_function), STDERR);
@@ -1272,7 +1272,8 @@ bload_env (SCM a) ///((internal))
   assert (getchar () == 'M');
   assert (getchar () == 'E');
   assert (getchar () == 'S');
-  eputs ("*GOT MES*\n");
+
+  if (g_debug) eputs ("*GOT MES*\n");
   g_stack = getchar () << 8;
   g_stack += getchar ();
 
@@ -1297,7 +1298,7 @@ bload_env (SCM a) ///((internal))
   set_env_x (cell_symbol_mesc, cell_t, r0);
 #endif
 
-  if (g_debug)
+  if (g_debug > 1)
     {
       eputs ("symbols: ");
       SCM s = g_symbols;
@@ -1333,22 +1334,18 @@ bload_env (SCM a) ///((internal))
 int
 main (int argc, char *argv[])
 {
-#if __GNUC__
-  g_debug = getenv ("MES_DEBUG") != 0;
-  if (g_debug) {eputs ("MODULEDIR=");eputs (MODULEDIR);eputs ("\n");}
-#endif
-#if _POSIX_SOURCE
-  if (getenv ("MES_MAX_ARENA")) MAX_ARENA_SIZE = atoi (getenv ("MES_MAX_ARENA"));
-  if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
-#endif
-  if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE");
-  if (argc > 1 && !strcmp (argv[1], "--version")) {puts ("Mes ");puts (VERSION);return 0;};
+  char *p;
+  if (p = getenv ("MES_DEBUG")) g_debug = atoi (p);
+  if (g_debug) {eputs (";;; MODULEDIR=");eputs (MODULEDIR);eputs ("\n");}
+  if (p = getenv ("MES_MAX_ARENA")) MAX_ARENA_SIZE = atoi (p);
+  if (p = getenv ("MES_ARENA")) ARENA_SIZE = atoi (p);
+  if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE\n");
+  if (argc > 1 && !strcmp (argv[1], "--version")) {puts ("Mes ");puts (VERSION);puts ("\n");return 0;};
   g_stdin = STDIN;
   r0 = mes_environment ();
 
 #if __MESC__
   SCM program = bload_env (r0);
-  g_debug = 1;
 #else
   SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
     ? bload_env (r0) : load_env (r0);
@@ -1362,7 +1359,7 @@ main (int argc, char *argv[])
 #endif
   r0 = acons (cell_symbol_argv, lst, r0);
   push_cc (r2, cell_unspecified, r0, cell_unspecified);
-  if (g_debug)
+  if (g_debug > 1)
     {
       eputs ("program: ");
       display_error_ (r1);

diff --git a/src/reader.c b/src/reader.c
index cd9434ce36fcc6dd36f551a36f70b6dd7d8a1cc8..fe6dab5eddad393fde8d4bdecbf7348913a2765b 100644 (file)
--- a/src/reader.c
+++ b/src/reader.c
@@ -124,10 +124,6 @@ int g_tiny = 0;
 int
 dump ()
 {
-  eputs ("program r2=");
-  display_error_ (r2);
-  eputs ("\n");
-
   r1 = g_symbols;
   gc_push_frame ();
   gc ();
@@ -139,8 +135,7 @@ dump ()
   putchar (g_stack >> 8);
   putchar (g_stack % 256);
   // See HACKING, simple crafted dump for tiny-mes.c
-  //  if (getenv ("MES_TINY"))
-  if (g_tiny)
+  if (g_tiny || getenv ("MES_TINY"))
     {
       eputs ("dumping TINY\n");
 
@@ -171,7 +166,16 @@ dump ()
       g_free = 15;
     }
   else
-    eputs ("dumping FULL\n");
+    {
+      eputs ("dumping FULL\n");
+      if (g_debug > 1)
+        {
+          eputs ("program r2=");
+          display_error_ (r2);
+          eputs ("\n");
+        }
+    }
+
   for (int i=0; i<g_free * sizeof(struct scm); i++)
     putchar (*p++);
   return 0;