doc: Release update. WIP.

* AUTHORS: Update.
* HACKING: Update.
* NEWS: Update.
* doc/mes.guix: Update.
* scripts/mescc.in: Update.
* mes/module/mes/boot-0.scm.in: Update.

.gitignore

@@ -30,6 +30,7 @@
 *.mini-M1
 *.mini-guile
 *.mini-hex2
+*.a
 *.o
 *.seed-out
 *.stderr
@@ -37,6 +38,7 @@
 *.x86-out
 *.x86_64-mes-E
 *.x86_64-mes-S
+*.x86_64-mes-gcc-a
 *.x86_64-mes-gcc-o
 *.x86_64-mes-gcc-out
 *.x86_64-mes-gcc-stdout
@@ -75,16 +77,17 @@
 /doc/mescc.1
 /doc/version.texi
 
+/config.status
 /pre-inst-env
+/build.sh
+/check.sh
+/install.sh
+/uninstall.sh
 /mes/module/mes/boot-0.scm
 /scripts/mescc
 /doc/images/gcc-mesboot-graph.png
 /GNUmakefile
-/build.sh
-/check.sh
-/install.sh
 /pre-inst-env
-/uninstall.sh
 /doc/images/gcc-mesboot-graph.eps
 /doc/images/gcc-mesboot-graph.pdf
 /doc/web/

AUTHORS

@@ -18,6 +18,13 @@ scaffold/tests/98-fopen.c
 Han-Wen Nienhuys <hanwen@xs4all.nl>
 lib/string/memmem.c (_memmem, memmem)
 
+Peter de Wachter
+Small fixes and additions to
+lib/x86-mes/x86.M1
+lib/x86_64-mes/x86_64.M1
+include/stdint.h
+module/mescc/compile.mes
+
 rain1
 scaffold/tests/90-goto-var.c
 scaffold/tests/91-goto-array.c

NEWS

@@ -10,6 +10,70 @@ Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 
 Please send Mes bug reports to bug-mes@gnu.org.
 
+* Changes in 0.19 since 0.18
+** Core
+*** The build system has been simplified.
+*** Mes now prints a backtrace upon error.
+*** Performance has been improved 2-8 times, making Mes 2-10 times slower than Guile.
+*** Mes now supports a module type and uses a `boot-module'.
+*** Mes now supports a hash_table type.
+*** Mes now supports a struct type.
+*** Mes now supports building a %bootstrap-mes seed from Guix.
+** Language
+*** Records are now implemented using struct (WAS: vector).
+*** 44 new functions
+ceil,
+char-downcase,
+char-set-adjoin,
+char-set-complement,
+char-upcase,
+current-time,
+delete-file,
+dup,
+dup2,
+file-exists?,
+floor,
+frame-printer,
+get-internal-run-time,
+getcwd,
+gettimeofday,
+hash,
+hash-ref,
+hash-set!,
+hash-table-printer,
+hashq,
+hashq-get-handle,
+hashq-ref,
+hashq-set,
+inexact->exact,
+make-hash-table,
+make-stack,
+make-struct,
+module-define!,
+module-printer,
+module-ref,
+module-variable,
+read-line,
+round,
+stack-length,
+stack-ref,
+string-downcase,
+string-tokenize,
+string-upcase,
+struct-length,
+struct-ref,
+struct-set!
+struct-vtable,
+struct-vtable,
+with-error-to-file.
+** MesCC
+*** MesCC now supports compiling Bash.
+*** Assembly defines have been cleaned-up: duplicates deleted, missing added, wrong fixed.
+** Noteworthy bug fixes
+*** MesCC now supports the unary plus operator.
+*** MesCC now supports the `U' integer suffix.
+*** MesCC now comes with INTnn_MIN/MAX, UINTnn defines in stdint.h.
+*** MesCC now always exits non-zero when assembler or linker fail.
 * Changes in 0.18 since 0.17.1
 ** Core
 *** Mes/MesCC now supports x86_64.

build-aux/GNUmakefile.in

@@ -82,39 +82,21 @@ doc: build
 build:
 	./build.sh
 
-src/mes: build
-
-gcc:
-	${srcdest}build-aux/build-cc.sh
-
-mes-gcc:
-	${srcdest}build-aux/build-cc32.sh
-
-x86_64-mes-gcc:
-	${srcdest}build-aux/build-cc64.sh
-
-mes-tcc:
-ifdef TCC
-	CC32=$(TCC) ${srcdest}build-aux/build-cc32.sh
-else
-
-$(warning skipping mes-tcc: no tcc)
-endif
-
-mes:
-	${srcdest}build-aux/build-mes.sh
-
-x86_64-mes:
-	${srcdest}build-aux/build-x86_64-mes.sh
+src/${program_prefix}mes: build
 
 clean:
 	git clean -dfx\
+	    -e .config.make\
+	    -e config.status\
 	    -e GNUmakefile\
 	    -e build.sh\
 	    -e check.sh\
 	    -e install.sh\
-	    -e pre-inst-env\
 	    -e uninstall.sh\
+	    -e pre-inst-env\
+	    -e scripts/mescc\
+	    -e "mes"/module/mes/boot-0.scm\
+
 #
 
 # Mes does not cache anything on the file system; therefore clean
@@ -151,30 +133,6 @@ install:
 uninstall:
 	./uninstall.sh
 
-seed: all-go gcc mes-gcc x86_64-mes-gcc mes-tcc
-	cd $(MES_SEED) && git reset --hard HEAD
-	$(MAKE) MES=guile MES_SEED= SEED=1 mes
-	cp -v lib/x86-mes/*.S $(MES_SEED)/x86-mes
-	cp -v src/mes.S $(MES_SEED)/x86-mes
-	$(MAKE) MES=guile MES_SEED= SEED=1 x86_64-mes
-	cp -v lib/x86_64-mes/*.S $(MES_SEED)/x86_64-mes
-	cp -v src/mes.x86_64-mes-S $(MES_SEED)/x86_64-mes/mes.S
-	MES=$(GUILE) GUILE=$(GUILE) SEED=1 MES_SEED= ${srcdest}build-aux/build-mes.sh
-	MES=$(GUILE) GUILE=$(GUILE) SEED=1 MES_SEED= ${srcdest}build-aux/build-x86_64-mes.sh
-	cd $(MES_SEED) && MES_PREFIX=$(PWD) ./refresh.sh
-	MES=$(GUILE) GUILE=$(GUILE) SEED=1 ${srcdest}build-aux/build-mes.sh
-	cd $(MES_SEED) && MES_PREFIX=$(PWD) arch=x86_64-mes ./refresh.sh
-	MES=$(GUILE) GUILE=$(GUILE) SEED=1 ${srcdest}build-aux/build-x86_64-mes.sh
-	cp lib/x86-mes/libc+tcc.S\
-           lib/x86-mes/libc.S\
-           lib/x86-mes/crt1.S\
-           lib/x86-mes/libgetopt.S\
-           $(MESCC_TOOLS_SEED)/libs
-	cd $(MESCC_TOOLS_SEED) && MES_PREFIX=$(PWD) ./bootstrap.sh
-ifdef TCC
-	cd $(TINYCC_SEED) && MES_PREFIX=$(PWD) ./refresh.sh
-endif
-
 doc/version.texi: ${srcdest}doc/mes.texi GNUmakefile
 	@mkdir -p $(@D)
 	(set `LANG= date -r $< +'%d %B %Y'`;\
@@ -234,10 +192,10 @@ man: doc/mes.1 doc/mescc.1
 %: %.o
 %: %.c
 
-doc/mes.1: src/mes | build
+doc/mes.1: src/${program_prefix}mes | build
 	MES_ARENA=10000000 ./pre-inst-env $(HELP2MAN) $(<F) > $@
 
-doc/mescc.1: scripts/mescc src/mes | build
+doc/mescc.1: scripts/mescc src/${program_prefix}mes | build
 	MES_ARENA=10000000 ./pre-inst-env $(HELP2MAN) $(<F) > $@
 
 html: doc/html/index.html
@@ -320,7 +278,7 @@ tag:
 	git tag -s v$(VERSION) -m "GNU Mes $(VERSION)."
 
 # Release process
-#  0. doc: Release update, Release commit, make seed, test guix bootstrap
+#  0. doc: Release update, Release commit, test guix bootstrap
 #  1. make tag
 #  2. make dist
 #  3. make release
@@ -376,12 +334,8 @@ Usage: make [OPTION]... [TARGET]...
 Main and non-standard targets:
   all             update everything
   all-go          update .go files
-  gcc             update src/mes.gcc-out
   dist            update $(TARBALL)
   doc             update documentation
-  mes-gcc         update src/mes.mes-gcc-out
-  mes-tcc         update src/mes.mes-tcc-out
-  mes             update src/mes
   check           run unit tests
   clean           run git clean -dfx
   clean-go        clean .go files
@@ -389,7 +343,6 @@ Main and non-standard targets:
   install         install in $(prefix)
   install-info    install info docs in $(prefix)/share/info
   release         dist and tag
-  seed            update mes-seed in $(MES_SEED)
   uninstall       uninstall from $(prefix)
 endef
 export HELP_TOP

build-aux/bootstrap-mes.sh

@@ -0,0 +1,101 @@
+#! /bin/sh
+
+# GNU Mes --- Maxwell Equations of Software
+# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of GNU Mes.
+#
+# GNU 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.
+#
+# GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+. ./config.status
+. ${srcdest}build-aux/config.sh
+. ${srcdest}build-aux/trace.sh
+
+set -e
+
+# FIXME?
+#mes_program_prefix=boot-$arch-
+mes_program_prefix=$program_prefix
+trace "HEX2       0exit-42" $HEX2\
+      $HEX2FLAGS\
+      -f ${srcdest}lib/$mes_arch/elf$bits-0header.hex2\
+      -f ${srcdest}lib/$mes_arch/elf$bits-body-exit-42.hex2\
+      -f ${srcdest}lib/$mes_arch/elf-0footer.hex2\
+      --exec_enable\
+      -o lib/$mes_arch/${mes_program_prefix}0exit-42
+
+trace "TEST       lib/$mes_arch/${mes_program_prefix}0exit-42" echo lib/$mes_arch/${mes_program_prefix}0exit-42
+{ set +e; lib/$mes_arch/${mes_program_prefix}0exit-42; r=$?; set -e; }
+[ $r != 42 ] && echo "  => $r" && exit 1
+
+trace "HEX2       exit-42" $HEX2\
+      $HEX2FLAGS\
+      -f ${srcdest}lib/$mes_arch/elf$bits-header.hex2\
+      -f ${srcdest}lib/$mes_arch/elf$bits-body-exit-42.hex2\
+      -f ${srcdest}lib/$mes_arch/elf$bits-footer-single-main.hex2\
+      --exec_enable\
+      -o lib/$mes_arch/${mes_program_prefix}exit-42
+
+trace "TEST       lib/$mes_arch/${mes_program_prefix}exit-42" echo lib/$mes_arch/${mes_program_prefix}exit-42
+{ set +e; lib/$mes_arch/${mes_program_prefix}exit-42; r=$?; set -e; }
+[ $r != 42 ] && echo "  => $r" && exit 1
+
+
+mkdir -p lib/$mes_arch
+trace "M1         crt1.S" $M1\
+      $M1FLAGS\
+      -f ${srcdest}lib/$mes_arch/$arch.M1\
+      -f $MES_SEED/$mes_arch/crt1.S\
+      -o lib/$mes_arch/crt1.o
+trace "M1         libc.S" $M1\
+      $M1FLAGS\
+      -f ${srcdest}lib/$mes_arch/$arch.M1\
+      -f $MES_SEED/$mes_arch/libc.S\
+      -o lib/$mes_arch/libc.o
+trace "M1         mes.S" $M1\
+      --LittleEndian\
+      --Architecture 1\
+      -f ${srcdest}lib/$mes_arch/$arch.M1\
+      -f $MES_SEED/$mes_arch/mes.S\
+      -o src/mes.o
+trace "BLOOD_ELF  mes.S" $BLOOD_ELF\
+      -f ${srcdest}lib/$mes_arch/$arch.M1\
+      -f $MES_SEED/$mes_arch/mes.S\
+      -f $MES_SEED/$mes_arch/libc.S\
+        -o src/mes.S.blood-elf
+trace "M1         mes.blood-elf" $M1\
+      --LittleEndian\
+      --Architecture 1\
+      -f src/mes.S.blood-elf\
+      -o src/mes.o.blood-elf
+trace "HEX2       mes.o" $HEX2\
+      $HEX2FLAGS\
+      -f ${srcdest}lib/$mes_arch/elf$bits-header.hex2\
+      -f lib/$mes_arch/crt1.o\
+      -f lib/$mes_arch/libc.o\
+      -f src/mes.o\
+      -f src/mes.o.blood-elf\
+      --exec_enable\
+      -o src/${mes_program_prefix}mes
+#cp src/${mes_program_prefix}mes src/${program_prefix}mes
+trace "M1         libc+tcc.S" $M1\
+      $M1FLAGS\
+      -f ${srcdest}lib/$mes_arch/$arch.M1\
+      -f $MES_SEED/$mes_arch/libc+tcc.S\
+      -o lib/$mes_arch/libc+tcc.o
+trace "M1         libc+gnu.S" $M1\
+      $M1FLAGS\
+      -f ${srcdest}lib/$mes_arch/$arch.M1\
+      -f $MES_SEED/$mes_arch/libc+gnu.S\
+      -o lib/$mes_arch/libc+gnu.o

build-aux/build-cc.sh

@@ -1,37 +0,0 @@
-#! /bin/sh
-
-# GNU Mes --- Maxwell Equations of Software
-# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-#
-# This file is part of GNU Mes.
-#
-# GNU 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.
-#
-# GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-set -e
-
-. ${srcdest}build-aux/config.sh
-. ${srcdest}build-aux/trace.sh
-
-# native
-trace "SNARF      gc.c"     ${srcdest}build-aux/mes-snarf.scm src/gc.c
-trace "SNARF      lib.c"    ${srcdest}build-aux/mes-snarf.scm src/lib.c
-trace "SNARF      math.c"   ${srcdest}build-aux/mes-snarf.scm src/math.c
-trace "SNARF      mes.c"    ${srcdest}build-aux/mes-snarf.scm src/mes.c
-trace "SNARF      posix.c"  ${srcdest}build-aux/mes-snarf.scm src/posix.c
-trace "SNARF      reader.c" ${srcdest}build-aux/mes-snarf.scm src/reader.c
-trace "SNARF      vector.c" ${srcdest}build-aux/mes-snarf.scm src/vector.c
-
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc.sh lib/libmes
-sh ${srcdest}build-aux/cc.sh src/mes
-cp src/mes.gcc-out src/mes

build-aux/build-cc32.sh

@@ -1,75 +0,0 @@
-#! /bin/sh
-
-# GNU Mes --- Maxwell Equations of Software
-# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-#
-# This file is part of GNU Mes.
-#
-# GNU 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.
-#
-# GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-set -e
-
-. ${srcdest}build-aux/config.sh
-. ${srcdest}build-aux/trace.sh
-
-LIBC=${LIBC-c}
-
-##moduledir=${moduledir-${datadir}${datadir:+/}module}
-
-# native
-# trace "SNARF      gc.c"     ${srcdest}build-aux/mes-snarf.scm src/gc.c
-# trace "SNARF      lib.c"    ${srcdest}build-aux/mes-snarf.scm src/lib.c
-# trace "SNARF      math.c"   ${srcdest}build-aux/mes-snarf.scm src/math.c
-# trace "SNARF      mes.c"    ${srcdest}build-aux/mes-snarf.scm src/mes.c
-# trace "SNARF      posix.c"  ${srcdest}build-aux/mes-snarf.scm src/posix.c
-# trace "SNARF      reader.c" ${srcdest}build-aux/mes-snarf.scm src/reader.c
-# trace "SNARF      vector.c" ${srcdest}build-aux/mes-snarf.scm src/vector.c
-
-# cc32-mes
-trace "SNARF.mes  gc.c"     ${srcdest}build-aux/mes-snarf.scm --mes src/gc.c
-trace "SNARF.mes  lib.c"    ${srcdest}build-aux/mes-snarf.scm --mes src/lib.c
-trace "SNARF.mes  math.c"   ${srcdest}build-aux/mes-snarf.scm --mes src/math.c
-trace "SNARF.mes  mes.c"    ${srcdest}build-aux/mes-snarf.scm --mes src/mes.c
-trace "SNARF.mes  posix.c"  ${srcdest}build-aux/mes-snarf.scm --mes src/posix.c
-trace "SNARF.mes  reader.c" ${srcdest}build-aux/mes-snarf.scm --mes src/reader.c
-trace "SNARF.mes  vector.c" ${srcdest}build-aux/mes-snarf.scm --mes src/vector.c
-
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/linux/x86-mes-gcc/crt0
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/linux/x86-mes-gcc/crt1
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/linux/x86-mes-gcc/crti
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/linux/x86-mes-gcc/crtn
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc-mini
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc+tcc
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libtcc1
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc+gnu
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libg
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libgetopt
-
-LIBC= sh ${srcdest}build-aux/cc32-mes.sh scaffold/main
-LIBC=c-mini sh ${srcdest}build-aux/cc32-mes.sh scaffold/hello
-LIBC=c-mini sh ${srcdest}build-aux/cc32-mes.sh scaffold/argv
-sh ${srcdest}build-aux/cc32-mes.sh scaffold/read
-sh ${srcdest}build-aux/cc32-mes.sh scaffold/malloc
-sh ${srcdest}build-aux/cc32-mes.sh scaffold/micro-mes
-sh ${srcdest}build-aux/cc32-mes.sh scaffold/tiny-mes
-sh ${srcdest}build-aux/cc32-mes.sh scaffold/mini-mes
-
-sh ${srcdest}build-aux/cc32-mes.sh src/mes
-
-if [ "$CC32" = "$TCC" ]; then
-    cp src/mes.mes-tcc-out src/mes
-else
-    cp src/mes.mes-gcc-out src/mes
-fi

build-aux/build-cc64.sh

@@ -1,60 +0,0 @@
-#! /bin/sh
-
-# GNU Mes --- Maxwell Equations of Software
-# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-#
-# This file is part of GNU Mes.
-#
-# GNU 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.
-#
-# GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-set -e
-
-. ${srcdest}build-aux/config.sh
-. ${srcdest}build-aux/trace.sh
-
-LIBC=${LIBC-c}
-
-# cc64-mes
-trace "SNARF.mes  gc.c"     ${srcdest}build-aux/mes-snarf.scm --mes src/gc.c
-trace "SNARF.mes  lib.c"    ${srcdest}build-aux/mes-snarf.scm --mes src/lib.c
-trace "SNARF.mes  math.c"   ${srcdest}build-aux/mes-snarf.scm --mes src/math.c
-trace "SNARF.mes  mes.c"    ${srcdest}build-aux/mes-snarf.scm --mes src/mes.c
-trace "SNARF.mes  posix.c"  ${srcdest}build-aux/mes-snarf.scm --mes src/posix.c
-trace "SNARF.mes  reader.c" ${srcdest}build-aux/mes-snarf.scm --mes src/reader.c
-trace "SNARF.mes  vector.c" ${srcdest}build-aux/mes-snarf.scm --mes src/vector.c
-
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/linux/x86_64-mes-gcc/crt0
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/linux/x86_64-mes-gcc/crt1
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/linux/x86_64-mes-gcc/crti
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/linux/x86_64-mes-gcc/crtn
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc-mini
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc+tcc
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libtcc1
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc+gnu
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libg
-ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libgetopt
-
-LIBC= sh ${srcdest}build-aux/cc64-mes.sh scaffold/main
-LIBC=c-mini sh ${srcdest}build-aux/cc64-mes.sh scaffold/hello
-LIBC=c-mini sh ${srcdest}build-aux/cc64-mes.sh scaffold/argv
-sh ${srcdest}build-aux/cc64-mes.sh scaffold/read
-sh ${srcdest}build-aux/cc64-mes.sh scaffold/malloc
-sh ${srcdest}build-aux/cc64-mes.sh scaffold/micro-mes
-sh ${srcdest}build-aux/cc64-mes.sh scaffold/tiny-mes
-# sh ${srcdest}build-aux/cc64-mes.sh scaffold/cons-mes
-sh ${srcdest}build-aux/cc64-mes.sh scaffold/mini-mes
-
-sh ${srcdest}build-aux/cc64-mes.sh src/mes
-cp src/mes.x86_64-mes-gcc-out src/mes

build-aux/build-guile.sh

@@ -18,12 +18,12 @@
 # You should have received a copy of the GNU General Public License
 # along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-. ${srcdest}build-aux/trace.sh
+if [ ! "$config_status" ]; then
+    . ./config.status
+fi
 
-export GUILE
-export GUILE_AUTO_COMPILE
-GUILE=${GUILE-$(command -v guile)}
-GUILE_TOOLS=${GUILE_TOOLS-$(command -v guile-tools)}
+. ${srcdest}build-aux/config.sh
+. ${srcdest}build-aux/trace.sh
 GUILE_AUTO_COMPILE=0
 
 set -e
@@ -58,12 +58,10 @@ if [ "$GUILE_EFFECTIVE_VERSION" = "2.0" ]; then
     srcdest=$abs_top_srcdir/
 fi
 
-GUILE_AUTO_COMPILE=0
-
 for i in $SCM_FILES $SCRIPTS; do
     b=$(basename $i)
     go=${i%%.scm}.go
     if [ $i -nt $go ]; then
-        trace "GUILEC     $b" $GUILE_TOOLS compile -L ${srcdest}module -L ${srcdest}build-aux -L ${srcdest}scripts -o $go $i
+        trace "GUILEC     $b" $GUILD compile -L ${srcdest}module -L ${srcdest}build-aux -L ${srcdest}scripts -o $go $i
     fi
 done

build-aux/build-mes.sh

@@ -1,7 +1,7 @@
 #! /bin/sh
 
 # GNU Mes --- Maxwell Equations of Software
-# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 #
 # This file is part of GNU Mes.
 #
@@ -18,140 +18,65 @@
 # You should have received a copy of the GNU General Public License
 # along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-. ${srcdest}build-aux/config.sh
-. ${srcdest}build-aux/trace.sh
-
-GUILE=${GUILE-guile}
-if [ -z "$GUILE" -o "$GUILE" = "true" ] || ! command -v $GUILE > /dev/null; then
-    GUILE=src/mes
-fi
-
-[ -z "$MESCC" ] && MESCC=scripts/mescc
-MES=${MES-$(command -v mes)}
-[ -z "$MES" ] && MES=src/mes
-
 set -e
 
-trace "HEX2       0exit-42" $HEX2\
-    --LittleEndian\
-    --Architecture 1\
-    --BaseAddress 0x1000000\
-    -f ${srcdest}lib/x86-mes/elf32-0header.hex2\
-    -f ${srcdest}lib/x86-mes/elf32-body-exit-42.hex2\
-    -f ${srcdest}lib/x86-mes/elf-0footer.hex2\
-    --exec_enable\
-    -o lib/x86-mes/0exit-42.x86-out
-
-trace "TEST       lib/x86-mes/0exit-42.x86-out" echo lib/x86-mes/0exit-42.x86-out
-{ set +e; lib/x86-mes/0exit-42.x86-out; r=$?; set -e; }
-[ $r != 42 ] && echo "  => $r" && exit 1
-
-trace "HEX2       0exit-42" $HEX2\
-    --LittleEndian\
-    --Architecture 1\
-    --BaseAddress 0x1000000\
-    -f ${srcdest}lib/x86-mes/elf32-header.hex2\
-    -f ${srcdest}lib/x86-mes/elf32-body-exit-42.hex2\
-    -f ${srcdest}lib/x86-mes/elf32-footer-single-main.hex2\
-    --exec_enable\
-    -o lib/x86-mes/exit-42.x86-out
-
-trace "TEST       lib/x86-mes/exit-42.x86-out" echo lib/x86-mes/exit-42.x86-out
-{ set +e; lib/x86-mes/exit-42.x86-out; r=$?; set -e; }
-[ $r != 42 ] && echo "  => $r" && exit 1
-
-if [ -d "$MES_SEED" ]; then
-    mkdir -p lib/x86-mes
-    trace "M1         crt1.S" $M1\
-        $M1FLAGS\
-        -f ${srcdest}lib/x86-mes/x86.M1\
-        -f $MES_SEED/x86-mes/crt1.S\
-        -o lib/x86-mes/crt1.o
-    trace "M1         libc.S" $M1\
-        $M1FLAGS\
-        -f ${srcdest}lib/x86-mes/x86.M1\
-        -f $MES_SEED/x86-mes/libc.S\
-        -o lib/x86-mes/libc.o
-    trace "M1         mes.S" $M1\
-        --LittleEndian\
-        --Architecture 1\
-        -f ${srcdest}lib/x86-mes/x86.M1\
-        -f $MES_SEED/x86-mes/mes.S\
-        -o src/mes.o
-    trace "BLOOD_ELF  mes.S" $BLOOD_ELF\
-        -f ${srcdest}lib/x86-mes/x86.M1\
-        -f $MES_SEED/x86-mes/mes.S\
-        -f $MES_SEED/x86-mes/libc.S\
-        -o src/mes.S.blood-elf
-    trace "M1         mes.blood-elf" $M1\
-        --LittleEndian\
-        --Architecture 1\
-        -f src/mes.S.blood-elf\
-        -o src/mes.o.blood-elf
-    trace "HEX2       mes.o" $HEX2\
-        $HEX2FLAGS\
-        -f ${srcdest}lib/x86-mes/elf32-header.hex2\
-        -f lib/x86-mes/crt1.o\
-        -f lib/x86-mes/libc.o\
-        -f src/mes.o\
-        -f src/mes.o.blood-elf\
-        --exec_enable\
-        -o src/mes.seed-out
-    cp src/mes.seed-out src/mes
-    trace "M1         libc+tcc.S" $M1\
-        $M1FLAGS\
-        -f ${srcdest}lib/x86-mes/x86.M1\
-        -f $MES_SEED/x86-mes/libc+tcc.S\
-        -o lib/x86-mes/libc+tcc.o
+if [ ! "$config_status" ]; then
+    . ./config.status
 fi
 
-PREPROCESS=1
-if [ ! -d "$MES_SEED" ] \
-       && [ "$arch" = "i386" \
-            -o "$arch" = "i586" \
-            -o "$arch" = "i686" ]; then
-    MES_ARENA=100000000
-fi
+. ${srcdest}build-aux/config.sh
+. ${srcdest}build-aux/trace.sh
+. ${srcdest}build-aux/cc.sh
 
-MES_ARENA=100000000
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/x86-mes/crt1
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc-mini
-MES_LIBS='-l c-mini' PREPROCESS= bash ${srcdest}build-aux/cc-mes.sh lib/x86-mes/exit-42
+[ "$mes_p" ] && (program_prefix= compile lib/linux/$mes_arch/crt1)
+[ "$mes_p" -a ! "$gcc_p" ] && cp -f lib/linux/$mes_arch/crt1.S lib/$mes_arch/crt1.S
+[ "$mes_p" -a ! "$gcc_p" ] && cp -f lib/linux/$mes_arch/crt1.o lib/$mes_arch/crt1.o
 
-trace "TEST       lib/x86-mes/exit-42.mes-out" echo lib/x86-mes/exit-42.mes-out
-{ set +e; lib/x86-mes/exit-42.mes-out; r=$?; set -e; }
-[ $r != 42 ] && echo "  => $r" && exit 1
+[ ! "$mesc_p" -a ! "$posix_p" ] && (program_prefix= compile lib/linux/$mes_arch/crt0)
+[ "$mes_p" -a "$gcc_p" ] && (program_prefix= compile lib/linux/$mes_arch/crti)
+[ "$mes_p" -a "$gcc_p" ] && (program_prefix= compile lib/linux/$mes_arch/crtn)
 
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc+tcc
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc+gnu
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libgetopt
+[ ! "$mes_p" -a ! "$mesc_p" ] && compile lib/libmes
+[ ! "$mes_p" -a ! "$mesc_p" ] && archive lib/libmes
 
-MES_ARENA=${MES_ARENA-100000000}
-trace "SNARF.mes  gc.c"     ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/gc.c
-trace "SNARF.mes  lib.c"    ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/lib.c
-trace "SNARF.mes  math.c"   ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/math.c
-trace "SNARF.mes  mes.c"    ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/mes.c
-trace "SNARF.mes  posix.c"  ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/posix.c
-trace "SNARF.mes  reader.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/reader.c
-trace "SNARF.mes  vector.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/vector.c
+[ "$mes_p" ] && compile lib/libc-mini
+[ "$mes_p" ] && archive lib/libc-mini
 
-if [ -n "$SEED" ]; then
-    bash ${srcdest}build-aux/cc-mes.sh src/mes
-    exit 0
-fi
+[ "$mes_p" ] && compile lib/libc
+[ "$mes_p" ] && archive lib/libc
 
-MES_LIBS='-l none' bash ${srcdest}build-aux/cc-mes.sh scaffold/main
+[ "$mes_p"  ] && compile lib/libc+tcc
+[ "$mes_p"  ] && archive lib/libc+tcc
 
-trace "TEST       scaffold/main.mes-out" echo scaffold/main.mes-out
-{ set +e; scaffold/main.mes-out; r=$?; set -e; }
-[ $r != 42 ] && echo "  => $r" && exit 1
+[ "$mes_p" ] && compile lib/libc+gnu
+[ "$mes_p" ] && archive lib/libc+gnu
 
-MES_LIBS='-l c-mini' bash ${srcdest}build-aux/cc-mes.sh scaffold/hello
-MES_LIBS='-l c-mini' bash ${srcdest}build-aux/cc-mes.sh scaffold/argv
-bash ${srcdest}build-aux/cc-mes.sh scaffold/malloc
-##sh ${srcdest}build-aux/cc-mes.sh scaffold/micro-mes
-##sh ${srcdest}build-aux/cc-mes.sh scaffold/tiny-mes
-# bash ${srcdest}build-aux/cc-mes.sh scaffold/mini-mes
-bash ${srcdest}build-aux/cc-mes.sh src/mes
-cp src/mes.mes-out src/mes
+[ "$mes_p" -a ! "$mesc_p" ] && compile lib/libtcc1
+[ "$mes_p" -a ! "$mesc_p" ] && archive lib/libtcc1
+
+[ "$mes_p" -a ! "$mesc_p" ] && compile lib/libg
+[ "$mes_p" -a ! "$mesc_p" ] && archive lib/libg
+
+[ "$mes_p" -a ! "$mesc_p" ] && compile lib/libgetopt
+[ "$mes_p" -a ! "$mesc_p" ] && archive lib/libgetopt
+
+compile scaffold/main
+(libc= link scaffold/main)
+
+compile scaffold/hello
+(libc="-l c-mini" link scaffold/hello)
+
+compile scaffold/argv
+(libc="-l c-mini" link scaffold/argv)
+
+[ "$mes_p" ] && compile scaffold/malloc
+[ "$mes_p" ] && link scaffold/malloc
+[ "$mes_p" ] && compile scaffold/micro-mes
+[ "$mes_p" ] && link scaffold/micro-mes
+[ "$mes_p" ] && compile scaffold/tiny-mes
+[ "$mes_p" ] && link scaffold/tiny-mes
+[ "$mes_p" ] && compile scaffold/mini-mes
+[ "$mes_p" ] && link scaffold/mini-mes
+
+compile src/mes
+link src/mes

build-aux/build-x86_64-mes.sh

@@ -1,153 +0,0 @@
-#! /bin/sh
-
-# GNU Mes --- Maxwell Equations of Software
-# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-#
-# This file is part of GNU Mes.
-#
-# GNU 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.
-#
-# GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-. ${srcdest}build-aux/config.sh
-. ${srcdest}build-aux/trace.sh
-
-GUILE=${GUILE-guile}
-if [ -z "$GUILE" -o "$GUILE" = "true" ] || ! command -v $GUILE > /dev/null; then
-    GUILE=src/mes
-fi
-
-[ -z "$MESCC" ] && MESCC=scripts/mescc
-MES=${MES-$(command -v mes)}
-[ -z "$MES" ] && MES=src/mes
-
-set -e
-
-trace "HEX2       0exit-42" $HEX2\
-    --LittleEndian\
-    --Architecture 2\
-    --BaseAddress 0x1000000\
-    -f ${srcdest}lib/x86_64-mes/elf64-0header.hex2\
-    -f ${srcdest}lib/x86_64-mes/elf64-body-exit-42.hex2\
-    -f ${srcdest}lib/x86_64-mes/elf-0footer.hex2\
-    --exec_enable\
-    -o lib/x86_64-mes/0exit-42.x86_64-out
-
-trace "TEST       lib/x86_64-mes/0exit-42.x86_64-out" echo lib/x86_64-mes/0exit-42.x86_64-out
-{ set +e; lib/x86_64-mes/0exit-42.x86_64-out; r=$?; set -e; }
-[ $r != 42 ] && echo "  => $r" && exit 1
-
-trace "HEX2       0exit-42" $HEX2\
-    --LittleEndian\
-    --Architecture 2\
-    --BaseAddress 0x1000000\
-    -f ${srcdest}lib/x86_64-mes/elf64-header.hex2\
-    -f ${srcdest}lib/x86_64-mes/elf64-body-exit-42.hex2\
-    -f ${srcdest}lib/x86_64-mes/elf64-footer-single-main.hex2\
-    --exec_enable\
-    -o lib/x86_64-mes/exit-42.x86_64-out
-
-trace "TEST       lib/x86_64-mes/exit-42.x86_64-out" echo lib/x86_64-mes/exit-42.x86_64-out
-{ set +e; lib/x86_64-mes/exit-42.x86_64-out; r=$?; set -e; }
-[ $r != 42 ] && echo "  => $r" && exit 1
-
-if [ -d "$MES_SEED" ]; then
-    mkdir -p lib/x86_64-mes
-    trace "M1         crt1.S" $M1\
-        $M1FLAGS\
-        -f ${srcdest}lib/x86_64-mes/x86_64.M1\
-        -f $MES_SEED/x86_64-mes/crt1.S\
-        -o lib/x86_64-mes/crt1.o
-    trace "M1         libc.S" $M1\
-        $M1FLAGS\
-        -f ${srcdest}lib/x86_64-mes/x86_64.M1\
-        -f $MES_SEED/x86_64-mes/libc.S\
-        -o lib/x86_64-mes/libc.o
-    trace "M1         mes.S" $M1\
-        --LittleEndian\
-        --Architecture 2\
-        -f ${srcdest}lib/x86_64-mes/x86_64.M1\
-        -f $MES_SEED/x86_64-mes/mes.S\
-        -o src/mes.o
-    trace "BLOOD_ELF  mes.S" $BLOOD_ELF\
-        -f ${srcdest}lib/x86_64-mes/x86_64.M1\
-        -f $MES_SEED/x86_64-mes/mes.S\
-        -f $MES_SEED/x86_64-mes/libc.S\
-        -o src/mes.S.blood-elf
-    trace "M1         mes.blood-elf" $M1\
-        --LittleEndian\
-        --Architecture 2\
-        -f src/mes.S.blood-elf\
-        -o src/mes.o.blood-elf
-    trace "HEX2       mes.o" $HEX2\
-        $HEX2FLAGS\
-        -f ${srcdest}lib/x86_64-mes/elf64-header.hex2\
-        -f lib/x86_64-mes/crt1.o\
-        -f lib/x86_64-mes/libc.o\
-        -f src/mes.o\
-        -f src/mes.o.blood-elf\
-        --exec_enable\
-        -o src/mes.seed-out
-    cp src/mes.seed-out src/mes
-    trace "M1         libc+tcc.S" $M1\
-        $M1FLAGS\
-        -f ${srcdest}lib/x86_64-mes/x86_64.M1\
-        -f $MES_SEED/x86_64-mes/libc+tcc.S\
-        -o lib/x86_64-mes/libc+tcc.o
-fi
-
-
-PREPROCESS=1
-MES_ARENA=100000000
-
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/linux/x86_64-mes/crt1
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc-mini
-MES_LIBS='-l c-mini' PREPROCESS= bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/x86_64-mes/exit-42
-
-trace "TEST       lib/x86_64-mes/exit-42.x86_64-mes-out" echo lib/x86_64-mes/exit-42.x86_64-mes-out
-{ set +e; lib/x86_64-mes/exit-42.x86_64-mes-out; r=$?; set -e; }
-[ $r != 42 ] && echo "  => $r" && exit 1
-
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc+tcc
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc+gnu
-ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libgetopt
-
-MES_ARENA=${MES_ARENA-100000000}
-trace "SNARF.mes  gc.c"     ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/gc.c
-trace "SNARF.mes  lib.c"    ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/lib.c
-trace "SNARF.mes  math.c"   ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/math.c
-trace "SNARF.mes  mes.c"    ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/mes.c
-trace "SNARF.mes  posix.c"  ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/posix.c
-trace "SNARF.mes  reader.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/reader.c
-trace "SNARF.mes  vector.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/vector.c
-
-if [ -n "$SEED" ]; then
-    bash ${srcdest}build-aux/cc-mes.sh src/mes
-    exit 0
-fi
-
-MES_LIBS='-l none' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/main
-
-trace "TEST       scaffold/main.x86_64-mes-out" echo scaffold/main.x86_64-mes-out
-{ set +e; scaffold/main.x86_64-mes-out; r=$?; set -e; }
-[ $r != 42 ] && echo "  => $r" && exit 1
-
-MES_LIBS='-l c-mini' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/hello
-MES_LIBS='-l c-mini' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/argv
-bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/malloc
-sh ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/micro-mes
-sh ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/tiny-mes
-bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/mini-mes
-bash ${srcdest}build-aux/cc-x86_64-mes.sh src/mes
-# not yet, broken
-# cp src/mes.x86_64-mes-out src/mes

build-aux/build.sh.in

@@ -1,7 +1,7 @@
-#! @BASH@
+#! /bin/sh
 
 # GNU Mes --- Maxwell Equations of Software
-# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 #
 # This file is part of GNU Mes.
 #
@@ -18,42 +18,43 @@
 # You should have received a copy of the GNU General Public License
 # along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-srcdest="@srcdest@"
-srcdir="@srcdir@"
-abs_top_srcdir="@abs_top_srcdir@"
-abs_top_builddir="@abs_top_builddir@"
-prefix=${prefix-@prefix@}
-VERSION=${VERSION-@VERSION@}
-arch=${arch-@arch@}
+set -e
 
+. ./config.status
 . ${srcdest}build-aux/config.sh
-. ${srcdest}build-aux/trace.sh
-
-MES_SEED=${MES_SEED-../mes-seed}
-GUILE=${GUILE-$(command -v guile)}
-MES_ARENA=${MES_ARENA-100000000}
 
 if [ -n "$GUILE" -a "$GUILE" != true ]; then
     sh ${srcdest}build-aux/build-guile.sh
 fi
 
-if [ -n "$CC" ]; then
-    sh ${srcdest}build-aux/build-cc.sh
+if [ ! "$mes_p" ]; then
+    sh ${srcdest}build-aux/snarf.sh
+#elif [ ! -d "$MES_SEED" ]; then
+#else
+fi
+sh ${srcdest}build-aux/snarf.sh --mes
+
+if [ "$gcc_p$tcc_p" ]; then
+    sh ${srcdest}build-aux/build-mes.sh
+elif [ -d "$MES_SEED" ]; then
+    sh ${srcdest}build-aux/bootstrap-mes.sh
 fi
 
-if [ -n "$CC32" ]; then
-    sh ${srcdest}build-aux/build-cc32.sh
-fi
-
-if [ -n "$CC64" ]; then
-    sh ${srcdest}build-aux/build-cc64.sh
-fi
-
-if [ -n "$TCC" ]; then
-    CC32=$TCC sh ${srcdest}build-aux/build-cc32.sh
-fi
+## FIXME: remove this and have user configure/build/install for each compiler?
+unset CFLAGS CPPFLAGS LDFLAGS gcc_p tcc_p posix_p
+MES=guile
+mesc_p=1
+mes_p=1
+mes_arch=x86-mes
+program_prefix=$mes_arch-
+CC="./pre-inst-env mescc"
 
 sh ${srcdest}build-aux/build-mes.sh
-if [ "$arch" = x86_64 -a "$GUILE" ]; then
-    MES=$GUILE sh ${srcdest}build-aux/build-x86_64-mes.sh
+cp src/${program_prefix}mes src/mes
+
+if [ "$arch" = x86_64 ]; then
+    MES_CFLAGS='-m 64'
+    mes_arch=x86_64-mes
+    program_prefix=$mes_arch-
+    sh ${srcdest}build-aux/build-mes.sh
 fi

build-aux/cc-mes.sh

@@ -1,67 +0,0 @@
-#! /bin/sh
-
-# GNU Mes --- Maxwell Equations of Software
-# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-#
-# This file is part of GNU Mes.
-#
-# GNU 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.
-#
-# GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-set -e
-
-. ${srcdest}build-aux/config.sh
-. ${srcdest}build-aux/trace.sh
-
-MESCC=${MESCC-$(command -v mescc)}
-[ -z "$MESCC" ] && MESCC=scripts/mescc
-MES=${MES-$(command -v mes)}
-[ -z "$MES" ] && MES=src/mes
-
-if [ "$V" = 2 ]; then
-    MES_CFLAGS="$MES_CFLAGS -v"
-fi
-
-c=$1
-
-set -e
-
-if [ -z "$ARCHDIR" ]; then
-    o="$c"
-    d=${c%%/*}
-    p="mes-"
-else
-    b=${c##*/}
-    d=${c%%/*}/x86-mes
-    o="$d/$b"
-fi
-mkdir -p $d
-
-if [ -n "$PREPROCESS" ]; then
-    trace "CPP.mes    $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES_CFLAGS -E -o "$o.E" "${srcdest}$c".c
-    trace "CC.mes     $c.E" ./pre-inst-env bash $MESCC $MES_CFLAGS -S "$o".E
-    trace "AS.mes     $c.S" ./pre-inst-env bash $MESCC $MES_CFLAGS -c -o "$o".${p}o "$o".S
-    if [ -z "$NOLINK" ]; then
-        trace "LD.mes     $c.o" ./pre-inst-env bash $MESCC $MES_CFLAGS -o "$o".${p}out "$o".${p}o $MES_LIBS
-    fi
-elif [ -n "$COMPILE" ]; then
-    trace "CC.mes     $c.c" trace "MESCC $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES_CFLAGS -S -o "$o.S" "${srcdest}$c".c
-    trace "AS.mes     $c.S" ./pre-inst-env bash $MESCC $MES_CFLAGS -c -o "$o".${p}o "$o".S
-    if [ -z "$NOLINK" ]; then
-        trace "LD.mes     $c.o" ./pre-inst-env bash $MESCC $MES_CFLAGS -o "$o".${p}out "$o".${p}o $MES_LIBS
-    fi
-elif [ -z "$NOLINK" ]; then
-    trace "CC.mes     $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES_CFLAGS -o "$o".${p}out "${srcdest}$c".c $MES_LIBS
-else
-   trace "CC.mes     $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES_CFLAGS -c -o "$o".${p}o "${srcdest}$c".c
-fi

build-aux/cc-x86_64-mes.sh

@@ -1,67 +0,0 @@
-#! /bin/sh
-
-# GNU Mes --- Maxwell Equations of Software
-# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-#
-# This file is part of GNU Mes.
-#
-# GNU 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.
-#
-# GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-set -e
-
-. ${srcdest}build-aux/config.sh
-. ${srcdest}build-aux/trace.sh
-
-MESCC=${MESCC-$(command -v mescc)}
-[ -z "$MESCC" ] && MESCC=scripts/mescc
-MES=${MES-$(command -v mes)}
-[ -z "$MES" ] && MES=src/mes
-
-if [ "$V" = 2 ]; then
-    MES64_CFLAGS="$MES64_CFLAGS -v"
-fi
-
-c=$1
-
-set -e
-
-if [ -z "$ARCHDIR" ]; then
-    o="$c"
-    d=${c%%/*}
-    p="x86_64-mes-"
-else
-    b=${c##*/}
-    d=${c%%/*}/x86_64-mes
-    o="$d/$b"
-fi
-mkdir -p $d
-
-if [ -n "$PREPROCESS" ]; then
-    trace "CPP.mes64  $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -E -o "$o.${p}E" "${srcdest}$c".c
-    trace "CC.mes64   $c.E" ./pre-inst-env bash $MESCC $MES64_CFLAGS -S -o "$o".${p}S "$o".${p}E
-    trace "AS.mes64   $c.S" ./pre-inst-env bash $MESCC $MES64_CFLAGS -c -o "$o".${p}o "$o".${p}S
-    if [ -z "$NOLINK" ]; then
-        trace "LD.mes64   $c.o" ./pre-inst-env bash $MESCC $MES64_CFLAGS -o "$o".${p}out "$o".${p}o $MES_LIBS
-    fi
-elif [ -n "$COMPILE" ]; then
-    trace "CC.mes64   $c.c" trace "MESCC $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -S -o "$o".${p}S "${srcdest}$c".c
-    trace "AS.mes64   $c.S" ./pre-inst-env bash $MESCC $MES64_CFLAGS -c -o "$o".${p}o "$o".${p}S
-    if [ -z "$NOLINK" ]; then
-        trace "LD.mes64   $c.o" ./pre-inst-env bash $MESCC $MES64_CFLAGS -o "$o".${p}out "$o".${p}o $MES_LIBS
-    fi
-elif [ -z "$NOLINK" ]; then
-    trace "CC.mes64   $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -o "$o".${p}out "${srcdest}$c".c $MES_LIBS
-else
-   trace "CC.mes64   $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -c -o "$o".${p}o "${srcdest}$c".c
-fi

build-aux/cc.sh

@@ -1,5 +1,3 @@
-#! /bin/sh
-
 # GNU Mes --- Maxwell Equations of Software
 # Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 #
@@ -18,42 +16,32 @@
 # You should have received a copy of the GNU General Public License
 # along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-set -e
+compile () {
+    flags=
+    [ "$mesc_p" ] && flags="$LDFLAGS $MES_CFLAGS"
+    trace "CC         $1.c" $CC -c $CPPFLAGS $CFLAGS $flags -o "$1".${program_prefix}o "${srcdest}$1".c
+}
 
-. ${srcdest}build-aux/trace.sh
-. ${srcdest}build-aux/config.sh
+archive () {
+    l=$1
+    shift
+    objects=$(for i in $@; do echo $i.${program_prefix}o; done)
+    [ -z "$objects" ] && objects=$l.${program_prefix}o
+    out=$(dirname "$l")/$mes_arch/$(basename "$l").a
+    d=$(dirname $out)
+    mkdir -p $d
+    if [ "$mesc_p" ]; then
+        trace "AR         $l.a" mv $l.${program_prefix}o $(dirname $l)/$mes_arch/$(basename $l).o\
+            && mv $l.${program_prefix}S $(dirname $l)/$mes_arch/$(basename $l).S
+    else
+        trace "AR         $l.a" $AR cr $out $objects\
+            && mv $objects $d
+    fi
+}
 
-c=$1
-
-if [ -z "$ARCHDIR" ]; then
-    o="$c"
-    d=${c%%/*}
-    p="gcc-"
-else
-    b=${c##*/}
-    d=${c%/*}/gcc
-    o="$d/$b"
-fi
-mkdir -p $d
-
-trace "CC         $c.c" $CC\
-    -c\
-    $CC_CPPFLAGS\
-    $CPPFLAGS\
-    $CC_CFLAGS\
-    $CFLAGS\
-    -D WITH_GLIBC=1\
-    -D POSIX=1\
-    -o "$o".${p}o\
-    "${srcdest}$c".c
-
-if [ -z "$NOLINK" ]; then
-    trace "CCLD       "$o".${p}out" $CC\
-        $CC_CPPFLAGS\
-        $CPPFLAGS\
-        $CC_CFLAGS\
-        $CFLAGS\
-        -o "$o".${p}out\
-        "$o".${p}o\
-        lib/gcc/libmes.o
-fi
+link () {
+    lib=$libc
+    [ "$posix_p" ] && lib='-l mes'
+    out=$(dirname "$1")/${program_prefix}$(basename "$1")
+    trace "CCLD       $1" $CC $CFLAGS $LDFLAGS -o" $out" $crt1 "$1".${program_prefix}o $2 $lib
+}

build-aux/check-boot.sh

@@ -20,17 +20,10 @@
 
 set -e
 
+. ./config.status
 . ${srcdest}build-aux/config.sh
 . ${srcdest}build-aux/trace.sh
 
-export GUILE MES
-MES=${MES-./src/mes}
-
-GUILE=${GUILE-guile}
-if ! command -v $GUILE > /dev/null; then
-    GUILE=true
-fi
-
 tests="
 
 00-zero.scm
@@ -120,18 +113,17 @@ for i in $tests; do
         echo ' [SKIP]'
         continue;
     fi
-    trace "TEST       $i.guile" $GUILE -L ${srcdest}module -C module -L . <(echo '(use-modules (mes guile))'; cat scaffold/boot/$i)
     x=$(
-        if [ "$MES" = guile ]; then
-            true
+        if [ "$MES" = guile -o "$(basename $MES)" = guile ]; then
+            trace "TEST       $i.guile" $GUILE -L ${srcdest}module -C module -L . <(echo '(use-modules (mes guile))'; cat scaffold/boot/$i)
         elif [ -z "${i/5[0-9]-*/}" ]; then
-            cat scaffold/boot/$i | MES_BOOT=${srcdest}boot-00.scm $MES 2>&1;
+            cat scaffold/boot/$i | MES_BOOT=${srcdest}boot-00.scm trace "TEST       $i" $MES 2>&1;
         elif [ -z "${i/6[0-9]-*/}" ]; then
-            cat scaffold/boot/$i | MES_BOOT=${srcdest}boot-01.scm $MES 2>&1;
+            cat scaffold/boot/$i | MES_BOOT=${srcdest}boot-01.scm trace "TEST       $i" $MES 2>&1;
         else
-            MES_BOOT=${srcdest}scaffold/boot/$i $MES 2>&1;
+            MES_BOOT=${srcdest}scaffold/boot/$i trace "TEST       $i" $MES 2>&1;
         fi
      ) \
-        && echo ' [PASS]' \
+        && echo ' [OK]' \
         || (r=$?; echo ' [FAIL]'; echo -e "$x"; echo scaffold/boot/$i; exit $r)
 done

build-aux/check-mes.sh

@@ -20,20 +20,16 @@
 
 set -e
 
+. ./config.status
 . ${srcdest}build-aux/config.sh
 . ${srcdest}build-aux/trace.sh
 
-if [ "$MES" = guile ]; then
-    mes=guile-
-fi
-BASH=${BASH-bash}
-GUILE=${GUILE-guile}
-MES=${MES-src/mes}
-MES_ARENA=${MES_ARENA-100000000}
-
 tests="
 tests/boot.test
 tests/read.test
+tests/srfi-0.test
+tests/macro.test
+tests/perform.test
 tests/base.test
 tests/quasiquote.test
 tests/let.test

build-aux/check-mescc.sh

@@ -19,31 +19,11 @@
 # along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
 set -e
+. ./config.status
 . ${srcdest}build-aux/config.sh
 . ${srcdest}build-aux/trace.sh
 
-MES=${MES-src/mes}
-[ -z "$MESCC" ] && MESCC=scripts/mescc
-GUILE=${GUILE-guile}
-MES_PREFIX=${MES_PREFIX-mes}
-
-HEX2=${HEX2-hex2}
-M1=${M1-M1}
-BLOOD_ELF=${BLOOD_ELF-blood-elf}
-MES_SEED=${MES_SEED-../mes-seed}
-MESCC=${MESCC-$(command -v mescc)}
-[ -z "$MESCC" ] && MESCC=scripts/mescc
-MES=${MES-$(command -v mes)}
-[ -z "$MES" ] && MES=src/mes
-
-if ! command -v $GUILE > /dev/null; then
-    GUILE=true
-fi
-
 test_sh=${test_sh-${srcdest}build-aux/test.sh}
-if [ "$arch" = "x86_64-mes" ]; then
-    test_sh=${srcdest}build-aux/test64.sh
-fi
 
 tests="
 t
@@ -219,6 +199,7 @@ t
 97-fopen
 98-fopen
 99-readdir
+9a-snprintf
 a0-call-trunc-char
 a0-call-trunc-short
 a0-call-trunc-int
@@ -235,8 +216,18 @@ a0-call-trunc-int
 a0-math-divide-signed-negative
 "
 
-# gcc not supported
-CC=
+if [ "$mes_arch" = "x86_64-gcc" ]; then
+    broken="$broken
+21-char[]
+41-?
+70-printf-stdarg
+70-printf-simple
+70-printf
+80-setjmp
+a1-global-no-align
+"
+fi
+
 set +e
 expect=$(echo $broken | wc -w)
 pass=0
@@ -245,20 +236,15 @@ total=0
 mkdir -p scaffold/tests
 for t in $tests; do
     if [ -z "${t/[012][0-9]-*/}" ]; then
-        LIBC=
-        MES_LIBS="-l none"
+        libc=
     elif [ -z "${t/[34][0-9]-*/}" ]; then
-        LIBC=c-mini
-        MES_LIBS="-l c-mini"
+        libc='-l c-mini'
     elif [ -z "${t/[78][0-9a-z]-*/}" ]; then
-        LIBC=c+tcc
-        MES_LIBS="-l c+tcc"
-    elif [ -z "${t/9[0-9]-*/}" ]; then
-        LIBC=c+gnu
-        MES_LIBS="-l c+gnu"
+        libc='-l c+tcc'
+    elif [ -z "${t/9[0-9a-z]-*/}" ]; then
+        libc='-l c+gnu'
     else
-        LIBC=c
-        MES_LIBS=
+        libc='-l c'
     fi
     sh $test_sh "scaffold/tests/$t" &> scaffold/tests/"$t".log
     r=$?

build-aux/check-tcc.sh

@@ -19,27 +19,10 @@
 # along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
 set -e
+. ./config.status
 . ${srcdest}build-aux/config.sh
 . ${srcdest}build-aux/trace.sh
 
-MES=${MES-src/mes}
-[ -z "$MESCC" ] && MESCC=scripts/mescc
-GUILE=${GUILE-guile}
-MES_PREFIX=${MES_PREFIX-mes}
-
-HEX2=${HEX2-hex2}
-M1=${M1-M1}
-BLOOD_ELF=${BLOOD_ELF-blood-elf}
-MES_SEED=${MES_SEED-../mes-seed}
-MESCC=${MESCC-$(command -v mescc)}
-[ -z "$MESCC" ] && MESCC=scripts/mescc
-MES=${MES-$(command -v mes)}
-[ -z "$MES" ] && MES=src/mes
-
-if ! command -v $GUILE > /dev/null; then
-    GUILE=true
-fi
-
 tests="
 00_assignment
 01_comment

build-aux/check.sh.in

@@ -20,34 +20,13 @@
 
 set -e
 
-srcdest="@srcdest@"
-srcdir="@srcdir@"
-abs_top_srcdir="@abs_top_srcdir@"
-abs_top_builddir="@abs_top_builddir@"
-prefix=${prefix-@prefix@}
-
+. ./config.status
 . ${srcdest}build-aux/config.sh
 . ${srcdest}build-aux/trace.sh
 
-GUILE=${GUILE-guile}
-MES=${MES-src/mes}
-MES_ARENA=${MES_ARENA-100000000}
-TCC_PREFIX=${TCC_PREFIX-${srcdest}../tinycc}
-
-if ! command -v $GUILE > /dev/null; then
-    GUILE=true
-fi
-
-set -e
-
-if [ "$GUILE" != true ]; then
-    MES=guile bash ${srcdest}build-aux/check-mes.sh
-fi
-if [ "$MES" != guile ]; then
-    bash ${srcdest}build-aux/check-mes.sh
-fi
-bash ${srcdest}build-aux/check-boot.sh
-bash ${srcdest}build-aux/check-mescc.sh
+./pre-inst-env bash ${srcdest}build-aux/check-boot.sh
+./pre-inst-env bash ${srcdest}build-aux/check-mes.sh
+./pre-inst-env bash ${srcdest}build-aux/check-mescc.sh
 if [ -d $TINYCC_PREFIX/tests/tests2 ] ;then
-    bash ${srcdest}build-aux/check-tcc.sh
+    ./pre-inst-env bash ${srcdest}build-aux/check-tcc.sh
 fi

build-aux/config.make.in

@@ -0,0 +1,72 @@
+# GNU Mes --- Maxwell Equations of Software
+# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of GNU Mes.
+#
+# GNU 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.
+#
+# GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+AR:=@AR@
+BASH:=@BASH@
+BLOOD_ELF:=@BLOOD_ELF@
+CC:=@CC@
+DOT:=@DOT@
+GIT:=@GIT@
+GUILD:=@GUILD@
+GUILE:=@GUILE@
+GUILE_EFFECTIVE_VERSION:=@GUILE_EFFECTIVE_VERSION@
+GUIX:=@GUIX@
+HELP2MAN:=@HELP2MAN@
+HEX2:=@HEX2@
+#HEX2FLAGS:=@HEX2FLAGS@
+MAKEINFO:=@MAKEINFO@
+M1:=@M1@
+#M1FLAGS:=@M1FLAGS@
+MES:=@MES@
+MES_FOR_BUILD:=@MES_FOR_BUILD@
+MES_SEED:=@MES_SEED@
+NYACC:=@NYACC@
+PACKAGE:=@PACKAGE@
+PERL:=@PERL@
+TINYCC_PREFIX:=@TINYCC_PREFIX@
+VERSION:=@VERSION@
+
+abs_top_builddir:=@abs_top_builddir@
+abs_top_srcdir:=@abs_top_srcdir@
+arch:=@arch@
+build:=@build@
+host:=@host@
+
+mes_arch:=@mes_arch@
+gcc_p:=@gcc_p@
+mes_p:=@mes_p@
+mesc_p:=@mesc_p@
+tcc_p:=@tcc_p@
+
+prefix:=@prefix@
+
+bindir:=@bindir@
+datadir:=@datadir@
+docdir:=@docdir@
+guile_site_ccache_dir:=@guile_site_ccache_dir@
+guile_site_dir:=@guile_site_dir@
+infodir:=@infodir@
+libdir:=@libdir@
+mandir:=@mandir@
+moduledir:=@moduledir@
+posix_p:=@posix_p@
+program_prefix:=@program_prefix@
+srcdest:=@srcdest@
+srcdir:=@srcdir@
+sysconfdir:=@sysconfdir@
+top_builddir:=@top_builddir@

build-aux/config.sh

@@ -18,60 +18,72 @@
 
 srcdir=${srcdir-.}
 top_builddir=${top_builddir-.}
+
 if [ "$V" = 2 ]; then
     echo $0
     echo srcdest=${srcdest}
     echo top_builddir=${top_builddir}
 fi
 
+if [ -n "$mes_p" -a -n "$gcc_p" ]; then
+    crt1=lib/linux/$mes_arch/crt1.o
+fi
+
+MES=${MES-${program_prefix}mes}
+libc=${libc-"-l c"}
+export libc
+
+if [ ! "$CC" ]; then
+    CC="./pre-inst-env mescc"
+fi
+
+export AR
 export CC
-export CC CFLAGS
-export CC32
-export CC32_CPPFLAGS
-export CC64
-export CC64_CPPFLAGS
-export CC_CFLAGS
-export CC_CPPFLAGS
 export CFLAGS
 export CPPFLAGS
+export GUILD
 export GUILE
 export GUILE_LOAD_COMPILED_PATH
 export GUILE_LOAD_PATH
 export HEX2
 export HEX2FLAGS
-export LIBC
 export M1
 export M1FLAGS
 export MES
 export MES_CFLAGS
-export MES_CPPFLAGS
-export MES_LIBS
-export TCC
+export MES_FOR_BUILD
+export MES_SEED
+export MESCC
 
 export MES_DEBUG
-export MES_SEED
 export MES_ARENA
-export COMPILE
-export PREPROCESS
 export TINYCC_PREFIX
 export V
 
+export config_status
 export abs_top_builddir
 export abs_top_srcdir
 export arch
 export datadir
 export moduledir
 export prefix
+export program_prefix
 export srcdest
 export srcdir
 export top_builddir
 
-MESCC=${MESCC-mescc}
-BLOOD_ELF=${BLOOD_ELF-blood-elf}
-HEX2=${HEX2-hex2}
-M1=${M1-M1}
+export bits
+export build
+export host
+export compiler
+export gcc_p
+export mes_p
+export mesc_p
+export tcc_p
+export mes_arch
+export posix_p
 
-CC_CPPFLAGS=${CC_CPPFLAGS-"
+CPPFLAGS=${CPPFLAGS-"
 -D 'VERSION=\"$VERSION\"'
 -D 'MODULEDIR=\"$moduledir\"'
 -D 'PREFIX=\"$prefix\"'
@@ -81,29 +93,35 @@ CC_CPPFLAGS=${CC_CPPFLAGS-"
 -I ${srcdest}include
 "}
 
-CC_CFLAGS=${CC_CFLAGS-"
+[ "$posix_p" ] && CPPFLAGS="$CPPFLAGS -D POSIX=1 -D WITH_GLIBC=1"
+
+LDFLAGS=${LDFLAGS-"
+-v
+-L lib/linux/$mes_arch
+-L lib/linux
+-L lib/$mes_arch
+-L lib
+"}
+
+if [ -f "$MES_SEED/x86-mes/mes.S" ]; then
+    LDFLAGS="$LDFLAGS
+-L $MES_SEED
+"
+fi
+
+if [ -n "$gcc_p" ]; then
+CFLAGS=${CFLAGS-"
+-v
 --std=gnu99
 -O0
 -g
 "}
+fi
 
-CC64_CPPFLAGS=${CC64_CPPFLAGS-"
--D 'VERSION=\"$VERSION\"'
--D 'MODULEDIR=\"$moduledir\"'
--D 'PREFIX=\"$prefix\"'
--I src
--I ${srcdest}src
--I ${srcdest}lib
--I ${srcdest}include
-"}
-
-CC64_CFLAGS=${CC64_CFLAGS-"
--std=gnu99
--O0
+if [ "$mes_p" -a "$gcc_p" ]; then
+CFLAGS="$CFLAGS
 -fno-builtin
 -fno-stack-protector
--g
--m64
 -nostdinc
 -nostdlib
 -Wno-discarded-qualifiers
@@ -112,59 +130,29 @@ CC64_CFLAGS=${CC64_CFLAGS-"
 -Wno-pointer-sign
 -Wno-int-conversion
 -Wno-incompatible-pointer-types
-"}
+"
+fi
 
-CC32_CPPFLAGS=${CC32_CPPFLAGS-"
--D 'VERSION=\"$VERSION\"'
--D 'MODULEDIR=\"$moduledir\"'
--D 'PREFIX=\"$prefix\"'
--I src
--I ${srcdest}src
--I ${srcdest}lib
--I ${srcdest}include
-"}
-
-CC32_CFLAGS=${CC32_CFLAGS-"
--std=gnu99
--O0
--fno-builtin
--fno-stack-protector
--g
--m32
--nostdinc
--nostdlib
--Wno-discarded-qualifiers
--Wno-int-to-pointer-cast
--Wno-pointer-to-int-cast
--Wno-pointer-sign
--Wno-int-conversion
--Wno-incompatible-pointer-types
-"}
-
-MES_CPPFLAGS=${MES_CPPFLAGS-"
--D 'VERSION=\"$VERSION\"'
--D 'MODULEDIR=\"$moduledir\"'
--D 'PREFIX=\"$prefix\"'
--I src
--I ${srcdest}src
--I ${srcdest}lib
--I ${srcdest}include
-"}
-
-MES_CFLAGS=${MES_CFLAGS-"
-"}
-
-MES64_CFLAGS=${MES64_CFLAGS-"
--m64
-"}
-
-M1FLAGS=${M1FLAGS-"
---LittleEndian
---Architecture 1
-"}
-
-HEX2FLAGS=${HEX2FLAGS-"
+if [ "$arch" = "x86" ]; then
+    HEX2FLAGS=${HEX2FLAGS-"
 --LittleEndian
 --Architecture 1
 --BaseAddress 0x1000000
 "}
+    M1FLAGS=${M1FLAGS-"
+--LittleEndian
+--Architecture 1
+"}
+    bits=32
+elif [ "$arch" = "x86_64" ]; then
+    HEX2FLAGS=${HEX2FLAGS-"
+--LittleEndian
+--Architecture 2
+--BaseAddress 0x1000000
+"}
+    M1FLAGS=${M1FLAGS-"
+--LittleEndian
+--Architecture 2
+"}
+    bits=64
+fi

build-aux/config.status.in

@@ -0,0 +1,72 @@
+# GNU Mes --- Maxwell Equations of Software
+# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of GNU Mes.
+#
+# GNU 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.
+#
+# GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+config_status=1
+AR="@AR@"
+BASH="@BASH@"
+BLOOD_ELF="@BLOOD_ELF@"
+CC="@CC@"
+DOT="@DOT@"
+GIT="@GIT@"
+GUILD="@GUILD@"
+GUILE="@GUILE@"
+GUILE_EFFECTIVE_VERSION="@GUILE_EFFECTIVE_VERSION@"
+GUIX="@GUIX@"
+HELP2MAN="@HELP2MAN@"
+HEX2="@HEX2@"
+#HEX2FLAGS="@HEX2FLAGS@"
+MAKEINFO="@MAKEINFO@"
+M1="@M1@"
+#M1FLAGS="@M1FLAGS@"
+MES_FOR_BUILD="@MES_FOR_BUILD@"
+MES_SEED="@MES_SEED@"
+NYACC="@NYACC@"
+PACKAGE="@PACKAGE@"
+PERL="@PERL@"
+TINYCC_PREFIX="@TINYCC_PREFIX@"
+VERSION="@VERSION@"
+
+abs_top_builddir="@abs_top_builddir@"
+abs_top_srcdir="@abs_top_srcdir@"
+arch="@arch@"
+build="@build@"
+host="@host@"
+
+mes_arch="@mes_arch@"
+gcc_p="@gcc_p@"
+mes_p="@mes_p@"
+mesc_p="@mesc_p@"
+tcc_p="@tcc_p@"
+
+prefix="@prefix@"
+
+bindir="@bindir@"
+datadir="@datadir@"
+docdir="@docdir@"
+guile_site_ccache_dir="@guile_site_ccache_dir@"
+guile_site_dir="@guile_site_dir@"
+infodir="@infodir@"
+libdir="@libdir@"
+mandir="@mandir@"
+moduledir="@moduledir@"
+posix_p="@posix_p@"
+program_prefix="@program_prefix@"
+srcdest="@srcdest@"
+srcdir="@srcdir@"
+sysconfdir="@sysconfdir@"
+top_builddir="@top_builddir@"

build-aux/export.make

@@ -56,10 +56,6 @@ ifdef CC
 export CC
 endif
 
-ifdef CC32
-export CC32
-endif
-
 ifdef CC64
 export CC64
 endif
@@ -80,6 +76,18 @@ ifdef MES
 export MES
 endif
 
+ifdef MES_FOR_BUILD
+export MES_FOR_BUILD
+endif
+
+ifdef MES_SEED
+export MES_SEED
+endif
+
+ifdef MESCC
+export MESCC
+endif
+
 ifdef HEX2
 export HEX2
 endif
@@ -92,8 +100,8 @@ ifdef GUILE
 export GUILE
 endif
 
-ifdef GUILE_TOOLS
-export GUILE_TOOLS
+ifdef GUILD
+export GUILD
 endif
 
 ifdef GUIX
@@ -124,14 +132,6 @@ ifdef CPPFLAGS
 export CPPFLAGS
 endif
 
-ifdef CC32_CFLAGS
-export CC32_CFLAGS
-endif
-
-ifdef CC64_CFLAGS
-export CC64_CFLAGS
-endif
-
 ifdef HEX2FLAGS
 export HEX2FLAGS
 endif
@@ -140,22 +140,6 @@ ifdef M1FLAGS
 export M1FLAGS
 endif
 
-ifdef MES_CFLAGS
-export MES_CFLAGS
-endif
-
-ifdef MES_SEED
-export MES_SEED
-endif
-
-ifdef MESCC_TOOLS_SEED
-export MESCC_TOOLS_SEED
-endif
-
-ifdef TINYCC_SEED
-export TINYCC_SEED
-endif
-
 ifdef TINYCC_PREFIX
 export TINYCC_PREFIX
 endif

build-aux/install.sh.in

@@ -19,13 +19,8 @@
 # along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
 set -e
-srcdest="@srcdest@"
-srcdir="@srcdir@"
-abs_top_srcdir="@abs_top_srcdir@"
-abs_top_builddir="@abs_top_builddir@"
-prefix=${prefix-@prefix@}
-VERSION=${VERSION-@VERSION@}
 
+. ./config.status
 . ${srcdest}build-aux/config.sh
 . ${srcdest}build-aux/trace.sh
 
@@ -35,8 +30,6 @@ SHELL=${SHELL-$(command -v sh)}
 [ -n "$BASH" ] && set -o pipefail
 
 MES_PREFIX=${MES_PREFIX-$prefix/share/mes}
-MES_SEED=${MES_SEED-../MES-SEED}
-TINYCC_SEED=${TINYCC_SEED-../TINYCC-SEED}
 
 GUILE=${GUILE-$(command -v guile)} || true
 if [ -z "$GUILE" -o "$GUILE" = true ]; then
@@ -54,7 +47,9 @@ guile_site_dir=$(eval echo ${guile_site_dir-$prefix/share/guile/site/$GUILE_EFFE
 guile_site_ccache_dir=$(eval echo ${guile_site_ccache_dir-$prefix/lib/guile/$GUILE_EFFECTIVE_VERSION/site-ccache})
 
 mkdir -p $DESTDIR$bindir
-cp src/mes $DESTDIR$bindir/mes
+if [ -f src/x86-mes-mes ]; then
+    cp src/x86-mes-mes $DESTDIR$bindir/mes
+fi
 cp scripts/mescc $DESTDIR$bindir/mescc
 
 sed \
@@ -66,7 +61,7 @@ mkdir -p $docdir
 
 if [ -n "$PERL" -a -n "$GIT" ]\
        && $PERL -v > /dev/null\
-       && $GIT --status > /dev/null; then
+       && $GIT status > /dev/null; then
     $PERL ${srcdest}build-aux/gitlog-to-changelog --srcdir=. > ChangeLog
 fi
 
@@ -105,7 +100,9 @@ else
 fi
 tar -cf- -C ${srcdest}mes module | tar -xf- -C $DESTDIR$MES_PREFIX
 
-cp src/mes.S $DESTDIR$MES_PREFIX/lib/x86-mes/mes.S
+if [ -f src/mes.x86-mes-S ]; then
+    cp src/mes.x86-mes-S $DESTDIR$MES_PREFIX/lib/x86-mes/mes.S
+fi
 if [ -f src/mes.x86_64-mes-S ]; then
     cp src/mes.x86_64-mes-S $DESTDIR$MES_PREFIX/lib/x86_64-mes/mes.S
 fi

build-aux/mes-snarf.scm

@@ -146,8 +146,8 @@ exec ${GUILE-guile} --no-auto-compile -L $(dirname $0) -C $(dirname $0) -e '(mes
        (format #f "g_cells[cell_~a].string = MAKE_STRING (scm_~a.string);\n" (function.name f) (function.name f))
        (format #f "g_cells[cell_~a].car = MAKE_STRING (scm_~a.car);\n" (function.name f) (function.name f)))
    (if %gcc?
-       (format #f "a = acons (lookup_symbol_ (scm_~a.string), ~a, a);\n\n" (function.name f) (function-cell-name f))
-       (format #f "a = acons (lookup_symbol_ (scm_~a.car), ~a, a);\n\n" (function.name f) (function-cell-name f)))))
+       (format #f "a = acons (list_to_symbol (scm_~a.string), ~a, a);\n\n" (function.name f) (function-cell-name f))
+       (format #f "a = acons (list_to_symbol (scm_~a.car), ~a, a);\n\n" (function.name f) (function-cell-name f)))))
 
 (define (disjoin . predicates)
   (lambda (. arguments)

build-aux/pre-inst-env.in

@@ -22,6 +22,7 @@ srcdir="@srcdir@"
 abs_top_srcdir="@abs_top_srcdir@"
 abs_top_builddir="@abs_top_builddir@"
 prefix=${prefix-@prefix@}
+program_prefix=${program_prefix-@program_prefix@}
 
 MES_PREFIX=${MES_PREFIX-${srcdest}mes}
 export MES_PREFIX
@@ -36,7 +37,7 @@ export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH
 PATH="$abs_top_builddir/scripts:$abs_top_builddir/src:$abs_top_builddir/build-aux:$PATH"
 export PATH
 
-MES=${MES-src/mes}
+MES=${MES-${abs_top_builddir}/src/${program_prefix}mes}
 export MES
 
 GUIX_PACKAGE_PATH="$abs_top_srcdir/guix${GUIX_PACKAGE_PATH:+:}$GUIX_PACKAGE_PATH"

build-aux/snarf.sh

@@ -23,42 +23,17 @@ set -e
 . ${srcdest}build-aux/config.sh
 . ${srcdest}build-aux/trace.sh
 
-arch=x86_64-mes-gcc
-if [ "$CC64" = "$TCC" ]; then
-    arch=x86_64-mes-tcc
-    LIBC=c+tcc # tcc bug with undefined symbols
-fi
-
-if [ -n "$LIBC" ]; then
-    CC64LIBS="lib/$arch/lib$LIBC.o"
-fi
-
-c=$1
-
-if [ -z "$ARCHDIR" ]; then
-    o="$c"
-    d=${c%%/*}
-    p="$arch-"
-else
-    b=${c##*/}
-    d=${c%%/*}/$arch
-    o="$d/$b"
-fi
-mkdir -p $d
-
-trace "CC.64      $c.c" $CC64\
-    -c\
-    $CC64_CPPFLAGS\
-    $CC64_CFLAGS\
-    -o "$o".${p}o\
-    "${srcdest}$c".c
-
-if [ -z "$NOLINK" ]; then
-    trace "CCLD.64    $c.c" $CC64\
-        $CC64_CPPFLAGS\
-        $CC64_CFLAGS\
-        -o "$o".${p}out\
-        lib/$arch/crt1.o\
-        "$o".${p}o\
-        $CC64LIBS
+snarf="    "
+if [ -n "$1" ]; then
+    snarf=.mes
 fi
+trace "SNARF$snarf  gc.c"     ${srcdest}build-aux/mes-snarf.scm $1 src/gc.c
+trace "SNARF$snarf  hash.c"   ${srcdest}build-aux/mes-snarf.scm $1 src/hash.c
+trace "SNARF$snarf  lib.c"    ${srcdest}build-aux/mes-snarf.scm $1 src/lib.c
+trace "SNARF$snarf  math.c"   ${srcdest}build-aux/mes-snarf.scm $1 src/math.c
+trace "SNARF$snarf  mes.c"    ${srcdest}build-aux/mes-snarf.scm $1 src/mes.c
+trace "SNARF$snarf  module.c" ${srcdest}build-aux/mes-snarf.scm $1 src/module.c
+trace "SNARF$snarf  posix.c"  ${srcdest}build-aux/mes-snarf.scm $1 src/posix.c
+trace "SNARF$snarf  reader.c" ${srcdest}build-aux/mes-snarf.scm $1 src/reader.c
+trace "SNARF$snarf  struct.c" ${srcdest}build-aux/mes-snarf.scm $1 src/struct.c
+trace "SNARF$snarf  vector.c" ${srcdest}build-aux/mes-snarf.scm $1 src/vector.c

build-aux/test-cc.sh

@@ -20,46 +20,30 @@
 
 set -e
 
+if [ ! "$config_status" ]; then
+    . ./config.status
+fi
+
 . ${srcdest}build-aux/config.sh
 . ${srcdest}build-aux/trace.sh
+. ${srcdest}build-aux/cc.sh
 
-a=mes-gcc
-if [ "$CC32" = "$TCC" ]; then
-    a=mes-tcc
-    LIBC=c+tcc # tcc bug with undefined symbols
-fi
-arch=x86-$a
-
-if [ -n "$LIBC" ]; then
-    CC32LIBS="lib/$arch/lib$LIBC.o"
-fi
-
-c=$1
-
-if [ -z "$ARCHDIR" ]; then
-    o="$c"
-    d=${c%%/*}
-    p="$a-"
-else
-    b=${c##*/}
-    d=${c%%/*}/$arch
-    o="$d/$b"
-fi
-mkdir -p $d
-
-trace "CC.32      $c.c" $CC32\
-    -c\
-    $CC32_CPPFLAGS\
-    $CC32_CFLAGS\
-    -o "$o".${p}o\
-    "${srcdest}$c".c
-
-if [ -z "$NOLINK" ]; then
-    trace "CCLD.32    $c.c" $CC32\
-        $CC32_CPPFLAGS\
-        $CC32_CFLAGS\
-        -o "$o".${p}out\
-        lib/$arch/crt1.o\
-        "$o".${p}o\
-        $CC32LIBS
+t=${1-scaffold/tests/t}
+o="$t"
+
+rm -f "${program_prefix}$o"
+compile "$t"
+link "$t"
+
+r=0
+[ -f "$t".exit ] && r=$(cat "$t".exit)
+set +e
+$(dirname "$o")/${program_prefix}$(basename "$o") $ARGS > "$o".${program_prefix}stdout
+m=$?
+cat "$o".${program_prefix}stdout
+set -e
+
+[ $m = $r ]
+if [ -f "$t".expect ]; then
+    $DIFF -ub "$t".expect "$o".${program_prefix}stdout
 fi

build-aux/test.sh

@@ -19,67 +19,19 @@
 # along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
 set -e
+. ./config.status
 . ${srcdest}build-aux/config.sh
-. ${srcdest}build-aux/trace.sh
 
-MES_ARENA=100000000
+sh ${srcdest}build-aux/test-cc.sh $1
 
-GUILE=${GUILE-$MES}
-DIFF=${DIFF-$(command -v diff)} || true
-[ -z "$DIFF" ] && DIFF="sh scripts/diff.scm"
-
-t=${1-scaffold/tests/t}
-o="$t"
-rm -f "$o".mes-out
-
-rm -f "$o".gcc-out
-if [ -n "$CC" ]; then
-    sh ${srcdest}build-aux/cc.sh "$t"
-
-    r=0
-    [ -f "$t".exit ] && r=$(cat "$t".exit)
-    set +e
-    "$o".gcc-out $ARGS > "$o".gcc-stdout
-    m=$?
-    cat "$o".gcc-stdout
-    set -e
-
-    [ $m = $r ]
-    if [ -f "$t".expect ]; then
-        $DIFF -ub "$t".expect "$o".gcc-stdout;
-    fi
-fi
-
-rm -f "$t".mes-gcc-out
-if [ -n "$CC32" ]; then
-    sh ${srcdest}build-aux/cc32-mes.sh "$t"
-
-    r=0
-    [ -f "$t".exit ] && r=$(cat "$t".exit)
-    set +e
-    "$o".mes-gcc-out $ARGS > "$o".mes-gcc-stdout
-    m=$?
-    cat "$t".mes-gcc-stdout
-    set -e
-
-    [ $m = $r ]
-    if [ -f "$t".expect ]; then
-        $DIFF -ub "$t".expect "$o".mes-gcc-stdout;
-    fi
-fi
-
-rm -f "$o".mes-out
-sh ${srcdest}build-aux/cc-mes.sh "$t"
-
-r=0
-[ -f "$t".exit ] && r=$(cat "$t".exit)
-set +e
-"$o".mes-out $ARGS > "$o".mes-stdout
-m=$?
-cat "$o".mes-stdout
-set -e
-
-[ $m = $r ]
-if [ -f "$t".expect ]; then
-    $DIFF -ub "$t".expect "$o".mes-stdout;
+if [ ! "$mesc_p" ]; then
+    #FIXME: c&p
+    unset CFLAGS CPPFLAGS LDFLAGS gcc_p tcc_p posix_p
+    MES=guile
+    mesc_p=1
+    mes_p=1
+    mes_arch=x86-mes
+    program_prefix=$mes_arch-
+    CC="./pre-inst-env mescc"
+    sh ${srcdest}build-aux/test-cc.sh $1
 fi

build-aux/test64.sh

@@ -1,85 +0,0 @@
-#! /bin/sh
-
-# GNU Mes --- Maxwell Equations of Software
-# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-#
-# This file is part of GNU Mes.
-#
-# GNU 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.
-#
-# GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-set -e
-. ${srcdest}build-aux/config.sh
-. ${srcdest}build-aux/trace.sh
-
-MES_ARENA=100000000
-
-GUILE=${GUILE-$MES}
-DIFF=${DIFF-$(command -v diff)} || true
-[ -z "$DIFF" ] && DIFF="sh scripts/diff.scm"
-
-t=${1-scaffold/tests/t}
-o="$t"
-rm -f "$o".mes-out
-
-rm -f "$o".gcc-out
-if [ -n "$CC" ]; then
-    sh ${srcdest}build-aux/cc.sh "$t"
-
-    r=0
-    [ -f "$t".exit ] && r=$(cat "$t".exit)
-    set +e
-    "$o".gcc-out $ARGS > "$o".gcc-stdout
-    m=$?
-    cat "$o".gcc-stdout
-    set -e
-
-    [ $m = $r ]
-    if [ -f "$t".expect ]; then
-        $DIFF -ub "$t".expect "$o".gcc-stdout;
-    fi
-fi
-
-rm -f "$t".x86_64-mes-gcc-out
-if [ -n "$CC64" ]; then
-    sh ${srcdest}build-aux/cc64-mes.sh "$t"
-
-    r=0
-    [ -f "$t".exit ] && r=$(cat "$t".exit)
-    set +e
-    "$o".x86_64-mes-gcc-out $ARGS > "$o".x86_64-mes-gcc-stdout
-    m=$?
-    cat "$t".x86_64-mes-gcc-stdout
-    set -e
-
-    [ $m = $r ]
-    if [ -f "$t".expect ]; then
-        $DIFF -ub "$t".expect "$o".x86_64-mes-gcc-stdout;
-    fi
-fi
-
-rm -f "$o".x86_64-mes-out
-sh ${srcdest}build-aux/cc-x86_64-mes.sh "$t"
-
-r=0
-[ -f "$t".exit ] && r=$(cat "$t".exit)
-set +e
-"$o".x86_64-mes-out $ARGS > "$o".x86_64-mes-stdout
-m=$?
-cat "$o".x86_64-mes-stdout
-set -e
-
-[ $m = $r ]
-if [ -f "$t".expect ]; then
-    $DIFF -ub "$t".expect "$o".x86_64-mes-stdout;
-fi

build-aux/uninstall.sh.in

@@ -20,12 +20,7 @@
 
 #set -e
 
-srcdest="@srcdest@"
-srcdir="@srcdir@"
-abs_top_srcdir="@abs_top_srcdir@"
-abs_top_builddir="@abs_top_builddir@"
-prefix=${prefix-@prefix@}
-
+. ./config.status
 . ${srcdest}build-aux/config.sh
 . ${srcdest}build-aux/trace.sh
 
@@ -44,15 +39,11 @@ moduledir=${moduledir-$datadir/mes/module}
 guile_site_dir=${guile_site_dir-$prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION}
 guile_site_ccache_dir=${guile_site_ccache_dir-$prefix/lib/guile/$GUILE_EFFECTIVE_VERSION/site-ccache}
 
-mkdir -p $DESTDIR$prefix/bin
-cp src/mes $DESTDIR$prefix/bin/mes
-
-mkdir -p $DESTDIR$prefix/lib
-mkdir -p $DESTDIR$MES_PREFIX/lib
-cp scripts/mescc $DESTDIR$prefix/bin/mescc
+MES_PREFIX=${MES_PREFIX-$prefix/share/mes}
 
 rm $DESTDIR$prefix/bin/mes
 rm $DESTDIR$prefix/bin/mescc
+rm -f $DESTDIR$prefix/bin/diff.scm
 rmdir $DESTDIR$prefix/bin || :
 
 for i in\
@@ -77,6 +68,16 @@ rm -r $DESTDIR$guile_site_ccache_dir/mescc
 rm -r $DESTDIR$guile_site_dir/mes
 rm -r $DESTDIR$guile_site_dir/mescc
 
+rm $DESTDIR$prefix/share/info/dir
 rm $DESTDIR$prefix/share/info/mes.info*
+rm $DESTDIR$prefix/share/info/images/gcc-mesboot*
+rm $DESTDIR$prefix/share/info/images/README
 rm $DESTDIR$mandir/man1/mes.1
 rm $DESTDIR$mandir/man1/mescc.1
+
+rmdir -p $DESTDIR$prefix/share/doc
+rmdir -p $DESTDIR$prefix/share/info/images
+rmdir -p $DESTDIR$guile_site_dir
+rmdir -p $DESTDIR$guile_site_ccache_dir
+rmdir -p $DESTDIR$mandir/man1
+true

configure

@@ -1,24 +1,6 @@
 #! /bin/sh
-# -*- scheme -*-
-unset LANG LC_ALL
-guile=$(command -v ${GUILE-guile})
-guix=$(command -v ${GUIX-guix})
-if [ -n "$guix" ] ; then
-    install="guix environment -l .guix.scm"
-else
-    install="sudo apt-get install guile-2.2-dev"
-fi
-if [ -z "$guile" ]; then
-    cat <<EOF
-
-Missing dependencies: ${GUILE-guile}, please install Guile 2.2 or later; run
-    $install
-EOF
-exit 1
-fi
-GUILE=$guile
-export GUILE
-exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
+# -*-scheme-*-
+MES_ARENA=100000000 exec ${SCHEME-guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
 !#
 
 ;;; GNU Mes --- Maxwell Equations of Software
@@ -44,16 +26,38 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-26)
-  #:use-module (ice-9 and-let-star)
-  #:use-module (ice-9 curried-definitions)
   #:use-module (ice-9 getopt-long)
-  #:use-module (ice-9 match)
   #:use-module (ice-9 optargs)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
-  #:use-module (ice-9 regex)
   #:export (main))
 
+(cond-expand
+ (guile)
+ (mes (mes-use-module (srfi srfi-1))
+      (mes-use-module (srfi srfi-9))
+      (mes-use-module (srfi srfi-9 gnu))
+      (mes-use-module (srfi srfi-26))
+      (mes-use-module (mes getopt-long))
+      (mes-use-module (mes guile))
+      (mes-use-module (mes misc))
+      (mes-use-module (mes optargs))
+      (define %host-type "x86_64-unknown-linux-gnu")
+      (define OPEN_READ "r")
+      (define (canonicalize-path o)
+        (if (string-prefix? "/" o) o
+            (string-append (getcwd) "/" o)))
+      (define (sort lst less)
+        lst)
+      (define (close-pipe o) 0)
+      (define (open-pipe* OPEN_READ . commands)
+        (let ((fake-pipe ".pipe"))
+          (with-output-to-file fake-pipe
+            (lambda _
+              (let ((status (apply system* (append commands))))
+                (set! close-pipe (lambda _ status)))))
+          (open-input-file fake-pipe)))))
+
 (define* (PATH-search-path name #:key (default name) warn?)
   (or (search-path (string-split (getenv "PATH") #\:) name)
       (and (and warn? (format (current-error-port) "warning: not found: ~a\n" name))
@@ -80,22 +84,17 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
 (define (verbose string . rest)
   (if %verbose? (apply stderr (cons string rest))))
 
-(define (gulp-pipe command)
-  (let* ((port (open-pipe* OPEN_READ *shell* "-c" command))
+(define (gulp-pipe* . command)
+  (let* ((err (current-error-port))
+         (foo (set-current-error-port (open-output-file ".error")))
+         (port (apply open-pipe* OPEN_READ command))
          (output (read-string port))
-         (status (close-pipe port)))
-    (verbose "command[~a]: ~s => ~a\n" status command output)
-    (if (not (zero? status)) "" (string-trim-right output #\newline))))
-
-(define* ((->string #:optional (infix "")) h . t)
-  (let ((o (if (pair? t) (cons h t) h)))
-    (match o
-      ((? char?) (make-string 1 o))
-      ((? number?) (number->string o))
-      ((? string?) o)
-      ((? symbol?) (symbol->string o))
-      ((h ... t) (string-join (map (->string) o) ((->string) infix)))
-      (_ ""))))
+         (status (close-pipe port))
+         (error (with-input-from-file ".error" read-string)))
+    (set-current-error-port err)
+    (verbose "command[~a]: ~s => ~a [~a]\n" status command output error)
+    (if (not (zero? status)) ""
+        (string-trim-right (string-append output error)))))
 
 (define (tuple< a b)
   (cond
@@ -120,24 +119,39 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
 (define (string-replace-char string from to)
   (string-map (cut char->char from to <>) string))
 
+(define (string-replace-string string from to)
+  (cond ((string-contains string from)
+         => (lambda (i) (string-replace string to i (+ i (string-length from)))))
+        (else string)))
+
+(define (string-replace-string/all string from to)
+  (or (and=> (string-contains string from)
+             (lambda (i)
+               (string-append
+                (substring string 0 i)
+                to
+                (string-replace-string/all
+                 (substring string (+ i (string-length from))) from to))))
+      string))
+
 ;;; Configure
 
 (define-immutable-record-type <dependency>
-  (make-depedency name version-expected optional? version-option commands file-name)
+  (make-dependency name version-expected optional? version-option commands file-name data version-found)
   dependency?
   (name dependency-name)
   (version-expected dependency-version-expected)
-  (version-option dependency-version-option)
   (optional? dependency-optional?)
+  (version-option dependency-version-option)
   (commands dependency-commands)
   (file-name dependency-file-name)
+  (data dependency-data)
   (version-found dependency-version-found))
 
-(define* (make-dep name #:optional (version '(0))
-                   #:key optional? (version-option "--version") (commands (list name)) file-name)
+(define* (make-dep name #:key (version '(0)) optional? (version-option "--version") (commands (list name)) file-name data)
   (let* ((env-var (getenv (name->shell-name name)))
          (commands (if env-var (cons env-var commands) commands)))
-   (make-depedency name version optional? version-option commands file-name)))
+    (make-dependency name version optional? version-option commands file-name data #f)))
 
 (define (find-dep name deps)
   (find (compose (cut equal? <> name) dependency-name) deps))
@@ -153,18 +167,23 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
 (define (name->shell-name name)
   (string-upcase (string-replace-char name #\- #\_)))
 
+(define (->string o)
+  (cond ((number? o) (number->string o))
+        ((string? o) o)
+        (else (format #f "~a" o))))
+
 (define (version->string version)
-  ((->string '.) version))
+  (and version (string-join (map ->string version) ".")))
 
 (define (string->version string)
-  (and-let* ((version (string-tokenize string
-                                       (char-set-adjoin char-set:digit #\.)))
-             ((pair? version))
-             (version (sort version (lambda (a b) (> (string-length a) (string-length b)))))
-             (version (car version))
-             (version (string-tokenize version
-                                       (char-set-complement (char-set #\.)))))
-            (map string->number version)))
+  (let ((split (string-tokenize string
+                                (char-set-adjoin char-set:digit #\.))))
+    (and (pair? split)
+         (let* ((version (sort split (lambda (a b) (> (string-length a) (string-length b)))))
+                (version (car version))
+                (version (string-tokenize version
+                                          (char-set-complement (char-set #\.)))))
+           (map string->number version)))))
 
 (define (check-program-version dependency)
   (let ((name (dependency-name dependency))
@@ -174,15 +193,20 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
     (let loop ((commands commands))
       (if (null? commands) dependency
           (let ((command (car commands)))
-            (stdout "checking for ~a~a... " command
+            (stdout "checking for ~a~a... " name
                     (if (null? expected) ""
                         (format #f " [~a]" (version->string expected))))
-            (let* ((output (gulp-pipe (format #f "~a ~a 2>&1" command version-option)))
+            (let* ((output (gulp-pipe* command version-option))
+                   ;;(foo (stderr "output=~s\n" output))
                    (actual (string->version output))
+                   ;;(foo (stderr "actual=~s\n" actual))
+                   ;;(foo (stderr "expected=~s\n" expected))
                    (pass? (and actual (tuple< expected actual)))
+                   ;;(foo (stderr "PASS?~s\n" pass?))
                    (dependency (set-field dependency (dependency-version-found) actual)))
               (stdout "~a ~a\n" (if pass? (if (pair? actual) "" " yes")
-                                    (if actual " no, found" "no")) (version->string actual))
+                                    (if actual " no, found" "no"))
+                      (or (version->string actual) ""))
               (if pass? (let ((file-name (or (PATH-search-path command)
                                              (dependency-file-name dependency))))
                           (set-field dependency (dependency-file-name) file-name))
@@ -195,29 +219,64 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
     (stdout "~a\n" (or file-name ""))
     (set-field dependency (dependency-file-name) file-name)))
 
-(define* (check-header-c dependency  #:optional (check check-compile-header-c))
+(define* (check-header-c cc dependency #:optional (check check-preprocess-header-c))
   (let ((name (dependency-name dependency)))
     (stderr "checking for ~a..." name)
-    (let ((result (check name)))
+    (let ((result (check cc name)))
       (stderr " ~a\n" (if result "yes" "no"))
       (if result (set-field dependency (dependency-file-name) name)
-          dependency-file-name))))
+          dependency))))
 
-(define (check-compile-header-c header)
-  (zero? (system (format #f "echo '#include ~s' | gcc -E - > /dev/null 2>&1" header))))
+(define* (check-compile-c cc dependency #:optional (check check-compile-string-c))
+  (let ((name (dependency-name dependency)))
+    (stderr "checking for ~a..." name)
+    (let ((result (check cc (dependency-data dependency))))
+      (stderr " ~a\n" (if result "yes" "no"))
+      (if result (set-field dependency (dependency-file-name) name)
+          dependency))))
+
+(define* (check-link-c cc dependency #:optional (check check-link-string-c))
+  (let ((name (dependency-name dependency)))
+    (stderr "checking for ~a..." name)
+    (let ((result (check cc (dependency-data dependency))))
+      (stderr " ~a\n" (if result "yes" "no"))
+      (if result (set-field dependency (dependency-file-name) name)
+          dependency))))
+
+(define (check-preprocess-header-c cc header)
+  (with-output-to-file ".config.c"
+    (cut format #t "#include \"~a\"" header))
+  (with-error-to-file "/dev/null"
+    (cut zero? (system* cc "-E" "-o" ".config.E" ".config.c"))))
+
+(define (check-compile-string-c cc string)
+  (with-output-to-file ".config.c"
+    (cut display string))
+  (with-error-to-file "/dev/null"
+    (cut zero? (system* cc "--std=gnu99" "-c" "-o" ".config.o" ".config.c"))))
+
+(define (check-link-string-c cc string)
+  (with-output-to-file ".config.c"
+    (cut display string))
+  (with-error-to-file "/dev/null"
+    (cut zero? (system* cc "--std=gnu99" "-o" ".config" ".config.c"))))
 
 (define (parse-opts args)
   (let* ((option-spec
   	  '((build (value #t))
             (host (value #t))
-            (help (single-char #\h))
+
             (prefix (value #t))
+            (program-prefix (value #t))
             (bindir (value #t))
             (datadir (value #t))
             (docdir (value #t))
             (libdir (value #t))
             (srcdir (value #t))
             (sysconfdir (value #t))
+
+            (mes)
+            (help (single-char #\h))
             (verbose (single-char #\v))
             (with-cheating)
             (with-courage)
@@ -254,8 +313,9 @@ Options:
   -h, --help           display this help
       --build=BUILD    configure for building on BUILD [guessed]
       --disable-silent-rules
-                       verbose build output [BUILD_DEBUG=1]
+                       verbose build output [V=1]
       --host=HOST      cross-compile to build programs to run on HOST [BUILD]
+      --mes            use Mes C Library
   -v, --verbose        be verbose
   --with-courage       assert being courageous to configure for unsupported platform
   --with-cheating      cheat using Guile instead of Mes
@@ -265,6 +325,10 @@ Installation directories:
   --infodir=DIR        info documentation [PREFIX/share/info]
   --mandir=DIR         man pages [PREFIX/share/man]
 
+Program names:
+  --program-prefix=PREFIX            prepend PREFIX to installed program names
+  --program-suffix=SUFFIX            append SUFFIX to installed program names
+
 Ignored for Guix:
   --enable-fast-install
 
@@ -280,29 +344,23 @@ Ignored for Debian:
 Some influential environment variables:
   CC                C compiler command
   CFLAGS            C compiler flags
-  CC32              x86 C compiler command
-  CC64_CFLAGS       x86_64 C compiler flags
-  CC64              x86_64 C compiler command
-  CC32_CFLAGS       x86 C compiler flags
   GUILE             guile command
-  GUILE_TOOLS       guile-tools command
-  MES_CFLAGS        MesCC flags
+  GUILD             guild command
+  MES_FOR_BUILD     build system MES [can be mes or guile]
   MES_SEED          location of mes-seed
-  MESCC_TOOLS_SEED  location of mescc-tools-seed
-  TCC               tcc C compiler command
   TINYCC_PREFIX     location of tinycc [for tests/test2]
-  TINYCC_SEED       location of tinycc-seed
 " PACKAGE VERSION (getenv "prefix")))
 
 (define (main args)
   (let* ((options (parse-opts args))
          (build-type (option-ref options 'build %host-type))
 
-         (arch (car (string-split build-type #\-)))
          (host-type (option-ref options 'host %host-type))(prefix "/usr/local")
 
          (prefix "/usr/local")
          (prefix (option-ref options 'prefix prefix))
+         (program-prefix (option-ref options 'program-prefix ""))
+         (program-suffix (option-ref options 'program-suffix ""))
          (infodir (option-ref options 'infodir "${prefix}/share/info"))
          (mandir (option-ref options 'infodir "${prefix}/share/man"))
          (sysconfdir (option-ref options 'sysconfdir "${prefix}/etc"))
@@ -312,7 +370,7 @@ Some influential environment variables:
          (docdir (option-ref options 'docdir "${datadir}/doc/mes-${VERSION}"))
          (libdir (option-ref options 'libdir "${prefix}/lib"))
          (moduledir "${datadir}/mes/module")
-         (moduledir/ (gulp-pipe (string-append "echo " prefix "/share/mes/module/")))
+         (moduledir/ (gulp-pipe* "echo" prefix "/share/mes/module/"))
          (guile-effective-version (effective-version))
          (guile-site-dir (if (equal? prefix ".") (canonicalize-path ".")
                              (string-append "${prefix}/share/guile/site/" guile-effective-version)))
@@ -332,7 +390,8 @@ Some influential environment variables:
          (disable-silent-rules? (option-ref options 'disable-silent-rules #f))
          (enable-silent-rules? (option-ref options 'enable-silent-rules #f))
          (vars (filter (cut string-index <> #\=) (option-ref options '() '())))
-         (help? (option-ref options 'help #f)))
+         (help? (option-ref options 'help #f))
+         (mes? (option-ref options 'mes #f)))
     (when help?
       (print-help)
       (exit 0))
@@ -342,57 +401,87 @@ Some influential environment variables:
     (for-each (lambda (v) (apply setenv (string-split v #\=))) vars)
     (let* ((mes-seed (or (getenv "MES_SEED")
                          (string-append srcdest "../mes-seed")))
+           (mes-seed (and mes-seed
+                          (file-exists? (string-append mes-seed "/x86-mes/mes.S"))
+                          mes-seed))
            (tinycc-prefix (or (getenv "TINYCC_PREFIX")
                               (string-append srcdest "../tinycc-prefix")))
-           (tinycc-seed (or (getenv "TINYCC_SEED")
-                            (string-append srcdest "../tinycc-seed")))
-           (mescc-tools-seed (or (getenv "MESCC_TOOLS_SEED")
-                                 (string-append srcdest "../mescc-tools-seed")))
+           (gcc (or (getenv "CC") "gcc"))
+           (tcc (or (getenv "TCC") "tcc"))
+           (mescc (or (getenv "MESCC") "mescc"))
            (deps (fold (lambda (program results)
                          (cons (check-program-version program) results))
                        '()
-                       (list (make-dep "guile" '(2 0) #:commands '("guile-2.2" "guile-2.0" "guile-2" "guile"))
-                             (make-dep "guix" '(0 13) #:optional? #t)
-                             (make-dep "bash" '(2 0) #:optional? #t)
-                             (make-dep "guile-tools" '(2 0))
-                             (make-dep "mes-seed" '(0 18) #:optional? #t
-                                       #:commands (list (string-append mes-seed "/refresh.sh"))
-                                       #:file-name mes-seed)
-                             (make-dep "tinycc-seed" '(0 18) #:optional? #t
-                                       #:commands (list (string-append tinycc-seed "/refresh.sh"))
-                                       #:file-name tinycc-seed)
-                             (make-dep "cc" '(2 95) #:commands '("gcc"))
-                             (make-dep "make" '(4))
-                             (make-dep "cc32" '(2 95)
-                                       #:optional? #t
-                                       #:commands '("i686-unknown-linux-gnu-gcc"))
-                             (make-dep "cc64" '(2 95)
-                                       #:optional? #t
-                                       #:commands '("gcc"))
-                             (make-dep "M1" '(0 3))
-                             (make-dep "blood-elf" '(0 1))
-                             (make-dep "hex2" '(0 3))
-                             (make-dep "tcc" '(0 9 26) #:optional? #t #:version-option "-v")
-                             (make-dep "makeinfo" '(5) #:optional? #t)
-                             (make-dep "dot" '(2) #:version-option "-V")
-                             (make-dep "help2man" '(1 47) #:optional? #t)
-                             (make-dep "perl" '(5) #:optional? #t)
-                             (make-dep "git" '(2) #:optional? #t))))
-           (deps (cons (check-program-version (make-dep "nyacc" '(0 86 0) #:commands (list (string-append (file-name "guile" deps) " -c '(use-modules (nyacc lalr)) (display *nyacc-version*)'")) #:file-name #t))
-                       deps))
-           (deps (if (file-name "cc" deps)
-                     (cons* (check-header-c (make-dep "stdio.h"))
-                            (check-header-c (make-dep "limits.h"))
+                       (list (make-dep "hex2" #:version '(0 3))
+                             (make-dep "M1" #:version '(0 3))
+                             (make-dep "blood-elf" #:version '(0 1))
+                             (make-dep "guile" #:version '(2 0) #:commands '("guile-2.2" "guile-2.0" "guile-2" "guile") #:optional? #t)
+                             (make-dep "mes" #:version '(0 18) #:optional? #t)
+                             (make-dep "guix" #:version '(0 13) #:optional? #t)
+                             (make-dep "ar" #:version '(2 10) #:optional? #t)
+                             (make-dep "bash" #:version '(2 0) #:optional? #t)
+                             (make-dep "guild" #:version '(2 0) #:commands '("guild" "guile-tools"))
+                             (make-dep "cc" #:commands (list gcc tcc mescc) #:optional? #t)
+                             (make-dep "make" #:optional? #t)
+                             (make-dep "makeinfo" #:optional? #t)
+                             (make-dep "dot" #:version-option "-V")
+                             (make-dep "help2man" #:version '(1 47) #:optional? #t)
+                             (make-dep "perl" #:version '(5) #:optional? #t)
+                             (make-dep "git" #:version '(2) #:optional? #t))))
+           (guile (file-name "guile" deps))
+           (deps (if guile (cons (check-program-version (make-dep "nyacc" #:version '(0 86 0) #:commands (list (string-append guile " -c '(use-modules (nyacc lalr)) (display *nyacc-version*)'")) #:file-name #t))
+                                 deps)
+                     deps))
+           (guile (or guile "guile"))
+           (cc (file-name "cc" deps))
+           (deps (if cc
+                     (cons* (check-header-c cc (make-dep "limits.h"))
+                            (check-header-c cc (make-dep "stdio.h" #:optional? #t))
                             deps)
                      deps))
-           (deps (cons (check-file (make-dep "mescc-tools-seed" '(0) #:optional? #t
-                                             #:file-name mescc-tools-seed))
-                       deps))
-           (deps (cons (check-file (make-dep "tinycc-prefix" '(0) #:optional? #t
+           (deps (cons (check-file (make-dep "tinycc-prefix" #:optional? #t
                                              #:file-name tinycc-prefix))
                        deps))
            (missing (filter (conjoin (negate dependency-file-name)
-                                     (negate dependency-optional?)) deps)))
+                                     (negate dependency-optional?)) deps))
+           (deps (if cc
+                     (cons (check-compile-c cc (make-dep "cc is GNU C" #:data "#if !defined (__GNUC__)
+#error no gnuc
+#endif
+"))
+                           deps)
+                     deps))
+           (gcc? (file-name "cc is GNU C" deps))
+           (deps (if cc
+                     (cons (check-compile-c cc (make-dep "cc is Mes C" #:data "#if !defined (__MESC__)
+#error no mesc
+#endif
+"))
+                           deps)
+                     deps))
+           (mesc? (file-name "cc is Mes C" deps))
+           (deps (if cc
+                     (cons (check-compile-c cc (make-dep "cc is Tiny CC" #:data "#if !defined (__TINYCC__)
+#error no tinycc
+#endif
+"))
+                           deps)
+                     deps))
+           (tcc? (file-name "cc is Tiny CC" deps))
+           (deps (if cc
+                     (cons (check-link-c cc (make-dep "if cc can create executables" #:data "int main () {return 0;}"))
+                           deps)
+                     deps))
+           (mes? (or mes? (not (file-name "if cc can create executables" deps))))
+           (build-type (or (and cc (gulp-pipe* cc "-dumpmachine")) build-type))
+           (arch (car (string-split build-type #\-)))
+           (arch (if (member arch '("i386" "i486" "i586" "i686")) "x86"
+                     arch))
+           (mes-arch arch)
+           (mes-arch (if mes? (string-append mes-arch "-mes") mes-arch))
+           (mes-arch (if gcc? (string-append mes-arch "-gcc") mes-arch))
+           (mes-arch (if tcc? (string-append mes-arch "-gcc") mes-arch))
+           (posix? (and (not mesc?) (not mes?))))
 
       (define* (substitute file-name pairs
                            #:key (target (if (string-suffix? ".in" file-name)
@@ -400,12 +489,15 @@ Some influential environment variables:
         (system* "mkdir" "-p" (dirname target))
         (with-output-to-file target
           (lambda _
-            (display
-             (fold (lambda (o result)
-                     (regexp-substitute/global #f (car o) result 'pre (cdr o) 'post))
-                   (with-input-from-file file-name read-string) pairs)))))
+            (let ((in (open-input-file file-name)))
+              (let loop ((line (read-line in 'concat)))
+                (when (not (eof-object? line))
+                  (display (fold (lambda (o result)
+                                   (string-replace-string/all result (car o) (cdr o)))
+                                 line pairs))
+                  (loop (read-line in 'concat))))))))
 
-      (when (and (not (member arch '("i686" "x86_64"))) (not with-courage?))
+      (when (and (not (member arch '("x86" "x86_64"))) (not with-courage?))
         (stderr "platform not supported: ~a, try --with-courage\n" arch)
         (exit 1))
       (when (pair? missing)
@@ -418,71 +510,72 @@ Some influential environment variables:
           (and (zero? (system* "git" "init"))
                (zero? (system* "git" "add" "."))
                (zero? (system* "git" "commit" "--allow-empty" "-m" "Import mes")))))
-      (with-output-to-file ".config.make"
-        (lambda _
-          (stdout "PACKAGE:=~a\n" PACKAGE)
-          (stdout "VERSION:=~a\n" VERSION)
 
-          (stdout "arch:=~a\n" arch)
-          (stdout "build:=~a\n" build-type)
-          (stdout "host:=~a\n" host-type)
+      (let ((pairs `(("@PACKAGE@" . ,PACKAGE)
+                     ("@VERSION@" . ,VERSION)
 
-          (stdout "top_builddir:=~a\n" top-builddir)
-          (stdout "abs_top_builddir:=~a\n" abs-top-builddir)
-          (stdout "abs_top_srcdir:=~a\n" abs-top-srcdir)
+                     ("@arch@" . ,arch)
+                     ("@build@" . ,build-type)
+                     ("@host@" . ,host-type)
 
-          (stdout "srcdest:=~a\n" srcdest)
-          (stdout "srcdir:=~a\n" srcdir)
+                     ("@gcc_p@" . ,(if gcc? "1" ""))
+                     ("@mes_arch@" . ,mes-arch)
+                     ("@mes_p@" . ,(if mes? "1" ""))
+                     ("@mesc_p@" . ,(if mesc? "1" ""))
+                     ("@posix_p@" . ,(if posix? "1" ""))
+                     ("@tcc_p@" . ,(if tcc? "1" ""))
 
-          (stdout "prefix:=~a\n" (gulp-pipe (string-append "echo " prefix)))
-          (stdout "datadir:=~a\n" datadir)
-          (stdout "docdir:=~a\n" docdir)
-
-          (stdout "bindir:=~a\n" bindir)
-          (stdout "guile_site_ccache_dir:=~a\n" guile-site-ccache-dir)
-          (stdout "guile_site_dir:=~a\n" guile-site-dir)
-          (stdout "infodir:=~a\n" infodir)
-          (stdout "libdir:=~a\n" libdir)
-          (stdout "mandir:=~a\n" mandir)
-          (stdout "moduledir:=~a\n" moduledir)
-          (stdout "sysconfdir:=~a\n" sysconfdir)
-
-          (for-each (lambda (o)
-                      (stdout "~a:=~a\n" (variable-name o) (or (dependency-file-name o) "")))
-                    deps)
-          (stdout "GUILE_EFFECTIVE_VERSION:=~a\n" (effective-version))
-
-          (when disable-silent-rules?
-            (stdout "V:=1\n"))
-
-          (when with-cheating?
-            (stdout "MES:=guile\n"))
-
-          (for-each (lambda (o)
-                      (stdout "~a:=~a\n" o (or (getenv o) "")))
-                    '(
-                      "CFLAGS"
-                      "CC32_CFLAGS"
-                      "CC64_CFLAGS"
-                      "HEX2FLAGS"
-                      "M1FLAGS"
-                      "MES_CFLAGS"
-                      ))))
-
-      (let ((pairs `(("@srcdest@" . ,srcdest)
-                     ("@srcdir@" . ,srcdir)
                      ("@abs_top_srcdir@" . ,abs-top-srcdir)
                      ("@abs_top_builddir@" . ,abs-top-builddir)
                      ("@top_builddir@" . ,top-builddir)
-                     ("@BASH@" . ,(file-name "bash" deps))
-                     ("@GUILE@" . ,(file-name "guile" deps))
-                     ("@MES@" . ,(file-name "guile" deps))
+
+                     ("@srcdest@" . ,srcdest)
+                     ("@srcdir@" . ,srcdir)
+
                      ("@prefix@" . ,prefix)
-                     ("@guile_site_dir@" . ,guile-site-dir)
+                     ("@program_prefix@" . ,program-prefix)
+                     ("@bindir@" . ,bindir)
+                     ("@datadir@" . ,datadir)
+                     ("@docdir@" . ,docdir)
                      ("@guile_site_ccache_dir@" . ,guile-site-ccache-dir)
-                     ("@VERSION@" . ,VERSION)
-                     ("@arch@" . ,arch)
-                     ("mes/module/" . ,(string-append moduledir/)))))
+                     ("@guile_site_dir@" . ,guile-site-dir)
+                     ("@infodir@" . ,infodir)
+                     ("@libdir@" . ,libdir)
+                     ("@mandir@" . ,mandir)
+                     ("@moduledir@" . ,moduledir)
+                     ("@sysconfdir@" . ,sysconfdir)
+
+                     ("@GUILE_EFFECTIVE_VERSION@" . ,(effective-version))
+                     ("@V@" . ,(if disable-silent-rules? 1 0))
+
+                     ("@AR@" . ,(file-name "ar" deps))
+                     ("@BASH@" . ,(file-name "bash" deps))
+                     ("@CC@" . ,(or (file-name "cc" deps) ""))
+                     ("@DOT@" . ,(file-name "dot" deps))
+                     ("@GIT@" . ,(or (file-name "git" deps) ""))
+                     ("@GUILE@" . ,guile)
+                     ("@GUIX@" . ,(or (file-name "guix" deps) ""))
+                     ("@HELP2MAN@" . ,(file-name "help2man" deps))
+                     ("@MAKEINFO@" . ,(file-name "makeinfo" deps))
+                     ("@MES_FOR_BUILD@" . ,(or (file-name "mes" deps)
+                                               guile))
+                     ("@MES_SEED@" . ,(or mes-seed ""))
+                     ("@PERL@" . ,(file-name "perl" deps))
+
+                     ("@CFLAGS@" . ,(or (getenv "CFLAGS") ""))
+                     ("@HEX2FLAGS@" . ,(or (getenv "HEX2FLAGS") ""))
+                     ("@M1FLAGS@" . ,(or (getenv "M1FLAGS") ""))
+
+                     ("mes/module/" . ,(string-append moduledir/))
+                     ,@(map
+                        (lambda (o)
+                          (cons (string-append "@" (variable-name o) "@") (or (format #f "~a" (dependency-file-name o)) "")))
+                        deps))))
+
+        (when (and (not cc)
+                   (not mes-seed))
+          (format (current-error-port) "must supply C compiler or MES_SEED/x86-mes/mes.S\n")
+          (exit 2))
         (for-each (lambda (o)
                     (let* ((src (string-append srcdest o))
                            (target (string-drop-right o 3))
@@ -491,6 +584,7 @@ Some influential environment variables:
                       (substitute src pairs #:target target)))
                   '(
                     "build-aux/GNUmakefile.in"
+                    "build-aux/config.status.in"
                     "build-aux/build.sh.in"
                     "build-aux/check.sh.in"
                     "build-aux/install.sh.in"
@@ -498,17 +592,23 @@ Some influential environment variables:
                     "build-aux/uninstall.sh.in"
                     "mes/module/mes/boot-0.scm.in"
                     "scripts/mescc.in"
-                    )))
-      (chmod "build.sh" #o755)
-      (chmod "check.sh" #o755)
-      (chmod "install.sh" #o755)
-      (chmod "pre-inst-env" #o755)
-      (chmod "uninstall.sh" #o755)
-      (chmod "scripts/mescc" #o755)
+                    ))
+        (chmod "pre-inst-env" #o755)
+        (chmod "scripts/mescc" #o755)
+        (chmod "build.sh" #o755)
+        (chmod "check.sh" #o755)
+        (chmod "install.sh" #o755)
+        (chmod "uninstall.sh" #o755)
+        (substitute (string-append srcdest "build-aux/config.make.in") pairs #:target ".config.make"))
+
       (let ((make (and=> (file-name "make" deps) basename)))
         (format (current-output-port)
-                "\nRun:
+                "
+GNU Mes is configured for ~a
+
+Run:
   ~a            to build mes
   ~a help       for help on other targets\n"
+                mes-arch
                 (or make "./build.sh")
                 (or make "./build.sh"))))))

configure.sh

@@ -21,22 +21,55 @@
 set -e
 
 VERSION=0.18
-
-# parse --prefix=prefix
-cmdline=$(echo "$@")
-p=${cmdline##*--prefix=}
-p=${p% *}
-p=${p% -*}
-if [ -z "$p" ]; then
-    p=${prefix-/usr/local}
-fi
-prefix=$p
-
 srcdir=${srcdir-$(dirname $0)}
 . ${srcdest}build-aux/trace.sh
 
+# parse --mes
+cmdline=$(echo " $@")
+p=${cmdline/ --mes/}
+if [ "$p" != "$cmdline" ]; then
+    mes_p=${mes_p-1}
+fi
+
+# parse --prefix=PREFIX
+p=${cmdline/ --prefix=/ -prefix=}
+if [ "$p" != "$cmdline" ]; then
+    p=${p##* -prefix=}
+    p=${p% *}
+    p=${p% -*}
+    prefix=${p-/usr/local}
+
+else
+    prefix=${prefix-/usr/local}
+fi
+
+# parse --program-prefix=
+p=${cmdline/ --program-prefix=/ -program-prefix=}
+if [ "$p" != "$cmdline" ]; then
+    p=${p##* -program-prefix=}
+    p=${p% *}
+    p=${p% -*}
+    program_prefix=$p
+fi
+
+AR=${AR-$(command -v ar)} || true
 BASH=${BASH-$(command -v bash)}
+BLOOD_ELF=${BLOOD_ELF-$(command -v blood-elf)}
+CC=${CC-$(command -v gcc)} || true
+GUILD=${GUILD-$(command -v guild)} || true
+GUILE_TOOLS=${GUILE_TOOLS-$(command -v guile-tools)} || true
+if [ ! "$GUILD" ]; then
+    if [ "$GUILE_TOOLS" ]; then
+        GUILD=$GUILE_TOOLS
+    else
+        GUILD=true
+    fi
+fi
 GUILE=${GUILE-$(command -v guile)} || true
+HEX2=${HEX2-$(command -v hex2)}
+M1=${M1-$(command -v M1)}
+MES_FOR_BUILD=${MES_FOR_BUILD-$(command -v mes || command -v guile || echo mes)}
+MES_SEED=${MES_SEED-../mes-seed}
 
 if [ "$srcdir" = . ]; then
     top_builddir=.
@@ -52,48 +85,126 @@ if [ -z "$GUILE" -o "$GUILE" = true ]; then
 else
     GUILE_EFFECTIVE_VERSION=${GUILE_EFFECTIVE_VERSION-$(guile -c '(display (effective-version))')}
 fi
+bindir=$(eval echo ${bindir-$prefix/bin})
 datadir=$(eval echo ${datadir-$prefix/share})
 docdir=$(eval echo ${docdir-$datadir/doc/mes-$VERSION})
 infodir=$(eval echo ${infodir-$datadir/info})
+libdir=$(eval echo ${libdir-$prefix/lib})
 mandir=$(eval echo ${mandir-$datadir/man})
 moduledir=$(eval echo ${moduledir-$datadir/mes/module})
 moduledir_="$moduledir/"
 guile_site_dir=$(eval echo ${guile_site_dir-$prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION})
 guile_site_ccache_dir=$(eval echo ${guile_site_ccache_dir-$prefix/lib/guile/$GUILE_EFFECTIVE_VERSION/site-ccache})
-arch=$(get_machine || uname -m)
 
 subst () {
     sed \
-    -e s,"@srcdest@,$srcdest,"\
-    -e s,"@srcdir@,$srcdir,"\
+    -e s,"@PACKAGE@,$PACKAGE,"\
+    -e s,"@VERSION@,$VERSION,"\
+    -e s,"@arch@,$arch,"\
+    -e s,"@build@,$build,"\
+    -e s,"@host@,$host,"\
+    -e s,"@compiler@,$compiler,"\
+    -e s,"@gcc_p@,$gcc_p,"\
+    -e s,"@mes_p@,$mes_p,"\
+    -e s,"@mesc_p@,$mesc_p,"\
+    -e s,"@tcc_p@,$tcc_p,"\
+    -e s,"@mes_arch@,$mes_arch,"\
+    -e s,"@posix_p@,$posix_p,"\
     -e s,"@abs_top_srcdir@,$abs_top_srcdir,"\
     -e s,"@abs_top_builddir@,$abs_top_builddir,"\
     -e s,"@top_builddir@,$top_builddir,"\
-    -e s,"@BASH@,$BASH,"\
-    -e s,"@GUILE@,$GUILE,"\
+    -e s,"@srcdest@,$srcdest,"\
+    -e s,"@srcdir@,$srcdir,"\
     -e s,"@prefix@,$prefix,"\
+    -e s,"@program_prefix@,$program_prefix,"\
+    -e s,"@bindir@,$bindir,"\
+    -e s,"@datadir@,$datadir,"\
+    -e s,"@docdir@,$docdir,"\
     -e s,"@guile_site_dir@,$guile_site_dir,"\
     -e s,"@guile_site_ccache_dir@,$guile_site_ccache_dir,"\
-    -e s,"@VERSION@,$VERSION,"\
-    -e s,"@arch@,$arch,"\
+    -e s,"@infodir@,$infodir,"\
+    -e s,"@libdir@,$libdir,"\
+    -e s,"@mandir@,$mandir,"\
+    -e s,"@moduledir@,$moduledir,"\
+    -e s,"@sysconfdir@,$sysconfdir,"\
+    -e s,"@GUILE_EFFECTIVE_VERSION@,$GUILE_EFFECTIVE_VERSION,"\
+    -e s,"@V@,$V,"\
+    -e s,"@AR@,$AR,"\
+    -e s,"@BASH@,$BASH,"\
+    -e s,"@BLOOD_ELF@,$BLOOD_ELF,"\
+    -e s,"@CC@,$CC,"\
+    -e s,"@GUILD@,$GUILD,"\
+    -e s,"@GUILE@,$GUILE,"\
+    -e s,"@CFLAGS@,$CFLAGS,"\
+    -e s,"@HEX2@,$HEX2,"\
+    -e s,"@HEX2FLAGS@,$HEX2FLAGS,"\
+    -e s,"@M1@,$M1,"\
+    -e s,"@M1FLAGS@,$M1FLAGS,"\
+    -e s,"@MES_FOR_BUILD@,$MES_FOR_BUILD,"\
+    -e s,"@MES_SEED@,$MES_SEED,"\
     -e s,"mes/module/,$moduledir/,"\
     $1 > $2
 }
 
 subst ${srcdest}build-aux/pre-inst-env.in pre-inst-env
 chmod +x pre-inst-env
-subst ${srcdest}mes/module/mes/boot-0.scm.in mes/module/mes/boot-0.scm
 subst ${srcdest}scripts/mescc.in scripts/mescc
-
-subst ${srcdest}build-aux/GNUmakefile.in GNUmakefile
-subst ${srcdest}build-aux/build.sh.in build.sh
-subst ${srcdest}build-aux/check.sh.in check.sh
-subst ${srcdest}build-aux/install.sh.in install.sh
-subst ${srcdest}build-aux/uninstall.sh.in uninstall.sh
-
 chmod +x scripts/mescc
 
+host=${host-$($CC -dumpmachine 2>/dev/null || echo x86)}
+if [ -z "$host" ]; then
+    arch=${arch-$(get_machine || uname -m)}
+else
+    arch=${host%%-*}
+fi
+if [ "$arch" = i386\
+             -o "$arch" = i486\
+             -o "$arch" = i586\
+             -o "$arch" = i686\
+   ]; then
+    arch=x86
+fi
+
+#
+if $CC --version | grep gcc 2>/dev/null; then
+    gcc_p=1
+    compiler=gcc
+elif $CC --version | grep tcc 2>/dev/null; then
+    tcc_p=1
+    compiler=tcc
+else
+    mes_p=1
+    mesc_p=1
+    compiler=mescc
+fi
+
+mes_arch=$arch
+if [ "$mes_p" -o "$mesc_p" ]; then
+    mes_arch=$arch-mes
+fi
+
+if [ ! "$mesc_p" ]; then
+    mes_arch=$mes_arch-$compiler
+fi
+if [ ! "$mesc_p" -a ! "$mes_p" ]; then
+    posix_p=1
+fi
+
+subst ${srcdest}mes/module/mes/boot-0.scm.in mes/module/mes/boot-0.scm
+subst ${srcdest}build-aux/GNUmakefile.in GNUmakefile
+subst ${srcdest}build-aux/config.status.in config.status
+subst ${srcdest}build-aux/build.sh.in build.sh
+chmod +x build.sh
+subst ${srcdest}build-aux/check.sh.in check.sh
+chmod +x check.sh
+subst ${srcdest}build-aux/install.sh.in install.sh
+chmod +x install.sh
+subst ${srcdest}build-aux/uninstall.sh.in uninstall.sh
+chmod +x uninstall.sh
+
 cat <<EOF
+GNU Mes is configured for $mes_arch
+
 Run:
   ./build.sh      to build mes
   ./check.sh      to check mes

doc/mes.texi

@@ -33,7 +33,7 @@ Documentation License''.
 @end direntry
 
 @titlepage
-@title Mes Reference Manual
+@title GNU Mes Reference Manual
 @subtitle Full Source Bootstrapping of the GNU GuixSD Operating System
 @author Jan (janneke) Nieuwenhuizen
 
@@ -49,7 +49,7 @@ Edition @value{EDITION} @*
 
 @c *********************************************************************
 @node Top
-@top Mes
+@top GNU Mes
 
 This document describes GNU Mes version @value{VERSION}, a bootstrappable
 Scheme interpreter and C compiler written for bootstrapping the GNU system.
@@ -1039,7 +1039,7 @@ Please send bug reports with full details to @email{bug-mes@@gnu.org}.
 @chapter Acknowledgments
 
 We would like to thank the following people for their help: Jeremiah
-Orians, pdewacht, rain1, Ricardo Wurmus, Rutger van Beusekom.
+Orians, Peter de Wachter, rain1, Ricardo Wurmus, Rutger van Beusekom.
 
 We also thank Ludovic Courtès for creating GuixSD and making the
 bootstrap problem so painfully visible, John McCarthy for creating

include/errno.h

@@ -44,11 +44,14 @@ int errno;
 #define	ECHILD  10
 #define EAGAIN  11
 #define ENOMEM  12
+#define EACCES  13
 #define EEXIST  17
 #define ENOTDIR 20
 #define EISDIR  21
 #define EINVAL  22
 #define EMFILE  24
+#define ENOSPC  28
+#define ESPIPE  29
 #define EPIPE   32
 #define ERANGE  34
 

include/libmes-mini.h

@@ -21,6 +21,13 @@
 #ifndef __MES_LIBMES_MINI_H
 #define __MES_LIBMES_MINI_H
 
+char **environ;
+int g_stdin;
+int g_stdout;
+int g_stderr;
+
+#if !WITH_GLIBC
+
 #ifndef _SIZE_T
 #define _SIZE_T
 #ifndef __SIZE_T
@@ -40,10 +47,22 @@ typedef unsigned long size_t;
 #ifndef __MES_SSIZE_T
 #define __MES_SSIZE_T
 #undef ssize_t
+#if __i386__
+typedef int ssize_t;
+#else
 typedef long ssize_t;
 #endif
 #endif
 #endif
+#endif
+
+#ifndef __MES_ERRNO_T
+#define __MES_ERRNO_T 1
+typedef int error_t;
+int errno;
+#endif // !__MES_ERRNO_T
+
+#endif //!WITH_LIBC
 
 #ifndef STDIN
 #define STDIN 0
@@ -57,16 +76,14 @@ typedef long ssize_t;
 #define STDERR 2
 #endif
 
-#ifndef __MES_ERRNO_T
-#define __MES_ERRNO_T 1
-typedef int error_t;
-int errno;
-#endif // !__MES_ERRNO_T
 
-size_t strlen (char const* s);
-ssize_t write (int filedes, void const *buffer, size_t size);
 int eputs (char const* s);
 int puts (char const* s);
 int oputs (char const* s);
 
+#if !WITH_GLIBC
+size_t strlen (char const* s);
+ssize_t write (int filedes, void const *buffer, size_t size);
+#endif // !WITH_GLIBC
+
 #endif //__MES_LIBMES_MINI_H

include/libmes.h

@@ -43,8 +43,8 @@ int isspace (int c);
 int isxdigit (int c);
 int _open3 (char const *file_name, int flags, int mask);
 int _open2 (char const *file_name, int flags);
+int oputc (int c);
 int oputs (char const* s);
-ssize_t write (int filedes, void const *buffer, size_t size);
 char *search_path (char const *file_name);
 
 #endif //__MES_LIBMES_H

include/limits.h

@@ -29,19 +29,12 @@
 
 #else // ! WITH_GLIBC
 
-#define CHAR_BIT 8
-#define UCHAR_MAX 255
-#define CHAR_MAX 255
-#define UINT_MAX 4294967295U
-#define ULONG_MAX 4294967295U
-#define INT_MIN -2147483648
-#define INT_MAX 2147483647
+#include <stdint.h>
+
 #define MB_CUR_MAX 1
-#define LONG_MIN -2147483648
-#define LONG_MAX 2147483647
-#define _POSIX_OPEN_MAX 16
-#define PATH_MAX 512
 #define NAME_MAX 255
+#define PATH_MAX 512
+#define _POSIX_OPEN_MAX 16
 
 #endif // ! WITH_GLIBC
 

include/linux/x86/syscall.h

@@ -73,4 +73,13 @@
 #define SYS_getdents  0x8d
 #define SYS_clock_gettime 0x109
 
+// bash
+#define SYS_setuid    0x17
+#define SYS_geteuid   0x31
+#define SYS_getegid   0x32
+#define SYS_setgid    0x3e
+
+// make+POSIX
+#define SYS_sigprocmask 0x7e
+
 #endif // __MES_LINUX_X86_SYSCALL_H

include/linux/x86_64/syscall.h

@@ -69,4 +69,13 @@
 #define SYS_getdents  0x4e
 #define SYS_clock_gettime 0xe4
 
+// bash
+#define SYS_setuid    0x69
+#define SYS_setgid    0x6a
+#define SYS_geteuid   0x6b
+#define SYS_getegid   0x6c
+
+// make+POSIX
+#define SYS_rt_sigprocmask 0x0e
+
 #endif // __MES_LINUX_X86_64_SYSCALL_H

include/pwd.h

@@ -36,6 +36,9 @@ struct passwd
   char *pw_shell;
 };
 
+struct passwd * getpwuid ();
+
+
 #endif  // ! WITH_GLIBC
 
 #endif // __MES_PWD_H

include/signal.h

@@ -228,6 +228,12 @@ void* signal (int signum, void * action);
 sighandler_t signal (int signum, sighandler_t action);
 #endif
 int sigemptyset (sigset_t *set);
+#ifndef SIG_BLOCK
+#define SIG_BLOCK 0
+#define SIG_UNBLOCK 1
+#define SIG_SETMASK 2
+#endif
+int sigprocmask (int how, sigset_t const *set, sigset_t *oldset);
 
 #endif //! WITH_GLIBC
 

include/stdint.h

@@ -1,6 +1,7 @@
 /* -*-comment-start: "//";comment-end:""-*-
  * GNU Mes --- Maxwell Equations of Software
  * Copyright © 2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2018 Peter De Wachter <pdewacht@gmail.com>
  *
  * This file is part of GNU Mes.
  *
@@ -80,6 +81,46 @@ typedef unsigned* uintptr_t;
 typedef long ptrdiff_t;
 #endif
 
+#define CHAR_BIT 8
+#define CHAR_MAX 255
+#define UCHAR_MAX 255
+
+#define INT8_MAX 127
+#define INT8_MIN (-INT8_MAX-1)
+#define UINT8_MAX 255
+
+#define INT16_MAX 32767
+#define INT16_MIN (-INT16_MAX-1)
+#define UINT16_MAX 65535
+
+#define INT32_MAX 2147483647
+#define INT32_MIN (-INT32_MAX-1)
+#define UINT32_MAX 4294967295U
+
+#define INT64_MAX 9223372036854775807LL
+#define INT64_MIN (-INT64_MAX-1)
+#define UINT64_MAX 18446744073709551615ULL
+
+#define INT_MIN -2147483648
+#define INT_MAX 2147483647
+#if __i386__
+#define LONG_MIN INT_MIN
+#define LONG_MAX INT_MAX
+#define UINT_MAX UINT32_MAX
+#define ULONG_MAX UINT32_MAX
+#define LLONG_MIN INT64_MIN
+#define LLONG_MAX INT64_MAX
+#define SIZE_MAX UINT32_MAX
+#elif __x86_64__
+#define LONG_MIN INT64_MIN
+#define LONG_MAX INT64_MAX
+#define UINT_MAX UINT32_MAX
+#define ULONG_MAX UINT64_MAX
+#define LLONG_MIN INT64_MIN
+#define LLONG_MAX INT64_MAX
+#define SIZE_MAX UINT64_MAX
+#endif
+
 #endif // ! WITH_GLIBC
 
 #endif // __MES_STDINT_H

include/stdio.h

@@ -20,21 +20,7 @@
 #ifndef __MES_STDIO_H
 #define __MES_STDIO_H 1
 
-char **environ;
-int g_stdin;
-int g_stdout;
-
-#ifndef STDIN
-#define STDIN 0
-#endif
-
-#ifndef STDOUT
-#define STDOUT 1
-#endif
-
-#ifndef STDERR
-#define STDERR 2
-#endif
+#include <libmes.h>
 
 #if WITH_GLIBC
 #ifndef _GNU_SOURCE

include/stdlib.h

@@ -42,6 +42,7 @@ int setenv (char const* s, char const* v, int overwrite_p);
 void unsetenv (char const *name);
 void *malloc (size_t);
 void qsort (void *base, size_t nmemb, size_t size, int (*compar)(void const *, void const *));
+int rand (void);
 void *realloc (void *p, size_t size);
 double strtod (char const *string, char **tailptr);
 float strtof (char const *string, char **tailptr);

include/string.h

@@ -45,6 +45,7 @@ typedef unsigned long size_t;
 typedef long ssize_t;
 #endif
 
+void * memchr (void const *block, int c, size_t size);
 void *memcpy (void *dest, void const *src, size_t n);
 void *memmove (void *dest, void const *src, size_t n);
 void *memset (void *s, int c, size_t n);

include/sys/stat.h

@@ -101,6 +101,17 @@ int stat (char const *file_name, struct stat *buf);
 #define S_IWUSR 00200
 #define S_IRUSR 00400
 
+#define S_ISUID 0400
+#define S_ISGID 02000
+#define S_IXGRP 00010
+#define S_IXOTH 00001
+#define S_IRGRP 00040
+#define S_IROTH 00004
+#define S_IWGRP 00020
+#define S_IWOTH 00002
+#define S_IRWXG 00070
+#define S_IRWXO 00007
+
 #endif // ! WITH_GLIBC
 
 #endif // __MES_SYS_STAT_H

include/termio.h

@@ -0,0 +1,64 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU 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.
+ *
+ * GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+#ifndef __MES_TERMIO_H
+#define __MES_TERMIO_H 1
+
+#if WITH_GLIBC
+#ifndef _GNU_SOURCE
+#define _GNU_SOURCE
+#endif
+#undef __MES_TERMIO_H
+#include_next <termio.h>
+
+#else // ! WITH_GLIBC
+
+#define TIOCGWINSZ	0x5413
+#define TCGETA		0x5405
+#define TCSETAW		0x5407
+
+#define VTIME 5
+#define VMIN 6
+
+#define ISIG	0000001
+#define ICANON	0000002
+#define ECHO	0000010
+#define ECHOK	0000040
+#define ECHONL	0000100
+
+#define ISTRIP	0000040
+#define INLCR	0000100
+#define ICRNL	0000400
+
+#define   CS8	0000060
+#define PARENB	0000400
+
+struct termio
+{
+  unsigned short c_iflag;
+  unsigned short c_oflag;
+  unsigned short c_cflag;
+  unsigned short c_lflag;
+  unsigned char c_line;
+  unsigned char c_cc[8];
+};
+
+#endif // ! WITH_GLIBC
+
+#endif // __MES_TERMIO_H

include/time.h

@@ -54,6 +54,7 @@ struct timespec
 
 #endif // __MES_STRUCT_TIMESPEC
 
+#define CLOCK_PROCESS_CPUTIME_ID 2
 int clock_gettime (clockid_t clk_id, struct timespec *tp);
 struct tm *localtime (time_t const *timep);
 struct tm *gmtime (time_t const *time);

include/unistd.h

@@ -29,6 +29,10 @@
 
 #else // ! WITH_GLIBC
 
+#if !defined (BOOTSTRAP_WITHOUT_POSIX)
+#define _POSIX_VERSION 199009L
+#endif
+
 #include <sys/types.h>
 #ifndef NULL
 #define NULL 0
@@ -62,8 +66,12 @@ int execve (char const *file, char *const argv[], char *const env[]);
 int execvp (char const *file, char *const argv[]);
 int fork (void);
 char *getcwd (char *buf, size_t size);
-gid_t getgid (void);
 uid_t getuid (void);
+gid_t getgid (void);
+int setgid (gid_t newgid);
+int setuid (uid_t newuid);
+uid_t geteuid (void);
+gid_t getegid (void);
 int isatty (int fd);
 int link (char const *oldname, char const *newname);
 off_t lseek (int fd, off_t offset, int whence);

lib/libc+gnu.c

@@ -113,3 +113,8 @@
 #include <stub/sigblock.c>
 #include <stub/sigaddset.c>
 #include <stub/setlocale.c>
+
+// bash
+#include <stub/getpwuid.c>
+#include <stub/rand.c>
+#include <stub/ttyname.c>

lib/libmes.c

@@ -47,3 +47,4 @@
 #endif // POSIX
 
 #include <mes/eputc.c>
+#include <mes/oputc.c>

lib/linux/clock_gettime.c

@@ -0,0 +1,27 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU 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.
+ *
+ * GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <time.h>
+
+int
+clock_gettime (clockid_t clk_id, struct timespec *tp)
+{
+  return _sys_call2 (SYS_clock_gettime, (long)clk_id, (long)tp);
+}

lib/linux/gettimeofday.c

@@ -0,0 +1,27 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU 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.
+ *
+ * GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <time.h>
+
+int
+gettimeofday (struct timeval *tv, struct timezone *tz)
+{
+  return _sys_call2 (SYS_gettimeofday, (long)tv, (long)tz);
+}

lib/linux/gnu.c

@@ -57,12 +57,6 @@ mkdir (char const *file_name, mode_t mode)
   return _sys_call2 (SYS_mkdir, (long)file_name, (long)mode);
 }
 
-int
-dup (int old)
-{
-  return _sys_call1 (SYS_dup, (int)old);
-}
-
 gid_t
 getgid ()
 {
@@ -124,12 +118,6 @@ pipe (int filedes[2])
   return _sys_call1 (SYS_pipe, (long)filedes);
 }
 
-int
-dup2 (int old, int new)
-{
-  return _sys_call2 (SYS_dup2, (int)old, (int)new);
-}
-
 int
 getrusage (int processes, struct rusage *rusage)
 {
@@ -174,8 +162,38 @@ chdir (char const *file_name)
   return _sys_call1 (SYS_chdir, (long)file_name);
 }
 
-int
-clock_gettime (clockid_t clk_id, struct timespec *tp)
+// bash
+uid_t
+geteuid ()
 {
-  return _sys_call2 (SYS_clock_gettime, (long)clk_id, (long)tp);
+  return _sys_call (SYS_geteuid);
+}
+
+gid_t
+getegid ()
+{
+  return _sys_call (SYS_getegid);
+}
+
+int
+setuid (uid_t newuid)
+{
+  return _sys_call1 (SYS_setuid, (long)newuid);
+}
+
+int
+setgid (gid_t newgid)
+{
+  return _sys_call1 (SYS_setgid, (long)newgid);
+}
+
+// make+POSIX
+int
+sigprocmask (int how, sigset_t const *set, sigset_t *oldset)
+{
+#if __i386__
+  return _sys_call3 (SYS_sigprocmask, (long)how, (long)set, (long)oldset);
+#else
+  return _sys_call3 (SYS_rt_sigprocmask, (long)how, (long)set, (long)oldset);
+#endif
 }

lib/linux/libc.c

@@ -149,3 +149,34 @@ fsync (int filedes)
 {
   return _sys_call1 (SYS_fsync, (int)filedes);
 }
+
+char *
+getcwd (char *buffer, size_t size)
+{
+  int r = _sys_call2 (SYS_getcwd, (long)buffer, (long)size);
+  if (r >= 0)
+    return buffer;
+  return 0;
+}
+
+int
+dup (int old)
+{
+  return _sys_call1 (SYS_dup, (int)old);
+}
+
+int
+dup2 (int old, int new)
+{
+  return _sys_call2 (SYS_dup2, (int)old, (int)new);
+}
+
+int
+unlink (char const *file_name)
+{
+  return _sys_call1 (SYS_unlink, (long)file_name);
+}
+
+#include "linux/clock_gettime.c"
+#include "linux/gettimeofday.c"
+#include "linux/time.c"

lib/linux/tcc.c

@@ -37,12 +37,6 @@ lseek (int filedes, off_t offset, int whence)
   return _sys_call3 (SYS_lseek, (int)filedes, (long)offset, (int)whence);
 }
 
-int
-unlink (char const *file_name)
-{
-  return _sys_call1 (SYS_unlink, (long)file_name);
-}
-
 int
 rmdir (char const *file_name)
 {
@@ -54,21 +48,3 @@ stat (char const *file_name, struct stat *statbuf)
 {
   return _sys_call2 (SYS_stat, (long)file_name, (long)statbuf);
 }
-
-char *
-getcwd (char *buffer, size_t size)
-{
-  return _sys_call2 (SYS_getcwd, (long)buffer, (long)size);
-}
-
-time_t
-time (time_t *result)
-{
-  return _sys_call1 (SYS_time, (long)result);
-}
-
-int
-gettimeofday (struct timeval *tv, struct timezone *tz)
-{
-  return _sys_call2 (SYS_gettimeofday, (long)tv, (long)tz);
-}

lib/linux/time.c

@@ -0,0 +1,27 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU 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.
+ *
+ * GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <time.h>
+
+time_t
+time (time_t *result)
+{
+  return _sys_call1 (SYS_time, (long)result);
+}

lib/mes/eputc.c

@@ -23,5 +23,5 @@
 int
 eputc (int c)
 {
-  return fdputc (c, STDERR);
+  return fdputc (c, g_stderr);
 }

lib/mes/eputs.c

@@ -24,6 +24,6 @@ int
 eputs (char const* s)
 {
   int i = strlen (s);
-  write (STDERR, s, i);
+  write (g_stderr, s, i);
   return 0;
 }

lib/mes/oputc.c

@@ -0,0 +1,27 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU 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.
+ *
+ * GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <libmes.h>
+
+int
+oputc (int c)
+{
+  return fdputc (c, g_stdout);
+}

lib/mes/oputs.c

@@ -24,6 +24,6 @@ int
 oputs (char const* s)
 {
   int i = strlen (s);
-  write (1, s, i);
+  write (g_stdout, s, i);
   return 0;
 }

lib/stdio/snprintf.c

@@ -25,8 +25,14 @@ int
 snprintf (char *str,  size_t size,  char const *format, ...)
 {
   va_list ap;
+  int r;
+#if __GNUC__ && __x86_64__
+#define __FUNCTION_ARGS 3
+  ap += (__FOO_VARARGS + (__FUNCTION_ARGS << 1)) << 3;
+#undef __FUNCTION_ARGS
+#endif
   va_start (ap, format);
-  int r = vsprintf (str, format, ap);
+  r = vsnprintf (str, size, format, ap);
   va_end (ap);
   return r;
 }

lib/stdio/vsnprintf.c

@@ -22,7 +22,200 @@
 #include <stdlib.h>
 
 int
-vsnprintf (char *str, size_t size, char const *format, va_list ap)
+vsnprintf (char *str, size_t size, char const* format, va_list ap)
 {
-  return vsprintf (str, format, ap);
+  char const *p = format;
+  int count = 0;
+  char c;
+  while (*p)
+    if (*p != '%')
+      {
+        c = *p++;
+        if (count < size)
+          *str++ = c;
+        count++;
+      }
+    else
+      {
+        p++;
+        c = *p;
+        int left_p = 0;
+        int precision = -1;
+        int width = -1;
+        if (c == '-')
+          {
+            left_p = 1;
+            c = *++p;
+          }
+        char pad = ' ';
+        if (c == '0')
+          {
+            pad = c;
+            c = *p++;
+          }
+        if (c >= '0' && c <= '9')
+          {
+            width = abtol (&p, 10);
+            c = *p;
+          }
+        else if (c == '*')
+          {
+            width = va_arg (ap, long);
+            c = *++p;
+          }
+        if (c == '.')
+          {
+            c = *++p;
+            if (c >= '0' && c <= '9')
+              {
+                precision = abtol (&p, 10);
+                c = *p;
+              }
+            else if (c == '*')
+              {
+                precision = va_arg (ap, long);
+                c = *++p;
+              }
+          }
+        if (c == 'l')
+          c = *++p;
+        if (c == 'l')
+          c = *++p;
+        if (c == 'l')
+          {
+            eputs ("vsnprintf: skipping second: l\n");
+            c = *++p;
+          }
+        switch (c)
+          {
+          case '%':
+            {
+              if (count < size)
+                *str++ = *p;
+              count++;
+              break;
+            }
+          case 'c':
+            {
+              c = va_arg (ap, long);
+              if (count < size)
+                *str++ = c;
+              count++;
+              break;
+            }
+          case 'd':
+          case 'i':
+          case 'o':
+          case 'u':
+          case 'x':
+          case 'X':
+            {
+              long d = va_arg (ap, long);
+              int base = c == 'o' ? 8
+                : c == 'x' || c == 'X' ? 16
+                : 10;
+              char const *s = ntoab (d, base, c != 'u' && c != 'x' && c != 'X');
+              if (c == 'X')
+                strupr (s);
+              int length = strlen (s);
+              if (precision == -1)
+                precision = length;
+              if (!left_p)
+                {
+                  while (width-- > precision)
+                    {
+                      if (count < size)
+                        *str++ = pad;
+                      count++;
+                    }
+                  while (precision > length)
+                    {
+                      if (count < size)
+                        *str++ = '0';
+                      precision--;
+                      width--;
+                      count++;
+                    }
+                }
+              while (*s)
+                {
+                  if (precision-- <= 0)
+                    break;
+                  width--;
+                  c = *s++;
+                  if (count < size)
+                    *str++ = c;
+                  count++;
+                }
+              while (width > 0)
+                {
+                  width--;
+                  if (count < size)
+                    *str++ = pad;
+                  count++;
+                }
+              break;
+            }
+          case 's':
+            {
+              char *s = va_arg (ap, char *);
+              int length = s ? strlen (s) : 0;
+              if (precision == -1)
+                precision = length;
+              if (!left_p)
+                {
+                  while (width-- > precision)
+                    {
+                      if (count < size)
+                        *str++ = pad;
+                      count++;
+                    }
+                  while (width > length)
+                    {
+                      if (count < size)
+                        *str++ = ' ';
+                      precision--;
+                      width--;
+                      count++;
+                    }
+                }
+              while (s && *s)
+                {
+                  if (precision-- <= 0)
+                    break;
+                  width--;
+                  c = *s++;
+                  if (count < size)
+                    *str++ = c;
+                  count++;
+                }
+              while (width > 0)
+                {
+                  width--;
+                  if (count < size)
+                    *str++ = pad;
+                  count++;
+                }
+              break;
+            }
+          case 'n':
+            {
+              int *n = va_arg (ap, int *);
+              *n = count;
+              break;
+            }
+          default:
+            {
+              eputs ("vsnprintf: not supported: %:");
+              eputc (c);
+              eputs ("\n");
+              p++;
+            }
+          }
+        p++;
+      }
+  va_end (ap);
+  if (count < size)
+    *str = 0;
+  return count;
 }

lib/stdio/vsprintf.c

@@ -24,182 +24,5 @@
 int
 vsprintf (char *str, char const* format, va_list ap)
 {
-  char const *p = format;
-  int count = 0;
-  while (*p)
-    if (*p != '%')
-      {
-        *str++ = *p++;
-        count++;
-      }
-    else
-      {
-        p++;
-        char c = *p;
-        int left_p = 0;
-        int precision = -1;
-        int width = -1;
-        if (c == '-')
-          {
-            left_p = 1;
-            c = *++p;
-          }
-        char pad = ' ';
-        if (c == '0')
-          {
-            pad = c;
-            c = *p++;
-          }
-        if (c >= '0' && c <= '9')
-          {
-            width = abtol (&p, 10);
-            c = *p;
-          }
-        else if (c == '*')
-          {
-            width = va_arg (ap, long);
-            c = *++p;
-          }
-        if (c == '.')
-          {
-            c = *++p;
-            if (c >= '0' && c <= '9')
-              {
-                precision = abtol (&p, 10);
-                c = *p;
-              }
-            else if (c == '*')
-              {
-                precision = va_arg (ap, long);
-                c = *++p;
-              }
-          }
-        if (c == 'l')
-          c = *++p;
-        if (c == 'l')
-          c = *++p;
-        if (c == 'l')
-          {
-            eputs ("vfprintf: skipping second: l\n");
-            c = *++p;
-          }
-        switch (c)
-          {
-          case '%':
-            {
-              *str++ = *p;
-              count++;
-              break;
-            }
-          case 'c':
-            {
-              c = va_arg (ap, long);
-              *str++ = c;
-              count++;
-              break;
-            }
-          case 'd':
-          case 'i':
-          case 'o':
-          case 'u':
-          case 'x':
-          case 'X':
-            {
-              long d = va_arg (ap, long);
-              int base = c == 'o' ? 8
-                : c == 'x' || c == 'X' ? 16
-                : 10;
-              char const *s = ntoab (d, base, c != 'u' && c != 'x' && c != 'X');
-              if (c == 'X')
-                strupr (s);
-              int length = strlen (s);
-              if (precision == -1)
-                precision = length;
-              if (!left_p)
-                {
-                  while (width-- > precision)
-                    {
-                      *str++ = pad;
-                      count++;
-                    }
-                  while (precision > length)
-                    {
-                      *str++ = '0';
-                      precision--;
-                      width--;
-                      count++;
-                    }
-                }
-              while (*s)
-                {
-                  if (precision-- <= 0)
-                    break;
-                  width--;
-                  *str++ = *s++;
-                  count++;
-                }
-              while (width > 0)
-                {
-                  width--;
-                  *str++ = pad;
-                  count++;
-                }
-              break;
-            }
-          case 's':
-            {
-              char *s = va_arg (ap, char *);
-              int length = strlen (s);
-              if (precision == -1)
-                precision = length;
-              if (!left_p)
-                {
-                  while (width-- > precision)
-                    {
-                      *str++ = pad;
-                      count++;
-                    }
-                  while (width > length)
-                    {
-                      *str++ = ' ';
-                      precision--;
-                      width--;
-                      count++;
-                    }
-                }
-              while (*s)
-                {
-                  if (precision-- <= 0)
-                    break;
-                  width--;
-                  *str++ = *s++;
-                  count++;
-                }
-              while (width > 0)
-                {
-                  width--;
-                  *str++ = pad;
-                  count++;
-                }
-              break;
-            }
-          case 'n':
-            {
-              int *n = va_arg (ap, int *);
-              *n = count;
-              break;
-            }
-          default:
-            {
-              eputs ("vsprintf: not supported: %:");
-              eputc (c);
-              eputs ("\n");
-              p++;
-            }
-          }
-        p++;
-      }
-  va_end (ap);
-  *str = 0;
-  return strlen (str);
+  return vsnprintf (str, LONG_MAX, format, ap);
 }

lib/string/memchr.c

@@ -0,0 +1,34 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU 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.
+ *
+ * GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <string.h>
+
+void *
+memchr (void const *block, int c, size_t size)
+{
+  char const *p = block;
+  while (size--)
+    {
+      if (c == *p)
+        return p;
+      p++;
+    }
+  return 0;
+}

lib/stub/getpwuid.c

@@ -0,0 +1,33 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU 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.
+ *
+ * GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <libmes.h>
+#include <pwd.h>
+
+struct passwd *
+getpwuid ()
+{
+  static int stub = 0;
+  if (__mes_debug () && !stub)
+    eputs ("getpwuid stub\n");
+  stub = 1;
+  errno = 0;
+  return 0;
+}

lib/stub/rand.c

@@ -0,0 +1,33 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU 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.
+ *
+ * GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <libmes.h>
+#include <pwd.h>
+
+int
+rand (void)
+{
+  static int stub = 0;
+  if (__mes_debug () && !stub)
+    eputs ("rand stub\n");
+  stub = 1;
+  errno = 0;
+  return 0;
+}

lib/stub/ttyname.c

@@ -0,0 +1,35 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU 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.
+ *
+ * GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <libmes.h>
+#include <unistd.h>
+
+char *
+ttyname (int filedes)
+{
+  static int stub = 0;
+  if (__mes_debug () && !stub)
+    eputs ("ttyname stub\n");
+  stub = 1;
+  errno = 0;
+  if (isatty (filedes))
+      return "/dev/tty0";
+  return 0;
+}

lib/x86-mes/x86.M1

@@ -53,6 +53,7 @@ DEFINE cltd 99
 DEFINE cmp____$0x32,%eax 3d
 DEFINE cmp____$i32,%eax 3d
 DEFINE cmp____$i8,%eax 83f8
+DEFINE cmp____$i8,%ebx 81fb
 DEFINE div___%ebx f7f3
 DEFINE hlt f4
 DEFINE idiv___%ebx f7fb
@@ -129,14 +130,15 @@ DEFINE mov____0x8(%ebp),%edx 8b55
 DEFINE mov____0x8(%ebp),%esi 8b75
 DEFINE mov____0x8(%ebp),%esp 8b65
 DEFINE movb___%al,0x32 a2
+DEFINE movb___%bl,0x32 881d
 DEFINE movsbl_%al,%eax 0fbec0
 DEFINE movsbl_%bl,%ebx 0fbedb
 DEFINE movswl_%ax,%eax 0fbfc0
 DEFINE movswl_%bx,%ebx 0fbfdb
 DEFINE movw___%ax,0x32 66a3
+DEFINE movw___%bx,0x32 66891d
 DEFINE movzbl_%al,%eax 0fb6c0
 DEFINE movzbl_%bl,%ebx 0fb6db
-DEFINE movzbl_%bl,%ebx 0fb6db
 DEFINE movzbl_(%eax),%eax 0fb600
 DEFINE movzbl_(%ebx),%ebx 0fb61b
 DEFINE movzbl_0x32(%eax),%eax 0fb680
@@ -203,7 +205,6 @@ DEFINE test___%eax,%eax 85c0
 DEFINE test___%ebx,%ebx 85db
 DEFINE xchg___%eax,%ebx 93
 DEFINE xchg___%eax,(%esp) 870424
-DEFINE xchg___%eax,(%esp) 870424
 DEFINE xchg___%ebx,(%esp) 871c24
 DEFINE xor____$i32,%eax 35
 DEFINE xor____$i8,%ah 80f4

lib/x86_64-mes/x86_64.M1

@@ -1,5 +1,6 @@
 ### GNU Mes --- Maxwell Equations of Software
 ### Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+### Copyright © 2018 Peter De Wachter <pdewacht@gmail.com>
 ###
 ### This file is part of GNU Mes.
 ###
@@ -54,6 +55,7 @@ DEFINE call___*%rax ffd0
 DEFINE call___*%rdi ffd7
 DEFINE cmp____$i32,%rax 483d
 DEFINE cmp____$i8,%rax 4883f8
+DEFINE cmp____$i8,%rdi 4883ff
 DEFINE cmp____%r15,%rax 4c39f8
 DEFINE cmp____%r15,%rdi 4c39ff
 DEFINE cqto 4899
@@ -78,8 +80,6 @@ DEFINE mov____$i32,%rax 48c7c0
 DEFINE mov____$i32,%rdi 48c7c7
 DEFINE mov____$i32,0x8(%rbp) c745
 DEFINE mov____$i64,%r15 49bf
-DEFINE mov____$i64,%rax 48a1
-DEFINE mov____$i64,%rax 48b8
 DEFINE mov____$i64,%rax 48b8
 DEFINE mov____$i64,%rdi 48bf
 DEFINE mov____%al,(%rdi) 8807
@@ -92,7 +92,6 @@ DEFINE mov____%eax,%rax 89c0
 DEFINE mov____%eax,(%rdi) 8907
 DEFINE mov____%eax,0x32(%rbp)  8985
 DEFINE mov____%eax,0x8(%rbp) 8945
-DEFINE mov____%eax,0x8(%rbp) 8945
 DEFINE mov____%edi,%edi 89ff
 DEFINE mov____%edi,%rdi 89ff
 DEFINE mov____%edi,0x32(%rbp) 89bd

mes/module/mes/boot-0.scm.in

@@ -30,7 +30,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (assq x (current-module)))
+  (module-variable (current-module) x))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))
@@ -42,7 +42,6 @@
 ;; end boot-00.scm
 
 ;; boot-01.scm
-(define (pair? x) (eq? (core:type x) <cell:pair>))
 (define (not x) (if x #f #t))
 
 (define (display x . rest)
@@ -104,10 +103,6 @@
                             (cons (quote or) (cdr x))))
                 (car x)))))
 
-(define-macro (module-define! module name value)
-  ;;(list 'define name value)
-  #t)
-
 (define-macro (mes-use-module module)
   #t)
 ;; end boot-02.scm
@@ -116,8 +111,6 @@
 (define (primitive-eval e) (core:eval e (current-module)))
 (define eval core:eval)
 
-(define (current-output-port) 1)
-(define (current-error-port) 2)
 (define (port-filename port) "<stdin>")
 (define (port-line port) 0)
 (define (port-column port) 0)
@@ -190,9 +183,9 @@
                      "@VERSION@"))
 (define (effective-version) %version)
 
-(if (list 'and (list getenv "MES_DEBUG")
-          (list not (list equal2? (list getenv "MES_DEBUG") "0"))
-          (list not (list equal2? (list getenv "MES_DEBUG") "1")))
+(if (and (getenv "MES_DEBUG")
+          (not (equal2? (getenv "MES_DEBUG") "0"))
+          (not (equal2? (getenv "MES_DEBUG") "1")))
     (begin
       (core:display-error ";;; %moduledir=")
       (core:display-error %moduledir)
@@ -292,6 +285,10 @@ Ignored for Guile compatibility:
   --fresh-auto-compile
   --no-auto-compile
   -C,--compiled-path=DIR
+
+Report bugs to: bug-mes@gnu.org
+GNU Mes home page: <http://gnu.org/software/mes/>
+General help using GNU software: <http://gnu.org/gethelp/>
 " (or (and usage? (current-error-port)) (current-output-port)))
           (exit (or (and usage? 2) 0)))
      options)

mes/module/mes/boot-00.scm

@@ -20,7 +20,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (assq x (current-module)))
+  (module-variable (current-module) x))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))

mes/module/mes/boot-01.scm

@@ -20,7 +20,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (assq x (current-module)))
+  (module-variable (current-module) x))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))
@@ -32,7 +32,6 @@
 ;; end boot-00.scm
 
 ;; boot-01.scm
-(define (pair? x) (eq? (core:type x) <cell:pair>))
 (define (not x) (if x #f #t))
 
 (define (display x . rest)

mes/module/mes/boot-02.scm

@@ -30,7 +30,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (assq x (current-module)))
+  (module-variable (current-module) x))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))
@@ -42,7 +42,6 @@
 ;; end boot-00.scm
 
 ;; boot-01.scm
-(define (pair? x) (eq? (core:type x) <cell:pair>))
 (define (not x) (if x #f #t))
 
 (define (display x . rest)
@@ -104,10 +103,6 @@
                             (cons (quote or) (cdr x))))
                 (car x)))))
 
-(define-macro (module-define! module name value)
-  ;;(list 'define name value)
-  #t)
-
 (define-macro (mes-use-module module)
   #t)
 

mes/module/mes/catch.mes

@@ -31,6 +31,8 @@
                      (core:display-error ":")
                      (core:write-error args)
                      (core:display-error "\n")))
+               (core:display-error "Backtrace:\n")
+               (display-backtrace (make-stack) (current-error-port))
                (exit 1))))
 
 (define (catch key thunk handler)
@@ -54,3 +56,16 @@
     (apply handler (cons key args))))
 
 (define with-throw-handler catch) ; FIXME: hack for Nyacc 0.75
+
+(define (frame-procedure frame)
+  (struct-ref frame 3))
+
+(define (display-backtrace stack port . rest)
+  (let* ((frames (map (lambda (i) (stack-ref stack i)) (iota (stack-length stack))))
+         (call-frames (filter frame-procedure frames))
+         (display-frames (drop-right call-frames 2)))
+    (for-each (lambda (f)
+                (core:display-error "  ")
+                (core:display-error f)
+                (core:display-error "\n"))
+              display-frames)))

mes/module/mes/display.mes

@@ -115,6 +115,7 @@
        ((port? x)
         (display "#<port " port)
         (display (core:cdr x) port)
+        (display " ")
         (display (core:car x) port)
         (display ">" port))
        ((variable? x)
@@ -142,6 +143,13 @@
         (if (keyword? x) (display "#:" port))
         (for-each (display-cut2 display-char <> port write?) (string->list x))
         (if (and (string? x) write?) (write-char #\" port)))
+       ((struct? x)
+        (display "#<" port)
+        (for-each (lambda (i)
+                    (let ((x (strut-ref x i)))
+                      (d x #f (if (= i 0) "" " "))))
+                  (iota (struct-length x)))
+        (display ")" port))
        ((vector? x)
         (display "#(" port)
         (for-each (lambda (i)
@@ -214,7 +222,7 @@
                     ((#\s) (write (car args) port))
                     (else (display (car args) port)))
                   (simple-format (cddr lst) (cdr args)))))))
-    
+
     (if destination (simple-format lst rest)
         (with-output-to-string
           (lambda () (simple-format lst rest))))))

mes/module/mes/fluids.mes

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -24,39 +24,19 @@
 
 (mes-use-module (mes scm))
 
-
-(define (sexp:define e a)
-  (if (atom? (car (cdr e))) (cons (car (cdr e))
-                                  (core:eval (car (cdr (cdr e))) a))
-      (cons (car (car (cdr e)))
-            (core:eval (cons (quote lambda)
-                             (cons (cdr (car (cdr e))) (cdr (cdr e)))) a))))
-
-(define (f:env:define a+ a)
-  (set-cdr! a+ (cdr a))
-  (set-cdr! a a+)
-  ;;(set-cdr! (assq '*closure* a) a+)
-  )
-
-(define (env:escape-closure a n)
-  (if (eq? (caar a) '*closure*) (if (= 0 n) a
-                                    (env:escape-closure (cdr a) (- n 1)))
-      (env:escape-closure (cdr a) n)))
-
-(define-macro (module-define! name value a)
-  `(f:env:define (cons (sexp:define (cons 'define (cons ',name (cons ,value '()))) ,a) '()) (env:escape-closure ,a 1)))
-
 (define-macro (make-fluid . default)
-  `(begin
-     ,(let ((fluid (symbol-append 'fluid: (gensym)))
-            (module (current-module)))
-        `(begin
-           (module-define! ,fluid
-                           (let ((v ,(and (pair? default) (car default))))
-                             (lambda ( . rest)
-                               (if (null? rest) v
-                                   (set! v (car rest))))) ',module)
-           ',fluid))))
+  ((lambda (fluid)
+     `(begin
+        (module-define!
+         (boot-module)
+        ',fluid
+        ((lambda (v)
+           (lambda ( . rest)
+             (if (null? rest) v
+                 (set! v (car rest)))))
+         ,(and (pair? default) (car default))))
+        ',fluid))
+   (symbol-append 'fluid: (gensym))))
 
 (define (fluid-ref fluid)
   (fluid))
@@ -92,7 +72,7 @@
     `(let ,(map (lambda (b s) `(,s (,b))) (map car bindings) syms)
        ,@(map (lambda (o) `(fluid-set! ,(car o) ,(cadr o))) bindings)
        (let ((r (begin ,@bodies)))
-         `,@(map (lambda (b s) `(fluid-set! ,b ,s)) (map car bindings) syms)
+         ,@(map (lambda (b s) `(fluid-set! ,b ,s)) (map car bindings) syms)
          r))))
 
 (define (dynamic-wind in-guard thunk out-guard)

mes/module/mes/guile.mes

@@ -31,20 +31,20 @@
 (mes-use-module (srfi srfi-16))
 (mes-use-module (mes display))
 
-(if #t ;;(not (defined? 'read-string))
-    (define (read-string)
-      (define (read-string c)
-        (if (eq? c #\*eof*) '()
-            (cons c (read-string (read-char)))))
-      (let ((string (list->string (read-string (read-char)))))
-        (if (and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 3)) string->number))
-            (core:display-error (string-append "drained: `" string "'\n")))
-        string)))
-
 (define (drain-input port) (read-string))
 
-(define (make-string n . fill)
-  (list->string (apply make-list n fill)))
+(define (read-line . rest)
+  (let* ((port (if (pair? rest) (car rest) (current-input-port)))
+         (handle-delim (if (and (pair? rest) (pair? (cdr rest))) (cadr rest) 'trim))
+         (c (read-char port)))
+    (if (eof-object? c) c
+        (list->string
+         (let loop ((c c))
+           (if (or (eof-object? c) (eq? c #\newline)) (case handle-delim
+                                                        ((trim) '())
+                                                        ((concat) '(#\newline))
+                                                        (else (error (format #f "not supported: handle-delim=~a" handle-delim))))
+               (cons c (loop (read-char port)))))))))
 
 (define (object->string x . rest)
   (with-output-to-string
@@ -79,6 +79,16 @@
           (set-current-output-port save)
           r))))
 
+(define (with-error-to-file file thunk)
+  (let ((port (open-output-file file)))
+    (if (= port -1)
+        (error 'cannot-open file)
+        (let* ((save (current-error-port))
+               (foo (set-current-error-port port))
+               (r (thunk)))
+          (set-current-error-port save)
+          r))))
+
 (define (with-output-to-port port thunk)
   (let* ((save (current-output-port))
          (foo (set-current-output-port port))
@@ -99,9 +109,13 @@
     port))
 
 (define (dirname file-name)
-  (let ((lst (filter (negate string-null?) (string-split file-name #\/))))
-    (if (<= (length lst) 1) "."
-        (string-join (list-head lst (1- (length lst))) "/"))))
+  (let* ((lst (string-split file-name #\/))
+         (lst (filter (negate string-null?) lst)))
+    (if (null? lst) (if (string-prefix? "/" file-name) "/" ".")
+        (let ((dir (string-join (list-head lst (1- (length lst))) "/")))
+          (if (string-prefix? "/" file-name) (string-append "/" dir)
+              (if (string-null? dir) "."
+                  dir))))))
 
 ;; FIXME: c&p from display
 (define (with-output-to-string thunk)
@@ -137,4 +151,8 @@
     (if destination (simple-format lst rest)
         (with-output-to-string
           (lambda () (simple-format lst rest))))))
+
 (define format simple-format)
+
+(define (file-exists? o)
+  (access? o R_OK))

mes/module/mes/posix.mes

@@ -49,7 +49,16 @@
 
 (define (system* file-name . args)
   (let ((pid (primitive-fork)))
-    (cond ((zero? pid) (apply execlp file-name (list args)))
+    (cond ((zero? pid)
+           (let ((out (current-output-port))
+                 (err (current-error-port)))
+             (when (and (> out 0)
+                        (not (= out 1)))
+               (dup2 out 1))
+             (when (and (> err 0)
+                        (not (= err 2)))
+               (dup2 err 2))
+             (exit (apply execlp file-name (list args)))))
           ((= -1 pid) (error "fork failed:" file-name))
           (else (let ((pid+status (waitpid 0)))
                   (cdr pid+status))))))
@@ -57,3 +66,6 @@
 (define (waitpid pid . options)
   (let ((options (if (null? options) 0 (car options))))
     (core:waitpid pid options)))
+
+(define (status:exit-val status)
+  (ash status -8))

mes/module/mes/scm.mes

@@ -108,11 +108,6 @@
 (define assv assq)
 (define assv-ref assq-ref)
 
-(define (assoc key alist)
-  (if (not (pair? alist)) #f
-      (if (equal? key (caar alist)) (car alist)
-          (assoc key (cdr alist)))))
-
 (define (assoc-ref alist key)
   (let ((entry (assoc key alist)))
     (if entry (cdr entry)
@@ -373,6 +368,12 @@
   (lambda args
     (not (apply proc args))))
 
+(define ceil identity)
+(define floor identity)
+(define round identity)
+(define inexact->exact identity)
+(define exact->inexact identity)
+
 (define (const . rest)
   (lambda (. _)
     (car rest)))

mes/module/mes/type-0.mes

@@ -37,6 +37,7 @@
         (cons <cell:ref> (quote <cell:ref>))
         (cons <cell:special> (quote <cell:special>))
         (cons <cell:string> (quote <cell:string>))
+        (cons <cell:struct> (quote <cell:struct>))
         (cons <cell:symbol> (quote <cell:symbol>))
         (cons <cell:values> (quote <cell:values>))
         (cons <cell:variable> (quote <cell:variable>))
@@ -74,9 +75,6 @@
 (define (number? x)
   (eq? (core:type x) <cell:number>))
 
-(define (pair? x)
-  (eq? (core:type x) <cell:pair>))
-
 (define (port? x)
   (eq? (core:type x) <cell:port>))
 
@@ -86,6 +84,9 @@
 (define (string? x)
   (eq? (core:type x) <cell:string>))
 
+(define (struct? x)
+  (eq? (core:type x) <cell:struct>))
+
 (define (symbol? x)
   (eq? (core:type x) <cell:symbol>))
 
@@ -119,14 +120,11 @@
 
 (define (string->symbol s)
   (if (not (pair? (core:car s))) '()
-      (core:lookup-symbol (core:car s))))
+      (list->symbol (core:car s))))
 
 (define (symbol->keyword s)
   (core:make-cell <cell:keyword> (symbol->list s) 0))
 
-(define (list->symbol lst)
-  (core:lookup-symbol lst))
-
 (define (symbol->list s)
   (core:car s))
 

mes/module/srfi/srfi-13.mes

@@ -182,3 +182,21 @@
       (string->list (string-take string (or start1 0)))
       (string->list replace)
       (string->list (string-drop string (or end1 (string-length string))))))))
+
+(define (string-downcase string)
+  (string-map char-downcase string))
+
+(define (string-upcase string)
+  (string-map char-upcase string))
+
+(define (string-tokenize string char-set)
+  (let loop ((lst (string->list string)) (result '()))
+    (if (null? lst) (reverse result)
+        (let match ((lst lst) (found '()))
+          (if (null? lst) (loop lst (if (null? found) (reverse result)
+                                        (cons (list->string (reverse found)) result)))
+              (let ((c (car lst)))
+                (if (not (char-set-contains? char-set c)) (loop (cdr lst)
+                                                                (if (null? found) result
+                                                                    (cons (list->string (reverse found)) result)))
+                    (match (cdr lst) (cons c found)))))))))

mes/module/srfi/srfi-14.mes

@@ -36,6 +36,20 @@
        (equal? a b)))
 
 (define char-set:whitespace (char-set #\tab #\page #\return #\vtab #\newline #\space))
+(define char-set:digit (apply char-set
+                                   (map integer->char
+                                        (map (lambda (i)
+                                               (+ i (char->integer #\0))) (iota 10)))))
+
+(define char-set:lower-case (apply char-set
+                                   (map integer->char
+                                        (map (lambda (i)
+                                               (+ i (char->integer #\a))) (iota 26)))))
+
+(define char-set:upper-case (apply char-set
+                                   (map integer->char
+                                        (map (lambda (i)
+                                               (+ i (char->integer #\A))) (iota 26)))))
 
 (define (list->char-set lst)
   (apply char-set lst))
@@ -47,11 +61,30 @@
   (set-cdr! (last-pair base) (string->list x))
   base)
 
+(define (char-set-adjoin cs . chars)
+  (append cs chars))
+
 (define (char-set-contains? cs x)
   (and (memq x cs) #t))
 
+(define (char-set-complement cs)
+  (let ((ascii (map integer->char (iota 128))))
+    (list->char-set (filter (lambda (c) (not (char-set-contains? cs c))) ascii))))
+
 (define (char-whitespace? c)
   (char-set-contains? char-set:whitespace c))
 
 (define (char-set-copy cs)
   (map identity cs))
+
+(define (char-upcase c)
+  (if (char-set-contains? char-set:lower-case c) (integer->char (- (char->integer c)
+                                                                   (- (char->integer #\a)
+                                                                      (char->integer #\A))))
+      c))
+
+(define (char-downcase c)
+  (if (char-set-contains? char-set:upper-case c) (integer->char (+ (char->integer c)
+                                                                   (- (char->integer #\a)
+                                                                      (char->integer #\A))))
+      c))

mes/module/srfi/srfi-9-struct.mes

@@ -0,0 +1,145 @@
+;;; -*-scheme-*-
+
+;;; GNU Mes --- Maxwell Equations of Software
+;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Mes.
+;;;
+;;; GNU 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.
+;;;
+;;; GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; srfi-9.mes - records, based on struct.
+
+(define-macro (define-record-type name constructor+params predicate . fields)
+  (let ((type (make-record-type name (map car fields))))
+   `(begin
+      (define ,name ,type)
+      (define ,(car constructor+params) ,(record-constructor type name (cdr constructor+params)))
+      (define ,predicate ,(record-predicate type))
+      (define-record-accessors ,type ,@fields))))
+
+(define (make-record-type type fields . printer)
+  (let ((printer (if (pair? printer) (car printer))))
+    (make-struct '<record-type> (cons type (list fields)) printer)))
+
+(define (record-type? o)
+  (eq? (struct-vtable o) '<record-type>))
+
+(define (struct-vtable o)
+  (struct-ref o 0))
+
+(define (record-type o)
+  (struct-ref o 2))
+
+(define (record-predicate type)
+  (lambda (o)
+    (and (record? o)
+         (eq? (record-type o) (record-type type)))))
+
+(define (record? o)
+  (and (struct? o)
+       (record-type? (struct-vtable o))))
+
+(define (record-constructor type name params)
+  (let ((fields (record-fields type))
+        (record-type (record-type type)))
+    (lambda (. o)
+      (if (not (= (length o) (length params))) (error "wrong number of arguments for record-constructor")
+          (let ((rest (make-list (- (length fields) (length params)))))
+            (make-struct type (cons name (append o rest)) record-printer))))))
+
+(define record-printer *unspecified*)   ; TODO
+(define (record-printer o)
+  (display "#<")
+  (display (record-type o))
+  (let* ((vtable (struct-vtable o))
+         (fields (record-fields vtable)))
+    (for-each (lambda (field)
+                (display " ")
+                (display field)
+                (display ": ")
+                (display ((record-getter vtable field) o)))
+              fields))
+  (display ">"))
+
+(define (record-fields o)
+  (struct-ref o 3))
+
+(define-macro (define-record-accessors type . fields)
+  `(begin
+     ,@(map (lambda (field)
+              `(define-record-accessor ,type ,field))
+            fields)))
+
+(define-macro (define-record-accessor type field)
+  `(begin
+     (define ,(cadr field) ,(record-getter type (car field)))
+     (if ,(pair? (cddr field))
+         (define ,(if (pair? (cddr field)) (caddr field)) ,(record-setter type (car field))))))
+
+(define (record-getter type field)
+  (let ((i (record-field-index type field)))
+    (lambda (o . field?)
+      (if (not (eq? (record-type o) (record-type type))) (error "record getter: record expected" type o)
+          (if (pair? field?) field
+              (struct-ref o i))))))
+
+(define (record-setter type field)
+  (let ((i (record-field-index type field)))
+    (lambda (o v)
+      (if (not (eq? (record-type o) (record-type type))) (error "record setter: record expected" type o)
+          (struct-set! o i v)))))
+
+(define (record-field-index type field)
+  (+ 3 (or (lst-index (record-fields type) field)
+           (error "no such field" type field))))
+
+(define (lst-index lst o)
+  (let loop ((lst lst) (i 0))
+    (and (pair? lst)
+         (if (eq? o (car lst)) i
+             (loop (cdr lst) (1+ i))))))
+
+;; (define-record-type <employee>
+;;   (make-employee name age salary)
+;;   employee?
+;;   (name employe-name)
+;;   (age employee-age set-employee-age!)
+;;   (salary employee-salary))
+
+;; (display <employee>)
+;; (newline)
+
+;; (display make-employee)
+;; (newline)
+;; (display "employee-age ")
+;; (display employee-age)
+;; (newline)
+
+;; (display "set-employee-age! ")
+;; (display set-employee-age!)
+;; (newline)
+
+;; (define janneke (make-employee "janneke" 49 42))
+;; (display janneke)
+;; (newline)
+
+;; (display (employee-age janneke))
+;; (newline)
+
+;; (display (set-employee-age! janneke 33))
+;; (newline)
+;; (display (employee-age janneke))
+;; (newline)

mes/module/srfi/srfi-9-vector.mes

@@ -0,0 +1,116 @@
+;;; -*-scheme-*-
+
+;;; GNU Mes --- Maxwell Equations of Software
+;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Mes.
+;;;
+;;; GNU 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.
+;;;
+;;; GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; srfi-9-vector.mes - records, based on vector
+
+(define-macro (define-record-type type constructor+params predicate . fields)
+  (let ((record (make-record-type type (map car fields))))
+   `(begin
+      (define ,type ,record)
+      (define ,(car constructor+params) ,(record-constructor record (cdr constructor+params)))
+      (define ,predicate ,(record-predicate record))
+      (define-record-accessors ,record ,@fields))))
+
+(define (make-record-type type fields)
+  (list->vector (list '*record-type* type fields (length fields))))
+
+(define (record-type? o)
+  (eq? (record-type o) '*record-type*))
+
+(define (record-type o)
+  (vector-ref o 0))
+
+(define (record-predicate type)
+  (lambda (o)
+    (and (vector? o)
+         (eq? (record-type o) type))))
+
+(define (record-constructor type params)
+  (let ((fields (record-fields type)))
+    (lambda (. o)
+      (if (not (= (length o) (length params))) (error "wrong number of arguments for record-constructor")
+          (let ((rest (make-list (- (length fields) (length params)))))
+            (list->vector (cons type (append o rest))))))))
+
+(define (record-fields o)
+  (vector-ref o 2))
+
+(define-macro (define-record-accessors type . fields)
+  `(begin
+     ,@(map (lambda (field)
+              `(define-record-accessor ,type ,field))
+            fields)))
+
+(define-macro (define-record-accessor type field)
+  `(begin
+     (define ,(cadr field) ,(record-getter type (car field)))
+     (if ,(pair? (cddr field))
+         (define ,(if (pair? (cddr field)) (caddr field)) ,(record-setter type (car field))))))
+
+(define (record-getter type field)
+  (let ((i (record-field-index type field)))
+    (lambda (o . field?)
+      (if (not (eq? (record-type o) type)) (error "record getter: record expected" type o)
+          (if (pair? field?) field
+              (vector-ref o i))))))
+
+(define (record-setter type field)
+  (let ((i (record-field-index type field)))
+    (lambda (o v)
+      (if (not (eq? (record-type o) type)) (error "record setter: record expected" type o)
+          (vector-set! o i v)))))
+
+(define (record-field-index type field)
+  (1+ (or (lst-index (record-fields type) field)
+          (error "no such field" type field))))
+
+(define (lst-index lst o)
+  (let loop ((lst lst) (i 0))
+    (and (pair? lst)
+         (if (eq? o (car lst)) i
+             (loop (cdr lst) (1+ i))))))
+
+;; (define-record-type <employee> (make-employee name age salary) employee? (name employe-name) (age  employee-age set-employee-age!) (salary employee-salary))
+
+;; (display <employee>)
+;; (newline)
+;; (display make-employee)
+;; (newline)
+;; (display "employee-age ")
+;; (display employee-age)
+;; (newline)
+
+;; (display "set-employee-age! ")
+;; (display set-employee-age!)
+;; (newline)
+
+;; (define janneke (make-employee "janneke" 49 42))
+;; (display janneke)
+;; (newline)
+
+;; (display (employee-age janneke))
+;; (newline)
+
+;; (display (set-employee-age! janneke 33))
+;; (newline)
+;; (display (employee-age janneke))
+;; (newline)

mes/module/srfi/srfi-9.mes

@@ -1,138 +0,0 @@
-;;; -*-scheme-*-
-
-;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of GNU Mes.
-;;;
-;;; GNU 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.
-;;;
-;;; GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; srfi-9.mes - records.
-
-(define (lst-index lst o)
-  (let loop ((lst lst) (i 0))
-    (and (pair? lst)
-         (if (equal? o (car lst)) i
-             (loop (cdr lst) (1+ i))))))
-
-(define (make-record-type type fields)
-  (list->vector (list '*record-type* type fields (length fields))))
-
-(define (record-type o)
-  (vector-ref o 0))
-
-(define (record-type? o)
-  (eq? (record-type o) '*record-type*))
-
-(define (record-constructor type params)
-  (let ((fields (record-fields type)))
-    (lambda (. o)
-      (if (not (= (length o) (length params))) (error "wrong number of arguments for record-constructor")
-          (let ((rest (make-list (- (length fields) (length params)))))
-            (list->vector (cons type (append o rest))))))))
-
-(define (record-fields o)
-  (vector-ref o 2))
-
-(define (record-field-index type field)
-  (1+ (or (lst-index (record-fields type) field)
-          (error "no such field" type field))))
-
-(define (record-getter type field)
-  (let ((i (record-field-index type field)))
-    (lambda (o . field?)
-      (if (not (eq? (record-type o) type)) (error "record getter: record expected" type o)
-          (if (pair? field?) field
-              (vector-ref o i))))))
-
-(define (record-setter type field)
-  (let ((i (record-field-index type field)))
-    (lambda (o v)
-      (if (not (eq? (record-type o) type)) (error "record setter: record expected" type o)
-          (vector-set! o i v)))))
-
-(define (record-predicate type)
-  (lambda (o)
-    (and (vector? o)
-         (eq? (record-type o) type))))
-
-(define-macro (define-record-accessors type . fields)
-  `(begin
-     ,@(map (lambda (field)
-              `(define-record-accessor ,type ,field))
-            fields)))
-
-(define-macro (define-record-accessor type field)
-  `(begin
-     (define ,(cadr field) ,(record-getter type (car field)))
-     (if ,(pair? (cddr field))
-         (define ,(if (pair? (cddr field)) (caddr field)) ,(record-setter type (car field))))))
-
-(define-macro (define-record-type type constructor+params predicate . fields)
-  (let ((record (make-record-type type (map car fields))))
-   `(begin
-      (define ,type ,record)
-      (define ,(car constructor+params) ,(record-constructor record (cdr constructor+params)))
-      (define ,predicate ,(record-predicate record))
-      (define-record-accessors ,record ,@fields))))
-
-;; (define-record-type cpi
-;;   (make-cpi-1)
-;;   cpi?
-;;   (debug cpi-debug set-cpi-debug!)	; debug #t #f
-;;   (defines cpi-defs set-cpi-defs!)	; #defines
-;;   (incdirs cpi-incs set-cpi-incs!)	; #includes
-;;   (inc-tynd cpi-itynd set-cpi-itynd!)	; a-l of incfile => typenames
-;;   (inc-defd cpi-idefd set-cpi-idefd!)	; a-l of incfile => defines
-;;   (ptl cpi-ptl set-cpi-ptl!)		; parent typename list
-;;   (ctl cpi-ctl set-cpi-ctl!)		; current typename list
-;;   (blev cpi-blev set-cpi-blev!)		; curr brace/block level
-;;   )
-
-;; (display cpi)
-;; (newline)
-;; (display make-cpi-1)
-;; (newline)
-;; (define cpi (make-cpi-1))
-;; (set-cpi-debug! cpi #t)
-;; (set-cpi-blev! cpi #t)
-
-
-;; (define-record-type <employee> (make-employee name age salary) employee? (name employe-name) (age  employee-age set-employee-age!) (salary employee-salary))
-
-;; (display <employee>)
-;; (newline)
-;; (display make-employee)
-;; (newline)
-;; (display "employee-age ")
-;; (display employee-age)
-;; (newline)
-
-;; (display "set-employee-age! ")
-;; (display set-employee-age!)
-;; (newline)
-
-;; (define janneke (make-employee "janneke" 49 42))
-;; (display janneke)
-;; (newline)
-
-;; (display (employee-age janneke))
-;; (newline)
-
-;; (display (set-employee-age! janneke 33))
-;; (newline)
-;; (display (employee-age janneke))
-;; (newline)

mes/module/srfi/srfi-9.mes

@@ -0,0 +1 @@
+srfi-9-struct.mes

mes/module/srfi/srfi-9/gnu-struct.mes

@@ -0,0 +1,38 @@
+;;; -*-scheme-*-
+
+;;; GNU Mes --- Maxwell Equations of Software
+;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Mes.
+;;;
+;;; GNU 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.
+;;;
+;;; GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; srfi-9.mes - GNU immutable records.
+
+(define-macro (define-immutable-record-type type constructor+params predicate . fields)
+  `(define-record-type ,type ,constructor+params ,predicate ,@(map (lambda (f) (list-head f 2)) fields)))
+
+(define-macro (set-field o getters value)
+  `(let ((getter ,(car getters)))
+     (let* ((type (struct-vtable ,o))
+            (name (record-type ,o))
+            (set (getter ,o #t)))
+       (define (field->value field)
+         (if (eq? set field) ,value
+             ((record-getter type field) ,o)))
+       (let* ((fields (record-fields type))
+              (values (map field->value fields)))
+         (apply (record-constructor type name fields) values)))))

mes/module/srfi/srfi-9/gnu-vector.mes

@@ -0,0 +1,37 @@
+;;; -*-scheme-*-
+
+;;; GNU Mes --- Maxwell Equations of Software
+;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Mes.
+;;;
+;;; GNU 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.
+;;;
+;;; GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; srfi-9.mes - GNU immutable records.
+
+(define-macro (define-immutable-record-type type constructor+params predicate . fields)
+  `(define-record-type ,type ,constructor+params ,predicate ,@(map (lambda (f) (list-head f 2)) fields)))
+
+(define-macro (set-field o getters value)
+  `(let ((getter ,(car getters)))
+     (let ((type (record-type ,o))
+           (set (getter ,o #t)))
+       (define (field->value field)
+         (if (eq? set field) ,value
+             ((record-getter type field) ,o)))
+       (let* ((fields (record-fields type))
+              (values (map field->value fields)))
+         (apply (record-constructor type fields) values)))))

mes/module/srfi/srfi-9/gnu.mes

@@ -1,37 +0,0 @@
-;;; -*-scheme-*-
-
-;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of GNU Mes.
-;;;
-;;; GNU 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.
-;;;
-;;; GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; srfi-9.mes - GNU immutable records.
-
-(define-macro (define-immutable-record-type type constructor+params predicate . fields)
-  `(define-record-type ,type ,constructor+params ,predicate ,@(map (lambda (f) (list-head f 2)) fields)))
-
-(define-macro (set-field o getters value)
-  `(let ((getter ,(car getters)))
-     (let ((type (record-type ,o))
-           (set (getter ,o #t)))
-       (define (field->value field)
-         (if (eq? set field) ,value
-             ((record-getter type field) ,o)))
-       (let* ((fields (record-fields type))
-              (values (map field->value fields)))
-         (apply (record-constructor type fields) values)))))

mes/module/srfi/srfi-9/gnu.mes

@@ -0,0 +1 @@
+gnu-struct.mes

module/mes/mes-0.scm

@@ -38,6 +38,11 @@
             %arch
             %compiler
             ))
+(cond-expand
+ (guile-2)
+ (guile
+  (define %host-type (string-append (utsname:machine (uname)) "linux-gnu")))
+ (else))
 
 (define-macro (mes-use-module . rest) #t)
 (define builtin? procedure?) ; not strictly true, but ok for tests/*.test

module/mes/misc.scm

@@ -22,7 +22,9 @@
             disjoin
             guile?
             mes?
+            pk
             pke
+            warn
             stderr
             string-substitute))
 
@@ -43,6 +45,13 @@
 (define (stderr string . rest)
   (apply logf (cons* (current-error-port) string rest)))
 
+(define (pk . stuff)
+  (newline)
+  (display ";;; ")
+  (write stuff)
+  (newline)
+  (car (last-pair stuff)))
+
 (define (pke . stuff)
   (newline (current-error-port))
   (display ";;; " (current-error-port))
@@ -50,6 +59,8 @@
   (newline (current-error-port))
   (car (last-pair stuff)))
 
+(define warn pke)
+
 (define (disjoin . predicates)
   (lambda (. arguments)
     (any (lambda (o) (apply o arguments)) predicates)))

module/mes/test.scm

@@ -26,11 +26,13 @@
 ;;; Code:
 
 (define-module (mes test)
+  #:use-module (ice-9 rdelim)
   #:export (
             pass-if
             pass-if-equal
             pass-if-not
             pass-if-eq
+            pass-if-timeout
             result
             seq? ; deprecated
             sequal? ; deprecated
@@ -38,6 +40,7 @@
 
 (cond-expand
  (mes
+  (define (inexact->exact x) x)
   (define mes? #t)
   (define guile? #f)
   (define guile-2? #f)
@@ -78,9 +81,9 @@
         (display ": fail")
         (newline)
         (display "expected: ")
-        (display expect) (newline)
+        (write expect) (newline)
         (display "actual: ")
-        (display a)
+        (write a)
         (newline)
         #f)))
 
@@ -90,9 +93,9 @@
         (display ": fail")
         (newline)
         (display "expected: ")
-        (display expect) (newline)
+        (write expect) (newline)
         (display "actual: ")
-        (display a)
+        (write a)
         (newline)
         #f)))
 
@@ -100,16 +103,24 @@
   (or (eq? a expect)
       (begin
         (display ": fail") (newline)
-        (display "expected: ") (display expect) (newline)
-        (display "actual: ") (display a) (newline)
+        (display "expected: ") (write expect) (newline)
+        (display "actual: ") (write a) (newline)
+        #f)))
+
+(define (sless? a expect)
+  (or (< a expect)
+      (begin
+        (display ": fail") (newline)
+        (display "expected: ") (write expect) (newline)
+        (display "actual: ") (write a) (newline)
         #f)))
 
 (define (sequal2? actual expect)
   (or (equal? actual expect)
       (begin
         (display ": fail") (newline)
-        (display "expected: ") (display expect) (newline)
-        (display "actual: ") (display actual) (newline)
+        (display "expected: ") (write expect) (newline)
+        (display "actual: ") (write actual) (newline)
         #f)))
 
 (define-macro (pass-if name t)
@@ -132,3 +143,16 @@
    'begin
    (list display "test: ") (list display name)
    (list 'result (list not f)))) ;; FIXME
+
+(define internal-time-units-per-milli-second
+  (/ internal-time-units-per-second 1000))
+(define (test-time thunk)
+  ((lambda (start)
+     (begin
+       (thunk)
+       (inexact->exact (/ (- (get-internal-run-time) start)
+                          internal-time-units-per-milli-second))))
+   (get-internal-run-time)))
+
+(define-macro (pass-if-timeout name limit . body)
+  (list 'pass-if name (list sless? (list test-time (cons* 'lambda '_ body)) limit)))

module/mescc/M1.scm

@@ -87,7 +87,7 @@
                                      (dec->hex (quotient o #x100000000))))
       (string-append "%" (number->string (dec->hex (modulo o #x100000000)))
                      " %" (if (< o 0) "-1"
-                              (number->string (dec->hex (quoteint o #x100000000)))))))
+                              (number->string (dec->hex (quotient o #x100000000)))))))
 
 (define* (display-join o #:optional (sep ""))
   (let loop ((o o))

module/mescc/compile.scm

@@ -209,6 +209,7 @@
       ((mod ,a ,b) (ast->type a info))
       ((mul ,a ,b) (ast->type a info))
       ((not ,a) (ast->type a info))
+      ((pos ,a) (ast->type a info))
       ((neg ,a) (ast->type a info))
       ((eq ,a ,b) (ast->type a info))
       ((ge ,a ,b) (ast->type a info))
@@ -1218,6 +1219,9 @@
                 (info (append-text info (wrap-as (as info 'r-negate)))))
            (append-text info (wrap-as (as info 'test-r))))) ;; hmm, use ast->info?
 
+        ((pos ,expr)
+         (expr->register expr info))
+
         ((neg ,expr)
          (let* ((info (expr->register expr info))
                 (info (allocate-register info))
@@ -1542,6 +1546,7 @@
 (define (cstring->int o)
   (let ((o (cond ((string-suffix? "ULL" o) (string-drop-right o 3))
                  ((string-suffix? "UL" o) (string-drop-right o 2))
+                 ((string-suffix? "U" o) (string-drop-right o 1))
                  ((string-suffix? "LL" o) (string-drop-right o 2))
                  ((string-suffix? "L" o) (string-drop-right o 1))
                  (else o))))
@@ -1559,6 +1564,8 @@
   (pmatch o
     ((fixed ,a) (cstring->int a))
     ((p-expr ,expr) (expr->number info expr))
+    ((pos ,a)
+     (expr->number info a))
     ((neg ,a)
      (- (expr->number info a)))
     ((add ,a ,b)
@@ -2536,6 +2543,7 @@
 (define (fctn-defn:get-name o)
   (pmatch o
     ((_ (ftn-declr (ident ,name) _) _) name)
+    ((_ (ftn-declr (scope (ident ,name)) _) _) name)
     ((_ (ptr-declr (pointer . _) (ftn-declr (ident ,name) _)) _) name)
     (_ (error "fctn-defn:get-name not supported:" o))))
 
@@ -2609,6 +2617,7 @@
 (define (fctn-defn:get-statement o)
   (pmatch o
     ((_ (ftn-declr (ident _) _) ,statement) statement)
+    ((_ (ftn-declr (scope (ident _)) _) ,statement) statement)
     ((_ (ptr-declr (pointer . _) (ftn-declr (ident _) . _)) ,statement) statement)
     (_ (error "fctn-defn:get-statement: not supported: " o))))
 

module/mescc/i386/as.scm

@@ -540,6 +540,7 @@
 
 (define (i386:r2->r0 info)
   (let ((r0 (get-r0 info))
+        (r1 (get-r1 info))
         (allocated (.allocated info)))
     (if (> (length allocated) 2)
         (let ((r2 (cadddr allocated)))