artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Posixify interface.

Browse source 
* 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.
This commit is contained in:
Jan Nieuwenhuizen 2018-05-25 08:05:02 +02:00
parent 2748992551
commit a10c48735d
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
52 changed files with 1024 additions and 987 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
.gitignore vendored
View file

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

3
AUTHORS
View file

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

2
GNUmakefile
View file

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

8
build-aux/build-cc.sh
View file

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

52
build-aux/build-guile.sh
View file

@ -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
language/c99/info.scm
mes/as-i386.scm
mes/as.scm
mes/bytevectors.scm
mes/elf.scm
mes/guile.scm
mes/test.scm
mes/M1.scm"
guile/mes/guile.scm
guile/mes/misc.scm
guile/mes/test.scm
guile/mescc/M1.scm
guile/mescc/as.scm
guile/mescc/bytevectors.scm
guile/mescc/compile.scm
guile/mescc/i386/as.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

48
build-aux/build-mes.sh
View file

@ -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/>.
set -x
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\
-o src/mes.blood-elf.hex2
-f src/mes.S.blood-elf\
-o src/mes.o.blood-elf
$HEX2\
$HEX2FLAGS\
-f stage0/elf32-header.hex2\
-f lib/crt1.hex2\
-f lib/libc-mes.hex2\
-f src/mes.hex2\
-f src/mes.blood-elf.hex2\
-f lib/crt1.o\
-f lib/libc-mes.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
$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/hello
# sh build-aux/cc-mes.sh scaffold/argv
# sh build-aux/cc-mes.sh scaffold/malloc
sh build-aux/cc-mes.sh scaffold/main
sh build-aux/cc-mes.sh scaffold/hello
sh build-aux/cc-mes.sh scaffold/argv
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

8
build-aux/build-mlibc.sh
View file

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

81
build-aux/cc-mes.sh
View file

@ -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/>.
set -x
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-"
"}
LIBC=${LIBC-lib/libc}
M1FLAGS=${M1FLAGS-"
--LittleEndian
--Architecture=1
"}
HEX2FLAGS=${HEX2FLAGS-"
--LittleEndian
--Architecture=1
--BaseAddress=0x1000000
"}
if [ -n "$BUILD_DEBUG" ]; then
MESCCFLAGS="$MESCCFLAGS -v"
fi
c=$1
set -e
if [ -n "$PREPROCESS" ]; then
sh -x $MESCC\
-E\
$CPPFLAGS\
$MESCCFLAGS\
-o "$c".E\
"$c".c
sh -x $MESCC\
-c\
-o "$c".M1\
"$c".E
sh $MESCC $MESCCFLAGS $CPPFLAGS -E "$c".c
sh $MESCC $MESCCFLAGS -S "$c".E
sh $MESCC $MESCCFLAGS -c -o "$c".mes-o "$c".S
if [ -z "$NOLINK" ]; then
sh $MESCC $MESCCFLAGS -o "$c".mes-out "$c".mes-o $MESCCLIBS
fi
elif [ -n "$COMPILE" ]; then
sh $MESCC $MESCCFLAGS $CPPFLAGS -S "$c".c
sh $MESCC $MESCCFLAGS -c -o "$c".mes-o "$c".S
if [ -z "$NOLINK" ]; then
sh $MESCC $MESCCFLAGS -o "$c".mes-out "$c".mes-o $MESCCLIBS
fi
elif [ -z "$NOLINK" ]; then
sh $MESCC $MESCCFLAGS $CPPFLAGS -o "$c".mes-out "$c".c $MESCCLIBS
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\
-f stage0/x86.M1\
-f "$c".M1\
-f $LIBC-mes.M1\
-o "$c".blood-elf-M1
$M1\
$M1FLAGS\
-f "$c".blood-elf-M1\
-o "$c".blood-elf-hex2
$HEX2\
$HEX2FLAGS\
-f stage0/elf32-header.hex2\
-f lib/crt1.hex2\
-f $LIBC-mes.hex2\
-f "$c".hex2\
-f "$c".blood-elf-hex2\
--exec_enable\
-o "$c".mes-out
sh $MESCC $MESCCFLAGS $CPPFLAGS -c -o "$c".mes-out "$c".c
fi

9
build-aux/cc-mlibc.sh
View file

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

6
build-aux/cc.sh
View file

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

9
build-aux/check-boot.sh
View file

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

21
build-aux/check-mescc.sh
View file

@ -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=$?

159
build-aux/compile-all.scm
View file

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

6
build-aux/test.sh
View file

@ -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/>.
set -x
if [ -n "$BUILD_DEBUG" ]; then
set -x
fi
export LIBC
export LIBC MESCCLIBS
GUILE=${GUILE-$MES}
DIFF=${DIFF-$(command -v diff)}

8
build.sh
View file

@ -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/>.
set -x
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}

9
check.sh
View file

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

1
guile/mescc Symbolic link
View file

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

4
lib/libc-gcc.c
View file

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

4
lib/libc-mes.c
View file

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

4
lib/mini-libc-gcc.c → lib/libc-mini-gcc.c
View file

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

4
lib/mini-libc-mes.c → lib/libc-mini-mes.c
View file

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

0
lib/mini-libc.c → lib/libc-mini.c
View file

0
lib/mini-linux-gcc.c → lib/linux-mini-gcc.c
View file

0
lib/mini-linux-mes.c → lib/linux-mini-mes.c
View file

61
module/language/c99/compiler.scm
View file

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

44
module/mes/M1.scm
View file

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

172
module/mes/as-i386.scm
View file

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

8
module/mes/boot-0.scm
View file

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

11
module/mes/guile.mes
View file

@ -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")
;;(format (current-error-port) "include-from-path: ~s [PATH:~s]\n" file path)
(cond ((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 1)) string->number))
(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)

14
module/mes/elf.scm → module/mes/mescc.mes
View file

@ -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)
#:use-module (mes guile)
#:export (M1->elf))
(cond-expand
(guile-2)
(guile
(use-modules (ice-9 syncase)))
(mes))
(include-from-path "mes/elf.mes")
(include-from-path "mes/mescc.scm")

23
module/mes/as.scm → module/mes/misc.mes
View file

@ -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:
;;; 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")
(include-from-path "mes/misc.scm")

65
module/mes/misc.scm Normal file
View file

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

2
module/mes/posix.mes
View file

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

28
module/mescc/M1.mes Normal file
View file

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

69
module/mes/M1.mes → module/mescc/M1.scm
View file

@ -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
(guile)
(mes
(mes-use-module (srfi srfi-1))
(mes-use-module (srfi srfi-26))
(mes-use-module (mes as))
(mes-use-module (mes elf))
(mes-use-module (mes optargs))
(mes-use-module (mes pmatch))
(mes-use-module (language c99 info))))
(define-module (mescc M1)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (system base pmatch)
#:use-module (mes misc)
#:use-module (mes guile)
(define (logf port string . rest)
(apply format (cons* port string rest))
(force-output port)
#t)
#:use-module (mescc as)
#:use-module (mescc info)
#:export (info->M1
infos->M1
M1:merge-infos))
(define (stderr string . rest)
(apply logf (cons* (current-error-port) string rest)))
(define (infos->M1 file-name infos)
(let ((info (fold M1:merge-infos (make <info>) infos)))
(info->M1 file-name info)))
(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 (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 (M1:merge-infos o info)
(clone info
#:functions (alist-add (.functions info) (.functions o))
#:globals (alist-add (.globals info) (.globals o))))
(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)
(stderr "dumping M1: object\n")
(let* ((functions (assoc-ref o 'functions))
(define (info->M1 file-name o)
(let* ((functions (.functions o))
(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)

17
module/mes/elf.mes → module/mescc/as.mes
View file

@ -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:
;;; elf.mes - produce a i386 elf executable.
;;; Code:
(cond-expand
(guile)
(mes))
(define (M1->elf objects)
(error "->ELF support dropped, use M1"))
(mes-use-module (srfi srfi-1))
(mes-use-module (mescc bytevectors))
(include-from-path "mescc/as.scm")

25
module/mes/as.mes → module/mescc/as.scm
View file

@ -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:
;;; compiler.mes produces an i386 binary from the C produced by
;;; Nyacc c99.
;;; Code:
(cond-expand
(guile)
(guile-2)
(mes
(mes-use-module (srfi srfi-1))
(mes-use-module (mes bytevectors))))
(define-module (mescc as)
#:use-module (srfi srfi-1)
#:use-module (mes guile)
#:use-module (mescc bytevectors)
#:export (dec->hex
int->bv8
int->bv16
int->bv32))
(define (int->bv32 value)
(let ((bv (make-bytevector 4)))

21
module/mescc/bytevectors.mes Normal file
View file

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

11
module/mes/bytevectors.mes → module/mescc/bytevectors.scm
View file

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

33
module/mescc/compile.mes Normal file
View file

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

172
module/language/c99/compiler.mes → module/mescc/compile.scm
View file

@ -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
(guile-2)
(guile)
(mes
(mes-use-module (srfi srfi-1))
(mes-use-module (srfi srfi-26))
(mes-use-module (mes pmatch))
(mes-use-module (nyacc lang c99 parser))
(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-module (mescc compile)
#: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 pprint)
(define (logf port string . rest)
(apply format (cons* port string rest))
(force-output port)
#t)
#:use-module (mes guile)
#:use-module (mes misc)
(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 %prefix (if (string-prefix? "@PREFIX" "@PREFIX@") (or (getenv "PREFIX") "") "@PREFIX@"))
#:use-module (mescc preprocess)
#:use-module (mescc info)
#:use-module (mescc as)
#:use-module (mescc i386 as)
#:use-module (mescc M1)
#:export (c99-ast->info
c99-input->info
c99-input->object))
(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))))

22
module/mescc/i386/as.mes Normal file
View file

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

149
module/mes/as-i386.mes → module/mescc/i386/as.scm
View file

@ -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
(guile-2)
(guile)
(mes
(mes-use-module (mes as))))
(define-module (mescc i386 as)
#:use-module (mes guile)
#:use-module (mescc 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
))
(define (i386:nop)
'(("nop")))

6
module/language/c99/info.mes → module/mescc/info.mes
View file

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

48
module/language/c99/info.scm → module/mescc/info.scm
View file

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

29
module/mes/bytevectors.scm → module/mescc/mescc.mes
View file

@ -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:
(define-module (mes bytevectors)
#:use-module (mes guile)
#:export (bytevector-u32-native-set!
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")
(mes-use-module (mes guile))
(mes-use-module (mescc preprocess))
(mes-use-module (mescc compile))
(mes-use-module (mescc M1))
(include-from-path "mescc/mescc.scm")

232
module/mescc/mescc.scm Normal file
View file

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

27
module/mescc/preprocess.mes Normal file
View file

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

87
module/mescc/preprocess.scm Normal file
View file

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

6
module/srfi/srfi-1.mes
View file

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

7
module/srfi/srfi-13.mes
View file

@ -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)))
(list->string (list-head (string->list s) (- length n)))))
((> n 0) ((compose list->string (lambda (o) (drop-right o n)) string->list) s))
(else (error "string-drop-right: not supported: n=" n))))
(define (string-delete pred s)

162
scripts/mescc
View file

@ -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 (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (mes misc)
#:use-module (mescc mescc)
#: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))
(guile-2
(define %scheme "guile")
(define-macro (mes-use-module . rest) #t)
(module-define! (resolve-module '(language c99 compiler)) '%prefix %prefix))
(define (set-port-encoding! port encoding) #t)
(mes-use-module (mes guile))
(mes-use-module (mes misc))
(mes-use-module (mes getopt-long))
(mes-use-module (mes display))
(mes-use-module (mescc mescc)))
(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 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 (mes M1))
(mes-use-module (srfi srfi-1))
(mes-use-module (srfi srfi-26))
(define-macro (mes-use-module . rest) #t)))
(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))
(g (single-char #\g))
(debug-info (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
-D DEFINE define DEFINE
-c preprocess, compile and assemble only; do not link
-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 '() '()))
(file (car files))
(file-name (car (string-split (basename file) #\.)))
(preprocess? (option-ref options 'E #f))
(compile? (option-ref options 'c #f))
(debug-info? (option-ref options 'g #f))
(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")
(options (acons 'prefix %prefix options))
(preprocess? (option-ref options 'preprocess #f))
(compile? (option-ref options 'compile #f))
(assemble? (option-ref options 'assemble #f))
(verbose? (option-ref options 'verbose (getenv "MES_DEBUG"))))
(when verbose?
(setenv "NYACC_TRACE" "yes")
(format (current-error-port) "options=~s\n" options)
(format (current-error-port) "output: ~a\n" out))
(if (and (pair? sources) (pair? objects)) (error "cannot mix source and object files:" files))
(with-output-to-file out
(lambda ()
(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))))))))))
(format (current-error-port) "options=~s\n" options))
(cond (preprocess? (mescc:preprocess options))
(compile? (mescc:compile options))
(assemble? (mescc:assemble options))
(else (mescc:link options)))))
'done