Stabilize jerbuild binary program image selection
ober
fbe231403a85cd33235087553193fe6f2d14fa10
--- a/jerbuild.ss +++ b/jerbuild.ss @@ -2099,6 +2099,49 @@ (printf " Stripped deterministic WPO FASL metadata: ~a\n" program-wp-so)))) +(define (condition-brief exn) + (cond + [(message-condition? exn) (condition-message exn)] + [else (format "~s" exn)])) + +(define (strip-binary-fasl-artifact! path) + (let ([tmp (string-append path ".stripped")]) + (when (file-exists? tmp) + (safe-delete-file tmp)) + (guard (exn + [else + (when (file-exists? tmp) + (safe-delete-file tmp)) + (printf " FASL metadata strip skipped for ~a: ~a\n" + path + (condition-brief exn)) + 0]) + (strip-fasl-file + path + tmp + (fasl-strip-options inspector-source + source-annotations + profile-source)) + (safe-delete-file path) + (rename-file tmp path) + 1))) + +(define (strip-binary-fasl-tree! root) + (if (binary-deterministic-ids?) + (let loop ([path root] [count 0]) + (cond + [(file-directory? path) + (let walk ([names (list-sort string<? (directory-list path))] + [acc count]) + (if (null? names) + acc + (walk (cdr names) + (loop (string-append path "/" (car names)) acc))))] + [(and (file-regular? path) (binary-fasl-artifact? path)) + (+ count (strip-binary-fasl-artifact! path))] + [else count])) + 0)) + (define (canonicalize-binary-wpo-artifacts! obj-dir program-so program-wpo program-wp-so) (when (binary-deterministic-ids?) (let* ([input-count @@ -2784,8 +2827,9 @@ int main(int argc, const char *argv[]) { ;; jerbuild's host image; and (b) inside the multicall binary, whose running ;; image has the stdlib internalized — only a fresh process can recompile the ;; bundled sources to native .wpo. xpatch #f => native (no retarget). -(define (cross-wpo-subprocess! entry obj-dir bundle-lib user-libs xpatch - program-so program-wpo program-wp-so) +(define (cross-program-subprocess! entry obj-dir bundle-lib user-libs xpatch + program-so program-wpo program-wp-so + binary-wpo?) (let* ([compile-helper (format "~a/cross-wpo-compile.ss" obj-dir)] [whole-helper (format "~a/cross-wpo-whole.ss" obj-dir)] ;; Redirect bundle-lib to obj-dir/bundle so freshly compiled @@ -2810,7 +2854,7 @@ int main(int argc, const char *argv[]) { (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 "(generate-wpo-files ~s)\n" binary-wpo?) (fprintf port "(compile-program ~s ~s)\n" entry program-so) (display "(exit 0)\n" port))) (let ([cmd (wpo-subprocess-command compile-helper)]) @@ -2819,29 +2863,35 @@ int main(int argc, const char *argv[]) { (run-system! (format "WPO compile subprocess (helper=~a)" compile-helper) cmd)) (let ([input-count (canonicalize-binary-input-gensym-prefix! obj-dir program-so)]) - (with-replacing-text-output whole-helper - (lambda (port) - (display "(import (scheme))\n" port) - (when (binary-deterministic-ids?) - (write-binary-deterministic-id-setup port)) - (fprintf port "(library-directories '~s)\n" libdirs) - (when xpatch - (fprintf port "(load ~s)\n" xpatch) - (fprintf port "(library-directories '~s)\n" libdirs)) - (fprintf port "(compile-whole-program ~s ~s #t)\n" - program-wpo program-wp-so) - (display "(exit 0)\n" port))) - (let ([cmd (wpo-subprocess-command whole-helper)]) - (printf " helper: ~a\n" whole-helper) - (printf " cmd: ~a\n" cmd) - (run-system! (format "WPO whole-program subprocess (helper=~a)" whole-helper) cmd)) - (let ([wpo-count - (if (binary-deterministic-ids?) - (canonicalize-binary-wpo-only-prefixes! - program-so program-wpo program-wp-so) - 0)]) - (log-canonicalized-gensym-prefix-count input-count wpo-count) - (strip-binary-wpo-fasl! program-wp-so))))) + (if binary-wpo? + (begin + (with-replacing-text-output whole-helper + (lambda (port) + (display "(import (scheme))\n" port) + (when (binary-deterministic-ids?) + (write-binary-deterministic-id-setup port)) + (fprintf port "(library-directories '~s)\n" libdirs) + (when xpatch + (fprintf port "(load ~s)\n" xpatch) + (fprintf port "(library-directories '~s)\n" libdirs)) + (fprintf port "(compile-whole-program ~s ~s #t)\n" + program-wpo program-wp-so) + (display "(exit 0)\n" port))) + (let ([cmd (wpo-subprocess-command whole-helper)]) + (printf " helper: ~a\n" whole-helper) + (printf " cmd: ~a\n" cmd) + (run-system! (format "WPO whole-program subprocess (helper=~a)" whole-helper) cmd)) + (let ([wpo-count + (if (binary-deterministic-ids?) + (canonicalize-binary-wpo-only-prefixes! + program-so program-wpo program-wp-so) + 0)]) + (log-canonicalized-gensym-prefix-count input-count wpo-count) + (strip-binary-wpo-fasl! program-wp-so))) + (begin + (log-canonicalized-gensym-prefix-count input-count 0) + (when (binary-deterministic-ids?) + (strip-binary-fasl-tree! obj-dir))))))) (define (do-binary-build libs cc-arg extra-archives extra-sources extra-ldflags rust-crates main-c-override @@ -2942,6 +2992,8 @@ int main(int argc, const char *argv[]) { [program-so (format "~a/program.so" obj-dir)] [program-wpo (format "~a/program.wpo" obj-dir)] [program-wp-so (format "~a/program.wp.so" obj-dir)] + [binary-wpo? (env-enabled? "JERBOA_BINARY_WPO" #t)] + [program-image (if binary-wpo? program-wp-so program-so)] [petite-hdr (format "~a/petite_boot.h" obj-dir)] [scheme-hdr (format "~a/scheme_boot.h" obj-dir)] [program-hdr (format "~a/program_boot.h" obj-dir)] @@ -2970,6 +3022,10 @@ int main(int argc, const char *argv[]) { (printf " Static native: ~a (~a symbol(s))\n" static-native-archive (length static-native-symbols))) + (printf " Program image: ~a\n" + (if binary-wpo? + "compile-whole-program (standalone default)" + "compile-program (explicit JERBOA_BINARY_WPO=0)")) (unless (null? rust-crates) (printf " Rust crates: ~a\n" (length rust-crates))) (unless (null? extra-archives) @@ -3018,25 +3074,36 @@ int main(int argc, const char *argv[]) { ;; keeps the in-process path when its bundle .wpo already match the host. (cond [(or xpatch (getenv "JERBOA_SELF_EXE")) - (printf "==> [1/5] WPO compile in isolated subprocess~a\n" + (printf "==> [1/5] Program compile in isolated subprocess~a\n" (if xpatch (format " (xpatch=~a)" xpatch) " (multicall self)")) - (cross-wpo-subprocess! entry obj-dir bundle-lib user-libs xpatch - program-so program-wpo program-wp-so)] + (cross-program-subprocess! entry obj-dir bundle-lib user-libs xpatch + program-so program-wpo program-wp-so + binary-wpo?)] [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) + (generate-wpo-files binary-wpo?) + (printf "==> [1/5] Program compile ~a\n" entry) (call-with-binary-compile-mode (lambda () (call-with-binary-generated-id-mode (lambda () (compile-program entry program-so) - (compile-whole-program program-wpo program-wp-so #t))))) - (canonicalize-binary-wpo-artifacts! - obj-dir program-so program-wpo program-wp-so)]) + (when binary-wpo? + (compile-whole-program program-wpo program-wp-so #t)))))) + (if binary-wpo? + (canonicalize-binary-wpo-artifacts! + obj-dir program-so program-wpo program-wp-so) + (let ([input-count + (if (binary-deterministic-ids?) + (canonicalize-binary-input-gensym-prefix! + obj-dir program-so) + 0)]) + (log-canonicalized-gensym-prefix-count input-count 0) + (when (binary-deterministic-ids?) + (strip-binary-fasl-tree! obj-dir))))]) (let* ([rust-archives (cond @@ -3066,7 +3133,7 @@ int main(int argc, const char *argv[]) { (printf "==> [3/5] Embed boots + program as C arrays\n") (embed-bytes-as-c-array petite-boot petite-hdr "petite_boot") (embed-bytes-as-c-array scheme-boot scheme-hdr "scheme_boot") - (embed-bytes-as-c-array program-wp-so program-hdr "program_boot") + (embed-bytes-as-c-array program-image program-hdr "program_boot") ;; Always emit ffi_symbols.h so main.c (stock or user override) can ;; #include it unconditionally. With no (ffi-symbols ...) the header