From da20d92c7749a74a8567252ac7c6673a5721d901 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Thu, 14 Dec 2017 07:05:53 +0100 Subject: [PATCH] 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. --- make.scm | 3 ++ module/mes/fluids.mes | 4 +++ src/gc.c | 12 +++++++ src/mes.c | 82 ++++++++++++++++++++++++++++++++----------- 4 files changed, 81 insertions(+), 20 deletions(-) diff --git a/make.scm b/make.scm index af2b0843..329f0b44 100755 --- a/make.scm +++ b/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 "\"") diff --git a/module/mes/fluids.mes b/module/mes/fluids.mes index 87dc4307..78d14db2 100644 --- a/module/mes/fluids.mes +++ b/module/mes/fluids.mes @@ -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)) diff --git a/src/gc.c b/src/gc.c index e140b499..0b102f1d 100644 --- a/src/gc.c +++ b/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); } diff --git a/src/mes.c b/src/mes.c index f89490e7..c1d3470d 100644 --- a/src/mes.c +++ b/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: [");