06e0dfe9ad
* doc/images/gcc-mesboot-graph.dot: New file.
* doc/images/gcc-mesboot-graph.png: Remove.
* GNUmakefile (${top_builddest}doc/images/gcc-mesboot-graph.png): New target.
* configure (det): Add check.
* build-aux/export.make: Export it.
* doc/mes.texi (The Mes Bootstrap Process): Describe new recipe.
* guix/git/mes.scm (mes): Add graphvis dependency.
491 lines
20 KiB
Scheme
Executable file
491 lines
20 KiB
Scheme
Executable file
#! /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+"$@"}
|
|
!#
|
|
|
|
;;; Mes --- Maxwell Equations of Software
|
|
;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
|
;;;
|
|
;;; configure: This file is part of Mes.
|
|
;;;
|
|
;;; Mes is free software; you can redistribute it and/or modify it
|
|
;;; under the terms of the GNU General Public License as published by
|
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
|
;;; your option) any later version.
|
|
;;;
|
|
;;; Mes is distributed in the hope that it will be useful, but
|
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;;; GNU General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU General Public License
|
|
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
(define-module (configure)
|
|
#:use-module (srfi srfi-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))
|
|
|
|
(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))
|
|
default)))
|
|
|
|
(define *shell* "sh")
|
|
(define PACKAGE "mes")
|
|
(define VERSION "0.16.1")
|
|
|
|
;;; Utility
|
|
(define (logf port string . rest)
|
|
(apply format (cons* port string rest))
|
|
(force-output port)
|
|
#t)
|
|
|
|
(define (stderr string . rest)
|
|
(apply logf (cons* (current-error-port) string rest)))
|
|
|
|
(define (stdout string . rest)
|
|
(apply logf (cons* (current-output-port) string rest)))
|
|
|
|
(define %verbose? #f)
|
|
|
|
(define (verbose string . rest)
|
|
(if %verbose? (apply stderr (cons string rest))))
|
|
|
|
(define (gulp-pipe command)
|
|
(let* ((port (open-pipe* OPEN_READ *shell* "-c" 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)))
|
|
(_ ""))))
|
|
|
|
(define (tuple< a b)
|
|
(cond
|
|
((and (null? a) (null? b)) #t)
|
|
((null? a) (not (null? b)))
|
|
((null? b) #f)
|
|
((and (not (< (car a) (car b)))
|
|
(not (< (car b) (car a))))
|
|
(tuple< (cdr a) (cdr b)))
|
|
(else (< (car a) (car b)))))
|
|
|
|
(define (tuple<= a b)
|
|
(or (equal? a b) (tuple< a b)))
|
|
|
|
(define (conjoin . predicates)
|
|
(lambda (. arguments)
|
|
(every (cut apply <> arguments) predicates)))
|
|
|
|
(define (char->char from to char)
|
|
(if (eq? char from) to char))
|
|
|
|
(define (string-replace-char string from to)
|
|
(string-map (cut char->char from to <>) string))
|
|
|
|
;;; Configure
|
|
|
|
(define-immutable-record-type <dependency>
|
|
(make-depedency name version-expected optional? version-option commands file-name)
|
|
dependency?
|
|
(name dependency-name)
|
|
(version-expected dependency-version-expected)
|
|
(version-option dependency-version-option)
|
|
(optional? dependency-optional?)
|
|
(commands dependency-commands)
|
|
(file-name dependency-file-name)
|
|
(version-found dependency-version-found))
|
|
|
|
(define* (make-dep name #:optional (version '(0))
|
|
#:key optional? (version-option "--version") (commands (list name)) file-name)
|
|
(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)))
|
|
|
|
(define (find-dep name deps)
|
|
(find (compose (cut equal? <> name) dependency-name) deps))
|
|
|
|
(define (file-name name deps)
|
|
(and=> (find-dep name deps) dependency-file-name))
|
|
|
|
(define (variable-name dependency)
|
|
(and=>
|
|
(dependency-name dependency)
|
|
name->shell-name))
|
|
|
|
(define (name->shell-name name)
|
|
(string-upcase (string-replace-char name #\- #\_)))
|
|
|
|
(define (version->string version)
|
|
((->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)))
|
|
|
|
(define (check-program-version dependency)
|
|
(let ((name (dependency-name dependency))
|
|
(expected (dependency-version-expected dependency))
|
|
(version-option (dependency-version-option dependency))
|
|
(commands (dependency-commands dependency)))
|
|
(let loop ((commands commands))
|
|
(if (null? commands) dependency
|
|
(let ((command (car commands)))
|
|
(stdout "checking for ~a~a... " command
|
|
(if (null? expected) ""
|
|
(format #f " [~a]" (version->string expected))))
|
|
(let* ((output (gulp-pipe (format #f "~a ~a 2>&1" command version-option)))
|
|
(actual (string->version output))
|
|
(pass? (and actual (tuple< expected actual)))
|
|
(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 pass? (let ((file-name (or (PATH-search-path command)
|
|
(dependency-file-name dependency))))
|
|
(set-field dependency (dependency-file-name) file-name))
|
|
(loop (cdr commands)))))))))
|
|
|
|
(define (check-file dependency)
|
|
(stdout "checking for ~a... " (dependency-name dependency))
|
|
(let ((file-name (and (file-exists? (dependency-file-name dependency))
|
|
(dependency-file-name dependency))))
|
|
(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))
|
|
(let ((name (dependency-name dependency)))
|
|
(stderr "checking for ~a..." name)
|
|
(let ((result (check name)))
|
|
(stderr " ~a\n" (if result "yes" "no"))
|
|
(if result (set-field dependency (dependency-file-name) name)
|
|
dependency-file-name))))
|
|
|
|
(define (check-compile-header-c header)
|
|
(zero? (system (format #f "echo '#include ~s' | gcc -E - > /dev/null 2>&1" header))))
|
|
|
|
(define (parse-opts args)
|
|
(let* ((option-spec
|
|
'((build (value #t))
|
|
(host (value #t))
|
|
(help (single-char #\h))
|
|
(prefix (value #t))
|
|
(bindir (value #t))
|
|
(datadir (value #t))
|
|
(docdir (value #t))
|
|
(libdir (value #t))
|
|
(sysconfdir (value #t))
|
|
(verbose (single-char #\v))
|
|
(with-courage)
|
|
(infodir (value #t))
|
|
(mandir (value #t))
|
|
(disable-silent-rules)
|
|
|
|
(enable-fast-install) ; Ignored for Guix
|
|
(includedir (value #t)) ; Ignored for Debian
|
|
(mandir (value #t)) ; Ignored for Debian
|
|
(localstatedir (value #t)) ; Ignored for Debian
|
|
(libdir (value #t)) ; Ignored for Debian
|
|
(libexecdir (value #t)) ; Ignored for Debian
|
|
(runstatedir (value #t)) ; Ignored for Debian
|
|
(disable-maintainer-mode) ; Ignored for Debian
|
|
(disable-dependency-tracking) ; Ignored for Debian
|
|
)))
|
|
|
|
(getopt-long args option-spec)))
|
|
|
|
(define* (print-help #:optional (port (current-output-port)))
|
|
(format port "\
|
|
`configure' configures ~a ~a to adapt to many kinds of systems.
|
|
|
|
Usage: ./configure [OPTION]... [VAR=VALUE]
|
|
|
|
To assign environment variables (e.g., CC, CFLAGS...), specify them as
|
|
VAR=VALUE. See below for descriptions of some of the useful variables.
|
|
|
|
Defaults for the options are specified in brackets.
|
|
|
|
Options:
|
|
-h, --help display this help
|
|
--build=BUILD configure for building on BUILD [guessed]
|
|
--disable-silent-rules
|
|
verbose build output [BUILD_DEBUG=1]
|
|
--host=HOST cross-compile to build programs to run on HOST [BUILD]
|
|
-v, --verbose be verbose
|
|
--with-courage assert being courageous to configure for unsupported platform
|
|
|
|
Installation directories:
|
|
--prefix=DIR install in prefix DIR [~a]
|
|
--infodir=DIR info documentation [PREFIX/share/info]
|
|
--mandir=DIR man pages [PREFIX/share/man]
|
|
|
|
Ignored for Guix:
|
|
--enable-fast-install
|
|
|
|
Ignored for Debian:
|
|
--disable-dependency-tracking
|
|
--disable-maintainer-mode
|
|
--includedir=DIR
|
|
--libdir=DIR
|
|
--libexecdir=DIR
|
|
--localstatedir=DIR
|
|
--runstatedir=DIR
|
|
|
|
Some influential environment variables:
|
|
CC C compiler command
|
|
CFLAGS C compiler flags
|
|
CC32 x86 C compiler command
|
|
CC32_CFLAGS x86 C compiler flags
|
|
GUILE guile command
|
|
GUILE_TOOLS guile-tools command
|
|
MES_CFLAGS MesCC flags
|
|
MES_SEED location of mes-seed
|
|
MESCC_TOOLS_SEED location of mescc-tools-seed
|
|
TCC tcc C compiler command
|
|
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))
|
|
(infodir (option-ref options 'infodir "${prefix}/share/info"))
|
|
(mandir (option-ref options 'infodir "${prefix}/share/man"))
|
|
(sysconfdir (option-ref options 'sysconfdir "${prefix}/etc"))
|
|
|
|
(bindir (option-ref options 'bindir "${prefix}/etc"))
|
|
(datadir (option-ref options 'datadir "${prefix}/share"))
|
|
(docdir (option-ref options 'docdir "${datadir}/doc/mes-${VERSION}"))
|
|
(libdir (option-ref options 'libdir "${prefix}/lib"))
|
|
(moduledir "${datadir}/mes/module")
|
|
(guile-effective-version (effective-version))
|
|
(guile-site-dir (if (equal? prefix ".") (canonicalize-path ".")
|
|
(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")))
|
|
|
|
(srcdir (dirname (car (command-line))))
|
|
(abs-top-srcdir (canonicalize-path srcdir))
|
|
(abs-top-builddir (canonicalize-path (getcwd)))
|
|
(top-builddir (if (equal? srcdir ".") "."
|
|
abs-top-builddir))
|
|
(top-builddest (if (equal? srcdir ".") ""
|
|
(string-append abs-top-builddir "/")))
|
|
|
|
|
|
(with-courage? (option-ref options 'with-courage #f))
|
|
(disable-silent-rules? (option-ref options 'disable-silent-rules #f))
|
|
(vars (filter (cut string-index <> #\=) (option-ref options '() '())))
|
|
(help? (option-ref options 'help #f)))
|
|
(define (srcdir-relative file-name)
|
|
(if (equal? srcdir ".") file-name
|
|
(string-append srcdir "/" file-name)))
|
|
(when help?
|
|
(print-help)
|
|
(exit 0))
|
|
(set! %verbose? (option-ref options 'verbose #f))
|
|
(when %verbose?
|
|
(stderr "configure args=~s\n" args))
|
|
(for-each (lambda (v) (apply setenv (string-split v #\=))) vars)
|
|
(let* ((mes-seed (or (getenv "MES_SEED")
|
|
(srcdir-relative "../mes-seed")))
|
|
(tinycc-seed (or (getenv "TINYCC_SEED")
|
|
(srcdir-relative "../tinycc-seed")))
|
|
(mescc-tools-seed (or (getenv "MESCC_TOOLS_SEED")
|
|
(srcdir-relative "../mescc-tools-seed")))
|
|
(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 16 1) #:optional? #t
|
|
#:commands (list (string-append mes-seed "/refresh.sh"))
|
|
#:file-name mes-seed)
|
|
(make-dep "tinycc-seed" '(0 16) #: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 "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 80 41) #: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"))
|
|
deps)
|
|
deps))
|
|
(deps (cons (check-file (make-dep "mescc-tools-seed" '(0) #:optional? #t
|
|
#:file-name mescc-tools-seed))
|
|
deps))
|
|
(missing (filter (conjoin (negate dependency-file-name)
|
|
(negate dependency-optional?)) deps)))
|
|
|
|
(define* (substitute file-name pairs
|
|
#:key (target (if (string-suffix? ".in" file-name)
|
|
(string-drop-right file-name 3) file-name)))
|
|
(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)))))
|
|
|
|
(when (and (not (member arch '("i686" "x86_64"))) (not with-courage?))
|
|
(stderr "platform not supported: ~a, try --with-courage\n" arch)
|
|
(exit 1))
|
|
(when (pair? missing)
|
|
(stderr "\nMissing dependencies: ~a\n" (string-join (map dependency-name missing)))
|
|
(exit 1))
|
|
(let ((git (find-dep "git" deps)))
|
|
(when (and git
|
|
(not (file-exists? ".git")))
|
|
;; Debian wants to run `make clean' from a tarball
|
|
(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)
|
|
|
|
(stdout "top_builddest:=~a\n" top-builddest)
|
|
(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)
|
|
|
|
(stdout "srcdir:=~a\n" srcdir)
|
|
|
|
(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 "BUILD_DEBUG:=1\n"))
|
|
|
|
(for-each (lambda (o)
|
|
(stdout "~a:=~a\n" o (or (getenv o) "")))
|
|
'(
|
|
"CFLAGS"
|
|
"CC32_CFLAGS"
|
|
"HEX2FLAGS"
|
|
"M1FLAGS"
|
|
"CC32_CFLAGS"
|
|
"MES_CFLAGS"
|
|
))))
|
|
|
|
(let ((pairs `(("@srcdir@" . ,abs-top-srcdir)
|
|
("@abs_top_srcdir@" . ,abs-top-srcdir)
|
|
("@abs_top_builddir@" . ,abs-top-builddir)
|
|
("@top_builddir@" . ,top-builddir)
|
|
("@top_builddest@" . ,top-builddest)
|
|
("@BASH@" . ,(file-name "bash" deps))
|
|
("@GUILE@" . ,(file-name "guile" deps))
|
|
("@guile_site_dir@" . ,guile-site-dir)
|
|
("@guile_site_ccache_dir@" . ,guile-site-ccache-dir)
|
|
("@VERSION@" . ,VERSION)
|
|
("mes/module/" . ,(string-append moduledir "/")))))
|
|
(for-each (lambda (o)
|
|
(let* ((src (srcdir-relative o))
|
|
(target (string-drop-right o 3))
|
|
(target (if (not (string-prefix? "build-aux/" target)) target
|
|
(string-drop target (string-length "build-aux/")))))
|
|
(substitute src pairs #:target target)))
|
|
'(
|
|
"build-aux/pre-inst-env.in"
|
|
"mes/module/mes/boot-0.scm.in"
|
|
"scripts/mescc.in"
|
|
))
|
|
(when (not (equal? srcdir "."))
|
|
(substitute (string-append srcdir "/build-aux/GNUmakefile.in")
|
|
pairs
|
|
#:target "GNUmakefile")
|
|
(system (string-append "cd mes/module/mes && ln -sf " abs-top-srcdir "/mes/module/mes/*.mes ."))))
|
|
(chmod "pre-inst-env" #o755)
|
|
(chmod "scripts/mescc" #o755)
|
|
(let ((make (and=> (file-name "make" deps) basename)))
|
|
(format (current-output-port)
|
|
"\nRun:
|
|
~a to build mes
|
|
~a help for help on other targets\n"
|
|
(or make "./build.sh")
|
|
(or make "./build.sh"))))))
|