artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: Move some debugging to MES_DEBUG=2.

Browse source 
* 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.
This commit is contained in:
Jan Nieuwenhuizen 2017-04-17 23:32:02 +02:00
parent 707c3a31cd
commit e0a0a3798a
4 changed files with 29 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
module/mes/base-0.mes
View file

@ -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")))

7
src/gc.c
View file

@ -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));

27
src/mes.c
View file

@ -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);

18
src/reader.c
View file

@ -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;