mescc: Posixify interface.

* module/mescc/compile.mes: Move from language/c99/compiler.mes.
* module/mescc: New module..
* module/mescc/M1.scm: Move from mes/M1.mes.
* module/mescc/as.scm: Likewise.
* module/mescc/bytevectors.scm: Likewise.
* module/mescc/mescc.scm: New file.
* scripts/mescc: Update to new layout and posixy interface.
* GNUmakefile: Likewise.
* build-aux/build-cc.sh: Likewise.
* build-aux/build-guile.sh: Likewise.
* build-aux/build-mes.sh: Likewise.
* build-aux/build-mlibc.sh: Likewise.
* build-aux/cc-mes.sh: Likewise.
* build-aux/cc-mlibc.sh: Likewise.
* build-aux/cc.sh: Likewise.
* build-aux/check-mescc.sh: Likewise.
* build-aux/test.sh: Likewise.
* build.sh: Likewise.
* .gitignore: Update for posixy extensions.

.gitignore

@@ -8,12 +8,13 @@
 *.0-guile
 *.0-hex2
 *.E
-*.M1
+*.S
+*.o
+*.blood-elf
 *.gcc
 *.guile
-*.hex2
-*.hex2-o
 *.log
+*.gcc-o
 *.mes-o
 *.mes-stdout
 *.mini-M1
@@ -32,8 +33,8 @@
 
 /src/*.h
 /src/*.i
+/src/mes
 
-*.o
 /.config.make
 /.store
 /.tarball-version
@@ -59,4 +60,3 @@
 /doc/fosdem/fosdem.tex
 /doc/fosdem/fosdem.toc
 /doc/fosdem/fosdem.*vrb
-

AUTHORS

@@ -12,9 +12,6 @@ List of imported files
 Based on Guile ECMAScript
 module/language/c/lexer.mes
 
-Included verbatim from GNU Guix
-build-aux/compile-all.scm
-
 Included verbatim from gnulib
 build-aux/gitlog-to-changelog
 

GNUmakefile

@@ -38,7 +38,7 @@ install:
 
 .config.make: ./configure
 
-seed:
+seed: all-go
 	cd $(MES_SEED) && git reset --hard HEAD
 	MES=$(GUILE) GUILE=$(GUILE) SEED=1 build-aux/build-mes.sh
 	cd $(MES_SEED) && MES_PREFIX=$(PWD) ./refresh.sh

build-aux/build-cc.sh

@@ -18,7 +18,11 @@
 # You should have received a copy of the GNU General Public License
 # along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-set -ex
+set -e
+
+if [ -n "$BUILD_DEBUG" ]; then
+    set -x
+fi
 
 export CC CFLAGS CPPFLAGS
 
@@ -46,7 +50,7 @@ build-aux/mes-snarf.scm src/posix.c
 build-aux/mes-snarf.scm src/reader.c
 build-aux/mes-snarf.scm src/vector.c
 
-NOLINK=1 sh build-aux/cc.sh lib/mini-libc-gcc
+NOLINK=1 sh build-aux/cc.sh lib/libc-mini-gcc
 NOLINK=1 sh build-aux/cc.sh lib/libc-gcc
 NOLINK=1 sh build-aux/cc.sh lib/libc+tcc-gcc
 

build-aux/build-guile.sh

@@ -18,23 +18,51 @@
 # You should have received a copy of the GNU General Public License
 # along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-set -ex
+if [ -n "$BUILD_DEBUG" ]; then
+    set -x
+fi
 
 export GUILE
 GUILE=${GUILE-$(command -v guile)}
+GUILE_TOOLS=${GUILE_TOOLS-$(command -v guile-tools)}
+
+set -e
 
 SCM_FILES="
-language/c99/compiler.scm
+guile/mes/guile.scm
-language/c99/info.scm
+guile/mes/misc.scm
-mes/as-i386.scm
+guile/mes/test.scm
-mes/as.scm
+guile/mescc/M1.scm
-mes/bytevectors.scm
+guile/mescc/as.scm
-mes/elf.scm
+guile/mescc/bytevectors.scm
-mes/guile.scm
+guile/mescc/compile.scm
-mes/test.scm
+guile/mescc/i386/as.scm
-mes/M1.scm"
+guile/mescc/info.scm
+guile/mescc/mescc.scm
+guile/mescc/preprocess.scm
+"
 
 export srcdir=.
 export host=$($GUILE -c "(display %host-type)")
-cd guile
+
-$GUILE --no-auto-compile -L . -C . -s ../build-aux/compile-all.scm $SCM_FILES
+#$GUILE --no-auto-compile -L guile -C guile -s build-aux/compile-all.scm $SCM_FILES
+
+for i in $SCM_FILES; do
+    go=${i%%.scm}.go
+    if [ $i -nt $go ]; then
+        echo "  GUILEC $i"
+        $GUILE_TOOLS compile -L guile -L scripts -o $go $i
+    fi
+done
+
+SCRIPTS="
+scripts/mescc
+"
+
+for i in $SCRIPTS; do
+    go=${i%%.scm}.go
+    if [ $i -nt $go ]; then
+        echo "  GUILEC $i"
+        $GUILE_TOOLS compile -L guile -L scripts -o $go $i
+    fi
+done

build-aux/build-mes.sh

@@ -18,12 +18,19 @@
 # You should have received a copy of the GNU General Public License
 # along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
+if [ -n "$BUILD_DEBUG" ]; then
     set -x
+fi
 
 export BLOOD_ELF GUILE HEX2 M1 MES MESCC
 export M1FLAGS HEX2FLAGS PREPROCESS
 export MES_SEED MES_ARENA
 
+GUILE=${GUILE-guile}
+if [ -z "$GUILE" -o "$GUILE" = "true" ] || ! command -v $GUILE > /dev/null; then
+    GUILE=src/mes
+fi
+
 HEX2=${HEX2-hex2}
 M1=${M1-M1}
 BLOOD_ELF=${BLOOD_ELF-blood-elf}
@@ -50,55 +57,58 @@ if [ -d "$MES_SEED" ]; then
         $M1FLAGS\
         -f stage0/x86.M1\
         -f $MES_SEED/crt1.M1\
-        -o lib/crt1.hex2
+        -o lib/crt1.o
     $M1\
         $M1FLAGS\
         -f stage0/x86.M1\
         -f $MES_SEED/libc-mes.M1\
-        -o lib/libc-mes.hex2
+        -o lib/libc-mes.o
     $M1\
         --LittleEndian\
         --Architecture=1\
         -f stage0/x86.M1\
         -f $MES_SEED/mes.M1\
-        -o src/mes.hex2
+        -o src/mes.o
     $BLOOD_ELF\
         -f stage0/x86.M1\
         -f $MES_SEED/mes.M1\
         -f $MES_SEED/libc-mes.M1\
-        -o src/mes.blood-elf.M1
+        -o src/mes.S.blood-elf
     $M1\
         --LittleEndian\
         --Architecture=1\
-        -f src/mes.blood-elf.M1\
+        -f src/mes.S.blood-elf\
-        -o src/mes.blood-elf.hex2
+        -o src/mes.o.blood-elf
     $HEX2\
         $HEX2FLAGS\
         -f stage0/elf32-header.hex2\
-        -f lib/crt1.hex2\
+        -f lib/crt1.o\
-        -f lib/libc-mes.hex2\
+        -f lib/libc-mes.o\
-        -f src/mes.hex2\
+        -f src/mes.o\
-        -f src/mes.blood-elf.hex2\
+        -f src/mes.o.blood-elf\
         --exec_enable\
         -o src/mes.seed-out
     cp src/mes.seed-out src/mes
-
     $M1\
         $M1FLAGS\
         -f stage0/x86.M1\
         -f $MES_SEED/libc+tcc-mes.M1\
-        -o src/libc+tcc-mes.hex2
+        -o lib/libc+tcc-mes.o
 fi
 
 PREPROCESS=1
 NOLINK=1 sh build-aux/cc-mes.sh lib/crt1
-NOLINK=1 sh build-aux/cc-mes.sh lib/mini-libc-mes
+NOLINK=1 sh build-aux/cc-mes.sh lib/libc-mini-mes
 NOLINK=1 sh build-aux/cc-mes.sh lib/libc-mes
 NOLINK=1 sh build-aux/cc-mes.sh lib/libc+tcc-mes
 
+cp lib/crt1.mes-o lib/crt1.o
+cp lib/libc-mini-mes.mes-o lib/libc-mini-mes.o
+cp lib/libc-mes.mes-o lib/libc-mes.o
+cp lib/libc+tcc-mes.mes-o lib/libc+tcc-mes.o
+
 [ -n "$SEED" ] && exit 0
 
-GUILE=src/mes
 MES_ARENA=${MES_ARENA-30000000}
 sh build-aux/mes-snarf.scm --mes src/gc.c
 sh build-aux/mes-snarf.scm --mes src/lib.c
@@ -108,10 +118,10 @@ sh build-aux/mes-snarf.scm --mes src/posix.c
 sh build-aux/mes-snarf.scm --mes src/reader.c
 sh build-aux/mes-snarf.scm --mes src/vector.c
 
-# sh build-aux/cc-mes.sh scaffold/main
+sh build-aux/cc-mes.sh scaffold/main
-# sh build-aux/cc-mes.sh scaffold/hello
+sh build-aux/cc-mes.sh scaffold/hello
-# sh build-aux/cc-mes.sh scaffold/argv
+sh build-aux/cc-mes.sh scaffold/argv
-# sh build-aux/cc-mes.sh scaffold/malloc
+sh build-aux/cc-mes.sh scaffold/malloc
 ##sh build-aux/cc-mes.sh scaffold/micro-mes
 ##sh build-aux/cc-mes.sh scaffold/tiny-mes
 # sh build-aux/cc-mes.sh scaffold/mini-mes

build-aux/build-mlibc.sh

@@ -18,7 +18,11 @@
 # You should have received a copy of the GNU General Public License
 # along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-set -ex
+set -e
+
+if [ -n "$BUILD_DEBUG" ]; then
+    set -x
+fi
 
 export CC32 CPPFLAGS C32FLAGS
 
@@ -59,7 +63,7 @@ C32FLAGS=${C32FLAGS-"
 "}
 
 NOLINK=1 sh build-aux/cc-mlibc.sh lib/crt1
-NOLINK=1 sh build-aux/cc-mlibc.sh lib/mini-libc-gcc
+NOLINK=1 sh build-aux/cc-mlibc.sh lib/libc-mini-gcc
 NOLINK=1 sh build-aux/cc-mlibc.sh lib/libc-gcc
 NOLINK=1 sh build-aux/cc-mlibc.sh lib/libc+tcc-gcc
 

build-aux/cc-mes.sh

@@ -18,16 +18,16 @@
 # You should have received a copy of the GNU General Public License
 # along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
+if [ -n "$BUILD_DEBUG" ]; then
     set -x
+fi
 
 export BLOOD_ELF GUILE HEX2 M1 MES MESCC
 export M1FLAGS HEX2FLAGS PREPROCESS
-export MES_SEED MES_ARENA
 
 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)}
@@ -41,67 +41,32 @@ CPPFLAGS=${CPPFLAGS-"
 -I lib
 -I include
 "}
+MESCCFLAGS=${MESCCFLAGS-"
+"}
 
-MESCCLAGS=${MESCCFLAGS-"
+if [ -n "$BUILD_DEBUG" ]; then
-"}
+    MESCCFLAGS="$MESCCFLAGS -v"
-LIBC=${LIBC-lib/libc}
+fi
-M1FLAGS=${M1FLAGS-"
---LittleEndian
---Architecture=1
-"}
-HEX2FLAGS=${HEX2FLAGS-"
---LittleEndian
---Architecture=1
---BaseAddress=0x1000000
-"}
 
 c=$1
 
 set -e
 
 if [ -n "$PREPROCESS" ]; then
-    sh -x $MESCC\
+    sh $MESCC $MESCCFLAGS $CPPFLAGS -E "$c".c
-       -E\
+    sh $MESCC $MESCCFLAGS -S "$c".E
-       $CPPFLAGS\
+    sh $MESCC $MESCCFLAGS -c -o "$c".mes-o "$c".S
-       $MESCCFLAGS\
-       -o "$c".E\
-       "$c".c
-    sh -x $MESCC\
-       -c\
-       -o "$c".M1\
-       "$c".E
-else
-    sh -x $MESCC\
-       -c\
-       $CPPFLAGS\
-       $MESCCFLAGS\
-       -o "$c".M1\
-       "$c".c
-fi
-
-$M1\
-    $M1FLAGS\
-    -f stage0/x86.M1\
-    -f "$c".M1\
-    -o "$c".hex2
-
     if [ -z "$NOLINK" ]; then
-    $BLOOD_ELF\
+        sh $MESCC $MESCCFLAGS -o "$c".mes-out "$c".mes-o $MESCCLIBS
-        -f stage0/x86.M1\
+    fi
-        -f "$c".M1\
+elif [ -n "$COMPILE" ]; then
-        -f $LIBC-mes.M1\
+    sh $MESCC $MESCCFLAGS $CPPFLAGS -S "$c".c
-        -o "$c".blood-elf-M1
+    sh $MESCC $MESCCFLAGS -c -o "$c".mes-o "$c".S
-    $M1\
+    if [ -z "$NOLINK" ]; then
-        $M1FLAGS\
+        sh $MESCC $MESCCFLAGS -o "$c".mes-out "$c".mes-o $MESCCLIBS
-        -f "$c".blood-elf-M1\
+    fi
-        -o "$c".blood-elf-hex2
+elif [ -z "$NOLINK" ]; then
-    $HEX2\
+    sh $MESCC $MESCCFLAGS $CPPFLAGS -o "$c".mes-out "$c".c $MESCCLIBS
-        $HEX2FLAGS\
+else
-        -f stage0/elf32-header.hex2\
+    sh $MESCC $MESCCFLAGS $CPPFLAGS -c -o "$c".mes-out "$c".c
-        -f lib/crt1.hex2\
-        -f $LIBC-mes.hex2\
-        -f "$c".hex2\
-        -f "$c".blood-elf-hex2\
-        --exec_enable\
-        -o "$c".mes-out
 fi

build-aux/cc-mlibc.sh

@@ -18,7 +18,11 @@
 # You should have received a copy of the GNU General Public License
 # along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-set -ex
+set -e
+
+if [ -n "$BUILD_DEBUG" ]; then
+    set -x
+fi
 
 CPPFLAGS=${CPPFLAGS-"
 -D VERSION=\"$VERSION\"
@@ -56,5 +60,6 @@ if [ -z "$NOLINK" ]; then
         -o "$c".mlibc-out\
         lib/crt1.mlibc-o\
         "$c".mlibc-o\
-        $LIBC-gcc.mlibc-o
+        $LIBC-gcc.mlibc-o\
+        $CC32LIBS
 fi

build-aux/cc.sh

@@ -18,7 +18,11 @@
 # You should have received a copy of the GNU General Public License
 # along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-set -ex
+set -e
+
+if [ -n "$BUILD_DEBUG" ]; then
+    set -x
+fi
 
 CPPFLAGS=${CPPFLAGS-"
 -D VERSION=\"$VERSION\"

build-aux/check-boot.sh

@@ -18,12 +18,17 @@
 # You should have received a copy of the GNU General Public License
 # along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-set -e
 
 export GUILE MES
-GUILE=${GUILE-guile}
 MES=${MES-./src/mes}
 
+GUILE=${GUILE-guile}
+if ! command -v $GUILE > /dev/null; then
+    GUILE=true
+fi
+
+set -e
+
 tests="
 
 00-zero.scm

build-aux/check-mescc.sh

@@ -18,9 +18,15 @@
 # You should have received a copy of the GNU General Public License
 # along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
+if [ -n "$BUILD_DEBUG" ]; then
+    set -x
+fi
+
 export BLOOD_ELF GUILE HEX2 M1 MES MESCC
-export M1FLAGS HEX2FLAGS PREPROCESS LIBC
+export M1FLAGS HEX2FLAGS PREPROCESS
 export MES_ARENA MES_PREFIX MES_SEED
+export BUILD_DEBUG
+export CC32LIBS MESCCLIBS
 
 MES=${MES-src/mes}
 MESCC=${MESCC-scripts/mescc}
@@ -36,6 +42,9 @@ MESCC=${MESCC-$(command -v mescc)}
 MES=${MES-$(command -v mes)}
 [ -z "$MES" ] && MES=src/mes
 
+if ! command -v $GUILE > /dev/null; then
+    GUILE=true
+fi
 
 tests="
 t
@@ -135,14 +144,18 @@ expect=$(echo $broken | wc -w)
 pass=0
 fail=0
 total=0
+MESCCLIBS=
 LIBC=libc/libc
 for t in $tests; do
     if [ -z "${t/[012][0-9]-*/}" ]; then
-        LIBC=lib/mini-libc;
+        LIBC="lib/libc-mini"
+        MESCCLIBS="-l c-mini"
     elif [ -z "${t/8[0-9]-*/}" ]; then
-        LIBC=lib/libc+tcc;
+        LIBC="lib/libc+tcc"
+        MESCCLIBS="-l c+tcc"
     else
-        LIBC=lib/libc;
+        LIBC=libc/libc
+        MESCCLIBS=
     fi
     sh build-aux/test.sh "scaffold/tests/$t" &> scaffold/tests/"$t".log
     r=$?

build-aux/compile-all.scm

@@ -1,159 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix 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 Guix 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 Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(use-modules (system base target)
-             (system base message)
-             (ice-9 match)
-             (ice-9 threads))
-
-(define (mkdir-p dir)
-  "Create directory DIR and all its ancestors."
-  (define absolute?
-    (string-prefix? "/" dir))
-
-  (define not-slash
-    (char-set-complement (char-set #\/)))
-
-  (let loop ((components (string-tokenize dir not-slash))
-             (root       (if absolute?
-                             ""
-                             ".")))
-    (match components
-      ((head tail ...)
-       (let ((path (string-append root "/" head)))
-         (catch 'system-error
-           (lambda ()
-             (mkdir path)
-             (loop tail path))
-           (lambda args
-             (if (= EEXIST (system-error-errno args))
-                 (loop tail path)
-                 (apply throw args))))))
-      (() #t))))
-
-(define warnings
-  '(unsupported-warning format unbound-variable arity-mismatch))
-
-(define host (getenv "host"))
-
-(define srcdir (getenv "srcdir"))
-
-(define (relative-file file)
-  (if (string-prefix? (string-append srcdir "/") file)
-      (string-drop file (+ 1 (string-length srcdir)))
-      file))
-
-(define (file-mtime<? f1 f2)
-  (< (stat:mtime (stat f1))
-     (stat:mtime (stat f2))))
-
-(define (scm->go file)
-  (let* ((relative (relative-file file))
-         (without-extension (string-drop-right relative 4)))
-    (string-append without-extension ".go")))
-
-(define (scm->mes file)
-  (let ((base (string-drop-right file 4)))
-    (string-append base ".mes")))
-
-(define (file-needs-compilation? file)
-  (let ((go (scm->go file)))
-    (or (not (file-exists? go))
-        (file-mtime<? go file)
-        (let ((mes (scm->mes file))) ; FIXME: try to respect (include-from-path ".mes")
-          (and (file-exists? mes)
-               (file-mtime<? go mes))))))
-
-(define (file->module file)
-  (let* ((relative (relative-file file))
-         (module-path (string-drop-right relative 4)))
-    (map string->symbol
-         (string-split module-path #\/))))
-
-;;; To work around <http://bugs.gnu.org/15602> (FIXME), we want to load all
-;;; files to be compiled first.  We do this via resolve-interface so that the
-;;; top-level of each file (module) is only executed once.
-(define (load-module-file file)
-  (let ((module (file->module file)))
-    (format #t "  LOAD     ~a~%" module)
-    (resolve-interface module)))
-
-(cond-expand
- (guile-2.2 (use-modules (language tree-il optimize)
-                         (language cps optimize)))
- (else #f))
-
-(define %default-optimizations
-  ;; Default optimization options (equivalent to -O2 on Guile 2.2).
-  (cond-expand
-   (guile-2.2 (append (tree-il-default-optimization-options)
-                      (cps-default-optimization-options)))
-    (else '())))
-
-(define %lightweight-optimizations
-  ;; Lightweight optimizations (like -O0, but with partial evaluation).
-  (let loop ((opts %default-optimizations)
-             (result '()))
-    (match opts
-      (() (reverse result))
-      ((#:partial-eval? _ rest ...)
-       (loop rest `(#t #:partial-eval? ,@result)))
-      ((kw _ rest ...)
-       (loop rest `(#f ,kw ,@result))))))
-
-(define (optimization-options file)
-  (if (string-contains file "gnu/packages/")
-      %lightweight-optimizations                  ;build faster
-      '()))
-
-(define (compile-file* file output-mutex)
-  (let ((go (scm->go file)))
-    (with-mutex output-mutex
-      (format #t "  GUILEC   ~a~%" go)
-      (force-output))
-    (mkdir-p (dirname go))
-    (with-fluids ((*current-warning-prefix* ""))
-      (with-target host
-        (lambda ()
-          (compile-file file
-                        #:output-file go
-                        #:opts `(#:warnings ,warnings
-                                 ,@(optimization-options file))))))))
-
-;; Install a SIGINT handler to give unwind handlers in 'compile-file' an
-;; opportunity to run upon SIGINT and to remove temporary output files.
-(sigaction SIGINT
-  (lambda args
-    (exit 1)))
-
-(match (command-line)
-  ((_ . files)
-   (let ((files (filter file-needs-compilation? files)))
-     (for-each load-module-file files)
-     (let ((mutex (make-mutex)))
-       ;; Make sure compilation related modules are loaded before starting to
-       ;; compile files in parallel.
-       (compile #f)
-       (par-for-each (lambda (file)
-                       (compile-file* file mutex))
-                     files)))))
-
-;;; Local Variables:
-;;; eval: (put 'with-target 'scheme-indent-function 1)
-;;; End:

build-aux/test.sh

@@ -18,9 +18,11 @@
 # You should have received a copy of the GNU General Public License
 # along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
+if [ -n "$BUILD_DEBUG" ]; then
     set -x
+fi
 
-export LIBC
+export LIBC MESCCLIBS
 
 GUILE=${GUILE-$MES}
 DIFF=${DIFF-$(command -v diff)}

build.sh

@@ -18,12 +18,16 @@
 # You should have received a copy of the GNU General Public License
 # along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
+if [ -n "$BUILD_DEBUG" ]; then
     set -x
+fi
+
 # dash does not export foo=${foo-bar} for some values
 export CC CC32 GUILE MESCC MES_SEED
 export MES_ARENA MES_DEBUG
 export PREFIX DATADIR MODULEDIR
 export CPPFLAGS CFLAGS C32FLAGS MESCCFLAGS
+export BUILD_DEBUG
 
 CC=${CC-$(command -v gcc)}
 CC32=${CC32-$(command -v i686-unknown-linux-gnu-gcc)}
@@ -31,7 +35,7 @@ MESCC=${MESCC-$(command -v mescc)}
 MES_SEED=${MES_SEED-../mes-seed}
 GUILE=${GUILE-$(command -v guile)}
 MES_ARENA=${MES_ARENA-300000000}
-MES_DEBUG=${MES_DEBUG-2}
+MES_DEBUG=${MES_DEBUG-1}
 
 PREFIX=${PREFIX-/usr/local}
 DATADIR=${DATADIR-$PREFIX/share/mes}

check.sh

@@ -20,10 +20,17 @@
 
 export CC32
 export GUILE MES MES_ARENA
+export BUILD_DEBUG
+
 CC32=${CC32-$(command -v i686-unknown-linux-gnu-gcc)}
 GUILE=${GUILE-guile}
 MES=${MES-src/mes}
-MES_ARENA=${MES_ARENA-100000000}
+MES_ARENA=${MES_ARENA-300000000}
+PREFIX=
+
+if ! command -v $GUILE > /dev/null; then
+    GUILE=true
+fi
 
 set -e
 bash build-aux/check-boot.sh

guile/mescc

@@ -0,0 +1 @@
+../module/mescc

lib/libc-gcc.c

@@ -29,8 +29,8 @@
 #include <fcntl.h>
 #include <assert.h>
 
-#include <mini-linux-gcc.c>
+#include <linux-mini-gcc.c>
-#include <mini-libc.c>
+#include <libc-mini.c>
 #include <linux-gcc.c>
 #include <libc.c>
 

lib/libc-mes.c

@@ -25,7 +25,7 @@
 
 void _env ();
 
-#include <mini-linux-mes.c>
+#include <linux-mini-mes.c>
-#include <mini-libc.c>
+#include <libc-mini.c>
 #include <linux-mes.c>
 #include <libc.c>

lib/libc-mini-gcc.c

@@ -18,5 +18,5 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-#include <mini-linux-gcc.c>
+#include <linux-mini-gcc.c>
-#include <mini-libc.c>
+#include <libc-mini.c>

lib/libc-mini-mes.c

@@ -18,5 +18,5 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-#include <mini-linux-mes.c>
+#include <linux-mini-mes.c>
-#include <mini-libc.c>
+#include <libc-mini.c>

module/language/c99/compiler.scm

@@ -1,61 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(define-module (language c99 compiler)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9 gnu)
-  #:use-module (srfi srfi-26)
-  #:use-module (system base pmatch)
-  #:use-module (ice-9 optargs)
-  #:use-module (ice-9 pretty-print)
-  #:use-module (nyacc lang c99 parser)
-  ;;#:use-module (nyacc lang c99 pprint)
-  #:use-module (mes guile)
-  #:use-module (mes as)
-  #:use-module (mes as-i386)
-  #:use-module (mes elf)
-  #:use-module (mes M1)
-  #:use-module (language c99 info)
-  #:export (c99-ast->info
-            c99-input->ast
-            c99-input->elf
-            c99-input->info
-            c99-input->object
-            info->object))
-
-(cond-expand
- (guile-2
-  (use-modules (nyacc lang c99 pprint)))
- (guile
-  (debug-set! stack 0)
-  (use-modules (ice-9 optargs))
-  (use-modules (ice-9 syncase)))
- ;; guile-1.8 does not have (sxml match), short-circuit me
- (define* (pretty-print-c99 tree
-                            #:optional (port (current-output-port))
-                            #:key ugly per-line-prefix (basic-offset 2))
-   (write tree port))
- (mes))
-
-(include-from-path "language/c99/compiler.mes")

module/mes/M1.scm

@@ -1,44 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(define-module (mes M1)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
-  #:use-module (system base pmatch)
-  #:use-module (mes guile)
-  #:use-module (mes as)
-  #:use-module (mes elf)
-  #:use-module (language c99 info)
-  #:export (object->M1
-            objects->M1
-            object->elf
-            objects->elf))
-
-(cond-expand
- (guile-2)
- (guile
-  (use-modules (ice-9 syncase)))
- (mes))
-
-(include-from-path "mes/M1.mes")

module/mes/as-i386.scm

@@ -1,172 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; as-i386.scm defines i386 assembly
-
-;;; Code:
-
-(define-module (mes as-i386)
-  #:use-module (mes guile)
-  #:use-module (mes as)
-  #:export (
-            i386:accu%base
-            i386:accu*base
-            i386:accu*n->label
-            i386:accu*n->local
-            i386:accu+accu
-            i386:accu+base
-            i386:accu+value
-            i386:accu->base
-            i386:accu->base-mem
-            i386:byte-accu->base-mem
-            i386:word-accu->base-mem
-            i386:accu->base-mem+n
-            i386:byte-accu->base-mem+n
-            i386:word-accu->base-mem+n
-            i386:accu->label
-            i386:accu->local
-            i386:accu->local+n
-            i386:accu->local+n
-            i386:accu-and
-            i386:accu-and-base
-            i386:accu-and-base-mem
-            i386:accu-base
-            i386:accu-cmp-value
-            i386:accu-mem-add
-            i386:accu-mem->base-mem
-            i386:accu-negate
-            i386:accu-not
-            i386:accu-or-base
-            i386:accu-or-base-mem
-            i386:accu-shl
-            i386:accu-test
-            i386:accu-xor-base
-            i386:accu-zero?
-            i386:accu/base
-            i386:accu<->stack
-            i386:accu<<base
-            i386:accu>>base
-            i386:base+value
-            i386:base->accu
-            i386:base->accu-mem
-            i386:base->label
-            i386:base-mem->accu-mem
-            i386:base-mem+n->accu
-            i386:base-mem->accu
-            i386:base-sub
-            i386:byte-accu->base-mem
-            i386:word-accu->base-mem
-            i386:byte-base->accu-mem
-            i386:byte-base->accu-mem+n
-            i386:byte-base-mem->accu
-            i386:byte-base-sub
-            i386:byte-local->base
-            i386:byte-mem->accu
-            i386:word-mem->accu
-            i386:byte-mem->base
-            i386:byte-sub-base
-            i386:byte-test-base
-            i386:call-accu
-            i386:call-label
-            i386:formal
-            i386:function-locals
-            i386:function-preamble
-            i386:jump
-            i386:jump
-            i386:jump-a
-            i386:jump-ae
-            i386:jump-b
-            i386:jump-be
-            i386:jump-byte-z
-            i386:jump-g
-            i386:jump-ge
-            i386:jump-l
-            i386:jump-le
-            i386:jump-nz
-            i386:jump-z
-            i386:label->accu
-            i386:label->base
-            i386:label-mem->accu
-            i386:label-mem->base
-            i386:label-mem-add
-            i386:local->accu
-            i386:local->base
-            i386:local-add
-            i386:local-address->accu
-            i386:local-address->accu
-            i386:local-address->base
-            i386:local-ptr->accu
-            i386:local-ptr->base
-            i386:local-test
-            i386:mem+n->accu
-            i386:byte-mem+n->accu
-            i386:word-mem+n->accu
-            i386:mem->accu
-            i386:mem->base
-            i386:nop
-            i386:nz->accu
-            i386:pop-accu
-            i386:pop-base
-            i386:push-accu
-            i386:push-base
-            i386:push-byte-local-de-de-ref
-            i386:push-byte-local-de-ref
-            i386:push-word-local-de-ref
-            i386:push-label
-            i386:push-label-mem
-            i386:push-local
-            i386:push-local-address
-            i386:push-local-de-ref
-            i386:ret
-            i386:ret-local
-            i386:sub-base
-            i386:test-base
-            i386:value->accu
-            i386:value->accu-mem
-            i386:value->accu-mem+n
-            i386:value->base
-            i386:value->label
-            i386:value->local
-            i386:xor-accu
-            i386:xor-zf
-            i386:g?->accu
-            i386:ge?->accu
-            i386:l?->accu
-            i386:le?->accu
-            i386:a?->accu
-            i386:ae?->accu
-            i386:b?->accu
-            i386:be?->accu
-            i386:z->accu
-            i386:byte-accu
-            i386:signed-byte-accu
-            i386:word-accu
-            i386:signed-word-accu
-            ))
-
-(cond-expand
- (guile-2)
- (guile
-  (use-modules (ice-9 syncase)))
- (mes))
-
-(include-from-path "mes/as-i386.mes")

module/mes/boot-0.scm

@@ -152,7 +152,9 @@
 
 (define-macro (load file)
   (list 'begin
-        (list 'if (list getenv "MES_DEBUG")
+        (list '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")))
               (list 'begin
                     (list core:display-error ";;; read ")
                     (list core:display-error file)
@@ -190,7 +192,9 @@
                      "@VERSION@"))
 (define (effective-version) %version)
 
-(if (getenv "MES_DEBUG")
+(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")))
     (begin
       (core:display-error ";;; %moduledir=")
       (core:display-error %moduledir)

module/mes/guile.mes

@@ -22,12 +22,15 @@
 
 ;;; Code:
 
+(mes-use-module (srfi srfi-13))
+
 (define-macro (cond-expand-provide . rest) #t)
 
 (define-macro (include-from-path file)
   (let loop ((path (cons %moduledir (string-split (or (getenv "GUILE_LOAD_PATH") "") #\:))))
-    (if (getenv "MES_DEBUG")
+    (cond ((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 1)) string->number))
-        ;;(format (current-error-port) "include-from-path: ~s [PATH:~s]\n" file path)
+           (core:display-error (string-append "include-from-path: " file "\n")))
+          ((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 1)) string->number)))
           (core:display-error (string-append "include-from-path: " file " [PATH:" (string-join path ":") "]\n")))
     (if (null? path) (error "include-from-path: not found: " file)
         (let ((file (string-append (car path) "/" file)))
@@ -37,7 +40,6 @@
 (mes-use-module (mes catch))
 (mes-use-module (mes posix))
 (mes-use-module (srfi srfi-16))
-(mes-use-module (srfi srfi-26))
 (mes-use-module (mes display))
 
 (if #t ;;(not (defined? 'read-string))
@@ -46,7 +48,7 @@
         (if (eq? c #\*eof*) '()
             (cons c (read-string (read-char)))))
       (let ((string (list->string (read-string (read-char)))))
-        (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 3) string->number))
+        (if (and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 3)) string->number))
             (core:display-error (string-append "drained: `" string "'\n")))
         string)))
 
@@ -147,4 +149,3 @@
         (with-output-to-string
           (lambda () (simple-format lst rest))))))
 (define format simple-format)
-

module/mes/mescc.mes

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -22,14 +22,4 @@
 
 ;;; Code:
 
-(define-module (mes elf)
+(include-from-path "mes/mescc.scm")
-  #:use-module (mes guile)
-  #:export (M1->elf))
-
-(cond-expand
- (guile-2)
- (guile
-  (use-modules (ice-9 syncase)))
- (mes))
-
-(include-from-path "mes/elf.mes")

module/mes/misc.mes

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -18,23 +18,4 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-;;; Commentary:
+(include-from-path "mes/misc.scm")
-
-;;; Code:
-
-(define-module (mes as)
-  #:use-module (srfi srfi-1)
-  #:use-module (mes guile)
-  #:use-module (mes bytevectors)
-  #:export (dec->hex
-            int->bv8
-            int->bv16
-            int->bv32))
-
-(cond-expand
- (guile-2)
- (guile
-  (use-modules (ice-9 syncase)))
- (mes))
-
-(include-from-path "mes/as.mes")

module/mes/misc.scm

@@ -0,0 +1,65 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (mes misc)
+  #:use-module (srfi srfi-1)
+  #:export (%scheme
+            disjoin
+            guile?
+            mes?
+            pke
+            stderr
+            string-substitute))
+
+(cond-expand
+ (mes
+  (define %scheme "mes"))
+ (guile
+  (define %scheme "guile")))
+
+(define guile? (equal? %scheme "guile"))
+(define mes? (equal? %scheme "mes"))
+
+(define (logf port string . rest)
+  (apply format (cons* port string rest))
+  (force-output port)
+  #t)
+
+(define (stderr string . rest)
+  (apply logf (cons* (current-error-port) string rest)))
+
+(define (pke . stuff)
+  (newline (current-error-port))
+  (display ";;; " (current-error-port))
+  (write stuff (current-error-port))
+  (newline (current-error-port))
+  (car (last-pair stuff)))
+
+(define (disjoin . predicates)
+  (lambda (. arguments)
+    (any (lambda (o) (apply o arguments)) predicates)))
+
+(define (string-substitute string find replace)
+  (let ((index (string-contains string find)))
+    (if (not index) string
+        (string-append
+         (string-take string index)
+         replace
+         (string-substitute
+          (string-drop string (+ index (string-length find)))
+          find replace)))))

module/mes/posix.mes

@@ -22,6 +22,8 @@
 
 ;;; Code:
 
+(mes-use-module (srfi srfi-13))
+
 (define R_OK 0)
 (define S_IRWXU #o700)
 

module/mescc/M1.mes

@@ -0,0 +1,28 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(mes-use-module (srfi srfi-1))
+(mes-use-module (srfi srfi-26))
+(mes-use-module (mes misc))
+(mes-use-module (mes optargs))
+(mes-use-module (mes pmatch))
+(mes-use-module (mescc as))
+(mes-use-module (mescc info))
+(include-from-path "mescc/M1.scm")

module/mescc/M1.scm

@@ -1,7 +1,5 @@
-;;; -*-scheme-*-
-
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -20,51 +18,31 @@
 
 ;;; Commentary:
 
-;;; M1.mes produces stage0' M1 object format
+;;; M1.scm produces stage0' M1 assembly format
 
 ;;; Code:
 
-(cond-expand
+(define-module (mescc M1)
- (guile)
+  #:use-module (srfi srfi-1)
- (mes
+  #:use-module (srfi srfi-26)
-  (mes-use-module (srfi srfi-1))
+  #:use-module (system base pmatch)
-  (mes-use-module (srfi srfi-26))
+  #:use-module (mes misc)
-  (mes-use-module (mes as))
+  #:use-module (mes guile)
-  (mes-use-module (mes elf))
-  (mes-use-module (mes optargs))
-  (mes-use-module (mes pmatch))
-  (mes-use-module (language c99 info))))
 
-(define (logf port string . rest)
+  #:use-module (mescc as)
-  (apply format (cons* port string rest))
+  #:use-module (mescc info)
-  (force-output port)
+  #:export (info->M1
-  #t)
+            infos->M1
+            M1:merge-infos))
 
-(define (stderr string . rest)
+(define (infos->M1 file-name infos)
-  (apply logf (cons* (current-error-port) string rest)))
+  (let ((info (fold M1:merge-infos (make <info>) infos)))
+    (info->M1 file-name info)))
 
-(define (pke . stuff)
+(define (M1:merge-infos o info)
-  (newline (current-error-port))
+  (clone info
-  (display ";;; " (current-error-port))
+         #:functions (alist-add (.functions info) (.functions o))
-  (write stuff (current-error-port))
+         #:globals (alist-add (.globals info) (.globals o))))
-  (newline (current-error-port))
-  (car (last-pair stuff)))
-
-(define (objects->M1 file-name objects)
-  ((compose (cut object->M1 file-name <>) merge-objects) objects))
-
-(define (object->elf file-name o)
-  ((compose M1->elf (cut object->M1 file-name <>)) o))
-
-(define (objects->elf file-name objects)
-  ((compose M1->elf (cut object->M1 file-name <>) merge-objects) objects))
-
-(define (merge-objects objects)
-  (let loop ((objects (cdr objects)) (object (car objects)))
-    (if (null? objects) object
-        (loop (cdr objects)
-              `((functions . ,(alist-add (assoc-ref object 'functions) (assoc-ref (car objects) 'functions)))
-                (globals . ,(alist-add (assoc-ref object 'globals) (assoc-ref (car objects) 'globals))))))))
 
 (define (alist-add a b)
   (let* ((b-keys (map car b))
@@ -99,11 +77,10 @@
           (display sep))
       (loop (cdr o)))))
 
-(define (object->M1 file-name o)
+(define (info->M1 file-name o)
-  (stderr "dumping M1: object\n")
+  (let* ((functions (.functions o))
-  (let* ((functions (assoc-ref o 'functions))
          (function-names (map car functions))
-         (globals (assoc-ref o 'globals))
+         (globals (.globals o))
          (global-names (map car globals))
          (strings (filter (lambda (g) (and (pair? g) (eq? (car g) #:string))) global-names)))
     (define (string->label o)

module/mescc/as.mes

@@ -1,4 +1,4 @@
-<;;; -*-scheme-*-
+;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
 ;;; Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
@@ -18,15 +18,6 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-;;; Commentary:
+(mes-use-module (srfi srfi-1))
-
+(mes-use-module (mescc bytevectors))
-;;; elf.mes - produce a i386 elf executable.
+(include-from-path "mescc/as.scm")
-
-;;; Code:
-
-(cond-expand
- (guile)
- (mes))
-
-(define (M1->elf objects)
-  (error "->ELF support dropped, use M1"))

module/mescc/as.scm

@@ -1,7 +1,5 @@
-;;; -*-scheme-*-
-
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -18,19 +16,14 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-;;; Commentary:
+(define-module (mescc as)
-
+  #:use-module (srfi srfi-1)
-;;; compiler.mes produces an i386 binary from the C produced by
+  #:use-module (mes guile)
-;;; Nyacc c99.
+  #:use-module (mescc bytevectors)
-
+  #:export (dec->hex
-;;; Code:
+            int->bv8
-
+            int->bv16
-(cond-expand
+            int->bv32))
- (guile)
- (guile-2)
- (mes
-  (mes-use-module (srfi srfi-1))
-  (mes-use-module (mes bytevectors))))
 
 (define (int->bv32 value)
   (let ((bv (make-bytevector 4)))

module/mescc/bytevectors.mes

@@ -0,0 +1,21 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(include-from-path "mescc/bytevectors.scm")

module/mescc/bytevectors.scm

@@ -1,5 +1,3 @@
-;;; -*-scheme-*-
-
 ;;; Mes --- Maxwell Equations of Software
 ;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
@@ -20,10 +18,15 @@
 
 ;;; Commentary:
 
-;;; bytevectors.mes 
-
 ;;; Code:
 
+(define-module (mescc bytevectors)
+  #:use-module (mes guile)
+  #:export (bytevector-u32-native-set!
+            bytevector-u16-native-set!
+            bytevector-u8-set!
+            make-bytevector))
+
 ;; rnrs compatibility
 (define (bytevector-u32-native-set! bv index value)
   (when (not (= 0 index)) (error "bytevector-u32-native-set! index not zero: " index " value: " value))

module/mescc/compile.mes

@@ -0,0 +1,33 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(mes-use-module (srfi srfi-1))
+(mes-use-module (srfi srfi-13))
+(mes-use-module (srfi srfi-26))
+(mes-use-module (mes pmatch))
+(mes-use-module (mes optargs))
+(mes-use-module (mes misc))
+(mes-use-module (nyacc lang c99 pprint))
+
+(mes-use-module (mescc as))
+(mes-use-module (mescc i386 as))
+(mes-use-module (mescc info))
+(mes-use-module (mescc M1))
+(include-from-path "mescc/compile.scm")

module/mescc/compile.scm

@@ -1,5 +1,3 @@
-;;; -*-scheme-*-
-
 ;;; Mes --- Maxwell Equations of Software
 ;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
@@ -20,119 +18,48 @@
 
 ;;; Commentary:
 
-;;; compiler.mes produces an i386 binary from the C produced by
-;;; Nyacc c99.
-
 ;;; Code:
 
-(cond-expand
+(define-module (mescc compile)
- (guile-2)
+  #:use-module (srfi srfi-1)
- (guile)
+  #:use-module (srfi srfi-9 gnu)
- (mes
+  #:use-module (srfi srfi-26)
-  (mes-use-module (srfi srfi-1))
+  #:use-module (system base pmatch)
-  (mes-use-module (srfi srfi-26))
+  #:use-module (ice-9 optargs)
-  (mes-use-module (mes pmatch))
+  #:use-module (ice-9 pretty-print)
-  (mes-use-module (nyacc lang c99 parser))
+  #:use-module (nyacc lang c99 pprint)
-  (mes-use-module (nyacc lang c99 pprint))
-  (mes-use-module (mes as))
-  (mes-use-module (mes as-i386))
-  (mes-use-module (mes M1))
-  (mes-use-module (mes optargs))
-  (mes-use-module (language c99 info))))
 
-(define (logf port string . rest)
+  #:use-module (mes guile)
-  (apply format (cons* port string rest))
+  #:use-module (mes misc)
-  (force-output port)
-  #t)
 
-(define (stderr string . rest)
+  #:use-module (mescc preprocess)
-  (apply logf (cons* (current-error-port) string rest)))
+  #:use-module (mescc info)
-
+  #:use-module (mescc as)
-(define (pke . stuff)
+  #:use-module (mescc i386 as)
-  (newline (current-error-port))
+  #:use-module (mescc M1)
-  (display ";;; " (current-error-port))
+  #:export (c99-ast->info
-  (write stuff (current-error-port))
+            c99-input->info
-  (newline (current-error-port))
+            c99-input->object))
-  (car (last-pair stuff)))
-
-(define %prefix (if (string-prefix? "@PREFIX" "@PREFIX@") (or (getenv "PREFIX") "") "@PREFIX@"))
 
 (define mes? (pair? (current-module)))
 
+(define* (c99-input->info #:key (prefix "") (defines '()) (includes '()))
+  (let ((ast (c99-input->ast #:prefix prefix #:defines defines #:includes includes)))
+    (c99-ast->info ast)))
+
+(define* (c99-ast->info o)
+  (stderr "compiling: input\n")
+  (let ((info (ast->info o (make <info> #:types i386:type-alist))))
+    (clean-info info)))
+
+(define (clean-info o)
+  (make <info>
+    #:functions (filter (compose pair? function:text cdr) (.functions o))
+    #:globals (.globals o)))
+
 (define %int-size 4)
 (define %pointer-size %int-size)
 
-(define* (c99-input->full-ast #:key (defines '()) (includes '()))
-  (let ((sys-include (if (equal? %prefix "") "include" (string-append %prefix "/share/include"))))
-    (parse-c99
-     #:inc-dirs (append includes (cons* sys-include "include" "lib" (or (and=> (getenv "C_INCLUDE_PATH") (cut string-split <> #\:)) '())))
-     #:cpp-defs `(
-                  "NULL=0"
-                  "__linux__=1"
-                  "__i386__=1"
-                  "POSIX=0"
-                  "_POSIX_SOURCE=0"
-                  "__MESC__=1"
-                  ,(if mes? "__MESC_MES__=1" "__MESC_MES__=0")
-                  ,@defines)
-     #:mode 'code)))
-
-(define (ast-strip-comment o)
-  (pmatch o
-    ((comment . ,comment) #f)
-    (((comment . ,comment) . ,t) (filter-map ast-strip-comment t))
-    (((comment . ,comment) . ,cdr) cdr)
-    ((,car . (comment . ,comment)) car)
-    ((,h . ,t) (if (list? o) (filter-map ast-strip-comment o)
-                   (cons (ast-strip-comment h) (ast-strip-comment t))))
-    (_  o)))
-
-(define (ast-strip-const o)
-  (pmatch o
-    ((type-qual ,qual) (if (equal? qual "const") #f o))
-    ((pointer (type-qual-list (type-qual ,qual)) . ,rest)
-     (if (equal? qual "const") `(pointer ,@rest) o))
-    ((decl-spec-list (type-qual ,qual))
-     (if (equal? qual "const") #f
-         `(decl-spec-list (type-qual ,qual))))
-    ((decl-spec-list (type-qual ,qual) . ,rest)
-     (if (equal? qual "const") `(decl-spec-list ,@rest)
-         `(decl-spec-list (type-qual ,qual) ,@(map ast-strip-const rest))))
-    ((decl-spec-list (type-qual-list (type-qual ,qual)) . ,rest)
-     (if (equal? qual "const") `(decl-spec-list ,@rest)
-         `(decl-spec-list (type-qual-list (type-qual ,qual)) ,@(map ast-strip-const rest))))
-    ((,h . ,t) (if (list? o) (filter-map ast-strip-const o)
-                   (cons (ast-strip-const h) (ast-strip-const t))))
-    (_  o)))
-
-(define (clone o . rest)
-  (cond ((info? o)
-         (let ((types (.types o))
-               (constants (.constants o))
-               (functions (.functions o))
-               (globals (.globals o))
-               (locals (.locals o))
-               (statics (.statics o))
-               (function (.function o))
-               (text (.text o))
-               (post (.post o))
-               (break (.break o))
-               (continue (.continue o)))
-           (let-keywords rest
-                         #f
-                         ((types types)
-                          (constants constants)
-                          (functions functions)
-                          (globals globals)
-                          (locals locals)
-                          (statics statics)
-                          (function function)
-                          (text text)
-                          (post post)
-                          (break break)
-                          (continue continue))
-                         (make <info> #:types types #:constants constants #:functions functions #:globals globals  #:locals locals #:statics statics #:function function #:text text #:post post #:break break #:continue continue))))))
-
 (define (ident->constant name value)
   (cons name value))
 
@@ -755,7 +682,11 @@
 
 (define (ast->comment o)
   (if mes? '()
-      (let ((source (with-output-to-string (lambda () (pretty-print-c99 o)))))
+      (let* ((source (with-output-to-string (lambda () (pretty-print-c99 o))))
+             ;; Nyacc 0.80.42 fixups
+             (source (string-substitute source "'\\'" "'\\\\'"))
+             (source (string-substitute source "'\"'" "'\\\"'"))
+             (source (string-substitute source "'''" "'\\''")))
         (make-comment (string-join (string-split source #\newline) " ")))))
 
 (define (accu*n info n)
@@ -2496,32 +2427,3 @@
              #:globals (append (.statics info) (.globals info))
              #:statics '()
              #:functions (append (.functions info) (list (cons name (make-function name type (assert-return (.text info))))))))))
-
-;; exports
-
-(define* (c99-ast->info o)
-  (ast->info o (make <info> #:types i386:type-alist)))
-
-(define* (c99-input->ast #:key (defines '()) (includes '()))
-  (stderr "parsing: input\n")
-  ((compose ast-strip-const ast-strip-comment) (c99-input->full-ast #:defines defines #:includes includes)))
-
-(define* (c99-input->info #:key (defines '()) (includes '()))
-  (lambda ()
-    (let* ((info (make <info> #:types i386:type-alist))
-           (ast (c99-input->ast #:defines defines #:includes includes))
-           (foo (stderr "compiling: input\n"))
-           (info (ast->info ast info))
-           (info (clone info #:text '() #:locals '())))
-      info)))
-
-(define* (info->object o)
-  (stderr "compiling: object\n")
-  `((functions . ,(filter (compose pair? function:text cdr) (.functions o)))
-    (globals . ,(.globals o))))
-
-(define* (c99-input->elf #:key (defines '()) (includes '()))
-  ((compose object->elf info->object (c99-input->info #:defines defines #:includes includes))))
-
-(define* (c99-input->object #:key (defines '()) (includes '()))
-  ((compose object->M1 info->object (c99-input->info #:defines defines #:includes includes))))

module/mescc/i386/as.mes

@@ -0,0 +1,22 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(mes-use-module (mescc as))
+(include-from-path "mescc/i386/as.scm")

module/mescc/i386/as.scm

@@ -1,7 +1,5 @@
-;;; -*-scheme-*-
-
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -20,15 +18,148 @@
 
 ;;; Commentary:
 
-;;; as-i386.mes defines i386 assembly
+;;; define i386 assembly
 
 ;;; Code:
 
-(cond-expand
+(define-module (mescc i386 as)
- (guile-2)
+  #:use-module (mes guile)
- (guile)
+  #:use-module (mescc as)
- (mes
+  #:export (
-  (mes-use-module (mes as))))
+            i386:accu%base
+            i386:accu*base
+            i386:accu*n->label
+            i386:accu*n->local
+            i386:accu+accu
+            i386:accu+base
+            i386:accu+value
+            i386:accu->base
+            i386:accu->base-mem
+            i386:byte-accu->base-mem
+            i386:word-accu->base-mem
+            i386:accu->base-mem+n
+            i386:byte-accu->base-mem+n
+            i386:word-accu->base-mem+n
+            i386:accu->label
+            i386:accu->local
+            i386:accu->local+n
+            i386:accu->local+n
+            i386:accu-and
+            i386:accu-and-base
+            i386:accu-and-base-mem
+            i386:accu-base
+            i386:accu-cmp-value
+            i386:accu-mem-add
+            i386:accu-mem->base-mem
+            i386:accu-negate
+            i386:accu-not
+            i386:accu-or-base
+            i386:accu-or-base-mem
+            i386:accu-shl
+            i386:accu-test
+            i386:accu-xor-base
+            i386:accu-zero?
+            i386:accu/base
+            i386:accu<->stack
+            i386:accu<<base
+            i386:accu>>base
+            i386:base+value
+            i386:base->accu
+            i386:base->accu-mem
+            i386:base->label
+            i386:base-mem->accu-mem
+            i386:base-mem+n->accu
+            i386:base-mem->accu
+            i386:base-sub
+            i386:byte-accu->base-mem
+            i386:word-accu->base-mem
+            i386:byte-base->accu-mem
+            i386:byte-base->accu-mem+n
+            i386:byte-base-mem->accu
+            i386:byte-base-sub
+            i386:byte-local->base
+            i386:byte-mem->accu
+            i386:word-mem->accu
+            i386:byte-mem->base
+            i386:byte-sub-base
+            i386:byte-test-base
+            i386:call-accu
+            i386:call-label
+            i386:formal
+            i386:function-locals
+            i386:function-preamble
+            i386:jump
+            i386:jump
+            i386:jump-a
+            i386:jump-ae
+            i386:jump-b
+            i386:jump-be
+            i386:jump-byte-z
+            i386:jump-g
+            i386:jump-ge
+            i386:jump-l
+            i386:jump-le
+            i386:jump-nz
+            i386:jump-z
+            i386:label->accu
+            i386:label->base
+            i386:label-mem->accu
+            i386:label-mem->base
+            i386:label-mem-add
+            i386:local->accu
+            i386:local->base
+            i386:local-add
+            i386:local-address->accu
+            i386:local-address->accu
+            i386:local-address->base
+            i386:local-ptr->accu
+            i386:local-ptr->base
+            i386:local-test
+            i386:mem+n->accu
+            i386:byte-mem+n->accu
+            i386:word-mem+n->accu
+            i386:mem->accu
+            i386:mem->base
+            i386:nop
+            i386:nz->accu
+            i386:pop-accu
+            i386:pop-base
+            i386:push-accu
+            i386:push-base
+            i386:push-byte-local-de-de-ref
+            i386:push-byte-local-de-ref
+            i386:push-word-local-de-ref
+            i386:push-label
+            i386:push-label-mem
+            i386:push-local
+            i386:push-local-address
+            i386:push-local-de-ref
+            i386:ret
+            i386:ret-local
+            i386:sub-base
+            i386:test-base
+            i386:value->accu
+            i386:value->accu-mem
+            i386:value->accu-mem+n
+            i386:value->base
+            i386:value->label
+            i386:value->local
+            i386:xor-accu
+            i386:xor-zf
+            i386:g?->accu
+            i386:ge?->accu
+            i386:l?->accu
+            i386:le?->accu
+            i386:a?->accu
+            i386:ae?->accu
+            i386:b?->accu
+            i386:be?->accu
+            i386:z->accu
+            i386:byte-accu
+            i386:signed-byte-accu
+            i386:word-accu
+            i386:signed-word-accu
+            ))
 
 (define (i386:nop)
   '(("nop")))

module/mescc/info.mes

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -24,5 +24,5 @@
 
 (mes-use-module (srfi srfi-9))
 (mes-use-module (srfi srfi-9 gnu))
-(include-from-path "language/c99/info.scm")
+(mes-use-module (mes optargs))
-
+(include-from-path "mescc/info.scm")

module/mescc/info.scm

@@ -1,5 +1,3 @@
-;;; -*-scheme-*-
-
 ;;; Mes --- Maxwell Equations of Software
 ;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
@@ -18,17 +16,20 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-;;; info.scm defines [Guile] record data types for compiler.mes
+;;; Commentary:
+
+;;; info.scm defines [Guile] record data types for MesCC
 
 ;;; Code:
 
-(define-module (language c99 info)
+(define-module (mescc info)
   #:use-module (ice-9 optargs)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-26)
   #:export (<info>
             make
+            clone
             make-<info>
             info?
 
@@ -113,14 +114,6 @@
             rank+=
             structured-type?))
 
-(cond-expand
- (guile-2)
- (guile
-  (use-modules (ice-9 syncase))
-  (use-modules (ice-9 optargs)))
- (mes
-  (mes-use-module (mes optargs))))
-
 (define-immutable-record-type <info>
   (make-<info> types constants functions globals locals statics function text post break continue)
   info?
@@ -137,7 +130,36 @@
   (continue .continue))
 
 (define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (post '()) (break '()) (continue '()))
-  (make-<info> types constants functions globals locals statics function text post break continue))
+  (cond ((eq? o <info>)
+         (make-<info> types constants functions globals locals statics function text post break continue))))
+
+(define (clone o . rest)
+  (cond ((info? o)
+         (let ((types (.types o))
+               (constants (.constants o))
+               (functions (.functions o))
+               (globals (.globals o))
+               (locals (.locals o))
+               (statics (.statics o))
+               (function (.function o))
+               (text (.text o))
+               (post (.post o))
+               (break (.break o))
+               (continue (.continue o)))
+           (let-keywords rest
+                         #f
+                         ((types types)
+                          (constants constants)
+                          (functions functions)
+                          (globals globals)
+                          (locals locals)
+                          (statics statics)
+                          (function function)
+                          (text text)
+                          (post post)
+                          (break break)
+                          (continue continue))
+                         (make <info> #:types types #:constants constants #:functions functions #:globals globals  #:locals locals #:statics statics #:function function #:text text #:post post #:break break #:continue continue))))))
 
 ;; ("int" . ,(make-type 'builtin 4 #f 0 #f))
 ;;           (make-type 'enum 4 0 fields)

module/mescc/mescc.mes

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
@@ -18,21 +18,14 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-;;; Commentary:
+(mes-use-module (srfi srfi-1))
+(mes-use-module (srfi srfi-13))
+(mes-use-module (srfi srfi-26))
+(mes-use-module (mes misc))
+(mes-use-module (mes getopt-long))
 
-;;; Code:
+(mes-use-module (mes guile))
-
+(mes-use-module (mescc preprocess))
-(define-module (mes bytevectors)
+(mes-use-module (mescc compile))
-  #:use-module (mes guile)
+(mes-use-module (mescc M1))
-  #:export (bytevector-u32-native-set!
+(include-from-path "mescc/mescc.scm")
-            bytevector-u16-native-set!
-            bytevector-u8-set!
-            make-bytevector))
-
-(cond-expand
- (guile-2)
- (guile
-  (use-modules (ice-9 syncase)))
- (mes))
-
-(include-from-path "mes/bytevectors.mes")

module/mescc/mescc.scm

@@ -0,0 +1,232 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (mescc mescc)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (ice-9 getopt-long)
+  #:use-module (mes guile)
+  #:use-module (mes misc)
+
+  #:use-module (mescc preprocess)
+  #:use-module (mescc compile)
+  #:use-module (mescc M1)
+  #:export (mescc:preprocess
+            mescc:compile
+            mescc:assemble
+            mescc:link))
+
+(define (mescc:preprocess options)
+  (let* ((defines (reverse (filter-map (multi-opt 'define) options)))
+         (includes (reverse (filter-map (multi-opt 'include) options)))
+         (pretty-print/write (string->symbol (option-ref options 'write (if guile? "pretty-print" "write"))))
+         (pretty-print/write (if (eq? pretty-print/write 'pretty-print) pretty-print write))
+         (files (option-ref options '() '("a.c")))
+         (input-file-name (car files))
+         (ast-file-name (cond ((and (option-ref options 'preprocess #f)
+                                    (option-ref options 'output #f)))
+                              (else (replace-suffix input-file-name ".E"))))
+         (prefix (option-ref options 'prefix "")))
+    (with-output-to-file ast-file-name
+      (lambda _ (for-each (cut c->ast prefix defines includes write <>) files)))))
+
+(define (c->ast prefix defines includes write file-name)
+  (with-input-from-file file-name
+    (cut write (c99-input->ast #:prefix prefix #:defines defines #:includes includes))))
+
+(define (mescc:compile options)
+  (let* ((files (option-ref options '() '("a.c")))
+         (input-file-name (car files))
+         (M1-file-name (cond ((and (option-ref options 'compile #f)
+                                   (option-ref options 'output #f)))
+                             (else (replace-suffix input-file-name ".S"))))
+         (infos (map (cut file->info options <>) files))
+         (verbose? (option-ref options 'verbose #f)))
+    (when verbose?
+      (stderr "dumping: ~a\n" M1-file-name))
+    (with-output-to-file M1-file-name
+      (cut infos->M1 M1-file-name infos))
+    M1-file-name))
+
+(define (file->info options file-name)
+  (cond ((.c? file-name) (c->info options file-name))
+        ((.E? file-name) (E->info options file-name))))
+
+(define (c->info options file-name)
+  (let ((defines (reverse (filter-map (multi-opt 'define) options)))
+        (includes (reverse (filter-map (multi-opt 'include) options)))
+        (prefix (option-ref options 'prefix "")))
+    (with-input-from-file file-name
+      (cut c99-input->info #:prefix prefix #:defines defines #:includes includes))))
+
+(define (E->info options file-name)
+  (let ((ast (with-input-from-file file-name read)))
+    (c99-ast->info ast)))
+
+(define (mescc:assemble options)
+  (let* ((files (option-ref options '() '("a.c")))
+         (input-file-name (car files))
+         (hex2-file-name (cond ((and (option-ref options 'assemble #f)
+                                     (option-ref options 'output #f)))
+                               (else (replace-suffix input-file-name ".o"))))
+         (S-files (filter .S? files))
+         (hex2-files  M1->hex2 ) ;; FIXME
+         (source-files (filter (disjoin .c? .E?) files))
+         (infos (map (cut file->info options <>) source-files)))
+    (if (and (pair? S-files) (pair? infos))
+        (error "mixing source and object not supported:" source-files S-files))
+    (when (pair? S-files)
+      (M1->hex2 options S-files))
+    (when (pair? infos)
+      (infos->hex2 options hex2-file-name infos))
+    hex2-file-name))
+
+(define (mescc:link options)
+  (define (library->hex2 o)
+    (prefix-file options (string-append "lib/lib" o "-mes.o")))
+  (let* ((files (option-ref options '() '("a.c")))
+         (source-files (filter (disjoin .c? .E?) files))
+         (S-files (filter .S? files))
+         (o-files (filter .o? files))
+         (input-file-name (car files))
+         (hex2-file-name (if (or (string-suffix? ".hex2" input-file-name)
+                                 (string-suffix? ".o" input-file-name)) input-file-name
+                                 (replace-suffix input-file-name ".o")))
+         (infos (map (cut file->info options <>) source-files))
+         (S-files (filter .S? files))
+         (hex2-files (filter .o? files))
+         (hex2-files (if (null? S-files) hex2-files
+                         (append hex2-files (list (M1->hex2 options S-files)))))
+         (hex2-files (if (null? infos) hex2-files
+                         (append hex2-files
+                                 (list (infos->hex2 options hex2-file-name infos)))))
+         (libraries (filter-map (multi-opt 'library) options))
+         (libraries (if (pair? libraries) libraries '("c")))
+         (hex2-libraries (map library->hex2 libraries))
+         (hex2-files (append hex2-files hex2-libraries))
+         (S-files (append S-files (map (cut replace-suffix <> ".S") hex2-libraries)))
+         (debug-info? (option-ref options 'debug-info #f))
+         (S-files (cons (replace-suffix input-file-name ".S") S-files))
+         (elf-footer (and debug-info?
+                          (or (M1->blood-elf options S-files)
+                              (exit 1)))))
+    (or (hex2->elf options hex2-files #:elf-footer elf-footer)
+        (exit 1))))
+
+(define (infos->hex2 options hex2-file-name infos)
+  (let* ((input-file-name (car (option-ref options '() '("a.c"))))
+         (M1-file-name (replace-suffix hex2-file-name ".S"))
+         (options (acons 'compile #t options)) ; ugh
+         (options (acons 'output hex2-file-name options))
+         (verbose? (option-ref options 'verbose #f)))
+    (when verbose?
+      (stderr "dumping: ~a\n" M1-file-name))
+    (with-output-to-file M1-file-name
+      (cut infos->M1 M1-file-name infos))
+    (or (M1->hex2 options (list M1-file-name))
+        (exit 1))))
+
+(define (M1->hex2 options M1-files)
+  (let* ((input-file-name (car (option-ref options '() '("a.c"))))
+         (M1-file-name (car M1-files))
+         (hex2-file-name (cond ((and (option-ref options 'assemble #f)
+                                     (option-ref options 'output #f)))
+                               ((option-ref options 'assemble #f)
+                                (replace-suffix input-file-name ".o"))
+                               (else (replace-suffix M1-file-name ".o"))))
+         (verbose? (option-ref options 'verbose #f))
+         (M1 (or (getenv "M1") "M1"))
+         (command `(,M1
+                    "--LittleEndian"
+                    "--Architecture=1"
+                    "-f" ,(prefix-file options "stage0/x86.M1")
+                    ,@(append-map (cut list "-f" <>) M1-files)
+                    "-o" ,hex2-file-name)))
+    (when verbose?
+      (stderr "~a\n" (string-join command)))
+    (and (zero? (apply system* command))
+         hex2-file-name)))
+
+(define* (hex2->elf options hex2-files #:key elf-footer)
+  (let* ((input-file-name (car (option-ref options '() '("a.c"))))
+         (elf-file-name (cond ((option-ref options 'output #f))
+                              (else (replace-suffix input-file-name ""))))
+         (verbose? (option-ref options 'verbose #f))
+         (elf-footer (or elf-footer (prefix-file options "stage0/elf32-footer-single-main.hex2")))
+         (hex2 (or (getenv "HEX2") "hex2"))
+         (command `(,hex2
+                    "--LittleEndian"
+                    "--Architecture=1"
+                    "--BaseAddress=0x1000000"
+                    "-f" ,(prefix-file options "stage0/elf32-header.hex2")
+                    "-f" ,(prefix-file options "lib/crt1.o")
+                    ,@(append-map (cut list "-f" <>) hex2-files)
+                    "-f" ,elf-footer
+                    "--exec_enable"
+                    "-o" ,elf-file-name)))
+    (when verbose?
+      (stderr "command=~s\n" command)
+      (format (current-error-port) "~a\n" (string-join command)))
+    (and (zero? (apply system* command))
+         elf-file-name)))
+
+(define (M1->blood-elf options M1-files)
+  (let* ((M1-file-name (car M1-files))
+         (M1-blood-elf-footer (string-append M1-file-name ".blood-elf"))
+         (hex2-file-name (replace-suffix M1-file-name ".o"))
+         (blood-elf-footer (string-append hex2-file-name ".blood-elf"))
+         (verbose? (option-ref options 'verbose #f))
+         (blood-elf (or (getenv "BLOOD_ELF") "blood-elf"))
+         (command `(,blood-elf
+                      "-f" ,(prefix-file options "stage0/x86.M1")
+                      ,@(append-map (cut list "-f" <>) M1-files)
+                      "-o" ,M1-blood-elf-footer)))
+    (when verbose?
+        (format (current-error-port) "~a\n" (string-join command)))
+    (and (zero? (apply system* command))
+         (let* ((options (acons 'compile #t options)) ; ugh
+                (options (acons 'output blood-elf-footer options)))
+           (M1->hex2 options (list M1-blood-elf-footer))))))
+
+(define (replace-suffix file-name suffix)
+  (let* ((parts (string-split file-name #\.))
+         (base (if (pair? (cdr parts)) (drop-right parts 1))))
+    (string-append (string-join base ".") suffix)))
+
+(define (prefix-file options file-name)
+  (let ((prefix (option-ref options 'prefix "")))
+    (define (prefix-file o)
+      (if (string-null? prefix) o (string-append prefix "/" o)))
+    (prefix-file file-name)))
+
+(define (multi-opt option-name) (lambda (o) (and (eq? (car o) option-name) (cdr o))))
+
+(define (.c? o) (or (string-suffix? ".c" o)
+                    (string-suffix? ".M2" o)))
+(define (.E? o) (string-suffix? ".E" o))
+(define (.S? o) (or (string-suffix? ".S" o)
+                    (string-suffix? ".mes-S" o)
+                    (string-suffix? "S" o)
+                    (string-suffix? ".M1" o)))
+(define (.o? o) (or (string-suffix? ".o" o)
+                    (string-suffix? ".mes-o" o)
+                    (string-suffix? "o" o)
+                    (string-suffix? ".hex2" o)))

module/mescc/preprocess.mes

@@ -0,0 +1,27 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(mes-use-module (mes optargs))
+(mes-use-module (mes pmatch))
+(mes-use-module (srfi srfi-1))
+(mes-use-module (srfi srfi-13))
+(mes-use-module (srfi srfi-26))
+(mes-use-module (nyacc lang c99 parser))
+(include-from-path "mescc/preprocess.scm")

module/mescc/preprocess.scm

@@ -0,0 +1,87 @@
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(define-module (mescc preprocess)
+  #:use-module (ice-9 optargs)
+  #:use-module (system base pmatch)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (nyacc lang c99 parser)
+  #:use-module (mes guile)
+  #:export (c99-input->ast))
+
+(define (logf port string . rest)
+  (apply format (cons* port string rest))
+  (force-output port)
+  #t)
+
+(define (stderr string . rest)
+  (apply logf (cons* (current-error-port) string rest)))
+
+(define mes? (pair? (current-module)))
+
+(define* (c99-input->full-ast #:key (prefix "") (defines '()) (includes '()))
+  (let ((sys-include (if (equal? prefix "") "include" (string-append prefix "/share/include"))))
+    (parse-c99
+     #:inc-dirs (append includes (cons* sys-include "include" "lib" (or (and=> (getenv "C_INCLUDE_PATH") (cut string-split <> #\:)) '())))
+     #:cpp-defs `(
+                  "NULL=0"
+                  "__linux__=1"
+                  "__i386__=1"
+                  "POSIX=0"
+                  "_POSIX_SOURCE=0"
+                  "__MESC__=1"
+                  ,(if mes? "__MESC_MES__=1" "__MESC_MES__=0")
+                  ,@defines)
+     #:mode 'code)))
+
+(define* (c99-input->ast #:key (prefix "") (defines '()) (includes '()))
+  (stderr "parsing: input\n")
+  ((compose ast-strip-const ast-strip-comment) (c99-input->full-ast #:prefix prefix #:defines defines #:includes includes)))
+
+(define (ast-strip-comment o)
+  (pmatch o
+    ((comment . ,comment) #f)
+    (((comment . ,comment) . ,t) (filter-map ast-strip-comment t))
+    (((comment . ,comment) . ,cdr) cdr)
+    ((,car . (comment . ,comment)) car)
+    ((,h . ,t) (if (list? o) (filter-map ast-strip-comment o)
+                   (cons (ast-strip-comment h) (ast-strip-comment t))))
+    (_  o)))
+
+(define (ast-strip-const o)
+  (pmatch o
+    ((type-qual ,qual) (if (equal? qual "const") #f o))
+    ((pointer (type-qual-list (type-qual ,qual)) . ,rest)
+     (if (equal? qual "const") `(pointer ,@rest) o))
+    ((decl-spec-list (type-qual ,qual))
+     (if (equal? qual "const") #f
+         `(decl-spec-list (type-qual ,qual))))
+    ((decl-spec-list (type-qual ,qual) . ,rest)
+     (if (equal? qual "const") `(decl-spec-list ,@rest)
+         `(decl-spec-list (type-qual ,qual) ,@(map ast-strip-const rest))))
+    ((decl-spec-list (type-qual-list (type-qual ,qual)) . ,rest)
+     (if (equal? qual "const") `(decl-spec-list ,@rest)
+         `(decl-spec-list (type-qual-list (type-qual ,qual)) ,@(map ast-strip-const rest))))
+    ((,h . ,t) (if (list? o) (filter-map ast-strip-const o)
+                   (cons (ast-strip-const h) (ast-strip-const t))))
+    (_  o)))

module/srfi/srfi-1.mes

@@ -131,10 +131,4 @@
               (loop (cdr lst))
                 (cons (car lst) (loop (cdr lst))))))))
 
-(define (drop lst n)
-  (list-tail lst n))
-
-(define (drop-right lst n)
-  (list-head lst (- (length lst) n)))
-
 (include-from-path "srfi/srfi-1.scm")

module/srfi/srfi-13.mes

@@ -24,7 +24,6 @@
 
 ;;; Code:
 
-(mes-use-module (srfi srfi-1))
 (mes-use-module (srfi srfi-14))
 
 (define (string-join lst . delimiter+grammar)
@@ -76,10 +75,12 @@
         ((> n 0) (list->string (list-tail (string->list s) n)))
         (else s (error "string-drop: not supported: (n s)=" (cons n s)))))
 
+(define (drop-right lst n)
+  (list-head lst (- (length lst) n)))
+
 (define (string-drop-right s n)
   (cond ((zero? n) s)
-        ((> n 0) (let ((length (string-length s)))
+        ((> n 0) ((compose list->string (lambda (o) (drop-right o n)) string->list) s))
-                   (list->string (list-head (string->list s) (- length n)))))
         (else (error "string-drop-right: not supported: n=" n))))
 
 (define (string-delete pred s)

scripts/mescc

@@ -1,5 +1,14 @@
 #! /bin/sh
 # -*-scheme-*-
+if [ -n "$BUILD_DEBUG" ]; then
+    set -x
+fi
+PREFIX=${PREFIX-@PREFIX@}
+if [ "$PREFIX" = @PREFIX""@ -o ! -d "$PREFIX" ]
+then
+    MES_PREFIX=${MES_PREFIX-$(cd $(dirname $0)/.. && pwd)}
+    export MES_PREFIX
+fi
 mes_p=$(command -v mes)
 if [ '(' -z "$mes_p" -a -z "$MES" ')' -o "$MES" = "guile" -o "$MES" = "mes.guile" ]; then
     GODIR=${GODIR-@GODIR@}
@@ -11,18 +20,9 @@ if [ '(' -z "$mes_p" -a -z "$MES" ')' -o "$MES" = "guile" -o "$MES" = "mes.guile
     exec ${GUILE-guile} -L $GUILEDIR -e '(mescc)' -s "$0" "$@"
 else
     MES=${MES-$(dirname $0)/mes}
-    PREFIX=${PREFIX-@PREFIX@}
-    if [ "$MES_PREFIX" = @PREFIX""@ ]
-    then
-        MES_PREFIX=$(cd $(dirname $0)/.. && pwd)
-        export MES_PREFIX
-    else
-        MES_PREFIX=${MES_PREFIX-$PREFIX/share/mes}
-    fi
     MES_MODULEDIR=${MES_MODULEDIR-$MES_PREFIX/"module"}
     export MES_MODULEDIR
     exec ${MES-mes} -e '(mescc)' -s $0 "$@"
-    exit $?
 fi
 !#
 
@@ -44,63 +44,43 @@ fi
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-#!
-Run with Guile-1.8:
-GUILE='~/src/guile-1.8/build/pre-inst-guile --debug -q' scripts/mescc
-!#
-
 (define-module (mescc)
-  #:use-module (language c99 info)
-  #:use-module (language c99 compiler)
-  #:use-module (mes elf)
-  #:use-module (mes M1)
   #:use-module (ice-9 getopt-long)
-  #:use-module (ice-9 pretty-print)
+  #:use-module (mes misc)
-  #:use-module (srfi srfi-1)
+  #:use-module (mescc mescc)
-  #:use-module (srfi srfi-26)
   #:export (main))
 
 (define %prefix (if (string-prefix? "@PREFIX" "@PREFIX@") (or (getenv "MES_PREFIX") "") "@PREFIX@"))
 
+(define %version (if (string-prefix? "@VERSION" "@VERSION@") "git"
+                     "@VERSION@"))
+
 (cond-expand
  (mes
-  (define %scheme "mes")
+  (define (set-port-encoding! port encoding) #t)
-  (define (set-port-encoding! port encoding) #t))
- (guile-2
-  (define %scheme "guile")
-  (define-macro (mes-use-module . rest) #t)
-  (module-define! (resolve-module '(language c99 compiler)) '%prefix %prefix))
- (guile
-  (use-modules (ice-9 syncase))
-  (define %scheme "guile")
-  (define-macro (mes-use-module . rest) #t)
-  (module-define! (resolve-module '(language c99 compiler)) '%prefix %prefix)))
-
-(define guile? (equal? %scheme "guile"))
-
   (mes-use-module (mes guile))
+  (mes-use-module (mes misc))
   (mes-use-module (mes getopt-long))
-(mes-use-module (mes pretty-print))
-(mes-use-module (language c99 info))
-(mes-use-module (language c99 compiler))
   (mes-use-module (mes display))
-(mes-use-module (mes elf))
+  (mes-use-module (mescc mescc)))
-(mes-use-module (mes M1))
+ (guile
-(mes-use-module (srfi srfi-1))
+  (define-macro (mes-use-module . rest) #t)))
-(mes-use-module (srfi srfi-26))
 
 (format (current-error-port) "mescc[~a]...\n" %scheme)
 
 (define (parse-opts args)
   (let* ((option-spec
-          '((c (single-char #\c))
+          '((assemble (single-char #\c))
+            (compile (single-char #\S))
             (define (single-char #\D) (value #t))
-            (E (single-char #\E))
+            (debug-info (single-char #\g))
-            (g (single-char #\g))
             (help (single-char #\h))
             (include (single-char #\I) (value #t))
-            (o (single-char #\o) (value #t))
+            (library (single-char #\l) (value #t))
+            (preprocess (single-char #\E))
+            (output (single-char #\o) (value #t))
             (version (single-char #\V))
+            (verbose (single-char #\v))
             (write (single-char #\w) (value #t))))
          (options (getopt-long args option-spec))
          (help? (option-ref options 'help #f))
@@ -113,13 +93,15 @@ GUILE='~/src/guile-1.8/build/pre-inst-guile --debug -q' scripts/mescc
      (and (or help? usage?)
           (format (or (and usage? (current-error-port)) (current-output-port)) "\
 Usage: mescc [OPTION]... FILE...
-  -c                 compile and assemble, but do not link
+  -c                 preprocess, compile and assemble only; do not link
-  -D DEFINE          define DEFINE
+  -D DEFINE[=VALUE]  define DEFINE [VALUE=1]
   -E                 preprocess only; do not compile, assemble or link
   -g                 add debug info [GDB, objdump] TODO: hex2 footer
   -h, --help         display this help and exit
   -I DIR             append DIR to include path
+  -l LIBNAME         link with LIBNAME
   -o FILE            write output to FILE
+  -S                 preprocess and compile only; do not assemble or link
   -v, --version      display version and exit
   -w,--write=TYPE    dump Nyacc AST using TYPE {pretty-print,write}
 
@@ -132,76 +114,18 @@ Environment variables:
           (exit (or (and usage? 2) 0)))
      options)))
 
-(define (read-object file)
-  (let ((char (with-input-from-file file read-char)))
-    (if (eq? char #\#) (error "hex2 format not supported:" file)))
-  (with-input-from-file file read))
-
-(define (main:ast->info file)
-  (let ((ast (with-input-from-file file read)))
-    (c99-ast->info ast)))
-
-(define (source->ast write defines includes)
-  (lambda (file)
-    (with-input-from-file file
-      (lambda ()
-        (write (c99-input->ast #:defines defines #:includes includes))))))
-
-(define (source->info defines includes)
-  (lambda (file)
-    (with-input-from-file file
-      (lambda ()
-        ((c99-input->info #:defines defines #:includes includes))))))
-
-(define (ast? o)
-  (or (string-suffix? ".E" o)
-      (string-suffix? (string-append "." %scheme "-E") o)
-      (string-suffix? "-E" o)))
-
-(define (object? o)
-  (or (string-suffix? ".o" o)
-      (string-suffix? (string-append "." %scheme "-o") o)
-      (string-suffix? "-o" o)))
-
 (define (main args)
   (let* ((options (parse-opts args))
-         (files (option-ref options '() '()))
+         (options (acons 'prefix %prefix options))
-         (file (car files))
+         (preprocess? (option-ref options 'preprocess #f))
-         (file-name (car (string-split (basename file) #\.)))
+         (compile? (option-ref options 'compile #f))
-         (preprocess? (option-ref options 'E #f))
+         (assemble? (option-ref options 'assemble #f))
-         (compile? (option-ref options 'c #f))
+         (verbose? (option-ref options 'verbose (getenv "MES_DEBUG"))))
-         (debug-info? (option-ref options 'g #f))
+    (when verbose?
-         (asts (filter ast? files))
-         (objects (filter object? files))
-         (sources (filter (cut string-suffix? ".c" <>) files))
-         (base (substring file (1+ (or (string-rindex file #\/) -1)) (- (string-length file) 2)))
-         (out (option-ref options 'o (cond (compile? (string-append base ".o"))
-                                           (preprocess? (string-append base ".E"))
-                                           (else "a.out"))))
-         (multi-opt (lambda (option) (lambda (o) (and (eq? (car o) option) (cdr o)))))
-         (defines (reverse (filter-map (multi-opt 'define) options)))
-         (includes (reverse (filter-map (multi-opt 'include) options)))
-         (pretty-print/write (string->symbol (option-ref options 'write (if guile? "pretty-print" "write"))))
-         (pretty-print/write (if (eq? pretty-print/write 'pretty-print) pretty-print write)))
-    (when (getenv "MES_DEBUG")
       (setenv "NYACC_TRACE" "yes")
-      (format (current-error-port) "options=~s\n" options)
+      (format (current-error-port) "options=~s\n" options))
-      (format (current-error-port) "output: ~a\n" out))
+    (cond (preprocess? (mescc:preprocess options))
-    (if (and (pair? sources) (pair? objects)) (error "cannot mix source and object files:" files))
+          (compile? (mescc:compile options))
-    (with-output-to-file out
+          (assemble? (mescc:assemble options))
-      (lambda ()
+          (else (mescc:link options)))))
-        (if (and (not compile?)
-                 (not preprocess?)) (set-port-encoding! (current-output-port) "ISO-8859-1"))
-        (cond ((pair? objects) (let ((objects (map read-object objects)))
-                                 (if compile? (objects->M1 file-name objects)
-                                     (objects->elf file objects))))
-              ((pair? asts) (let* ((infos (map main:ast->info asts))
-                                   (objects (map info->object infos)))
-                              (if compile? (objects->M1 file-name objects)
-                                  (objects->elf file objects))))
-              ((pair? sources) (if preprocess? (map (source->ast pretty-print/write defines includes) sources)
-                                   (let* ((infos (map (source->info defines includes) sources))
-                                          (objects (map info->object infos)))
-                                     (if compile? (objects->M1 file-name objects)
-                                         (objects->elf file objects))))))))))
 'done