Self-contained build foundation: embedded-bytes helpers, launcher stub, in-process app link
Adds the pieces a toolchain-free joltc needs to compile apps with no external Chez or cc: - host/chez/java/io.ss: register-embedded-bytes!/jolt-embedded-bytes, read-file-bytes, jolt-spill-embedded!, jolt-append-payload! (frames an app boot onto the stub as [stub][boot][len:le64]["JOLTBOOT"]), and jolt-chmod-755 via load-shared-object #f (no subprocess). - host/chez/stub/launcher.c: a native stub that locates its own executable, reads the trailing frame, and hands the appended boot to the Chez kernel. - host/chez/loader.ss: resolve-on-roots consults the embedded source store before disk; ldr-read-source reads baked source. Dev (empty store) is unaffected. - host/chez/build.ss: build-binary step 4 splits into build-self-contained (in-process compile-file/make-boot-file with the system error restored, then append the boot to a copy of the embedded stub) and build-with-cc (the existing dev path). The self-contained path is taken only when the stub is embedded. The legacy cc path is unchanged behaviorally; make buildsmoke still passes.
This commit is contained in:
parent
0abb958955
commit
0420cd4d79
4 changed files with 266 additions and 48 deletions
|
|
@ -190,7 +190,7 @@
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (nf)
|
(lambda (nf)
|
||||||
(set-chez-ns! (car nf))
|
(set-chez-ns! (car nf))
|
||||||
(let ((src (read-file-string (cdr nf))))
|
(let ((src (ldr-read-source (cdr nf))))
|
||||||
(parameterize ((rdr-source-file (cdr nf)))
|
(parameterize ((rdr-source-file (cdr nf)))
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (f)
|
(lambda (f)
|
||||||
|
|
@ -370,7 +370,7 @@
|
||||||
;; ns-prelude forms (always kept, no fqn/refs) set the
|
;; ns-prelude forms (always kept, no fqn/refs) set the
|
||||||
;; ns + register aliases before this ns's forms; dce
|
;; ns + register aliases before this ns's forms; dce
|
||||||
;; keeps original order.
|
;; keeps original order.
|
||||||
(let ((src (read-file-string (cdr nf))))
|
(let ((src (ldr-read-source (cdr nf))))
|
||||||
(parameterize ((rdr-source-file (cdr nf)))
|
(parameterize ((rdr-source-file (cdr nf)))
|
||||||
(append
|
(append
|
||||||
(map (lambda (s) (dce-rec #t #f '() s))
|
(map (lambda (s) (dce-rec #t #f '() s))
|
||||||
|
|
@ -381,7 +381,7 @@
|
||||||
(values #f
|
(values #f
|
||||||
(apply append
|
(apply append
|
||||||
(map (lambda (nf)
|
(map (lambda (nf)
|
||||||
(let ((src (read-file-string (cdr nf))))
|
(let ((src (ldr-read-source (cdr nf))))
|
||||||
(parameterize ((rdr-source-file (cdr nf)))
|
(parameterize ((rdr-source-file (cdr nf)))
|
||||||
(append (bld-ns-prelude (car nf) src)
|
(append (bld-ns-prelude (car nf) src)
|
||||||
(bld-emit-ns (car nf) src)))))
|
(bld-emit-ns (car nf) src)))))
|
||||||
|
|
@ -442,10 +442,49 @@
|
||||||
" (apply jolt-invoke mainv args)))\n"
|
" (apply jolt-invoke mainv args)))\n"
|
||||||
" (exit 0)))\n"))
|
" (exit 0)))\n"))
|
||||||
(close-port out))
|
(close-port out))
|
||||||
;; 4. compile -> boot -> embed -> link.
|
;; 4. compile -> boot -> link. Two paths, chosen by whether this process
|
||||||
;; compile-file/make-boot-file run in a FRESH Chez, not this process: the
|
;; carries the bundled Chez boots + launcher stub:
|
||||||
;; loaded runtime shadows `error` (regex.ss, for irregex), which would
|
;; - SELF-CONTAINED (the distributed joltc, jolt-eaj): compile-file +
|
||||||
;; otherwise bake a broken `error` reference into the boot.
|
;; make-boot-file run IN PROCESS (the compiler is resident — joltc is
|
||||||
|
;; built from scheme.boot), then the boot is appended to a copy of the
|
||||||
|
;; embedded stub. No external Chez, no cc.
|
||||||
|
;; - LEGACY (dev bin/joltc): spawn a fresh Chez for compile-file/
|
||||||
|
;; make-boot-file, then xxd the boot into a C array and cc-link against
|
||||||
|
;; libkernel.a. Kept so `make buildsmoke` still exercises the cc path.
|
||||||
|
(if (jolt-embedded-bytes "stub/launcher")
|
||||||
|
(build-self-contained entry-ns out-path mode builddir flat-ss flat-so boot)
|
||||||
|
(build-with-cc entry-ns out-path mode builddir flat-ss flat-so boot boot-h main-c)))))))
|
||||||
|
|
||||||
|
;; --- self-contained link (in-process compile + append the boot to the stub) ---
|
||||||
|
;; The system `error` is restored around compile-file/make-boot-file: the loaded
|
||||||
|
;; jolt runtime shadows it (regex.ss, %chez-error holds the kernel original).
|
||||||
|
;; flat.ss opens with (import (chezscheme)) so the boot binds the real error
|
||||||
|
;; regardless, but the save/restore keeps any compile-time diagnostic honest.
|
||||||
|
(define (build-self-contained entry-ns out-path mode builddir flat-ss flat-so boot)
|
||||||
|
(let ((petite (string-append builddir "/petite.boot"))
|
||||||
|
(scheme (string-append builddir "/scheme.boot")))
|
||||||
|
(jolt-spill-embedded! "csv/petite.boot" petite)
|
||||||
|
(jolt-spill-embedded! "csv/scheme.boot" scheme)
|
||||||
|
(display (string-append "jolt build: compiling " entry-ns " (" mode " mode, self-contained)\n"))
|
||||||
|
(let ((saved-err error))
|
||||||
|
(dynamic-wind
|
||||||
|
(lambda () (set! error %chez-error))
|
||||||
|
(lambda ()
|
||||||
|
(compile-file flat-ss flat-so)
|
||||||
|
(make-boot-file boot '() petite scheme flat-so))
|
||||||
|
(lambda () (set! error saved-err))))
|
||||||
|
;; link: stub bytes ++ boot ++ frame, then make it executable.
|
||||||
|
(jolt-spill-embedded! "stub/launcher" out-path)
|
||||||
|
(jolt-append-payload! out-path (read-file-bytes boot))
|
||||||
|
(jolt-chmod-755 out-path)
|
||||||
|
(display (string-append "jolt build: wrote " out-path "\n"))
|
||||||
|
(when bld-osx?
|
||||||
|
(display (string-append
|
||||||
|
"jolt build: note — on macOS this binary is unsigned; to share it,\n"
|
||||||
|
" `xattr -d com.apple.quarantine " out-path "` on the target, or sign it.\n")))))
|
||||||
|
|
||||||
|
;; --- legacy cc link (dev bin/joltc): fresh Chez compile + xxd + cc ------------
|
||||||
|
(define (build-with-cc entry-ns out-path mode builddir flat-ss flat-so boot boot-h main-c)
|
||||||
(display (string-append "jolt build: compiling " entry-ns " (" mode " mode)\n"))
|
(display (string-append "jolt build: compiling " entry-ns " (" mode " mode)\n"))
|
||||||
(let ((cs (string-append builddir "/compile.ss")))
|
(let ((cs (string-append builddir "/compile.ss")))
|
||||||
(let ((p (open-output-file cs 'replace)))
|
(let ((p (open-output-file cs 'replace)))
|
||||||
|
|
@ -478,7 +517,7 @@
|
||||||
(bld-system (string-append
|
(bld-system (string-append
|
||||||
"cc -O2 -I'" bld-csv-dir "' '" main-c "' '" bld-csv-dir "/libkernel.a' "
|
"cc -O2 -I'" bld-csv-dir "' '" main-c "' '" bld-csv-dir "/libkernel.a' "
|
||||||
"-o '" out-path "' " (bld-link-libs)))
|
"-o '" out-path "' " (bld-link-libs)))
|
||||||
(display (string-append "jolt build: wrote " out-path "\n")))))))
|
(display (string-append "jolt build: wrote " out-path "\n")))
|
||||||
|
|
||||||
(def-var! "jolt.host" "build-binary"
|
(def-var! "jolt.host" "build-binary"
|
||||||
(lambda (entry out mode natives embed-dirs ext-roots direct-link? tree-shake?)
|
(lambda (entry out mode natives embed-dirs ext-roots direct-link? tree-shake?)
|
||||||
|
|
|
||||||
|
|
@ -29,6 +29,65 @@
|
||||||
(hashtable-set! embedded-resources name content))
|
(hashtable-set! embedded-resources name content))
|
||||||
(define-record-type embedded-res (fields name content) (nongenerative jolt-embres-v1))
|
(define-record-type embedded-res (fields name content) (nongenerative jolt-embres-v1))
|
||||||
|
|
||||||
|
;; --- self-contained build artifacts (jolt-eaj) ------------------------------
|
||||||
|
;; A toolchain-free `jolt build` (the distributed joltc) carries the Chez
|
||||||
|
;; petite/scheme boots and a prebuilt launcher stub baked into its own boot image.
|
||||||
|
;; They live in the same table as embedded-resources, but keyed under bytevector
|
||||||
|
;; values (register-embedded-bytes!) rather than strings; resolve-on-roots /
|
||||||
|
;; io/resource only ever ask for the string-keyed source entries, so the two
|
||||||
|
;; coexist. The build driver reads them at heap-build time from files that exist
|
||||||
|
;; only on the dev machine.
|
||||||
|
(define (register-embedded-bytes! name bv) (hashtable-set! embedded-resources name bv))
|
||||||
|
(define (jolt-embedded-bytes name)
|
||||||
|
(let ((v (hashtable-ref embedded-resources name #f)))
|
||||||
|
(and (bytevector? v) v)))
|
||||||
|
|
||||||
|
;; Read a whole file as a bytevector ("" -> empty). Used to slurp boot/stub files.
|
||||||
|
(define (read-file-bytes path)
|
||||||
|
(let ((p (open-file-input-port path)))
|
||||||
|
(let ((bv (get-bytevector-all p)))
|
||||||
|
(close-port p)
|
||||||
|
(if (eof-object? bv) (bytevector) bv))))
|
||||||
|
|
||||||
|
;; Write an embedded bytevector resource out to a path. make-boot-file needs the
|
||||||
|
;; petite/scheme boots as files, so they are spilled to scratch before the call.
|
||||||
|
(define (jolt-spill-embedded! name path)
|
||||||
|
(let ((bv (jolt-embedded-bytes name)))
|
||||||
|
(unless bv (error 'jolt-spill-embedded! "no embedded bytes for" name))
|
||||||
|
(let ((p (open-file-output-port path (file-options no-fail) (buffer-mode block))))
|
||||||
|
(put-bytevector p bv)
|
||||||
|
(close-port p))))
|
||||||
|
|
||||||
|
;; Frame an app boot onto a file that already holds the stub bytes. Layout:
|
||||||
|
;; [stub][boot][boot-length:le64]["JOLTBOOT"]. The stub (host/chez/stub/launcher.c)
|
||||||
|
;; reads the trailing 16 bytes — the 8-byte magic, then the preceding 8-byte LE
|
||||||
|
;; length — to locate and register the boot, so a boot that itself contains the
|
||||||
|
;; magic bytes can't be mistaken for the frame.
|
||||||
|
(define jolt-payload-magic (string->utf8 "JOLTBOOT"))
|
||||||
|
(define (jolt-append-payload! path boot-bv)
|
||||||
|
(let ((head (read-file-bytes path))) ; the stub bytes already written
|
||||||
|
(let ((p (open-file-output-port path (file-options no-fail) (buffer-mode block)))
|
||||||
|
(lb (make-bytevector 8 0)))
|
||||||
|
(bytevector-u64-set! lb 0 (bytevector-length boot-bv) (endianness little))
|
||||||
|
(put-bytevector p head)
|
||||||
|
(put-bytevector p boot-bv)
|
||||||
|
(put-bytevector p lb)
|
||||||
|
(put-bytevector p jolt-payload-magic)
|
||||||
|
(close-port p))))
|
||||||
|
|
||||||
|
;; chmod 0755 via libc, so the produced binary is executable. load-shared-object
|
||||||
|
;; with #f pulls the running process's own symbols (chmod is in libc, linked into
|
||||||
|
;; every Chez binary) — no external toolchain. Falls back to /bin/sh chmod if the
|
||||||
|
;; symbol can't be resolved.
|
||||||
|
(define jolt-chmod-755
|
||||||
|
(let ((c (guard (e (#t #f))
|
||||||
|
(load-shared-object #f)
|
||||||
|
(foreign-procedure "chmod" (string int) int))))
|
||||||
|
(lambda (path)
|
||||||
|
(if c
|
||||||
|
(c path #o755)
|
||||||
|
(system (string-append "chmod 755 '" path "'"))))))
|
||||||
|
|
||||||
;; A user-facing relative path resolves against JOLT_PWD — the user's cwd before
|
;; A user-facing relative path resolves against JOLT_PWD — the user's cwd before
|
||||||
;; the launcher cd'd to the jolt repo root — matching the JVM, where io/file is
|
;; the launcher cd'd to the jolt repo root — matching the JVM, where io/file is
|
||||||
;; cwd-relative. (io/resource builds jfiles from the source roots directly, so it
|
;; cwd-relative. (io/resource builds jfiles from the source roots directly, so it
|
||||||
|
|
|
||||||
|
|
@ -122,14 +122,31 @@
|
||||||
(else (loop (cdr cs) (cons (car cs) seg) segs)))))
|
(else (loop (cdr cs) (cons (car cs) seg) segs)))))
|
||||||
|
|
||||||
;; First existing <root>/rel.clj or <root>/rel.cljc on the search roots, else #f.
|
;; First existing <root>/rel.clj or <root>/rel.cljc on the search roots, else #f.
|
||||||
|
;; A self-contained joltc binary embeds jolt-core + stdlib source keyed by their
|
||||||
|
;; root-relative path ("clojure/string.clj"); those are checked first, so a
|
||||||
|
;; `require` resolves with no source on disk. The dev bin/joltc has an empty
|
||||||
|
;; source store, so the two hashtable probes miss and it falls straight to disk.
|
||||||
(define (resolve-on-roots rel)
|
(define (resolve-on-roots rel)
|
||||||
|
(let ((eclj (string-append rel ".clj")) (ecljc (string-append rel ".cljc")))
|
||||||
|
(cond
|
||||||
|
((string? (hashtable-ref embedded-resources eclj #f)) eclj)
|
||||||
|
((string? (hashtable-ref embedded-resources ecljc #f)) ecljc)
|
||||||
|
(else
|
||||||
(let loop ((roots source-roots))
|
(let loop ((roots source-roots))
|
||||||
(if (null? roots) #f
|
(if (null? roots) #f
|
||||||
(let ((clj (string-append (car roots) "/" rel ".clj"))
|
(let ((clj (string-append (car roots) "/" rel ".clj"))
|
||||||
(cljc (string-append (car roots) "/" rel ".cljc")))
|
(cljc (string-append (car roots) "/" rel ".cljc")))
|
||||||
(cond ((file-exists? clj) clj)
|
(cond ((file-exists? clj) clj)
|
||||||
((file-exists? cljc) cljc)
|
((file-exists? cljc) cljc)
|
||||||
(else (loop (cdr roots))))))))
|
(else (loop (cdr roots)))))))))))
|
||||||
|
|
||||||
|
;; Read a namespace source. An embedded key (resolve-on-roots above, or the
|
||||||
|
;; build driver's app-order entries) reads its baked string; everything else is
|
||||||
|
;; a real path read off disk. Bytevector entries (the bundled boots/stub) are not
|
||||||
|
;; source, so a string? guard skips them.
|
||||||
|
(define (ldr-read-source path)
|
||||||
|
(let ((emb (hashtable-ref embedded-resources path #f)))
|
||||||
|
(if (string? emb) emb (read-file-string path))))
|
||||||
|
|
||||||
(define (find-ns-file name) (resolve-on-roots (ns-name->rel name)))
|
(define (find-ns-file name) (resolve-on-roots (ns-name->rel name)))
|
||||||
|
|
||||||
|
|
@ -176,7 +193,7 @@
|
||||||
;; more forms", which would silently drop the entire rest of the file; here we
|
;; more forms", which would silently drop the entire rest of the file; here we
|
||||||
;; skip the no-op form and continue to true end-of-string.
|
;; skip the no-op form and continue to true end-of-string.
|
||||||
(define (load-jolt-file path)
|
(define (load-jolt-file path)
|
||||||
(let* ((src (read-file-string path)) (end (string-length src)))
|
(let* ((src (ldr-read-source path)) (end (string-length src)))
|
||||||
;; parameterize (not a bare set!) so a require nested in this file's ns form
|
;; parameterize (not a bare set!) so a require nested in this file's ns form
|
||||||
;; restores path when control returns to the rest of this file.
|
;; restores path when control returns to the rest of this file.
|
||||||
(parameterize ((rdr-source-file path)) ; list forms read here carry :file = path
|
(parameterize ((rdr-source-file path)) ; list forms read here carry :file = path
|
||||||
|
|
|
||||||
103
host/chez/stub/launcher.c
Normal file
103
host/chez/stub/launcher.c
Normal file
|
|
@ -0,0 +1,103 @@
|
||||||
|
/* launcher.c — the native stub for self-contained jolt binaries (jolt-eaj).
|
||||||
|
*
|
||||||
|
* A toolchain-free `jolt build` (and joltc itself) produces an executable by
|
||||||
|
* appending a Chez boot image to a copy of this prebuilt stub, framed as:
|
||||||
|
*
|
||||||
|
* [stub bytes][boot bytes][boot-length : little-endian u64]["JOLTBOOT"]
|
||||||
|
*
|
||||||
|
* (see host/chez/java/io.ss jolt-append-payload!). At startup the stub locates
|
||||||
|
* its own executable, reads the trailing 16-byte frame to find the boot, and
|
||||||
|
* hands the boot to the Chez kernel — no external boot file, no Chez install.
|
||||||
|
*
|
||||||
|
* Built once at joltc-build time against the Chez kernel (libkernel.a + scheme.h)
|
||||||
|
* by host/chez/build-joltc.ss; the resulting binary is embedded into joltc and
|
||||||
|
* copied per app build. Inherently per-platform (the boot targets the host
|
||||||
|
* machine-type), like a native compiler.
|
||||||
|
*/
|
||||||
|
#include "scheme.h"
|
||||||
|
#include <stdint.h>
|
||||||
|
#include <stdio.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <string.h>
|
||||||
|
|
||||||
|
#if defined(__APPLE__)
|
||||||
|
#include <mach-o/dyld.h>
|
||||||
|
static int self_path(char *buf, uint32_t size) {
|
||||||
|
/* _NSGetExecutablePath fills buf and reports the needed size on overflow. */
|
||||||
|
return _NSGetExecutablePath(buf, &size);
|
||||||
|
}
|
||||||
|
#else
|
||||||
|
#include <unistd.h>
|
||||||
|
static int self_path(char *buf, uint32_t size) {
|
||||||
|
ssize_t n = readlink("/proc/self/exe", buf, (size_t)size - 1);
|
||||||
|
if (n < 0) return -1;
|
||||||
|
buf[n] = '\0';
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#define JOLT_MAGIC "JOLTBOOT"
|
||||||
|
#define JOLT_MAGIC_LEN 8
|
||||||
|
#define JOLT_TRAILER_LEN 16 /* u64 length + 8-byte magic */
|
||||||
|
|
||||||
|
int main(int argc, char *argv[]) {
|
||||||
|
char path[4096];
|
||||||
|
if (self_path(path, (uint32_t)sizeof(path)) != 0) {
|
||||||
|
fprintf(stderr, "jolt: cannot resolve own executable path\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
FILE *f = fopen(path, "rb");
|
||||||
|
if (!f) { fprintf(stderr, "jolt: cannot open self for reading\n"); return 1; }
|
||||||
|
|
||||||
|
if (fseek(f, 0, SEEK_END) != 0) { fclose(f); return 1; }
|
||||||
|
long fsize = ftell(f);
|
||||||
|
if (fsize < JOLT_TRAILER_LEN) {
|
||||||
|
fprintf(stderr, "jolt: no boot payload (run was not produced by jolt build)\n");
|
||||||
|
fclose(f);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
unsigned char trailer[JOLT_TRAILER_LEN];
|
||||||
|
if (fseek(f, fsize - JOLT_TRAILER_LEN, SEEK_SET) != 0 ||
|
||||||
|
fread(trailer, 1, JOLT_TRAILER_LEN, f) != JOLT_TRAILER_LEN) {
|
||||||
|
fclose(f);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if (memcmp(trailer + 8, JOLT_MAGIC, JOLT_MAGIC_LEN) != 0) {
|
||||||
|
fprintf(stderr, "jolt: boot payload not found\n");
|
||||||
|
fclose(f);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint64_t boot_len = 0;
|
||||||
|
for (int i = 0; i < 8; i++)
|
||||||
|
boot_len |= ((uint64_t)trailer[i]) << (8 * i);
|
||||||
|
|
||||||
|
long boot_off = fsize - JOLT_TRAILER_LEN - (long)boot_len;
|
||||||
|
if (boot_off < 0) {
|
||||||
|
fprintf(stderr, "jolt: corrupt boot payload\n");
|
||||||
|
fclose(f);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The kernel keeps the boot bytes for the life of the process (demand-loaded),
|
||||||
|
* so this buffer is freed only after Sscheme_deinit. */
|
||||||
|
void *boot = malloc((size_t)boot_len);
|
||||||
|
if (!boot) { fclose(f); return 1; }
|
||||||
|
if (fseek(f, boot_off, SEEK_SET) != 0 ||
|
||||||
|
fread(boot, 1, (size_t)boot_len, f) != (size_t)boot_len) {
|
||||||
|
free(boot);
|
||||||
|
fclose(f);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
fclose(f);
|
||||||
|
|
||||||
|
Sscheme_init(0);
|
||||||
|
Sregister_boot_file_bytes("jolt", boot, (iptr)boot_len);
|
||||||
|
Sbuild_heap(0, 0);
|
||||||
|
int status = Sscheme_start(argc, (const char **)argv);
|
||||||
|
Sscheme_deinit();
|
||||||
|
free(boot);
|
||||||
|
return status;
|
||||||
|
}
|
||||||
Loading…
Add table
Add a link
Reference in a new issue