From 6b841a0cab4aa4653f1b7fb4895f4de831f41523 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 25 Nov 2018 13:21:03 +0100 Subject: [PATCH] mescc: Run without shell. * mes/module/mescc.mes: New file. * module/mescc.scm: Include it. * scripts/mescc.scm.in: New file. * scripts/mescc.in: Use it; Make pure shell. * configure: Substitute it. * configure.sh: Substitute it. * build-aux/install.sh.in: Install it. --- .gitignore | 1 + build-aux/build-guile.sh | 2 +- build-aux/install.sh.in | 1 + build-aux/pre-inst-env.in | 2 +- configure | 6 +- configure.sh | 2 + mes/module/mescc.mes | 25 ++++++ module/mescc.scm | 125 ++++++++++++++++++++++++++ scripts/mescc.in | 178 +++++++------------------------------- scripts/mescc.scm.in | 38 ++++++++ 10 files changed, 227 insertions(+), 153 deletions(-) create mode 100644 mes/module/mescc.mes create mode 100644 module/mescc.scm create mode 100644 scripts/mescc.scm.in diff --git a/.gitignore b/.gitignore index ccd7c94c..d6b2db6b 100644 --- a/.gitignore +++ b/.gitignore @@ -115,6 +115,7 @@ /install.sh /uninstall.sh /mes/module/mes/boot-0.scm +/scripts/mescc.scm /scripts/mescc /doc/images/gcc-mesboot-graph.png /GNUmakefile diff --git a/build-aux/build-guile.sh b/build-aux/build-guile.sh index 22303410..91e0d75e 100755 --- a/build-aux/build-guile.sh +++ b/build-aux/build-guile.sh @@ -42,13 +42,13 @@ ${srcdest}module/mescc/i386/info.scm ${srcdest}module/mescc/x86_64/as.scm ${srcdest}module/mescc/x86_64/info.scm ${srcdest}module/mescc/info.scm +${srcdest}module/mescc.scm ${srcdest}module/mescc/mescc.scm ${srcdest}module/mescc/preprocess.scm " SCRIPTS=" ${srcdest}build-aux/mes-snarf.scm -${srcdest}scripts/mescc " export host=$($GUILE -c "(display %host-type)") diff --git a/build-aux/install.sh.in b/build-aux/install.sh.in index afb4d0c3..db475205 100644 --- a/build-aux/install.sh.in +++ b/build-aux/install.sh.in @@ -50,6 +50,7 @@ mkdir -p $DESTDIR$bindir if [ -f src/x86-mes-mes ]; then cp src/x86-mes-mes $DESTDIR$bindir/mes fi +cp scripts/mescc.scm $DESTDIR$bindir/mescc.scm cp scripts/mescc $DESTDIR$bindir/mescc sed \ diff --git a/build-aux/pre-inst-env.in b/build-aux/pre-inst-env.in index 258431db..7ae34ac7 100644 --- a/build-aux/pre-inst-env.in +++ b/build-aux/pre-inst-env.in @@ -28,7 +28,7 @@ MES_PREFIX=${MES_PREFIX-${srcdest}mes} export MES_PREFIX GUILE_LOAD_COMPILED_PATH="$abs_top_builddir/scripts:$abs_top_builddir/module${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" -GUILE_LOAD_PATH="module:mes:$abs_top_srcdir/guix${GUILE_LOAD_PATH:+:}$GUILE_LOAD_PATH" +GUILE_LOAD_PATH="$abs_top_srcdir/module:$abs_top_srcdir/mes:$abs_top_srcdir/guix${GUILE_LOAD_PATH:+:}$GUILE_LOAD_PATH" if [ -n "$srcdest" ]; then GUILE_LOAD_PATH="${srcdest}module:${srcdest}mes:$GUILE_LOAD_PATH" fi diff --git a/configure b/configure index 93f334a4..dda0dfbd 100755 --- a/configure +++ b/configure @@ -373,9 +373,9 @@ Some influential environment variables: (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))) + (string-append prefix "/share/guile/site/" guile-effective-version))) (guile-site-ccache-dir (if (equal? prefix ".") (canonicalize-path ".") - (string-append "${prefix}/lib/guile/" guile-effective-version "/site-ccache"))) + (string-append prefix "/lib/guile/" guile-effective-version "/site-ccache"))) (srcdir (dirname (car (command-line)))) (srcdest (if (equal? srcdir ".") "" @@ -591,10 +591,12 @@ Some influential environment variables: "build-aux/pre-inst-env.in" "build-aux/uninstall.sh.in" "mes/module/mes/boot-0.scm.in" + "scripts/mescc.scm.in" "scripts/mescc.in" )) (chmod "pre-inst-env" #o755) (chmod "scripts/mescc" #o755) + (chmod "scripts/mescc.scm" #o755) (chmod "build.sh" #o755) (chmod "check.sh" #o755) (chmod "install.sh" #o755) diff --git a/configure.sh b/configure.sh index a1e03246..c631afee 100755 --- a/configure.sh +++ b/configure.sh @@ -152,6 +152,8 @@ subst ${srcdest}build-aux/pre-inst-env.in pre-inst-env chmod +x pre-inst-env subst ${srcdest}scripts/mescc.in scripts/mescc chmod +x scripts/mescc +subst ${srcdest}scripts/mescc.scm.in scripts/mescc.scm +chmod +x scripts/mescc.scm host=${host-$($CC -dumpmachine 2>/dev/null || echo x86)} if [ -z "$host" ]; then diff --git a/mes/module/mescc.mes b/mes/module/mescc.mes new file mode 100644 index 00000000..ea422ca1 --- /dev/null +++ b/mes/module/mescc.mes @@ -0,0 +1,25 @@ +;;; -*-scheme-*- + +;;; GNU Mes --- Maxwell Equations of Software +;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen +;;; +;;; 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 . + +;;; Commentary: + +;;; Code: + +(include-from-path "mescc.scm") diff --git a/module/mescc.scm b/module/mescc.scm new file mode 100644 index 00000000..de9b02e1 --- /dev/null +++ b/module/mescc.scm @@ -0,0 +1,125 @@ +;;; GNU Mes --- Maxwell Equations of Software +;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen +;;; +;;; 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 . + +(define-module (mescc) + #:use-module (ice-9 getopt-long) + #:use-module (mes misc) + #:use-module (mescc mescc) + #:export (mescc:main)) + +(cond-expand + (mes + (define (set-port-encoding! port encoding) #t) + (mes-use-module (mes guile)) + (mes-use-module (mes misc)) + (mes-use-module (mes getopt-long)) + (mes-use-module (mes display)) + (mes-use-module (mescc mescc)) + ) + (guile + (define-macro (mes-use-module . rest) #t))) + +(define %prefix (getenv "%prefix")) +(define %version (getenv "%version")) + +(when (and=> (getenv "V") (lambda (v) (> (string->number v) 1))) + (format (current-error-port) "mescc[~a]...\n" %scheme)) + +(define (parse-opts args) + (let* ((option-spec + '((align) + (assemble (single-char #\c)) + (base-address (value #t)) + (compile (single-char #\S)) + (define (single-char #\D) (value #t)) + (debug-info (single-char #\g)) + (dumpmachine (single-char #\d)) + (help (single-char #\h)) + (include (single-char #\I) (value #t)) + (library-dir (single-char #\L) (value #t)) + (library (single-char #\l) (value #t)) + (machine (single-char #\m) (value #t)) + (preprocess (single-char #\E)) + (std (value #t)) + (output (single-char #\o) (value #t)) + (optimize (single-char #\O) (value #t)) + (version (single-char #\V)) + (verbose (single-char #\v)) + (write (single-char #\w) (value #t)) + (language (single-char #\x) (value #t)))) + (single-dash-options '("-dumpmachine" "-std")) + (args (map (lambda (o) + (if (member o single-dash-options) (string-append "-" o) + o)) + args)) + (options (getopt-long args option-spec)) + (help? (option-ref options 'help #f)) + (files (option-ref options '() '())) + (usage? (and (not help?) (null? files))) + (version? (option-ref options 'version #f))) + (cond ((option-ref options 'dumpmachine #f) + (display "x86-mes") + (exit 0)) + (version? (format #t "mescc (GNU Mes) ~a\n" %version) (exit 0)) + (else + (and (or help? usage?) + (format (or (and usage? (current-error-port)) (current-output-port)) "\ +Usage: mescc [OPTION]... FILE... + --align align globals + -dumpmachine display the compiler's target processor + --base-address=ADRRESS + use BaseAddress ADDRESS [0x1000000] + -D DEFINE[=VALUE] define DEFINE [VALUE=1] + -E preprocess only; do not compile, assemble or link + -g add debug info [GDB, objdump] TODO: hex2 footer + -h, --help display this help and exit + -I DIR append DIR to include path + -L DIR append DIR to library path + -l LIBNAME link with LIBNAME + -m BITS compile for BITS bits [32] + -o FILE write output to FILE + -O LEVEL use optimizing LEVEL + -S preprocess and compile only; do not assemble or link + --std=STANDARD assume that the input sources are for STANDARD + -v, --version display version and exit + -w,--write=TYPE dump Nyacc AST using TYPE {pretty-print,write} + -x LANGUAGE specify LANGUAGE of the following input files + +Environment variables: + + MES=BINARY run on mes-executable BINARY {mes,guile} + MES_DEBUG=LEVEL show debug output with verbosity LEVEL {0..5} + NYACC_TRACE=1 show Nyacc progress +") + (exit (or (and usage? 2) 0))) + options)))) + +(define (mescc:main args) + (let* ((options (parse-opts args)) + (options (acons 'prefix %prefix options)) + (preprocess? (option-ref options 'preprocess #f)) + (compile? (option-ref options 'compile #f)) + (assemble? (option-ref options 'assemble #f)) + (verbose? (option-ref options 'verbose (getenv "MES_DEBUG")))) + (when verbose? + (setenv "NYACC_TRACE" "yes") + (format (current-error-port) "options=~s\n" options)) + (cond (preprocess? (mescc:preprocess options)) + (compile? (mescc:compile options)) + (assemble? (mescc:assemble options)) + (else (mescc:link options))))) diff --git a/scripts/mescc.in b/scripts/mescc.in index 738b49d0..ce4075a1 100755 --- a/scripts/mescc.in +++ b/scripts/mescc.in @@ -1,161 +1,41 @@ #! @BASH@ -# -*-scheme-*- + +# GNU Mes --- Maxwell Equations of Software +# Copyright © 2018 Jan (janneke) Nieuwenhuizen +# +# 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 . + if [ "$V" = 2 ]; then set -x fi -prefix=${prefix-@prefix@} -program_prefix=${program_prefix-@program_prefix@} + MES_ARENA=${MES_ARENA-100000000} export MES_ARENA + MES_STACK=${MES_STACK-500000} export MES_STACK + MES_PREFIX=${MES_PREFIX-$prefix/share/mes} export MES_PREFIX -mes_p=$(command -v mes) -mescc=$(command -v $0) -guile_site_dir=${guile_site_dir-@guile_site_dir@} -GUILE_LOAD_PATH=$guile_site_dir:$GUILE_LOAD_PATH +MES=${MES-src/mes} -if [ '(' -z "$mes_p" -a -z "$MES" ')' -o "$MES" = "guile" -o "$MES" = "mes.guile" ]; then - guile_site_ccache_dir=${guile_site_ccache_dir-@guile_site_ccache_dir@} - GUILE_LOAD_COMPILED_PATH=$guile_site_ccache_dir:$GUILE_LOAD_COMPILED_PATH - GUILE_AUTO_COMPILE=${GUILE_AUTO_COMPILE-0} - export GUILE_AUTO_COMPILE - exec ${GUILE-guile} -L $guile_site_dir -e '(mescc)' -s "$mescc" "$@" -else - MES=${MES-$(dirname $0)/mes} - exec ${MES-mes} -e '(mescc)' -s "$mescc" "$@" -fi -!# - -;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen -;;; -;;; 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 . - -(define-module (mescc) - #:use-module (ice-9 getopt-long) - #:use-module (mes misc) - #:use-module (mescc mescc) - #:export (main)) - -(define %prefix (or (getenv "MES_PREFIX") - (if (string-prefix? "@prefix" "@prefix@") - "" - "@prefix@/share/mes"))) - -(define %version (if (string-prefix? "@VERSION" "@VERSION@") "git" - "@VERSION@")) - -(cond-expand - (mes - (define (set-port-encoding! port encoding) #t) - (mes-use-module (mes guile)) - (mes-use-module (mes misc)) - (mes-use-module (mes getopt-long)) - (mes-use-module (mes display)) - (mes-use-module (mescc mescc))) - (guile - (define-macro (mes-use-module . rest) #t))) - -(when (and=> (getenv "V") (lambda (v) (> (string->number v) 1))) - (format (current-error-port) "mescc[~a]...\n" %scheme)) - -(define (parse-opts args) - (let* ((option-spec - '((align) - (assemble (single-char #\c)) - (base-address (value #t)) - (compile (single-char #\S)) - (define (single-char #\D) (value #t)) - (debug-info (single-char #\g)) - (dumpmachine (single-char #\d)) - (help (single-char #\h)) - (include (single-char #\I) (value #t)) - (library-dir (single-char #\L) (value #t)) - (library (single-char #\l) (value #t)) - (machine (single-char #\m) (value #t)) - (preprocess (single-char #\E)) - (std (value #t)) - (output (single-char #\o) (value #t)) - (optimize (single-char #\O) (value #t)) - (version (single-char #\V)) - (verbose (single-char #\v)) - (write (single-char #\w) (value #t)) - (language (single-char #\x) (value #t)))) - (single-dash-options '("-dumpmachine" "-std")) - (args (map (lambda (o) - (if (member o single-dash-options) (string-append "-" o) - o)) - args)) - (options (getopt-long args option-spec)) - (help? (option-ref options 'help #f)) - (files (option-ref options '() '())) - (usage? (and (not help?) (null? files))) - (version? (option-ref options 'version #f))) - (cond ((option-ref options 'dumpmachine #f) - (display "x86-mes") - (exit 0)) - (version? (format #t "mescc (GNU Mes) ~a\n" %version) (exit 0)) - (else - (and (or help? usage?) - (format (or (and usage? (current-error-port)) (current-output-port)) "\ -Usage: mescc [OPTION]... FILE... - --align align globals - -dumpmachine display the compiler's target processor - --base-address=ADRRESS - use BaseAddress ADDRESS [0x1000000] - -D DEFINE[=VALUE] define DEFINE [VALUE=1] - -E preprocess only; do not compile, assemble or link - -g add debug info [GDB, objdump] TODO: hex2 footer - -h, --help display this help and exit - -I DIR append DIR to include path - -L DIR append DIR to library path - -l LIBNAME link with LIBNAME - -m BITS compile for BITS bits [32] - -o FILE write output to FILE - -O LEVEL use optimizing LEVEL - -S preprocess and compile only; do not assemble or link - --std=STANDARD assume that the input sources are for STANDARD - -v, --version display version and exit - -w,--write=TYPE dump Nyacc AST using TYPE {pretty-print,write} - -x LANGUAGE specify LANGUAGE of the following input files - -Environment variables: - - MES=BINARY run on mes-executable BINARY {mes,guile} - MES_DEBUG=LEVEL show debug output with verbosity LEVEL {0..5} - NYACC_TRACE=1 show Nyacc progress -") - (exit (or (and usage? 2) 0))) - options)))) - -(define (main args) - (let* ((options (parse-opts args)) - (options (acons 'prefix %prefix options)) - (preprocess? (option-ref options 'preprocess #f)) - (compile? (option-ref options 'compile #f)) - (assemble? (option-ref options 'assemble #f)) - (verbose? (option-ref options 'verbose (getenv "MES_DEBUG")))) - (when verbose? - (setenv "NYACC_TRACE" "yes") - (format (current-error-port) "options=~s\n" options)) - (cond (preprocess? (mescc:preprocess options)) - (compile? (mescc:compile options)) - (assemble? (mescc:assemble options)) - (else (mescc:link options))))) -'done +exec ${SCHEME-$MES} \ + --no-auto-compile\ + -e main\ + -L @guile_site_dir@\ + -C @guile_site_ccache_dir@\ + $(dirname $0)/mescc.scm "$@" diff --git a/scripts/mescc.scm.in b/scripts/mescc.scm.in new file mode 100644 index 00000000..05e67ad5 --- /dev/null +++ b/scripts/mescc.scm.in @@ -0,0 +1,38 @@ +#! @GUILE@ \ +--no-auto-compile -e main -L @guile_site_dir@ -C @guile_site_ccache_dir@ -s +!# +;;; GNU Mes --- Maxwell Equations of Software +;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen +;;; +;;; 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 . + +(setenv "%prefix" (or (getenv "MES_PREFIX") + (if (string-prefix? "@prefix" "@prefix@") + "" + "@prefix@/share/mes"))) + +(setenv "%version" (if (string-prefix? "@VERSION" "@VERSION@") "git" + "@VERSION@")) + +(cond-expand + (mes + (mes-use-module (mescc)) + (mescc:main (command-line))) + (guile + (use-modules (mescc)))) + +(define (main args) + (mescc:main args))