jerbuild binary: subprocess isolation for cross-WPO + --os-libs override
ober
c955178daaddeaff1b1bee1cfbfaf804dc7666ba
--- a/jerbuild.ss +++ b/jerbuild.ss @@ -1751,30 +1751,101 @@ int main(int argc, const char *argv[]) { (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 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))))))))))))) + (let-values ([(xpatch args) (parse-single-flag args "--xpatch")]) + (let-values ([(os-libs rest) (parse-single-flag args "--os-libs")]) + (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 os-libs + (current-directory) + rest)))))))))))))) + +;; Find a usable Chez scheme binary to spawn subprocess WPO compiles. +;; Tries $SCHEME, then ~/mine/jerboa/.chez/bin/scheme, then `command -v scheme`. +(define (find-scheme-binary) + (or (let ([e (getenv "SCHEME")]) + (and e (file-exists? e) e)) + (let* ([home (or (getenv "HOME") "")] + [p (string-append home "/mine/jerboa/.chez/bin/scheme")]) + (and (file-exists? p) p)) + (let* ([tmp (format "/tmp/jerbuild-scheme-which-~a" (get-process-id))] + [rc (system (format "command -v scheme > ~a 2>/dev/null" tmp))]) + (let ([path (and (zero? rc) (file-exists? tmp) + (call-with-input-file tmp get-line))]) + (when (file-exists? tmp) (delete-file tmp)) + (cond + [(or (not path) (eof-object? path) (string=? path "")) #f] + [(file-exists? path) path] + [else #f]))) + (error 'jerbuild + "find-scheme-binary: no scheme found (set SCHEME env var)"))) + +;; Path-leaf: basename of a path (no trailing slash). Used to make per-libdir +;; cache dirs unique in obj-dir. +(define (path-leaf p) + (let loop ([i (string-length p)]) + (cond + [(zero? i) p] + [(char=? (string-ref p (- i 1)) #\/) + (substring p i (string-length p))] + [else (loop (- i 1))]))) + +;; Run compile-program + compile-whole-program in a fresh Chez subprocess so +;; the cross target's recompiled libraries do not collide with the libraries +;; already loaded into jerbuild's own host image. +(define (cross-wpo-subprocess! entry obj-dir bundle-lib user-libs xpatch + program-so program-wpo program-wp-so) + (let* ([scheme (find-scheme-binary)] + [helper (format "~a/cross-wpo.ss" obj-dir)] + ;; Redirect bundle-lib to obj-dir/bundle so freshly compiled target + ;; .so files don't overwrite the host .so files in the bundle. + [bundle-redirect (string-append obj-dir "/bundle")] + [libdirs + (append + (map (lambda (l) + (cons l (string-append obj-dir "/u-" (path-leaf l)))) + user-libs) + (list (cons bundle-lib bundle-redirect)))]) + (system (format "mkdir -p ~a" (shell-quote bundle-redirect))) + (call-with-output-file helper + (lambda (port) + (display "(import (chezscheme))\n" port) + (fprintf port "(library-directories '~s)\n" libdirs) + ;; xpatch may mutate library-directories; restore after loading. + (fprintf port "(load ~s)\n" xpatch) + (fprintf port "(library-directories '~s)\n" libdirs) + (display "(compile-imported-libraries #t)\n" port) + (display "(generate-wpo-files #t)\n" port) + (fprintf port "(compile-program ~s ~s)\n" entry program-so) + (fprintf port "(compile-whole-program ~s ~s #t)\n" + program-wpo program-wp-so) + (display "(exit 0)\n" port)) + 'replace) + (printf " scheme: ~a\n" scheme) + (printf " helper: ~a\n" helper) + (let ([rc (system (format "~a --quiet --script ~a" + (shell-quote scheme) (shell-quote helper)))]) + (unless (zero? rc) + (error 'jerbuild + (format "cross WPO subprocess failed (rc=~a; helper=~a)" + rc helper)))))) (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 xpatch + rust-target csv-dir-override xpatch os-libs-override 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. @@ -1785,9 +1856,13 @@ int main(int argc, const char *argv[]) { ;; 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. + ;; os-libs-override: when set, replaces the host-derived OS link libs + ;; (-lm -lpthread -lncurses ...) at link time. Required for cross builds + ;; to platforms whose static toolchain lacks the host's libs (e.g. musl + ;; has no -liconv/-lncurses). (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] [--xpatch P] [--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] [--os-libs S] [--main-c F] <entry.ss> <output>")) (let* ([entry (car rest)] [output (cadr rest)] [cc (or cc-arg (or (getenv "CC") "cc"))] @@ -1865,6 +1940,8 @@ int main(int argc, const char *argv[]) { (printf " Rust target: ~a\n" rust-target)) (when xpatch (printf " xpatch: ~a\n" xpatch)) + (when os-libs-override + (printf " OS libs (override): ~a\n" os-libs-override)) (unless (null? rust-crates) (printf " Rust crates: ~a\n" (length rust-crates))) (unless (null? extra-archives) @@ -1886,23 +1963,27 @@ int main(int argc, const char *argv[]) { ;; .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))) - - (compile-imported-libraries #t) - (generate-wpo-files #t) - - (printf "==> [1/5] WPO compile ~a\n" entry) - (compile-program entry program-so) - (compile-whole-program program-wpo program-wp-so #t) + ;; jerbuild's own image has libraries already imported as the HOST + ;; machine-type (jerboa core, std pregexp, std misc string, ...). After + ;; loading xpatch, Chez's codegen switches to the target machine-type. + ;; Recompiling those libs to the new machine-type would trigger + ;; "attempting to re-install compile-time part of library" because they + ;; are already loaded. Run the WPO step in a fresh Chez subprocess so it + ;; sees a clean library table. + (cond + [xpatch + (printf "==> [1/5] WPO compile in isolated subprocess (xpatch=~a)\n" xpatch) + (cross-wpo-subprocess! entry obj-dir bundle-lib user-libs xpatch + program-so program-wpo program-wp-so)] + [else + (library-directories + (append (map (lambda (l) (cons l obj-dir)) user-libs) + (list bundle-lib))) + (compile-imported-libraries #t) + (generate-wpo-files #t) + (printf "==> [1/5] WPO compile ~a\n" entry) + (compile-program entry program-so) + (compile-whole-program program-wpo program-wp-so #t)]) (let* ([rust-archives (cond @@ -1995,7 +2076,8 @@ int main(int argc, const char *argv[]) { (shell-quote libkernel) chez-archives (join-raw extra-ldflags) - (machine-type->os-libs mt))]) + (or os-libs-override + (machine-type->os-libs mt)))]) (printf " ~a\n" cc-cmd) (let ([rc (system cc-cmd)]) (unless (zero? rc) @@ -2125,7 +2207,7 @@ int main(int argc, const char *argv[]) { ;; Returns (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 os-libs ;; config-dir). ;; extra-sources entries are pairs (abs-path . cflags-or-#f). (let* ([config-dir (path-dirname path)] @@ -2137,7 +2219,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] [xpatch #f]) + [rust-target #f] [csv-dir #f] [xpatch #f] [os-libs #f]) (for-each (lambda (form) (unless (and (pair? form) (symbol? (car form))) @@ -2194,9 +2276,13 @@ int main(int argc, const char *argv[]) { (unless (= (length form) 2) (error 'jerbuild "config: (xpatch PATH) takes one value")) (set! xpatch (resolve-config-path (cadr form) base))] + [(os-libs) + (unless (= (length form) 2) + (error 'jerbuild "config: (os-libs STR) takes one string value")) + (set! os-libs (cadr form))] [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 xpatch)" + (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 os-libs)" (car form) path))])) forms) (unless entry @@ -2206,51 +2292,54 @@ 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 xpatch + rust-target csv-dir xpatch os-libs base))) (define (run-build args) ;; jerbuild build [--cc CC] [--config PATH] ;; [--rust-target TRIPLE] [--csv-dir PATH] [--xpatch PATH] + ;; [--os-libs STR] ;; Reads .jerbuild from cwd (or any parent) and runs do-binary-build. - ;; --cc / --rust-target / --csv-dir / --xpatch override config settings. + ;; --cc / --rust-target / --csv-dir / --xpatch / --os-libs override config. (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 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)))))))))) + (let-values ([(xp-arg rest5) (parse-single-flag rest4 "--xpatch")]) + (let-values ([(ol-arg rest) (parse-single-flag rest5 "--os-libs")]) + (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 cfg-os-libs + 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) + (or ol-arg cfg-os-libs) + config-dir + (list entry output))))))))))) ;;;; ============================================================ ;;;; Entry point --- a/support/build-jerbuild.sh +++ b/support/build-jerbuild.sh @@ -353,10 +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" + " [--xpatch P] [--os-libs STR]\n" " <entry.ss> <output> # build standalone binary\n" " jerbuild build [--cc CC] [--config PATH]\n" " [--rust-target T] [--csv-dir D] [--xpatch P]\n" + " [--os-libs STR]\n" " # read .jerbuild, build\n" " jerbuild --jerboa-home # extract+print stdlib path\n" " jerbuild --version\n",