Fix static binary library boot
ober
d1639697907b37f4b390d01a9b4f75d3cddd0be0
--- a/.gitignore +++ b/.gitignore @@ -16,8 +16,10 @@ jdns-freebsd-amd64 jdns-data-freebsd-amd64 jdns*.wp.so jdns*-main.c +jdns*-libs.boot petite_boot.h scheme_boot.h +app_boot.h program_boot.h # Per-machine compiled-library caches Chez emits during cross-builds --- a/Makefile +++ b/Makefile @@ -81,7 +81,8 @@ static-clean: rm -f jdns-linux-arm64 jdns-data-linux-arm64 rm -f jdns-freebsd-amd64 jdns-data-freebsd-amd64 rm -f jdns*.wp.so jdns*-main.c - rm -f petite_boot.h scheme_boot.h program_boot.h + rm -f jdns*-libs.boot + rm -f petite_boot.h scheme_boot.h app_boot.h program_boot.h clean: find lib -name '*.so' -delete 2>/dev/null || true --- a/static/build-common.ss +++ b/static/build-common.ss @@ -46,6 +46,90 @@ (error 'find-cross-csv-dir "no csv* under" lib)) (format "~a/~a/~a" lib (car csvs) machine)))) +(define (string-join/slash parts) + (cond + [(null? parts) ""] + [else + (let loop ([rest (cdr parts)] [acc (car parts)]) + (if (null? rest) + acc + (loop (cdr rest) (string-append acc "/" (car rest)))))])) + +(define (module->relative-path module ext) + (string-append (string-join/slash (map symbol->string module)) ext)) + +(define (library-search-roots) + (map car (library-directories))) + +(define (find-library-file rel) + (let loop ([roots (library-search-roots)]) + (cond + [(null? roots) #f] + [else + (let ([p (format "~a/~a" (car roots) rel)]) + (if (file-exists? p) + p + (loop (cdr roots))))]))) + +(define (find-library-source module) + (or (find-library-file (module->relative-path module ".sls")) + (find-library-file (module->relative-path module ".ss")))) + +(define (map-in-order proc xs) + (let loop ([rest xs] [acc '()]) + (if (null? rest) + (reverse acc) + (loop (cdr rest) (cons (proc (car rest)) acc))))) + +;; Libraries needed by the embedded jdns and jdns-data programs. The order is +;; dependency-first because make-boot-file requires dependencies before users. +(define jdns-static-library-modules + '((jerboa runtime) + (std os path) + (std misc thread) + (std pregexp) + (std misc string) + (std misc list) + (std contract condition) + (std typed) + (jerboa core) + (std wasm sandbox) + ;; Optional runtime-loaded TCP fiber support. + (std misc cpu) + (std actor deque) + (std fiber) + ;; Application libraries. + (jerboa-dns protocol) + (jerboa-dns cdb) + (jerboa-dns zone) + (jerboa-dns log) + (jerboa-dns response) + (jerboa-dns wasm-cdb) + (jerboa-dns wasm-dns) + (jerboa-dns lookup) + (jerboa-dns zone-compiler) + (jerboa-dns server) + (jerboa-dns main))) + +(define (compile-static-library! module) + (let ([src (find-library-source module)]) + (unless src + (error 'compile-static-library! "library source not found" module)) + (printf " compile library ~s from ~a~n" module src) + (compile-library src) + (let ([so (find-library-file (module->relative-path module ".so"))]) + (unless so + (error 'compile-static-library! "compiled library not found" module)) + so))) + +(define (build-libraries-boot! binary-name) + (printf "==> [~a] compile static library closure~n" binary-name) + (let ([library-sos (map-in-order compile-static-library! jdns-static-library-modules)] + [app-boot (string-append binary-name "-libs.boot")]) + (printf "==> [~a] make-boot-file libraries -> ~a~n" binary-name app-boot) + (apply make-boot-file app-boot '("petite" "scheme") library-sos) + app-boot)) + ;; POSIX symbols jdns calls via foreign-procedure. Resolved by the libc ;; statically/dynamically linked into the final binary. (define jdns-posix-symbols @@ -101,6 +185,7 @@ (display "#include \"scheme.h\"\n" out) (display "#include \"petite_boot.h\"\n" out) (display "#include \"scheme_boot.h\"\n" out) + (display "#include \"app_boot.h\"\n" out) (display "#include \"program_boot.h\"\n\n" out) ;; dlopen stubs for fully-static binaries (musl's dlopen always fails in @@ -187,6 +272,7 @@ (display " Sscheme_init(NULL);\n" out) (display " Sregister_boot_file_bytes(\"petite\", (void *)petite_boot_data, petite_boot_size);\n" out) (display " Sregister_boot_file_bytes(\"scheme\", (void *)scheme_boot_data, scheme_boot_size);\n" out) + (display " Sregister_boot_file_bytes(\"app\", (void *)app_boot_data, app_boot_size);\n" out) (display " Sbuild_heap(NULL, register_ffi_symbols);\n" out) (display " const char *prog_path = write_program_tempfile();\n" out) (display " int status = Sscheme_program(prog_path, argc, argv);\n" out) @@ -195,7 +281,7 @@ (display " return status;\n" out) (display "}\n" out)) -;; Generic per-binary pipeline: compile-program → compile-whole-program → +;; Generic per-binary pipeline: compile-program → app libraries boot → ;; embed boot + program → generate main.c → invoke cross-cc. ;; Each target script calls (build-one-binary ...) twice — once for jdns, ;; once for jdns-data. @@ -205,24 +291,29 @@ platform-tag extra-posix-symbols link-cmd-fn) - (let* ([wpo-output (string-append binary-name ".wp.so")] - ;; entry "bin/jdns.ss" → wpo at "bin/jdns.wpo" + (let* (;; entry "bin/jdns.ss" → program at "bin/jdns.so" [base (let ([n (string-length entry-script)]) (if (and (>= n 3) (string=? (substring entry-script (- n 3) n) ".ss")) (substring entry-script 0 (- n 3)) entry-script))] - [wpo-input (string-append base ".wpo")] + [program-output (string-append base ".so")] [main-c (string-append binary-name "-main.c")]) + (let ([app-boot (build-libraries-boot! binary-name)]) (printf "==> [~a] compile-program ~a~n" binary-name entry-script) - (compile-program entry-script) - (printf "==> [~a] compile-whole-program ~a -> ~a~n" - binary-name wpo-input wpo-output) - (compile-whole-program wpo-input wpo-output #t) + ;; The app boot contains the library instances. Compile the tiny entry + ;; program after that, without recompiling imported libraries, so its + ;; imports match the boot-loaded instances exactly. + (let ([old-compile-imported (compile-imported-libraries)]) + (dynamic-wind + (lambda () (compile-imported-libraries #f)) + (lambda () (compile-program entry-script)) + (lambda () (compile-imported-libraries old-compile-imported)))) (printf "==> [~a] embed boot files + program~n" binary-name) (embed-as-c-array (format "~a/petite.boot" csv-dir) "petite_boot" "petite_boot.h") (embed-as-c-array (format "~a/scheme.boot" csv-dir) "scheme_boot" "scheme_boot.h") - (embed-as-c-array wpo-output "program_boot" "program_boot.h") + (embed-as-c-array app-boot "app_boot" "app_boot.h") + (embed-as-c-array program-output "program_boot" "program_boot.h") (printf "==> [~a] generate ~a~n" binary-name main-c) (call-with-port (open-file-output-port main-c (file-options no-fail) (buffer-mode block) (native-transcoder)) @@ -236,4 +327,4 @@ (printf "=== ~a built ===~n" binary-name) (system (format "ls -lh ~a" binary-name)) ; jerboa-security: suppress missing-taint-check-at-sink (system (format "file ~a" binary-name)) ; jerboa-security: suppress missing-taint-check-at-sink - (newline))) + (newline))))