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:
parent
b99f756367
commit
fc263de433
3
.gitignore
vendored
3
.gitignore
vendored
|
@ -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
|
||||||
|
|
99
GNUmakefile
99
GNUmakefile
|
@ -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
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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
16
lib.c
|
@ -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;
|
||||||
}
|
}
|
||||||
|
|
|
@ -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
38
mes.c
|
@ -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"))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
|
@ -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
|
||||||
|
))
|
||||||
|
|
|
@ -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
|
(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
61
posix.c
|
@ -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;
|
||||||
}
|
}
|
||||||
|
|
|
@ -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)
|
||||||
{
|
{
|
||||||
|
|
|
@ -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)
|
||||||
{
|
{
|
||||||
|
|
|
@ -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/
|
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
|
||||||
|
|
|
@ -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
|
;;; 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.
|
||||||
;;;
|
;;;
|
||||||
|
|
Loading…
Reference in a new issue