core: Refactor stack handling.

* mes.c (gc_pop_frame, gc_push_frame): New Functions.
  (gc_frame, gc_stack): Remove.
  (vm_call): Update callers.
* lib.c (dump, bload_env): Update callers.
This commit is contained in:
Jan Nieuwenhuizen 2016-12-26 09:00:43 +01:00
parent b45936815c
commit a80ced8f84
2 changed files with 30 additions and 32 deletions

16
lib.c
View file

@ -129,16 +129,13 @@ int
dump ()
{
r1 = g_symbols;
SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
stack = cons (frame, stack);
stack = gc (stack);
gc_frame (stack);
gc (gc_push_frame ());
char *p = (char*)g_cells;
fputc ('M', stdout);
fputc ('E', stdout);
fputc ('S', stdout);
fputc (stack >> 8, stdout);
fputc (stack % 256, stdout);
fputc (g_stack >> 8, stdout);
fputc (g_stack % 256, stdout);
for (int i=0; i<g_free.value * sizeof(scm); i++)
fputc (*p++, stdout);
return 0;
@ -165,8 +162,8 @@ bload_env (SCM a) ///((internal))
assert (getchar () == 'M');
assert (getchar () == 'E');
assert (getchar () == 'S');
stack = getchar () << 8;
stack += getchar ();
g_stack = getchar () << 8;
g_stack += getchar ();
int c = getchar ();
while (c != EOF)
{
@ -174,10 +171,9 @@ bload_env (SCM a) ///((internal))
c = getchar ();
}
g_free.value = (p-(char*)g_cells) / sizeof (scm);
gc_frame (stack);
gc_peek_frame ();
g_symbols = r1;
g_stdin = stdin;
r0 = mes_builtins (r0);
return r3;
}

46
mes.c
View file

@ -129,7 +129,7 @@ function functions[200];
int g_function = 0;
SCM g_symbols = 0;
SCM stack = 0;
SCM g_stack = 0;
SCM r0 = 0; // a/env
SCM r1 = 0; // param 1
SCM r2 = 0; // param 2
@ -558,9 +558,9 @@ call (SCM fn, SCM x)
}
SCM
gc_frame (SCM stack)
gc_peek_frame ()
{
SCM frame = car (stack);
SCM frame = car (g_stack);
r1 = car (frame);
r2 = cadr (frame);
r3 = car (cddr (frame));
@ -569,30 +569,32 @@ gc_frame (SCM stack)
}
SCM
gc_stack (SCM a)
gc_pop_frame ()
{
SCM frame = gc_peek_frame (g_stack);
g_stack = cdr (g_stack);
return frame;
}
SCM
gc_push_frame ()
{
SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
stack = cons (frame, stack);
stack = gc (stack);
gc_frame (stack);
stack = cdr (stack);
return stack;
return g_stack = cons (frame, g_stack);
}
SCM
vm_call (function0_t f, SCM p1, SCM p2, SCM a)
{
SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
stack = cons (frame, stack);
gc_push_frame ();
r1 = p1;
r2 = p2;
r0 = a;
if (g_free.value + GC_SAFETY > ARENA_SIZE)
gc_stack (stack);
gc_pop_frame (gc (gc_push_frame ()));
SCM r = f ();
frame = gc_frame (stack);
stack = cdr (stack);
gc_pop_frame ();
return r;
}
@ -819,9 +821,9 @@ gc ()
gc_copy (i);
make_tmps (g_news);
g_symbols = gc_copy (g_symbols);
SCM new = gc_copy (stack);
if (g_debug) fprintf (stderr, "new=%d\n", new, stack);
stack = new;
SCM new = gc_copy (g_stack);
if (g_debug) fprintf (stderr, "new=%d\n", new, g_stack);
g_stack = new;
return gc_loop (1);
}
@ -896,7 +898,7 @@ gc_flip ()
g_cells = g_news;
g_news = cells;
if (g_debug) fprintf (stderr, " => jam[%d]\n", g_free.value);
return stack;
return g_stack;
}
// Environment setup
@ -983,13 +985,13 @@ mes_builtins (SCM a)
}
SCM
mes_stack (SCM a) ///((internal))
mes_g_stack (SCM a) ///((internal))
{
r0 = a;
r1 = MAKE_CHAR (0);
r2 = MAKE_CHAR (0);
r3 = MAKE_CHAR (0);
stack = cons (cell_nil, cell_nil);
g_stack = cons (cell_nil, cell_nil);
return r0;
}
@ -997,7 +999,7 @@ SCM
mes_environment () ///((internal))
{
SCM a = mes_symbols ();
return mes_stack (a);
return mes_g_stack (a);
}
SCM
@ -1035,7 +1037,7 @@ main (int argc, char *argv[])
if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
stderr_ (begin_env (program, r0));
fputs ("", stderr);
gc (stack);
gc (g_stack);
if (g_debug) fprintf (stderr, "\nstats: [%d]\n", g_free.value);
return 0;
}