core: Move GNUisms inside #if.
authorJan Nieuwenhuizen <janneke@gnu.org>
Wed, 4 Jan 2017 07:16:14 +0000 (08:16 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Wed, 4 Jan 2017 09:52:36 +0000 (10:52 +0100)
* mes.c: Move GNUisms inside #if, add Nyacc #ifs.
 (tmp_num2, tmp_num3): Remove.
 (make_tmps): Update.
 (g_free): Make simple int.  Update users.
* lib.c: Update users.
* build-aux/mes-snarf.scm (GCC?): New switch to enable GNU extensions.

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

index 97499e3954e410cd10364659fe1cfa35024ffd68..06f268aade5b1d9b1714079b53cbbd28e003d3d5 100755 (executable)
@@ -34,6 +34,7 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
              (cut regexp-substitute #f <> 'pre replace 'post))
       string))
 
+(define GCC? #t)
 ;; (define-record-type function (make-function name formals annotation)
 ;;   function?
 ;;   (name .name)
@@ -78,7 +79,7 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
 
 (define (symbol->source s i)
   (string-append
-   (format #f "g_free.value++;\n")
+   (format #f "g_free++;\n")
    (format #f "g_cells[cell_~a] = scm_~a;\n\n" s s)))
 
 (define (symbol->names s i)
@@ -92,28 +93,29 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
          (n (if (eq? arity 'n) -1 arity)))
     (string-append
      (format #f "SCM ~a (~a);\n" (.name f) (.formals f))
-     (format #f "function fun_~a = {.function~a=&~a, .arity=~a};\n" (.name f) arity (.name f) n)
-     (format #f "scm ~a = {FUNCTION, .name=~S, .function=0};\n" (function-builtin-name f) (function-scm-name f))
+     (if GCC?
+         (format #f "function_t fun_~a = {.function~a=&~a, .arity=~a};\n" (.name f) arity (.name f) n)
+         (format #f "function_t fun_~a = {&~a, ~a};\n" (.name f) (.name f) n))
+     (if GCC?
+         (format #f "scm ~a = {FUNCTION, .name=~S, .function=0};\n" (function-builtin-name f) (function-scm-name f))
+         (format #f "scm ~a = {FUNCTION, ~S, 0};\n" (function-builtin-name f) (function-scm-name f)))
      (format #f "SCM cell_~a;\n\n" (.name f)))))
 
 (define (function->source f i)
   (string-append
    (format #f "~a.function = g_function;\n" (function-builtin-name f))
    (format #f "functions[g_function++] = fun_~a;\n" (.name f))
-   (format #f "cell_~a = g_free.value++;\n" (.name f))
+   (format #f "cell_~a = g_free++;\n" (.name f))
    (format #f "g_cells[cell_~a] = ~a;\n\n" (.name f) (function-builtin-name f))))
 
 (define (function->environment f i)
   (string-append
    (format #f "scm_~a.string = cstring_to_list (scm_~a.name);\n" (.name f) (.name f))
    (format #f "g_cells[cell_~a].string = MAKE_STRING (scm_~a.string);\n" (.name f) (.name f))
-   (format #f "a = acons (make_symbol (scm_~a.string), ~a, a);\n" (.name f) (function-cell-name f))
-   ;;(format #f "a = add_environment (a, ~S, ~a);\n" (function-scm-name f) (function-cell-name f))
-   ))
+   (format #f "a = acons (make_symbol (scm_~a.string), ~a, a);\n\n" (.name f) (function-cell-name f))))
 
 (define (snarf-symbols string)
-  (let* ((matches (append (list-matches "\nscm scm_([a-z_0-9]+) = [{](SPECIAL)," string)
-                          (list-matches "\nscm scm_([a-z_0-9]+) = [{](SYMBOL)," string))))
+  (let* ((matches (list-matches "\nscm scm_([a-z_0-9]+) = [{](SPECIAL|SYMBOL)," string)))
     (map (cut match:substring <> 1) matches)))
 
 (define (snarf-functions string)
diff --git a/lib.c b/lib.c
index 8b09cb9bcbec67210507e013c6135fa7d356d25a..eaf26ce35eaa4b7bf9ab6d6967fca3df136044c9 100644 (file)
--- a/lib.c
+++ b/lib.c
@@ -136,7 +136,7 @@ dump ()
   fputc ('S', stdout);
   fputc (g_stack >> 8, stdout);
   fputc (g_stack % 256, stdout);
-  for (int i=0; i<g_free.value * sizeof(scm); i++)
+  for (int i=0; i<g_free * sizeof(scm); i++)
     fputc (*p++, stdout);
   return 0;
 }
@@ -170,7 +170,7 @@ bload_env (SCM a) ///((internal))
       *p++ = c;
       c = getchar ();
     }
-  g_free.value = (p-(char*)g_cells) / sizeof (scm);
+  g_free = (p-(char*)g_cells) / sizeof (scm);
   gc_peek_frame ();
   g_symbols = r1;
   g_stdin = stdin;
diff --git a/mes.c b/mes.c
index 3d7be3e3e9845b56407bf3b0e6f7044e6026721a..aacb340d475fbae99271cd6e4f54d9e2058ae087 100644 (file)
--- a/mes.c
+++ b/mes.c
  */
 
 #define _GNU_SOURCE
+#if __GNUC__
+#define  __NYACC__ 0
+#define NYACC
+#define NYACC2
 #include <assert.h>
 #include <ctype.h>
 #include <errno.h>
 #include <string.h>
 #include <stdlib.h>
 #include <stdbool.h>
+#else
+typedef int bool;
+#define  __NYACC__ 1
+#define NYACC nyacc
+#define NYACC2 nyacc2
+#endif
 
 #define DEBUG 0
 #define FIXED_PRIMITIVES 1
@@ -42,18 +52,18 @@ typedef SCM (*function1_t) (SCM);
 typedef SCM (*function2_t) (SCM, SCM);
 typedef SCM (*function3_t) (SCM, SCM, SCM);
 typedef SCM (*functionn_t) (SCM);
-typedef struct function_t {
+typedef struct function_struct {
   union {
     function0_t function0;
     function1_t function1;
     function2_t function2;
     function3_t function3;
     functionn_t functionn;
-  };
+  } NYACC;
   int arity;
-} function;
-struct scm_t;
-typedef struct scm_t {
+} function_t;
+struct scm;
+typedef struct scm_struct {
   enum type_t type;
   union {
     char const *name;
@@ -61,7 +71,7 @@ typedef struct scm_t {
     SCM car;
     SCM ref;
     int length;
-  };
+  } NYACC;
   union {
     int value;
     int function;
@@ -70,7 +80,7 @@ typedef struct scm_t {
     SCM macro;
     SCM vector;
     int hits;
-  };
+  } NYACC2;
 } scm;
 
 scm scm_nil = {SPECIAL, "()"};
@@ -88,9 +98,8 @@ scm scm_symbol_dot = {SYMBOL, "*dot*"};
 scm scm_symbol_lambda = {SYMBOL, "lambda"};
 scm scm_symbol_begin = {SYMBOL, "begin"};
 scm scm_symbol_if = {SYMBOL, "if"};
-scm scm_symbol_set_x = {SYMBOL, "set!"};
-
 scm scm_symbol_quote = {SYMBOL, "quote"};
+scm scm_symbol_set_x = {SYMBOL, "set!"};
 
 scm scm_symbol_sc_expand = {SYMBOL, "sc-expand"};
 scm scm_symbol_macro_expand = {SYMBOL, "macro-expand"};
@@ -113,7 +122,7 @@ scm scm_symbol_null_p = {SYMBOL, "null?"};
 scm scm_symbol_eq_p = {SYMBOL, "eq?"};
 scm scm_symbol_cons = {SYMBOL, "cons"};
 
-scm g_free = {NUMBER, .value=0};
+int g_free = 0;
 scm *g_cells;
 scm *g_news = 0;
 
@@ -122,10 +131,8 @@ scm *g_news = 0;
 SCM tmp;
 SCM tmp_num;
 SCM tmp_num2;
-SCM tmp_num3;
-SCM tmp_num4;
 
-function functions[200];
+function_t functions[200];
 int g_function = 0;
 
 SCM g_symbols = 0;
@@ -190,9 +197,9 @@ tmp_num2_ (int x)
 SCM
 alloc (int n)
 {
-  assert (g_free.value + n < ARENA_SIZE);
-  SCM x = g_free.value;
-  g_free.value += n;
+  assert (g_free + n < ARENA_SIZE);
+  SCM x = g_free;
+  g_free += n;
   return x;
 }
 
@@ -235,6 +242,18 @@ cdr (SCM x)
   if (TYPE (x) != PAIR) error ("cdr: not pair: ", x);
   return CDR (x);
 }
+SCM
+eq_p (SCM x, SCM y)
+{
+  return (x == y
+          || ((TYPE (x) == KEYWORD && TYPE (y) == KEYWORD
+               && STRING (x) == STRING (y)))
+          || (TYPE (x) == CHAR && TYPE (y) == CHAR
+              && VALUE (x) == VALUE (y))
+          || (TYPE (x) == NUMBER && TYPE (y) == NUMBER
+              && VALUE (x) == VALUE (y)))
+    ? cell_t : cell_f;
+}
 
 SCM
 type_ (SCM x)
@@ -262,19 +281,6 @@ cdr_ (SCM x)
           || TYPE (CDR (x)) == STRING) ? CDR (x) : MAKE_NUMBER (CDR (x));
 }
 
-SCM
-eq_p (SCM x, SCM y)
-{
-  return (x == y
-          || ((TYPE (x) == KEYWORD && TYPE (y) == KEYWORD
-               && STRING (x) == STRING (y)))
-          || (TYPE (x) == CHAR && TYPE (y) == CHAR
-              && VALUE (x) == VALUE (y))
-          || (TYPE (x) == NUMBER && TYPE (y) == NUMBER
-              && VALUE (x) == VALUE (y)))
-    ? cell_t : cell_f;
-}
-
 SCM
 set_car_x (SCM x, SCM e)
 {
@@ -576,7 +582,7 @@ vm_call (function0_t f, SCM p1, SCM a)
   gc_push_frame ();
   r1 = p1;
   r0 = a;
-  if (g_free.value + GC_SAFETY > ARENA_SIZE)
+  if (g_free + GC_SAFETY > ARENA_SIZE)
     gc_pop_frame (gc (gc_push_frame ()));
 
   SCM r = f ();
@@ -770,16 +776,12 @@ vector_to_list (SCM v)
 void
 make_tmps (scm* cells)
 {
-  tmp = g_free.value++;
+  tmp = g_free++;
   cells[tmp].type = CHAR;
-  tmp_num = g_free.value++;
+  tmp_num = g_free++;
   cells[tmp_num].type = NUMBER;
-  tmp_num2 = g_free.value++;
+  tmp_num2 = g_free++;
   cells[tmp_num2].type = NUMBER;
-  tmp_num3 = g_free.value++;
-  cells[tmp_num3].type = NUMBER;
-  tmp_num4 = g_free.value++;
-  cells[tmp_num4].type = NUMBER;
 }
 
 //\f Jam Collector
@@ -791,7 +793,7 @@ gc_up_arena ()
 {
   ARENA_SIZE *= 2;
   void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(scm));
-  if (!p) error (strerror (errno), MAKE_NUMBER (g_free.value));
+  if (!p) error (strerror (errno), MAKE_NUMBER (g_free));
   g_cells = (scm*)p;
   g_cells++;
   gc_init_news ();
@@ -800,10 +802,10 @@ gc_up_arena ()
 SCM
 gc ()
 {
-  if (g_debug) fprintf (stderr, "***gc[%d]...", g_free.value);
-  g_free.value = 1;
+  if (g_debug) fprintf (stderr, "***gc[%d]...", g_free);
+  g_free = 1;
   if (g_cells < g_news && ARENA_SIZE < MAX_ARENA_SIZE) gc_up_arena ();
-  for (int i=g_free.value; i<g_symbol_max; i++)
+  for (int i=g_free; i<g_symbol_max; i++)
     gc_copy (i);
   make_tmps (g_news);
   g_symbols = gc_copy (g_symbols);
@@ -816,7 +818,7 @@ gc ()
 SCM
 gc_loop (SCM scan)
 {
-  while (scan < g_free.value)
+  while (scan < g_free)
     {
       if (NTYPE (scan) == CLOSURE
           || NTYPE (scan) == FUNCTION
@@ -850,13 +852,13 @@ SCM
 gc_copy (SCM old)
 {
   if (TYPE (old) == BROKEN_HEART) return g_cells[old].car;
-  SCM new = g_free.value++;
+  SCM new = g_free++;
   g_news[new] = g_cells[old];
   if (NTYPE (new) == VECTOR)
     {
-      g_news[new].vector = g_free.value;
+      g_news[new].vector = g_free;
       for (int i=0; i<LENGTH (old); i++)
-        g_news[g_free.value++] = g_cells[VECTOR (old)+i];
+        g_news[g_free++] = g_cells[VECTOR (old)+i];
     }
   g_cells[old].type = BROKEN_HEART;
   g_cells[old].car = new;
@@ -883,7 +885,7 @@ gc_flip ()
   scm *cells = g_cells;
   g_cells = g_news;
   g_news = cells;
-  if (g_debug) fprintf (stderr, " => jam[%d]\n", g_free.value);
+  if (g_debug) fprintf (stderr, " => jam[%d]\n", g_free);
   return g_stack;
 }
 
@@ -926,7 +928,7 @@ mes_symbols () ///((internal))
 
 #include "mes.symbols.i"
 
-  g_symbol_max = g_free.value;
+  g_symbol_max = g_free;
   make_tmps (g_cells);
 
   g_symbols = 0;
@@ -1012,10 +1014,13 @@ FILE *g_stdin;
 int
 main (int argc, char *argv[])
 {
+#if __GNUC__
   g_debug = getenv ("MES_DEBUG");
+#else
+#endif
   if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
   if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE");
-  if (argc > 1 && !strcmp (argv[1], "--version")) return puts ("Mes " VERSION);
+  if (argc > 1 && !strcmp (argv[1], "--version")) {puts ("Mes ");puts (VERSION);return 0;};
   g_stdin = stdin;
   r0 = mes_environment ();
   SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
@@ -1029,6 +1034,9 @@ main (int argc, char *argv[])
   stderr_ (begin_env (program, r0));
   fputs ("", stderr);
   gc (g_stack);
-  if (g_debug) fprintf (stderr, "\nstats: [%d]\n", g_free.value);
+#if __GNUC__
+  if (g_debug) fprintf (stderr, "\nstats: [%d]\n", g_free);
+#else
+#endif
   return 0;
 }