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
parent
b99f756367
commit
fc263de433
3
.gitignore
vendored
3
.gitignore
vendored
|
|
@ -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
|
||||
|
|
|
|||
99
GNUmakefile
99
GNUmakefile
|
|
@ -26,20 +26,21 @@ endif
|
|||
|
||||
-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
|
||||
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
|
||||
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 $@ $<
|
||||
|
||||
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 < $< > $@
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -18,19 +18,21 @@
|
|||
* 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
|
||||
|
|
|
|||
16
lib.c
16
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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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-
|
||||
|
|
|
|||
38
mes.c
38
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"))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
@ -661,8 +657,9 @@
|
|||
(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
|
||||
|
|
@ -1605,7 +1602,7 @@
|
|||
|
||||
;; ++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)
|
||||
|
|
@ -1617,7 +1614,7 @@
|
|||
|
||||
;; 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)
|
||||
|
|
@ -1629,7 +1626,7 @@
|
|||
|
||||
;; --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)
|
||||
|
|
@ -2451,13 +2448,14 @@
|
|||
|
||||
(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
|
||||
|
|
@ -2474,6 +2472,7 @@
|
|||
(loop (cdr elements) ((ast->info info) (car elements)))))))
|
||||
|
||||
(define (compile)
|
||||
(stderr "COMPILE\n")
|
||||
(let* ((ast (mescc))
|
||||
(info (make <info>
|
||||
#:functions i386:libc
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
@ -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
|
||||
()
|
||||
|
|
@ -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
|
||||
|
|
|
|||
61
posix.c
61
posix.c
|
|
@ -18,21 +18,66 @@
|
|||
* 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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -25,17 +25,6 @@
|
|||
|
||||
#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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
()
|
||||
|
|
@ -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@'
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
()
|
||||
|
|
@ -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 '())
|
||||
()
|
||||
|
|
@ -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)
|
||||
()
|
||||
|
|
@ -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.
|
||||
;;;
|
||||
|
|
|
|||
Loading…
Reference in a new issue