build: Cleanup, use gcc-specific snarfing.

* .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.
This commit is contained in:
Jan Nieuwenhuizen 2017-04-02 17:01:22 +02:00
parent b99f756367
commit fc263de433
23 changed files with 222 additions and 702 deletions

3
.gitignore vendored
View file

@ -5,6 +5,7 @@
*.h *.h
*.i *.i
*.o *.o
*.o-32
*.symbols.i *.symbols.i
*~ *~
.#* .#*
@ -33,6 +34,8 @@
/guile-t /guile-t
/guile-tiny-mes /guile-tiny-mes
/mes-mini-mes
/module/mes/tiny-0-32.mo /module/mes/tiny-0-32.mo
#keep this: bootstrap #keep this: bootstrap
#/module/mes/read-0-32.mo #/module/mes/read-0-32.mo

View file

@ -26,20 +26,21 @@ endif
-include .local.make -include .local.make
all: mes module/mes/read-0.mo all: mes module/mes/read-0.mo module/mes/read-0-32.mo
mes.o: GNUmakefile S:=
mes.o: mes.c mes.o$(S): GNUmakefile
mes.o: mes.c mes.h mes.i mes.environment.i mes.symbols.i mes.o$(S): mes.c
mes.o: lib.c lib.h lib.i lib.environment.i mes.o$(S): mes.c mes.h mes.i mes.environment.i mes.symbols.i
mes.o: math.c math.h math.i math.environment.i mes.o$(S): lib.c lib.h lib.i lib.environment.i
mes.o: posix.c posix.h posix.i posix.environment.i mes.o$(S): math.c math.h math.i math.environment.i
mes.o: reader.c reader.h reader.i reader.environment.i mes.o$(S): posix.c posix.h posix.i posix.environment.i
mes.o: gc.c gc.h gc.i gc.environment.i mes.o$(S): reader.c reader.h reader.i reader.environment.i
mes.o: vector.c vector.h vector.i vector.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: 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 mes-32
rm -f cons-mes m main micro-mes mini-mes t tiny-mes 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 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 mes-check: all
set -e; for i in $(TESTS); do ./$$i; done set -e; for i in $(TESTS); do ./$$i; done
mes-check-nyacc: all mini-mes-check: all mini-mes
scripts/nyacc.mes $(MAKE) mes-check MES=./mini-mes
scripts/nyacc-calc.mes
module/mes/read-0.mo: module/mes/read-0.mes mes module/mes/read-0.mo: module/mes/read-0.mes mes
./mes --dump < $< > $@ ./mes --dump < $< > $@
dump: module/mes/read-0.mo dump: module/mes/read-0.mo
mes-32: gc.c lib.c math.c posix.c vector.c mes.o$(S): mes.c
mes-32: mes.c lib.c $(CC) $(CPPFLAGS) $(CFLAGS) -c -o $@ $<
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
module/mes/read-0-32.mo: module/mes/read-0.mes mes-32 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
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 < $< > $@ MES_MINI=1 ./mes-32 --dump < $< > $@
module/mes/tiny-0-32.mo: module/mes/tiny-0.mes mes-32 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\ set -e; for i in $(TESTS); do\
$(GUILE) -s <(cat $(MES-0) module/mes/test.mes $$i);\ $(GUILE) -s <(cat $(MES-0) module/mes/test.mes $$i);\
done done
guile/nyacc-calc.scm
t-check: t t-check: t
./t ./t
@ -127,33 +131,51 @@ mescc-check: t-check
chmod +x a.out chmod +x a.out
./a.out ./a.out
%.h %.i %.environment.i %.symbols.i: scaffold/%.c build-aux/mes-snarf.scm %.h %.i %.environment.i %.symbols.i: scaffold/%.c build-aux/mes-snarf.scm GNUmakefile
build-aux/mes-snarf.scm $< 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: mini-mes.h mini-mes.i mini-mes.environment.i mini-mes.symbols.i
mini-mes: vector.c mini-mes: gc.c mini-gc.h mini-gc.i mini-gc.environment.i
mini-mes: gc.c mini-mes: vector.c mini-vector.h mini-vector.i mini-vector.environment.i
mini-mes: mlibc.c mstart.c mini-mes: mlibc.c mstart.c
mini-mes: GNUmakefile mini-mes: GNUmakefile
mini-mes: module/mes/read-0-32.mo mini-mes: module/mes/read-0-32.mo
mini-mes: scaffold/mini-mes.c mini-mes: scaffold/mini-mes.c
rm -f $@ rm -f $@
# gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DPREFIX=' '-DVERSION='"$(VERSION)"' $< gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
gcc -nostdlib -I. --std=gnu99 -m32 -g -I. -o $@ $(CPPFLAGS) $<
rm -f mes.o rm -f mes.o
chmod +x $@ chmod +x $@
guile-mini-mes: mini-mes.h mini-mes.i mini-mes.environment.i mini-mes.symbols.i 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: module/mes/read-0-32.mo
guile-mini-mes: scaffold/mini-mes.c guile-mini-mes: scaffold/mini-mes.c
guile/mescc.scm $< > $@ || rm -f $@ guile/mescc.scm $< > $@ || rm -f $@
chmod +x $@ 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: module/mes/tiny-0-32.mo
cons-mes: scaffold/cons-mes.c GNUmakefile cons-mes: scaffold/cons-mes.c GNUmakefile
rm -f $@ rm -f $@
gcc -nostdlib -I. --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $< gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
chmod +x $@ chmod +x $@
guile-cons-mes: module/mes/tiny-0-32.mo 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: module/mes/tiny-0-32.mo
tiny-mes: scaffold/tiny-mes.c GNUmakefile tiny-mes: scaffold/tiny-mes.c GNUmakefile
rm -f $@ rm -f $@
gcc -nostdlib -I. --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $< gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
chmod +x $@ chmod +x $@
guile-tiny-mes: module/mes/tiny-0-32.mo 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 m: scaffold/m.c GNUmakefile
rm -f $@ rm -f $@
gcc -nostdlib -I. --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $< gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
# gcc --std=gnu99 -g -o $@ '-DVERSION="0.4"' $< # gcc --std=gnu99 -g -o $@ $(CPPFLAGS) $<
chmod +x $@ chmod +x $@
guile-m: scaffold/m.c guile-m: scaffold/m.c
@ -184,7 +206,7 @@ guile-m: scaffold/m.c
malloc: scaffold/malloc.c GNUmakefile malloc: scaffold/malloc.c GNUmakefile
rm -f $@ rm -f $@
gcc -nostdlib -I. --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $< gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
chmod +x $@ chmod +x $@
guile-malloc: scaffold/malloc.c guile-malloc: scaffold/malloc.c
@ -193,7 +215,7 @@ guile-malloc: scaffold/malloc.c
micro-mes: scaffold/micro-mes.c GNUmakefile micro-mes: scaffold/micro-mes.c GNUmakefile
rm -f $@ rm -f $@
gcc -nostdlib -I. --std=gnu99 -m32 -o $@ '-DVERSION="0.4"' $< gcc -nostdlib --std=gnu99 -m32 -o $@ $(CPPFLAGS) $<
chmod +x $@ chmod +x $@
guile-micro-mes: scaffold/micro-mes.c guile-micro-mes: scaffold/micro-mes.c
@ -202,7 +224,7 @@ guile-micro-mes: scaffold/micro-mes.c
main: doc/examples/main.c GNUmakefile main: doc/examples/main.c GNUmakefile
rm -f $@ rm -f $@
gcc -nostdlib -I. --std=gnu99 -m32 -o $@ '-DVERSION="0.4"' $< gcc -nostdlib --std=gnu99 -m32 -o $@ $(CPPFLAGS) $<
chmod +x $@ chmod +x $@
guile-main: doc/examples/main.c guile-main: doc/examples/main.c
@ -212,7 +234,7 @@ guile-main: doc/examples/main.c
t: mlibc.c t: mlibc.c
t: scaffold/t.c GNUmakefile t: scaffold/t.c GNUmakefile
rm -f $@ rm -f $@
gcc -nostdlib -I. --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $< gcc -nostdlib --std=gnu99 -m32 -g -o $@ $(CPPFLAGS) $<
chmod +x $@ chmod +x $@
guile-t: scaffold/t.c guile-t: scaffold/t.c
@ -231,9 +253,6 @@ guile-mescc: $(MAIN_C)
chmod +x a.out chmod +x a.out
./a.out; r=$$?; [ $$r = 42 ] ./a.out; r=$$?; [ $$r = 42 ]
paren: all
scripts/paren.mes
GUILE_GIT:=$(HOME)/src/guile-1.8 GUILE_GIT:=$(HOME)/src/guile-1.8
GUILE_COMMIT:=ba8a709 GUILE_COMMIT:=ba8a709
psyntax-import: module/mes/psyntax.ss module/mes/psyntax.pp psyntax-import: module/mes/psyntax.ss module/mes/psyntax.pp

View file

@ -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 ;;; 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. ;;; 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)) (cut regexp-substitute #f <> 'pre replace 'post))
string)) string))
(define GCC? #f) (define %gcc? #t)
;; (define-record-type function (make-function name formals annotation) ;; (define-record-type function (make-function name formals annotation)
;; function? ;; function?
;; (name .name) ;; (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))) (format #f "g_cells[cell_~a] = scm_~a;\n\n" s s)))
(define (symbol->names s i) (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.name);\n" s s)
(format #f "g_cells[cell_~a].car = cstring_to_list (scm_~a.car);\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))) (n (if (eq? arity 'n) -1 arity)))
(string-append (string-append
(format #f "SCM ~a (~a);\n" (.name f) (.formals f)) (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 = {.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))) (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, .name=0, .function=0};\n" (function-builtin-name f))
(format #f "struct scm ~a = {TFUNCTION, 0, 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))))) (format #f "SCM cell_~a;\n\n" (.name f)))))
(define (function->source f i) (define (function->source f i)
(string-append (string-append
(if GCC? (if %gcc?
(format #f "~a.function = g_function;\n" (function-builtin-name f)) (format #f "~a.function = g_function;\n" (function-builtin-name f))
(format #f "~a.cdr = 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)) (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) (define (function->environment f i)
(string-append (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.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))) (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].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))) (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.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))))) (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)) (functions (filter (negate internal?) functions))
(symbols (snarf-symbols string)) (symbols (snarf-symbols string))
(base-name (basename file-name ".c")) (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> (header (make <file>
#:name (string-append base-name ".h") #:name (string-append base-name ".h")
#:content (string-join (map function->header functions (iota (length functions) (+ %start (length symbols)))) ""))) #: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))))) (with-output-to-file (.name file) (lambda () (display (.content file)))))
(define (main args) (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))))) (map file-write (filter content? (append-map generate-includes files)))))
;;(define string (with-input-from-file "../mes.c" read-string)) ;;(define string (with-input-from-file "../mes.c" read-string))

View file

@ -18,19 +18,21 @@
* along with Mes. If not, see <http://www.gnu.org/licenses/>. * along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/ */
#if __GNUC__ #define GNU 0
#include "mlibc.c" // #if __GNUC__
#endif // #include "mlibc.c"
// #endif
int int
//main () //main ()
main (int argc, char *argv[]) main (int argc, char *argv[])
{ {
puts ("Hi Mes!\n"); //puts ("Hi Mes!\n");
if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("argc > 1 && --help\n"); //if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("argc > 1 && --help\n");
if (argc > 1) return argc;
return 42; return 42;
} }
#if __GNUC__ // #if __GNUC__
#include "mstart.c" // #include "mstart.c"
#endif // #endif

16
lib.c
View file

@ -54,7 +54,7 @@ display_helper (SCM x, int cont, char* sep, FILE *fd)
case TFUNCTION: case TFUNCTION:
{ {
fputs ("#<procedure ", fd); fputs ("#<procedure ", fd);
char *p = "?"; char const *p = "?";
if (FUNCTION (x).name != 0) if (FUNCTION (x).name != 0)
p = FUNCTION (x).name; p = FUNCTION (x).name;
fputs (p, fd); fputs (p, fd);
@ -329,11 +329,11 @@ SCM
load_env (SCM a) ///((internal)) load_env (SCM a) ///((internal))
{ {
r0 = a; r0 = a;
g_stdin = fopen ("module/mes/read-0.mes", "r"); g_stdin = open ("module/mes/read-0.mes", O_RDONLY);
g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mes", "r"); g_stdin = g_stdin ? g_stdin : open (PREFIX "module/mes/read-0.mes", O_RDONLY);
if (!g_function) r0 = mes_builtins (r0); if (!g_function) r0 = mes_builtins (r0);
r2 = read_input_file_env (r0); r2 = read_input_file_env (r0);
g_stdin = stdin; g_stdin = STDIN;
return r2; return r2;
} }
@ -341,10 +341,10 @@ SCM
bload_env (SCM a) ///((internal)) bload_env (SCM a) ///((internal))
{ {
#if MES_MINI #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 #else
g_stdin = fopen ("module/mes/read-0.mo", "r"); g_stdin = open ("module/mes/read-0.mo", O_RDONLY);
g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mo", "r"); g_stdin = g_stdin ? g_stdin : open (PREFIX "module/mes/read-0.mo", O_RDONLY);
#endif #endif
char *p = (char*)g_cells; char *p = (char*)g_cells;
@ -362,7 +362,7 @@ bload_env (SCM a) ///((internal))
g_free = (p-(char*)g_cells) / sizeof (struct scm); g_free = (p-(char*)g_cells) / sizeof (struct scm);
gc_peek_frame (); gc_peek_frame ();
g_symbols = r1; g_symbols = r1;
g_stdin = stdin; g_stdin = STDIN;
r0 = mes_builtins (r0); r0 = mes_builtins (r0);
return r2; return r2;
} }

View file

@ -45,25 +45,16 @@ ChangeLog:
install: all ChangeLog install: all ChangeLog
mkdir -p $(DESTDIR)$(PREFIX)/bin mkdir -p $(DESTDIR)$(PREFIX)/bin
install mes $(DESTDIR)$(PREFIX)/bin/mes 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/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/repl.mes $(DESTDIR)$(PREFIX)/bin/repl.mes
install scripts/paren.mes $(DESTDIR)$(PREFIX)/bin/paren.mes
mkdir -p $(DESTDIR)$(PREFIX)/share/mes mkdir -p $(DESTDIR)$(PREFIX)/share/mes
$(GIT_ARCHIVE_HEAD) module\ $(GIT_ARCHIVE_HEAD) module\
| tar -C $(DESTDIR)$(PREFIX)/share/mes -xf- | tar -C $(DESTDIR)$(PREFIX)/share/mes -xf-
cp module/mes/read-0.mo $(DESTDIR)$(PREFIX)/share/mes/module/mes cp module/mes/read-0.mo $(DESTDIR)$(PREFIX)/share/mes/module/mes
sed -i -e 's@module/@$(PREFIX)/share/mes/module/@' \ sed -i -e 's@module/@$(PREFIX)/share/mes/module/@' \
$(DESTDIR)$(PREFIX)/share/mes/module/mes/base-0.mes \ $(DESTDIR)$(PREFIX)/share/mes/module/mes/base-0.mes \
$(DESTDIR)$(PREFIX)/bin/elf.mes \
$(DESTDIR)$(PREFIX)/bin/mescc.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/repl.mes \
$(DESTDIR)$(PREFIX)/bin/paren.mes
mkdir -p $(DESTDIR)$(PREFIX)/share/doc/mes mkdir -p $(DESTDIR)$(PREFIX)/share/doc/mes
$(GIT_ARCHIVE_HEAD) $(READMES) \ $(GIT_ARCHIVE_HEAD) $(READMES) \
| tar -C $(DESTDIR)$(PREFIX)/share/doc/mes -xf- | tar -C $(DESTDIR)$(PREFIX)/share/doc/mes -xf-

38
mes.c
View file

@ -425,6 +425,8 @@ length (SCM x)
return MAKE_NUMBER (n); return MAKE_NUMBER (n);
} }
SCM apply (SCM, SCM, SCM);
SCM SCM
error (SCM key, SCM x) error (SCM key, SCM x)
{ {
@ -519,6 +521,8 @@ set_cdr_x (SCM x, SCM e)
return cell_unspecified; return cell_unspecified;
} }
SCM assert_defined (SCM, SCM);
SCM SCM
set_env_x (SCM x, SCM e, SCM a) set_env_x (SCM x, SCM e, SCM a)
{ {
@ -551,18 +555,11 @@ lookup_macro_ (SCM x, SCM a) ///((internal))
return cell_f; return cell_f;
} }
SCM SCM check_apply (SCM, SCM);
push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal)) SCM check_formals (SCM, SCM, SCM);
{ SCM push_cc (SCM, SCM, SCM, SCM);
SCM x = r3; SCM gc_pop_frame ();
r3 = c; SCM gc_push_frame ();
r2 = p2;
gc_push_frame ();
r1 = p1;
r0 = a;
r3 = x;
return cell_unspecified;
}
SCM SCM
eval_apply () eval_apply ()
@ -919,6 +916,19 @@ gc_push_frame () ///((internal))
return g_stack = cons (frame, g_stack); 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 SCM
apply (SCM f, SCM x, SCM a) ///((internal)) apply (SCM f, SCM x, SCM a) ///((internal))
{ {
@ -1066,7 +1076,7 @@ mes_environment () ///((internal))
return mes_g_stack (a); return mes_g_stack (a);
} }
FILE *g_stdin; int g_stdin;
#include "math.c" #include "math.c"
#include "posix.c" #include "posix.c"
#include "lib.c" #include "lib.c"
@ -1083,7 +1093,7 @@ main (int argc, char *argv[])
if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA")); 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], "--help")) return puts ("Usage: mes [--dump|--load] < FILE");
if (argc > 1 && !strcmp (argv[1], "--version")) {puts ("Mes ");puts (VERSION);return 0;}; if (argc > 1 && !strcmp (argv[1], "--version")) {puts ("Mes ");puts (VERSION);return 0;};
g_stdin = stdin; g_stdin = STDIN;
r0 = mes_environment (); r0 = mes_environment ();
SCM program = (argc > 1 && !strcmp (argv[1], "--load")) SCM program = (argc > 1 && !strcmp (argv[1], "--load"))

View file

@ -30,9 +30,9 @@
(set-port-encoding! (current-output-port) "ISO-8859-1")) (set-port-encoding! (current-output-port) "ISO-8859-1"))
(guile) (guile)
(mes (mes
(mes-use-module (mes pmatch))
(mes-use-module (nyacc lang c99 parser)) (mes-use-module (nyacc lang c99 parser))
(mes-use-module (mes elf-util)) (mes-use-module (mes elf-util))
(mes-use-module (mes pmatch))
(mes-use-module (mes elf)) (mes-use-module (mes elf))
(mes-use-module (mes as-i386)) (mes-use-module (mes as-i386))
(mes-use-module (mes libc)) (mes-use-module (mes libc))
@ -46,8 +46,6 @@
(define (stderr string . rest) (define (stderr string . rest)
(apply logf (cons* (current-error-port) 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) (define (mescc)
(parse-c99 (parse-c99
#:inc-dirs (string-split (getenv "C_INCLUDE_PATH") #\:) #:inc-dirs (string-split (getenv "C_INCLUDE_PATH") #\:)
@ -67,9 +65,7 @@
"VERSION=\"0.4\"" "VERSION=\"0.4\""
"PREFIX=\"\"" "PREFIX=\"\""
) )
#:xdef? gnuc-xdef? #:mode 'code))
#:mode 'code
))
(define (write-any x) (define (write-any x)
(write-char (cond ((char? x) x) (write-char (cond ((char? x) x)
@ -661,8 +657,9 @@
(count (length fields)) (count (length fields))
(field-size 4) ;; FIXME:4, not fixed (field-size 4) ;; FIXME:4, not fixed
(rest (or (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))) (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)))) (offset (* field-size (1- (length rest))))
(text (.text info))) (text (.text info)))
(clone info #:text (clone info #:text
@ -1605,7 +1602,7 @@
;; ++i ;; ++i
((expr-stmt (pre-inc (p-expr (ident ,name)))) ((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 (clone info #:text
(append text (append text
((ident-add info) name 1) ((ident-add info) name 1)
@ -1617,7 +1614,7 @@
;; i-- ;; i--
((expr-stmt (post-dec (p-expr (ident ,name)))) ((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 (clone info #:text
(append text (append text
((ident->accu info) name) ((ident->accu info) name)
@ -1629,7 +1626,7 @@
;; --i ;; --i
((expr-stmt (pre-dec (p-expr (ident ,name)))) ((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 (clone info #:text
(append text (append text
((ident-add info) name -1) ((ident-add info) name -1)
@ -2451,13 +2448,14 @@
(define (function->info info) (define (function->info info)
(lambda (o) (lambda (o)
;;(stderr "\n") ;;(stderr "function->info o=~s\n" o)
;;(stderr "formals=~a\n" (.formals o)) ;;(stderr "formals=~s\n" (.formals o))
(let* ((name (.name o)) (let* ((name (.name o))
(text (formals->text (.formals o))) (formals (.formals o))
(locals (formals->locals (.formals o)))) (text (formals->text formals))
(format (current-error-port) "compiling ~a\n" name) (locals (formals->locals formals)))
;;(stderr "locals=~a\n" locals) (format (current-error-port) "compiling ~s\n" name)
;;(stderr "locals=~s\n" locals)
(let loop ((statements (.statements o)) (let loop ((statements (.statements o))
(info (clone info #:locals locals #:function (.name o) #:text text))) (info (clone info #:locals locals #:function (.name o) #:text text)))
(if (null? statements) (clone info (if (null? statements) (clone info
@ -2474,6 +2472,7 @@
(loop (cdr elements) ((ast->info info) (car elements))))))) (loop (cdr elements) ((ast->info info) (car elements)))))))
(define (compile) (define (compile)
(stderr "COMPILE\n")
(let* ((ast (mescc)) (let* ((ast (mescc))
(info (make <info> (info (make <info>
#:functions i386:libc #:functions i386:libc

View file

@ -67,7 +67,7 @@
(define (with-input-from-file file thunk) (define (with-input-from-file file thunk)
(let ((port (open-input-file file))) (let ((port (open-input-file file)))
(if (= port -1) (if (= port -1)
(begin (display "no such file:") (display file) (newline)) (error 'no-such-file file)
(let* ((save (current-input-port)) (let* ((save (current-input-port))
(foo (set-current-input-port port)) (foo (set-current-input-port port))
(r (thunk))) (r (thunk)))

View file

@ -56,18 +56,6 @@ strlen (char const* s)
(define getchar (define getchar
(let* ((ast (with-input-from-string (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 g_stdin = 0;
int ungetc_char = -1; int ungetc_char = -1;
char ungetc_buf[2]; char ungetc_buf[2];
@ -92,12 +80,6 @@ getchar ()
} }
if (i < 0) i += 256; if (i < 0) i += 256;
#if 0
puts (\"get: \");
putchar (i);
puts (\"\n\");
#endif
return i; return i;
} }
" "
@ -127,13 +109,13 @@ assert_fail (char* s)
(define ungetc (define ungetc
(let* ((ast (with-input-from-string (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 int
ungetc (int c, int fd) ungetc (int c, int fd)
{ {
//FIXME //FIXME
//assert (ungetc_char < 2); //assert (ungetc_char < 2);
assert (ungetc_char == -1 || ungetc_char < 2); //assert (ungetc_char == -1 || ungetc_char < 2);
//FIXME //FIXME
//ungetc_buf[++ungetc_char] = c; //ungetc_buf[++ungetc_char] = c;
ungetc_char++; ungetc_char++;
@ -337,6 +319,7 @@ realloc (int *p, int size)
puts puts
strcmp strcmp
itoa itoa
isdigit ;; isdigit
malloc ;; malloc
realloc)) ;; realloc
))

View file

@ -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")

View file

@ -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
()

View file

@ -28,7 +28,7 @@
(define welcome (define welcome
(string-append "Mes " %version " (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'. Mes comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it This program is free software, and you are welcome to redistribute it

61
posix.c
View file

@ -18,21 +18,66 @@
* along with Mes. If not, see <http://www.gnu.org/licenses/>. * along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/ */
#if !MINI_MES #if 0
#include <fcntl.h> #include <fcntl.h>
FILE *g_stdin; 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 int
getchar () 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 #endif
int int
ungetchar (int c) ungetchar (int c)
{ {
return ungetc (c, g_stdin); return fd_ungetc (c, g_stdin);
} }
int int
@ -113,13 +158,13 @@ open_input_file (SCM file_name)
SCM SCM
current_input_port () current_input_port ()
{ {
return MAKE_NUMBER (fileno (g_stdin)); return MAKE_NUMBER (g_stdin);
} }
SCM SCM
set_current_input_port (SCM port) set_current_input_port (SCM port)
{ {
g_stdin = VALUE (port) ? fdopen (VALUE (port), "r") : stdin; g_stdin = VALUE (port);
return current_input_port (); return current_input_port ();
} }
@ -128,7 +173,7 @@ force_output (SCM p) ///((arity . n))
{ {
int fd = 1; int fd = 1;
if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p)); if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
FILE *f = fd == 1 ? stdout : stderr; // FILE *f = fd == 1 ? stdout : stderr;
fflush (f); // fflush (f);
return cell_unspecified; return cell_unspecified;
} }

View file

@ -168,13 +168,13 @@ SCM tmp_num2;
struct function g_functions[200]; struct function g_functions[200];
int g_function = 0; int g_function = 0;
#include "gc.h" #include "mini-gc.h"
// #include "lib.h" // #include "lib.h"
// #include "math.h" // #include "math.h"
#include "mini-mes.h" #include "mini-mes.h"
// #include "posix.h" // #include "posix.h"
// #include "reader.h" // #include "reader.h"
#include "vector.h" #include "mini-vector.h"
#define TYPE(x) (g_cells[x].type) #define TYPE(x) (g_cells[x].type)
@ -1589,17 +1589,17 @@ mes_builtins (SCM a) ///((internal))
// #include "lib.i" // #include "lib.i"
// #include "math.i" // #include "math.i"
// #include "posix.i" // #include "posix.i"
#include "vector.i" #include "mini-vector.i"
#include "gc.i" #include "mini-gc.i"
// #include "reader.i" // #include "reader.i"
#include "gc.environment.i" #include "mini-gc.environment.i"
// #include "lib.environment.i" // #include "lib.environment.i"
// #include "math.environment.i" // #include "math.environment.i"
#include "mini-mes.environment.i" #include "mini-mes.environment.i"
// #include "posix.environment.i" // #include "posix.environment.i"
// #include "reader.environment.i" // #include "reader.environment.i"
#include "vector.environment.i" #include "mini-vector.environment.i"
return a; return a;
} }
@ -1702,6 +1702,9 @@ main (int argc, char *argv[])
if (argc > 1 && !strcmp (argv[1], "--dump")) return dump (); if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
#endif #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); push_cc (r2, cell_unspecified, r0, cell_unspecified);
if (g_debug) if (g_debug)
{ {

View file

@ -25,17 +25,6 @@
#define MES_MINI 1 #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]; char arena[200];
typedef int SCM; typedef int SCM;
@ -53,11 +42,7 @@ SCM r1 = 0; // param 1
SCM r2 = 0; // save 2+load/dump SCM r2 = 0; // save 2+load/dump
SCM r3 = 0; // continuation SCM r3 = 0; // continuation
#if __NYACC__ || FIXME_NYACC enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
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
struct scm { struct scm {
enum type_t type; enum type_t type;
@ -142,7 +127,7 @@ fill ()
CAR (0) = 0x6a746f6f; CAR (0) = 0x6a746f6f;
CDR (0) = 0x00002165; CDR (0) = 0x00002165;
TYPE (1) = SYMBOL; TYPE (1) = TSYMBOL;
CAR (1) = 0x2d2d2d2d; CAR (1) = 0x2d2d2d2d;
CDR (1) = 0x3e3e3e3e; CDR (1) = 0x3e3e3e3e;
@ -151,19 +136,19 @@ fill ()
CDR (9) = 0x3e3e3e3e; CDR (9) = 0x3e3e3e3e;
// (A(B)) // (A(B))
TYPE (10) = PAIR; TYPE (10) = TPAIR;
CAR (10) = 11; CAR (10) = 11;
CDR (10) = 12; CDR (10) = 12;
TYPE (11) = CHAR; TYPE (11) = TCHAR;
CAR (11) = 0x58585858; CAR (11) = 0x58585858;
CDR (11) = 89; CDR (11) = 89;
TYPE (12) = PAIR; TYPE (12) = TPAIR;
CAR (12) = 13; CAR (12) = 13;
CDR (12) = 1; CDR (12) = 1;
TYPE (13) = CHAR; TYPE (13) = TCHAR;
CAR (11) = 0x58585858; CAR (11) = 0x58585858;
CDR (13) = 90; CDR (13) = 90;
@ -187,7 +172,7 @@ display_ (SCM x)
//puts ("<display>\n"); //puts ("<display>\n");
switch (TYPE (x)) switch (TYPE (x))
{ {
case CHAR: case TCHAR:
{ {
//puts ("<char>\n"); //puts ("<char>\n");
puts ("#\\"); puts ("#\\");
@ -207,7 +192,7 @@ display_ (SCM x)
puts ("cdr"); puts ("cdr");
break; break;
} }
case NUMBER: case TNUMBER:
{ {
//puts ("<number>\n"); //puts ("<number>\n");
#if __GNUC__ #if __GNUC__
@ -220,7 +205,7 @@ display_ (SCM x)
#endif #endif
break; break;
} }
case PAIR: case TPAIR:
{ {
//puts ("<pair>\n"); //puts ("<pair>\n");
//if (cont != cell_f) puts "("); //if (cont != cell_f) puts "(");
@ -229,13 +214,13 @@ display_ (SCM x)
if (CDR (x) && CDR (x) != cell_nil) if (CDR (x) && CDR (x) != cell_nil)
{ {
#if __GNUC__ #if __GNUC__
if (TYPE (CDR (x)) != PAIR) if (TYPE (CDR (x)) != TPAIR)
puts (" . "); puts (" . ");
#else #else
int c; int c;
c = CDR (x); c = CDR (x);
c = TYPE (c); c = TYPE (c);
if (c != PAIR) if (c != TPAIR)
puts (" . "); puts (" . ");
#endif #endif
display_ (CDR (x)); display_ (CDR (x));
@ -244,7 +229,7 @@ display_ (SCM x)
puts (")"); puts (")");
break; break;
} }
case SPECIAL: case TSPECIAL:
{ {
switch (x) switch (x)
{ {
@ -264,7 +249,7 @@ display_ (SCM x)
} }
break; break;
} }
case SYMBOL: case TSYMBOL:
{ {
switch (x) switch (x)
{ {

View file

@ -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))
()

View file

@ -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@'

View file

@ -4,8 +4,9 @@ MES=${MES-$(dirname $0)/mes}
prefix=module/ prefix=module/
echo '()' | cat $prefix/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS "$@" echo '()' | cat $prefix/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS "$@"
#paredit:|| #paredit:||
chmod +x a.out r=$?
exit $? ([ -f a.out ] && chmod +x a.out)
exit $r
!# !#
;;; Mes --- Maxwell Equations of Software ;;; Mes --- Maxwell Equations of Software

View file

@ -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)
()

View file

@ -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 '())
()

View file

@ -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)
()

View file

@ -10,7 +10,7 @@ exit $?
!# !#
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; This file is part of Mes.
;;; ;;;