[bug#57050] [PATCH 5/6] gnu: racket: Use Racket CS on all systems.

[Philip McGrath <philip@philipmcgrath.com>]

On systems for which Racket CS cannot generate native code, it can use a
'pbarch' machine type---a variant of the ``portable bytecode'' backend
specialized to word size and endianness---allowing Racket CS to replace
Racket BC on those systems while maintaining comparable performance.
(Racket BC lacks JIT support for those systems anyway.)

This patch adds 'pbarch' support to 'racket-vm-cs' and
'chez-scheme-for-racket-bootstrap-bootfiles' and changes 'racket' and
'racket-minimal' to use 'racket-vm-cs' on all systems.

In the process, it also adds support for cross-compiling the bootfiles,
'racket-vm-cgc', 'racket-vm-bc', and 'racket-vm-cs'. This is not enough
to cross-compile 'racket-minimal' or 'racket': that would require
building and loading cross-compilation pluggins for 'racket-vm-cs',
which will be much easier once we can build the package 'raco-cross'.

This patch does not address 'chez-scheme-for-racket'.

* gnu/packages/chez.scm (nix-system->pbarch-machine-type): New variable.
(racket-cs-native-supported-system): Change to return the applicable
machine type instead of '#t'.
(chez-scheme-for-racket-bootstrap-bootfiles)[native-inputs]: When
cross-compiling, use 'zuo' and 'chez-scheme-for-racket' instead of
'racket-vm-bc'.
[arguments]: Support cross-compilation and 'pbarch' machine types.
[supported-systems]: Use '%supported-systems' instead of inheriting.
* gnu/packages/racket.scm (racket-vm-for-system): Remove.
(racket-vm-cgc)[native-inputs]: Add 'this-package' when cross-compiling.
(racket-vm-bc)[native-inputs]: Adjust accordingly.
[description]: Update.
(racket-vm-cs)[description]: Likewise.
[inputs]: Use 'libffi' for 'pbarch' machine types.
[native-inputs]: Use 'racket-vm-cs' instead of 'racket-vm-bc' when
cross-compiling. Adapt to changes to 'racket-vm-cgc'.
[arguments]<#:configure-flags>: Support cross-compilation and 'pbarch'
machine types.
(racket-minimal, racket)[inputs]: Replace '(racket-vm-for-system)' with
'racket-vm-cs'.
---
 gnu/packages/chez.scm   | 65 ++++++++++++++++++++++++++++------
 gnu/packages/racket.scm | 77 ++++++++++++++++++++++-------------------
 2 files changed, 97 insertions(+), 45 deletions(-)

diff --git a/gnu/packages/chez.scm b/gnu/packages/chez.scm
index dde2c22ca5..2afef8d3bd 100644
--- a/gnu/packages/chez.scm
+++ b/gnu/packages/chez.scm
@@ -50,6 +50,7 @@ (define-module (gnu packages chez)
   #:use-module (srfi srfi-26)
   #:export (chez-scheme-for-system
             racket-cs-native-supported-system?
+            nix-system->pbarch-machine-type
             unpack-nanopass+stex))
 
 ;; Commentary:
@@ -232,18 +233,41 @@ (define* (chez-upstream-features-for-system #:optional
     (and=> (assoc-ref %chez-features-table chez-os)
            (cut assoc-ref <> chez-arch))))
 
+(define* (nix-system->pbarch-machine-type #:optional
+                                          (system
+                                           (or (%current-target-system)
+                                               (%current-system)))
+                                          #:key (threads? #t))
+  "Return a string naming the pseudo–machine type used by Racket's variant of
+Chez Scheme to represent the appropriate ``pbarch'' backend for SYSTEM: that
+is, the ``portable bytecode'' backend specialized for SYSTEM's word size and
+endianness.  The result will name the threaded machine type unless THREADS? is
+provided and is #f."
+  (string-append (if threads?
+                     "t"
+                     "")
+                 "pb"
+                 (if (target-64bit? system)
+                     "64"
+                     "32")
+                 ;; missing (guix utils) predicate target-little-endian?
+                 (if (target-ppc32? system)
+                     "b"
+                     "l")))
+
 (define* (racket-cs-native-supported-system? #:optional
                                              (system
                                               (or (%current-target-system)
                                                   (%current-system))))
-  "Can Racket's variant of Chez Scheme generate native code for SYSTEM?
-Otherwise, SYSTEM can use only the ``portable bytecode'' backends."
+  "Can Racket's variant of Chez Scheme generate native code for SYSTEM?  If
+so, return the applicable machine type as a string.  Otherwise, when SYSTEM
+can use only the ``portable bytecode'' backends, return #f."
   (let ((chez-arch (target-chez-arch system))
         (chez-os (target-chez-os system)))
     (and (and=> (assoc-ref %chez-features-table chez-os)
                 ;; NOT assoc-ref: supported even if cdr is #f
                 (cut assoc chez-arch <>))
-         #t)))
+         (string-append "t" chez-arch chez-os))))
 
 ;;
 ;; Chez Scheme:
@@ -587,8 +611,12 @@ (define-public chez-scheme-for-racket-bootstrap-bootfiles
     (name "chez-scheme-for-racket-bootstrap-bootfiles")
     (version (package-version chez-scheme-for-racket))
     (source #f) ; avoid problematic cycle with racket.scm
-    (native-inputs (list chez-nanopass-bootstrap racket-vm-bc))
-    ;; TODO: cross compilation
+    (native-inputs
+     (cons* chez-nanopass-bootstrap
+            (if (%current-target-system)
+                (list zuo
+                      chez-scheme-for-racket)
+                (list racket-vm-bc))))
     (arguments
      (substitute-keyword-arguments
          (package-arguments chez-scheme-bootstrap-bootfiles)
@@ -608,11 +636,28 @@ (define-public chez-scheme-for-racket-bootstrap-bootfiles
                   #$unpack-nanopass+stex))
               (add-before 'install 'build
                 (lambda* (#:key native-inputs inputs #:allow-other-keys)
-                  (invoke (search-input-file (or native-inputs inputs)
-                                             "/opt/racket-vm/bin/racket")
-                          "rktboot/main.rkt"))))))))
-    (supported-systems
-     (package-supported-systems chez-scheme-for-racket))
+                  #$(cond
+                     ((%current-target-system)
+                      ;; cross-compiling
+                      #~(invoke
+                         (search-input-file (or native-inputs inputs)
+                                            "/bin/zuo")
+                         "makefiles/boot.zuo"
+                         (search-input-file (or native-inputs inputs)
+                                            "/bin/scheme")
+                         #$(or (racket-cs-native-supported-system?)
+                               (nix-system->pbarch-machine-type))))
+                     (else
+                      ;; bootstrapping
+                      #~(invoke
+                         (search-input-file (or native-inputs inputs)
+                                            "/opt/racket-vm/bin/racket")
+                         "rktboot/main.rkt"
+                         #$@(if (racket-cs-native-supported-system?)
+                                #~()
+                                (let ((m (nix-system->pbarch-machine-type)))
+                                  #~("--machine" #$m)))))))))))))
+    (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
diff --git a/gnu/packages/racket.scm b/gnu/packages/racket.scm
index f1a2794164..7920d6812c 100644
--- a/gnu/packages/racket.scm
+++ b/gnu/packages/racket.scm
@@ -129,10 +129,9 @@ (define-module (gnu packages racket)
 ;; This file defines the packages 'racket-vm-cgc', 'racket-vm-bc', and
 ;; 'racket-vm-cs'. All three are in-place builds of 'racket/src/' and
 ;; 'racket/collects/' and are installed to 'opt/racket-vm/' in the store
-;; output. The function 'racket-vm-for-system' returns the recomended Racket
-;; VM package for a given system.
+;; output.
 ;;
-;; We then define the packages 'racket-minimal' and
+;; Using 'racket-vm-cs', we then define the packages 'racket-minimal' and
 ;; 'racket'. These use Racket's support for ``layered installations'', which
 ;; allow an immutable base layer to be extended with additional packages.
 ;; They use the layer configuration directly provide ready-to-install FHS-like
@@ -193,17 +192,6 @@ (define-module (gnu packages racket)
 ;;
 ;; CODE:
 
-(define* (racket-vm-for-system #:optional
-                               (system (or (%current-target-system)
-                                           (%current-system))))
-  "Return 'racket-vm-cs' if we are able to build it for SYSTEM; 'racket-vm-bc'
-otherwise."
-  ;; Once we figure out the issues in https://racket.discourse.group/t/950,
-  ;; we can use 'racket-vm-cs' everywhere.
-  (if (racket-cs-native-supported-system? system)
-      racket-vm-cs
-      racket-vm-bc))
-
 (define %racket-version "8.6") ; Remember to update chez-scheme-for-racket!
 (define %zuo-version "1.0") ;; defined in racket/src/zuo/zuo.c
 (define %racket-commit
@@ -331,9 +319,12 @@ (define-public racket-vm-cgc
      (source %racket-origin)
      (inputs (list ncurses ;; <- common to all variants (for #%terminal)
                    bash-minimal ;; <- common to all variants (for `system`)
-                   libffi)) ;; <- only for BC variants
-     (native-inputs (list zuo ;; <- for all variants
-                          libtool)) ;; <- only for BC variants
+                   libffi)) ;; <- for BC and non-native CS variants
+     (native-inputs (cons* zuo ;; <- for all variants
+                           libtool ;; <- only for BC variants
+                           (if (%current-target-system)
+                               (list this-package)
+                               '())))
      (outputs '("out" "debug"))
      (build-system gnu-build-system)
      (arguments
@@ -421,8 +412,10 @@ (define-public racket-vm-bc
     (inherit racket-vm-cgc)
     (name "racket-vm-bc")
     (native-inputs
-     (modify-inputs (package-native-inputs racket-vm-cgc)
-       (prepend racket-vm-cgc)))
+     (if (%current-target-system)
+         (package-native-inputs racket-vm-cgc)
+         (modify-inputs (package-native-inputs racket-vm-cgc)
+           (prepend racket-vm-cgc))))
     (arguments
      (substitute-keyword-arguments (package-arguments racket-vm-cgc)
        ((#:configure-flags _ '())
@@ -432,10 +425,8 @@ (define-public racket-vm-bc
     (description "The Racket BC (``before Chez'' or ``bytecode'')
 implementation was the default before Racket 8.0.  It uses a compiler written
 in C targeting architecture-independent bytecode, plus a JIT compiler on most
-platforms.  Racket BC has a different C API and supports a slightly different
-set of architectures than the current default runtime system, Racket CS (based
-on ``Chez Scheme'').  It is the recommended implementation for architectures
-that Racket CS doesn't support.
+platforms.  Racket BC has a different C API than the current default runtime
+system, Racket CS (based on ``Chez Scheme'').
 
 This package is the normal implementation of Racket BC with a precise garbage
 collector, 3M (``Moving Memory Manager'').")
@@ -448,15 +439,24 @@ (define-public racket-vm-cs
     (inherit racket-vm-bc)
     (name "racket-vm-cs")
     (inputs
-     (modify-inputs (package-inputs racket-vm-cgc)
-       (prepend zlib lz4)
-       (delete "libffi")))
+     (let ((inputs (modify-inputs (package-inputs racket-vm-cgc)
+                     (prepend zlib lz4))))
+       (if (racket-cs-native-supported-system?)
+           (modify-inputs inputs
+             (delete "libffi"))
+           inputs)))
     (native-inputs
-     (modify-inputs (package-native-inputs racket-vm-cgc)
-       (delete "libtool")
-       (prepend chez-scheme-for-racket
-                chez-nanopass-bootstrap
-                racket-vm-bc)))
+     (let ((native-inputs (package-native-inputs racket-vm-cgc)))
+       (modify-inputs (if (%current-target-system)
+                          (modify-inputs native-inputs
+                            (delete "racket-vm-cgc"))
+                          native-inputs)
+         (delete "libtool")
+         (prepend chez-scheme-for-racket
+                  chez-nanopass-bootstrap
+                  (if (%current-target-system)
+                      racket-vm-cs
+                      racket-vm-bc)))))
     (arguments
      (substitute-keyword-arguments (package-arguments racket-vm-cgc)
        ((#:phases those-phases #~%standard-phases)
@@ -470,15 +470,22 @@ (define-public racket-vm-cs
                  "--enable-libz"
                  "--enable-lz4"
                  (string-append "--enable-scheme="
-                                #$(this-package-native-input
+                                #+(this-package-native-input
                                    "chez-scheme-for-racket")
                                 "/bin/scheme")
+                 #$@(if (racket-cs-native-supported-system?)
+                        #~()
+                        #~(#$(string-append "--enable-mach="
+                                            (nix-system->pbarch-machine-type))
+                           "--enable-pb"))
                  #$(racket-vm-common-configure-flags)))))
     (synopsis "Racket CS implementation")
     (description "The Racket CS implementation, which uses ``Chez Scheme'' as
 its core compiler and runtime system, has been the default Racket VM
 implementation since Racket 8.0.  It performs better than the Racket BC
-implementation for most programs.
+implementation for most programs.  On systems for which Racket CS cannot
+generate machine code, this package uses a variant of its ``portable
+bytecode'' backend specialized for word size and endianness.
 
 Using the Racket VM packages directly is not recommended: instead, install the
 @code{racket-minimal} or @code{racket} packages.")
@@ -554,7 +561,7 @@ (define-public racket-minimal
     (inputs
      (list openssl
            sqlite
-           (racket-vm-for-system)
+           racket-vm-cs
            (racket-packages-origin
             "base" %racket-origin
             '(("base" "pkgs/base")
@@ -672,7 +679,7 @@ (define-public racket
       unixodbc
       libedit ;; TODO reconsider in light of expeditor and readline-gpl
       racket-minimal ;; <-- TODO non-tethered layer
-      (racket-vm-for-system)
+      racket-vm-cs
       (simple-racket-origin
        "2d" (base32 "0fb5v6058ls08xw3zbmqyr2ym0psm119gl9ffgmhm9w8rs9i4dq7")
        '("2d" "2d-doc" "2d-lib"))
-- 
2.32.0