core: Make symbols constants.
authorJan Nieuwenhuizen <janneke@gnu.org>
Wed, 14 Dec 2016 18:02:19 +0000 (19:02 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Wed, 14 Dec 2016 18:02:19 +0000 (19:02 +0100)
* mes.c (apply_env,eval_env): Rewrite using switch.
* build-aux/mes-snarf.scm (symbol->header): Define constants.
  (symbol->source): Only update g_free and init cells.

build-aux/mes-snarf.scm
mes.c

index e80669740e1c586fc01f9672b24bfa7d56dccbf5..a34d48fe5e99de82476581d4180ba82fad0a8d3a 100755 (executable)
@@ -72,11 +72,11 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
 
 (define %start 1)
 (define (symbol->header s i)
-  (format #f "SCM cell_~a;\n" s))
+  (format #f "#define cell_~a ~a\n" s i))
 
 (define (symbol->source s i)
   (string-append
-   (format #f "cell_~a = g_free.value++;\n" s)
+   (format #f "g_free.value++;\n")
    (format #f "g_cells[cell_~a] = scm_~a;\n\n" s s)))
 
 (define (function->header f i)
diff --git a/mes.c b/mes.c
index bee6a3946255e564f0ec2c296bed43a94156dbc4..7aaa70e70ad3c3092b5a191fcb45eba6bbb636f5 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -43,7 +43,7 @@ int ARENA_SIZE = 100000;
 int MAX_ARENA_SIZE = 20000000;
 int GC_SAFETY = 100;
 
-typedef long SCM;
+typedef int SCM;
 enum type_t {CHAR, FUNCTION, MACRO, NUMBER, PAIR, SPECIAL, STRING, SYMBOL, REF, VALUES, VECTOR, BROKEN_HEART};
 typedef SCM (*function0_t) (void);
 typedef SCM (*function1_t) (SCM);
@@ -80,34 +80,6 @@ typedef struct scm_t {
   };
 } scm;
 
-function functions[200];
-int g_function = 0;
-
-#include "mes.symbols.h"
-#include "define.h"
-#include "display.h"
-#include "lib.h"
-#include "math.h"
-#include "mes.h"
-#include "posix.h"
-#include "quasiquote.h"
-#include "reader.h"
-#include "string.h"
-#include "type.h"
-
-SCM g_symbols = 0;
-SCM stack = 0;
-SCM r0 = 0; // a/env
-SCM r1 = 0; // param 1
-SCM r2 = 0; // param 2
-SCM r3 = 0; // param 3
-
-SCM tmp;
-SCM tmp_num;
-SCM tmp_num2;
-SCM tmp_num3;
-SCM tmp_num4;
-
 scm scm_nil = {SPECIAL, "()"};
 scm scm_f = {SPECIAL, "#f"};
 scm scm_t = {SPECIAL, "#t"};
@@ -170,6 +142,35 @@ scm g_free = {NUMBER, .value=0};
 scm *g_cells;
 scm *g_news = 0;
 
+#include "mes.symbols.h"
+
+SCM tmp;
+SCM tmp_num;
+SCM tmp_num2;
+SCM tmp_num3;
+SCM tmp_num4;
+
+function functions[200];
+int g_function = 0;
+
+SCM g_symbols = 0;
+SCM stack = 0;
+SCM r0 = 0; // a/env
+SCM r1 = 0; // param 1
+SCM r2 = 0; // param 2
+SCM r3 = 0; // param 3
+
+#include "define.h"
+#include "display.h"
+#include "lib.h"
+#include "math.h"
+#include "mes.h"
+#include "posix.h"
+#include "quasiquote.h"
+#include "reader.h"
+#include "string.h"
+#include "type.h"
+
 #define CAR(x) g_cells[x].car
 #define CDR(x) g_cells[x].cdr
 #define HITS(x) g_cells[x].hits
@@ -378,24 +379,30 @@ vm_apply_env ()
         return call_with_values_env (car (r2), cadr (r2), r0);
       if (r1 == cell_symbol_current_module) return r0;
     }
-  else if (car (r1) == cell_symbol_lambda) {
-    SCM args = cadr (r1);
-    SCM body = cddr (r1);
-    SCM p = pairlis (args, r2, r0);
-    return call_lambda (body, p, p, r0);
-  }
-  else if (car (r1) == cell_closure) {
-    SCM args = caddr (r1);
-    SCM body = cdddr (r1);
-    SCM aa = cdadr (r1);
-    aa = cdr (aa);
-    SCM p = pairlis (args, r2, aa);
-    return call_lambda (body, p, aa, r0);
-  }
+  else
+    switch (car (r1))
+      {
+      case cell_symbol_lambda:
+        {
+          SCM args = cadr (r1);
+          SCM body = cddr (r1);
+          SCM p = pairlis (args, r2, r0);
+          return call_lambda (body, p, p, r0);
+        }
+      case cell_closure:
+        {
+          SCM args = caddr (r1);
+          SCM body = cdddr (r1);
+          SCM aa = cdadr (r1);
+          aa = cdr (aa);
+          SCM p = pairlis (args, r2, aa);
+          return call_lambda (body, p, aa, r0);
+        }
 #if BOOT
-  else if (car (r1) == cell_symbol_label)
-    return apply_env (caddr (r1), r2, cons (cons (cadr (r1), caddr (r1)), r0));
+      case cell_symbol_label:
+        return apply_env (caddr (r1), r2, cons (cons (cadr (r1), caddr (r1)), r0));
 #endif
+      }
   SCM e = eval_env (r1, r0);
   char const* type = 0;
   if (e == cell_f || e == cell_t) type = "bool";
@@ -423,77 +430,48 @@ vm_eval_env ()
     {
     case PAIR:
       {
+        switch (car (r1))
+          {
 #if FIXED_PRIMITIVES
-        if (car (r1) == cell_symbol_car)
-          return car (eval_env (CADR (r1), r0));
-        if (car (r1) == cell_symbol_cdr)
-          return cdr (eval_env (CADR (r1), r0));
-        if (car (r1) == cell_symbol_cons) {
-          SCM m = evlis_env (CDR (r1), r0);
-          return cons (CAR (m), CADR (m));
-        }
-        if (car (r1) == cell_symbol_null_p)
-          return null_p (eval_env (CADR (r1), r0));
+          case cell_symbol_car: return car (eval_env (CADR (r1), r0));
+          case cell_symbol_cdr: return cdr (eval_env (CADR (r1), r0));
+          case cell_symbol_cons: {SCM m = evlis_env (CDR (r1), r0);
+              return cons (CAR (m), CADR (m));}
+          case cell_symbol_null_p: return null_p (eval_env (CADR (r1), r0));
 #endif // FIXED_PRIMITIVES
-        if (car (r1) == cell_symbol_quote)
-          return cadr (r1);
+          case cell_symbol_quote: return cadr (r1);
 #if QUASISYNTAX
-        if (car (r1) == cell_symbol_syntax)
-          return r1;
+          case cell_symbol_syntax: return r1;
 #endif
-        if (car (r1) == cell_symbol_begin)
-          return begin_env (r1, r0);
-        if (car (r1) == cell_symbol_lambda)
-          return make_closure (cadr (r1), cddr (r1), assq (cell_closure, r0));
-        if (car (r1) == cell_closure)
-          return r1;
-        if (car (r1) == cell_symbol_if)
-          return if_env (cdr (r1), r0);
+          case cell_symbol_begin: return begin_env (r1, r0);
+          case cell_symbol_lambda:
+            return make_closure (cadr (r1), cddr (r1), assq (cell_closure, r0));
+          case cell_closure: return r1;
+          case cell_symbol_if: return if_env (cdr (r1), r0);
 #if !BOOT
-        if (car (r1) == cell_symbol_define)
-          return define_env (r1, r0);
-        if (car (r1) == cell_symbol_define_macro)
-          return define_env (r1, r0);
-        if (car (r1) == cell_symbol_primitive_load)
-          return begin_env (read_input_file_env (r0), r0);
-#else
-        if (car (r1) == cell_symbol_define) {
-        fprintf (stderr, "C DEFINE: ");
-        display_ (stderr,
-                  TYPE (cadr (r1)) == SYMBOL
-                  ? STRING (cadr (r1))
-                  : STRING (caadr (r1)));
-        fprintf (stderr, "\n");
-      }
-      assert (car (r1) != cell_symbol_define);
-      assert (car (r1) != cell_symbol_define_macro);
+          case cell_symbol_define: return define_env (r1, r0);
+          case cell_symbol_define_macro: return define_env (r1, r0);
 #endif
 #if 1 //!BOOT
-      if (car (r1) == cell_symbol_set_x)
-        {
-          SCM x = eval_env (caddr (r1), r0);
-          return set_env_x (cadr (r1), x, r0);
-        }
-#else
-      assert (car (r1) != cell_symbol_set_x);
+          case cell_symbol_set_x: {
+            SCM x = eval_env (caddr (r1), r0); return set_env_x (cadr (r1), x, r0);
+          }
 #endif
 #if QUASIQUOTE
-      if (car (r1) == cell_symbol_unquote)
-        return eval_env (cadr (r1), r0);
-      if (car (r1) == cell_symbol_quasiquote)
-        return eval_quasiquote (cadr (r1), add_unquoters (r0));
+          case cell_symbol_unquote: return eval_env (cadr (r1), r0);
+          case cell_symbol_quasiquote: return eval_quasiquote (cadr (r1), add_unquoters (r0));
 #endif //QUASIQUOTE
 #if QUASISYNTAX
-      if (car (r1) == cell_symbol_unsyntax)
-        return eval_env (cadr (r1), r0);
-      if (car (r1) == cell_symbol_quasisyntax)
-        return eval_quasisyntax (cadr (r1), add_unsyntaxers (r0));
+          case cell_symbol_unsyntax: return eval_env (cadr (r1), r0);
+          case cell_symbol_quasisyntax: return eval_quasisyntax (cadr (r1), add_unsyntaxers (r0));
 #endif //QUASISYNTAX
-      SCM x = expand_macro_env (r1, r0);
-      if (x != r1)
-          return eval_env (x, r0);
-      SCM m = evlis_env (CDR (r1), r0);
-      return apply_env (car (r1), m, r0);
+          default: {
+            SCM x = expand_macro_env (r1, r0);
+            if (x != r1) return eval_env (x, r0);
+            SCM m = evlis_env (CDR (r1), r0);
+            return apply_env (car (r1), m, r0);
+          }
+          }
       }
     case SYMBOL: return assert_defined (r1, assq_ref_cache (r1, r0));
     default: return r1;
@@ -1060,7 +1038,6 @@ gc_init_cells ()
   g_cells++;
   g_cells[0].type = CHAR;
   g_cells[0].value = 'c';
-  g_free.value = 1; // 0 is tricky
 }
 
 SCM