build: Cater for ARM.

* configure: Cater for ARM.
* configure.sh: Likewise
* build-aux/GNUmakefile.in: Likewise.
* build-aux/bootstrap.sh.in: Likewise.
* module/mescc.scm (parse-opts): Likewise.
* src/mes.c (mes_environment): Likewise.
* build-aux/build.sh.in: Likewise.
* build-aux/config.sh Likewise.
* build-aux/install.sh.in: Likewise.
* module/mes/guile.scm: Likewise.
* scripts/mescc.scm.in: Likewise.
* module/mescc/mescc.scm (arch-get): New function.
(arch-get-info): New function.
(arch-get-define): New function.
(arch-get-m1-options): New function.
(arch-get-Architecture): New function.
(mescc:preprocess c->info, E->info, M1->hex2, hex2->elf,
M1->blood-elf, arch-find): Use them.

build-aux/GNUmakefile.in

@@ -1,5 +1,5 @@
 # GNU Mes --- Maxwell Equations of Software
-# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+# Copyright © 2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 #
 # This file is part of GNU Mes.
 #
@@ -28,8 +28,20 @@ cleaning-p:=$(filter clean%, $(MAKECMDGOALS))$(filter %clean, $(MAKECMDGOALS))
 
 ifndef cleaning-p
 include .config.make
+ifneq ($(prefix),)
+prefix-arg=--prefix=$(prefix)
+endif
+ifneq ($(build),)
+build-arg=--build=$(build)
+endif
+ifneq ($(host),)
+host-arg=--host=$(host)
+endif
+ifeq ($(mes_libc),system)
+--with-system-libc=system
+endif
 .config.make:
-	${srcdir}/configure --prefix=$(prefix)
+	${srcdir}/configure $(prefix_arg) $(host-arg) $(build-arg) $(with-system-libc)
 endif
 
 PHONY_TARGETS:=\

build-aux/build-scaffold.sh

@@ -36,6 +36,8 @@ if $courageous; then
 fi
 
 case "$mes_cpu" in
+    arm)
+        stage0_cpu=armv7l;;
     x86_64)
         stage0_cpu=amd64;;
     x86)

configure

@@ -4,7 +4,7 @@ MES_ARENA=100000000 exec ${SCHEME-guile} -L . --no-auto-compile -e '(configure)'
 !#
 
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; configure: This file is part of GNU Mes.
 ;;;
@@ -370,8 +370,7 @@ Some influential environment variables:
 (define (main args)
   (let* ((options (parse-opts args))
          (build-type (option-ref options 'build %host-type))
-
+         (host-type (option-ref options 'host build-type))
-         (host-type (option-ref options 'host %host-type))(prefix "/usr/local")
 
          (prefix "/usr/local")
          (prefix (option-ref options 'prefix prefix))
@@ -497,8 +496,9 @@ Some influential environment variables:
            (build-type (or (and cc (gulp-pipe* cc "-dumpmachine")) build-type))
            (build-type-list (string-split build-type #\-))
            (mes-cpu (car build-type-list))
-           (mes-cpu (if (member mes-cpu '("i386" "i486" "i586" "i686")) "x86"
+           (mes-cpu (cond ((member mes-cpu '("i386" "i486" "i586" "i686")) "x86")
-                        mes-cpu))
+                          ((member mes-cpu '("arm" "armv4" "armv7l")) "arm")
+                          (else mes-cpu)))
            (mes-bits (if (member mes-cpu '("x86_64")) "64"
                          "32"))
            (mes-libc (if system-libc? "system" "mes"))
@@ -525,8 +525,12 @@ Some influential environment variables:
                                  line pairs))
                   (loop (read-line in 'concat))))))))
 
-      (when (and (not (member mes-system '("x86-linux-mes" "x86_64-linux-mes"))) (not with-courage?))
+      (when (and (not (member mes-system '("arm-linux-mes"
-        (stderr "platform not supported: ~a, try --with-courage\n" mes-system)
+                                           "x86-linux-mes"
+                                           "x86_64-linux-mes")))
+                 (not with-courage?))
+        (stderr "platform not supported: ~a
+See \"Porting GNU Mes\" in the manual, or try --with-courage\n" mes-system)
         (exit 1))
       (when (pair? missing)
         (stderr "\nMissing dependencies: ~a\n" (string-join (map dependency-name missing)))

configure.sh

@@ -54,6 +54,29 @@ else
     prefix=${prefix-/usr/local}
 fi
 
+# parse --build=BUILD
+p=${cmdline/ --build=/ -build=}
+if [ "$p" != "$cmdline" ]; then
+    p=${p##* -build=}
+    p=${p% *}
+    p=${p% -*}
+    build=${p-$build}
+else
+    build=$build
+fi
+
+# parse --host=HOST
+p=${cmdline/ --host=/ -host=}
+if [ "$p" != "$cmdline" ]; then
+    p=${p##* -host=}
+    p=${p% *}
+    p=${p% -*}
+    host=${p-$build}
+
+else
+    host=${host-$build}
+fi
+
 # parse --program-prefix=
 p=${cmdline/ --program-prefix=/ -program-prefix=}
 if test "$p" != "$cmdline"; then
@@ -180,6 +203,10 @@ if test "$mes_cpu" = i386\
         || test "$mes_cpu" = i686; then
     mes_cpu=x86
 fi
+if test "$mes_cpu" = armv4\
+        || test "$arch" = armv7l; then
+    mes_cpu=arm
+fi
 
 case "$host" in
     *linux-gnu|*linux)

module/mes/guile.scm

@@ -32,6 +32,8 @@
             <cell:symbol>
             <cell:vector>
 
+            %arch
+            %compiler
             append2
             core:apply
             core:car
@@ -54,6 +56,12 @@
   ;;#:re-export (open-input-file open-input-string with-input-from-string)
   )
 
+(cond-expand
+ (guile-2)
+ (guile
+  (define %host-type (string-append (utsname:machine (uname)) "linux-gnu")))
+ (else))
+
 (cond-expand
  (guile
   (define pmatch-car car)
@@ -84,6 +92,8 @@
   (define <cell:string> 10)
   (define <cell:symbol> 11)
   (define <cell:vector> 15)
+  (define %arch (car (string-split %host-type #\-)))
+  (define %compiler "gnuc")
 
   (define %compiler "gnuc")
   (define keyword->string (compose symbol->string keyword->symbol))

module/mescc.scm

@@ -1,5 +1,5 @@
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -19,6 +19,7 @@
 (define-module (mescc)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 getopt-long)
+  #:use-module (mes guile)
   #:use-module (mes misc)
   #:use-module (mescc mescc)
   #:export (mescc:main))
@@ -35,6 +36,7 @@
  (guile
   (define-macro (mes-use-module . rest) #t)))
 
+(define %host-arch (or (getenv "%arch") %arch))
 (define %prefix (getenv "%prefix"))
 (define %version (getenv "%version"))
 
@@ -53,6 +55,7 @@
 (define (parse-opts args)
   (let* ((option-spec
           '((align)
+            (arch (value #t))
             (assemble (single-char #\c))
             (base-address (value #t))
             (compile (single-char #\S))
@@ -79,20 +82,17 @@
             (language (single-char #\x) (value #t))))
          (options (getopt-long args option-spec))
          (help? (option-ref options 'help #f))
-         (machine (option-ref options 'machine "32"))
          (files (option-ref options '() '()))
-         (usage? (and (not help?) (null? files)))
+         (dumpmachine? (option-ref options 'dumpmachine #f))
-         (version? (option-ref options 'version #f)))
+         (version? (option-ref options 'version #f))
-    (cond ((option-ref options 'dumpmachine #f)
+         (usage? (and (not dumpmachine?) (not help?) (not version?) (null? files))))
-           (cond ((equal? machine "32") (display "x86-linux-mes\n"))
+    (cond (version? (format #t "mescc (GNU Mes) ~a\n" %version) (exit 0))
-                 (else (display "x86_64-linux-mes\n")))
-           (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
+  --arch=ARCH         compile for ARCH [~a]
   -dumpmachine        display the compiler's target machine
   --base-address=ADRRESS
                       use BaseAddress ADDRESS [0x1000000]
@@ -128,7 +128,7 @@ Environment variables:
 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/>
-")
+" %host-arch)
                 (exit (or (and usage? 2) 0)))
            options))))
 
@@ -147,6 +147,9 @@ General help using GNU software: <http://gnu.org/gethelp/>
          (args (append-map unclump-single args))
          (options (parse-opts args))
          (options (acons 'prefix %prefix options))
+         (arch (option-ref options 'arch %host-arch))
+         (options (if arch (acons 'arch arch options) options))
+         (dumpmachine? (option-ref options 'dumpmachine #f))
          (preprocess? (option-ref options 'preprocess #f))
          (compile? (option-ref options 'compile #f))
          (assemble? (option-ref options 'assemble #f))
@@ -154,7 +157,8 @@ General help using GNU software: <http://gnu.org/gethelp/>
     (when verbose?
       (setenv "NYACC_TRACE" "yes")
       (format (current-error-port) "options=~s\n" options))
-    (cond (preprocess? (mescc:preprocess options))
+    (cond (dumpmachine? (display (mescc:get-host options)))
+          (preprocess? (mescc:preprocess options))
           (compile? (mescc:compile options))
           (assemble? (mescc:assemble options))
           (else (mescc:link options)))))

module/mescc/mescc.scm

@@ -1,5 +1,5 @@
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -21,7 +21,6 @@
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 pretty-print)
   #:use-module (ice-9 getopt-long)
-  #:use-module (mes guile)
   #:use-module (mes misc)
 
   #:use-module (mescc i386 info)
@@ -30,6 +29,7 @@
   #:use-module (mescc compile)
   #:use-module (mescc M1)
   #:export (mescc:preprocess
+            mescc:get-host
             mescc:compile
             mescc:assemble
             mescc:link))
@@ -54,7 +54,7 @@
          (prefix (option-ref options 'prefix ""))
          (machine (option-ref options 'machine "32"))
          (arch (if (equal? machine "32") "__i386__=1" "__x86_64__=1"))
-         (defines (cons arch defines)))
+         (defines (cons (arch-get-define options) defines)))
     (with-output-to-file ast-file-name
       (lambda _ (for-each (cut c->ast prefix defines includes write <>) files)))))
 
@@ -87,18 +87,13 @@
          (dir (dirname file-name))
          (includes (cons dir includes))
          (prefix (option-ref options 'prefix ""))
-         (machine (option-ref options 'machine "32"))
+         (defines (cons (arch-get-define options) defines)))
-         (info (if (equal? machine "32") (x86-info)  (x86_64-info)))
-         (arch (if (equal? machine "32") "__i386__=1" "__x86_64__=1"))
-         (defines (cons arch defines)))
     (with-input-from-file file-name
-      (cut c99-input->info info #:prefix prefix #:defines defines #:includes includes))))
+      (cut c99-input->info (arch-get-info options) #:prefix prefix #:defines defines #:includes includes))))
 
 (define (E->info options file-name)
-  (let* ((ast (with-input-from-file file-name read))
+  (let ((ast (with-input-from-file file-name read)))
-         (machine (option-ref options 'machine "32"))
+    (c99-ast->info (arch-get-info options) ast)))
-         (info (if (equal? machine "32") (x86-info)  (x86_64-info))))
-    (c99-ast->info info ast)))
 
 (define (mescc:assemble options)
   (let* ((files (option-ref options '() '("a.c")))
@@ -173,21 +168,12 @@
                                ((option-ref options 'assemble #f)
                                 (replace-suffix input-file-name ".o"))
                                (else (replace-suffix M1-file-name ".o"))))
-         (machine (option-ref options 'machine "32"))
-         (architecture (cond
-                        ((equal? machine "32") "x86")
-                        ((equal? machine "64") "amd64")
-                        (else "1")))
-         (m1-macros (cond
-                     ((equal? machine "32") "x86.M1")
-                     ((equal? machine "64") "x86_64.M1")
-                     (else "x86.M1")))
          (verbose? (option-ref options 'verbose #f))
          (M1 (or (getenv "M1") "M1"))
          (command `(,M1
                     "--LittleEndian"
-                    "--architecture" ,architecture
+                    "--architecture" ,(arch-get-architecture options)
-                    "-f" ,(arch-find options m1-macros)
+                    "-f" ,(arch-find options (arch-get-m1-macros options))
                     ,@(append-map (cut list "-f" <>) M1-files)
                     "-o" ,hex2-file-name)))
     (when verbose?
@@ -201,12 +187,8 @@
                               (else "a.out")))
          (verbose? (option-ref options 'verbose #f))
          (hex2 (or (getenv "HEX2") "hex2"))
-         (machine (option-ref options 'machine "32"))
-         (architecture (cond
-                         ((equal? machine "32") "x86")
-                         ((equal? machine "64") "amd64")
-                         (else "1")))
          (base-address (option-ref options 'base-address "0x1000000"))
+         (machine (arch-get-machine options))
          (elf-footer (or elf-footer
                          (arch-find options (string-append
                                              "elf" machine "-footer-single-main.hex2"))))
@@ -215,7 +197,7 @@
                               `("-f" ,(arch-find options "crt1.o"))))
          (command `(,hex2
                     "--LittleEndian"
-                    "--architecture" ,architecture
+                    "--architecture" ,(arch-get-architecture options)
                     "--BaseAddress" ,base-address
                     "-f" ,(arch-find options (string-append "elf" machine "-header.hex2"))
                     ,@start-files
@@ -235,13 +217,8 @@
          (blood-elf-footer (string-append hex2-file-name ".blood-elf"))
          (verbose? (option-ref options 'verbose #f))
          (blood-elf (or (getenv "BLOOD_ELF") "blood-elf"))
-         (machine (option-ref options 'machine "32"))
-         (m1-macros (cond
-                     ((equal? machine "32") "x86.M1")
-                     ((equal? machine "64") "x86_64.M1")
-                     (else "x86.M1")))
          (command `(,blood-elf
-                      "-f" ,(arch-find options m1-macros)
+                      "-f" ,(arch-find options (arch-get-m1-macros options))
                       ,@(append-map (cut list "-f" <>) M1-files)
                       "-o" ,M1-blood-elf-footer)))
     (when verbose?
@@ -255,7 +232,8 @@
   (let* ((parts (string-split file-name #\.))
          (base (if (pair? (cdr parts)) (drop-right parts 1)))
          (old-suffix (last parts))
-         (program-prefix (cond ((string-prefix? "x86-mes-" old-suffix) ".x86-mes-")
+         (program-prefix (cond ((string-prefix? "arm-mes-" old-suffix) ".arm-mes-")
+                               ((string-prefix? "x86-mes-" old-suffix) ".x86-mes-")
                                ((string-prefix? "x86_64-mes-" old-suffix) ".x86_64-mes-")
                                (else "."))))
     (if (string-null? suffix)
@@ -269,11 +247,7 @@
 (define* (arch-find options file-name)
   (let* ((srcdest (or (getenv "srcdest") ""))
          (srcdir-lib (string-append srcdest "lib"))
-         (machine (option-ref options 'machine "32"))
+         (arch (string-append (arch-get options) "-mes"))
-         (arch (cond
-                ((equal? machine "32") "x86-mes")
-                ((equal? machine "64") "x86_64-mes")
-                (else "x86-mes")))
          (path (cons* "."
                       srcdir-lib
                       (prefix-file options "lib")
@@ -301,22 +275,69 @@
       (exit (status:exit-val status)))
     status))
 
+(define (arch-get options)
+  (let* ((machine (option-ref options 'machine #f))
+         (arch (option-ref options 'arch #f)))
+    (if machine (cond ((member arch '("x86" "x86_64")) (cond ((equal? machine "32") "x86")
+                                                             ((equal? machine "64") "x86_64")))
+                      ((equal? arch "arm") (cond ((equal? machine "32") "arm"))))
+        arch)))
+
+(define (mescc:get-host options)
+  (let ((cpu (arch-get options))
+        (kernel "linux"))
+    (string-join (list cpu kernel "mes") "-")))
+
+(define (arch-get-info options)
+  (let ((arch (arch-get options)))
+    (cond ((equal? arch "arm") (armv4-info))
+          ((equal? arch "x86") (x86-info))
+          ((equal? arch "x86_64") (x86_64-info)))))
+
+(define (arch-get-define options)
+  (let ((arch (arch-get options)))
+    (cond ((equal? arch "arm") "__arm__=1")
+          ((equal? arch "x86") "__i386__=1")
+          ((equal? arch "x86_64") "__x86_64__=1"))))
+
+(define (arch-get-machine options)
+  (let* ((machine (option-ref options 'machine #f))
+         (arch (option-ref options 'arch #f)))
+    (or machine
+        (if (member arch '("x86_64")) "64"
+            "32"))))
+
+(define (arch-get-m1-macros options)
+  (let ((arch (arch-get options)))
+    (cond ((equal? arch "arm") "arm.M1")
+          ((equal? arch "x86") "x86.M1")
+          ((equal? arch "x86_64") "x86_64.M1"))))
+
+(define (arch-get-architecture options)
+  (let ((arch (arch-get options)))
+    (cond ((equal? arch "arm") "armv7l")
+          ((equal? arch "x86") "x86")
+          ((equal? arch "x86_64") "amd64"))))
+
 (define (multi-opt option-name) (lambda (o) (and (eq? (car o) option-name) (cdr o))))
 
 (define (.c? o) (or (string-suffix? ".c" o)
                     (string-suffix? ".M2" o)))
 (define (.E? o) (or (string-suffix? ".E" o)
                     (string-suffix? ".mes-E" o)
+                    (string-suffix? ".arm-mes-E" o)
                     (string-suffix? ".x86-mes-E" o)
                     (string-suffix? ".x86_64-mes-E" o)))
 (define (.S? o) (or (string-suffix? ".S" o)
                     (string-suffix? ".mes-S" o)
+                    (string-suffix? ".arm-mes-S" o)
                     (string-suffix? ".x86-mes-S" o)
                     (string-suffix? ".x86_64-mes-S" o)
                     (string-suffix? "S" o)
                     (string-suffix? ".M1" o)))
 (define (.o? o) (or (string-suffix? ".o" o)
                     (string-suffix? ".mes-o" o)
+                    (string-suffix? ".arm-mes-o" o)
                     (string-suffix? ".x86-mes-o" o)
                     (string-suffix? ".x86_64-mes-o" o)
                     (string-suffix? ".hex2" o)))

scripts/mescc.scm.in

@@ -19,6 +19,11 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
+(cond-expand
+ (mes)
+ (guile
+  (define %arch (car (string-split %host-type #\-)))))
+
 (setenv "%prefix" (or (getenv "MES_PREFIX")
                       (if (string-prefix? "@prefix" "@prefix@")
                           ""
@@ -27,6 +32,9 @@
 (setenv "%version" (if (string-prefix? "@VERSION" "@VERSION@") "git"
                        "@VERSION@"))
 
+(setenv "%arch" (if (string-prefix? "@mes_cpu" "@mes_cpu@") %arch
+                       "@mes_cpu@"))
+
 (cond-expand
  (mes
   (mes-use-module (mescc))

src/mes.c

@@ -1419,9 +1419,15 @@ mes_environment (int argc, char *argv[])
 #endif
   a = acons (cell_symbol_compiler, MAKE_STRING0 (compiler), a);
 
-  char *arch = "x86";
+  char *arch;
-#if __x86_64__
+#if __i386__
+  arch = "x86";
+#elif __arm__
+  arch = "arm";
+#elif __x86_64__
   arch = "x86_64";
+#else
+#error arch not supported
 #endif
   a = acons (cell_symbol_arch, MAKE_STRING0 (arch), a);