build: Cleanup, use gcc-specific snarfing.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 2 Apr 2017 15:01:22 +0000 (17:01 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 2 Apr 2017 15:01:22 +0000 (17:01 +0200)
* .gitignore: Ignore *.o-32, mes-mini-mes.
* scripts/nyacc-calc.mes: Remove.
* scripts/nyacc.mes: Remove.
* scripts/paren.mes: Remove.
* make/install.make (install): Remove them.
p* module/mes/mes-0.mes: Remove.
* module/mes/loop-0.mes: Remove.
* build-aux/mes-snarf.scm (main): Add --mini option.
* GNUmakefile (mini-mes): Use it.

23 files changed:
.gitignore
GNUmakefile
build-aux/mes-snarf.scm
doc/examples/main.c
lib.c
make/install.make
mes.c
module/language/c99/compiler.mes
module/mes/guile.mes
module/mes/libc.mes
module/mes/loop-0.mes [deleted file]
module/mes/mes-0.mes [deleted file]
module/mes/repl.mes
posix.c
scaffold/mini-mes.c
scaffold/tiny-mes.c
scripts/elf.mes [deleted file]
scripts/include.mes [deleted file]
scripts/mescc.mes
scripts/nyacc-calc.mes [deleted file]
scripts/nyacc.mes [deleted file]
scripts/paren.mes [deleted file]
scripts/repl.mes

index 76c911a8de636e88aeb41071b53bb17a83300f45..237a4360f695fc3d64377a38d0b65093c2e64031 100644 (file)
@@ -5,6 +5,7 @@
 *.h
 *.i
 *.o
+*.o-32
 *.symbols.i
 *~
 .#*
@@ -33,6 +34,8 @@
 /guile-t
 /guile-tiny-mes
 
+/mes-mini-mes
+
 /module/mes/tiny-0-32.mo
 #keep this: bootstrap
 #/module/mes/read-0-32.mo
index f14c522d393f740b6c83944accecdb020ef456d2..af7a51bb21d792b47b5a5fc62275ebc86158cbe2 100644 (file)
@@ -26,20 +26,21 @@ endif
 
 -include .local.make
 
-all: mes module/mes/read-0.mo
-
-mes.o: GNUmakefile
-mes.o: mes.c
-mes.o: mes.c mes.h mes.i mes.environment.i mes.symbols.i
-mes.o: lib.c lib.h lib.i lib.environment.i
-mes.o: math.c math.h math.i math.environment.i
-mes.o: posix.c posix.h posix.i posix.environment.i
-mes.o: reader.c reader.h reader.i reader.environment.i
-mes.o: gc.c gc.h gc.i gc.environment.i
-mes.o: vector.c vector.h vector.i vector.environment.i
+all: mes module/mes/read-0.mo module/mes/read-0-32.mo
+
+S:=
+mes.o$(S): GNUmakefile
+mes.o$(S): mes.c
+mes.o$(S): mes.c mes.h mes.i mes.environment.i mes.symbols.i
+mes.o$(S): lib.c lib.h lib.i lib.environment.i
+mes.o$(S): math.c math.h math.i math.environment.i
+mes.o$(S): posix.c posix.h posix.i posix.environment.i
+mes.o$(S): reader.c reader.h reader.i reader.environment.i
+mes.o$(S): gc.c gc.h gc.i gc.environment.i
+mes.o$(S): vector.c vector.h vector.i vector.environment.i
 
 clean:
-       rm -f mes *.o *.environment.i *.symbols.i *.environment.h *.cat a.out
+       rm -f mes *.o *.o-32 *.environment.i *.symbols.i *.environment.h *.cat a.out
        rm -f mes-32
        rm -f cons-mes m main micro-mes mini-mes t tiny-mes
        rm -f guile-cons-mes guile-m guile-main guile-micro-mes guile-mini-mes guile-t guile-tiny-mes
@@ -90,23 +91,27 @@ MES_DEBUG:=1
 mes-check: all
        set -e; for i in $(TESTS); do ./$$i; done
 
-mes-check-nyacc: all
-       scripts/nyacc.mes
-       scripts/nyacc-calc.mes
+mini-mes-check: all mini-mes
+       $(MAKE) mes-check MES=./mini-mes
 
 module/mes/read-0.mo: module/mes/read-0.mes mes 
        ./mes --dump < $< > $@
 
 dump: module/mes/read-0.mo
 
-mes-32: gc.c lib.c math.c posix.c vector.c
-mes-32: mes.c lib.c
-       rm -f mes mes.o
-       guix environment --system=i686-linux --ad-hoc gcc-toolchain -- bash -c 'make mes CC=i686-unknown-linux-gnu-gcc LIBRARY_PATH=$${PATH%%/bin:*}/lib'
-       rm -f mes.o
-       mv mes mes-32
+mes.o$(S): mes.c
+       $(CC) $(CPPFLAGS) $(CFLAGS) -c -o $@ $<
+
+mes$(S): mes.o$(S)
+       $(CC) $(CFLAGS) $(LDFLAGS) $< -o $@
+
+mes$(S)-32: GNUmakefile
+mes$(S)-32: mes.c gc.c lib.c math.c posix.c vector.c
+       guix environment --system=i686-linux --ad-hoc gcc-toolchain -- bash -c 'make mes-32 S=-32 CC=i686-unknown-linux-gnu-gcc LIBRARY_PATH=$${PATH%%/bin:*}/lib'
 
-module/mes/read-0-32.mo: module/mes/read-0.mes mes-32
+module/mes/read-0-32.mo: module/mes/read-0.mes
+module/mes/read-0-32.mo: module/mes/read-0.mo
+module/mes/read-0-32.mo: mes-32
        MES_MINI=1 ./mes-32 --dump < $< > $@
 
 module/mes/tiny-0-32.mo: module/mes/tiny-0.mes mes-32
@@ -116,7 +121,6 @@ guile-check:
        set -e; for i in $(TESTS); do\
                $(GUILE) -s <(cat $(MES-0) module/mes/test.mes $$i);\
        done
-       guile/nyacc-calc.scm
 
 t-check: t
        ./t
@@ -127,33 +131,51 @@ mescc-check: t-check
        chmod +x a.out
        ./a.out
 
-%.h %.i %.environment.i %.symbols.i: scaffold/%.c build-aux/mes-snarf.scm
-       build-aux/mes-snarf.scm $<
+%.h %.i %.environment.i %.symbols.i: scaffold/%.c build-aux/mes-snarf.scm GNUmakefile
+       build-aux/mes-snarf.scm --mini $<
+
+mini-%.h mini-%.i mini-%.environment.i mini-%.symbols.i: %.c build-aux/mes-snarf.scm GNUmakefile
+       build-aux/mes-snarf.scm --mini $<
+
+mini-mes.h mini-mes.i mini-mes.environment.i mini-mes.symbols.i: scaffold/mini-mes.c build-aux/mes-snarf.scm GNUmakefile
+       build-aux/mes-snarf.scm --mini $<
 
 mini-mes: mini-mes.h mini-mes.i mini-mes.environment.i mini-mes.symbols.i
-mini-mes: vector.c
-mini-mes: gc.c
+mini-mes: gc.c mini-gc.h mini-gc.i mini-gc.environment.i
+mini-mes: vector.c mini-vector.h mini-vector.i mini-vector.environment.i
 mini-mes: mlibc.c mstart.c
 mini-mes: GNUmakefile
 mini-mes: module/mes/read-0-32.mo
 mini-mes: scaffold/mini-mes.c
        rm -f $@
-       #       gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DPREFIX=' '-DVERSION='"$(VERSION)"' $<
-       gcc -nostdlib -I. --std=gnu99 -m32 -g -I. -o $@ $(CPPFLAGS) $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
        rm -f mes.o
        chmod +x $@
 
 guile-mini-mes: mini-mes.h mini-mes.i mini-mes.environment.i mini-mes.symbols.i
-guile-mini-mes: vector.c
+guile-mini-mes: gc.c mini-gc.h mini-gc.i mini-gc.environment.i
+guile-mini-mes: vector.c mini-vector.h mini-vector.i mini-vector.environment.i
+guile-mini-mes: mlibc.c mstart.c
+guile-mini-mes: GNUmakefile
 guile-mini-mes: module/mes/read-0-32.mo
 guile-mini-mes: scaffold/mini-mes.c
        guile/mescc.scm $< > $@ || rm -f $@
        chmod +x $@
 
+mes-mini-mes: mini-mes.h mini-mes.i mini-mes.environment.i mini-mes.symbols.i
+mes-mini-mes: gc.c mini-gc.h mini-gc.i mini-gc.environment.i
+mes-mini-mes: vector.c mini-vector.h mini-vector.i mini-vector.environment.i
+mes-mini-mes: mlibc.c mstart.c
+mes-mini-mes: GNUmakefile
+mes-mini-mes: module/mes/read-0-32.mo
+mes-mini-mes: scaffold/mini-mes.c
+       MES_FLAGS= MES_DEBUG=1 scripts/mescc.mes $< > $@ || rm -f $@
+       chmod +x $@
+
 cons-mes: module/mes/tiny-0-32.mo
 cons-mes: scaffold/cons-mes.c GNUmakefile
        rm -f $@
-       gcc -nostdlib -I. --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
        chmod +x $@
 
 guile-cons-mes: module/mes/tiny-0-32.mo
@@ -164,7 +186,7 @@ guile-cons-mes: scaffold/cons-mes.c
 tiny-mes: module/mes/tiny-0-32.mo
 tiny-mes: scaffold/tiny-mes.c GNUmakefile
        rm -f $@
-       gcc -nostdlib -I. --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
        chmod +x $@
 
 guile-tiny-mes: module/mes/tiny-0-32.mo
@@ -174,8 +196,8 @@ guile-tiny-mes: scaffold/tiny-mes.c
 
 m: scaffold/m.c GNUmakefile
        rm -f $@
-       gcc -nostdlib -I. --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<
-#      gcc --std=gnu99 -g -o $@ '-DVERSION="0.4"' $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
+#      gcc --std=gnu99 -g -o $@ $(CPPFLAGS) $<
        chmod +x $@
 
 guile-m: scaffold/m.c
@@ -184,7 +206,7 @@ guile-m: scaffold/m.c
 
 malloc: scaffold/malloc.c GNUmakefile
        rm -f $@
-       gcc -nostdlib -I. --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
        chmod +x $@
 
 guile-malloc: scaffold/malloc.c
@@ -193,7 +215,7 @@ guile-malloc: scaffold/malloc.c
 
 micro-mes: scaffold/micro-mes.c GNUmakefile
        rm -f $@
-       gcc -nostdlib -I. --std=gnu99 -m32 -o $@ '-DVERSION="0.4"' $<
+       gcc -nostdlib --std=gnu99 -m32 -o $@ $(CPPFLAGS) $<
        chmod +x $@
 
 guile-micro-mes: scaffold/micro-mes.c
@@ -202,7 +224,7 @@ guile-micro-mes: scaffold/micro-mes.c
 
 main: doc/examples/main.c GNUmakefile
        rm -f $@
-       gcc -nostdlib -I. --std=gnu99 -m32 -o $@ '-DVERSION="0.4"' $<
+       gcc -nostdlib --std=gnu99 -m32 -o $@ $(CPPFLAGS) $<
        chmod +x $@
 
 guile-main: doc/examples/main.c
@@ -212,7 +234,7 @@ guile-main: doc/examples/main.c
 t: mlibc.c
 t: scaffold/t.c GNUmakefile
        rm -f $@
-       gcc -nostdlib -I. --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
        chmod +x $@
 
 guile-t: scaffold/t.c
@@ -231,9 +253,6 @@ guile-mescc: $(MAIN_C)
        chmod +x a.out
        ./a.out; r=$$?; [ $$r = 42 ]
 
-paren: all
-       scripts/paren.mes
-
 GUILE_GIT:=$(HOME)/src/guile-1.8
 GUILE_COMMIT:=ba8a709
 psyntax-import: module/mes/psyntax.ss module/mes/psyntax.pp
index 05215a2a56d91add81afaed1a40ec77853c6ca5c..9bebfa974280b7fe6c3761690c879a2e6cc8b5e3 100755 (executable)
@@ -4,7 +4,7 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
 !#
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; mes-snarf.scm: This file is part of Mes.
 ;;;
@@ -34,7 +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? #f)
+(define %gcc? #t)
 ;; (define-record-type function (make-function name formals annotation)
 ;;   function?
 ;;   (name .name)
@@ -84,7 +84,7 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
    (format #f "g_cells[cell_~a] = scm_~a;\n\n" s s)))
 
 (define (symbol->names s i)
-  (if GCC?
+  (if %gcc?
       (format #f "g_cells[cell_~a].car = cstring_to_list (scm_~a.name);\n" s s)
       (format #f "g_cells[cell_~a].car = cstring_to_list (scm_~a.car);\n" s s)))
 
@@ -95,17 +95,17 @@ 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))
-     (if GCC?
+     (if %gcc?
          (format #f "struct function fun_~a = {.function~a=&~a, .arity=~a, .name=~s};\n" (.name f) arity (.name f) n (function-scm-name f))
          (format #f "struct function fun_~a = {&~a, ~a, ~s};\n" (.name f) (.name f) n (function-scm-name f)))
-     (if GCC?
+     (if %gcc?
          (format #f "struct scm ~a = {TFUNCTION, .name=0, .function=0};\n" (function-builtin-name f))
          (format #f "struct scm ~a = {TFUNCTION, 0, 0};\n" (function-builtin-name f)))
      (format #f "SCM cell_~a;\n\n" (.name f)))))
 
 (define (function->source f i)
   (string-append
-   (if GCC?
+   (if %gcc?
        (format #f "~a.function = g_function;\n" (function-builtin-name f))
        (format #f "~a.cdr = g_function;\n" (function-builtin-name f)))
    (format #f "g_functions[g_function++] = fun_~a;\n" (.name f))
@@ -114,13 +114,13 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
 
 (define (function->environment f i)
   (string-append
-   (if GCC?
+   (if %gcc?
        (format #f "scm_~a.string = cstring_to_list (fun_~a.name);\n" (.name f) (.name f))
        (format #f "scm_~a.car = cstring_to_list (fun_~a.name);\n" (.name f) (.name f)))
-   (if GCC?
+   (if %gcc?
        (format #f "g_cells[cell_~a].string = MAKE_STRING (scm_~a.string);\n" (.name f) (.name f))
        (format #f "g_cells[cell_~a].car = MAKE_STRING (scm_~a.car);\n" (.name f) (.name f)))
-   (if GCC?
+   (if %gcc?
        (format #f "a = acons (lookup_symbol_ (scm_~a.string), ~a, a);\n\n" (.name f) (function-cell-name f))
        (format #f "a = acons (lookup_symbol_ (scm_~a.car), ~a, a);\n\n" (.name f) (function-cell-name f)))))
 
@@ -155,6 +155,8 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
          (functions (filter (negate internal?) functions))
          (symbols (snarf-symbols string))
          (base-name (basename file-name ".c"))
+         (base-name (if (or %gcc? (string-prefix? "mini-" base-name)) base-name
+                        (string-append "mini-" base-name)))
          (header (make <file>
                    #:name (string-append base-name ".h")
                    #:content (string-join (map function->header functions (iota (length functions) (+ %start (length symbols)))) "")))
@@ -179,7 +181,9 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
   (with-output-to-file (.name file) (lambda () (display (.content file)))))
 
 (define (main args)
-  (let* ((files (cdr args)))
+  (let* ((files (if (not (and (pair? (cdr args)) (equal? (cadr args) "--mini"))) (cdr args)
+                    (begin (set! %gcc? #f)
+                           (cddr args)))))
     (map file-write (filter content? (append-map generate-includes files)))))
 
 ;;(define string (with-input-from-file "../mes.c" read-string))
index 483496c63bf50f3b1d7bcd9306831bfac574c428..8082efb6a197057f8683a31527f896cc14da9b0c 100644 (file)
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-#if __GNUC__
-#include "mlibc.c"
-#endif
+#define GNU 0
+// #if __GNUC__
+// #include "mlibc.c"
+// #endif
 
 int
 //main ()
 main (int argc, char *argv[])
 {
-  puts ("Hi Mes!\n");
-  if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("argc > 1 && --help\n");
+  //puts ("Hi Mes!\n");
+  //if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("argc > 1 && --help\n");
+  if (argc > 1) return argc;
   return 42;
 }
 
-#if __GNUC__
-#include "mstart.c"
-#endif
+// #if __GNUC__
+// #include "mstart.c"
+// #endif
diff --git a/lib.c b/lib.c
index b458e56105596b49eaa9080f2c26a11a894766cd..5d33bb87f14245b6dcad746ecb7ea8f5ed5962bd 100644 (file)
--- a/lib.c
+++ b/lib.c
@@ -54,7 +54,7 @@ display_helper (SCM x, int cont, char* sep, FILE *fd)
     case TFUNCTION:
       {
         fputs ("#<procedure ", fd);
-        char *p = "?";
+        char const *p = "?";
         if (FUNCTION (x).name != 0)
           p = FUNCTION (x).name;
         fputs (p, fd);
@@ -329,11 +329,11 @@ SCM
 load_env (SCM a) ///((internal))
 {
   r0 = a;
-  g_stdin = fopen ("module/mes/read-0.mes", "r");
-  g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mes", "r");
+  g_stdin = open ("module/mes/read-0.mes", O_RDONLY);
+  g_stdin = g_stdin ? g_stdin : open (PREFIX "module/mes/read-0.mes", O_RDONLY);
   if (!g_function) r0 = mes_builtins (r0);
   r2 = read_input_file_env (r0);
-  g_stdin = stdin;
+  g_stdin = STDIN;
   return r2;
 }
 
@@ -341,10 +341,10 @@ SCM
 bload_env (SCM a) ///((internal))
 {
 #if MES_MINI
-  g_stdin = fopen ("module/mes/read-0-32.mo", "r");
+  g_stdin = fopen ("module/mes/read-0-32.mo", O_RDONLY);
 #else
-  g_stdin = fopen ("module/mes/read-0.mo", "r");
-  g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mo", "r");
+  g_stdin = open ("module/mes/read-0.mo", O_RDONLY);
+  g_stdin = g_stdin ? g_stdin : open (PREFIX "module/mes/read-0.mo", O_RDONLY);
 #endif
 
   char *p = (char*)g_cells;
@@ -362,7 +362,7 @@ bload_env (SCM a) ///((internal))
   g_free = (p-(char*)g_cells) / sizeof (struct scm);
   gc_peek_frame ();
   g_symbols = r1;
-  g_stdin = stdin;
+  g_stdin = STDIN;
   r0 = mes_builtins (r0);
   return r2;
 }
index c1b5d9491ecfd1a3dc8bcd763684b5eb682b0b93..44616cc8ce1ec740d3f2c4cc33b3b537187146d5 100644 (file)
@@ -45,25 +45,16 @@ ChangeLog:
 install: all ChangeLog
        mkdir -p $(DESTDIR)$(PREFIX)/bin
        install mes $(DESTDIR)$(PREFIX)/bin/mes
-       install scripts/elf.mes $(DESTDIR)$(PREFIX)/bin/elf.mes
-       install scripts/include.mes $(DESTDIR)$(PREFIX)/bin/include.mes
        install scripts/mescc.mes $(DESTDIR)$(PREFIX)/bin/mescc.mes
-       install scripts/mescc.mes $(DESTDIR)$(PREFIX)/bin/nyacc.mes
-       install scripts/mescc.mes $(DESTDIR)$(PREFIX)/bin/nyacc-calc.mes
        install scripts/repl.mes $(DESTDIR)$(PREFIX)/bin/repl.mes
-       install scripts/paren.mes $(DESTDIR)$(PREFIX)/bin/paren.mes
        mkdir -p $(DESTDIR)$(PREFIX)/share/mes
        $(GIT_ARCHIVE_HEAD) module\
                | tar -C $(DESTDIR)$(PREFIX)/share/mes -xf-
        cp module/mes/read-0.mo $(DESTDIR)$(PREFIX)/share/mes/module/mes
        sed -i -e 's@module/@$(PREFIX)/share/mes/module/@' \
                $(DESTDIR)$(PREFIX)/share/mes/module/mes/base-0.mes \
-               $(DESTDIR)$(PREFIX)/bin/elf.mes \
                $(DESTDIR)$(PREFIX)/bin/mescc.mes \
-               $(DESTDIR)$(PREFIX)/bin/nyacc.mes \
-               $(DESTDIR)$(PREFIX)/bin/nyacc-calc.mes \
                $(DESTDIR)$(PREFIX)/bin/repl.mes \
-               $(DESTDIR)$(PREFIX)/bin/paren.mes
        mkdir -p $(DESTDIR)$(PREFIX)/share/doc/mes
        $(GIT_ARCHIVE_HEAD) $(READMES) \
                | tar -C $(DESTDIR)$(PREFIX)/share/doc/mes -xf-
diff --git a/mes.c b/mes.c
index 8d27985361d25e8b6a886b3244a251f1d37ada00..43c48e732d8f1bd37023605a299e717819c63156 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -425,6 +425,8 @@ length (SCM x)
   return MAKE_NUMBER (n);
 }
 
+SCM apply (SCM, SCM, SCM);
+
 SCM
 error (SCM key, SCM x)
 {
@@ -519,6 +521,8 @@ set_cdr_x (SCM x, SCM e)
   return cell_unspecified;
 }
 
+SCM assert_defined (SCM, SCM);
+
 SCM
 set_env_x (SCM x, SCM e, SCM a)
 {
@@ -551,18 +555,11 @@ lookup_macro_ (SCM x, SCM a) ///((internal))
   return cell_f;
 }
 
-SCM
-push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
-{
-  SCM x = r3;
-  r3 = c;
-  r2 = p2;
-  gc_push_frame ();
-  r1 = p1;
-  r0 = a;
-  r3 = x;
-  return cell_unspecified;
-}
+SCM check_apply (SCM, SCM);
+SCM check_formals (SCM, SCM, SCM);
+SCM push_cc (SCM, SCM, SCM, SCM);
+SCM gc_pop_frame ();
+SCM gc_push_frame ();
 
 SCM
 eval_apply ()
@@ -919,6 +916,19 @@ gc_push_frame () ///((internal))
   return g_stack = cons (frame, g_stack);
 }
 
+SCM
+push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
+{
+  SCM x = r3;
+  r3 = c;
+  r2 = p2;
+  gc_push_frame ();
+  r1 = p1;
+  r0 = a;
+  r3 = x;
+  return cell_unspecified;
+}
+
 SCM
 apply (SCM f, SCM x, SCM a) ///((internal))
 {
@@ -1066,7 +1076,7 @@ mes_environment () ///((internal))
   return mes_g_stack (a);
 }
 
-FILE *g_stdin;
+int g_stdin;
 #include "math.c"
 #include "posix.c"
 #include "lib.c"
@@ -1083,7 +1093,7 @@ main (int argc, char *argv[])
   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")) {puts ("Mes ");puts (VERSION);return 0;};
-  g_stdin = stdin;
+  g_stdin = STDIN;
   r0 = mes_environment ();
 
   SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
index 201c7793a663cfc11695ac57eb70eaf4467198e1..02c6e28d784dc2edb20d486df6d97f10e1bdf3f1 100644 (file)
@@ -30,9 +30,9 @@
   (set-port-encoding! (current-output-port) "ISO-8859-1"))
  (guile)
  (mes
+  (mes-use-module (mes pmatch))
   (mes-use-module (nyacc lang c99 parser))
   (mes-use-module (mes elf-util))
-  (mes-use-module (mes pmatch))
   (mes-use-module (mes elf))
   (mes-use-module (mes as-i386))
   (mes-use-module (mes libc))
@@ -46,8 +46,6 @@
 (define (stderr string . rest)
   (apply logf (cons* (current-error-port) string rest)))
 
-(define (gnuc-xdef? name mode) (if (equal? name "__GNUC__") #f (eq? mode 'code)))
-
 (define (mescc)
   (parse-c99
    #:inc-dirs (string-split (getenv "C_INCLUDE_PATH") #\:)
@@ -67,9 +65,7 @@
                 "VERSION=\"0.4\""
                 "PREFIX=\"\""
                 )
-   #:xdef? gnuc-xdef?
-   #:mode 'code
-   ))
+   #:mode 'code))
 
 (define (write-any x)
   (write-char (cond ((char? x) x)
                 (count (length fields))
                 (field-size 4) ;; FIXME:4, not fixed
                 (rest (or (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))
-                          barf
-                          '()))
+                          (begin
+                            (stderr "no field:~a\n" field)
+                           '())))
                 (offset (* field-size (1- (length rest))))
                 (text (.text info)))
            (clone info #:text
 
         ;; ++i
         ((expr-stmt (pre-inc (p-expr (ident ,name))))
-         (or (assoc-ref locals name) barf)
+         (or (assoc-ref locals name) (begin (stderr "++i ~a\n" name) barf))
          (clone info #:text
                 (append text
                         ((ident-add info) name 1)
 
         ;; i--
         ((expr-stmt (post-dec (p-expr (ident ,name))))
-         (or (assoc-ref locals name) barf)
+         (or (assoc-ref locals name) (begin (stderr "i-- ~a\n" name) barf))
          (clone info #:text
                 (append text
                         ((ident->accu info) name)
 
         ;; --i
         ((expr-stmt (pre-dec (p-expr (ident ,name))))
-         (or (assoc-ref locals name) barf)
+         (or (assoc-ref locals name) (begin (stderr "--i ~a\n" name) barf))
          (clone info #:text
                 (append text
                         ((ident-add info) name -1)
 
 (define (function->info info)
   (lambda (o)
-    ;;(stderr "\n")
-    ;;(stderr "formals=~a\n" (.formals o))
+    ;;(stderr "function->info o=~s\n" o)
+    ;;(stderr "formals=~s\n" (.formals o))
     (let* ((name (.name o))
-           (text (formals->text (.formals o)))
-           (locals (formals->locals (.formals o))))
-      (format (current-error-port) "compiling ~a\n" name)
-      ;;(stderr "locals=~a\n" locals)
+           (formals (.formals o))
+           (text (formals->text formals))
+           (locals (formals->locals formals)))
+      (format (current-error-port) "compiling ~s\n" name)
+      ;;(stderr "locals=~s\n" locals)
       (let loop ((statements (.statements o))
                  (info (clone info #:locals locals #:function (.name o) #:text text)))
         (if (null? statements) (clone info
           (loop (cdr elements) ((ast->info info) (car elements)))))))
 
 (define (compile)
+  (stderr "COMPILE\n")
   (let* ((ast (mescc))
          (info (make <info>
                  #:functions i386:libc
index 55d2dd2acdf7eda2a2d7b0f11494c3a477aee956..a0e0ac0dcd42f9ce3725e1e4e2393cc543dfbfa3 100644 (file)
@@ -67,7 +67,7 @@
 (define (with-input-from-file file thunk)
   (let ((port (open-input-file file)))
     (if (= port -1)
-        (begin (display "no such file:") (display file) (newline))
+        (error 'no-such-file file)
         (let* ((save (current-input-port))
                (foo (set-current-input-port port))
                (r (thunk)))
index 688a0f3bc94baac85fe1b6c9232a75c7dbb61d56..c6c95015adcb2d4ece76f2d81ae29e374280c4cd 100644 (file)
@@ -56,18 +56,6 @@ strlen (char const* s)
 (define getchar
   (let* ((ast (with-input-from-string
                   "
-#if 0
-int
-getchar ()
-{
-  char c;
-  int r = read (g_stdin, &c, 1);
-  //int r = read (0, &c, 1);
-  if (r < 1) return -1;
-  return c;
-}
-#endif
-
 int g_stdin = 0;
 int ungetc_char = -1;
 char ungetc_buf[2];
@@ -92,12 +80,6 @@ getchar ()
     }
   if (i < 0) i += 256;
 
-#if 0
-  puts (\"get: \");
-  putchar (i);
-  puts (\"\n\");
-#endif
-
   return i;
 }
 "
@@ -127,13 +109,13 @@ assert_fail (char* s)
 (define ungetc
   (let* ((ast (with-input-from-string
 "
-#define assert(x) ((x) ? (void)0 : assert_fail (#x))
+//#define assert(x) ((x) ? (void)0 : assert_fail (#x))
 int
 ungetc (int c, int fd)
 {
   //FIXME
   //assert (ungetc_char < 2);
-  assert (ungetc_char == -1 || ungetc_char < 2);
+  //assert (ungetc_char == -1 || ungetc_char < 2);
   //FIXME
   //ungetc_buf[++ungetc_char] = c;
   ungetc_char++;
@@ -337,6 +319,7 @@ realloc (int *p, int size)
    puts
    strcmp
    itoa
-   isdigit
-   malloc
-   realloc))
+   ;; isdigit
+   ;; malloc
+   ;; realloc
+   ))
diff --git a/module/mes/loop-0.mes b/module/mes/loop-0.mes
deleted file mode 100644 (file)
index 2591295..0000000
+++ /dev/null
@@ -1,75 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; loop-0.mes - bootstrap into Scheme from minimal -DBOOT=1 core.
-
-;;; When compiling mes.c with -DBOOT=1, eval/apply et al. are lacking
-;;; features wrt the fat-c variant, e.g., define and define-macro are
-;;; not available; instead label is supplied.  Before loading
-;;; boot-0.mes, loop-0.mes is loaded to provide a richer eval/apply.
-
-;;; This might enable moving more functionality from C to Scheme,
-;;; making the entirely-from-source bootstrap process more feasible.
-;;; However, currently performance is 400x worse.  Also several tests
-;;; in the test suite fail and the REPL does not work yet.
-
-;;; Code:
-
-((label loop-0
-        (lambda (r e a)
-          ;; (display "***LOOP-0*** ... e=") (display e) (newline)
-          (if (null? e) (eval-env (cons 'begin (read-input-file-env (read-env a) a)) a)
-              (if (atom? e) (loop-0 (eval-env e a) (read-env a) a)
-                  (if (eq? (car e) 'define)
-                      ((lambda (aa)     ; env:define
-                         ;; (display "0DEFINE name=") (display (cadr e)) (newline)
-                         (set-cdr! aa (cdr a))
-                         (set-cdr! a aa)
-                         (set-cdr! (assq '*closure* a) a)
-                         (loop-0 *unspecified* (read-env a) a))
-                       (cons            ; sexp:define
-                        (if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a))
-                            (cons (caadr e) (eval-env (cons 'lambda (cons (cdadr e) (cddr e))) a)))
-                        '()))
-                      (if (eq? (car e) 'define-macro)
-                          ((lambda (name+entry) ; env:macro
-                             ;; (display "0MACRO name=") (display (car name+entry)) (newline)
-                             ((lambda (aa) ; env:define
-                                (set-cdr! aa (cdr a))
-                                (set-cdr! a aa)
-                                (set-cdr! (assq '*closure* a) a)
-                                (loop-0 *unspecified* (read-env a) a))
-                              (cons
-                               (cons (car name+entry)
-                                     (make-macro (car name+entry)
-                                                 (cdr name+entry)))
-                               '())))
-                                        ; sexp:define
-                           (if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a))
-                               (cons (caadr e) (eval-env (cons 'lambda (cons (cdadr e) (cddr e))) a)))
-                           '())
-                          (loop-0 (eval-env e a) (read-env a) a)))))))
- *unspecified* (read-env '()) (current-module))
-
-()
-;; enter reading loop-0
-(display "loop-0 ...\n")
diff --git a/module/mes/mes-0.mes b/module/mes/mes-0.mes
deleted file mode 100644 (file)
index 166fa9d..0000000
+++ /dev/null
@@ -1,184 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; mes-0.mes - bootstrap into Scheme, re
-
-;;; When compiling mes.c with -DBOOT=1, eval/apply et al. are lacking
-;;; features wrt the fat-c variant, e.g., define and define-macro are
-;;; not available; instead label is supplied.  Before loading
-;;; boot-0.mes, loop-0.mes is loaded to provide a richer eval/apply.
-
-;;; This might enable moving more functionality from C to Scheme,
-;;; making the entirely-from-source bootstrap process more feasible.
-;;; However, currently performance is 400x worse.  Also several tests
-;;; in the test suite fail and the REPL does not work yet.
-
-;;; Code:
-
-(define-macro (cond . clauses)
-  (list 'if (null? clauses) *unspecified*
-        (if (null? (cdr clauses))
-            (list 'if (car (car clauses))
-                  (list (cons 'lambda (cons '() (cons (car (car clauses)) (cdr (car clauses))))))
-                  *unspecified*)
-            (if (eq? (car (cadr clauses)) 'else)
-                (list 'if (car (car clauses))
-                      (list (cons 'lambda (cons '() (car clauses))))
-                      (list (cons 'lambda (cons '() (cons *unspecified* (cdr (cadr clauses)))))))
-                (list 'if (car (car clauses))
-                      (list (cons 'lambda (cons '() (car clauses))))
-                      (cons 'cond (cdr clauses)))))))
-
-(define (map f l . r)
-  (if (null? l) '()
-      (if (null? r) (cons (f (car l)) (map f (cdr l)))
-          (if (null? (cdr r))
-              (cons (f (car l) (caar r)) (map f (cdr l) (cdar r)))))))
-
-(define-macro (simple-let bindings . rest)
-  (cons (cons 'lambda (cons (map car bindings) rest))
-        (map cadr bindings)))
-
-(define-macro (let bindings . rest)
-  (cons 'simple-let (cons bindings rest)))
-
-(define-macro (or . x)
-  (if (null? x) #f
-      (if (null? (cdr x)) (car x)
-          (list 'if (car x) (car x)
-                (cons 'or (cdr x))))))
-
-(define-macro (and . x)
-  (if (null? x) #t
-      (if (null? (cdr x)) (car x)
-          (list 'if (car x) (cons 'and (cdr x))
-                #f))))
-
-(define (not x)
-  (if x #f #t))
-
-(define (evlis-env m a)
-  (cond
-   ((null? m) '())
-   ((not (pair? m)) (eval-env m a))
-   (#t (cons (eval-env (car m) a) (evlis-env (cdr m) a)))))
-
-(define (apply-env fn x a) 
-  (cond
-   ((atom? fn)
-    (cond
-     ((builtin? fn) (call fn x))
-     ((eq? fn 'call-with-values) (call call-with-values-env (append x (cons a '()))))
-     ((eq? fn 'current-module) a)
-     (#t (apply-env (eval-env fn a) x a))))
-   ((eq? (car fn) 'lambda)
-    (let ((p (pairlis (cadr fn) x a)))
-      (eval-begin-env (cddr fn) (cons (cons '*closure* p) p))))
-   ((eq? (car fn) '*closure*)
-    (let ((args (caddr fn))
-          (body (cdddr fn))
-          (a (cddr (cadr fn))))
-      (let ((p (pairlis args x a)))
-        (eval-begin-env body (cons (cons '*closure* p) p)))))
-   ;;((eq? (car fn) 'label) (apply-env (caddr fn) x (cons (cons (cadr fn) (caddr fn)) a)))
-   (#t (apply-env (eval-env fn a) x a))))
-
-(define (eval-expand e a)
-  (cond
-   ((symbol? e) (assq-ref-env e a))
-   ((atom? e) e)
-   ((atom? (car e))
-    (cond
-     ((eq? (car e) 'quote) (cadr e))
-     ((eq? (car e) 'syntax) (cadr e))
-     ((eq? (car e) 'begin) (eval-begin-env e a))
-     ((eq? (car e) 'lambda) (make-closure (cadr e) (cddr e) (assq '*closure* a)))
-     ((eq? (car e) '*closure*) e)
-     ((eq? (car e) 'if) (eval-if-env (cdr e) a))
-     ((eq? (car e) 'define) (env:define (cons (sexp:define e a) '()) a))
-     ((eq? (car e) 'define-macro) (env:define (env:macro (sexp:define e a)) a))
-     ((eq? (car e) 'set!) (set-env! (cadr e) (eval-env (caddr e) a) a))
-     ((eq? (car e) 'apply-env) (apply-env (eval-env (cadr e) a) (evlis-env (caddr e) a) a))
-     ((eq? (car e) 'unquote) (eval-env (cadr e) a))
-     ((eq? (car e) 'quasiquote) (eval-quasiquote (cadr e) (add-unquoters a)))
-     (#t (apply-env (car e) (evlis-env (cdr e) a) a))))
-   (#t (apply-env (car e) (evlis-env (cdr e) a) a))))
-
-(define (unquote x) (cons 'unquote x))
-(define (unquote-splicing x) (cons 'quasiquote x))
-
-(define %the-unquoters
-  (cons
-   (cons 'unquote unquote)
-   (cons (cons 'unquote-splicing unquote-splicing) '())))
-
-(define (add-unquoters a)
-  (cons %the-unquoters a))
-
-(define (eval-env e a)
-  (eval-expand (macro-expand-env e a) a))
-
-(define (macro-expand-env e a)
-  (if (pair? e) ((lambda (macro)
-                   (if macro (macro-expand-env (apply-env macro (cdr e) a) a)
-                       e))
-                 (lookup-macro (car e) a))
-      e))
-
-(define (eval-begin-env e a)
-  (if (null? e) *unspecified*
-      (if (null? (cdr e)) (eval-env (car e) a)
-          (begin
-            (eval-env (car e) a)
-            (eval-begin-env (cdr e) a)))))
-
-(define (eval-if-env e a)
-  (if (eval-env (car e) a) (eval-env (cadr e) a)
-      (if (pair? (cddr e)) (eval-env (caddr e) a))))
-
-(define (eval-quasiquote e a)
-  (cond ((null? e) e)
-        ((atom? e) e)
-        ((eq? (car e) 'unquote) (eval-env (cadr e) a))
-        ((and (pair? (car e))
-              (eq? (caar e) 'unquote-splicing))
-         (append2 (eval-env (cadar e) a) (eval-quasiquote (cdr e) a)))
-        (#t (cons (eval-quasiquote (car e) a) (eval-quasiquote (cdr e) a)))))
-
-(define (sexp:define e a)
-  (if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a))
-      (cons (caadr e) (eval-env (cons 'lambda (cons (cdadr e) (cddr e))) a))))
-
-(define (env:define a+ a)
-  (set-cdr! a+ (cdr a))
-  (set-cdr! a a+)
-  (set-cdr! (assq '*closure* a) a))
-
-(define (env:macro name+entry)
-  (cons
-   (cons (car name+entry)
-         (make-macro (car name+entry)
-                     (cdr name+entry)))
-   '()))
-
-;; boot into loop-0
-()
index 22a9acfbc30623fe2a80c1df298863186ccdf186..3bb77785e1950f67dc367b9dfaad1293b75601af 100644 (file)
@@ -28,7 +28,7 @@
 
 (define welcome
   (string-append "Mes " %version "
-Copyright (C) 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+Copyright (C) 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
 
 Mes comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
 This program is free software, and you are welcome to redistribute it
diff --git a/posix.c b/posix.c
index 924b5a69b2a0f125f9bd1b001bb39ae1d01a11d0..ea8a460c0e2165c2bbc6891ba38706d6e0859f09 100644 (file)
--- a/posix.c
+++ b/posix.c
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-#if !MINI_MES
+#if 0
 #include <fcntl.h>
-
 FILE *g_stdin;
+#else
+
+#if _POSIX_SOURCE
+int open (char const *s, int mode);
+int read (int fd, void* buf, size_t n);
+void write (int fd, char const* s, int n);
+#endif
+
+int g_stdin;
+
+#define O_RDONLY 0
+#define STDIN 0
+#define STDOUT 1
+#define STDERR 2
+
+int
+putchar (int c)
+{
+  write (STDOUT, (char*)&c, 1);
+  return 0;
+}
+
+int ungetc_char = -1;
+char ungetc_buf[2];
+
 int
 getchar ()
 {
-  return getc (g_stdin);
+  char c;
+  int i;
+  if (ungetc_char == -1)
+    {
+      int r = read (g_stdin, &c, 1);
+      if (r < 1) return -1;
+      i = c;
+    }
+  else
+    i = ungetc_buf[ungetc_char--];
+
+  if (i < 0) i += 256;
+
+  return i;
+}
+
+int
+fd_ungetc (int c, int fd)
+{
+  assert (ungetc_char < 2);
+  ungetc_buf[++ungetc_char] = c;
+  return c;
 }
 #endif
 
 int
 ungetchar (int c)
 {
-  return ungetc (c, g_stdin);
+  return fd_ungetc (c, g_stdin);
 }
 
 int
@@ -113,13 +158,13 @@ open_input_file (SCM file_name)
 SCM
 current_input_port ()
 {
-  return MAKE_NUMBER (fileno (g_stdin));
+  return MAKE_NUMBER (g_stdin);
 }
 
 SCM
 set_current_input_port (SCM port)
 {
-  g_stdin = VALUE (port) ? fdopen (VALUE (port), "r") : stdin;
+  g_stdin = VALUE (port);
   return current_input_port ();
 }
 
@@ -128,7 +173,7 @@ force_output (SCM p) ///((arity . n))
 {
   int fd = 1;
   if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
-  FILE *f = fd == 1 ? stdout : stderr;
-  fflush (f);
+  // FILE *f = fd == 1 ? stdout : stderr;
+  // fflush (f);
   return cell_unspecified;
 }
index e25e2c93c96a1fe74ac264630921b11291bfdd09..81c1e5407d124f67b1adb87ac05f48e7b067ac8b 100644 (file)
@@ -168,13 +168,13 @@ SCM tmp_num2;
 struct function g_functions[200];
 int g_function = 0;
 
-#include "gc.h"
+#include "mini-gc.h"
 // #include "lib.h"
 // #include "math.h"
 #include "mini-mes.h"
 // #include "posix.h"
 // #include "reader.h"
-#include "vector.h"
+#include "mini-vector.h"
 
 
 #define TYPE(x) (g_cells[x].type)
@@ -1589,17 +1589,17 @@ mes_builtins (SCM a) ///((internal))
 // #include "lib.i"
 // #include "math.i"
 // #include "posix.i"
-#include "vector.i"
-#include "gc.i"
+#include "mini-vector.i"
+#include "mini-gc.i"
 // #include "reader.i"
 
-#include "gc.environment.i"
+#include "mini-gc.environment.i"
 // #include "lib.environment.i"
 // #include "math.environment.i"
-  #include "mini-mes.environment.i"
+#include "mini-mes.environment.i"
 // #include "posix.environment.i"
 // #include "reader.environment.i"
-#include "vector.environment.i"
+#include "mini-vector.environment.i"
 
   return a;
 }
@@ -1702,6 +1702,9 @@ main (int argc, char *argv[])
   if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
 #endif
 
+  SCM lst = cell_nil;
+  for (int i=argc-1; i>=0; i--) lst = cons (MAKE_STRING (cstring_to_list (argv[i])), lst);
+  r0 = acons (cell_symbol_argv, lst, r0);
   push_cc (r2, cell_unspecified, r0, cell_unspecified);
   if (g_debug)
     {
index 23a0a607722956f394051017273048e803ee404f..23efacfc7ddc4923f1710e22ee4b6e051f5f65d0 100644 (file)
 
 #define MES_MINI 1
 
-#if __GNUC__
-#define FIXME_NYACC 1
-#define  __NYACC__ 0
-#define NYACC_CAR
-#define NYACC_CDR
-#else
-#define  __NYACC__ 1
-#define NYACC_CAR nyacc_car
-#define NYACC_CDR nyacc_cdr
-#endif
-
 char arena[200];
 
 typedef int SCM;
@@ -53,11 +42,7 @@ SCM r1 = 0; // param 1
 SCM r2 = 0; // save 2+load/dump
 SCM r3 = 0; // continuation
 
-#if __NYACC__ || FIXME_NYACC
-enum type_t {CHAR, CLOSURE, CONTINUATION, TFUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART};
-#else
-enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, STRING, SYMBOL, VALUES, VECTOR, BROKEN_HEART};
-#endif
+enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
 
 struct scm {
   enum type_t type;
@@ -142,7 +127,7 @@ fill ()
   CAR (0) = 0x6a746f6f;
   CDR (0) = 0x00002165;
 
-  TYPE (1) = SYMBOL;
+  TYPE (1) = TSYMBOL;
   CAR (1) = 0x2d2d2d2d;
   CDR (1) = 0x3e3e3e3e;
 
@@ -151,19 +136,19 @@ fill ()
   CDR (9) = 0x3e3e3e3e;
 
   // (A(B))
-  TYPE (10) = PAIR;
+  TYPE (10) = TPAIR;
   CAR (10) = 11;
   CDR (10) = 12;
 
-  TYPE (11) = CHAR;
+  TYPE (11) = TCHAR;
   CAR (11) = 0x58585858;
   CDR (11) = 89;
 
-  TYPE (12) = PAIR;
+  TYPE (12) = TPAIR;
   CAR (12) = 13;
   CDR (12) = 1;
 
-  TYPE (13) = CHAR;
+  TYPE (13) = TCHAR;
   CAR (11) = 0x58585858;
   CDR (13) = 90;
 
@@ -187,7 +172,7 @@ display_ (SCM x)
   //puts ("<display>\n");
   switch (TYPE (x))
     {
-    case CHAR:
+    case TCHAR:
       {
         //puts ("<char>\n");
         puts ("#\\");
@@ -207,7 +192,7 @@ display_ (SCM x)
           puts ("cdr");
         break;
       }
-    case NUMBER:
+    case TNUMBER:
       {
         //puts ("<number>\n");
 #if __GNUC__
@@ -220,7 +205,7 @@ display_ (SCM x)
 #endif
         break;
       }
-    case PAIR:
+    case TPAIR:
       {
         //puts ("<pair>\n");
         //if (cont != cell_f) puts "(");
@@ -229,13 +214,13 @@ display_ (SCM x)
         if (CDR (x) && CDR (x) != cell_nil)
           {
 #if __GNUC__
-            if (TYPE (CDR (x)) != PAIR)
+            if (TYPE (CDR (x)) != TPAIR)
               puts (" . ");
 #else
             int c;
             c = CDR (x);
             c = TYPE (c);
-            if (c != PAIR)
+            if (c != TPAIR)
               puts (" . ");
 #endif
             display_ (CDR (x));
@@ -244,7 +229,7 @@ display_ (SCM x)
         puts (")");
         break;
       }
-    case SPECIAL:
+    case TSPECIAL:
       {
         switch (x)
           {
@@ -264,7 +249,7 @@ display_ (SCM x)
           }
         break;
       }
-    case SYMBOL:
+    case TSYMBOL:
       {
         switch (x)
           {
diff --git a/scripts/elf.mes b/scripts/elf.mes
deleted file mode 100755 (executable)
index 8c0d745..0000000
+++ /dev/null
@@ -1,50 +0,0 @@
-#! /bin/sh
-# -*-scheme-*-
-prefix=module/
-cat $prefix/mes/base-0.mes $0 /dev/stdin | $(dirname $0)/mes $MES_FLAGS "$@" > a.out
-#paredit:|
-chmod +x a.out
-exit $?
-!#
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; elf.mes: This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-(mes-use-module (mes base))
-(mes-use-module (mes quasiquote))
-(mes-use-module (mes let))
-(mes-use-module (mes scm))
-(mes-use-module (rnrs bytevectors))
-(mes-use-module (mes elf))
-(mes-use-module (mes libc-i386))
-
-(define data
-  (string->list "Hello, world!\n"))
-
-(define (text d)
-  (append
-   (i386:puts d (length data))
-   (i386:for 0 3 1 (i386:puts (+ d 6) (- (length data) 6)))
-   (i386:exit 0)
-   ))
-
-(define (write-any x) (write-char (if (char? x) x (integer->char x))))
-
-(display "dumping to a.out:\n" (current-error-port))
-(map write-any (make-elf text data))
-()
diff --git a/scripts/include.mes b/scripts/include.mes
deleted file mode 100755 (executable)
index 5030ba5..0000000
+++ /dev/null
@@ -1,23 +0,0 @@
-#! /bin/sh
-
-if [ "$1" == "--help" ]; then
-    echo "Usage: include.mes FILE"
-    exit 0
-fi
-for prefix in $(dirname $(dirname $0))/share/mes . $(dirname $(dirname $0)); do
-    if [ -d ${prefix}/module ]; then
-        break;
-    fi
-done
-
-if [ -n "$BOOT" ]; then
-    echo $prefix/module/mes/loop-0.mes
-    if [ -n "$TYPE0" ]; then
-        echo $prefix/module/mes/type-0.mes
-    fi
-    echo $prefix/module/mes/mes-0.mes
-fi
-cat $@ \
-  | grep -Eo '^\(mes-use-module \([^ ()]+ [^()]+))' \
-  | grep -Eo ' \([^)]+\)' \
-  | sed -e "s@^ *(@${prefix}/module/@" -e 's@ @/@g' -e 's@)@.mes@'
index fac99d7db06027f8f6f5453e02e2208323e5cd04..c0995b2460364363379fbcc27c573d2bfe19e95f 100755 (executable)
@@ -4,8 +4,9 @@ MES=${MES-$(dirname $0)/mes}
 prefix=module/
 echo '()' | cat $prefix/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS "$@"
 #paredit:||
-chmod +x a.out
-exit $?
+r=$?
+([ -f a.out ] && chmod +x a.out)
+exit $r
 !#
 
 ;;; Mes --- Maxwell Equations of Software
diff --git a/scripts/nyacc-calc.mes b/scripts/nyacc-calc.mes
deleted file mode 100755 (executable)
index 428223b..0000000
+++ /dev/null
@@ -1,95 +0,0 @@
-#! /bin/sh
-# -*-scheme-*-
-MES_ARENA=${MES_ARENA-50000000}
-export MES_ARENA
-prefix=module/
-cat $prefix/mes/base-0.mes $0 | $(dirname $0)/mes $MES_FLAGS "$@"
-# |
-exit $?
-!#
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; nyacc-calc.mes
-;;;
-;;; Run with Guile:
-;;;    guile/nyacc-calc.scm
-
-;;; Code:
-
-(mes-use-module (mes scm))
-(mes-use-module (srfi srfi-9-psyntax))
-(mes-use-module (mes optargs))
-(mes-use-module (mes fluids))
-(mes-use-module (mes catch))
-
-(mes-use-module (mes guile))
-(mes-use-module (mes pretty-print))
-
-(mes-use-module (nyacc lalr))
-(mes-use-module (nyacc lex))
-(mes-use-module (nyacc parse))
-
-;; (define-module (nyacc)
-;;   #:use-module (nyacc lalr)
-;;   #:use-module (nyacc lex)
-;;   #:use-module (nyacc parse)
-;;   #:use-module (ice-9 rdelim)
-;;   #:use-module (ice-9 pretty-print)
-;;   #:export (main))
-
-(define simple-spec
-  (lalr-spec
-   (prec< (left "+" "-") (left "*" "/"))
-   (start expr)
-   (grammar
-    (expr
-     (expr "+" expr ($$ (+ $1 $3)))
-     (expr "-" expr ($$ (- $1 $3)))
-     (expr "*" expr ($$ (* $1 $3)))
-     (expr "/" expr ($$ (/ $1 $3)))
-     ("*" $error)
-     ($fixed ($$ (string->number $1)))
-     ($float ($$ (string->number $1)))
-     ("(" expr ")" ($$ $2))))))
-
-(define simple-mach (make-lalr-machine simple-spec))
-
-;; OR
-;; (use-modules (nyacc bison))
-;; (define simple-mach (make-lalr-machine/bison simple-spec))
-
-(define match-table (assq-ref simple-mach 'mtab))
-
-(define gen-lexer (make-lexer-generator match-table))
-
-(define parse (make-lalr-parser simple-mach))
-
-(define demo-string "2 + 2")
-
-(define (main arguments)
-  (display demo-string)
-  (display " => ")
-  (display (with-input-from-string demo-string
-             (lambda () (parse (gen-lexer)))))
-  (newline))
-(main #f)
-()
diff --git a/scripts/nyacc.mes b/scripts/nyacc.mes
deleted file mode 100755 (executable)
index d7b640b..0000000
+++ /dev/null
@@ -1,58 +0,0 @@
-#! /bin/sh
-# -*-scheme-*-
-MES_ARENA=${MES_ARENA-50000000}
-export MES_ARENA
-prefix=module/
-cat $prefix/mes/base-0.mes $0 | $(dirname $0)/mes $MES_FLAGS "$@"
-# |
-exit $?
-!#
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; nyacc.mes 
-;;;
-;;; Run with Guile:
-;;;    guile/nyacc.scm
-
-;;; Code:
-
-(mes-use-module (mes scm))
-(mes-use-module (srfi srfi-9-psyntax))
-(mes-use-module (mes optargs))
-(mes-use-module (mes fluids))
-(mes-use-module (mes catch))
-
-(mes-use-module (mes guile))
-(mes-use-module (mes pretty-print))
-
-(mes-use-module (nyacc lang c99 parser))
-
-;;(open-input-file "doc/examples/main.c")
-(define (main arguments)
-  (let* ((file (if (> (length arguments) 1) (cadr arguments)
-                   "doc/examples/main.c"))
-         (ast (with-input-from-file file
-                (lambda () (parse-c99 #:inc-dirs '())))))
-    (pretty-print ast)
-    (newline)))
-(main '())
-()
diff --git a/scripts/paren.mes b/scripts/paren.mes
deleted file mode 100755 (executable)
index 2c12426..0000000
+++ /dev/null
@@ -1,40 +0,0 @@
-#! /bin/sh
-# -*-scheme-*-
-prefix=module/
-echo -e 'EOF\n___P((()))' | cat $prefix/mes/base-0.mes $0 /dev/stdin | $(dirname $0)/mes $MES_FLAGS "$@"
-chmod +x a.out
-exit $?
-!#
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; paren.mes is a simple yet full lalr test for Mes taken from the
-;;; Gambit wiki.
-;;;
-;;; Run with Guile:
-;;;    echo '___P((()))' | guile -s <(echo '(paren-depth)' | cat module/language/paren.mes -)
-
-;;; Code:
-
-(mes-use-module (language paren))
-
-(paren-depth)
-()
index f14655885c1fda5415f22116dbc8fd96f5dccac7..4c4b07a09ef5513044cf0893467a55bd3a3a5835 100755 (executable)
@@ -10,7 +10,7 @@ exit $?
 !#
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;