jerbuild binary: --xpatch for Chez cross-codegen

ober

239a889487106b6cdf35bb2121e7f0213a35b8ec

diff --git a/jerbuild.ss b/jerbuild.ss
index cc2723e..38397bc 100644
--- a/jerbuild.ss
+++ b/jerbuild.ss
@@ -1736,6 +1736,7 @@ int main(int argc, const char *argv[]) {
   ;;                 [--main-c FILE]                       (single)
   ;;                 [--rust-target TRIPLE]                (single)
   ;;                 [--csv-dir PATH]                      (single)
+  ;;                 [--xpatch PATH]                       (single)
   ;;                 <entry.ss> <output>
   ;;
   ;; Builds a standalone executable that bundles Chez + the user's entry script
@@ -1749,39 +1750,44 @@ int main(int argc, const char *argv[]) {
             (let-values ([(rust-crates args) (parse-multi-flag args "--rust-crate")])
               (let-values ([(main-cs args) (parse-multi-flag args "--main-c")])
                 (let-values ([(rust-target args) (parse-single-flag args "--rust-target")])
-                  (let-values ([(csv-dir rest) (parse-single-flag args "--csv-dir")])
-                    (let ([main-c-override
-                           (cond
-                             [(null? main-cs) #f]
-                             [else (car (reverse main-cs))])]
-                          ;; Wrap each extra-source path as (path . #f) — no
-                          ;; per-source cflags supported on the CLI; use .jerbuild
-                          ;; for that.
-                          [extra-sources-pairs
-                           (map (lambda (s) (cons s #f)) extra-sources)])
-                      (do-binary-build libs cc-arg extra-archives
-                                       extra-sources-pairs
-                                       extra-ldflags rust-crates main-c-override
-                                       ;; CLI form: no ffi-symbols, pre-build, or
-                                       ;; pre-link — those are config-only.
-                                       #f '() '()
-                                       rust-target csv-dir
-                                       (current-directory)
-                                       rest))))))))))))
+                  (let-values ([(csv-dir args) (parse-single-flag args "--csv-dir")])
+                    (let-values ([(xpatch rest) (parse-single-flag args "--xpatch")])
+                      (let ([main-c-override
+                             (cond
+                               [(null? main-cs) #f]
+                               [else (car (reverse main-cs))])]
+                            ;; Wrap each extra-source path as (path . #f) — no
+                            ;; per-source cflags supported on the CLI; use .jerbuild
+                            ;; for that.
+                            [extra-sources-pairs
+                             (map (lambda (s) (cons s #f)) extra-sources)])
+                        (do-binary-build libs cc-arg extra-archives
+                                         extra-sources-pairs
+                                         extra-ldflags rust-crates main-c-override
+                                         ;; CLI form: no ffi-symbols, pre-build, or
+                                         ;; pre-link — those are config-only.
+                                         #f '() '()
+                                         rust-target csv-dir xpatch
+                                         (current-directory)
+                                         rest)))))))))))))
 
 (define (do-binary-build libs cc-arg extra-archives extra-sources
                          extra-ldflags rust-crates main-c-override
                          ffi-symbols pre-build pre-link
-                         rust-target csv-dir-override
+                         rust-target csv-dir-override xpatch
                          config-dir rest)
   ;; extra-sources is a list of pairs (abs-path . cflags-or-#f).
   ;; rust-target: triple passed to `cargo build --target=` or #f for host.
   ;; csv-dir-override: full path to a csv-dir (containing petite.boot,
   ;;   scheme.boot, libkernel.a, scheme.h). When set, replaces the default
   ;;   bundle path. Lets cross-builds point at a Chez built for the target.
+  ;; xpatch: optional path to a Chez compiler patch (.so/.ss) loaded before
+  ;;   WPO compile. Switches codegen to a non-host machine-type — typical
+  ;;   filename `<host>-to-<target>.xpatches`. Used together with csv-dir to
+  ;;   produce Scheme objects for a foreign target.
   (when (< (length rest) 2)
     (error 'jerbuild
-           "binary: usage: jerbuild binary [--libdirs P] [--cc CC] [--extra-archive A] [--extra-source S.c] [--extra-ldflag F] [--rust-crate Cargo.toml[:features]] [--rust-target T] [--csv-dir D] [--main-c F] <entry.ss> <output>"))
+           "binary: usage: jerbuild binary [--libdirs P] [--cc CC] [--extra-archive A] [--extra-source S.c] [--extra-ldflag F] [--rust-crate Cargo.toml[:features]] [--rust-target T] [--csv-dir D] [--xpatch P] [--main-c F] <entry.ss> <output>"))
   (let* ([entry      (car rest)]
          [output     (cadr rest)]
          [cc         (or cc-arg (or (getenv "CC") "cc"))]
@@ -1818,6 +1824,9 @@ int main(int argc, const char *argv[]) {
     (when ffi-symbols
       (unless (file-exists? ffi-symbols)
         (error 'jerbuild (format "binary: (ffi-symbols) file not found: ~a" ffi-symbols))))
+    (when xpatch
+      (unless (file-exists? xpatch)
+        (error 'jerbuild (format "binary: --xpatch not found: ~a" xpatch))))
     (unless (and (file-exists? libkernel) (file-exists? scheme-h)
                  (file-exists? petite-boot) (file-exists? scheme-boot))
       (error 'jerbuild
@@ -1854,6 +1863,8 @@ int main(int argc, const char *argv[]) {
               (if csv-dir-override " (override)" ""))
       (when rust-target
         (printf "    Rust target: ~a\n" rust-target))
+      (when xpatch
+        (printf "    xpatch: ~a\n" xpatch))
       (unless (null? rust-crates)
         (printf "    Rust crates:    ~a\n" (length rust-crates)))
       (unless (null? extra-archives)
@@ -1874,6 +1885,14 @@ int main(int argc, const char *argv[]) {
       ;; loaded" and skips compilation, so compile-whole-program needs their
       ;; .wpo files on disk. build-jerbuild.sh stages them next to the .sls
       ;; sources in the bundle.
+
+      ;; Load xpatch FIRST. Switches Chez codegen to a non-host machine-type
+      ;; for cross-builds. xpatch typically pushes its own paths onto
+      ;; library-directories — we override them next.
+      (when xpatch
+        (printf "==> [1/5] Load xpatch (target codegen): ~a\n" xpatch)
+        (load xpatch))
+
       (library-directories
         (append (map (lambda (l) (cons l obj-dir)) user-libs)
                 (list bundle-lib)))
@@ -2032,6 +2051,14 @@ int main(int argc, const char *argv[]) {
 ;;                                       ;   liblz4.a/libz.a) built for the
 ;;                                       ;   target machine. CLI --csv-dir
 ;;                                       ;   overrides.
+;;   (xpatch "vendor/chez/.../ta6osx-to-tarm64le.xpatches")  ; optional Chez
+;;                                       ;   compiler patch — loaded BEFORE
+;;                                       ;   compile-imported-libraries to
+;;                                       ;   switch codegen to a non-host
+;;                                       ;   machine-type. Required for true
+;;                                       ;   cross-builds; pair with csv-dir
+;;                                       ;   for the same target. CLI --xpatch
+;;                                       ;   overrides.
 ;;
 ;; All paths are resolved relative to the .jerbuild file's directory.
 
@@ -2110,7 +2137,7 @@ int main(int argc, const char *argv[]) {
          [libdirs '()] [rust-crates '()] [extra-sources '()]
          [extra-archives '()] [extra-ldflags '()]
          [pre-build '()] [pre-link '()]
-         [rust-target #f] [csv-dir #f])
+         [rust-target #f] [csv-dir #f] [xpatch #f])
     (for-each
       (lambda (form)
         (unless (and (pair? form) (symbol? (car form)))
@@ -2163,9 +2190,13 @@ int main(int argc, const char *argv[]) {
            (unless (= (length form) 2)
              (error 'jerbuild "config: (csv-dir PATH) takes one value"))
            (set! csv-dir (resolve-config-path (cadr form) base))]
+          [(xpatch)
+           (unless (= (length form) 2)
+             (error 'jerbuild "config: (xpatch PATH) takes one value"))
+           (set! xpatch (resolve-config-path (cadr form) base))]
           [else
            (error 'jerbuild
-                  (format "config: unknown key ~a in ~a (valid: entry output cc libdirs rust-crates extra-sources extra-archives extra-ldflags main-c ffi-symbols pre-build pre-link rust-target csv-dir)"
+                  (format "config: unknown key ~a in ~a (valid: entry output cc libdirs rust-crates extra-sources extra-archives extra-ldflags main-c ffi-symbols pre-build pre-link rust-target csv-dir xpatch)"
                           (car form) path))]))
       forms)
     (unless entry
@@ -2175,49 +2206,51 @@ int main(int argc, const char *argv[]) {
     (values entry output libdirs cc rust-crates
             extra-sources extra-archives extra-ldflags main-c
             ffi-symbols pre-build pre-link
-            rust-target csv-dir
+            rust-target csv-dir xpatch
             base)))
 
 (define (run-build args)
   ;; jerbuild build [--cc CC] [--config PATH]
-  ;;                [--rust-target TRIPLE] [--csv-dir PATH]
+  ;;                [--rust-target TRIPLE] [--csv-dir PATH] [--xpatch PATH]
   ;; Reads .jerbuild from cwd (or any parent) and runs do-binary-build.
-  ;; --cc / --rust-target / --csv-dir override the config's settings.
+  ;; --cc / --rust-target / --csv-dir / --xpatch override config settings.
   (let-values ([(cc-arg rest1) (parse-cc-flag args)])
     (let-values ([(config-paths rest2) (parse-multi-flag rest1 "--config")])
       (let-values ([(rt-arg rest3) (parse-single-flag rest2 "--rust-target")])
-        (let-values ([(csv-arg rest) (parse-single-flag rest3 "--csv-dir")])
-          (unless (null? rest)
-            (error 'jerbuild
-                   (format "build: unexpected positional args ~a" rest)))
-          (let ([config-path
-                 (cond
-                   [(not (null? config-paths))
-                    (let ([p (car (reverse config-paths))])
-                      (unless (file-exists? p)
-                        (error 'jerbuild (format "build: --config not found: ~a" p)))
-                      p)]
-                   [else
-                    (or (find-config-from (current-directory))
-                        (error 'jerbuild
-                               "build: no .jerbuild found in cwd or any parent"))])])
-            (printf "=== jerbuild build ===\n")
-            (printf "    Config: ~a\n" config-path)
-            (let-values ([(entry output libdirs cfg-cc rust-crates
-                           extra-sources extra-archives extra-ldflags main-c
-                           ffi-symbols pre-build pre-link
-                           cfg-rust-target cfg-csv-dir
-                           config-dir)
-                          (load-jerbuild-config config-path)])
-              (do-binary-build libdirs
-                               (or cc-arg cfg-cc)
-                               extra-archives extra-sources extra-ldflags
-                               rust-crates main-c
-                               ffi-symbols pre-build pre-link
-                               (or rt-arg cfg-rust-target)
-                               (or csv-arg cfg-csv-dir)
-                               config-dir
-                               (list entry output)))))))))
+        (let-values ([(csv-arg rest4) (parse-single-flag rest3 "--csv-dir")])
+          (let-values ([(xp-arg rest) (parse-single-flag rest4 "--xpatch")])
+            (unless (null? rest)
+              (error 'jerbuild
+                     (format "build: unexpected positional args ~a" rest)))
+            (let ([config-path
+                   (cond
+                     [(not (null? config-paths))
+                      (let ([p (car (reverse config-paths))])
+                        (unless (file-exists? p)
+                          (error 'jerbuild (format "build: --config not found: ~a" p)))
+                        p)]
+                     [else
+                      (or (find-config-from (current-directory))
+                          (error 'jerbuild
+                                 "build: no .jerbuild found in cwd or any parent"))])])
+              (printf "=== jerbuild build ===\n")
+              (printf "    Config: ~a\n" config-path)
+              (let-values ([(entry output libdirs cfg-cc rust-crates
+                             extra-sources extra-archives extra-ldflags main-c
+                             ffi-symbols pre-build pre-link
+                             cfg-rust-target cfg-csv-dir cfg-xpatch
+                             config-dir)
+                            (load-jerbuild-config config-path)])
+                (do-binary-build libdirs
+                                 (or cc-arg cfg-cc)
+                                 extra-archives extra-sources extra-ldflags
+                                 rust-crates main-c
+                                 ffi-symbols pre-build pre-link
+                                 (or rt-arg cfg-rust-target)
+                                 (or csv-arg cfg-csv-dir)
+                                 (or xp-arg cfg-xpatch)
+                                 config-dir
+                                 (list entry output))))))))))
 
 ;;;; ============================================================
 ;;;; Entry point
diff --git a/support/build-jerbuild.sh b/support/build-jerbuild.sh
index 22246ab..22750fd 100755
--- a/support/build-jerbuild.sh
+++ b/support/build-jerbuild.sh
@@ -353,9 +353,11 @@ int main(int argc, const char *argv[]) {
             "          [--extra-archive A] [--extra-source S.c]\n"
             "          [--extra-ldflag F] [--rust-crate Cargo.toml[:features]]\n"
             "          [--main-c FILE] [--rust-target T] [--csv-dir D]\n"
+            "          [--xpatch P]\n"
             "          <entry.ss> <output>                # build standalone binary\n"
             "  jerbuild build [--cc CC] [--config PATH]\n"
-            "          [--rust-target T] [--csv-dir D]    # read .jerbuild, build\n"
+            "          [--rust-target T] [--csv-dir D] [--xpatch P]\n"
+            "                                             # read .jerbuild, build\n"
             "  jerbuild --jerboa-home                     # extract+print stdlib path\n"
             "  jerbuild --version\n",
             stdout);