Compare commits
78 Commits
Author | SHA1 | Date |
---|---|---|
Jan Nieuwenhuizen | d6bd78ed8d | |
Jan Nieuwenhuizen | d9c46b75ae | |
Jan Nieuwenhuizen | 1425127012 | |
Jan Nieuwenhuizen | b4d18e646a | |
Jan Nieuwenhuizen | ddec5fc281 | |
Jan Nieuwenhuizen | 4441279bae | |
Jan Nieuwenhuizen | 41dfc1bbbe | |
Jan Nieuwenhuizen | 664df95190 | |
Jan Nieuwenhuizen | fec9fde0c9 | |
Jan Nieuwenhuizen | ef78835501 | |
Jan Nieuwenhuizen | 47b7fe2e38 | |
Jan Nieuwenhuizen | b76866f688 | |
Jan Nieuwenhuizen | 3c7266dff1 | |
Jan Nieuwenhuizen | 0761f6479e | |
Jan Nieuwenhuizen | 36e4de29e8 | |
Jan Nieuwenhuizen | ad9f78718f | |
Jan Nieuwenhuizen | b85db01e9b | |
Jan Nieuwenhuizen | 280b763ae8 | |
Jan Nieuwenhuizen | 4568b8434b | |
Jan Nieuwenhuizen | cf04774209 | |
Jan Nieuwenhuizen | 059fb2e27f | |
Jan Nieuwenhuizen | 216936e085 | |
Jan Nieuwenhuizen | 1d3d28dfbe | |
Jan Nieuwenhuizen | 938f425c71 | |
Jan Nieuwenhuizen | 5a3f28a069 | |
Jan Nieuwenhuizen | 5f987d12c2 | |
Jan Nieuwenhuizen | cd30bee788 | |
Jan Nieuwenhuizen | 23d4019d13 | |
Jan Nieuwenhuizen | 28190c53df | |
Jan Nieuwenhuizen | fc1db23dc8 | |
Jan Nieuwenhuizen | 213c89072f | |
Jan Nieuwenhuizen | 414a94f5f6 | |
Jan Nieuwenhuizen | 1e3e1f33bf | |
Jan Nieuwenhuizen | 72665f5bba | |
Jan Nieuwenhuizen | 38d014decd | |
Jan Nieuwenhuizen | bb6cdb6b54 | |
Jan Nieuwenhuizen | 4a31bcb06a | |
Jan Nieuwenhuizen | 47600095c3 | |
Jan Nieuwenhuizen | 3d4dbdef60 | |
Jan Nieuwenhuizen | cee0972566 | |
Jan Nieuwenhuizen | 24748f575a | |
Jan Nieuwenhuizen | b93fd30819 | |
Jan Nieuwenhuizen | 10a0ec8808 | |
Jan Nieuwenhuizen | 37cba9c93b | |
Jan Nieuwenhuizen | 9b32098573 | |
Jan Nieuwenhuizen | 554d1beeb2 | |
Jan Nieuwenhuizen | 42e6f43149 | |
Jan Nieuwenhuizen | d9199b3536 | |
Jan Nieuwenhuizen | 4e1f494d19 | |
Jan Nieuwenhuizen | 5c685ebd22 | |
Jan Nieuwenhuizen | 30c67ca3e0 | |
Jan Nieuwenhuizen | df2c9bf03f | |
Jan Nieuwenhuizen | 79cffa7d79 | |
Jan Nieuwenhuizen | 010901ca89 | |
Jan Nieuwenhuizen | d3fa0b4a1a | |
Jan Nieuwenhuizen | 8044674d00 | |
Jan Nieuwenhuizen | 08ef31c86b | |
Jan Nieuwenhuizen | 3dcc9879ab | |
Jan Nieuwenhuizen | 312099e5f3 | |
Jan Nieuwenhuizen | 99d890e340 | |
Jan Nieuwenhuizen | d9fb66a258 | |
Jan Nieuwenhuizen | 08452c7b26 | |
Jan Nieuwenhuizen | 049066edc7 | |
Jan Nieuwenhuizen | f8b70ff62e | |
Jan Nieuwenhuizen | b243af5499 | |
Jan Nieuwenhuizen | 47604479e2 | |
Jan Nieuwenhuizen | c3a1435714 | |
Jan Nieuwenhuizen | f0216ab20d | |
Jan Nieuwenhuizen | 18a9e37567 | |
Jan Nieuwenhuizen | 05d7b2cb16 | |
Jan Nieuwenhuizen | 06f7fb29ee | |
Peter De Wachter | 607b02c12c | |
Peter De Wachter | 58d184fc46 | |
Peter De Wachter | 3ec7c92094 | |
Peter De Wachter | ab69b899c4 | |
Peter De Wachter | 4d09caaed2 | |
Peter De Wachter | 74fcc8bff3 | |
Jan Nieuwenhuizen | 54f5a88ea1 |
|
@ -30,6 +30,7 @@
|
|||
*.mini-M1
|
||||
*.mini-guile
|
||||
*.mini-hex2
|
||||
*.a
|
||||
*.o
|
||||
*.seed-out
|
||||
*.stderr
|
||||
|
@ -37,6 +38,7 @@
|
|||
*.x86-out
|
||||
*.x86_64-mes-E
|
||||
*.x86_64-mes-S
|
||||
*.x86_64-mes-gcc-a
|
||||
*.x86_64-mes-gcc-o
|
||||
*.x86_64-mes-gcc-out
|
||||
*.x86_64-mes-gcc-stdout
|
||||
|
@ -75,16 +77,17 @@
|
|||
/doc/mescc.1
|
||||
/doc/version.texi
|
||||
|
||||
/config.status
|
||||
/pre-inst-env
|
||||
/build.sh
|
||||
/check.sh
|
||||
/install.sh
|
||||
/uninstall.sh
|
||||
/mes/module/mes/boot-0.scm
|
||||
/scripts/mescc
|
||||
/doc/images/gcc-mesboot-graph.png
|
||||
/GNUmakefile
|
||||
/build.sh
|
||||
/check.sh
|
||||
/install.sh
|
||||
/pre-inst-env
|
||||
/uninstall.sh
|
||||
/doc/images/gcc-mesboot-graph.eps
|
||||
/doc/images/gcc-mesboot-graph.pdf
|
||||
/doc/web/
|
||||
|
|
7
AUTHORS
7
AUTHORS
|
@ -18,6 +18,13 @@ scaffold/tests/98-fopen.c
|
|||
Han-Wen Nienhuys <hanwen@xs4all.nl>
|
||||
lib/string/memmem.c (_memmem, memmem)
|
||||
|
||||
Peter de Wachter
|
||||
Small fixes and additions to
|
||||
lib/x86-mes/x86.M1
|
||||
lib/x86_64-mes/x86_64.M1
|
||||
include/stdint.h
|
||||
module/mescc/compile.mes
|
||||
|
||||
rain1
|
||||
scaffold/tests/90-goto-var.c
|
||||
scaffold/tests/91-goto-array.c
|
||||
|
|
64
NEWS
64
NEWS
|
@ -10,6 +10,70 @@ Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
|||
|
||||
Please send Mes bug reports to bug-mes@gnu.org.
|
||||
|
||||
* Changes in 0.19 since 0.18
|
||||
** Core
|
||||
*** The build system has been simplified.
|
||||
*** Mes now prints a backtrace upon error.
|
||||
*** Performance has been improved 2-8 times, making Mes 2-10 times slower than Guile.
|
||||
*** Mes now supports a module type and uses a `boot-module'.
|
||||
*** Mes now supports a hash_table type.
|
||||
*** Mes now supports a struct type.
|
||||
*** Mes now supports building a %bootstrap-mes seed from Guix.
|
||||
** Language
|
||||
*** Records are now implemented using struct (WAS: vector).
|
||||
*** 44 new functions
|
||||
ceil,
|
||||
char-downcase,
|
||||
char-set-adjoin,
|
||||
char-set-complement,
|
||||
char-upcase,
|
||||
current-time,
|
||||
delete-file,
|
||||
dup,
|
||||
dup2,
|
||||
file-exists?,
|
||||
floor,
|
||||
frame-printer,
|
||||
get-internal-run-time,
|
||||
getcwd,
|
||||
gettimeofday,
|
||||
hash,
|
||||
hash-ref,
|
||||
hash-set!,
|
||||
hash-table-printer,
|
||||
hashq,
|
||||
hashq-get-handle,
|
||||
hashq-ref,
|
||||
hashq-set,
|
||||
inexact->exact,
|
||||
make-hash-table,
|
||||
make-stack,
|
||||
make-struct,
|
||||
module-define!,
|
||||
module-printer,
|
||||
module-ref,
|
||||
module-variable,
|
||||
read-line,
|
||||
round,
|
||||
stack-length,
|
||||
stack-ref,
|
||||
string-downcase,
|
||||
string-tokenize,
|
||||
string-upcase,
|
||||
struct-length,
|
||||
struct-ref,
|
||||
struct-set!
|
||||
struct-vtable,
|
||||
struct-vtable,
|
||||
with-error-to-file.
|
||||
** MesCC
|
||||
*** MesCC now supports compiling Bash.
|
||||
*** Assembly defines have been cleaned-up: duplicates deleted, missing added, wrong fixed.
|
||||
** Noteworthy bug fixes
|
||||
*** MesCC now supports the unary plus operator.
|
||||
*** MesCC now supports the `U' integer suffix.
|
||||
*** MesCC now comes with INTnn_MIN/MAX, UINTnn defines in stdint.h.
|
||||
*** MesCC now always exits non-zero when assembler or linker fail.
|
||||
* Changes in 0.18 since 0.17.1
|
||||
** Core
|
||||
*** Mes/MesCC now supports x86_64.
|
||||
|
|
|
@ -82,39 +82,21 @@ doc: build
|
|||
build:
|
||||
./build.sh
|
||||
|
||||
src/mes: build
|
||||
|
||||
gcc:
|
||||
${srcdest}build-aux/build-cc.sh
|
||||
|
||||
mes-gcc:
|
||||
${srcdest}build-aux/build-cc32.sh
|
||||
|
||||
x86_64-mes-gcc:
|
||||
${srcdest}build-aux/build-cc64.sh
|
||||
|
||||
mes-tcc:
|
||||
ifdef TCC
|
||||
CC32=$(TCC) ${srcdest}build-aux/build-cc32.sh
|
||||
else
|
||||
|
||||
$(warning skipping mes-tcc: no tcc)
|
||||
endif
|
||||
|
||||
mes:
|
||||
${srcdest}build-aux/build-mes.sh
|
||||
|
||||
x86_64-mes:
|
||||
${srcdest}build-aux/build-x86_64-mes.sh
|
||||
src/${program_prefix}mes: build
|
||||
|
||||
clean:
|
||||
git clean -dfx\
|
||||
-e .config.make\
|
||||
-e config.status\
|
||||
-e GNUmakefile\
|
||||
-e build.sh\
|
||||
-e check.sh\
|
||||
-e install.sh\
|
||||
-e pre-inst-env\
|
||||
-e uninstall.sh\
|
||||
-e pre-inst-env\
|
||||
-e scripts/mescc\
|
||||
-e "mes"/module/mes/boot-0.scm\
|
||||
|
||||
#
|
||||
|
||||
# Mes does not cache anything on the file system; therefore clean
|
||||
|
@ -151,30 +133,6 @@ install:
|
|||
uninstall:
|
||||
./uninstall.sh
|
||||
|
||||
seed: all-go gcc mes-gcc x86_64-mes-gcc mes-tcc
|
||||
cd $(MES_SEED) && git reset --hard HEAD
|
||||
$(MAKE) MES=guile MES_SEED= SEED=1 mes
|
||||
cp -v lib/x86-mes/*.S $(MES_SEED)/x86-mes
|
||||
cp -v src/mes.S $(MES_SEED)/x86-mes
|
||||
$(MAKE) MES=guile MES_SEED= SEED=1 x86_64-mes
|
||||
cp -v lib/x86_64-mes/*.S $(MES_SEED)/x86_64-mes
|
||||
cp -v src/mes.x86_64-mes-S $(MES_SEED)/x86_64-mes/mes.S
|
||||
MES=$(GUILE) GUILE=$(GUILE) SEED=1 MES_SEED= ${srcdest}build-aux/build-mes.sh
|
||||
MES=$(GUILE) GUILE=$(GUILE) SEED=1 MES_SEED= ${srcdest}build-aux/build-x86_64-mes.sh
|
||||
cd $(MES_SEED) && MES_PREFIX=$(PWD) ./refresh.sh
|
||||
MES=$(GUILE) GUILE=$(GUILE) SEED=1 ${srcdest}build-aux/build-mes.sh
|
||||
cd $(MES_SEED) && MES_PREFIX=$(PWD) arch=x86_64-mes ./refresh.sh
|
||||
MES=$(GUILE) GUILE=$(GUILE) SEED=1 ${srcdest}build-aux/build-x86_64-mes.sh
|
||||
cp lib/x86-mes/libc+tcc.S\
|
||||
lib/x86-mes/libc.S\
|
||||
lib/x86-mes/crt1.S\
|
||||
lib/x86-mes/libgetopt.S\
|
||||
$(MESCC_TOOLS_SEED)/libs
|
||||
cd $(MESCC_TOOLS_SEED) && MES_PREFIX=$(PWD) ./bootstrap.sh
|
||||
ifdef TCC
|
||||
cd $(TINYCC_SEED) && MES_PREFIX=$(PWD) ./refresh.sh
|
||||
endif
|
||||
|
||||
doc/version.texi: ${srcdest}doc/mes.texi GNUmakefile
|
||||
@mkdir -p $(@D)
|
||||
(set `LANG= date -r $< +'%d %B %Y'`;\
|
||||
|
@ -234,10 +192,10 @@ man: doc/mes.1 doc/mescc.1
|
|||
%: %.o
|
||||
%: %.c
|
||||
|
||||
doc/mes.1: src/mes | build
|
||||
doc/mes.1: src/${program_prefix}mes | build
|
||||
MES_ARENA=10000000 ./pre-inst-env $(HELP2MAN) $(<F) > $@
|
||||
|
||||
doc/mescc.1: scripts/mescc src/mes | build
|
||||
doc/mescc.1: scripts/mescc src/${program_prefix}mes | build
|
||||
MES_ARENA=10000000 ./pre-inst-env $(HELP2MAN) $(<F) > $@
|
||||
|
||||
html: doc/html/index.html
|
||||
|
@ -320,7 +278,7 @@ tag:
|
|||
git tag -s v$(VERSION) -m "GNU Mes $(VERSION)."
|
||||
|
||||
# Release process
|
||||
# 0. doc: Release update, Release commit, make seed, test guix bootstrap
|
||||
# 0. doc: Release update, Release commit, test guix bootstrap
|
||||
# 1. make tag
|
||||
# 2. make dist
|
||||
# 3. make release
|
||||
|
@ -376,12 +334,8 @@ Usage: make [OPTION]... [TARGET]...
|
|||
Main and non-standard targets:
|
||||
all update everything
|
||||
all-go update .go files
|
||||
gcc update src/mes.gcc-out
|
||||
dist update $(TARBALL)
|
||||
doc update documentation
|
||||
mes-gcc update src/mes.mes-gcc-out
|
||||
mes-tcc update src/mes.mes-tcc-out
|
||||
mes update src/mes
|
||||
check run unit tests
|
||||
clean run git clean -dfx
|
||||
clean-go clean .go files
|
||||
|
@ -389,7 +343,6 @@ Main and non-standard targets:
|
|||
install install in $(prefix)
|
||||
install-info install info docs in $(prefix)/share/info
|
||||
release dist and tag
|
||||
seed update mes-seed in $(MES_SEED)
|
||||
uninstall uninstall from $(prefix)
|
||||
endef
|
||||
export HELP_TOP
|
||||
|
|
|
@ -0,0 +1,101 @@
|
|||
#! /bin/sh
|
||||
|
||||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
# GNU Mes is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Mes is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
. ./config.status
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
set -e
|
||||
|
||||
# FIXME?
|
||||
#mes_program_prefix=boot-$arch-
|
||||
mes_program_prefix=$program_prefix
|
||||
trace "HEX2 0exit-42" $HEX2\
|
||||
$HEX2FLAGS\
|
||||
-f ${srcdest}lib/$mes_arch/elf$bits-0header.hex2\
|
||||
-f ${srcdest}lib/$mes_arch/elf$bits-body-exit-42.hex2\
|
||||
-f ${srcdest}lib/$mes_arch/elf-0footer.hex2\
|
||||
--exec_enable\
|
||||
-o lib/$mes_arch/${mes_program_prefix}0exit-42
|
||||
|
||||
trace "TEST lib/$mes_arch/${mes_program_prefix}0exit-42" echo lib/$mes_arch/${mes_program_prefix}0exit-42
|
||||
{ set +e; lib/$mes_arch/${mes_program_prefix}0exit-42; r=$?; set -e; }
|
||||
[ $r != 42 ] && echo " => $r" && exit 1
|
||||
|
||||
trace "HEX2 exit-42" $HEX2\
|
||||
$HEX2FLAGS\
|
||||
-f ${srcdest}lib/$mes_arch/elf$bits-header.hex2\
|
||||
-f ${srcdest}lib/$mes_arch/elf$bits-body-exit-42.hex2\
|
||||
-f ${srcdest}lib/$mes_arch/elf$bits-footer-single-main.hex2\
|
||||
--exec_enable\
|
||||
-o lib/$mes_arch/${mes_program_prefix}exit-42
|
||||
|
||||
trace "TEST lib/$mes_arch/${mes_program_prefix}exit-42" echo lib/$mes_arch/${mes_program_prefix}exit-42
|
||||
{ set +e; lib/$mes_arch/${mes_program_prefix}exit-42; r=$?; set -e; }
|
||||
[ $r != 42 ] && echo " => $r" && exit 1
|
||||
|
||||
|
||||
mkdir -p lib/$mes_arch
|
||||
trace "M1 crt1.S" $M1\
|
||||
$M1FLAGS\
|
||||
-f ${srcdest}lib/$mes_arch/$arch.M1\
|
||||
-f $MES_SEED/$mes_arch/crt1.S\
|
||||
-o lib/$mes_arch/crt1.o
|
||||
trace "M1 libc.S" $M1\
|
||||
$M1FLAGS\
|
||||
-f ${srcdest}lib/$mes_arch/$arch.M1\
|
||||
-f $MES_SEED/$mes_arch/libc.S\
|
||||
-o lib/$mes_arch/libc.o
|
||||
trace "M1 mes.S" $M1\
|
||||
--LittleEndian\
|
||||
--Architecture 1\
|
||||
-f ${srcdest}lib/$mes_arch/$arch.M1\
|
||||
-f $MES_SEED/$mes_arch/mes.S\
|
||||
-o src/mes.o
|
||||
trace "BLOOD_ELF mes.S" $BLOOD_ELF\
|
||||
-f ${srcdest}lib/$mes_arch/$arch.M1\
|
||||
-f $MES_SEED/$mes_arch/mes.S\
|
||||
-f $MES_SEED/$mes_arch/libc.S\
|
||||
-o src/mes.S.blood-elf
|
||||
trace "M1 mes.blood-elf" $M1\
|
||||
--LittleEndian\
|
||||
--Architecture 1\
|
||||
-f src/mes.S.blood-elf\
|
||||
-o src/mes.o.blood-elf
|
||||
trace "HEX2 mes.o" $HEX2\
|
||||
$HEX2FLAGS\
|
||||
-f ${srcdest}lib/$mes_arch/elf$bits-header.hex2\
|
||||
-f lib/$mes_arch/crt1.o\
|
||||
-f lib/$mes_arch/libc.o\
|
||||
-f src/mes.o\
|
||||
-f src/mes.o.blood-elf\
|
||||
--exec_enable\
|
||||
-o src/${mes_program_prefix}mes
|
||||
#cp src/${mes_program_prefix}mes src/${program_prefix}mes
|
||||
trace "M1 libc+tcc.S" $M1\
|
||||
$M1FLAGS\
|
||||
-f ${srcdest}lib/$mes_arch/$arch.M1\
|
||||
-f $MES_SEED/$mes_arch/libc+tcc.S\
|
||||
-o lib/$mes_arch/libc+tcc.o
|
||||
trace "M1 libc+gnu.S" $M1\
|
||||
$M1FLAGS\
|
||||
-f ${srcdest}lib/$mes_arch/$arch.M1\
|
||||
-f $MES_SEED/$mes_arch/libc+gnu.S\
|
||||
-o lib/$mes_arch/libc+gnu.o
|
|
@ -1,37 +0,0 @@
|
|||
#! /bin/sh
|
||||
|
||||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
# GNU Mes is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Mes is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
# native
|
||||
trace "SNARF gc.c" ${srcdest}build-aux/mes-snarf.scm src/gc.c
|
||||
trace "SNARF lib.c" ${srcdest}build-aux/mes-snarf.scm src/lib.c
|
||||
trace "SNARF math.c" ${srcdest}build-aux/mes-snarf.scm src/math.c
|
||||
trace "SNARF mes.c" ${srcdest}build-aux/mes-snarf.scm src/mes.c
|
||||
trace "SNARF posix.c" ${srcdest}build-aux/mes-snarf.scm src/posix.c
|
||||
trace "SNARF reader.c" ${srcdest}build-aux/mes-snarf.scm src/reader.c
|
||||
trace "SNARF vector.c" ${srcdest}build-aux/mes-snarf.scm src/vector.c
|
||||
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc.sh lib/libmes
|
||||
sh ${srcdest}build-aux/cc.sh src/mes
|
||||
cp src/mes.gcc-out src/mes
|
|
@ -1,75 +0,0 @@
|
|||
#! /bin/sh
|
||||
|
||||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
# GNU Mes is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Mes is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
LIBC=${LIBC-c}
|
||||
|
||||
##moduledir=${moduledir-${datadir}${datadir:+/}module}
|
||||
|
||||
# native
|
||||
# trace "SNARF gc.c" ${srcdest}build-aux/mes-snarf.scm src/gc.c
|
||||
# trace "SNARF lib.c" ${srcdest}build-aux/mes-snarf.scm src/lib.c
|
||||
# trace "SNARF math.c" ${srcdest}build-aux/mes-snarf.scm src/math.c
|
||||
# trace "SNARF mes.c" ${srcdest}build-aux/mes-snarf.scm src/mes.c
|
||||
# trace "SNARF posix.c" ${srcdest}build-aux/mes-snarf.scm src/posix.c
|
||||
# trace "SNARF reader.c" ${srcdest}build-aux/mes-snarf.scm src/reader.c
|
||||
# trace "SNARF vector.c" ${srcdest}build-aux/mes-snarf.scm src/vector.c
|
||||
|
||||
# cc32-mes
|
||||
trace "SNARF.mes gc.c" ${srcdest}build-aux/mes-snarf.scm --mes src/gc.c
|
||||
trace "SNARF.mes lib.c" ${srcdest}build-aux/mes-snarf.scm --mes src/lib.c
|
||||
trace "SNARF.mes math.c" ${srcdest}build-aux/mes-snarf.scm --mes src/math.c
|
||||
trace "SNARF.mes mes.c" ${srcdest}build-aux/mes-snarf.scm --mes src/mes.c
|
||||
trace "SNARF.mes posix.c" ${srcdest}build-aux/mes-snarf.scm --mes src/posix.c
|
||||
trace "SNARF.mes reader.c" ${srcdest}build-aux/mes-snarf.scm --mes src/reader.c
|
||||
trace "SNARF.mes vector.c" ${srcdest}build-aux/mes-snarf.scm --mes src/vector.c
|
||||
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/linux/x86-mes-gcc/crt0
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/linux/x86-mes-gcc/crt1
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/linux/x86-mes-gcc/crti
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/linux/x86-mes-gcc/crtn
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc-mini
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc+tcc
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libtcc1
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libc+gnu
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libg
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc32-mes.sh lib/libgetopt
|
||||
|
||||
LIBC= sh ${srcdest}build-aux/cc32-mes.sh scaffold/main
|
||||
LIBC=c-mini sh ${srcdest}build-aux/cc32-mes.sh scaffold/hello
|
||||
LIBC=c-mini sh ${srcdest}build-aux/cc32-mes.sh scaffold/argv
|
||||
sh ${srcdest}build-aux/cc32-mes.sh scaffold/read
|
||||
sh ${srcdest}build-aux/cc32-mes.sh scaffold/malloc
|
||||
sh ${srcdest}build-aux/cc32-mes.sh scaffold/micro-mes
|
||||
sh ${srcdest}build-aux/cc32-mes.sh scaffold/tiny-mes
|
||||
sh ${srcdest}build-aux/cc32-mes.sh scaffold/mini-mes
|
||||
|
||||
sh ${srcdest}build-aux/cc32-mes.sh src/mes
|
||||
|
||||
if [ "$CC32" = "$TCC" ]; then
|
||||
cp src/mes.mes-tcc-out src/mes
|
||||
else
|
||||
cp src/mes.mes-gcc-out src/mes
|
||||
fi
|
|
@ -1,60 +0,0 @@
|
|||
#! /bin/sh
|
||||
|
||||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
# GNU Mes is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Mes is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
LIBC=${LIBC-c}
|
||||
|
||||
# cc64-mes
|
||||
trace "SNARF.mes gc.c" ${srcdest}build-aux/mes-snarf.scm --mes src/gc.c
|
||||
trace "SNARF.mes lib.c" ${srcdest}build-aux/mes-snarf.scm --mes src/lib.c
|
||||
trace "SNARF.mes math.c" ${srcdest}build-aux/mes-snarf.scm --mes src/math.c
|
||||
trace "SNARF.mes mes.c" ${srcdest}build-aux/mes-snarf.scm --mes src/mes.c
|
||||
trace "SNARF.mes posix.c" ${srcdest}build-aux/mes-snarf.scm --mes src/posix.c
|
||||
trace "SNARF.mes reader.c" ${srcdest}build-aux/mes-snarf.scm --mes src/reader.c
|
||||
trace "SNARF.mes vector.c" ${srcdest}build-aux/mes-snarf.scm --mes src/vector.c
|
||||
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/linux/x86_64-mes-gcc/crt0
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/linux/x86_64-mes-gcc/crt1
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/linux/x86_64-mes-gcc/crti
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/linux/x86_64-mes-gcc/crtn
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc-mini
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc+tcc
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libtcc1
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libc+gnu
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libg
|
||||
ARCHDIR=1 NOLINK=1 sh ${srcdest}build-aux/cc64-mes.sh lib/libgetopt
|
||||
|
||||
LIBC= sh ${srcdest}build-aux/cc64-mes.sh scaffold/main
|
||||
LIBC=c-mini sh ${srcdest}build-aux/cc64-mes.sh scaffold/hello
|
||||
LIBC=c-mini sh ${srcdest}build-aux/cc64-mes.sh scaffold/argv
|
||||
sh ${srcdest}build-aux/cc64-mes.sh scaffold/read
|
||||
sh ${srcdest}build-aux/cc64-mes.sh scaffold/malloc
|
||||
sh ${srcdest}build-aux/cc64-mes.sh scaffold/micro-mes
|
||||
sh ${srcdest}build-aux/cc64-mes.sh scaffold/tiny-mes
|
||||
# sh ${srcdest}build-aux/cc64-mes.sh scaffold/cons-mes
|
||||
sh ${srcdest}build-aux/cc64-mes.sh scaffold/mini-mes
|
||||
|
||||
sh ${srcdest}build-aux/cc64-mes.sh src/mes
|
||||
cp src/mes.x86_64-mes-gcc-out src/mes
|
|
@ -18,12 +18,12 @@
|
|||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
if [ ! "$config_status" ]; then
|
||||
. ./config.status
|
||||
fi
|
||||
|
||||
export GUILE
|
||||
export GUILE_AUTO_COMPILE
|
||||
GUILE=${GUILE-$(command -v guile)}
|
||||
GUILE_TOOLS=${GUILE_TOOLS-$(command -v guile-tools)}
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
GUILE_AUTO_COMPILE=0
|
||||
|
||||
set -e
|
||||
|
@ -58,12 +58,10 @@ if [ "$GUILE_EFFECTIVE_VERSION" = "2.0" ]; then
|
|||
srcdest=$abs_top_srcdir/
|
||||
fi
|
||||
|
||||
GUILE_AUTO_COMPILE=0
|
||||
|
||||
for i in $SCM_FILES $SCRIPTS; do
|
||||
b=$(basename $i)
|
||||
go=${i%%.scm}.go
|
||||
if [ $i -nt $go ]; then
|
||||
trace "GUILEC $b" $GUILE_TOOLS compile -L ${srcdest}module -L ${srcdest}build-aux -L ${srcdest}scripts -o $go $i
|
||||
trace "GUILEC $b" $GUILD compile -L ${srcdest}module -L ${srcdest}build-aux -L ${srcdest}scripts -o $go $i
|
||||
fi
|
||||
done
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
#! /bin/sh
|
||||
|
||||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
|
@ -18,140 +18,65 @@
|
|||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
GUILE=${GUILE-guile}
|
||||
if [ -z "$GUILE" -o "$GUILE" = "true" ] || ! command -v $GUILE > /dev/null; then
|
||||
GUILE=src/mes
|
||||
fi
|
||||
|
||||
[ -z "$MESCC" ] && MESCC=scripts/mescc
|
||||
MES=${MES-$(command -v mes)}
|
||||
[ -z "$MES" ] && MES=src/mes
|
||||
|
||||
set -e
|
||||
|
||||
trace "HEX2 0exit-42" $HEX2\
|
||||
--LittleEndian\
|
||||
--Architecture 1\
|
||||
--BaseAddress 0x1000000\
|
||||
-f ${srcdest}lib/x86-mes/elf32-0header.hex2\
|
||||
-f ${srcdest}lib/x86-mes/elf32-body-exit-42.hex2\
|
||||
-f ${srcdest}lib/x86-mes/elf-0footer.hex2\
|
||||
--exec_enable\
|
||||
-o lib/x86-mes/0exit-42.x86-out
|
||||
|
||||
trace "TEST lib/x86-mes/0exit-42.x86-out" echo lib/x86-mes/0exit-42.x86-out
|
||||
{ set +e; lib/x86-mes/0exit-42.x86-out; r=$?; set -e; }
|
||||
[ $r != 42 ] && echo " => $r" && exit 1
|
||||
|
||||
trace "HEX2 0exit-42" $HEX2\
|
||||
--LittleEndian\
|
||||
--Architecture 1\
|
||||
--BaseAddress 0x1000000\
|
||||
-f ${srcdest}lib/x86-mes/elf32-header.hex2\
|
||||
-f ${srcdest}lib/x86-mes/elf32-body-exit-42.hex2\
|
||||
-f ${srcdest}lib/x86-mes/elf32-footer-single-main.hex2\
|
||||
--exec_enable\
|
||||
-o lib/x86-mes/exit-42.x86-out
|
||||
|
||||
trace "TEST lib/x86-mes/exit-42.x86-out" echo lib/x86-mes/exit-42.x86-out
|
||||
{ set +e; lib/x86-mes/exit-42.x86-out; r=$?; set -e; }
|
||||
[ $r != 42 ] && echo " => $r" && exit 1
|
||||
|
||||
if [ -d "$MES_SEED" ]; then
|
||||
mkdir -p lib/x86-mes
|
||||
trace "M1 crt1.S" $M1\
|
||||
$M1FLAGS\
|
||||
-f ${srcdest}lib/x86-mes/x86.M1\
|
||||
-f $MES_SEED/x86-mes/crt1.S\
|
||||
-o lib/x86-mes/crt1.o
|
||||
trace "M1 libc.S" $M1\
|
||||
$M1FLAGS\
|
||||
-f ${srcdest}lib/x86-mes/x86.M1\
|
||||
-f $MES_SEED/x86-mes/libc.S\
|
||||
-o lib/x86-mes/libc.o
|
||||
trace "M1 mes.S" $M1\
|
||||
--LittleEndian\
|
||||
--Architecture 1\
|
||||
-f ${srcdest}lib/x86-mes/x86.M1\
|
||||
-f $MES_SEED/x86-mes/mes.S\
|
||||
-o src/mes.o
|
||||
trace "BLOOD_ELF mes.S" $BLOOD_ELF\
|
||||
-f ${srcdest}lib/x86-mes/x86.M1\
|
||||
-f $MES_SEED/x86-mes/mes.S\
|
||||
-f $MES_SEED/x86-mes/libc.S\
|
||||
-o src/mes.S.blood-elf
|
||||
trace "M1 mes.blood-elf" $M1\
|
||||
--LittleEndian\
|
||||
--Architecture 1\
|
||||
-f src/mes.S.blood-elf\
|
||||
-o src/mes.o.blood-elf
|
||||
trace "HEX2 mes.o" $HEX2\
|
||||
$HEX2FLAGS\
|
||||
-f ${srcdest}lib/x86-mes/elf32-header.hex2\
|
||||
-f lib/x86-mes/crt1.o\
|
||||
-f lib/x86-mes/libc.o\
|
||||
-f src/mes.o\
|
||||
-f src/mes.o.blood-elf\
|
||||
--exec_enable\
|
||||
-o src/mes.seed-out
|
||||
cp src/mes.seed-out src/mes
|
||||
trace "M1 libc+tcc.S" $M1\
|
||||
$M1FLAGS\
|
||||
-f ${srcdest}lib/x86-mes/x86.M1\
|
||||
-f $MES_SEED/x86-mes/libc+tcc.S\
|
||||
-o lib/x86-mes/libc+tcc.o
|
||||
if [ ! "$config_status" ]; then
|
||||
. ./config.status
|
||||
fi
|
||||
|
||||
PREPROCESS=1
|
||||
if [ ! -d "$MES_SEED" ] \
|
||||
&& [ "$arch" = "i386" \
|
||||
-o "$arch" = "i586" \
|
||||
-o "$arch" = "i686" ]; then
|
||||
MES_ARENA=100000000
|
||||
fi
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
. ${srcdest}build-aux/cc.sh
|
||||
|
||||
MES_ARENA=100000000
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/linux/x86-mes/crt1
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc-mini
|
||||
MES_LIBS='-l c-mini' PREPROCESS= bash ${srcdest}build-aux/cc-mes.sh lib/x86-mes/exit-42
|
||||
[ "$mes_p" ] && (program_prefix= compile lib/linux/$mes_arch/crt1)
|
||||
[ "$mes_p" -a ! "$gcc_p" ] && cp -f lib/linux/$mes_arch/crt1.S lib/$mes_arch/crt1.S
|
||||
[ "$mes_p" -a ! "$gcc_p" ] && cp -f lib/linux/$mes_arch/crt1.o lib/$mes_arch/crt1.o
|
||||
|
||||
trace "TEST lib/x86-mes/exit-42.mes-out" echo lib/x86-mes/exit-42.mes-out
|
||||
{ set +e; lib/x86-mes/exit-42.mes-out; r=$?; set -e; }
|
||||
[ $r != 42 ] && echo " => $r" && exit 1
|
||||
[ ! "$mesc_p" -a ! "$posix_p" ] && (program_prefix= compile lib/linux/$mes_arch/crt0)
|
||||
[ "$mes_p" -a "$gcc_p" ] && (program_prefix= compile lib/linux/$mes_arch/crti)
|
||||
[ "$mes_p" -a "$gcc_p" ] && (program_prefix= compile lib/linux/$mes_arch/crtn)
|
||||
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc+tcc
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libc+gnu
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-mes.sh lib/libgetopt
|
||||
[ ! "$mes_p" -a ! "$mesc_p" ] && compile lib/libmes
|
||||
[ ! "$mes_p" -a ! "$mesc_p" ] && archive lib/libmes
|
||||
|
||||
MES_ARENA=${MES_ARENA-100000000}
|
||||
trace "SNARF.mes gc.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/gc.c
|
||||
trace "SNARF.mes lib.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/lib.c
|
||||
trace "SNARF.mes math.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/math.c
|
||||
trace "SNARF.mes mes.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/mes.c
|
||||
trace "SNARF.mes posix.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/posix.c
|
||||
trace "SNARF.mes reader.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/reader.c
|
||||
trace "SNARF.mes vector.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/vector.c
|
||||
[ "$mes_p" ] && compile lib/libc-mini
|
||||
[ "$mes_p" ] && archive lib/libc-mini
|
||||
|
||||
if [ -n "$SEED" ]; then
|
||||
bash ${srcdest}build-aux/cc-mes.sh src/mes
|
||||
exit 0
|
||||
fi
|
||||
[ "$mes_p" ] && compile lib/libc
|
||||
[ "$mes_p" ] && archive lib/libc
|
||||
|
||||
MES_LIBS='-l none' bash ${srcdest}build-aux/cc-mes.sh scaffold/main
|
||||
[ "$mes_p" ] && compile lib/libc+tcc
|
||||
[ "$mes_p" ] && archive lib/libc+tcc
|
||||
|
||||
trace "TEST scaffold/main.mes-out" echo scaffold/main.mes-out
|
||||
{ set +e; scaffold/main.mes-out; r=$?; set -e; }
|
||||
[ $r != 42 ] && echo " => $r" && exit 1
|
||||
[ "$mes_p" ] && compile lib/libc+gnu
|
||||
[ "$mes_p" ] && archive lib/libc+gnu
|
||||
|
||||
MES_LIBS='-l c-mini' bash ${srcdest}build-aux/cc-mes.sh scaffold/hello
|
||||
MES_LIBS='-l c-mini' bash ${srcdest}build-aux/cc-mes.sh scaffold/argv
|
||||
bash ${srcdest}build-aux/cc-mes.sh scaffold/malloc
|
||||
##sh ${srcdest}build-aux/cc-mes.sh scaffold/micro-mes
|
||||
##sh ${srcdest}build-aux/cc-mes.sh scaffold/tiny-mes
|
||||
# bash ${srcdest}build-aux/cc-mes.sh scaffold/mini-mes
|
||||
bash ${srcdest}build-aux/cc-mes.sh src/mes
|
||||
cp src/mes.mes-out src/mes
|
||||
[ "$mes_p" -a ! "$mesc_p" ] && compile lib/libtcc1
|
||||
[ "$mes_p" -a ! "$mesc_p" ] && archive lib/libtcc1
|
||||
|
||||
[ "$mes_p" -a ! "$mesc_p" ] && compile lib/libg
|
||||
[ "$mes_p" -a ! "$mesc_p" ] && archive lib/libg
|
||||
|
||||
[ "$mes_p" -a ! "$mesc_p" ] && compile lib/libgetopt
|
||||
[ "$mes_p" -a ! "$mesc_p" ] && archive lib/libgetopt
|
||||
|
||||
compile scaffold/main
|
||||
(libc= link scaffold/main)
|
||||
|
||||
compile scaffold/hello
|
||||
(libc="-l c-mini" link scaffold/hello)
|
||||
|
||||
compile scaffold/argv
|
||||
(libc="-l c-mini" link scaffold/argv)
|
||||
|
||||
[ "$mes_p" ] && compile scaffold/malloc
|
||||
[ "$mes_p" ] && link scaffold/malloc
|
||||
[ "$mes_p" ] && compile scaffold/micro-mes
|
||||
[ "$mes_p" ] && link scaffold/micro-mes
|
||||
[ "$mes_p" ] && compile scaffold/tiny-mes
|
||||
[ "$mes_p" ] && link scaffold/tiny-mes
|
||||
[ "$mes_p" ] && compile scaffold/mini-mes
|
||||
[ "$mes_p" ] && link scaffold/mini-mes
|
||||
|
||||
compile src/mes
|
||||
link src/mes
|
||||
|
|
|
@ -1,153 +0,0 @@
|
|||
#! /bin/sh
|
||||
|
||||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
# GNU Mes is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Mes is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
GUILE=${GUILE-guile}
|
||||
if [ -z "$GUILE" -o "$GUILE" = "true" ] || ! command -v $GUILE > /dev/null; then
|
||||
GUILE=src/mes
|
||||
fi
|
||||
|
||||
[ -z "$MESCC" ] && MESCC=scripts/mescc
|
||||
MES=${MES-$(command -v mes)}
|
||||
[ -z "$MES" ] && MES=src/mes
|
||||
|
||||
set -e
|
||||
|
||||
trace "HEX2 0exit-42" $HEX2\
|
||||
--LittleEndian\
|
||||
--Architecture 2\
|
||||
--BaseAddress 0x1000000\
|
||||
-f ${srcdest}lib/x86_64-mes/elf64-0header.hex2\
|
||||
-f ${srcdest}lib/x86_64-mes/elf64-body-exit-42.hex2\
|
||||
-f ${srcdest}lib/x86_64-mes/elf-0footer.hex2\
|
||||
--exec_enable\
|
||||
-o lib/x86_64-mes/0exit-42.x86_64-out
|
||||
|
||||
trace "TEST lib/x86_64-mes/0exit-42.x86_64-out" echo lib/x86_64-mes/0exit-42.x86_64-out
|
||||
{ set +e; lib/x86_64-mes/0exit-42.x86_64-out; r=$?; set -e; }
|
||||
[ $r != 42 ] && echo " => $r" && exit 1
|
||||
|
||||
trace "HEX2 0exit-42" $HEX2\
|
||||
--LittleEndian\
|
||||
--Architecture 2\
|
||||
--BaseAddress 0x1000000\
|
||||
-f ${srcdest}lib/x86_64-mes/elf64-header.hex2\
|
||||
-f ${srcdest}lib/x86_64-mes/elf64-body-exit-42.hex2\
|
||||
-f ${srcdest}lib/x86_64-mes/elf64-footer-single-main.hex2\
|
||||
--exec_enable\
|
||||
-o lib/x86_64-mes/exit-42.x86_64-out
|
||||
|
||||
trace "TEST lib/x86_64-mes/exit-42.x86_64-out" echo lib/x86_64-mes/exit-42.x86_64-out
|
||||
{ set +e; lib/x86_64-mes/exit-42.x86_64-out; r=$?; set -e; }
|
||||
[ $r != 42 ] && echo " => $r" && exit 1
|
||||
|
||||
if [ -d "$MES_SEED" ]; then
|
||||
mkdir -p lib/x86_64-mes
|
||||
trace "M1 crt1.S" $M1\
|
||||
$M1FLAGS\
|
||||
-f ${srcdest}lib/x86_64-mes/x86_64.M1\
|
||||
-f $MES_SEED/x86_64-mes/crt1.S\
|
||||
-o lib/x86_64-mes/crt1.o
|
||||
trace "M1 libc.S" $M1\
|
||||
$M1FLAGS\
|
||||
-f ${srcdest}lib/x86_64-mes/x86_64.M1\
|
||||
-f $MES_SEED/x86_64-mes/libc.S\
|
||||
-o lib/x86_64-mes/libc.o
|
||||
trace "M1 mes.S" $M1\
|
||||
--LittleEndian\
|
||||
--Architecture 2\
|
||||
-f ${srcdest}lib/x86_64-mes/x86_64.M1\
|
||||
-f $MES_SEED/x86_64-mes/mes.S\
|
||||
-o src/mes.o
|
||||
trace "BLOOD_ELF mes.S" $BLOOD_ELF\
|
||||
-f ${srcdest}lib/x86_64-mes/x86_64.M1\
|
||||
-f $MES_SEED/x86_64-mes/mes.S\
|
||||
-f $MES_SEED/x86_64-mes/libc.S\
|
||||
-o src/mes.S.blood-elf
|
||||
trace "M1 mes.blood-elf" $M1\
|
||||
--LittleEndian\
|
||||
--Architecture 2\
|
||||
-f src/mes.S.blood-elf\
|
||||
-o src/mes.o.blood-elf
|
||||
trace "HEX2 mes.o" $HEX2\
|
||||
$HEX2FLAGS\
|
||||
-f ${srcdest}lib/x86_64-mes/elf64-header.hex2\
|
||||
-f lib/x86_64-mes/crt1.o\
|
||||
-f lib/x86_64-mes/libc.o\
|
||||
-f src/mes.o\
|
||||
-f src/mes.o.blood-elf\
|
||||
--exec_enable\
|
||||
-o src/mes.seed-out
|
||||
cp src/mes.seed-out src/mes
|
||||
trace "M1 libc+tcc.S" $M1\
|
||||
$M1FLAGS\
|
||||
-f ${srcdest}lib/x86_64-mes/x86_64.M1\
|
||||
-f $MES_SEED/x86_64-mes/libc+tcc.S\
|
||||
-o lib/x86_64-mes/libc+tcc.o
|
||||
fi
|
||||
|
||||
|
||||
PREPROCESS=1
|
||||
MES_ARENA=100000000
|
||||
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/linux/x86_64-mes/crt1
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc-mini
|
||||
MES_LIBS='-l c-mini' PREPROCESS= bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/x86_64-mes/exit-42
|
||||
|
||||
trace "TEST lib/x86_64-mes/exit-42.x86_64-mes-out" echo lib/x86_64-mes/exit-42.x86_64-mes-out
|
||||
{ set +e; lib/x86_64-mes/exit-42.x86_64-mes-out; r=$?; set -e; }
|
||||
[ $r != 42 ] && echo " => $r" && exit 1
|
||||
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc+tcc
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libc+gnu
|
||||
ARCHDIR=1 NOLINK=1 bash ${srcdest}build-aux/cc-x86_64-mes.sh lib/libgetopt
|
||||
|
||||
MES_ARENA=${MES_ARENA-100000000}
|
||||
trace "SNARF.mes gc.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/gc.c
|
||||
trace "SNARF.mes lib.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/lib.c
|
||||
trace "SNARF.mes math.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/math.c
|
||||
trace "SNARF.mes mes.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/mes.c
|
||||
trace "SNARF.mes posix.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/posix.c
|
||||
trace "SNARF.mes reader.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/reader.c
|
||||
trace "SNARF.mes vector.c" ./pre-inst-env bash ${srcdest}build-aux/mes-snarf.scm --mes src/vector.c
|
||||
|
||||
if [ -n "$SEED" ]; then
|
||||
bash ${srcdest}build-aux/cc-mes.sh src/mes
|
||||
exit 0
|
||||
fi
|
||||
|
||||
MES_LIBS='-l none' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/main
|
||||
|
||||
trace "TEST scaffold/main.x86_64-mes-out" echo scaffold/main.x86_64-mes-out
|
||||
{ set +e; scaffold/main.x86_64-mes-out; r=$?; set -e; }
|
||||
[ $r != 42 ] && echo " => $r" && exit 1
|
||||
|
||||
MES_LIBS='-l c-mini' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/hello
|
||||
MES_LIBS='-l c-mini' bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/argv
|
||||
bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/malloc
|
||||
sh ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/micro-mes
|
||||
sh ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/tiny-mes
|
||||
bash ${srcdest}build-aux/cc-x86_64-mes.sh scaffold/mini-mes
|
||||
bash ${srcdest}build-aux/cc-x86_64-mes.sh src/mes
|
||||
# not yet, broken
|
||||
# cp src/mes.x86_64-mes-out src/mes
|
|
@ -1,7 +1,7 @@
|
|||
#! @BASH@
|
||||
#! /bin/sh
|
||||
|
||||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
|
@ -18,42 +18,43 @@
|
|||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
srcdest="@srcdest@"
|
||||
srcdir="@srcdir@"
|
||||
abs_top_srcdir="@abs_top_srcdir@"
|
||||
abs_top_builddir="@abs_top_builddir@"
|
||||
prefix=${prefix-@prefix@}
|
||||
VERSION=${VERSION-@VERSION@}
|
||||
arch=${arch-@arch@}
|
||||
set -e
|
||||
|
||||
. ./config.status
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
MES_SEED=${MES_SEED-../mes-seed}
|
||||
GUILE=${GUILE-$(command -v guile)}
|
||||
MES_ARENA=${MES_ARENA-100000000}
|
||||
|
||||
if [ -n "$GUILE" -a "$GUILE" != true ]; then
|
||||
sh ${srcdest}build-aux/build-guile.sh
|
||||
fi
|
||||
|
||||
if [ -n "$CC" ]; then
|
||||
sh ${srcdest}build-aux/build-cc.sh
|
||||
if [ ! "$mes_p" ]; then
|
||||
sh ${srcdest}build-aux/snarf.sh
|
||||
#elif [ ! -d "$MES_SEED" ]; then
|
||||
#else
|
||||
fi
|
||||
sh ${srcdest}build-aux/snarf.sh --mes
|
||||
|
||||
if [ "$gcc_p$tcc_p" ]; then
|
||||
sh ${srcdest}build-aux/build-mes.sh
|
||||
elif [ -d "$MES_SEED" ]; then
|
||||
sh ${srcdest}build-aux/bootstrap-mes.sh
|
||||
fi
|
||||
|
||||
if [ -n "$CC32" ]; then
|
||||
sh ${srcdest}build-aux/build-cc32.sh
|
||||
fi
|
||||
|
||||
if [ -n "$CC64" ]; then
|
||||
sh ${srcdest}build-aux/build-cc64.sh
|
||||
fi
|
||||
|
||||
if [ -n "$TCC" ]; then
|
||||
CC32=$TCC sh ${srcdest}build-aux/build-cc32.sh
|
||||
fi
|
||||
## FIXME: remove this and have user configure/build/install for each compiler?
|
||||
unset CFLAGS CPPFLAGS LDFLAGS gcc_p tcc_p posix_p
|
||||
MES=guile
|
||||
mesc_p=1
|
||||
mes_p=1
|
||||
mes_arch=x86-mes
|
||||
program_prefix=$mes_arch-
|
||||
CC="./pre-inst-env mescc"
|
||||
|
||||
sh ${srcdest}build-aux/build-mes.sh
|
||||
if [ "$arch" = x86_64 -a "$GUILE" ]; then
|
||||
MES=$GUILE sh ${srcdest}build-aux/build-x86_64-mes.sh
|
||||
cp src/${program_prefix}mes src/mes
|
||||
|
||||
if [ "$arch" = x86_64 ]; then
|
||||
MES_CFLAGS='-m 64'
|
||||
mes_arch=x86_64-mes
|
||||
program_prefix=$mes_arch-
|
||||
sh ${srcdest}build-aux/build-mes.sh
|
||||
fi
|
||||
|
|
|
@ -1,67 +0,0 @@
|
|||
#! /bin/sh
|
||||
|
||||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
# GNU Mes is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Mes is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
MESCC=${MESCC-$(command -v mescc)}
|
||||
[ -z "$MESCC" ] && MESCC=scripts/mescc
|
||||
MES=${MES-$(command -v mes)}
|
||||
[ -z "$MES" ] && MES=src/mes
|
||||
|
||||
if [ "$V" = 2 ]; then
|
||||
MES_CFLAGS="$MES_CFLAGS -v"
|
||||
fi
|
||||
|
||||
c=$1
|
||||
|
||||
set -e
|
||||
|
||||
if [ -z "$ARCHDIR" ]; then
|
||||
o="$c"
|
||||
d=${c%%/*}
|
||||
p="mes-"
|
||||
else
|
||||
b=${c##*/}
|
||||
d=${c%%/*}/x86-mes
|
||||
o="$d/$b"
|
||||
fi
|
||||
mkdir -p $d
|
||||
|
||||
if [ -n "$PREPROCESS" ]; then
|
||||
trace "CPP.mes $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES_CFLAGS -E -o "$o.E" "${srcdest}$c".c
|
||||
trace "CC.mes $c.E" ./pre-inst-env bash $MESCC $MES_CFLAGS -S "$o".E
|
||||
trace "AS.mes $c.S" ./pre-inst-env bash $MESCC $MES_CFLAGS -c -o "$o".${p}o "$o".S
|
||||
if [ -z "$NOLINK" ]; then
|
||||
trace "LD.mes $c.o" ./pre-inst-env bash $MESCC $MES_CFLAGS -o "$o".${p}out "$o".${p}o $MES_LIBS
|
||||
fi
|
||||
elif [ -n "$COMPILE" ]; then
|
||||
trace "CC.mes $c.c" trace "MESCC $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES_CFLAGS -S -o "$o.S" "${srcdest}$c".c
|
||||
trace "AS.mes $c.S" ./pre-inst-env bash $MESCC $MES_CFLAGS -c -o "$o".${p}o "$o".S
|
||||
if [ -z "$NOLINK" ]; then
|
||||
trace "LD.mes $c.o" ./pre-inst-env bash $MESCC $MES_CFLAGS -o "$o".${p}out "$o".${p}o $MES_LIBS
|
||||
fi
|
||||
elif [ -z "$NOLINK" ]; then
|
||||
trace "CC.mes $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES_CFLAGS -o "$o".${p}out "${srcdest}$c".c $MES_LIBS
|
||||
else
|
||||
trace "CC.mes $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES_CFLAGS -c -o "$o".${p}o "${srcdest}$c".c
|
||||
fi
|
|
@ -1,67 +0,0 @@
|
|||
#! /bin/sh
|
||||
|
||||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
# GNU Mes is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Mes is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
MESCC=${MESCC-$(command -v mescc)}
|
||||
[ -z "$MESCC" ] && MESCC=scripts/mescc
|
||||
MES=${MES-$(command -v mes)}
|
||||
[ -z "$MES" ] && MES=src/mes
|
||||
|
||||
if [ "$V" = 2 ]; then
|
||||
MES64_CFLAGS="$MES64_CFLAGS -v"
|
||||
fi
|
||||
|
||||
c=$1
|
||||
|
||||
set -e
|
||||
|
||||
if [ -z "$ARCHDIR" ]; then
|
||||
o="$c"
|
||||
d=${c%%/*}
|
||||
p="x86_64-mes-"
|
||||
else
|
||||
b=${c##*/}
|
||||
d=${c%%/*}/x86_64-mes
|
||||
o="$d/$b"
|
||||
fi
|
||||
mkdir -p $d
|
||||
|
||||
if [ -n "$PREPROCESS" ]; then
|
||||
trace "CPP.mes64 $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -E -o "$o.${p}E" "${srcdest}$c".c
|
||||
trace "CC.mes64 $c.E" ./pre-inst-env bash $MESCC $MES64_CFLAGS -S -o "$o".${p}S "$o".${p}E
|
||||
trace "AS.mes64 $c.S" ./pre-inst-env bash $MESCC $MES64_CFLAGS -c -o "$o".${p}o "$o".${p}S
|
||||
if [ -z "$NOLINK" ]; then
|
||||
trace "LD.mes64 $c.o" ./pre-inst-env bash $MESCC $MES64_CFLAGS -o "$o".${p}out "$o".${p}o $MES_LIBS
|
||||
fi
|
||||
elif [ -n "$COMPILE" ]; then
|
||||
trace "CC.mes64 $c.c" trace "MESCC $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -S -o "$o".${p}S "${srcdest}$c".c
|
||||
trace "AS.mes64 $c.S" ./pre-inst-env bash $MESCC $MES64_CFLAGS -c -o "$o".${p}o "$o".${p}S
|
||||
if [ -z "$NOLINK" ]; then
|
||||
trace "LD.mes64 $c.o" ./pre-inst-env bash $MESCC $MES64_CFLAGS -o "$o".${p}out "$o".${p}o $MES_LIBS
|
||||
fi
|
||||
elif [ -z "$NOLINK" ]; then
|
||||
trace "CC.mes64 $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -o "$o".${p}out "${srcdest}$c".c $MES_LIBS
|
||||
else
|
||||
trace "CC.mes64 $c.c" ./pre-inst-env bash $MESCC $MES_CPPFLAGS $MES64_CFLAGS -c -o "$o".${p}o "${srcdest}$c".c
|
||||
fi
|
|
@ -1,5 +1,3 @@
|
|||
#! /bin/sh
|
||||
|
||||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
|
@ -18,42 +16,32 @@
|
|||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
compile () {
|
||||
flags=
|
||||
[ "$mesc_p" ] && flags="$LDFLAGS $MES_CFLAGS"
|
||||
trace "CC $1.c" $CC -c $CPPFLAGS $CFLAGS $flags -o "$1".${program_prefix}o "${srcdest}$1".c
|
||||
}
|
||||
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
. ${srcdest}build-aux/config.sh
|
||||
archive () {
|
||||
l=$1
|
||||
shift
|
||||
objects=$(for i in $@; do echo $i.${program_prefix}o; done)
|
||||
[ -z "$objects" ] && objects=$l.${program_prefix}o
|
||||
out=$(dirname "$l")/$mes_arch/$(basename "$l").a
|
||||
d=$(dirname $out)
|
||||
mkdir -p $d
|
||||
if [ "$mesc_p" ]; then
|
||||
trace "AR $l.a" mv $l.${program_prefix}o $(dirname $l)/$mes_arch/$(basename $l).o\
|
||||
&& mv $l.${program_prefix}S $(dirname $l)/$mes_arch/$(basename $l).S
|
||||
else
|
||||
trace "AR $l.a" $AR cr $out $objects\
|
||||
&& mv $objects $d
|
||||
fi
|
||||
}
|
||||
|
||||
c=$1
|
||||
|
||||
if [ -z "$ARCHDIR" ]; then
|
||||
o="$c"
|
||||
d=${c%%/*}
|
||||
p="gcc-"
|
||||
else
|
||||
b=${c##*/}
|
||||
d=${c%/*}/gcc
|
||||
o="$d/$b"
|
||||
fi
|
||||
mkdir -p $d
|
||||
|
||||
trace "CC $c.c" $CC\
|
||||
-c\
|
||||
$CC_CPPFLAGS\
|
||||
$CPPFLAGS\
|
||||
$CC_CFLAGS\
|
||||
$CFLAGS\
|
||||
-D WITH_GLIBC=1\
|
||||
-D POSIX=1\
|
||||
-o "$o".${p}o\
|
||||
"${srcdest}$c".c
|
||||
|
||||
if [ -z "$NOLINK" ]; then
|
||||
trace "CCLD "$o".${p}out" $CC\
|
||||
$CC_CPPFLAGS\
|
||||
$CPPFLAGS\
|
||||
$CC_CFLAGS\
|
||||
$CFLAGS\
|
||||
-o "$o".${p}out\
|
||||
"$o".${p}o\
|
||||
lib/gcc/libmes.o
|
||||
fi
|
||||
link () {
|
||||
lib=$libc
|
||||
[ "$posix_p" ] && lib='-l mes'
|
||||
out=$(dirname "$1")/${program_prefix}$(basename "$1")
|
||||
trace "CCLD $1" $CC $CFLAGS $LDFLAGS -o" $out" $crt1 "$1".${program_prefix}o $2 $lib
|
||||
}
|
||||
|
|
|
@ -20,17 +20,10 @@
|
|||
|
||||
set -e
|
||||
|
||||
. ./config.status
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
export GUILE MES
|
||||
MES=${MES-./src/mes}
|
||||
|
||||
GUILE=${GUILE-guile}
|
||||
if ! command -v $GUILE > /dev/null; then
|
||||
GUILE=true
|
||||
fi
|
||||
|
||||
tests="
|
||||
|
||||
00-zero.scm
|
||||
|
@ -120,18 +113,17 @@ for i in $tests; do
|
|||
echo ' [SKIP]'
|
||||
continue;
|
||||
fi
|
||||
trace "TEST $i.guile" $GUILE -L ${srcdest}module -C module -L . <(echo '(use-modules (mes guile))'; cat scaffold/boot/$i)
|
||||
x=$(
|
||||
if [ "$MES" = guile ]; then
|
||||
true
|
||||
if [ "$MES" = guile -o "$(basename $MES)" = guile ]; then
|
||||
trace "TEST $i.guile" $GUILE -L ${srcdest}module -C module -L . <(echo '(use-modules (mes guile))'; cat scaffold/boot/$i)
|
||||
elif [ -z "${i/5[0-9]-*/}" ]; then
|
||||
cat scaffold/boot/$i | MES_BOOT=${srcdest}boot-00.scm $MES 2>&1;
|
||||
cat scaffold/boot/$i | MES_BOOT=${srcdest}boot-00.scm trace "TEST $i" $MES 2>&1;
|
||||
elif [ -z "${i/6[0-9]-*/}" ]; then
|
||||
cat scaffold/boot/$i | MES_BOOT=${srcdest}boot-01.scm $MES 2>&1;
|
||||
cat scaffold/boot/$i | MES_BOOT=${srcdest}boot-01.scm trace "TEST $i" $MES 2>&1;
|
||||
else
|
||||
MES_BOOT=${srcdest}scaffold/boot/$i $MES 2>&1;
|
||||
MES_BOOT=${srcdest}scaffold/boot/$i trace "TEST $i" $MES 2>&1;
|
||||
fi
|
||||
) \
|
||||
&& echo ' [PASS]' \
|
||||
&& echo ' [OK]' \
|
||||
|| (r=$?; echo ' [FAIL]'; echo -e "$x"; echo scaffold/boot/$i; exit $r)
|
||||
done
|
||||
|
|
|
@ -20,20 +20,16 @@
|
|||
|
||||
set -e
|
||||
|
||||
. ./config.status
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
if [ "$MES" = guile ]; then
|
||||
mes=guile-
|
||||
fi
|
||||
BASH=${BASH-bash}
|
||||
GUILE=${GUILE-guile}
|
||||
MES=${MES-src/mes}
|
||||
MES_ARENA=${MES_ARENA-100000000}
|
||||
|
||||
tests="
|
||||
tests/boot.test
|
||||
tests/read.test
|
||||
tests/srfi-0.test
|
||||
tests/macro.test
|
||||
tests/perform.test
|
||||
tests/base.test
|
||||
tests/quasiquote.test
|
||||
tests/let.test
|
||||
|
|
|
@ -19,31 +19,11 @@
|
|||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
. ./config.status
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
MES=${MES-src/mes}
|
||||
[ -z "$MESCC" ] && MESCC=scripts/mescc
|
||||
GUILE=${GUILE-guile}
|
||||
MES_PREFIX=${MES_PREFIX-mes}
|
||||
|
||||
HEX2=${HEX2-hex2}
|
||||
M1=${M1-M1}
|
||||
BLOOD_ELF=${BLOOD_ELF-blood-elf}
|
||||
MES_SEED=${MES_SEED-../mes-seed}
|
||||
MESCC=${MESCC-$(command -v mescc)}
|
||||
[ -z "$MESCC" ] && MESCC=scripts/mescc
|
||||
MES=${MES-$(command -v mes)}
|
||||
[ -z "$MES" ] && MES=src/mes
|
||||
|
||||
if ! command -v $GUILE > /dev/null; then
|
||||
GUILE=true
|
||||
fi
|
||||
|
||||
test_sh=${test_sh-${srcdest}build-aux/test.sh}
|
||||
if [ "$arch" = "x86_64-mes" ]; then
|
||||
test_sh=${srcdest}build-aux/test64.sh
|
||||
fi
|
||||
|
||||
tests="
|
||||
t
|
||||
|
@ -219,6 +199,7 @@ t
|
|||
97-fopen
|
||||
98-fopen
|
||||
99-readdir
|
||||
9a-snprintf
|
||||
a0-call-trunc-char
|
||||
a0-call-trunc-short
|
||||
a0-call-trunc-int
|
||||
|
@ -235,8 +216,18 @@ a0-call-trunc-int
|
|||
a0-math-divide-signed-negative
|
||||
"
|
||||
|
||||
# gcc not supported
|
||||
CC=
|
||||
if [ "$mes_arch" = "x86_64-gcc" ]; then
|
||||
broken="$broken
|
||||
21-char[]
|
||||
41-?
|
||||
70-printf-stdarg
|
||||
70-printf-simple
|
||||
70-printf
|
||||
80-setjmp
|
||||
a1-global-no-align
|
||||
"
|
||||
fi
|
||||
|
||||
set +e
|
||||
expect=$(echo $broken | wc -w)
|
||||
pass=0
|
||||
|
@ -245,20 +236,15 @@ total=0
|
|||
mkdir -p scaffold/tests
|
||||
for t in $tests; do
|
||||
if [ -z "${t/[012][0-9]-*/}" ]; then
|
||||
LIBC=
|
||||
MES_LIBS="-l none"
|
||||
libc=
|
||||
elif [ -z "${t/[34][0-9]-*/}" ]; then
|
||||
LIBC=c-mini
|
||||
MES_LIBS="-l c-mini"
|
||||
libc='-l c-mini'
|
||||
elif [ -z "${t/[78][0-9a-z]-*/}" ]; then
|
||||
LIBC=c+tcc
|
||||
MES_LIBS="-l c+tcc"
|
||||
elif [ -z "${t/9[0-9]-*/}" ]; then
|
||||
LIBC=c+gnu
|
||||
MES_LIBS="-l c+gnu"
|
||||
libc='-l c+tcc'
|
||||
elif [ -z "${t/9[0-9a-z]-*/}" ]; then
|
||||
libc='-l c+gnu'
|
||||
else
|
||||
LIBC=c
|
||||
MES_LIBS=
|
||||
libc='-l c'
|
||||
fi
|
||||
sh $test_sh "scaffold/tests/$t" &> scaffold/tests/"$t".log
|
||||
r=$?
|
||||
|
|
|
@ -19,27 +19,10 @@
|
|||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
. ./config.status
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
MES=${MES-src/mes}
|
||||
[ -z "$MESCC" ] && MESCC=scripts/mescc
|
||||
GUILE=${GUILE-guile}
|
||||
MES_PREFIX=${MES_PREFIX-mes}
|
||||
|
||||
HEX2=${HEX2-hex2}
|
||||
M1=${M1-M1}
|
||||
BLOOD_ELF=${BLOOD_ELF-blood-elf}
|
||||
MES_SEED=${MES_SEED-../mes-seed}
|
||||
MESCC=${MESCC-$(command -v mescc)}
|
||||
[ -z "$MESCC" ] && MESCC=scripts/mescc
|
||||
MES=${MES-$(command -v mes)}
|
||||
[ -z "$MES" ] && MES=src/mes
|
||||
|
||||
if ! command -v $GUILE > /dev/null; then
|
||||
GUILE=true
|
||||
fi
|
||||
|
||||
tests="
|
||||
00_assignment
|
||||
01_comment
|
||||
|
|
|
@ -20,34 +20,13 @@
|
|||
|
||||
set -e
|
||||
|
||||
srcdest="@srcdest@"
|
||||
srcdir="@srcdir@"
|
||||
abs_top_srcdir="@abs_top_srcdir@"
|
||||
abs_top_builddir="@abs_top_builddir@"
|
||||
prefix=${prefix-@prefix@}
|
||||
|
||||
. ./config.status
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
GUILE=${GUILE-guile}
|
||||
MES=${MES-src/mes}
|
||||
MES_ARENA=${MES_ARENA-100000000}
|
||||
TCC_PREFIX=${TCC_PREFIX-${srcdest}../tinycc}
|
||||
|
||||
if ! command -v $GUILE > /dev/null; then
|
||||
GUILE=true
|
||||
fi
|
||||
|
||||
set -e
|
||||
|
||||
if [ "$GUILE" != true ]; then
|
||||
MES=guile bash ${srcdest}build-aux/check-mes.sh
|
||||
fi
|
||||
if [ "$MES" != guile ]; then
|
||||
bash ${srcdest}build-aux/check-mes.sh
|
||||
fi
|
||||
bash ${srcdest}build-aux/check-boot.sh
|
||||
bash ${srcdest}build-aux/check-mescc.sh
|
||||
./pre-inst-env bash ${srcdest}build-aux/check-boot.sh
|
||||
./pre-inst-env bash ${srcdest}build-aux/check-mes.sh
|
||||
./pre-inst-env bash ${srcdest}build-aux/check-mescc.sh
|
||||
if [ -d $TINYCC_PREFIX/tests/tests2 ] ;then
|
||||
bash ${srcdest}build-aux/check-tcc.sh
|
||||
./pre-inst-env bash ${srcdest}build-aux/check-tcc.sh
|
||||
fi
|
||||
|
|
|
@ -0,0 +1,72 @@
|
|||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
# GNU Mes is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Mes is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
AR:=@AR@
|
||||
BASH:=@BASH@
|
||||
BLOOD_ELF:=@BLOOD_ELF@
|
||||
CC:=@CC@
|
||||
DOT:=@DOT@
|
||||
GIT:=@GIT@
|
||||
GUILD:=@GUILD@
|
||||
GUILE:=@GUILE@
|
||||
GUILE_EFFECTIVE_VERSION:=@GUILE_EFFECTIVE_VERSION@
|
||||
GUIX:=@GUIX@
|
||||
HELP2MAN:=@HELP2MAN@
|
||||
HEX2:=@HEX2@
|
||||
#HEX2FLAGS:=@HEX2FLAGS@
|
||||
MAKEINFO:=@MAKEINFO@
|
||||
M1:=@M1@
|
||||
#M1FLAGS:=@M1FLAGS@
|
||||
MES:=@MES@
|
||||
MES_FOR_BUILD:=@MES_FOR_BUILD@
|
||||
MES_SEED:=@MES_SEED@
|
||||
NYACC:=@NYACC@
|
||||
PACKAGE:=@PACKAGE@
|
||||
PERL:=@PERL@
|
||||
TINYCC_PREFIX:=@TINYCC_PREFIX@
|
||||
VERSION:=@VERSION@
|
||||
|
||||
abs_top_builddir:=@abs_top_builddir@
|
||||
abs_top_srcdir:=@abs_top_srcdir@
|
||||
arch:=@arch@
|
||||
build:=@build@
|
||||
host:=@host@
|
||||
|
||||
mes_arch:=@mes_arch@
|
||||
gcc_p:=@gcc_p@
|
||||
mes_p:=@mes_p@
|
||||
mesc_p:=@mesc_p@
|
||||
tcc_p:=@tcc_p@
|
||||
|
||||
prefix:=@prefix@
|
||||
|
||||
bindir:=@bindir@
|
||||
datadir:=@datadir@
|
||||
docdir:=@docdir@
|
||||
guile_site_ccache_dir:=@guile_site_ccache_dir@
|
||||
guile_site_dir:=@guile_site_dir@
|
||||
infodir:=@infodir@
|
||||
libdir:=@libdir@
|
||||
mandir:=@mandir@
|
||||
moduledir:=@moduledir@
|
||||
posix_p:=@posix_p@
|
||||
program_prefix:=@program_prefix@
|
||||
srcdest:=@srcdest@
|
||||
srcdir:=@srcdir@
|
||||
sysconfdir:=@sysconfdir@
|
||||
top_builddir:=@top_builddir@
|
|
@ -18,60 +18,72 @@
|
|||
|
||||
srcdir=${srcdir-.}
|
||||
top_builddir=${top_builddir-.}
|
||||
|
||||
if [ "$V" = 2 ]; then
|
||||
echo $0
|
||||
echo srcdest=${srcdest}
|
||||
echo top_builddir=${top_builddir}
|
||||
fi
|
||||
|
||||
if [ -n "$mes_p" -a -n "$gcc_p" ]; then
|
||||
crt1=lib/linux/$mes_arch/crt1.o
|
||||
fi
|
||||
|
||||
MES=${MES-${program_prefix}mes}
|
||||
libc=${libc-"-l c"}
|
||||
export libc
|
||||
|
||||
if [ ! "$CC" ]; then
|
||||
CC="./pre-inst-env mescc"
|
||||
fi
|
||||
|
||||
export AR
|
||||
export CC
|
||||
export CC CFLAGS
|
||||
export CC32
|
||||
export CC32_CPPFLAGS
|
||||
export CC64
|
||||
export CC64_CPPFLAGS
|
||||
export CC_CFLAGS
|
||||
export CC_CPPFLAGS
|
||||
export CFLAGS
|
||||
export CPPFLAGS
|
||||
export GUILD
|
||||
export GUILE
|
||||
export GUILE_LOAD_COMPILED_PATH
|
||||
export GUILE_LOAD_PATH
|
||||
export HEX2
|
||||
export HEX2FLAGS
|
||||
export LIBC
|
||||
export M1
|
||||
export M1FLAGS
|
||||
export MES
|
||||
export MES_CFLAGS
|
||||
export MES_CPPFLAGS
|
||||
export MES_LIBS
|
||||
export TCC
|
||||
export MES_FOR_BUILD
|
||||
export MES_SEED
|
||||
export MESCC
|
||||
|
||||
export MES_DEBUG
|
||||
export MES_SEED
|
||||
export MES_ARENA
|
||||
export COMPILE
|
||||
export PREPROCESS
|
||||
export TINYCC_PREFIX
|
||||
export V
|
||||
|
||||
export config_status
|
||||
export abs_top_builddir
|
||||
export abs_top_srcdir
|
||||
export arch
|
||||
export datadir
|
||||
export moduledir
|
||||
export prefix
|
||||
export program_prefix
|
||||
export srcdest
|
||||
export srcdir
|
||||
export top_builddir
|
||||
|
||||
MESCC=${MESCC-mescc}
|
||||
BLOOD_ELF=${BLOOD_ELF-blood-elf}
|
||||
HEX2=${HEX2-hex2}
|
||||
M1=${M1-M1}
|
||||
export bits
|
||||
export build
|
||||
export host
|
||||
export compiler
|
||||
export gcc_p
|
||||
export mes_p
|
||||
export mesc_p
|
||||
export tcc_p
|
||||
export mes_arch
|
||||
export posix_p
|
||||
|
||||
CC_CPPFLAGS=${CC_CPPFLAGS-"
|
||||
CPPFLAGS=${CPPFLAGS-"
|
||||
-D 'VERSION=\"$VERSION\"'
|
||||
-D 'MODULEDIR=\"$moduledir\"'
|
||||
-D 'PREFIX=\"$prefix\"'
|
||||
|
@ -81,29 +93,35 @@ CC_CPPFLAGS=${CC_CPPFLAGS-"
|
|||
-I ${srcdest}include
|
||||
"}
|
||||
|
||||
CC_CFLAGS=${CC_CFLAGS-"
|
||||
[ "$posix_p" ] && CPPFLAGS="$CPPFLAGS -D POSIX=1 -D WITH_GLIBC=1"
|
||||
|
||||
LDFLAGS=${LDFLAGS-"
|
||||
-v
|
||||
-L lib/linux/$mes_arch
|
||||
-L lib/linux
|
||||
-L lib/$mes_arch
|
||||
-L lib
|
||||
"}
|
||||
|
||||
if [ -f "$MES_SEED/x86-mes/mes.S" ]; then
|
||||
LDFLAGS="$LDFLAGS
|
||||
-L $MES_SEED
|
||||
"
|
||||
fi
|
||||
|
||||
if [ -n "$gcc_p" ]; then
|
||||
CFLAGS=${CFLAGS-"
|
||||
-v
|
||||
--std=gnu99
|
||||
-O0
|
||||
-g
|
||||
"}
|
||||
fi
|
||||
|
||||
CC64_CPPFLAGS=${CC64_CPPFLAGS-"
|
||||
-D 'VERSION=\"$VERSION\"'
|
||||
-D 'MODULEDIR=\"$moduledir\"'
|
||||
-D 'PREFIX=\"$prefix\"'
|
||||
-I src
|
||||
-I ${srcdest}src
|
||||
-I ${srcdest}lib
|
||||
-I ${srcdest}include
|
||||
"}
|
||||
|
||||
CC64_CFLAGS=${CC64_CFLAGS-"
|
||||
-std=gnu99
|
||||
-O0
|
||||
if [ "$mes_p" -a "$gcc_p" ]; then
|
||||
CFLAGS="$CFLAGS
|
||||
-fno-builtin
|
||||
-fno-stack-protector
|
||||
-g
|
||||
-m64
|
||||
-nostdinc
|
||||
-nostdlib
|
||||
-Wno-discarded-qualifiers
|
||||
|
@ -112,59 +130,29 @@ CC64_CFLAGS=${CC64_CFLAGS-"
|
|||
-Wno-pointer-sign
|
||||
-Wno-int-conversion
|
||||
-Wno-incompatible-pointer-types
|
||||
"}
|
||||
"
|
||||
fi
|
||||
|
||||
CC32_CPPFLAGS=${CC32_CPPFLAGS-"
|
||||
-D 'VERSION=\"$VERSION\"'
|
||||
-D 'MODULEDIR=\"$moduledir\"'
|
||||
-D 'PREFIX=\"$prefix\"'
|
||||
-I src
|
||||
-I ${srcdest}src
|
||||
-I ${srcdest}lib
|
||||
-I ${srcdest}include
|
||||
"}
|
||||
|
||||
CC32_CFLAGS=${CC32_CFLAGS-"
|
||||
-std=gnu99
|
||||
-O0
|
||||
-fno-builtin
|
||||
-fno-stack-protector
|
||||
-g
|
||||
-m32
|
||||
-nostdinc
|
||||
-nostdlib
|
||||
-Wno-discarded-qualifiers
|
||||
-Wno-int-to-pointer-cast
|
||||
-Wno-pointer-to-int-cast
|
||||
-Wno-pointer-sign
|
||||
-Wno-int-conversion
|
||||
-Wno-incompatible-pointer-types
|
||||
"}
|
||||
|
||||
MES_CPPFLAGS=${MES_CPPFLAGS-"
|
||||
-D 'VERSION=\"$VERSION\"'
|
||||
-D 'MODULEDIR=\"$moduledir\"'
|
||||
-D 'PREFIX=\"$prefix\"'
|
||||
-I src
|
||||
-I ${srcdest}src
|
||||
-I ${srcdest}lib
|
||||
-I ${srcdest}include
|
||||
"}
|
||||
|
||||
MES_CFLAGS=${MES_CFLAGS-"
|
||||
"}
|
||||
|
||||
MES64_CFLAGS=${MES64_CFLAGS-"
|
||||
-m64
|
||||
"}
|
||||
|
||||
M1FLAGS=${M1FLAGS-"
|
||||
--LittleEndian
|
||||
--Architecture 1
|
||||
"}
|
||||
|
||||
HEX2FLAGS=${HEX2FLAGS-"
|
||||
if [ "$arch" = "x86" ]; then
|
||||
HEX2FLAGS=${HEX2FLAGS-"
|
||||
--LittleEndian
|
||||
--Architecture 1
|
||||
--BaseAddress 0x1000000
|
||||
"}
|
||||
M1FLAGS=${M1FLAGS-"
|
||||
--LittleEndian
|
||||
--Architecture 1
|
||||
"}
|
||||
bits=32
|
||||
elif [ "$arch" = "x86_64" ]; then
|
||||
HEX2FLAGS=${HEX2FLAGS-"
|
||||
--LittleEndian
|
||||
--Architecture 2
|
||||
--BaseAddress 0x1000000
|
||||
"}
|
||||
M1FLAGS=${M1FLAGS-"
|
||||
--LittleEndian
|
||||
--Architecture 2
|
||||
"}
|
||||
bits=64
|
||||
fi
|
||||
|
|
|
@ -0,0 +1,72 @@
|
|||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
# GNU Mes is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Mes is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
config_status=1
|
||||
AR="@AR@"
|
||||
BASH="@BASH@"
|
||||
BLOOD_ELF="@BLOOD_ELF@"
|
||||
CC="@CC@"
|
||||
DOT="@DOT@"
|
||||
GIT="@GIT@"
|
||||
GUILD="@GUILD@"
|
||||
GUILE="@GUILE@"
|
||||
GUILE_EFFECTIVE_VERSION="@GUILE_EFFECTIVE_VERSION@"
|
||||
GUIX="@GUIX@"
|
||||
HELP2MAN="@HELP2MAN@"
|
||||
HEX2="@HEX2@"
|
||||
#HEX2FLAGS="@HEX2FLAGS@"
|
||||
MAKEINFO="@MAKEINFO@"
|
||||
M1="@M1@"
|
||||
#M1FLAGS="@M1FLAGS@"
|
||||
MES_FOR_BUILD="@MES_FOR_BUILD@"
|
||||
MES_SEED="@MES_SEED@"
|
||||
NYACC="@NYACC@"
|
||||
PACKAGE="@PACKAGE@"
|
||||
PERL="@PERL@"
|
||||
TINYCC_PREFIX="@TINYCC_PREFIX@"
|
||||
VERSION="@VERSION@"
|
||||
|
||||
abs_top_builddir="@abs_top_builddir@"
|
||||
abs_top_srcdir="@abs_top_srcdir@"
|
||||
arch="@arch@"
|
||||
build="@build@"
|
||||
host="@host@"
|
||||
|
||||
mes_arch="@mes_arch@"
|
||||
gcc_p="@gcc_p@"
|
||||
mes_p="@mes_p@"
|
||||
mesc_p="@mesc_p@"
|
||||
tcc_p="@tcc_p@"
|
||||
|
||||
prefix="@prefix@"
|
||||
|
||||
bindir="@bindir@"
|
||||
datadir="@datadir@"
|
||||
docdir="@docdir@"
|
||||
guile_site_ccache_dir="@guile_site_ccache_dir@"
|
||||
guile_site_dir="@guile_site_dir@"
|
||||
infodir="@infodir@"
|
||||
libdir="@libdir@"
|
||||
mandir="@mandir@"
|
||||
moduledir="@moduledir@"
|
||||
posix_p="@posix_p@"
|
||||
program_prefix="@program_prefix@"
|
||||
srcdest="@srcdest@"
|
||||
srcdir="@srcdir@"
|
||||
sysconfdir="@sysconfdir@"
|
||||
top_builddir="@top_builddir@"
|
|
@ -56,10 +56,6 @@ ifdef CC
|
|||
export CC
|
||||
endif
|
||||
|
||||
ifdef CC32
|
||||
export CC32
|
||||
endif
|
||||
|
||||
ifdef CC64
|
||||
export CC64
|
||||
endif
|
||||
|
@ -80,6 +76,18 @@ ifdef MES
|
|||
export MES
|
||||
endif
|
||||
|
||||
ifdef MES_FOR_BUILD
|
||||
export MES_FOR_BUILD
|
||||
endif
|
||||
|
||||
ifdef MES_SEED
|
||||
export MES_SEED
|
||||
endif
|
||||
|
||||
ifdef MESCC
|
||||
export MESCC
|
||||
endif
|
||||
|
||||
ifdef HEX2
|
||||
export HEX2
|
||||
endif
|
||||
|
@ -92,8 +100,8 @@ ifdef GUILE
|
|||
export GUILE
|
||||
endif
|
||||
|
||||
ifdef GUILE_TOOLS
|
||||
export GUILE_TOOLS
|
||||
ifdef GUILD
|
||||
export GUILD
|
||||
endif
|
||||
|
||||
ifdef GUIX
|
||||
|
@ -124,14 +132,6 @@ ifdef CPPFLAGS
|
|||
export CPPFLAGS
|
||||
endif
|
||||
|
||||
ifdef CC32_CFLAGS
|
||||
export CC32_CFLAGS
|
||||
endif
|
||||
|
||||
ifdef CC64_CFLAGS
|
||||
export CC64_CFLAGS
|
||||
endif
|
||||
|
||||
ifdef HEX2FLAGS
|
||||
export HEX2FLAGS
|
||||
endif
|
||||
|
@ -140,22 +140,6 @@ ifdef M1FLAGS
|
|||
export M1FLAGS
|
||||
endif
|
||||
|
||||
ifdef MES_CFLAGS
|
||||
export MES_CFLAGS
|
||||
endif
|
||||
|
||||
ifdef MES_SEED
|
||||
export MES_SEED
|
||||
endif
|
||||
|
||||
ifdef MESCC_TOOLS_SEED
|
||||
export MESCC_TOOLS_SEED
|
||||
endif
|
||||
|
||||
ifdef TINYCC_SEED
|
||||
export TINYCC_SEED
|
||||
endif
|
||||
|
||||
ifdef TINYCC_PREFIX
|
||||
export TINYCC_PREFIX
|
||||
endif
|
||||
|
|
|
@ -19,13 +19,8 @@
|
|||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
srcdest="@srcdest@"
|
||||
srcdir="@srcdir@"
|
||||
abs_top_srcdir="@abs_top_srcdir@"
|
||||
abs_top_builddir="@abs_top_builddir@"
|
||||
prefix=${prefix-@prefix@}
|
||||
VERSION=${VERSION-@VERSION@}
|
||||
|
||||
. ./config.status
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
|
@ -35,8 +30,6 @@ SHELL=${SHELL-$(command -v sh)}
|
|||
[ -n "$BASH" ] && set -o pipefail
|
||||
|
||||
MES_PREFIX=${MES_PREFIX-$prefix/share/mes}
|
||||
MES_SEED=${MES_SEED-../MES-SEED}
|
||||
TINYCC_SEED=${TINYCC_SEED-../TINYCC-SEED}
|
||||
|
||||
GUILE=${GUILE-$(command -v guile)} || true
|
||||
if [ -z "$GUILE" -o "$GUILE" = true ]; then
|
||||
|
@ -54,7 +47,9 @@ guile_site_dir=$(eval echo ${guile_site_dir-$prefix/share/guile/site/$GUILE_EFFE
|
|||
guile_site_ccache_dir=$(eval echo ${guile_site_ccache_dir-$prefix/lib/guile/$GUILE_EFFECTIVE_VERSION/site-ccache})
|
||||
|
||||
mkdir -p $DESTDIR$bindir
|
||||
cp src/mes $DESTDIR$bindir/mes
|
||||
if [ -f src/x86-mes-mes ]; then
|
||||
cp src/x86-mes-mes $DESTDIR$bindir/mes
|
||||
fi
|
||||
cp scripts/mescc $DESTDIR$bindir/mescc
|
||||
|
||||
sed \
|
||||
|
@ -66,7 +61,7 @@ mkdir -p $docdir
|
|||
|
||||
if [ -n "$PERL" -a -n "$GIT" ]\
|
||||
&& $PERL -v > /dev/null\
|
||||
&& $GIT --status > /dev/null; then
|
||||
&& $GIT status > /dev/null; then
|
||||
$PERL ${srcdest}build-aux/gitlog-to-changelog --srcdir=. > ChangeLog
|
||||
fi
|
||||
|
||||
|
@ -105,7 +100,9 @@ else
|
|||
fi
|
||||
tar -cf- -C ${srcdest}mes module | tar -xf- -C $DESTDIR$MES_PREFIX
|
||||
|
||||
cp src/mes.S $DESTDIR$MES_PREFIX/lib/x86-mes/mes.S
|
||||
if [ -f src/mes.x86-mes-S ]; then
|
||||
cp src/mes.x86-mes-S $DESTDIR$MES_PREFIX/lib/x86-mes/mes.S
|
||||
fi
|
||||
if [ -f src/mes.x86_64-mes-S ]; then
|
||||
cp src/mes.x86_64-mes-S $DESTDIR$MES_PREFIX/lib/x86_64-mes/mes.S
|
||||
fi
|
||||
|
|
|
@ -146,8 +146,8 @@ exec ${GUILE-guile} --no-auto-compile -L $(dirname $0) -C $(dirname $0) -e '(mes
|
|||
(format #f "g_cells[cell_~a].string = MAKE_STRING (scm_~a.string);\n" (function.name f) (function.name f))
|
||||
(format #f "g_cells[cell_~a].car = MAKE_STRING (scm_~a.car);\n" (function.name f) (function.name f)))
|
||||
(if %gcc?
|
||||
(format #f "a = acons (lookup_symbol_ (scm_~a.string), ~a, a);\n\n" (function.name f) (function-cell-name f))
|
||||
(format #f "a = acons (lookup_symbol_ (scm_~a.car), ~a, a);\n\n" (function.name f) (function-cell-name f)))))
|
||||
(format #f "a = acons (list_to_symbol (scm_~a.string), ~a, a);\n\n" (function.name f) (function-cell-name f))
|
||||
(format #f "a = acons (list_to_symbol (scm_~a.car), ~a, a);\n\n" (function.name f) (function-cell-name f)))))
|
||||
|
||||
(define (disjoin . predicates)
|
||||
(lambda (. arguments)
|
||||
|
|
|
@ -22,6 +22,7 @@ srcdir="@srcdir@"
|
|||
abs_top_srcdir="@abs_top_srcdir@"
|
||||
abs_top_builddir="@abs_top_builddir@"
|
||||
prefix=${prefix-@prefix@}
|
||||
program_prefix=${program_prefix-@program_prefix@}
|
||||
|
||||
MES_PREFIX=${MES_PREFIX-${srcdest}mes}
|
||||
export MES_PREFIX
|
||||
|
@ -36,7 +37,7 @@ export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH
|
|||
PATH="$abs_top_builddir/scripts:$abs_top_builddir/src:$abs_top_builddir/build-aux:$PATH"
|
||||
export PATH
|
||||
|
||||
MES=${MES-src/mes}
|
||||
MES=${MES-${abs_top_builddir}/src/${program_prefix}mes}
|
||||
export MES
|
||||
|
||||
GUIX_PACKAGE_PATH="$abs_top_srcdir/guix${GUIX_PACKAGE_PATH:+:}$GUIX_PACKAGE_PATH"
|
||||
|
|
|
@ -23,42 +23,17 @@ set -e
|
|||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
arch=x86_64-mes-gcc
|
||||
if [ "$CC64" = "$TCC" ]; then
|
||||
arch=x86_64-mes-tcc
|
||||
LIBC=c+tcc # tcc bug with undefined symbols
|
||||
fi
|
||||
|
||||
if [ -n "$LIBC" ]; then
|
||||
CC64LIBS="lib/$arch/lib$LIBC.o"
|
||||
fi
|
||||
|
||||
c=$1
|
||||
|
||||
if [ -z "$ARCHDIR" ]; then
|
||||
o="$c"
|
||||
d=${c%%/*}
|
||||
p="$arch-"
|
||||
else
|
||||
b=${c##*/}
|
||||
d=${c%%/*}/$arch
|
||||
o="$d/$b"
|
||||
fi
|
||||
mkdir -p $d
|
||||
|
||||
trace "CC.64 $c.c" $CC64\
|
||||
-c\
|
||||
$CC64_CPPFLAGS\
|
||||
$CC64_CFLAGS\
|
||||
-o "$o".${p}o\
|
||||
"${srcdest}$c".c
|
||||
|
||||
if [ -z "$NOLINK" ]; then
|
||||
trace "CCLD.64 $c.c" $CC64\
|
||||
$CC64_CPPFLAGS\
|
||||
$CC64_CFLAGS\
|
||||
-o "$o".${p}out\
|
||||
lib/$arch/crt1.o\
|
||||
"$o".${p}o\
|
||||
$CC64LIBS
|
||||
snarf=" "
|
||||
if [ -n "$1" ]; then
|
||||
snarf=.mes
|
||||
fi
|
||||
trace "SNARF$snarf gc.c" ${srcdest}build-aux/mes-snarf.scm $1 src/gc.c
|
||||
trace "SNARF$snarf hash.c" ${srcdest}build-aux/mes-snarf.scm $1 src/hash.c
|
||||
trace "SNARF$snarf lib.c" ${srcdest}build-aux/mes-snarf.scm $1 src/lib.c
|
||||
trace "SNARF$snarf math.c" ${srcdest}build-aux/mes-snarf.scm $1 src/math.c
|
||||
trace "SNARF$snarf mes.c" ${srcdest}build-aux/mes-snarf.scm $1 src/mes.c
|
||||
trace "SNARF$snarf module.c" ${srcdest}build-aux/mes-snarf.scm $1 src/module.c
|
||||
trace "SNARF$snarf posix.c" ${srcdest}build-aux/mes-snarf.scm $1 src/posix.c
|
||||
trace "SNARF$snarf reader.c" ${srcdest}build-aux/mes-snarf.scm $1 src/reader.c
|
||||
trace "SNARF$snarf struct.c" ${srcdest}build-aux/mes-snarf.scm $1 src/struct.c
|
||||
trace "SNARF$snarf vector.c" ${srcdest}build-aux/mes-snarf.scm $1 src/vector.c
|
|
@ -20,46 +20,30 @@
|
|||
|
||||
set -e
|
||||
|
||||
if [ ! "$config_status" ]; then
|
||||
. ./config.status
|
||||
fi
|
||||
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
. ${srcdest}build-aux/cc.sh
|
||||
|
||||
a=mes-gcc
|
||||
if [ "$CC32" = "$TCC" ]; then
|
||||
a=mes-tcc
|
||||
LIBC=c+tcc # tcc bug with undefined symbols
|
||||
fi
|
||||
arch=x86-$a
|
||||
|
||||
if [ -n "$LIBC" ]; then
|
||||
CC32LIBS="lib/$arch/lib$LIBC.o"
|
||||
fi
|
||||
|
||||
c=$1
|
||||
|
||||
if [ -z "$ARCHDIR" ]; then
|
||||
o="$c"
|
||||
d=${c%%/*}
|
||||
p="$a-"
|
||||
else
|
||||
b=${c##*/}
|
||||
d=${c%%/*}/$arch
|
||||
o="$d/$b"
|
||||
fi
|
||||
mkdir -p $d
|
||||
|
||||
trace "CC.32 $c.c" $CC32\
|
||||
-c\
|
||||
$CC32_CPPFLAGS\
|
||||
$CC32_CFLAGS\
|
||||
-o "$o".${p}o\
|
||||
"${srcdest}$c".c
|
||||
|
||||
if [ -z "$NOLINK" ]; then
|
||||
trace "CCLD.32 $c.c" $CC32\
|
||||
$CC32_CPPFLAGS\
|
||||
$CC32_CFLAGS\
|
||||
-o "$o".${p}out\
|
||||
lib/$arch/crt1.o\
|
||||
"$o".${p}o\
|
||||
$CC32LIBS
|
||||
t=${1-scaffold/tests/t}
|
||||
o="$t"
|
||||
|
||||
rm -f "${program_prefix}$o"
|
||||
compile "$t"
|
||||
link "$t"
|
||||
|
||||
r=0
|
||||
[ -f "$t".exit ] && r=$(cat "$t".exit)
|
||||
set +e
|
||||
$(dirname "$o")/${program_prefix}$(basename "$o") $ARGS > "$o".${program_prefix}stdout
|
||||
m=$?
|
||||
cat "$o".${program_prefix}stdout
|
||||
set -e
|
||||
|
||||
[ $m = $r ]
|
||||
if [ -f "$t".expect ]; then
|
||||
$DIFF -ub "$t".expect "$o".${program_prefix}stdout
|
||||
fi
|
|
@ -19,67 +19,19 @@
|
|||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
. ./config.status
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
MES_ARENA=100000000
|
||||
sh ${srcdest}build-aux/test-cc.sh $1
|
||||
|
||||
GUILE=${GUILE-$MES}
|
||||
DIFF=${DIFF-$(command -v diff)} || true
|
||||
[ -z "$DIFF" ] && DIFF="sh scripts/diff.scm"
|
||||
|
||||
t=${1-scaffold/tests/t}
|
||||
o="$t"
|
||||
rm -f "$o".mes-out
|
||||
|
||||
rm -f "$o".gcc-out
|
||||
if [ -n "$CC" ]; then
|
||||
sh ${srcdest}build-aux/cc.sh "$t"
|
||||
|
||||
r=0
|
||||
[ -f "$t".exit ] && r=$(cat "$t".exit)
|
||||
set +e
|
||||
"$o".gcc-out $ARGS > "$o".gcc-stdout
|
||||
m=$?
|
||||
cat "$o".gcc-stdout
|
||||
set -e
|
||||
|
||||
[ $m = $r ]
|
||||
if [ -f "$t".expect ]; then
|
||||
$DIFF -ub "$t".expect "$o".gcc-stdout;
|
||||
fi
|
||||
fi
|
||||
|
||||
rm -f "$t".mes-gcc-out
|
||||
if [ -n "$CC32" ]; then
|
||||
sh ${srcdest}build-aux/cc32-mes.sh "$t"
|
||||
|
||||
r=0
|
||||
[ -f "$t".exit ] && r=$(cat "$t".exit)
|
||||
set +e
|
||||
"$o".mes-gcc-out $ARGS > "$o".mes-gcc-stdout
|
||||
m=$?
|
||||
cat "$t".mes-gcc-stdout
|
||||
set -e
|
||||
|
||||
[ $m = $r ]
|
||||
if [ -f "$t".expect ]; then
|
||||
$DIFF -ub "$t".expect "$o".mes-gcc-stdout;
|
||||
fi
|
||||
fi
|
||||
|
||||
rm -f "$o".mes-out
|
||||
sh ${srcdest}build-aux/cc-mes.sh "$t"
|
||||
|
||||
r=0
|
||||
[ -f "$t".exit ] && r=$(cat "$t".exit)
|
||||
set +e
|
||||
"$o".mes-out $ARGS > "$o".mes-stdout
|
||||
m=$?
|
||||
cat "$o".mes-stdout
|
||||
set -e
|
||||
|
||||
[ $m = $r ]
|
||||
if [ -f "$t".expect ]; then
|
||||
$DIFF -ub "$t".expect "$o".mes-stdout;
|
||||
if [ ! "$mesc_p" ]; then
|
||||
#FIXME: c&p
|
||||
unset CFLAGS CPPFLAGS LDFLAGS gcc_p tcc_p posix_p
|
||||
MES=guile
|
||||
mesc_p=1
|
||||
mes_p=1
|
||||
mes_arch=x86-mes
|
||||
program_prefix=$mes_arch-
|
||||
CC="./pre-inst-env mescc"
|
||||
sh ${srcdest}build-aux/test-cc.sh $1
|
||||
fi
|
||||
|
|
|
@ -1,85 +0,0 @@
|
|||
#! /bin/sh
|
||||
|
||||
# GNU Mes --- Maxwell Equations of Software
|
||||
# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Mes.
|
||||
#
|
||||
# GNU Mes is free software; you can redistribute it and/or modify it
|
||||
# under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 3 of the License, or (at
|
||||
# your option) any later version.
|
||||
#
|
||||
# GNU Mes is distributed in the hope that it will be useful, but
|
||||
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
set -e
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
MES_ARENA=100000000
|
||||
|
||||
GUILE=${GUILE-$MES}
|
||||
DIFF=${DIFF-$(command -v diff)} || true
|
||||
[ -z "$DIFF" ] && DIFF="sh scripts/diff.scm"
|
||||
|
||||
t=${1-scaffold/tests/t}
|
||||
o="$t"
|
||||
rm -f "$o".mes-out
|
||||
|
||||
rm -f "$o".gcc-out
|
||||
if [ -n "$CC" ]; then
|
||||
sh ${srcdest}build-aux/cc.sh "$t"
|
||||
|
||||
r=0
|
||||
[ -f "$t".exit ] && r=$(cat "$t".exit)
|
||||
set +e
|
||||
"$o".gcc-out $ARGS > "$o".gcc-stdout
|
||||
m=$?
|
||||
cat "$o".gcc-stdout
|
||||
set -e
|
||||
|
||||
[ $m = $r ]
|
||||
if [ -f "$t".expect ]; then
|
||||
$DIFF -ub "$t".expect "$o".gcc-stdout;
|
||||
fi
|
||||
fi
|
||||
|
||||
rm -f "$t".x86_64-mes-gcc-out
|
||||
if [ -n "$CC64" ]; then
|
||||
sh ${srcdest}build-aux/cc64-mes.sh "$t"
|
||||
|
||||
r=0
|
||||
[ -f "$t".exit ] && r=$(cat "$t".exit)
|
||||
set +e
|
||||
"$o".x86_64-mes-gcc-out $ARGS > "$o".x86_64-mes-gcc-stdout
|
||||
m=$?
|
||||
cat "$t".x86_64-mes-gcc-stdout
|
||||
set -e
|
||||
|
||||
[ $m = $r ]
|
||||
if [ -f "$t".expect ]; then
|
||||
$DIFF -ub "$t".expect "$o".x86_64-mes-gcc-stdout;
|
||||
fi
|
||||
fi
|
||||
|
||||
rm -f "$o".x86_64-mes-out
|
||||
sh ${srcdest}build-aux/cc-x86_64-mes.sh "$t"
|
||||
|
||||
r=0
|
||||
[ -f "$t".exit ] && r=$(cat "$t".exit)
|
||||
set +e
|
||||
"$o".x86_64-mes-out $ARGS > "$o".x86_64-mes-stdout
|
||||
m=$?
|
||||
cat "$o".x86_64-mes-stdout
|
||||
set -e
|
||||
|
||||
[ $m = $r ]
|
||||
if [ -f "$t".expect ]; then
|
||||
$DIFF -ub "$t".expect "$o".x86_64-mes-stdout;
|
||||
fi
|
|
@ -20,12 +20,7 @@
|
|||
|
||||
#set -e
|
||||
|
||||
srcdest="@srcdest@"
|
||||
srcdir="@srcdir@"
|
||||
abs_top_srcdir="@abs_top_srcdir@"
|
||||
abs_top_builddir="@abs_top_builddir@"
|
||||
prefix=${prefix-@prefix@}
|
||||
|
||||
. ./config.status
|
||||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
|
@ -44,15 +39,11 @@ moduledir=${moduledir-$datadir/mes/module}
|
|||
guile_site_dir=${guile_site_dir-$prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION}
|
||||
guile_site_ccache_dir=${guile_site_ccache_dir-$prefix/lib/guile/$GUILE_EFFECTIVE_VERSION/site-ccache}
|
||||
|
||||
mkdir -p $DESTDIR$prefix/bin
|
||||
cp src/mes $DESTDIR$prefix/bin/mes
|
||||
|
||||
mkdir -p $DESTDIR$prefix/lib
|
||||
mkdir -p $DESTDIR$MES_PREFIX/lib
|
||||
cp scripts/mescc $DESTDIR$prefix/bin/mescc
|
||||
MES_PREFIX=${MES_PREFIX-$prefix/share/mes}
|
||||
|
||||
rm $DESTDIR$prefix/bin/mes
|
||||
rm $DESTDIR$prefix/bin/mescc
|
||||
rm -f $DESTDIR$prefix/bin/diff.scm
|
||||
rmdir $DESTDIR$prefix/bin || :
|
||||
|
||||
for i in\
|
||||
|
@ -77,6 +68,16 @@ rm -r $DESTDIR$guile_site_ccache_dir/mescc
|
|||
rm -r $DESTDIR$guile_site_dir/mes
|
||||
rm -r $DESTDIR$guile_site_dir/mescc
|
||||
|
||||
rm $DESTDIR$prefix/share/info/dir
|
||||
rm $DESTDIR$prefix/share/info/mes.info*
|
||||
rm $DESTDIR$prefix/share/info/images/gcc-mesboot*
|
||||
rm $DESTDIR$prefix/share/info/images/README
|
||||
rm $DESTDIR$mandir/man1/mes.1
|
||||
rm $DESTDIR$mandir/man1/mescc.1
|
||||
|
||||
rmdir -p $DESTDIR$prefix/share/doc
|
||||
rmdir -p $DESTDIR$prefix/share/info/images
|
||||
rmdir -p $DESTDIR$guile_site_dir
|
||||
rmdir -p $DESTDIR$guile_site_ccache_dir
|
||||
rmdir -p $DESTDIR$mandir/man1
|
||||
true
|
||||
|
|
|
@ -1,24 +1,6 @@
|
|||
#! /bin/sh
|
||||
# -*- scheme -*-
|
||||
unset LANG LC_ALL
|
||||
guile=$(command -v ${GUILE-guile})
|
||||
guix=$(command -v ${GUIX-guix})
|
||||
if [ -n "$guix" ] ; then
|
||||
install="guix environment -l .guix.scm"
|
||||
else
|
||||
install="sudo apt-get install guile-2.2-dev"
|
||||
fi
|
||||
if [ -z "$guile" ]; then
|
||||
cat <<EOF
|
||||
|
||||
Missing dependencies: ${GUILE-guile}, please install Guile 2.2 or later; run
|
||||
$install
|
||||
EOF
|
||||
exit 1
|
||||
fi
|
||||
GUILE=$guile
|
||||
export GUILE
|
||||
exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
|
||||
# -*-scheme-*-
|
||||
MES_ARENA=100000000 exec ${SCHEME-guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
|
||||
!#
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
|
@ -44,16 +26,38 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
|
|||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-9 gnu)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (ice-9 and-let-star)
|
||||
#:use-module (ice-9 curried-definitions)
|
||||
#:use-module (ice-9 getopt-long)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 optargs)
|
||||
#:use-module (ice-9 popen)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 regex)
|
||||
#:export (main))
|
||||
|
||||
(cond-expand
|
||||
(guile)
|
||||
(mes (mes-use-module (srfi srfi-1))
|
||||
(mes-use-module (srfi srfi-9))
|
||||
(mes-use-module (srfi srfi-9 gnu))
|
||||
(mes-use-module (srfi srfi-26))
|
||||
(mes-use-module (mes getopt-long))
|
||||
(mes-use-module (mes guile))
|
||||
(mes-use-module (mes misc))
|
||||
(mes-use-module (mes optargs))
|
||||
(define %host-type "x86_64-unknown-linux-gnu")
|
||||
(define OPEN_READ "r")
|
||||
(define (canonicalize-path o)
|
||||
(if (string-prefix? "/" o) o
|
||||
(string-append (getcwd) "/" o)))
|
||||
(define (sort lst less)
|
||||
lst)
|
||||
(define (close-pipe o) 0)
|
||||
(define (open-pipe* OPEN_READ . commands)
|
||||
(let ((fake-pipe ".pipe"))
|
||||
(with-output-to-file fake-pipe
|
||||
(lambda _
|
||||
(let ((status (apply system* (append commands))))
|
||||
(set! close-pipe (lambda _ status)))))
|
||||
(open-input-file fake-pipe)))))
|
||||
|
||||
(define* (PATH-search-path name #:key (default name) warn?)
|
||||
(or (search-path (string-split (getenv "PATH") #\:) name)
|
||||
(and (and warn? (format (current-error-port) "warning: not found: ~a\n" name))
|
||||
|
@ -80,22 +84,17 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
|
|||
(define (verbose string . rest)
|
||||
(if %verbose? (apply stderr (cons string rest))))
|
||||
|
||||
(define (gulp-pipe command)
|
||||
(let* ((port (open-pipe* OPEN_READ *shell* "-c" command))
|
||||
(define (gulp-pipe* . command)
|
||||
(let* ((err (current-error-port))
|
||||
(foo (set-current-error-port (open-output-file ".error")))
|
||||
(port (apply open-pipe* OPEN_READ command))
|
||||
(output (read-string port))
|
||||
(status (close-pipe port)))
|
||||
(verbose "command[~a]: ~s => ~a\n" status command output)
|
||||
(if (not (zero? status)) "" (string-trim-right output #\newline))))
|
||||
|
||||
(define* ((->string #:optional (infix "")) h . t)
|
||||
(let ((o (if (pair? t) (cons h t) h)))
|
||||
(match o
|
||||
((? char?) (make-string 1 o))
|
||||
((? number?) (number->string o))
|
||||
((? string?) o)
|
||||
((? symbol?) (symbol->string o))
|
||||
((h ... t) (string-join (map (->string) o) ((->string) infix)))
|
||||
(_ ""))))
|
||||
(status (close-pipe port))
|
||||
(error (with-input-from-file ".error" read-string)))
|
||||
(set-current-error-port err)
|
||||
(verbose "command[~a]: ~s => ~a [~a]\n" status command output error)
|
||||
(if (not (zero? status)) ""
|
||||
(string-trim-right (string-append output error)))))
|
||||
|
||||
(define (tuple< a b)
|
||||
(cond
|
||||
|
@ -120,24 +119,39 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
|
|||
(define (string-replace-char string from to)
|
||||
(string-map (cut char->char from to <>) string))
|
||||
|
||||
(define (string-replace-string string from to)
|
||||
(cond ((string-contains string from)
|
||||
=> (lambda (i) (string-replace string to i (+ i (string-length from)))))
|
||||
(else string)))
|
||||
|
||||
(define (string-replace-string/all string from to)
|
||||
(or (and=> (string-contains string from)
|
||||
(lambda (i)
|
||||
(string-append
|
||||
(substring string 0 i)
|
||||
to
|
||||
(string-replace-string/all
|
||||
(substring string (+ i (string-length from))) from to))))
|
||||
string))
|
||||
|
||||
;;; Configure
|
||||
|
||||
(define-immutable-record-type <dependency>
|
||||
(make-depedency name version-expected optional? version-option commands file-name)
|
||||
(make-dependency name version-expected optional? version-option commands file-name data version-found)
|
||||
dependency?
|
||||
(name dependency-name)
|
||||
(version-expected dependency-version-expected)
|
||||
(version-option dependency-version-option)
|
||||
(optional? dependency-optional?)
|
||||
(version-option dependency-version-option)
|
||||
(commands dependency-commands)
|
||||
(file-name dependency-file-name)
|
||||
(data dependency-data)
|
||||
(version-found dependency-version-found))
|
||||
|
||||
(define* (make-dep name #:optional (version '(0))
|
||||
#:key optional? (version-option "--version") (commands (list name)) file-name)
|
||||
(define* (make-dep name #:key (version '(0)) optional? (version-option "--version") (commands (list name)) file-name data)
|
||||
(let* ((env-var (getenv (name->shell-name name)))
|
||||
(commands (if env-var (cons env-var commands) commands)))
|
||||
(make-depedency name version optional? version-option commands file-name)))
|
||||
(make-dependency name version optional? version-option commands file-name data #f)))
|
||||
|
||||
(define (find-dep name deps)
|
||||
(find (compose (cut equal? <> name) dependency-name) deps))
|
||||
|
@ -153,18 +167,23 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
|
|||
(define (name->shell-name name)
|
||||
(string-upcase (string-replace-char name #\- #\_)))
|
||||
|
||||
(define (->string o)
|
||||
(cond ((number? o) (number->string o))
|
||||
((string? o) o)
|
||||
(else (format #f "~a" o))))
|
||||
|
||||
(define (version->string version)
|
||||
((->string '.) version))
|
||||
(and version (string-join (map ->string version) ".")))
|
||||
|
||||
(define (string->version string)
|
||||
(and-let* ((version (string-tokenize string
|
||||
(char-set-adjoin char-set:digit #\.)))
|
||||
((pair? version))
|
||||
(version (sort version (lambda (a b) (> (string-length a) (string-length b)))))
|
||||
(version (car version))
|
||||
(version (string-tokenize version
|
||||
(char-set-complement (char-set #\.)))))
|
||||
(map string->number version)))
|
||||
(let ((split (string-tokenize string
|
||||
(char-set-adjoin char-set:digit #\.))))
|
||||
(and (pair? split)
|
||||
(let* ((version (sort split (lambda (a b) (> (string-length a) (string-length b)))))
|
||||
(version (car version))
|
||||
(version (string-tokenize version
|
||||
(char-set-complement (char-set #\.)))))
|
||||
(map string->number version)))))
|
||||
|
||||
(define (check-program-version dependency)
|
||||
(let ((name (dependency-name dependency))
|
||||
|
@ -174,15 +193,20 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
|
|||
(let loop ((commands commands))
|
||||
(if (null? commands) dependency
|
||||
(let ((command (car commands)))
|
||||
(stdout "checking for ~a~a... " command
|
||||
(stdout "checking for ~a~a... " name
|
||||
(if (null? expected) ""
|
||||
(format #f " [~a]" (version->string expected))))
|
||||
(let* ((output (gulp-pipe (format #f "~a ~a 2>&1" command version-option)))
|
||||
(let* ((output (gulp-pipe* command version-option))
|
||||
;;(foo (stderr "output=~s\n" output))
|
||||
(actual (string->version output))
|
||||
;;(foo (stderr "actual=~s\n" actual))
|
||||
;;(foo (stderr "expected=~s\n" expected))
|
||||
(pass? (and actual (tuple< expected actual)))
|
||||
;;(foo (stderr "PASS?~s\n" pass?))
|
||||
(dependency (set-field dependency (dependency-version-found) actual)))
|
||||
(stdout "~a ~a\n" (if pass? (if (pair? actual) "" " yes")
|
||||
(if actual " no, found" "no")) (version->string actual))
|
||||
(if actual " no, found" "no"))
|
||||
(or (version->string actual) ""))
|
||||
(if pass? (let ((file-name (or (PATH-search-path command)
|
||||
(dependency-file-name dependency))))
|
||||
(set-field dependency (dependency-file-name) file-name))
|
||||
|
@ -195,29 +219,64 @@ exec ${guile} -L . --no-auto-compile -e '(configure)' -s "$0" ${1+"$@"}
|
|||
(stdout "~a\n" (or file-name ""))
|
||||
(set-field dependency (dependency-file-name) file-name)))
|
||||
|
||||
(define* (check-header-c dependency #:optional (check check-compile-header-c))
|
||||
(define* (check-header-c cc dependency #:optional (check check-preprocess-header-c))
|
||||
(let ((name (dependency-name dependency)))
|
||||
(stderr "checking for ~a..." name)
|
||||
(let ((result (check name)))
|
||||
(let ((result (check cc name)))
|
||||
(stderr " ~a\n" (if result "yes" "no"))
|
||||
(if result (set-field dependency (dependency-file-name) name)
|
||||
dependency-file-name))))
|
||||
dependency))))
|
||||
|
||||
(define (check-compile-header-c header)
|
||||
(zero? (system (format #f "echo '#include ~s' | gcc -E - > /dev/null 2>&1" header))))
|
||||
(define* (check-compile-c cc dependency #:optional (check check-compile-string-c))
|
||||
(let ((name (dependency-name dependency)))
|
||||
(stderr "checking for ~a..." name)
|
||||
(let ((result (check cc (dependency-data dependency))))
|
||||
(stderr " ~a\n" (if result "yes" "no"))
|
||||
(if result (set-field dependency (dependency-file-name) name)
|
||||
dependency))))
|
||||
|
||||
(define* (check-link-c cc dependency #:optional (check check-link-string-c))
|
||||
(let ((name (dependency-name dependency)))
|
||||
(stderr "checking for ~a..." name)
|
||||
(let ((result (check cc (dependency-data dependency))))
|
||||
(stderr " ~a\n" (if result "yes" "no"))
|
||||
(if result (set-field dependency (dependency-file-name) name)
|
||||
dependency))))
|
||||
|
||||
(define (check-preprocess-header-c cc header)
|
||||
(with-output-to-file ".config.c"
|
||||
(cut format #t "#include \"~a\"" header))
|
||||
(with-error-to-file "/dev/null"
|
||||
(cut zero? (system* cc "-E" "-o" ".config.E" ".config.c"))))
|
||||
|
||||
(define (check-compile-string-c cc string)
|
||||
(with-output-to-file ".config.c"
|
||||
(cut display string))
|
||||
(with-error-to-file "/dev/null"
|
||||
(cut zero? (system* cc "--std=gnu99" "-c" "-o" ".config.o" ".config.c"))))
|
||||
|
||||
(define (check-link-string-c cc string)
|
||||
(with-output-to-file ".config.c"
|
||||
(cut display string))
|
||||
(with-error-to-file "/dev/null"
|
||||
(cut zero? (system* cc "--std=gnu99" "-o" ".config" ".config.c"))))
|
||||
|
||||
(define (parse-opts args)
|
||||
(let* ((option-spec
|
||||
'((build (value #t))
|
||||
(host (value #t))
|
||||
(help (single-char #\h))
|
||||
|
||||
(prefix (value #t))
|
||||
(program-prefix (value #t))
|
||||
(bindir (value #t))
|
||||
(datadir (value #t))
|
||||
(docdir (value #t))
|
||||
(libdir (value #t))
|
||||
(srcdir (value #t))
|
||||
(sysconfdir (value #t))
|
||||
|
||||
(mes)
|
||||
(help (single-char #\h))
|
||||
(verbose (single-char #\v))
|
||||
(with-cheating)
|
||||
(with-courage)
|
||||
|
@ -254,8 +313,9 @@ Options:
|
|||
-h, --help display this help
|
||||
--build=BUILD configure for building on BUILD [guessed]
|
||||
--disable-silent-rules
|
||||
verbose build output [BUILD_DEBUG=1]
|
||||
verbose build output [V=1]
|
||||
--host=HOST cross-compile to build programs to run on HOST [BUILD]
|
||||
--mes use Mes C Library
|
||||
-v, --verbose be verbose
|
||||
--with-courage assert being courageous to configure for unsupported platform
|
||||
--with-cheating cheat using Guile instead of Mes
|
||||
|
@ -265,6 +325,10 @@ Installation directories:
|
|||
--infodir=DIR info documentation [PREFIX/share/info]
|
||||
--mandir=DIR man pages [PREFIX/share/man]
|
||||
|
||||
Program names:
|
||||
--program-prefix=PREFIX prepend PREFIX to installed program names
|
||||
--program-suffix=SUFFIX append SUFFIX to installed program names
|
||||
|
||||
Ignored for Guix:
|
||||
--enable-fast-install
|
||||
|
||||
|
@ -280,29 +344,23 @@ Ignored for Debian:
|
|||
Some influential environment variables:
|
||||
CC C compiler command
|
||||
CFLAGS C compiler flags
|
||||
CC32 x86 C compiler command
|
||||
CC64_CFLAGS x86_64 C compiler flags
|
||||
CC64 x86_64 C compiler command
|
||||
CC32_CFLAGS x86 C compiler flags
|
||||
GUILE guile command
|
||||
GUILE_TOOLS guile-tools command
|
||||
MES_CFLAGS MesCC flags
|
||||
GUILD guild command
|
||||
MES_FOR_BUILD build system MES [can be mes or guile]
|
||||
MES_SEED location of mes-seed
|
||||
MESCC_TOOLS_SEED location of mescc-tools-seed
|
||||
TCC tcc C compiler command
|
||||
TINYCC_PREFIX location of tinycc [for tests/test2]
|
||||
TINYCC_SEED location of tinycc-seed
|
||||
" PACKAGE VERSION (getenv "prefix")))
|
||||
|
||||
(define (main args)
|
||||
(let* ((options (parse-opts args))
|
||||
(build-type (option-ref options 'build %host-type))
|
||||
|
||||
(arch (car (string-split build-type #\-)))
|
||||
(host-type (option-ref options 'host %host-type))(prefix "/usr/local")
|
||||
|
||||
(prefix "/usr/local")
|
||||
(prefix (option-ref options 'prefix prefix))
|
||||
(program-prefix (option-ref options 'program-prefix ""))
|
||||
(program-suffix (option-ref options 'program-suffix ""))
|
||||
(infodir (option-ref options 'infodir "${prefix}/share/info"))
|
||||
(mandir (option-ref options 'infodir "${prefix}/share/man"))
|
||||
(sysconfdir (option-ref options 'sysconfdir "${prefix}/etc"))
|
||||
|
@ -312,7 +370,7 @@ Some influential environment variables:
|
|||
(docdir (option-ref options 'docdir "${datadir}/doc/mes-${VERSION}"))
|
||||
(libdir (option-ref options 'libdir "${prefix}/lib"))
|
||||
(moduledir "${datadir}/mes/module")
|
||||
(moduledir/ (gulp-pipe (string-append "echo " prefix "/share/mes/module/")))
|
||||
(moduledir/ (gulp-pipe* "echo" prefix "/share/mes/module/"))
|
||||
(guile-effective-version (effective-version))
|
||||
(guile-site-dir (if (equal? prefix ".") (canonicalize-path ".")
|
||||
(string-append "${prefix}/share/guile/site/" guile-effective-version)))
|
||||
|
@ -332,7 +390,8 @@ Some influential environment variables:
|
|||
(disable-silent-rules? (option-ref options 'disable-silent-rules #f))
|
||||
(enable-silent-rules? (option-ref options 'enable-silent-rules #f))
|
||||
(vars (filter (cut string-index <> #\=) (option-ref options '() '())))
|
||||
(help? (option-ref options 'help #f)))
|
||||
(help? (option-ref options 'help #f))
|
||||
(mes? (option-ref options 'mes #f)))
|
||||
(when help?
|
||||
(print-help)
|
||||
(exit 0))
|
||||
|
@ -342,57 +401,87 @@ Some influential environment variables:
|
|||
(for-each (lambda (v) (apply setenv (string-split v #\=))) vars)
|
||||
(let* ((mes-seed (or (getenv "MES_SEED")
|
||||
(string-append srcdest "../mes-seed")))
|
||||
(mes-seed (and mes-seed
|
||||
(file-exists? (string-append mes-seed "/x86-mes/mes.S"))
|
||||
mes-seed))
|
||||
(tinycc-prefix (or (getenv "TINYCC_PREFIX")
|
||||
(string-append srcdest "../tinycc-prefix")))
|
||||
(tinycc-seed (or (getenv "TINYCC_SEED")
|
||||
(string-append srcdest "../tinycc-seed")))
|
||||
(mescc-tools-seed (or (getenv "MESCC_TOOLS_SEED")
|
||||
(string-append srcdest "../mescc-tools-seed")))
|
||||
(gcc (or (getenv "CC") "gcc"))
|
||||
(tcc (or (getenv "TCC") "tcc"))
|
||||
(mescc (or (getenv "MESCC") "mescc"))
|
||||
(deps (fold (lambda (program results)
|
||||
(cons (check-program-version program) results))
|
||||
'()
|
||||
(list (make-dep "guile" '(2 0) #:commands '("guile-2.2" "guile-2.0" "guile-2" "guile"))
|
||||
(make-dep "guix" '(0 13) #:optional? #t)
|
||||
(make-dep "bash" '(2 0) #:optional? #t)
|
||||
(make-dep "guile-tools" '(2 0))
|
||||
(make-dep "mes-seed" '(0 18) #:optional? #t
|
||||
#:commands (list (string-append mes-seed "/refresh.sh"))
|
||||
#:file-name mes-seed)
|
||||
(make-dep "tinycc-seed" '(0 18) #:optional? #t
|
||||
#:commands (list (string-append tinycc-seed "/refresh.sh"))
|
||||
#:file-name tinycc-seed)
|
||||
(make-dep "cc" '(2 95) #:commands '("gcc"))
|
||||
(make-dep "make" '(4))
|
||||
(make-dep "cc32" '(2 95)
|
||||
#:optional? #t
|
||||
#:commands '("i686-unknown-linux-gnu-gcc"))
|
||||
(make-dep "cc64" '(2 95)
|
||||
#:optional? #t
|
||||
#:commands '("gcc"))
|
||||
(make-dep "M1" '(0 3))
|
||||
(make-dep "blood-elf" '(0 1))
|
||||
(make-dep "hex2" '(0 3))
|
||||
(make-dep "tcc" '(0 9 26) #:optional? #t #:version-option "-v")
|
||||
(make-dep "makeinfo" '(5) #:optional? #t)
|
||||
(make-dep "dot" '(2) #:version-option "-V")
|
||||
(make-dep "help2man" '(1 47) #:optional? #t)
|
||||
(make-dep "perl" '(5) #:optional? #t)
|
||||
(make-dep "git" '(2) #:optional? #t))))
|
||||
(deps (cons (check-program-version (make-dep "nyacc" '(0 86 0) #:commands (list (string-append (file-name "guile" deps) " -c '(use-modules (nyacc lalr)) (display *nyacc-version*)'")) #:file-name #t))
|
||||
deps))
|
||||
(deps (if (file-name "cc" deps)
|
||||
(cons* (check-header-c (make-dep "stdio.h"))
|
||||
(check-header-c (make-dep "limits.h"))
|
||||
(list (make-dep "hex2" #:version '(0 3))
|
||||
(make-dep "M1" #:version '(0 3))
|
||||
(make-dep "blood-elf" #:version '(0 1))
|
||||
(make-dep "guile" #:version '(2 0) #:commands '("guile-2.2" "guile-2.0" "guile-2" "guile") #:optional? #t)
|
||||
(make-dep "mes" #:version '(0 18) #:optional? #t)
|
||||
(make-dep "guix" #:version '(0 13) #:optional? #t)
|
||||
(make-dep "ar" #:version '(2 10) #:optional? #t)
|
||||
(make-dep "bash" #:version '(2 0) #:optional? #t)
|
||||
(make-dep "guild" #:version '(2 0) #:commands '("guild" "guile-tools"))
|
||||
(make-dep "cc" #:commands (list gcc tcc mescc) #:optional? #t)
|
||||
(make-dep "make" #:optional? #t)
|
||||
(make-dep "makeinfo" #:optional? #t)
|
||||
(make-dep "dot" #:version-option "-V")
|
||||
(make-dep "help2man" #:version '(1 47) #:optional? #t)
|
||||
(make-dep "perl" #:version '(5) #:optional? #t)
|
||||
(make-dep "git" #:version '(2) #:optional? #t))))
|
||||
(guile (file-name "guile" deps))
|
||||
(deps (if guile (cons (check-program-version (make-dep "nyacc" #:version '(0 86 0) #:commands (list (string-append guile " -c '(use-modules (nyacc lalr)) (display *nyacc-version*)'")) #:file-name #t))
|
||||
deps)
|
||||
deps))
|
||||
(guile (or guile "guile"))
|
||||
(cc (file-name "cc" deps))
|
||||
(deps (if cc
|
||||
(cons* (check-header-c cc (make-dep "limits.h"))
|
||||
(check-header-c cc (make-dep "stdio.h" #:optional? #t))
|
||||
deps)
|
||||
deps))
|
||||
(deps (cons (check-file (make-dep "mescc-tools-seed" '(0) #:optional? #t
|
||||
#:file-name mescc-tools-seed))
|
||||
deps))
|
||||
(deps (cons (check-file (make-dep "tinycc-prefix" '(0) #:optional? #t
|
||||
(deps (cons (check-file (make-dep "tinycc-prefix" #:optional? #t
|
||||
#:file-name tinycc-prefix))
|
||||
deps))
|
||||
(missing (filter (conjoin (negate dependency-file-name)
|
||||
(negate dependency-optional?)) deps)))
|
||||
(negate dependency-optional?)) deps))
|
||||
(deps (if cc
|
||||
(cons (check-compile-c cc (make-dep "cc is GNU C" #:data "#if !defined (__GNUC__)
|
||||
#error no gnuc
|
||||
#endif
|
||||
"))
|
||||
deps)
|
||||
deps))
|
||||
(gcc? (file-name "cc is GNU C" deps))
|
||||
(deps (if cc
|
||||
(cons (check-compile-c cc (make-dep "cc is Mes C" #:data "#if !defined (__MESC__)
|
||||
#error no mesc
|
||||
#endif
|
||||
"))
|
||||
deps)
|
||||
deps))
|
||||
(mesc? (file-name "cc is Mes C" deps))
|
||||
(deps (if cc
|
||||
(cons (check-compile-c cc (make-dep "cc is Tiny CC" #:data "#if !defined (__TINYCC__)
|
||||
#error no tinycc
|
||||
#endif
|
||||
"))
|
||||
deps)
|
||||
deps))
|
||||
(tcc? (file-name "cc is Tiny CC" deps))
|
||||
(deps (if cc
|
||||
(cons (check-link-c cc (make-dep "if cc can create executables" #:data "int main () {return 0;}"))
|
||||
deps)
|
||||
deps))
|
||||
(mes? (or mes? (not (file-name "if cc can create executables" deps))))
|
||||
(build-type (or (and cc (gulp-pipe* cc "-dumpmachine")) build-type))
|
||||
(arch (car (string-split build-type #\-)))
|
||||
(arch (if (member arch '("i386" "i486" "i586" "i686")) "x86"
|
||||
arch))
|
||||
(mes-arch arch)
|
||||
(mes-arch (if mes? (string-append mes-arch "-mes") mes-arch))
|
||||
(mes-arch (if gcc? (string-append mes-arch "-gcc") mes-arch))
|
||||
(mes-arch (if tcc? (string-append mes-arch "-gcc") mes-arch))
|
||||
(posix? (and (not mesc?) (not mes?))))
|
||||
|
||||
(define* (substitute file-name pairs
|
||||
#:key (target (if (string-suffix? ".in" file-name)
|
||||
|
@ -400,12 +489,15 @@ Some influential environment variables:
|
|||
(system* "mkdir" "-p" (dirname target))
|
||||
(with-output-to-file target
|
||||
(lambda _
|
||||
(display
|
||||
(fold (lambda (o result)
|
||||
(regexp-substitute/global #f (car o) result 'pre (cdr o) 'post))
|
||||
(with-input-from-file file-name read-string) pairs)))))
|
||||
(let ((in (open-input-file file-name)))
|
||||
(let loop ((line (read-line in 'concat)))
|
||||
(when (not (eof-object? line))
|
||||
(display (fold (lambda (o result)
|
||||
(string-replace-string/all result (car o) (cdr o)))
|
||||
line pairs))
|
||||
(loop (read-line in 'concat))))))))
|
||||
|
||||
(when (and (not (member arch '("i686" "x86_64"))) (not with-courage?))
|
||||
(when (and (not (member arch '("x86" "x86_64"))) (not with-courage?))
|
||||
(stderr "platform not supported: ~a, try --with-courage\n" arch)
|
||||
(exit 1))
|
||||
(when (pair? missing)
|
||||
|
@ -418,71 +510,72 @@ Some influential environment variables:
|
|||
(and (zero? (system* "git" "init"))
|
||||
(zero? (system* "git" "add" "."))
|
||||
(zero? (system* "git" "commit" "--allow-empty" "-m" "Import mes")))))
|
||||
(with-output-to-file ".config.make"
|
||||
(lambda _
|
||||
(stdout "PACKAGE:=~a\n" PACKAGE)
|
||||
(stdout "VERSION:=~a\n" VERSION)
|
||||
|
||||
(stdout "arch:=~a\n" arch)
|
||||
(stdout "build:=~a\n" build-type)
|
||||
(stdout "host:=~a\n" host-type)
|
||||
(let ((pairs `(("@PACKAGE@" . ,PACKAGE)
|
||||
("@VERSION@" . ,VERSION)
|
||||
|
||||
(stdout "top_builddir:=~a\n" top-builddir)
|
||||
(stdout "abs_top_builddir:=~a\n" abs-top-builddir)
|
||||
(stdout "abs_top_srcdir:=~a\n" abs-top-srcdir)
|
||||
("@arch@" . ,arch)
|
||||
("@build@" . ,build-type)
|
||||
("@host@" . ,host-type)
|
||||
|
||||
(stdout "srcdest:=~a\n" srcdest)
|
||||
(stdout "srcdir:=~a\n" srcdir)
|
||||
("@gcc_p@" . ,(if gcc? "1" ""))
|
||||
("@mes_arch@" . ,mes-arch)
|
||||
("@mes_p@" . ,(if mes? "1" ""))
|
||||
("@mesc_p@" . ,(if mesc? "1" ""))
|
||||
("@posix_p@" . ,(if posix? "1" ""))
|
||||
("@tcc_p@" . ,(if tcc? "1" ""))
|
||||
|
||||
(stdout "prefix:=~a\n" (gulp-pipe (string-append "echo " prefix)))
|
||||
(stdout "datadir:=~a\n" datadir)
|
||||
(stdout "docdir:=~a\n" docdir)
|
||||
|
||||
(stdout "bindir:=~a\n" bindir)
|
||||
(stdout "guile_site_ccache_dir:=~a\n" guile-site-ccache-dir)
|
||||
(stdout "guile_site_dir:=~a\n" guile-site-dir)
|
||||
(stdout "infodir:=~a\n" infodir)
|
||||
(stdout "libdir:=~a\n" libdir)
|
||||
(stdout "mandir:=~a\n" mandir)
|
||||
(stdout "moduledir:=~a\n" moduledir)
|
||||
(stdout "sysconfdir:=~a\n" sysconfdir)
|
||||
|
||||
(for-each (lambda (o)
|
||||
(stdout "~a:=~a\n" (variable-name o) (or (dependency-file-name o) "")))
|
||||
deps)
|
||||
(stdout "GUILE_EFFECTIVE_VERSION:=~a\n" (effective-version))
|
||||
|
||||
(when disable-silent-rules?
|
||||
(stdout "V:=1\n"))
|
||||
|
||||
(when with-cheating?
|
||||
(stdout "MES:=guile\n"))
|
||||
|
||||
(for-each (lambda (o)
|
||||
(stdout "~a:=~a\n" o (or (getenv o) "")))
|
||||
'(
|
||||
"CFLAGS"
|
||||
"CC32_CFLAGS"
|
||||
"CC64_CFLAGS"
|
||||
"HEX2FLAGS"
|
||||
"M1FLAGS"
|
||||
"MES_CFLAGS"
|
||||
))))
|
||||
|
||||
(let ((pairs `(("@srcdest@" . ,srcdest)
|
||||
("@srcdir@" . ,srcdir)
|
||||
("@abs_top_srcdir@" . ,abs-top-srcdir)
|
||||
("@abs_top_builddir@" . ,abs-top-builddir)
|
||||
("@top_builddir@" . ,top-builddir)
|
||||
("@BASH@" . ,(file-name "bash" deps))
|
||||
("@GUILE@" . ,(file-name "guile" deps))
|
||||
("@MES@" . ,(file-name "guile" deps))
|
||||
|
||||
("@srcdest@" . ,srcdest)
|
||||
("@srcdir@" . ,srcdir)
|
||||
|
||||
("@prefix@" . ,prefix)
|
||||
("@guile_site_dir@" . ,guile-site-dir)
|
||||
("@program_prefix@" . ,program-prefix)
|
||||
("@bindir@" . ,bindir)
|
||||
("@datadir@" . ,datadir)
|
||||
("@docdir@" . ,docdir)
|
||||
("@guile_site_ccache_dir@" . ,guile-site-ccache-dir)
|
||||
("@VERSION@" . ,VERSION)
|
||||
("@arch@" . ,arch)
|
||||
("mes/module/" . ,(string-append moduledir/)))))
|
||||
("@guile_site_dir@" . ,guile-site-dir)
|
||||
("@infodir@" . ,infodir)
|
||||
("@libdir@" . ,libdir)
|
||||
("@mandir@" . ,mandir)
|
||||
("@moduledir@" . ,moduledir)
|
||||
("@sysconfdir@" . ,sysconfdir)
|
||||
|
||||
("@GUILE_EFFECTIVE_VERSION@" . ,(effective-version))
|
||||
("@V@" . ,(if disable-silent-rules? 1 0))
|
||||
|
||||
("@AR@" . ,(file-name "ar" deps))
|
||||
("@BASH@" . ,(file-name "bash" deps))
|
||||
("@CC@" . ,(or (file-name "cc" deps) ""))
|
||||
("@DOT@" . ,(file-name "dot" deps))
|
||||
("@GIT@" . ,(or (file-name "git" deps) ""))
|
||||
("@GUILE@" . ,guile)
|
||||
("@GUIX@" . ,(or (file-name "guix" deps) ""))
|
||||
("@HELP2MAN@" . ,(file-name "help2man" deps))
|
||||
("@MAKEINFO@" . ,(file-name "makeinfo" deps))
|
||||
("@MES_FOR_BUILD@" . ,(or (file-name "mes" deps)
|
||||
guile))
|
||||
("@MES_SEED@" . ,(or mes-seed ""))
|
||||
("@PERL@" . ,(file-name "perl" deps))
|
||||
|
||||
("@CFLAGS@" . ,(or (getenv "CFLAGS") ""))
|
||||
("@HEX2FLAGS@" . ,(or (getenv "HEX2FLAGS") ""))
|
||||
("@M1FLAGS@" . ,(or (getenv "M1FLAGS") ""))
|
||||
|
||||
("mes/module/" . ,(string-append moduledir/))
|
||||
,@(map
|
||||
(lambda (o)
|
||||
(cons (string-append "@" (variable-name o) "@") (or (format #f "~a" (dependency-file-name o)) "")))
|
||||
deps))))
|
||||
|
||||
(when (and (not cc)
|
||||
(not mes-seed))
|
||||
(format (current-error-port) "must supply C compiler or MES_SEED/x86-mes/mes.S\n")
|
||||
(exit 2))
|
||||
(for-each (lambda (o)
|
||||
(let* ((src (string-append srcdest o))
|
||||
(target (string-drop-right o 3))
|
||||
|
@ -491,6 +584,7 @@ Some influential environment variables:
|
|||
(substitute src pairs #:target target)))
|
||||
'(
|
||||
"build-aux/GNUmakefile.in"
|
||||
"build-aux/config.status.in"
|
||||
"build-aux/build.sh.in"
|
||||
"build-aux/check.sh.in"
|
||||
"build-aux/install.sh.in"
|
||||
|
@ -498,17 +592,23 @@ Some influential environment variables:
|
|||
"build-aux/uninstall.sh.in"
|
||||
"mes/module/mes/boot-0.scm.in"
|
||||
"scripts/mescc.in"
|
||||
)))
|
||||
(chmod "build.sh" #o755)
|
||||
(chmod "check.sh" #o755)
|
||||
(chmod "install.sh" #o755)
|
||||
(chmod "pre-inst-env" #o755)
|
||||
(chmod "uninstall.sh" #o755)
|
||||
(chmod "scripts/mescc" #o755)
|
||||
))
|
||||
(chmod "pre-inst-env" #o755)
|
||||
(chmod "scripts/mescc" #o755)
|
||||
(chmod "build.sh" #o755)
|
||||
(chmod "check.sh" #o755)
|
||||
(chmod "install.sh" #o755)
|
||||
(chmod "uninstall.sh" #o755)
|
||||
(substitute (string-append srcdest "build-aux/config.make.in") pairs #:target ".config.make"))
|
||||
|
||||
(let ((make (and=> (file-name "make" deps) basename)))
|
||||
(format (current-output-port)
|
||||
"\nRun:
|
||||
"
|
||||
GNU Mes is configured for ~a
|
||||
|
||||
Run:
|
||||
~a to build mes
|
||||
~a help for help on other targets\n"
|
||||
mes-arch
|
||||
(or make "./build.sh")
|
||||
(or make "./build.sh"))))))
|
||||
|
|
163
configure.sh
163
configure.sh
|
@ -21,22 +21,55 @@
|
|||
set -e
|
||||
|
||||
VERSION=0.18
|
||||
|
||||
# parse --prefix=prefix
|
||||
cmdline=$(echo "$@")
|
||||
p=${cmdline##*--prefix=}
|
||||
p=${p% *}
|
||||
p=${p% -*}
|
||||
if [ -z "$p" ]; then
|
||||
p=${prefix-/usr/local}
|
||||
fi
|
||||
prefix=$p
|
||||
|
||||
srcdir=${srcdir-$(dirname $0)}
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
# parse --mes
|
||||
cmdline=$(echo " $@")
|
||||
p=${cmdline/ --mes/}
|
||||
if [ "$p" != "$cmdline" ]; then
|
||||
mes_p=${mes_p-1}
|
||||
fi
|
||||
|
||||
# parse --prefix=PREFIX
|
||||
p=${cmdline/ --prefix=/ -prefix=}
|
||||
if [ "$p" != "$cmdline" ]; then
|
||||
p=${p##* -prefix=}
|
||||
p=${p% *}
|
||||
p=${p% -*}
|
||||
prefix=${p-/usr/local}
|
||||
|
||||
else
|
||||
prefix=${prefix-/usr/local}
|
||||
fi
|
||||
|
||||
# parse --program-prefix=
|
||||
p=${cmdline/ --program-prefix=/ -program-prefix=}
|
||||
if [ "$p" != "$cmdline" ]; then
|
||||
p=${p##* -program-prefix=}
|
||||
p=${p% *}
|
||||
p=${p% -*}
|
||||
program_prefix=$p
|
||||
fi
|
||||
|
||||
AR=${AR-$(command -v ar)} || true
|
||||
BASH=${BASH-$(command -v bash)}
|
||||
BLOOD_ELF=${BLOOD_ELF-$(command -v blood-elf)}
|
||||
CC=${CC-$(command -v gcc)} || true
|
||||
GUILD=${GUILD-$(command -v guild)} || true
|
||||
GUILE_TOOLS=${GUILE_TOOLS-$(command -v guile-tools)} || true
|
||||
if [ ! "$GUILD" ]; then
|
||||
if [ "$GUILE_TOOLS" ]; then
|
||||
GUILD=$GUILE_TOOLS
|
||||
else
|
||||
GUILD=true
|
||||
fi
|
||||
fi
|
||||
GUILE=${GUILE-$(command -v guile)} || true
|
||||
HEX2=${HEX2-$(command -v hex2)}
|
||||
M1=${M1-$(command -v M1)}
|
||||
MES_FOR_BUILD=${MES_FOR_BUILD-$(command -v mes || command -v guile || echo mes)}
|
||||
MES_SEED=${MES_SEED-../mes-seed}
|
||||
|
||||
if [ "$srcdir" = . ]; then
|
||||
top_builddir=.
|
||||
|
@ -52,48 +85,126 @@ if [ -z "$GUILE" -o "$GUILE" = true ]; then
|
|||
else
|
||||
GUILE_EFFECTIVE_VERSION=${GUILE_EFFECTIVE_VERSION-$(guile -c '(display (effective-version))')}
|
||||
fi
|
||||
bindir=$(eval echo ${bindir-$prefix/bin})
|
||||
datadir=$(eval echo ${datadir-$prefix/share})
|
||||
docdir=$(eval echo ${docdir-$datadir/doc/mes-$VERSION})
|
||||
infodir=$(eval echo ${infodir-$datadir/info})
|
||||
libdir=$(eval echo ${libdir-$prefix/lib})
|
||||
mandir=$(eval echo ${mandir-$datadir/man})
|
||||
moduledir=$(eval echo ${moduledir-$datadir/mes/module})
|
||||
moduledir_="$moduledir/"
|
||||
guile_site_dir=$(eval echo ${guile_site_dir-$prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION})
|
||||
guile_site_ccache_dir=$(eval echo ${guile_site_ccache_dir-$prefix/lib/guile/$GUILE_EFFECTIVE_VERSION/site-ccache})
|
||||
arch=$(get_machine || uname -m)
|
||||
|
||||
subst () {
|
||||
sed \
|
||||
-e s,"@srcdest@,$srcdest,"\
|
||||
-e s,"@srcdir@,$srcdir,"\
|
||||
-e s,"@PACKAGE@,$PACKAGE,"\
|
||||
-e s,"@VERSION@,$VERSION,"\
|
||||
-e s,"@arch@,$arch,"\
|
||||
-e s,"@build@,$build,"\
|
||||
-e s,"@host@,$host,"\
|
||||
-e s,"@compiler@,$compiler,"\
|
||||
-e s,"@gcc_p@,$gcc_p,"\
|
||||
-e s,"@mes_p@,$mes_p,"\
|
||||
-e s,"@mesc_p@,$mesc_p,"\
|
||||
-e s,"@tcc_p@,$tcc_p,"\
|
||||
-e s,"@mes_arch@,$mes_arch,"\
|
||||
-e s,"@posix_p@,$posix_p,"\
|
||||
-e s,"@abs_top_srcdir@,$abs_top_srcdir,"\
|
||||
-e s,"@abs_top_builddir@,$abs_top_builddir,"\
|
||||
-e s,"@top_builddir@,$top_builddir,"\
|
||||
-e s,"@BASH@,$BASH,"\
|
||||
-e s,"@GUILE@,$GUILE,"\
|
||||
-e s,"@srcdest@,$srcdest,"\
|
||||
-e s,"@srcdir@,$srcdir,"\
|
||||
-e s,"@prefix@,$prefix,"\
|
||||
-e s,"@program_prefix@,$program_prefix,"\
|
||||
-e s,"@bindir@,$bindir,"\
|
||||
-e s,"@datadir@,$datadir,"\
|
||||
-e s,"@docdir@,$docdir,"\
|
||||
-e s,"@guile_site_dir@,$guile_site_dir,"\
|
||||
-e s,"@guile_site_ccache_dir@,$guile_site_ccache_dir,"\
|
||||
-e s,"@VERSION@,$VERSION,"\
|
||||
-e s,"@arch@,$arch,"\
|
||||
-e s,"@infodir@,$infodir,"\
|
||||
-e s,"@libdir@,$libdir,"\
|
||||
-e s,"@mandir@,$mandir,"\
|
||||
-e s,"@moduledir@,$moduledir,"\
|
||||
-e s,"@sysconfdir@,$sysconfdir,"\
|
||||
-e s,"@GUILE_EFFECTIVE_VERSION@,$GUILE_EFFECTIVE_VERSION,"\
|
||||
-e s,"@V@,$V,"\
|
||||
-e s,"@AR@,$AR,"\
|
||||
-e s,"@BASH@,$BASH,"\
|
||||
-e s,"@BLOOD_ELF@,$BLOOD_ELF,"\
|
||||
-e s,"@CC@,$CC,"\
|
||||
-e s,"@GUILD@,$GUILD,"\
|
||||
-e s,"@GUILE@,$GUILE,"\
|
||||
-e s,"@CFLAGS@,$CFLAGS,"\
|
||||
-e s,"@HEX2@,$HEX2,"\
|
||||
-e s,"@HEX2FLAGS@,$HEX2FLAGS,"\
|
||||
-e s,"@M1@,$M1,"\
|
||||
-e s,"@M1FLAGS@,$M1FLAGS,"\
|
||||
-e s,"@MES_FOR_BUILD@,$MES_FOR_BUILD,"\
|
||||
-e s,"@MES_SEED@,$MES_SEED,"\
|
||||
-e s,"mes/module/,$moduledir/,"\
|
||||
$1 > $2
|
||||
}
|
||||
|
||||
subst ${srcdest}build-aux/pre-inst-env.in pre-inst-env
|
||||
chmod +x pre-inst-env
|
||||
subst ${srcdest}mes/module/mes/boot-0.scm.in mes/module/mes/boot-0.scm
|
||||
subst ${srcdest}scripts/mescc.in scripts/mescc
|
||||
|
||||
subst ${srcdest}build-aux/GNUmakefile.in GNUmakefile
|
||||
subst ${srcdest}build-aux/build.sh.in build.sh
|
||||
subst ${srcdest}build-aux/check.sh.in check.sh
|
||||
subst ${srcdest}build-aux/install.sh.in install.sh
|
||||
subst ${srcdest}build-aux/uninstall.sh.in uninstall.sh
|
||||
|
||||
chmod +x scripts/mescc
|
||||
|
||||
host=${host-$($CC -dumpmachine 2>/dev/null || echo x86)}
|
||||
if [ -z "$host" ]; then
|
||||
arch=${arch-$(get_machine || uname -m)}
|
||||
else
|
||||
arch=${host%%-*}
|
||||
fi
|
||||
if [ "$arch" = i386\
|
||||
-o "$arch" = i486\
|
||||
-o "$arch" = i586\
|
||||
-o "$arch" = i686\
|
||||
]; then
|
||||
arch=x86
|
||||
fi
|
||||
|
||||
#
|
||||
if $CC --version | grep gcc 2>/dev/null; then
|
||||
gcc_p=1
|
||||
compiler=gcc
|
||||
elif $CC --version | grep tcc 2>/dev/null; then
|
||||
tcc_p=1
|
||||
compiler=tcc
|
||||
else
|
||||
mes_p=1
|
||||
mesc_p=1
|
||||
compiler=mescc
|
||||
fi
|
||||
|
||||
mes_arch=$arch
|
||||
if [ "$mes_p" -o "$mesc_p" ]; then
|
||||
mes_arch=$arch-mes
|
||||
fi
|
||||
|
||||
if [ ! "$mesc_p" ]; then
|
||||
mes_arch=$mes_arch-$compiler
|
||||
fi
|
||||
if [ ! "$mesc_p" -a ! "$mes_p" ]; then
|
||||
posix_p=1
|
||||
fi
|
||||
|
||||
subst ${srcdest}mes/module/mes/boot-0.scm.in mes/module/mes/boot-0.scm
|
||||
subst ${srcdest}build-aux/GNUmakefile.in GNUmakefile
|
||||
subst ${srcdest}build-aux/config.status.in config.status
|
||||
subst ${srcdest}build-aux/build.sh.in build.sh
|
||||
chmod +x build.sh
|
||||
subst ${srcdest}build-aux/check.sh.in check.sh
|
||||
chmod +x check.sh
|
||||
subst ${srcdest}build-aux/install.sh.in install.sh
|
||||
chmod +x install.sh
|
||||
subst ${srcdest}build-aux/uninstall.sh.in uninstall.sh
|
||||
chmod +x uninstall.sh
|
||||
|
||||
cat <<EOF
|
||||
GNU Mes is configured for $mes_arch
|
||||
|
||||
Run:
|
||||
./build.sh to build mes
|
||||
./check.sh to check mes
|
||||
|
|
|
@ -33,7 +33,7 @@ Documentation License''.
|
|||
@end direntry
|
||||
|
||||
@titlepage
|
||||
@title Mes Reference Manual
|
||||
@title GNU Mes Reference Manual
|
||||
@subtitle Full Source Bootstrapping of the GNU GuixSD Operating System
|
||||
@author Jan (janneke) Nieuwenhuizen
|
||||
|
||||
|
@ -49,7 +49,7 @@ Edition @value{EDITION} @*
|
|||
|
||||
@c *********************************************************************
|
||||
@node Top
|
||||
@top Mes
|
||||
@top GNU Mes
|
||||
|
||||
This document describes GNU Mes version @value{VERSION}, a bootstrappable
|
||||
Scheme interpreter and C compiler written for bootstrapping the GNU system.
|
||||
|
@ -1039,7 +1039,7 @@ Please send bug reports with full details to @email{bug-mes@@gnu.org}.
|
|||
@chapter Acknowledgments
|
||||
|
||||
We would like to thank the following people for their help: Jeremiah
|
||||
Orians, pdewacht, rain1, Ricardo Wurmus, Rutger van Beusekom.
|
||||
Orians, Peter de Wachter, rain1, Ricardo Wurmus, Rutger van Beusekom.
|
||||
|
||||
We also thank Ludovic Courtès for creating GuixSD and making the
|
||||
bootstrap problem so painfully visible, John McCarthy for creating
|
||||
|
|
|
@ -44,11 +44,14 @@ int errno;
|
|||
#define ECHILD 10
|
||||
#define EAGAIN 11
|
||||
#define ENOMEM 12
|
||||
#define EACCES 13
|
||||
#define EEXIST 17
|
||||
#define ENOTDIR 20
|
||||
#define EISDIR 21
|
||||
#define EINVAL 22
|
||||
#define EMFILE 24
|
||||
#define ENOSPC 28
|
||||
#define ESPIPE 29
|
||||
#define EPIPE 32
|
||||
#define ERANGE 34
|
||||
|
||||
|
|
|
@ -21,6 +21,13 @@
|
|||
#ifndef __MES_LIBMES_MINI_H
|
||||
#define __MES_LIBMES_MINI_H
|
||||
|
||||
char **environ;
|
||||
int g_stdin;
|
||||
int g_stdout;
|
||||
int g_stderr;
|
||||
|
||||
#if !WITH_GLIBC
|
||||
|
||||
#ifndef _SIZE_T
|
||||
#define _SIZE_T
|
||||
#ifndef __SIZE_T
|
||||
|
@ -40,10 +47,22 @@ typedef unsigned long size_t;
|
|||
#ifndef __MES_SSIZE_T
|
||||
#define __MES_SSIZE_T
|
||||
#undef ssize_t
|
||||
#if __i386__
|
||||
typedef int ssize_t;
|
||||
#else
|
||||
typedef long ssize_t;
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifndef __MES_ERRNO_T
|
||||
#define __MES_ERRNO_T 1
|
||||
typedef int error_t;
|
||||
int errno;
|
||||
#endif // !__MES_ERRNO_T
|
||||
|
||||
#endif //!WITH_LIBC
|
||||
|
||||
#ifndef STDIN
|
||||
#define STDIN 0
|
||||
|
@ -57,16 +76,14 @@ typedef long ssize_t;
|
|||
#define STDERR 2
|
||||
#endif
|
||||
|
||||
#ifndef __MES_ERRNO_T
|
||||
#define __MES_ERRNO_T 1
|
||||
typedef int error_t;
|
||||
int errno;
|
||||
#endif // !__MES_ERRNO_T
|
||||
|
||||
size_t strlen (char const* s);
|
||||
ssize_t write (int filedes, void const *buffer, size_t size);
|
||||
int eputs (char const* s);
|
||||
int puts (char const* s);
|
||||
int oputs (char const* s);
|
||||
|
||||
#if !WITH_GLIBC
|
||||
size_t strlen (char const* s);
|
||||
ssize_t write (int filedes, void const *buffer, size_t size);
|
||||
#endif // !WITH_GLIBC
|
||||
|
||||
#endif //__MES_LIBMES_MINI_H
|
||||
|
|
|
@ -43,8 +43,8 @@ int isspace (int c);
|
|||
int isxdigit (int c);
|
||||
int _open3 (char const *file_name, int flags, int mask);
|
||||
int _open2 (char const *file_name, int flags);
|
||||
int oputc (int c);
|
||||
int oputs (char const* s);
|
||||
ssize_t write (int filedes, void const *buffer, size_t size);
|
||||
char *search_path (char const *file_name);
|
||||
|
||||
#endif //__MES_LIBMES_H
|
||||
|
|
|
@ -29,19 +29,12 @@
|
|||
|
||||
#else // ! WITH_GLIBC
|
||||
|
||||
#define CHAR_BIT 8
|
||||
#define UCHAR_MAX 255
|
||||
#define CHAR_MAX 255
|
||||
#define UINT_MAX 4294967295U
|
||||
#define ULONG_MAX 4294967295U
|
||||
#define INT_MIN -2147483648
|
||||
#define INT_MAX 2147483647
|
||||
#include <stdint.h>
|
||||
|
||||
#define MB_CUR_MAX 1
|
||||
#define LONG_MIN -2147483648
|
||||
#define LONG_MAX 2147483647
|
||||
#define _POSIX_OPEN_MAX 16
|
||||
#define PATH_MAX 512
|
||||
#define NAME_MAX 255
|
||||
#define PATH_MAX 512
|
||||
#define _POSIX_OPEN_MAX 16
|
||||
|
||||
#endif // ! WITH_GLIBC
|
||||
|
||||
|
|
|
@ -73,4 +73,13 @@
|
|||
#define SYS_getdents 0x8d
|
||||
#define SYS_clock_gettime 0x109
|
||||
|
||||
// bash
|
||||
#define SYS_setuid 0x17
|
||||
#define SYS_geteuid 0x31
|
||||
#define SYS_getegid 0x32
|
||||
#define SYS_setgid 0x3e
|
||||
|
||||
// make+POSIX
|
||||
#define SYS_sigprocmask 0x7e
|
||||
|
||||
#endif // __MES_LINUX_X86_SYSCALL_H
|
||||
|
|
|
@ -69,4 +69,13 @@
|
|||
#define SYS_getdents 0x4e
|
||||
#define SYS_clock_gettime 0xe4
|
||||
|
||||
// bash
|
||||
#define SYS_setuid 0x69
|
||||
#define SYS_setgid 0x6a
|
||||
#define SYS_geteuid 0x6b
|
||||
#define SYS_getegid 0x6c
|
||||
|
||||
// make+POSIX
|
||||
#define SYS_rt_sigprocmask 0x0e
|
||||
|
||||
#endif // __MES_LINUX_X86_64_SYSCALL_H
|
||||
|
|
|
@ -36,6 +36,9 @@ struct passwd
|
|||
char *pw_shell;
|
||||
};
|
||||
|
||||
struct passwd * getpwuid ();
|
||||
|
||||
|
||||
#endif // ! WITH_GLIBC
|
||||
|
||||
#endif // __MES_PWD_H
|
||||
|
|
|
@ -228,6 +228,12 @@ void* signal (int signum, void * action);
|
|||
sighandler_t signal (int signum, sighandler_t action);
|
||||
#endif
|
||||
int sigemptyset (sigset_t *set);
|
||||
#ifndef SIG_BLOCK
|
||||
#define SIG_BLOCK 0
|
||||
#define SIG_UNBLOCK 1
|
||||
#define SIG_SETMASK 2
|
||||
#endif
|
||||
int sigprocmask (int how, sigset_t const *set, sigset_t *oldset);
|
||||
|
||||
#endif //! WITH_GLIBC
|
||||
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
* Copyright © 2018 Peter De Wachter <pdewacht@gmail.com>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
|
@ -80,6 +81,46 @@ typedef unsigned* uintptr_t;
|
|||
typedef long ptrdiff_t;
|
||||
#endif
|
||||
|
||||
#define CHAR_BIT 8
|
||||
#define CHAR_MAX 255
|
||||
#define UCHAR_MAX 255
|
||||
|
||||
#define INT8_MAX 127
|
||||
#define INT8_MIN (-INT8_MAX-1)
|
||||
#define UINT8_MAX 255
|
||||
|
||||
#define INT16_MAX 32767
|
||||
#define INT16_MIN (-INT16_MAX-1)
|
||||
#define UINT16_MAX 65535
|
||||
|
||||
#define INT32_MAX 2147483647
|
||||
#define INT32_MIN (-INT32_MAX-1)
|
||||
#define UINT32_MAX 4294967295U
|
||||
|
||||
#define INT64_MAX 9223372036854775807LL
|
||||
#define INT64_MIN (-INT64_MAX-1)
|
||||
#define UINT64_MAX 18446744073709551615ULL
|
||||
|
||||
#define INT_MIN -2147483648
|
||||
#define INT_MAX 2147483647
|
||||
#if __i386__
|
||||
#define LONG_MIN INT_MIN
|
||||
#define LONG_MAX INT_MAX
|
||||
#define UINT_MAX UINT32_MAX
|
||||
#define ULONG_MAX UINT32_MAX
|
||||
#define LLONG_MIN INT64_MIN
|
||||
#define LLONG_MAX INT64_MAX
|
||||
#define SIZE_MAX UINT32_MAX
|
||||
#elif __x86_64__
|
||||
#define LONG_MIN INT64_MIN
|
||||
#define LONG_MAX INT64_MAX
|
||||
#define UINT_MAX UINT32_MAX
|
||||
#define ULONG_MAX UINT64_MAX
|
||||
#define LLONG_MIN INT64_MIN
|
||||
#define LLONG_MAX INT64_MAX
|
||||
#define SIZE_MAX UINT64_MAX
|
||||
#endif
|
||||
|
||||
#endif // ! WITH_GLIBC
|
||||
|
||||
#endif // __MES_STDINT_H
|
||||
|
|
|
@ -20,21 +20,7 @@
|
|||
#ifndef __MES_STDIO_H
|
||||
#define __MES_STDIO_H 1
|
||||
|
||||
char **environ;
|
||||
int g_stdin;
|
||||
int g_stdout;
|
||||
|
||||
#ifndef STDIN
|
||||
#define STDIN 0
|
||||
#endif
|
||||
|
||||
#ifndef STDOUT
|
||||
#define STDOUT 1
|
||||
#endif
|
||||
|
||||
#ifndef STDERR
|
||||
#define STDERR 2
|
||||
#endif
|
||||
#include <libmes.h>
|
||||
|
||||
#if WITH_GLIBC
|
||||
#ifndef _GNU_SOURCE
|
||||
|
|
|
@ -42,6 +42,7 @@ int setenv (char const* s, char const* v, int overwrite_p);
|
|||
void unsetenv (char const *name);
|
||||
void *malloc (size_t);
|
||||
void qsort (void *base, size_t nmemb, size_t size, int (*compar)(void const *, void const *));
|
||||
int rand (void);
|
||||
void *realloc (void *p, size_t size);
|
||||
double strtod (char const *string, char **tailptr);
|
||||
float strtof (char const *string, char **tailptr);
|
||||
|
|
|
@ -45,6 +45,7 @@ typedef unsigned long size_t;
|
|||
typedef long ssize_t;
|
||||
#endif
|
||||
|
||||
void * memchr (void const *block, int c, size_t size);
|
||||
void *memcpy (void *dest, void const *src, size_t n);
|
||||
void *memmove (void *dest, void const *src, size_t n);
|
||||
void *memset (void *s, int c, size_t n);
|
||||
|
|
|
@ -101,6 +101,17 @@ int stat (char const *file_name, struct stat *buf);
|
|||
#define S_IWUSR 00200
|
||||
#define S_IRUSR 00400
|
||||
|
||||
#define S_ISUID 0400
|
||||
#define S_ISGID 02000
|
||||
#define S_IXGRP 00010
|
||||
#define S_IXOTH 00001
|
||||
#define S_IRGRP 00040
|
||||
#define S_IROTH 00004
|
||||
#define S_IWGRP 00020
|
||||
#define S_IWOTH 00002
|
||||
#define S_IRWXG 00070
|
||||
#define S_IRWXO 00007
|
||||
|
||||
#endif // ! WITH_GLIBC
|
||||
|
||||
#endif // __MES_SYS_STAT_H
|
||||
|
|
|
@ -0,0 +1,64 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
* GNU Mes is free software; you can redistribute it and/or modify it
|
||||
* under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 3 of the License, or (at
|
||||
* your option) any later version.
|
||||
*
|
||||
* GNU Mes is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
#ifndef __MES_TERMIO_H
|
||||
#define __MES_TERMIO_H 1
|
||||
|
||||
#if WITH_GLIBC
|
||||
#ifndef _GNU_SOURCE
|
||||
#define _GNU_SOURCE
|
||||
#endif
|
||||
#undef __MES_TERMIO_H
|
||||
#include_next <termio.h>
|
||||
|
||||
#else // ! WITH_GLIBC
|
||||
|
||||
#define TIOCGWINSZ 0x5413
|
||||
#define TCGETA 0x5405
|
||||
#define TCSETAW 0x5407
|
||||
|
||||
#define VTIME 5
|
||||
#define VMIN 6
|
||||
|
||||
#define ISIG 0000001
|
||||
#define ICANON 0000002
|
||||
#define ECHO 0000010
|
||||
#define ECHOK 0000040
|
||||
#define ECHONL 0000100
|
||||
|
||||
#define ISTRIP 0000040
|
||||
#define INLCR 0000100
|
||||
#define ICRNL 0000400
|
||||
|
||||
#define CS8 0000060
|
||||
#define PARENB 0000400
|
||||
|
||||
struct termio
|
||||
{
|
||||
unsigned short c_iflag;
|
||||
unsigned short c_oflag;
|
||||
unsigned short c_cflag;
|
||||
unsigned short c_lflag;
|
||||
unsigned char c_line;
|
||||
unsigned char c_cc[8];
|
||||
};
|
||||
|
||||
#endif // ! WITH_GLIBC
|
||||
|
||||
#endif // __MES_TERMIO_H
|
|
@ -54,6 +54,7 @@ struct timespec
|
|||
|
||||
#endif // __MES_STRUCT_TIMESPEC
|
||||
|
||||
#define CLOCK_PROCESS_CPUTIME_ID 2
|
||||
int clock_gettime (clockid_t clk_id, struct timespec *tp);
|
||||
struct tm *localtime (time_t const *timep);
|
||||
struct tm *gmtime (time_t const *time);
|
||||
|
|
|
@ -29,6 +29,10 @@
|
|||
|
||||
#else // ! WITH_GLIBC
|
||||
|
||||
#if !defined (BOOTSTRAP_WITHOUT_POSIX)
|
||||
#define _POSIX_VERSION 199009L
|
||||
#endif
|
||||
|
||||
#include <sys/types.h>
|
||||
#ifndef NULL
|
||||
#define NULL 0
|
||||
|
@ -62,8 +66,12 @@ int execve (char const *file, char *const argv[], char *const env[]);
|
|||
int execvp (char const *file, char *const argv[]);
|
||||
int fork (void);
|
||||
char *getcwd (char *buf, size_t size);
|
||||
gid_t getgid (void);
|
||||
uid_t getuid (void);
|
||||
gid_t getgid (void);
|
||||
int setgid (gid_t newgid);
|
||||
int setuid (uid_t newuid);
|
||||
uid_t geteuid (void);
|
||||
gid_t getegid (void);
|
||||
int isatty (int fd);
|
||||
int link (char const *oldname, char const *newname);
|
||||
off_t lseek (int fd, off_t offset, int whence);
|
||||
|
|
|
@ -113,3 +113,8 @@
|
|||
#include <stub/sigblock.c>
|
||||
#include <stub/sigaddset.c>
|
||||
#include <stub/setlocale.c>
|
||||
|
||||
// bash
|
||||
#include <stub/getpwuid.c>
|
||||
#include <stub/rand.c>
|
||||
#include <stub/ttyname.c>
|
||||
|
|
|
@ -47,3 +47,4 @@
|
|||
#endif // POSIX
|
||||
|
||||
#include <mes/eputc.c>
|
||||
#include <mes/oputc.c>
|
||||
|
|
|
@ -0,0 +1,27 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
* GNU Mes is free software; you can redistribute it and/or modify it
|
||||
* under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 3 of the License, or (at
|
||||
* your option) any later version.
|
||||
*
|
||||
* GNU Mes is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include <time.h>
|
||||
|
||||
int
|
||||
clock_gettime (clockid_t clk_id, struct timespec *tp)
|
||||
{
|
||||
return _sys_call2 (SYS_clock_gettime, (long)clk_id, (long)tp);
|
||||
}
|
|
@ -0,0 +1,27 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
* GNU Mes is free software; you can redistribute it and/or modify it
|
||||
* under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 3 of the License, or (at
|
||||
* your option) any later version.
|
||||
*
|
||||
* GNU Mes is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include <time.h>
|
||||
|
||||
int
|
||||
gettimeofday (struct timeval *tv, struct timezone *tz)
|
||||
{
|
||||
return _sys_call2 (SYS_gettimeofday, (long)tv, (long)tz);
|
||||
}
|
|
@ -57,12 +57,6 @@ mkdir (char const *file_name, mode_t mode)
|
|||
return _sys_call2 (SYS_mkdir, (long)file_name, (long)mode);
|
||||
}
|
||||
|
||||
int
|
||||
dup (int old)
|
||||
{
|
||||
return _sys_call1 (SYS_dup, (int)old);
|
||||
}
|
||||
|
||||
gid_t
|
||||
getgid ()
|
||||
{
|
||||
|
@ -124,12 +118,6 @@ pipe (int filedes[2])
|
|||
return _sys_call1 (SYS_pipe, (long)filedes);
|
||||
}
|
||||
|
||||
int
|
||||
dup2 (int old, int new)
|
||||
{
|
||||
return _sys_call2 (SYS_dup2, (int)old, (int)new);
|
||||
}
|
||||
|
||||
int
|
||||
getrusage (int processes, struct rusage *rusage)
|
||||
{
|
||||
|
@ -174,8 +162,38 @@ chdir (char const *file_name)
|
|||
return _sys_call1 (SYS_chdir, (long)file_name);
|
||||
}
|
||||
|
||||
int
|
||||
clock_gettime (clockid_t clk_id, struct timespec *tp)
|
||||
// bash
|
||||
uid_t
|
||||
geteuid ()
|
||||
{
|
||||
return _sys_call2 (SYS_clock_gettime, (long)clk_id, (long)tp);
|
||||
return _sys_call (SYS_geteuid);
|
||||
}
|
||||
|
||||
gid_t
|
||||
getegid ()
|
||||
{
|
||||
return _sys_call (SYS_getegid);
|
||||
}
|
||||
|
||||
int
|
||||
setuid (uid_t newuid)
|
||||
{
|
||||
return _sys_call1 (SYS_setuid, (long)newuid);
|
||||
}
|
||||
|
||||
int
|
||||
setgid (gid_t newgid)
|
||||
{
|
||||
return _sys_call1 (SYS_setgid, (long)newgid);
|
||||
}
|
||||
|
||||
// make+POSIX
|
||||
int
|
||||
sigprocmask (int how, sigset_t const *set, sigset_t *oldset)
|
||||
{
|
||||
#if __i386__
|
||||
return _sys_call3 (SYS_sigprocmask, (long)how, (long)set, (long)oldset);
|
||||
#else
|
||||
return _sys_call3 (SYS_rt_sigprocmask, (long)how, (long)set, (long)oldset);
|
||||
#endif
|
||||
}
|
||||
|
|
|
@ -149,3 +149,34 @@ fsync (int filedes)
|
|||
{
|
||||
return _sys_call1 (SYS_fsync, (int)filedes);
|
||||
}
|
||||
|
||||
char *
|
||||
getcwd (char *buffer, size_t size)
|
||||
{
|
||||
int r = _sys_call2 (SYS_getcwd, (long)buffer, (long)size);
|
||||
if (r >= 0)
|
||||
return buffer;
|
||||
return 0;
|
||||
}
|
||||
|
||||
int
|
||||
dup (int old)
|
||||
{
|
||||
return _sys_call1 (SYS_dup, (int)old);
|
||||
}
|
||||
|
||||
int
|
||||
dup2 (int old, int new)
|
||||
{
|
||||
return _sys_call2 (SYS_dup2, (int)old, (int)new);
|
||||
}
|
||||
|
||||
int
|
||||
unlink (char const *file_name)
|
||||
{
|
||||
return _sys_call1 (SYS_unlink, (long)file_name);
|
||||
}
|
||||
|
||||
#include "linux/clock_gettime.c"
|
||||
#include "linux/gettimeofday.c"
|
||||
#include "linux/time.c"
|
||||
|
|
|
@ -37,12 +37,6 @@ lseek (int filedes, off_t offset, int whence)
|
|||
return _sys_call3 (SYS_lseek, (int)filedes, (long)offset, (int)whence);
|
||||
}
|
||||
|
||||
int
|
||||
unlink (char const *file_name)
|
||||
{
|
||||
return _sys_call1 (SYS_unlink, (long)file_name);
|
||||
}
|
||||
|
||||
int
|
||||
rmdir (char const *file_name)
|
||||
{
|
||||
|
@ -54,21 +48,3 @@ stat (char const *file_name, struct stat *statbuf)
|
|||
{
|
||||
return _sys_call2 (SYS_stat, (long)file_name, (long)statbuf);
|
||||
}
|
||||
|
||||
char *
|
||||
getcwd (char *buffer, size_t size)
|
||||
{
|
||||
return _sys_call2 (SYS_getcwd, (long)buffer, (long)size);
|
||||
}
|
||||
|
||||
time_t
|
||||
time (time_t *result)
|
||||
{
|
||||
return _sys_call1 (SYS_time, (long)result);
|
||||
}
|
||||
|
||||
int
|
||||
gettimeofday (struct timeval *tv, struct timezone *tz)
|
||||
{
|
||||
return _sys_call2 (SYS_gettimeofday, (long)tv, (long)tz);
|
||||
}
|
||||
|
|
|
@ -0,0 +1,27 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
* GNU Mes is free software; you can redistribute it and/or modify it
|
||||
* under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 3 of the License, or (at
|
||||
* your option) any later version.
|
||||
*
|
||||
* GNU Mes is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include <time.h>
|
||||
|
||||
time_t
|
||||
time (time_t *result)
|
||||
{
|
||||
return _sys_call1 (SYS_time, (long)result);
|
||||
}
|
|
@ -23,5 +23,5 @@
|
|||
int
|
||||
eputc (int c)
|
||||
{
|
||||
return fdputc (c, STDERR);
|
||||
return fdputc (c, g_stderr);
|
||||
}
|
||||
|
|
|
@ -24,6 +24,6 @@ int
|
|||
eputs (char const* s)
|
||||
{
|
||||
int i = strlen (s);
|
||||
write (STDERR, s, i);
|
||||
write (g_stderr, s, i);
|
||||
return 0;
|
||||
}
|
||||
|
|
|
@ -0,0 +1,27 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
* GNU Mes is free software; you can redistribute it and/or modify it
|
||||
* under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 3 of the License, or (at
|
||||
* your option) any later version.
|
||||
*
|
||||
* GNU Mes is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include <libmes.h>
|
||||
|
||||
int
|
||||
oputc (int c)
|
||||
{
|
||||
return fdputc (c, g_stdout);
|
||||
}
|
|
@ -24,6 +24,6 @@ int
|
|||
oputs (char const* s)
|
||||
{
|
||||
int i = strlen (s);
|
||||
write (1, s, i);
|
||||
write (g_stdout, s, i);
|
||||
return 0;
|
||||
}
|
||||
|
|
|
@ -25,8 +25,14 @@ int
|
|||
snprintf (char *str, size_t size, char const *format, ...)
|
||||
{
|
||||
va_list ap;
|
||||
int r;
|
||||
#if __GNUC__ && __x86_64__
|
||||
#define __FUNCTION_ARGS 3
|
||||
ap += (__FOO_VARARGS + (__FUNCTION_ARGS << 1)) << 3;
|
||||
#undef __FUNCTION_ARGS
|
||||
#endif
|
||||
va_start (ap, format);
|
||||
int r = vsprintf (str, format, ap);
|
||||
r = vsnprintf (str, size, format, ap);
|
||||
va_end (ap);
|
||||
return r;
|
||||
}
|
||||
|
|
|
@ -22,7 +22,200 @@
|
|||
#include <stdlib.h>
|
||||
|
||||
int
|
||||
vsnprintf (char *str, size_t size, char const *format, va_list ap)
|
||||
vsnprintf (char *str, size_t size, char const* format, va_list ap)
|
||||
{
|
||||
return vsprintf (str, format, ap);
|
||||
char const *p = format;
|
||||
int count = 0;
|
||||
char c;
|
||||
while (*p)
|
||||
if (*p != '%')
|
||||
{
|
||||
c = *p++;
|
||||
if (count < size)
|
||||
*str++ = c;
|
||||
count++;
|
||||
}
|
||||
else
|
||||
{
|
||||
p++;
|
||||
c = *p;
|
||||
int left_p = 0;
|
||||
int precision = -1;
|
||||
int width = -1;
|
||||
if (c == '-')
|
||||
{
|
||||
left_p = 1;
|
||||
c = *++p;
|
||||
}
|
||||
char pad = ' ';
|
||||
if (c == '0')
|
||||
{
|
||||
pad = c;
|
||||
c = *p++;
|
||||
}
|
||||
if (c >= '0' && c <= '9')
|
||||
{
|
||||
width = abtol (&p, 10);
|
||||
c = *p;
|
||||
}
|
||||
else if (c == '*')
|
||||
{
|
||||
width = va_arg (ap, long);
|
||||
c = *++p;
|
||||
}
|
||||
if (c == '.')
|
||||
{
|
||||
c = *++p;
|
||||
if (c >= '0' && c <= '9')
|
||||
{
|
||||
precision = abtol (&p, 10);
|
||||
c = *p;
|
||||
}
|
||||
else if (c == '*')
|
||||
{
|
||||
precision = va_arg (ap, long);
|
||||
c = *++p;
|
||||
}
|
||||
}
|
||||
if (c == 'l')
|
||||
c = *++p;
|
||||
if (c == 'l')
|
||||
c = *++p;
|
||||
if (c == 'l')
|
||||
{
|
||||
eputs ("vsnprintf: skipping second: l\n");
|
||||
c = *++p;
|
||||
}
|
||||
switch (c)
|
||||
{
|
||||
case '%':
|
||||
{
|
||||
if (count < size)
|
||||
*str++ = *p;
|
||||
count++;
|
||||
break;
|
||||
}
|
||||
case 'c':
|
||||
{
|
||||
c = va_arg (ap, long);
|
||||
if (count < size)
|
||||
*str++ = c;
|
||||
count++;
|
||||
break;
|
||||
}
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'u':
|
||||
case 'x':
|
||||
case 'X':
|
||||
{
|
||||
long d = va_arg (ap, long);
|
||||
int base = c == 'o' ? 8
|
||||
: c == 'x' || c == 'X' ? 16
|
||||
: 10;
|
||||
char const *s = ntoab (d, base, c != 'u' && c != 'x' && c != 'X');
|
||||
if (c == 'X')
|
||||
strupr (s);
|
||||
int length = strlen (s);
|
||||
if (precision == -1)
|
||||
precision = length;
|
||||
if (!left_p)
|
||||
{
|
||||
while (width-- > precision)
|
||||
{
|
||||
if (count < size)
|
||||
*str++ = pad;
|
||||
count++;
|
||||
}
|
||||
while (precision > length)
|
||||
{
|
||||
if (count < size)
|
||||
*str++ = '0';
|
||||
precision--;
|
||||
width--;
|
||||
count++;
|
||||
}
|
||||
}
|
||||
while (*s)
|
||||
{
|
||||
if (precision-- <= 0)
|
||||
break;
|
||||
width--;
|
||||
c = *s++;
|
||||
if (count < size)
|
||||
*str++ = c;
|
||||
count++;
|
||||
}
|
||||
while (width > 0)
|
||||
{
|
||||
width--;
|
||||
if (count < size)
|
||||
*str++ = pad;
|
||||
count++;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case 's':
|
||||
{
|
||||
char *s = va_arg (ap, char *);
|
||||
int length = s ? strlen (s) : 0;
|
||||
if (precision == -1)
|
||||
precision = length;
|
||||
if (!left_p)
|
||||
{
|
||||
while (width-- > precision)
|
||||
{
|
||||
if (count < size)
|
||||
*str++ = pad;
|
||||
count++;
|
||||
}
|
||||
while (width > length)
|
||||
{
|
||||
if (count < size)
|
||||
*str++ = ' ';
|
||||
precision--;
|
||||
width--;
|
||||
count++;
|
||||
}
|
||||
}
|
||||
while (s && *s)
|
||||
{
|
||||
if (precision-- <= 0)
|
||||
break;
|
||||
width--;
|
||||
c = *s++;
|
||||
if (count < size)
|
||||
*str++ = c;
|
||||
count++;
|
||||
}
|
||||
while (width > 0)
|
||||
{
|
||||
width--;
|
||||
if (count < size)
|
||||
*str++ = pad;
|
||||
count++;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case 'n':
|
||||
{
|
||||
int *n = va_arg (ap, int *);
|
||||
*n = count;
|
||||
break;
|
||||
}
|
||||
default:
|
||||
{
|
||||
eputs ("vsnprintf: not supported: %:");
|
||||
eputc (c);
|
||||
eputs ("\n");
|
||||
p++;
|
||||
}
|
||||
}
|
||||
p++;
|
||||
}
|
||||
va_end (ap);
|
||||
if (count < size)
|
||||
*str = 0;
|
||||
return count;
|
||||
}
|
||||
|
|
|
@ -24,182 +24,5 @@
|
|||
int
|
||||
vsprintf (char *str, char const* format, va_list ap)
|
||||
{
|
||||
char const *p = format;
|
||||
int count = 0;
|
||||
while (*p)
|
||||
if (*p != '%')
|
||||
{
|
||||
*str++ = *p++;
|
||||
count++;
|
||||
}
|
||||
else
|
||||
{
|
||||
p++;
|
||||
char c = *p;
|
||||
int left_p = 0;
|
||||
int precision = -1;
|
||||
int width = -1;
|
||||
if (c == '-')
|
||||
{
|
||||
left_p = 1;
|
||||
c = *++p;
|
||||
}
|
||||
char pad = ' ';
|
||||
if (c == '0')
|
||||
{
|
||||
pad = c;
|
||||
c = *p++;
|
||||
}
|
||||
if (c >= '0' && c <= '9')
|
||||
{
|
||||
width = abtol (&p, 10);
|
||||
c = *p;
|
||||
}
|
||||
else if (c == '*')
|
||||
{
|
||||
width = va_arg (ap, long);
|
||||
c = *++p;
|
||||
}
|
||||
if (c == '.')
|
||||
{
|
||||
c = *++p;
|
||||
if (c >= '0' && c <= '9')
|
||||
{
|
||||
precision = abtol (&p, 10);
|
||||
c = *p;
|
||||
}
|
||||
else if (c == '*')
|
||||
{
|
||||
precision = va_arg (ap, long);
|
||||
c = *++p;
|
||||
}
|
||||
}
|
||||
if (c == 'l')
|
||||
c = *++p;
|
||||
if (c == 'l')
|
||||
c = *++p;
|
||||
if (c == 'l')
|
||||
{
|
||||
eputs ("vfprintf: skipping second: l\n");
|
||||
c = *++p;
|
||||
}
|
||||
switch (c)
|
||||
{
|
||||
case '%':
|
||||
{
|
||||
*str++ = *p;
|
||||
count++;
|
||||
break;
|
||||
}
|
||||
case 'c':
|
||||
{
|
||||
c = va_arg (ap, long);
|
||||
*str++ = c;
|
||||
count++;
|
||||
break;
|
||||
}
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'u':
|
||||
case 'x':
|
||||
case 'X':
|
||||
{
|
||||
long d = va_arg (ap, long);
|
||||
int base = c == 'o' ? 8
|
||||
: c == 'x' || c == 'X' ? 16
|
||||
: 10;
|
||||
char const *s = ntoab (d, base, c != 'u' && c != 'x' && c != 'X');
|
||||
if (c == 'X')
|
||||
strupr (s);
|
||||
int length = strlen (s);
|
||||
if (precision == -1)
|
||||
precision = length;
|
||||
if (!left_p)
|
||||
{
|
||||
while (width-- > precision)
|
||||
{
|
||||
*str++ = pad;
|
||||
count++;
|
||||
}
|
||||
while (precision > length)
|
||||
{
|
||||
*str++ = '0';
|
||||
precision--;
|
||||
width--;
|
||||
count++;
|
||||
}
|
||||
}
|
||||
while (*s)
|
||||
{
|
||||
if (precision-- <= 0)
|
||||
break;
|
||||
width--;
|
||||
*str++ = *s++;
|
||||
count++;
|
||||
}
|
||||
while (width > 0)
|
||||
{
|
||||
width--;
|
||||
*str++ = pad;
|
||||
count++;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case 's':
|
||||
{
|
||||
char *s = va_arg (ap, char *);
|
||||
int length = strlen (s);
|
||||
if (precision == -1)
|
||||
precision = length;
|
||||
if (!left_p)
|
||||
{
|
||||
while (width-- > precision)
|
||||
{
|
||||
*str++ = pad;
|
||||
count++;
|
||||
}
|
||||
while (width > length)
|
||||
{
|
||||
*str++ = ' ';
|
||||
precision--;
|
||||
width--;
|
||||
count++;
|
||||
}
|
||||
}
|
||||
while (*s)
|
||||
{
|
||||
if (precision-- <= 0)
|
||||
break;
|
||||
width--;
|
||||
*str++ = *s++;
|
||||
count++;
|
||||
}
|
||||
while (width > 0)
|
||||
{
|
||||
width--;
|
||||
*str++ = pad;
|
||||
count++;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case 'n':
|
||||
{
|
||||
int *n = va_arg (ap, int *);
|
||||
*n = count;
|
||||
break;
|
||||
}
|
||||
default:
|
||||
{
|
||||
eputs ("vsprintf: not supported: %:");
|
||||
eputc (c);
|
||||
eputs ("\n");
|
||||
p++;
|
||||
}
|
||||
}
|
||||
p++;
|
||||
}
|
||||
va_end (ap);
|
||||
*str = 0;
|
||||
return strlen (str);
|
||||
return vsnprintf (str, LONG_MAX, format, ap);
|
||||
}
|
||||
|
|
|
@ -0,0 +1,34 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
* GNU Mes is free software; you can redistribute it and/or modify it
|
||||
* under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 3 of the License, or (at
|
||||
* your option) any later version.
|
||||
*
|
||||
* GNU Mes is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
|
||||
void *
|
||||
memchr (void const *block, int c, size_t size)
|
||||
{
|
||||
char const *p = block;
|
||||
while (size--)
|
||||
{
|
||||
if (c == *p)
|
||||
return p;
|
||||
p++;
|
||||
}
|
||||
return 0;
|
||||
}
|
|
@ -0,0 +1,33 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
* GNU Mes is free software; you can redistribute it and/or modify it
|
||||
* under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 3 of the License, or (at
|
||||
* your option) any later version.
|
||||
*
|
||||
* GNU Mes is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include <libmes.h>
|
||||
#include <pwd.h>
|
||||
|
||||
struct passwd *
|
||||
getpwuid ()
|
||||
{
|
||||
static int stub = 0;
|
||||
if (__mes_debug () && !stub)
|
||||
eputs ("getpwuid stub\n");
|
||||
stub = 1;
|
||||
errno = 0;
|
||||
return 0;
|
||||
}
|
|
@ -0,0 +1,33 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
* GNU Mes is free software; you can redistribute it and/or modify it
|
||||
* under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 3 of the License, or (at
|
||||
* your option) any later version.
|
||||
*
|
||||
* GNU Mes is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include <libmes.h>
|
||||
#include <pwd.h>
|
||||
|
||||
int
|
||||
rand (void)
|
||||
{
|
||||
static int stub = 0;
|
||||
if (__mes_debug () && !stub)
|
||||
eputs ("rand stub\n");
|
||||
stub = 1;
|
||||
errno = 0;
|
||||
return 0;
|
||||
}
|
|
@ -0,0 +1,35 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
* GNU Mes is free software; you can redistribute it and/or modify it
|
||||
* under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 3 of the License, or (at
|
||||
* your option) any later version.
|
||||
*
|
||||
* GNU Mes is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include <libmes.h>
|
||||
#include <unistd.h>
|
||||
|
||||
char *
|
||||
ttyname (int filedes)
|
||||
{
|
||||
static int stub = 0;
|
||||
if (__mes_debug () && !stub)
|
||||
eputs ("ttyname stub\n");
|
||||
stub = 1;
|
||||
errno = 0;
|
||||
if (isatty (filedes))
|
||||
return "/dev/tty0";
|
||||
return 0;
|
||||
}
|
|
@ -53,6 +53,7 @@ DEFINE cltd 99
|
|||
DEFINE cmp____$0x32,%eax 3d
|
||||
DEFINE cmp____$i32,%eax 3d
|
||||
DEFINE cmp____$i8,%eax 83f8
|
||||
DEFINE cmp____$i8,%ebx 81fb
|
||||
DEFINE div___%ebx f7f3
|
||||
DEFINE hlt f4
|
||||
DEFINE idiv___%ebx f7fb
|
||||
|
@ -129,14 +130,15 @@ DEFINE mov____0x8(%ebp),%edx 8b55
|
|||
DEFINE mov____0x8(%ebp),%esi 8b75
|
||||
DEFINE mov____0x8(%ebp),%esp 8b65
|
||||
DEFINE movb___%al,0x32 a2
|
||||
DEFINE movb___%bl,0x32 881d
|
||||
DEFINE movsbl_%al,%eax 0fbec0
|
||||
DEFINE movsbl_%bl,%ebx 0fbedb
|
||||
DEFINE movswl_%ax,%eax 0fbfc0
|
||||
DEFINE movswl_%bx,%ebx 0fbfdb
|
||||
DEFINE movw___%ax,0x32 66a3
|
||||
DEFINE movw___%bx,0x32 66891d
|
||||
DEFINE movzbl_%al,%eax 0fb6c0
|
||||
DEFINE movzbl_%bl,%ebx 0fb6db
|
||||
DEFINE movzbl_%bl,%ebx 0fb6db
|
||||
DEFINE movzbl_(%eax),%eax 0fb600
|
||||
DEFINE movzbl_(%ebx),%ebx 0fb61b
|
||||
DEFINE movzbl_0x32(%eax),%eax 0fb680
|
||||
|
@ -203,7 +205,6 @@ DEFINE test___%eax,%eax 85c0
|
|||
DEFINE test___%ebx,%ebx 85db
|
||||
DEFINE xchg___%eax,%ebx 93
|
||||
DEFINE xchg___%eax,(%esp) 870424
|
||||
DEFINE xchg___%eax,(%esp) 870424
|
||||
DEFINE xchg___%ebx,(%esp) 871c24
|
||||
DEFINE xor____$i32,%eax 35
|
||||
DEFINE xor____$i8,%ah 80f4
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
### GNU Mes --- Maxwell Equations of Software
|
||||
### Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
### Copyright © 2018 Peter De Wachter <pdewacht@gmail.com>
|
||||
###
|
||||
### This file is part of GNU Mes.
|
||||
###
|
||||
|
@ -54,6 +55,7 @@ DEFINE call___*%rax ffd0
|
|||
DEFINE call___*%rdi ffd7
|
||||
DEFINE cmp____$i32,%rax 483d
|
||||
DEFINE cmp____$i8,%rax 4883f8
|
||||
DEFINE cmp____$i8,%rdi 4883ff
|
||||
DEFINE cmp____%r15,%rax 4c39f8
|
||||
DEFINE cmp____%r15,%rdi 4c39ff
|
||||
DEFINE cqto 4899
|
||||
|
@ -78,8 +80,6 @@ DEFINE mov____$i32,%rax 48c7c0
|
|||
DEFINE mov____$i32,%rdi 48c7c7
|
||||
DEFINE mov____$i32,0x8(%rbp) c745
|
||||
DEFINE mov____$i64,%r15 49bf
|
||||
DEFINE mov____$i64,%rax 48a1
|
||||
DEFINE mov____$i64,%rax 48b8
|
||||
DEFINE mov____$i64,%rax 48b8
|
||||
DEFINE mov____$i64,%rdi 48bf
|
||||
DEFINE mov____%al,(%rdi) 8807
|
||||
|
@ -92,7 +92,6 @@ DEFINE mov____%eax,%rax 89c0
|
|||
DEFINE mov____%eax,(%rdi) 8907
|
||||
DEFINE mov____%eax,0x32(%rbp) 8985
|
||||
DEFINE mov____%eax,0x8(%rbp) 8945
|
||||
DEFINE mov____%eax,0x8(%rbp) 8945
|
||||
DEFINE mov____%edi,%edi 89ff
|
||||
DEFINE mov____%edi,%rdi 89ff
|
||||
DEFINE mov____%edi,0x32(%rbp) 89bd
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(assq x (current-module)))
|
||||
(module-variable (current-module) x))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
@ -42,7 +42,6 @@
|
|||
;; end boot-00.scm
|
||||
|
||||
;; boot-01.scm
|
||||
(define (pair? x) (eq? (core:type x) <cell:pair>))
|
||||
(define (not x) (if x #f #t))
|
||||
|
||||
(define (display x . rest)
|
||||
|
@ -104,10 +103,6 @@
|
|||
(cons (quote or) (cdr x))))
|
||||
(car x)))))
|
||||
|
||||
(define-macro (module-define! module name value)
|
||||
;;(list 'define name value)
|
||||
#t)
|
||||
|
||||
(define-macro (mes-use-module module)
|
||||
#t)
|
||||
;; end boot-02.scm
|
||||
|
@ -116,8 +111,6 @@
|
|||
(define (primitive-eval e) (core:eval e (current-module)))
|
||||
(define eval core:eval)
|
||||
|
||||
(define (current-output-port) 1)
|
||||
(define (current-error-port) 2)
|
||||
(define (port-filename port) "<stdin>")
|
||||
(define (port-line port) 0)
|
||||
(define (port-column port) 0)
|
||||
|
@ -190,9 +183,9 @@
|
|||
"@VERSION@"))
|
||||
(define (effective-version) %version)
|
||||
|
||||
(if (list 'and (list getenv "MES_DEBUG")
|
||||
(list not (list equal2? (list getenv "MES_DEBUG") "0"))
|
||||
(list not (list equal2? (list getenv "MES_DEBUG") "1")))
|
||||
(if (and (getenv "MES_DEBUG")
|
||||
(not (equal2? (getenv "MES_DEBUG") "0"))
|
||||
(not (equal2? (getenv "MES_DEBUG") "1")))
|
||||
(begin
|
||||
(core:display-error ";;; %moduledir=")
|
||||
(core:display-error %moduledir)
|
||||
|
@ -292,6 +285,10 @@ Ignored for Guile compatibility:
|
|||
--fresh-auto-compile
|
||||
--no-auto-compile
|
||||
-C,--compiled-path=DIR
|
||||
|
||||
Report bugs to: bug-mes@gnu.org
|
||||
GNU Mes home page: <http://gnu.org/software/mes/>
|
||||
General help using GNU software: <http://gnu.org/gethelp/>
|
||||
" (or (and usage? (current-error-port)) (current-output-port)))
|
||||
(exit (or (and usage? 2) 0)))
|
||||
options)
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(assq x (current-module)))
|
||||
(module-variable (current-module) x))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(assq x (current-module)))
|
||||
(module-variable (current-module) x))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
@ -32,7 +32,6 @@
|
|||
;; end boot-00.scm
|
||||
|
||||
;; boot-01.scm
|
||||
(define (pair? x) (eq? (core:type x) <cell:pair>))
|
||||
(define (not x) (if x #f #t))
|
||||
|
||||
(define (display x . rest)
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(assq x (current-module)))
|
||||
(module-variable (current-module) x))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
@ -42,7 +42,6 @@
|
|||
;; end boot-00.scm
|
||||
|
||||
;; boot-01.scm
|
||||
(define (pair? x) (eq? (core:type x) <cell:pair>))
|
||||
(define (not x) (if x #f #t))
|
||||
|
||||
(define (display x . rest)
|
||||
|
@ -104,10 +103,6 @@
|
|||
(cons (quote or) (cdr x))))
|
||||
(car x)))))
|
||||
|
||||
(define-macro (module-define! module name value)
|
||||
;;(list 'define name value)
|
||||
#t)
|
||||
|
||||
(define-macro (mes-use-module module)
|
||||
#t)
|
||||
|
||||
|
|
|
@ -31,6 +31,8 @@
|
|||
(core:display-error ":")
|
||||
(core:write-error args)
|
||||
(core:display-error "\n")))
|
||||
(core:display-error "Backtrace:\n")
|
||||
(display-backtrace (make-stack) (current-error-port))
|
||||
(exit 1))))
|
||||
|
||||
(define (catch key thunk handler)
|
||||
|
@ -54,3 +56,16 @@
|
|||
(apply handler (cons key args))))
|
||||
|
||||
(define with-throw-handler catch) ; FIXME: hack for Nyacc 0.75
|
||||
|
||||
(define (frame-procedure frame)
|
||||
(struct-ref frame 3))
|
||||
|
||||
(define (display-backtrace stack port . rest)
|
||||
(let* ((frames (map (lambda (i) (stack-ref stack i)) (iota (stack-length stack))))
|
||||
(call-frames (filter frame-procedure frames))
|
||||
(display-frames (drop-right call-frames 2)))
|
||||
(for-each (lambda (f)
|
||||
(core:display-error " ")
|
||||
(core:display-error f)
|
||||
(core:display-error "\n"))
|
||||
display-frames)))
|
||||
|
|
|
@ -115,6 +115,7 @@
|
|||
((port? x)
|
||||
(display "#<port " port)
|
||||
(display (core:cdr x) port)
|
||||
(display " ")
|
||||
(display (core:car x) port)
|
||||
(display ">" port))
|
||||
((variable? x)
|
||||
|
@ -142,6 +143,13 @@
|
|||
(if (keyword? x) (display "#:" port))
|
||||
(for-each (display-cut2 display-char <> port write?) (string->list x))
|
||||
(if (and (string? x) write?) (write-char #\" port)))
|
||||
((struct? x)
|
||||
(display "#<" port)
|
||||
(for-each (lambda (i)
|
||||
(let ((x (strut-ref x i)))
|
||||
(d x #f (if (= i 0) "" " "))))
|
||||
(iota (struct-length x)))
|
||||
(display ")" port))
|
||||
((vector? x)
|
||||
(display "#(" port)
|
||||
(for-each (lambda (i)
|
||||
|
@ -214,7 +222,7 @@
|
|||
((#\s) (write (car args) port))
|
||||
(else (display (car args) port)))
|
||||
(simple-format (cddr lst) (cdr args)))))))
|
||||
|
||||
|
||||
(if destination (simple-format lst rest)
|
||||
(with-output-to-string
|
||||
(lambda () (simple-format lst rest))))))
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
|
@ -24,39 +24,19 @@
|
|||
|
||||
(mes-use-module (mes scm))
|
||||
|
||||
|
||||
(define (sexp:define e a)
|
||||
(if (atom? (car (cdr e))) (cons (car (cdr e))
|
||||
(core:eval (car (cdr (cdr e))) a))
|
||||
(cons (car (car (cdr e)))
|
||||
(core:eval (cons (quote lambda)
|
||||
(cons (cdr (car (cdr e))) (cdr (cdr e)))) a))))
|
||||
|
||||
(define (f:env:define a+ a)
|
||||
(set-cdr! a+ (cdr a))
|
||||
(set-cdr! a a+)
|
||||
;;(set-cdr! (assq '*closure* a) a+)
|
||||
)
|
||||
|
||||
(define (env:escape-closure a n)
|
||||
(if (eq? (caar a) '*closure*) (if (= 0 n) a
|
||||
(env:escape-closure (cdr a) (- n 1)))
|
||||
(env:escape-closure (cdr a) n)))
|
||||
|
||||
(define-macro (module-define! name value a)
|
||||
`(f:env:define (cons (sexp:define (cons 'define (cons ',name (cons ,value '()))) ,a) '()) (env:escape-closure ,a 1)))
|
||||
|
||||
(define-macro (make-fluid . default)
|
||||
`(begin
|
||||
,(let ((fluid (symbol-append 'fluid: (gensym)))
|
||||
(module (current-module)))
|
||||
`(begin
|
||||
(module-define! ,fluid
|
||||
(let ((v ,(and (pair? default) (car default))))
|
||||
(lambda ( . rest)
|
||||
(if (null? rest) v
|
||||
(set! v (car rest))))) ',module)
|
||||
',fluid))))
|
||||
((lambda (fluid)
|
||||
`(begin
|
||||
(module-define!
|
||||
(boot-module)
|
||||
',fluid
|
||||
((lambda (v)
|
||||
(lambda ( . rest)
|
||||
(if (null? rest) v
|
||||
(set! v (car rest)))))
|
||||
,(and (pair? default) (car default))))
|
||||
',fluid))
|
||||
(symbol-append 'fluid: (gensym))))
|
||||
|
||||
(define (fluid-ref fluid)
|
||||
(fluid))
|
||||
|
@ -92,7 +72,7 @@
|
|||
`(let ,(map (lambda (b s) `(,s (,b))) (map car bindings) syms)
|
||||
,@(map (lambda (o) `(fluid-set! ,(car o) ,(cadr o))) bindings)
|
||||
(let ((r (begin ,@bodies)))
|
||||
`,@(map (lambda (b s) `(fluid-set! ,b ,s)) (map car bindings) syms)
|
||||
,@(map (lambda (b s) `(fluid-set! ,b ,s)) (map car bindings) syms)
|
||||
r))))
|
||||
|
||||
(define (dynamic-wind in-guard thunk out-guard)
|
||||
|
|
|
@ -31,20 +31,20 @@
|
|||
(mes-use-module (srfi srfi-16))
|
||||
(mes-use-module (mes display))
|
||||
|
||||
(if #t ;;(not (defined? 'read-string))
|
||||
(define (read-string)
|
||||
(define (read-string c)
|
||||
(if (eq? c #\*eof*) '()
|
||||
(cons c (read-string (read-char)))))
|
||||
(let ((string (list->string (read-string (read-char)))))
|
||||
(if (and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 3)) string->number))
|
||||
(core:display-error (string-append "drained: `" string "'\n")))
|
||||
string)))
|
||||
|
||||
(define (drain-input port) (read-string))
|
||||
|
||||
(define (make-string n . fill)
|
||||
(list->string (apply make-list n fill)))
|
||||
(define (read-line . rest)
|
||||
(let* ((port (if (pair? rest) (car rest) (current-input-port)))
|
||||
(handle-delim (if (and (pair? rest) (pair? (cdr rest))) (cadr rest) 'trim))
|
||||
(c (read-char port)))
|
||||
(if (eof-object? c) c
|
||||
(list->string
|
||||
(let loop ((c c))
|
||||
(if (or (eof-object? c) (eq? c #\newline)) (case handle-delim
|
||||
((trim) '())
|
||||
((concat) '(#\newline))
|
||||
(else (error (format #f "not supported: handle-delim=~a" handle-delim))))
|
||||
(cons c (loop (read-char port)))))))))
|
||||
|
||||
(define (object->string x . rest)
|
||||
(with-output-to-string
|
||||
|
@ -79,6 +79,16 @@
|
|||
(set-current-output-port save)
|
||||
r))))
|
||||
|
||||
(define (with-error-to-file file thunk)
|
||||
(let ((port (open-output-file file)))
|
||||
(if (= port -1)
|
||||
(error 'cannot-open file)
|
||||
(let* ((save (current-error-port))
|
||||
(foo (set-current-error-port port))
|
||||
(r (thunk)))
|
||||
(set-current-error-port save)
|
||||
r))))
|
||||
|
||||
(define (with-output-to-port port thunk)
|
||||
(let* ((save (current-output-port))
|
||||
(foo (set-current-output-port port))
|
||||
|
@ -99,9 +109,13 @@
|
|||
port))
|
||||
|
||||
(define (dirname file-name)
|
||||
(let ((lst (filter (negate string-null?) (string-split file-name #\/))))
|
||||
(if (<= (length lst) 1) "."
|
||||
(string-join (list-head lst (1- (length lst))) "/"))))
|
||||
(let* ((lst (string-split file-name #\/))
|
||||
(lst (filter (negate string-null?) lst)))
|
||||
(if (null? lst) (if (string-prefix? "/" file-name) "/" ".")
|
||||
(let ((dir (string-join (list-head lst (1- (length lst))) "/")))
|
||||
(if (string-prefix? "/" file-name) (string-append "/" dir)
|
||||
(if (string-null? dir) "."
|
||||
dir))))))
|
||||
|
||||
;; FIXME: c&p from display
|
||||
(define (with-output-to-string thunk)
|
||||
|
@ -137,4 +151,8 @@
|
|||
(if destination (simple-format lst rest)
|
||||
(with-output-to-string
|
||||
(lambda () (simple-format lst rest))))))
|
||||
|
||||
(define format simple-format)
|
||||
|
||||
(define (file-exists? o)
|
||||
(access? o R_OK))
|
||||
|
|
|
@ -49,7 +49,16 @@
|
|||
|
||||
(define (system* file-name . args)
|
||||
(let ((pid (primitive-fork)))
|
||||
(cond ((zero? pid) (apply execlp file-name (list args)))
|
||||
(cond ((zero? pid)
|
||||
(let ((out (current-output-port))
|
||||
(err (current-error-port)))
|
||||
(when (and (> out 0)
|
||||
(not (= out 1)))
|
||||
(dup2 out 1))
|
||||
(when (and (> err 0)
|
||||
(not (= err 2)))
|
||||
(dup2 err 2))
|
||||
(exit (apply execlp file-name (list args)))))
|
||||
((= -1 pid) (error "fork failed:" file-name))
|
||||
(else (let ((pid+status (waitpid 0)))
|
||||
(cdr pid+status))))))
|
||||
|
@ -57,3 +66,6 @@
|
|||
(define (waitpid pid . options)
|
||||
(let ((options (if (null? options) 0 (car options))))
|
||||
(core:waitpid pid options)))
|
||||
|
||||
(define (status:exit-val status)
|
||||
(ash status -8))
|
||||
|
|
|
@ -108,11 +108,6 @@
|
|||
(define assv assq)
|
||||
(define assv-ref assq-ref)
|
||||
|
||||
(define (assoc key alist)
|
||||
(if (not (pair? alist)) #f
|
||||
(if (equal? key (caar alist)) (car alist)
|
||||
(assoc key (cdr alist)))))
|
||||
|
||||
(define (assoc-ref alist key)
|
||||
(let ((entry (assoc key alist)))
|
||||
(if entry (cdr entry)
|
||||
|
@ -373,6 +368,12 @@
|
|||
(lambda args
|
||||
(not (apply proc args))))
|
||||
|
||||
(define ceil identity)
|
||||
(define floor identity)
|
||||
(define round identity)
|
||||
(define inexact->exact identity)
|
||||
(define exact->inexact identity)
|
||||
|
||||
(define (const . rest)
|
||||
(lambda (. _)
|
||||
(car rest)))
|
||||
|
|
|
@ -37,6 +37,7 @@
|
|||
(cons <cell:ref> (quote <cell:ref>))
|
||||
(cons <cell:special> (quote <cell:special>))
|
||||
(cons <cell:string> (quote <cell:string>))
|
||||
(cons <cell:struct> (quote <cell:struct>))
|
||||
(cons <cell:symbol> (quote <cell:symbol>))
|
||||
(cons <cell:values> (quote <cell:values>))
|
||||
(cons <cell:variable> (quote <cell:variable>))
|
||||
|
@ -74,9 +75,6 @@
|
|||
(define (number? x)
|
||||
(eq? (core:type x) <cell:number>))
|
||||
|
||||
(define (pair? x)
|
||||
(eq? (core:type x) <cell:pair>))
|
||||
|
||||
(define (port? x)
|
||||
(eq? (core:type x) <cell:port>))
|
||||
|
||||
|
@ -86,6 +84,9 @@
|
|||
(define (string? x)
|
||||
(eq? (core:type x) <cell:string>))
|
||||
|
||||
(define (struct? x)
|
||||
(eq? (core:type x) <cell:struct>))
|
||||
|
||||
(define (symbol? x)
|
||||
(eq? (core:type x) <cell:symbol>))
|
||||
|
||||
|
@ -119,14 +120,11 @@
|
|||
|
||||
(define (string->symbol s)
|
||||
(if (not (pair? (core:car s))) '()
|
||||
(core:lookup-symbol (core:car s))))
|
||||
(list->symbol (core:car s))))
|
||||
|
||||
(define (symbol->keyword s)
|
||||
(core:make-cell <cell:keyword> (symbol->list s) 0))
|
||||
|
||||
(define (list->symbol lst)
|
||||
(core:lookup-symbol lst))
|
||||
|
||||
(define (symbol->list s)
|
||||
(core:car s))
|
||||
|
||||
|
|
|
@ -182,3 +182,21 @@
|
|||
(string->list (string-take string (or start1 0)))
|
||||
(string->list replace)
|
||||
(string->list (string-drop string (or end1 (string-length string))))))))
|
||||
|
||||
(define (string-downcase string)
|
||||
(string-map char-downcase string))
|
||||
|
||||
(define (string-upcase string)
|
||||
(string-map char-upcase string))
|
||||
|
||||
(define (string-tokenize string char-set)
|
||||
(let loop ((lst (string->list string)) (result '()))
|
||||
(if (null? lst) (reverse result)
|
||||
(let match ((lst lst) (found '()))
|
||||
(if (null? lst) (loop lst (if (null? found) (reverse result)
|
||||
(cons (list->string (reverse found)) result)))
|
||||
(let ((c (car lst)))
|
||||
(if (not (char-set-contains? char-set c)) (loop (cdr lst)
|
||||
(if (null? found) result
|
||||
(cons (list->string (reverse found)) result)))
|
||||
(match (cdr lst) (cons c found)))))))))
|
||||
|
|
|
@ -36,6 +36,20 @@
|
|||
(equal? a b)))
|
||||
|
||||
(define char-set:whitespace (char-set #\tab #\page #\return #\vtab #\newline #\space))
|
||||
(define char-set:digit (apply char-set
|
||||
(map integer->char
|
||||
(map (lambda (i)
|
||||
(+ i (char->integer #\0))) (iota 10)))))
|
||||
|
||||
(define char-set:lower-case (apply char-set
|
||||
(map integer->char
|
||||
(map (lambda (i)
|
||||
(+ i (char->integer #\a))) (iota 26)))))
|
||||
|
||||
(define char-set:upper-case (apply char-set
|
||||
(map integer->char
|
||||
(map (lambda (i)
|
||||
(+ i (char->integer #\A))) (iota 26)))))
|
||||
|
||||
(define (list->char-set lst)
|
||||
(apply char-set lst))
|
||||
|
@ -47,11 +61,30 @@
|
|||
(set-cdr! (last-pair base) (string->list x))
|
||||
base)
|
||||
|
||||
(define (char-set-adjoin cs . chars)
|
||||
(append cs chars))
|
||||
|
||||
(define (char-set-contains? cs x)
|
||||
(and (memq x cs) #t))
|
||||
|
||||
(define (char-set-complement cs)
|
||||
(let ((ascii (map integer->char (iota 128))))
|
||||
(list->char-set (filter (lambda (c) (not (char-set-contains? cs c))) ascii))))
|
||||
|
||||
(define (char-whitespace? c)
|
||||
(char-set-contains? char-set:whitespace c))
|
||||
|
||||
(define (char-set-copy cs)
|
||||
(map identity cs))
|
||||
|
||||
(define (char-upcase c)
|
||||
(if (char-set-contains? char-set:lower-case c) (integer->char (- (char->integer c)
|
||||
(- (char->integer #\a)
|
||||
(char->integer #\A))))
|
||||
c))
|
||||
|
||||
(define (char-downcase c)
|
||||
(if (char-set-contains? char-set:upper-case c) (integer->char (+ (char->integer c)
|
||||
(- (char->integer #\a)
|
||||
(char->integer #\A))))
|
||||
c))
|
||||
|
|
|
@ -0,0 +1,145 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
;;; GNU Mes is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Mes is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; srfi-9.mes - records, based on struct.
|
||||
|
||||
(define-macro (define-record-type name constructor+params predicate . fields)
|
||||
(let ((type (make-record-type name (map car fields))))
|
||||
`(begin
|
||||
(define ,name ,type)
|
||||
(define ,(car constructor+params) ,(record-constructor type name (cdr constructor+params)))
|
||||
(define ,predicate ,(record-predicate type))
|
||||
(define-record-accessors ,type ,@fields))))
|
||||
|
||||
(define (make-record-type type fields . printer)
|
||||
(let ((printer (if (pair? printer) (car printer))))
|
||||
(make-struct '<record-type> (cons type (list fields)) printer)))
|
||||
|
||||
(define (record-type? o)
|
||||
(eq? (struct-vtable o) '<record-type>))
|
||||
|
||||
(define (struct-vtable o)
|
||||
(struct-ref o 0))
|
||||
|
||||
(define (record-type o)
|
||||
(struct-ref o 2))
|
||||
|
||||
(define (record-predicate type)
|
||||
(lambda (o)
|
||||
(and (record? o)
|
||||
(eq? (record-type o) (record-type type)))))
|
||||
|
||||
(define (record? o)
|
||||
(and (struct? o)
|
||||
(record-type? (struct-vtable o))))
|
||||
|
||||
(define (record-constructor type name params)
|
||||
(let ((fields (record-fields type))
|
||||
(record-type (record-type type)))
|
||||
(lambda (. o)
|
||||
(if (not (= (length o) (length params))) (error "wrong number of arguments for record-constructor")
|
||||
(let ((rest (make-list (- (length fields) (length params)))))
|
||||
(make-struct type (cons name (append o rest)) record-printer))))))
|
||||
|
||||
(define record-printer *unspecified*) ; TODO
|
||||
(define (record-printer o)
|
||||
(display "#<")
|
||||
(display (record-type o))
|
||||
(let* ((vtable (struct-vtable o))
|
||||
(fields (record-fields vtable)))
|
||||
(for-each (lambda (field)
|
||||
(display " ")
|
||||
(display field)
|
||||
(display ": ")
|
||||
(display ((record-getter vtable field) o)))
|
||||
fields))
|
||||
(display ">"))
|
||||
|
||||
(define (record-fields o)
|
||||
(struct-ref o 3))
|
||||
|
||||
(define-macro (define-record-accessors type . fields)
|
||||
`(begin
|
||||
,@(map (lambda (field)
|
||||
`(define-record-accessor ,type ,field))
|
||||
fields)))
|
||||
|
||||
(define-macro (define-record-accessor type field)
|
||||
`(begin
|
||||
(define ,(cadr field) ,(record-getter type (car field)))
|
||||
(if ,(pair? (cddr field))
|
||||
(define ,(if (pair? (cddr field)) (caddr field)) ,(record-setter type (car field))))))
|
||||
|
||||
(define (record-getter type field)
|
||||
(let ((i (record-field-index type field)))
|
||||
(lambda (o . field?)
|
||||
(if (not (eq? (record-type o) (record-type type))) (error "record getter: record expected" type o)
|
||||
(if (pair? field?) field
|
||||
(struct-ref o i))))))
|
||||
|
||||
(define (record-setter type field)
|
||||
(let ((i (record-field-index type field)))
|
||||
(lambda (o v)
|
||||
(if (not (eq? (record-type o) (record-type type))) (error "record setter: record expected" type o)
|
||||
(struct-set! o i v)))))
|
||||
|
||||
(define (record-field-index type field)
|
||||
(+ 3 (or (lst-index (record-fields type) field)
|
||||
(error "no such field" type field))))
|
||||
|
||||
(define (lst-index lst o)
|
||||
(let loop ((lst lst) (i 0))
|
||||
(and (pair? lst)
|
||||
(if (eq? o (car lst)) i
|
||||
(loop (cdr lst) (1+ i))))))
|
||||
|
||||
;; (define-record-type <employee>
|
||||
;; (make-employee name age salary)
|
||||
;; employee?
|
||||
;; (name employe-name)
|
||||
;; (age employee-age set-employee-age!)
|
||||
;; (salary employee-salary))
|
||||
|
||||
;; (display <employee>)
|
||||
;; (newline)
|
||||
|
||||
;; (display make-employee)
|
||||
;; (newline)
|
||||
;; (display "employee-age ")
|
||||
;; (display employee-age)
|
||||
;; (newline)
|
||||
|
||||
;; (display "set-employee-age! ")
|
||||
;; (display set-employee-age!)
|
||||
;; (newline)
|
||||
|
||||
;; (define janneke (make-employee "janneke" 49 42))
|
||||
;; (display janneke)
|
||||
;; (newline)
|
||||
|
||||
;; (display (employee-age janneke))
|
||||
;; (newline)
|
||||
|
||||
;; (display (set-employee-age! janneke 33))
|
||||
;; (newline)
|
||||
;; (display (employee-age janneke))
|
||||
;; (newline)
|
|
@ -0,0 +1,116 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
;;; GNU Mes is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Mes is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; srfi-9-vector.mes - records, based on vector
|
||||
|
||||
(define-macro (define-record-type type constructor+params predicate . fields)
|
||||
(let ((record (make-record-type type (map car fields))))
|
||||
`(begin
|
||||
(define ,type ,record)
|
||||
(define ,(car constructor+params) ,(record-constructor record (cdr constructor+params)))
|
||||
(define ,predicate ,(record-predicate record))
|
||||
(define-record-accessors ,record ,@fields))))
|
||||
|
||||
(define (make-record-type type fields)
|
||||
(list->vector (list '*record-type* type fields (length fields))))
|
||||
|
||||
(define (record-type? o)
|
||||
(eq? (record-type o) '*record-type*))
|
||||
|
||||
(define (record-type o)
|
||||
(vector-ref o 0))
|
||||
|
||||
(define (record-predicate type)
|
||||
(lambda (o)
|
||||
(and (vector? o)
|
||||
(eq? (record-type o) type))))
|
||||
|
||||
(define (record-constructor type params)
|
||||
(let ((fields (record-fields type)))
|
||||
(lambda (. o)
|
||||
(if (not (= (length o) (length params))) (error "wrong number of arguments for record-constructor")
|
||||
(let ((rest (make-list (- (length fields) (length params)))))
|
||||
(list->vector (cons type (append o rest))))))))
|
||||
|
||||
(define (record-fields o)
|
||||
(vector-ref o 2))
|
||||
|
||||
(define-macro (define-record-accessors type . fields)
|
||||
`(begin
|
||||
,@(map (lambda (field)
|
||||
`(define-record-accessor ,type ,field))
|
||||
fields)))
|
||||
|
||||
(define-macro (define-record-accessor type field)
|
||||
`(begin
|
||||
(define ,(cadr field) ,(record-getter type (car field)))
|
||||
(if ,(pair? (cddr field))
|
||||
(define ,(if (pair? (cddr field)) (caddr field)) ,(record-setter type (car field))))))
|
||||
|
||||
(define (record-getter type field)
|
||||
(let ((i (record-field-index type field)))
|
||||
(lambda (o . field?)
|
||||
(if (not (eq? (record-type o) type)) (error "record getter: record expected" type o)
|
||||
(if (pair? field?) field
|
||||
(vector-ref o i))))))
|
||||
|
||||
(define (record-setter type field)
|
||||
(let ((i (record-field-index type field)))
|
||||
(lambda (o v)
|
||||
(if (not (eq? (record-type o) type)) (error "record setter: record expected" type o)
|
||||
(vector-set! o i v)))))
|
||||
|
||||
(define (record-field-index type field)
|
||||
(1+ (or (lst-index (record-fields type) field)
|
||||
(error "no such field" type field))))
|
||||
|
||||
(define (lst-index lst o)
|
||||
(let loop ((lst lst) (i 0))
|
||||
(and (pair? lst)
|
||||
(if (eq? o (car lst)) i
|
||||
(loop (cdr lst) (1+ i))))))
|
||||
|
||||
;; (define-record-type <employee> (make-employee name age salary) employee? (name employe-name) (age employee-age set-employee-age!) (salary employee-salary))
|
||||
|
||||
;; (display <employee>)
|
||||
;; (newline)
|
||||
;; (display make-employee)
|
||||
;; (newline)
|
||||
;; (display "employee-age ")
|
||||
;; (display employee-age)
|
||||
;; (newline)
|
||||
|
||||
;; (display "set-employee-age! ")
|
||||
;; (display set-employee-age!)
|
||||
;; (newline)
|
||||
|
||||
;; (define janneke (make-employee "janneke" 49 42))
|
||||
;; (display janneke)
|
||||
;; (newline)
|
||||
|
||||
;; (display (employee-age janneke))
|
||||
;; (newline)
|
||||
|
||||
;; (display (set-employee-age! janneke 33))
|
||||
;; (newline)
|
||||
;; (display (employee-age janneke))
|
||||
;; (newline)
|
|
@ -1,138 +0,0 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
;;; GNU Mes is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Mes is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; srfi-9.mes - records.
|
||||
|
||||
(define (lst-index lst o)
|
||||
(let loop ((lst lst) (i 0))
|
||||
(and (pair? lst)
|
||||
(if (equal? o (car lst)) i
|
||||
(loop (cdr lst) (1+ i))))))
|
||||
|
||||
(define (make-record-type type fields)
|
||||
(list->vector (list '*record-type* type fields (length fields))))
|
||||
|
||||
(define (record-type o)
|
||||
(vector-ref o 0))
|
||||
|
||||
(define (record-type? o)
|
||||
(eq? (record-type o) '*record-type*))
|
||||
|
||||
(define (record-constructor type params)
|
||||
(let ((fields (record-fields type)))
|
||||
(lambda (. o)
|
||||
(if (not (= (length o) (length params))) (error "wrong number of arguments for record-constructor")
|
||||
(let ((rest (make-list (- (length fields) (length params)))))
|
||||
(list->vector (cons type (append o rest))))))))
|
||||
|
||||
(define (record-fields o)
|
||||
(vector-ref o 2))
|
||||
|
||||
(define (record-field-index type field)
|
||||
(1+ (or (lst-index (record-fields type) field)
|
||||
(error "no such field" type field))))
|
||||
|
||||
(define (record-getter type field)
|
||||
(let ((i (record-field-index type field)))
|
||||
(lambda (o . field?)
|
||||
(if (not (eq? (record-type o) type)) (error "record getter: record expected" type o)
|
||||
(if (pair? field?) field
|
||||
(vector-ref o i))))))
|
||||
|
||||
(define (record-setter type field)
|
||||
(let ((i (record-field-index type field)))
|
||||
(lambda (o v)
|
||||
(if (not (eq? (record-type o) type)) (error "record setter: record expected" type o)
|
||||
(vector-set! o i v)))))
|
||||
|
||||
(define (record-predicate type)
|
||||
(lambda (o)
|
||||
(and (vector? o)
|
||||
(eq? (record-type o) type))))
|
||||
|
||||
(define-macro (define-record-accessors type . fields)
|
||||
`(begin
|
||||
,@(map (lambda (field)
|
||||
`(define-record-accessor ,type ,field))
|
||||
fields)))
|
||||
|
||||
(define-macro (define-record-accessor type field)
|
||||
`(begin
|
||||
(define ,(cadr field) ,(record-getter type (car field)))
|
||||
(if ,(pair? (cddr field))
|
||||
(define ,(if (pair? (cddr field)) (caddr field)) ,(record-setter type (car field))))))
|
||||
|
||||
(define-macro (define-record-type type constructor+params predicate . fields)
|
||||
(let ((record (make-record-type type (map car fields))))
|
||||
`(begin
|
||||
(define ,type ,record)
|
||||
(define ,(car constructor+params) ,(record-constructor record (cdr constructor+params)))
|
||||
(define ,predicate ,(record-predicate record))
|
||||
(define-record-accessors ,record ,@fields))))
|
||||
|
||||
;; (define-record-type cpi
|
||||
;; (make-cpi-1)
|
||||
;; cpi?
|
||||
;; (debug cpi-debug set-cpi-debug!) ; debug #t #f
|
||||
;; (defines cpi-defs set-cpi-defs!) ; #defines
|
||||
;; (incdirs cpi-incs set-cpi-incs!) ; #includes
|
||||
;; (inc-tynd cpi-itynd set-cpi-itynd!) ; a-l of incfile => typenames
|
||||
;; (inc-defd cpi-idefd set-cpi-idefd!) ; a-l of incfile => defines
|
||||
;; (ptl cpi-ptl set-cpi-ptl!) ; parent typename list
|
||||
;; (ctl cpi-ctl set-cpi-ctl!) ; current typename list
|
||||
;; (blev cpi-blev set-cpi-blev!) ; curr brace/block level
|
||||
;; )
|
||||
|
||||
;; (display cpi)
|
||||
;; (newline)
|
||||
;; (display make-cpi-1)
|
||||
;; (newline)
|
||||
;; (define cpi (make-cpi-1))
|
||||
;; (set-cpi-debug! cpi #t)
|
||||
;; (set-cpi-blev! cpi #t)
|
||||
|
||||
|
||||
;; (define-record-type <employee> (make-employee name age salary) employee? (name employe-name) (age employee-age set-employee-age!) (salary employee-salary))
|
||||
|
||||
;; (display <employee>)
|
||||
;; (newline)
|
||||
;; (display make-employee)
|
||||
;; (newline)
|
||||
;; (display "employee-age ")
|
||||
;; (display employee-age)
|
||||
;; (newline)
|
||||
|
||||
;; (display "set-employee-age! ")
|
||||
;; (display set-employee-age!)
|
||||
;; (newline)
|
||||
|
||||
;; (define janneke (make-employee "janneke" 49 42))
|
||||
;; (display janneke)
|
||||
;; (newline)
|
||||
|
||||
;; (display (employee-age janneke))
|
||||
;; (newline)
|
||||
|
||||
;; (display (set-employee-age! janneke 33))
|
||||
;; (newline)
|
||||
;; (display (employee-age janneke))
|
||||
;; (newline)
|
|
@ -0,0 +1 @@
|
|||
srfi-9-struct.mes
|
|
@ -0,0 +1,38 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
;;; GNU Mes is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Mes is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; srfi-9.mes - GNU immutable records.
|
||||
|
||||
(define-macro (define-immutable-record-type type constructor+params predicate . fields)
|
||||
`(define-record-type ,type ,constructor+params ,predicate ,@(map (lambda (f) (list-head f 2)) fields)))
|
||||
|
||||
(define-macro (set-field o getters value)
|
||||
`(let ((getter ,(car getters)))
|
||||
(let* ((type (struct-vtable ,o))
|
||||
(name (record-type ,o))
|
||||
(set (getter ,o #t)))
|
||||
(define (field->value field)
|
||||
(if (eq? set field) ,value
|
||||
((record-getter type field) ,o)))
|
||||
(let* ((fields (record-fields type))
|
||||
(values (map field->value fields)))
|
||||
(apply (record-constructor type name fields) values)))))
|
|
@ -0,0 +1,37 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
;;; GNU Mes is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Mes is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; srfi-9.mes - GNU immutable records.
|
||||
|
||||
(define-macro (define-immutable-record-type type constructor+params predicate . fields)
|
||||
`(define-record-type ,type ,constructor+params ,predicate ,@(map (lambda (f) (list-head f 2)) fields)))
|
||||
|
||||
(define-macro (set-field o getters value)
|
||||
`(let ((getter ,(car getters)))
|
||||
(let ((type (record-type ,o))
|
||||
(set (getter ,o #t)))
|
||||
(define (field->value field)
|
||||
(if (eq? set field) ,value
|
||||
((record-getter type field) ,o)))
|
||||
(let* ((fields (record-fields type))
|
||||
(values (map field->value fields)))
|
||||
(apply (record-constructor type fields) values)))))
|
|
@ -1,37 +0,0 @@
|
|||
;;; -*-scheme-*-
|
||||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
;;; GNU Mes is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Mes is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; srfi-9.mes - GNU immutable records.
|
||||
|
||||
(define-macro (define-immutable-record-type type constructor+params predicate . fields)
|
||||
`(define-record-type ,type ,constructor+params ,predicate ,@(map (lambda (f) (list-head f 2)) fields)))
|
||||
|
||||
(define-macro (set-field o getters value)
|
||||
`(let ((getter ,(car getters)))
|
||||
(let ((type (record-type ,o))
|
||||
(set (getter ,o #t)))
|
||||
(define (field->value field)
|
||||
(if (eq? set field) ,value
|
||||
((record-getter type field) ,o)))
|
||||
(let* ((fields (record-fields type))
|
||||
(values (map field->value fields)))
|
||||
(apply (record-constructor type fields) values)))))
|
|
@ -0,0 +1 @@
|
|||
gnu-struct.mes
|
|
@ -38,6 +38,11 @@
|
|||
%arch
|
||||
%compiler
|
||||
))
|
||||
(cond-expand
|
||||
(guile-2)
|
||||
(guile
|
||||
(define %host-type (string-append (utsname:machine (uname)) "linux-gnu")))
|
||||
(else))
|
||||
|
||||
(define-macro (mes-use-module . rest) #t)
|
||||
(define builtin? procedure?) ; not strictly true, but ok for tests/*.test
|
||||
|
|
|
@ -22,7 +22,9 @@
|
|||
disjoin
|
||||
guile?
|
||||
mes?
|
||||
pk
|
||||
pke
|
||||
warn
|
||||
stderr
|
||||
string-substitute))
|
||||
|
||||
|
@ -43,6 +45,13 @@
|
|||
(define (stderr string . rest)
|
||||
(apply logf (cons* (current-error-port) string rest)))
|
||||
|
||||
(define (pk . stuff)
|
||||
(newline)
|
||||
(display ";;; ")
|
||||
(write stuff)
|
||||
(newline)
|
||||
(car (last-pair stuff)))
|
||||
|
||||
(define (pke . stuff)
|
||||
(newline (current-error-port))
|
||||
(display ";;; " (current-error-port))
|
||||
|
@ -50,6 +59,8 @@
|
|||
(newline (current-error-port))
|
||||
(car (last-pair stuff)))
|
||||
|
||||
(define warn pke)
|
||||
|
||||
(define (disjoin . predicates)
|
||||
(lambda (. arguments)
|
||||
(any (lambda (o) (apply o arguments)) predicates)))
|
||||
|
|
|
@ -26,11 +26,13 @@
|
|||
;;; Code:
|
||||
|
||||
(define-module (mes test)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:export (
|
||||
pass-if
|
||||
pass-if-equal
|
||||
pass-if-not
|
||||
pass-if-eq
|
||||
pass-if-timeout
|
||||
result
|
||||
seq? ; deprecated
|
||||
sequal? ; deprecated
|
||||
|
@ -38,6 +40,7 @@
|
|||
|
||||
(cond-expand
|
||||
(mes
|
||||
(define (inexact->exact x) x)
|
||||
(define mes? #t)
|
||||
(define guile? #f)
|
||||
(define guile-2? #f)
|
||||
|
@ -78,9 +81,9 @@
|
|||
(display ": fail")
|
||||
(newline)
|
||||
(display "expected: ")
|
||||
(display expect) (newline)
|
||||
(write expect) (newline)
|
||||
(display "actual: ")
|
||||
(display a)
|
||||
(write a)
|
||||
(newline)
|
||||
#f)))
|
||||
|
||||
|
@ -90,9 +93,9 @@
|
|||
(display ": fail")
|
||||
(newline)
|
||||
(display "expected: ")
|
||||
(display expect) (newline)
|
||||
(write expect) (newline)
|
||||
(display "actual: ")
|
||||
(display a)
|
||||
(write a)
|
||||
(newline)
|
||||
#f)))
|
||||
|
||||
|
@ -100,16 +103,24 @@
|
|||
(or (eq? a expect)
|
||||
(begin
|
||||
(display ": fail") (newline)
|
||||
(display "expected: ") (display expect) (newline)
|
||||
(display "actual: ") (display a) (newline)
|
||||
(display "expected: ") (write expect) (newline)
|
||||
(display "actual: ") (write a) (newline)
|
||||
#f)))
|
||||
|
||||
(define (sless? a expect)
|
||||
(or (< a expect)
|
||||
(begin
|
||||
(display ": fail") (newline)
|
||||
(display "expected: ") (write expect) (newline)
|
||||
(display "actual: ") (write a) (newline)
|
||||
#f)))
|
||||
|
||||
(define (sequal2? actual expect)
|
||||
(or (equal? actual expect)
|
||||
(begin
|
||||
(display ": fail") (newline)
|
||||
(display "expected: ") (display expect) (newline)
|
||||
(display "actual: ") (display actual) (newline)
|
||||
(display "expected: ") (write expect) (newline)
|
||||
(display "actual: ") (write actual) (newline)
|
||||
#f)))
|
||||
|
||||
(define-macro (pass-if name t)
|
||||
|
@ -132,3 +143,16 @@
|
|||
'begin
|
||||
(list display "test: ") (list display name)
|
||||
(list 'result (list not f)))) ;; FIXME
|
||||
|
||||
(define internal-time-units-per-milli-second
|
||||
(/ internal-time-units-per-second 1000))
|
||||
(define (test-time thunk)
|
||||
((lambda (start)
|
||||
(begin
|
||||
(thunk)
|
||||
(inexact->exact (/ (- (get-internal-run-time) start)
|
||||
internal-time-units-per-milli-second))))
|
||||
(get-internal-run-time)))
|
||||
|
||||
(define-macro (pass-if-timeout name limit . body)
|
||||
(list 'pass-if name (list sless? (list test-time (cons* 'lambda '_ body)) limit)))
|
||||
|
|
|
@ -87,7 +87,7 @@
|
|||
(dec->hex (quotient o #x100000000))))
|
||||
(string-append "%" (number->string (dec->hex (modulo o #x100000000)))
|
||||
" %" (if (< o 0) "-1"
|
||||
(number->string (dec->hex (quoteint o #x100000000)))))))
|
||||
(number->string (dec->hex (quotient o #x100000000)))))))
|
||||
|
||||
(define* (display-join o #:optional (sep ""))
|
||||
(let loop ((o o))
|
||||
|
|
|
@ -209,6 +209,7 @@
|
|||
((mod ,a ,b) (ast->type a info))
|
||||
((mul ,a ,b) (ast->type a info))
|
||||
((not ,a) (ast->type a info))
|
||||
((pos ,a) (ast->type a info))
|
||||
((neg ,a) (ast->type a info))
|
||||
((eq ,a ,b) (ast->type a info))
|
||||
((ge ,a ,b) (ast->type a info))
|
||||
|
@ -1218,6 +1219,9 @@
|
|||
(info (append-text info (wrap-as (as info 'r-negate)))))
|
||||
(append-text info (wrap-as (as info 'test-r))))) ;; hmm, use ast->info?
|
||||
|
||||
((pos ,expr)
|
||||
(expr->register expr info))
|
||||
|
||||
((neg ,expr)
|
||||
(let* ((info (expr->register expr info))
|
||||
(info (allocate-register info))
|
||||
|
@ -1542,6 +1546,7 @@
|
|||
(define (cstring->int o)
|
||||
(let ((o (cond ((string-suffix? "ULL" o) (string-drop-right o 3))
|
||||
((string-suffix? "UL" o) (string-drop-right o 2))
|
||||
((string-suffix? "U" o) (string-drop-right o 1))
|
||||
((string-suffix? "LL" o) (string-drop-right o 2))
|
||||
((string-suffix? "L" o) (string-drop-right o 1))
|
||||
(else o))))
|
||||
|
@ -1559,6 +1564,8 @@
|
|||
(pmatch o
|
||||
((fixed ,a) (cstring->int a))
|
||||
((p-expr ,expr) (expr->number info expr))
|
||||
((pos ,a)
|
||||
(expr->number info a))
|
||||
((neg ,a)
|
||||
(- (expr->number info a)))
|
||||
((add ,a ,b)
|
||||
|
@ -2536,6 +2543,7 @@
|
|||
(define (fctn-defn:get-name o)
|
||||
(pmatch o
|
||||
((_ (ftn-declr (ident ,name) _) _) name)
|
||||
((_ (ftn-declr (scope (ident ,name)) _) _) name)
|
||||
((_ (ptr-declr (pointer . _) (ftn-declr (ident ,name) _)) _) name)
|
||||
(_ (error "fctn-defn:get-name not supported:" o))))
|
||||
|
||||
|
@ -2609,6 +2617,7 @@
|
|||
(define (fctn-defn:get-statement o)
|
||||
(pmatch o
|
||||
((_ (ftn-declr (ident _) _) ,statement) statement)
|
||||
((_ (ftn-declr (scope (ident _)) _) ,statement) statement)
|
||||
((_ (ptr-declr (pointer . _) (ftn-declr (ident _) . _)) ,statement) statement)
|
||||
(_ (error "fctn-defn:get-statement: not supported: " o))))
|
||||
|
||||
|
|
|
@ -540,6 +540,7 @@
|
|||
|
||||
(define (i386:r2->r0 info)
|
||||
(let ((r0 (get-r0 info))
|
||||
(r1 (get-r1 info))
|
||||
(allocated (.allocated info)))
|
||||
(if (> (length allocated) 2)
|
||||
(let ((r2 (cadddr allocated)))
|
||||
|
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue