Subject: [bug#57050] [PATCH 6/6] gnu: chez-scheme-for-racket: Suport all systems.

From: Philip McGrath <[email-masked]>
Date: Mon, 8 Aug 2022 02:10:07 -0400

On systems for which 'chez-scheme-for-racket' cannot generate native
code, use the applicable 'pbarch' machine type as with 'racket-vm-cs'.

In the process, this commit adds support for cross-compiling
'chez-scheme-for-racket', though not support for compiling it as a
cross-compiler to use in cross-compiling other Scheme programs.

* gnu/packages/chez.scm (chez-scheme)[native-inputs]: Move
'chez-scheme-bootstrap-bootfiles' to ...
[inputs]: ... this field.
[arguments]<#:phases>: Update 'unpack-bootfiles' accordingly.
(chez-scheme-for-racket)[native-inputs]: Add 'this-package' when
cross-compiling. Move 'chez-scheme-for-racket-bootstrap-bootfiles' to ...
[inputs]: ... this field. Add 'libffi' for 'pbarch' machine types.
[arguments]: Support cross-compilation and 'pbarch' machine types.
[supported-systems]: Use '%supported-systems'.
[description]: Update.
---
 gnu/packages/chez.scm | 93 ++++++++++++++++++++++++++++++++-----------
 1 file changed, 70 insertions(+), 23 deletions(-)

diff --git a/gnu/packages/chez.scm b/gnu/packages/chez.scm
index 2afef8d3bd..0ab82ef8bf 100644
--- a/gnu/packages/chez.scm
+++ b/gnu/packages/chez.scm
@@ -38,6 +38,7 @@ (define-module (gnu packages chez)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages ghostscript)
+  #:use-module (gnu packages libffi)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages netpbm)
   #:use-module (gnu packages racket)
@@ -318,6 +319,7 @@ (define-public chez-scheme
     (build-system gnu-build-system)
     (inputs
      (list
+      chez-scheme-bootstrap-bootfiles
       `(,util-linux "lib") ;<-- libuuid
       zlib
       lz4
@@ -326,8 +328,7 @@ (define-public chez-scheme
       ;; for X11 clipboard support in expeditor:
       ;; https://github.com/cisco/ChezScheme/issues/9#issuecomment-222057232
       libx11))
-    (native-inputs (list chez-scheme-bootstrap-bootfiles
-                         chez-nanopass-bootstrap
+    (native-inputs (list chez-nanopass-bootstrap
                          stex-bootstrap))
     (native-search-paths
      (list (search-path-specification
@@ -366,7 +367,7 @@ (define-public chez-scheme
               (when (directory-exists? "boot")
                 (delete-file-recursively "boot"))
               (copy-recursively
-               (search-input-directory (or native-inputs inputs)
+               (search-input-directory inputs
                                        "lib/chez-scheme-bootfiles")
                "boot")))
           ;; NOTE: The custom Chez 'configure' script doesn't allow
@@ -476,13 +477,21 @@ (define-public chez-scheme-for-racket
     ;; When updating, remember to also update %racket-version in racket.scm.
     (source #f) ; avoid problematic cycle with racket.scm
     (inputs
-     (modify-inputs (package-inputs chez-scheme)
-       (delete "libx11" "util-linux:lib")))
+     (let ((inputs (modify-inputs (package-inputs chez-scheme)
+                     (replace "chez-scheme-bootstrap-bootfiles"
+                       chez-scheme-for-racket-bootstrap-bootfiles)
+                     (delete "libx11" "util-linux:lib"))))
+       (if (racket-cs-native-supported-system?)
+           inputs
+           (modify-inputs inputs
+             (append libffi)))))
     (native-inputs
-     (modify-inputs (package-native-inputs chez-scheme)
-       (append zuo)
-       (replace "chez-scheme-bootstrap-bootfiles"
-         chez-scheme-for-racket-bootstrap-bootfiles)))
+     (let ((native-inputs (modify-inputs (package-native-inputs chez-scheme)
+                            (append zuo))))
+       (if (%current-target-system)
+           (modify-inputs native-inputs
+             (append this-package))
+           native-inputs)))
     (arguments
      (substitute-keyword-arguments (package-arguments chez-scheme)
        ((#:out-of-source? _ #f)
@@ -496,6 +505,21 @@ (define-public chez-scheme-for-racket
        ((#:configure-flags cfg-flags #~'())
         #~`("--disable-x11"
             "--threads" ;; ok to potentially duplicate
+            #$(string-append "-m=" (or (racket-cs-native-supported-system?)
+                                       (nix-system->pbarch-machine-type)))
+            ;; ^ could skip -m= for non-cross non-pbarch builds
+            #$@(if (racket-cs-native-supported-system?)
+                   #~()
+                   ;; not inferred on non-native platforms: see
+                   ;; https://racket.discourse.group/t/950/9
+                   #~("--enable-libffi"
+                      "CFLAGS=-g -O2 -D_REENTRANT -pthread"
+                      "LIBS=-lm -ldl -lrt -lffi -lncurses"))
+            #$@(if (%current-target-system)
+                   (list (string-append "--toolprefix="
+                                        (%current-target-system)
+                                        "-"))
+                   '())
             ,@(let* ((chez+version (strip-store-file-name #$output))
                      (doc-prefix (assoc-ref %outputs "doc"))
                      (doc-dir (string-append doc-prefix
@@ -518,25 +542,46 @@ (define-public chez-scheme-for-racket
                  #$mk-flags))
        ((#:phases those-phases #~%standard-phases)
         #~(let* ((those-phases #$those-phases)
-                 (unpack (assoc-ref those-phases 'unpack)))
+                 (gnu:unpack (assoc-ref those-phases 'unpack))
+                 (gnu:build (assoc-ref those-phases 'build)))
             (modify-phases those-phases
+              (replace 'build
+                ;; need to override target for cross-compilation
+                ;; https://racket.discourse.group/t/950/19
+                (lambda* (#:key target (make-flags '()) (parallel-build? #t)
+                          #:allow-other-keys)
+                  (gnu:build #:make-flags (if target
+                                              (cons "kernel" make-flags)
+                                              make-flags)
+                             #:parallel-build? parallel-build?)))
               (replace 'install-docs
-                (lambda* (#:key make-flags #:allow-other-keys)
+                (lambda* (#:key native-inputs (make-flags '())
+                          #:allow-other-keys)
+                  ;; The tests for 'native-inputs' are cross-compilation
+                  ;; workarounds that would be better to address upstream:
+                  ;; see <https://racket.discourse.group/t/950/20>.
+                  (when native-inputs
+                    (substitute* "Makefile"
+                      (("install-docs: build \\$[(]ZUO[)]")
+                       "install-docs: $(ZUO)")))
                   (apply invoke
                          "make"
                          "install-docs"
-                         make-flags)))
+                         (if native-inputs
+                             (cons (string-append
+                                    "Scheme="
+                                    (search-input-file native-inputs
+                                                       "/bin/scheme"))
+                                   make-flags)
+                             make-flags))))
               (replace 'unpack
                 (lambda args
-                  (unpack #:source #$(or (package-source this-package)
-                                         (package-source racket-vm-bc)))))
+                  (gnu:unpack #:source #$(or (package-source this-package)
+                                             (package-source racket-vm-bc)))))
               (add-after 'unpack 'chdir
                 (lambda args
                   (chdir "racket/src/ChezScheme"))))))))
-    ;; TODO: How to build pbarch/pbchunks for other systems?
-    ;; See https://racket.discourse.group/t/950
-    (supported-systems (filter racket-cs-native-supported-system?
-                               %supported-systems))
+    (supported-systems %supported-systems)
     (home-page "https://github.com/racket/ChezScheme")
     ;; ^ This is downstream of https://github.com/racket/racket,
     ;; but it's designed to be a friendly landing place for people
@@ -549,13 +594,17 @@ (define-public chez-scheme-for-racket
 Main additions to Chez Scheme in the Racket variant:
 @itemize @bullet
 @item
-AArch64 support
+AArch64 code generation
 @item
-Portable bytes (@code{pb}) support, which is mainly useful for bootstrapping
-a build on any supported platform
+Portable bytecode (@code{pb}) mode, which is mainly useful for bootstrapping a
+build on any platform, but can also be used on platforms without native-code
+generation, compiled via Emscripten, linked with @code{libffi}, or used with
+bytecode partially compiled to C
 @item
 Unboxed floating-point arithmetic and flvectors
 @item
+Faster multiplication and division for large exact numbers
+@item
 Type reconstruction during optimization (especially for safe code)
 @item
 Continuation attachments
@@ -566,8 +615,6 @@ (define-public chez-scheme-for-racket
 @item
 Ordered finalization, immobile (but collectable) objects, weak/ephemeron
 generic hash tables, and reference bytevectors
-@item
-Faster multiplication and division for large exact numbers
 @end itemize")
     (license asl2.0)))
 
-- 
2.32.0