mes: use array-based stack. WIP: will not survice gc.
* src/mes.c (STACK_SIZE)[MES_ARRAY_STACK]: New variable. (g_stack_array): New variable. (g_stack): Change type to SCM*. * (gc_push_frame)[MES_ARRAY_STACK]: Use g_stack_array, g_stack. (gc_peek_frame): Likewise. (gc_pop_frame): Likewise. * src/gc.c (gc_check): Likewise. (gc): Likewise.
This commit is contained in:
Jan Nieuwenhuizen
parent
90249f595f
commit
da20d92c77
3
make.scm
3
make.scm
|
|
@ -418,6 +418,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
|
|||
(add-target (bin.gcc "src/mes.c" #:dependencies gcc-snarf-targets
|
||||
#:defines `("MES_C_READER=1"
|
||||
"MES_C_DEFINE=1"
|
||||
"MES_ARRAY_STACK=1"
|
||||
"MES_FIXED_PRIMITIVES=1"
|
||||
"MES_FULL=1"
|
||||
"POSIX=1"
|
||||
|
|
@ -430,6 +431,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
|
|||
#:dependencies mes-snarf-targets
|
||||
#:defines `("MES_C_READER=1"
|
||||
"MES_C_DEFINE=1"
|
||||
"MES_ARRAY_STACK=1"
|
||||
"MES_FIXED_PRIMITIVES=1"
|
||||
"MES_FULL=1"
|
||||
,(string-append "VERSION=\"" %version "\"")
|
||||
|
|
@ -440,6 +442,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
|
|||
(add-target (bin.mescc "src/mes.c" #:dependencies mes-snarf-targets
|
||||
#:defines `("MES_C_READER=1"
|
||||
"MES_C_DEFINE=1"
|
||||
"MES_ARRAY_STACK=1"
|
||||
"MES_FIXED_PRIMITIVES=1"
|
||||
"MES_FULL=1"
|
||||
,(string-append "VERSION=\"" %version "\"")
|
||||
|
|
|
|||
|
|
@ -58,6 +58,10 @@
|
|||
(set! v (car rest))))) ',module)
|
||||
',fluid))))
|
||||
|
||||
(define-macro (make-fluid . default)
|
||||
(core:display "FIXME: disabled fluids\n")
|
||||
(lambda (x) x))
|
||||
|
||||
(define (fluid-ref fluid)
|
||||
(fluid))
|
||||
|
||||
|
|
|
|||
12
src/gc.c
12
src/gc.c
|
|
@ -125,8 +125,15 @@ gc_loop (SCM scan) ///((internal))
|
|||
SCM
|
||||
gc_check ()
|
||||
{
|
||||
#if !MES_ARRAY_STACK
|
||||
if (g_free + GC_SAFETY > ARENA_SIZE)
|
||||
gc_pop_frame (gc (gc_push_frame ()));
|
||||
#else
|
||||
#endif
|
||||
if (g_free + GC_SAFETY > ARENA_SIZE)
|
||||
{
|
||||
gc ();
|
||||
}
|
||||
return cell_unspecified;
|
||||
}
|
||||
|
||||
|
|
@ -148,6 +155,8 @@ gc ()
|
|||
gc_copy (i);
|
||||
make_tmps (g_news);
|
||||
g_symbols = gc_copy (g_symbols);
|
||||
|
||||
#if !MES_ARRAY_STACK
|
||||
SCM new = gc_copy (g_stack);
|
||||
if (g_debug > 1)
|
||||
{
|
||||
|
|
@ -156,5 +165,8 @@ gc ()
|
|||
eputs ("\n");
|
||||
}
|
||||
g_stack = new;
|
||||
#else
|
||||
#endif
|
||||
|
||||
return gc_loop (1);
|
||||
}
|
||||
|
|
|
|||
82
src/mes.c
82
src/mes.c
|
|
@ -30,6 +30,9 @@ int ARENA_SIZE = 10000000;
|
|||
int ARENA_SIZE = 100000;
|
||||
#endif
|
||||
int MAX_ARENA_SIZE = 20000000;
|
||||
#if MES_ARRAY_STACK
|
||||
int STACK_SIZE = 10000;
|
||||
#endif
|
||||
|
||||
//int GC_SAFETY_DIV = 400;
|
||||
//int GC_SAFETY = ARENA_SIZE / 400;
|
||||
|
|
@ -44,6 +47,7 @@ int g_free = 0;
|
|||
SCM g_continuations = 0;
|
||||
SCM g_symbols = 0;
|
||||
SCM g_stack = 0;
|
||||
SCM *g_stack_array = 0;
|
||||
// a/env
|
||||
SCM r0 = 0;
|
||||
// param 1
|
||||
|
|
@ -584,9 +588,52 @@ check_apply (SCM f, SCM e) ///((internal))
|
|||
SCM
|
||||
gc_push_frame () ///((internal))
|
||||
{
|
||||
#if !MES_ARRAY_STACK
|
||||
SCM frame = cons (r1, cons (r2, cons (r3, cons (r0, cell_nil))));
|
||||
g_stack = cons (frame, g_stack);
|
||||
return g_stack;
|
||||
#else
|
||||
if (g_stack < 4)
|
||||
assert (!"STACK FULL");
|
||||
g_stack_array[--g_stack] = r0;
|
||||
g_stack_array[--g_stack] = r1;
|
||||
g_stack_array[--g_stack] = r2;
|
||||
g_stack_array[--g_stack] = r3;
|
||||
return g_stack;
|
||||
#endif
|
||||
}
|
||||
|
||||
SCM
|
||||
gc_peek_frame () ///((internal))
|
||||
{
|
||||
#if !MES_ARRAY_STACK
|
||||
SCM frame = CAR (g_stack);
|
||||
r1 = CAR (frame);
|
||||
r2 = CADR (frame);
|
||||
r3 = CAR (CDDR (frame));
|
||||
r0 = CADR (CDDR (frame));
|
||||
return frame;
|
||||
#else
|
||||
r3 = g_stack_array[g_stack];
|
||||
r2 = g_stack_array[g_stack+1];
|
||||
r1 = g_stack_array[g_stack+2];
|
||||
r0 = g_stack_array[g_stack+3];
|
||||
return r0;
|
||||
#endif
|
||||
}
|
||||
|
||||
SCM
|
||||
gc_pop_frame () ///((internal))
|
||||
{
|
||||
#if !MES_ARRAY_STACK
|
||||
SCM frame = gc_peek_frame ();
|
||||
g_stack = CDR (g_stack);
|
||||
return frame;
|
||||
#else
|
||||
gc_peek_frame ();
|
||||
g_stack += 4;
|
||||
return r0;
|
||||
#endif
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
@ -731,25 +778,6 @@ push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
|
|||
return cell_unspecified;
|
||||
}
|
||||
|
||||
SCM
|
||||
gc_peek_frame () ///((internal))
|
||||
{
|
||||
SCM frame = CAR (g_stack);
|
||||
r1 = CAR (frame);
|
||||
r2 = CADR (frame);
|
||||
r3 = CAR (CDDR (frame));
|
||||
r0 = CADR (CDDR (frame));
|
||||
return frame;
|
||||
}
|
||||
|
||||
SCM
|
||||
gc_pop_frame () ///((internal))
|
||||
{
|
||||
SCM frame = gc_peek_frame (g_stack);
|
||||
g_stack = CDR (g_stack);
|
||||
return frame;
|
||||
}
|
||||
|
||||
SCM
|
||||
eval_apply ()
|
||||
{
|
||||
|
|
@ -1129,12 +1157,22 @@ apply (SCM f, SCM x, SCM a) ///((internal))
|
|||
SCM
|
||||
mes_g_stack (SCM a) ///((internal))
|
||||
{
|
||||
#if !MES_ARRAY_STACK
|
||||
r0 = a;
|
||||
r1 = MAKE_CHAR (0);
|
||||
r2 = MAKE_CHAR (0);
|
||||
r3 = MAKE_CHAR (0);
|
||||
g_stack = cons (cell_nil, cell_nil);
|
||||
return r0;
|
||||
#else
|
||||
//g_stack = g_free + ARENA_SIZE;
|
||||
g_stack = STACK_SIZE;
|
||||
r0 = a;
|
||||
r1 = MAKE_CHAR (0);
|
||||
r2 = MAKE_CHAR (0);
|
||||
r3 = MAKE_CHAR (0);
|
||||
return r0;
|
||||
#endif
|
||||
}
|
||||
|
||||
// Environment setup
|
||||
|
|
@ -1162,6 +1200,9 @@ SCM
|
|||
gc_init_cells () ///((internal))
|
||||
{
|
||||
g_cells = (struct scm *)malloc (2*ARENA_SIZE*sizeof (struct scm));
|
||||
#if MES_ARRAY_STACK
|
||||
g_stack_array = (SCM *)malloc (STACK_SIZE);
|
||||
#endif
|
||||
|
||||
TYPE (0) = TVECTOR;
|
||||
LENGTH (0) = 1000;
|
||||
|
|
@ -1466,6 +1507,7 @@ main (int argc, char *argv[])
|
|||
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 (p = getenv ("MES_STACK")) STACK_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;
|
||||
|
|
@ -1491,7 +1533,7 @@ main (int argc, char *argv[])
|
|||
r1 = eval_apply ();
|
||||
display_error_ (r1);
|
||||
eputs ("\n");
|
||||
gc (g_stack);
|
||||
gc ();
|
||||
if (g_debug)
|
||||
{
|
||||
eputs ("\nstats: [");
|
||||
|
|
|
|||
Loading…
Reference in a new issue