nandi/frq · build-jolt-boot.bb

nandi/frqpublic⑂ Fork 0

⑂ bffe879efd6e16d866307e451e9a3568976fcdb2

build-jolt-boot.bb · 180 lines · 8.0 KBBlitzBasic    Blame HistoryRaw
Write the build in babashka, and pin the babashka   1
3exec "$(dirname "$0")/../scripts/bb" "$0" "$@"
6;; frq's Scheme, cross-compiled to an arm64 Chez boot image.
8;;   build-jolt-boot.bb OUTPUT_DIRECTORY   build the image
9;;   build-jolt-boot.bb --stamp            print what it would be built from
11;; The image is built from :paths alone — there is no dependency resolution
12;; inside a cross compile — so every source root deps.edn would have resolved
13;; is named here instead. Two of them are git dependencies, which means the
14;; jolt cache rather than a checkout; the shas come out of deps.edn so there is
15;; one place to bump them.
16(require '[babashka.classpath :as cp])
17(cp/add-classpath (str (babashka.fs/path (babashka.fs/parent *file*) ".." "scripts")))
18(require '[frq.paths :as paths]
19         '[babashka.fs :as fs]
20         '[babashka.process :as p]
21         '[clojure.string :as str])
23(def root (str (fs/canonicalize (fs/path (fs/parent *file*) ".."))))
24(def args *command-line-args*)
25(def stamp-only? (= "--stamp" (first args)))
27;; The DotSlash-pinned jolt, not whatever is on PATH: an upstream jolt cannot
28;; open a TLS connection on Android — it reads the socket address out of
29;; `struct addrinfo` at glibc's offset, which is Bionic's `ai_canonname` — so a
30;; build made with one produces an APK that cannot sign in or send a picture.
31;; Override with JOLT= to use another.
33;; DOTSLASH and JOLT_MANIFEST are set when buck runs this: the manifest and the
34;; fetcher are inputs to that action, so the machine running it needs neither
35;; jolt nor DotSlash installed, and a remote worker resolves the same pin
36;; against the same digest. Without them the shim beside this script answers,
37;; which is what a person at a terminal gets.
38
39  (or (paths/env "JOLT" nil)
40      (let [dotslash (paths/env "DOTSLASH" nil)
41            manifest (paths/env "JOLT_MANIFEST" nil)]
42        (if (and dotslash manifest)
43          (paths/out dotslash "--" "fetch" manifest)
44          (str (fs/path root "scripts" "jolt"))))))
Take every jolt-native half from the release, and only from there   46;; The two source roots that are not this repo's, asked of jolt rather than
47;; guessed at. `jolt path` prints what it resolved deps.edn to, which is the
48;; only thing that knows where a git dependency landed: a plain :git/sha goes
49;; to one cache layout and one with :deps/root to another, and glimmer and
50;; glimmer-vidya are one of each.
52;; GLIMMER and GLIMMER_VIDYA name them instead when a caller already knows.
53;; buck sets the second: the jolt cache cannot be an action input, so that
54;; build hands over the release archive it fetched by digest, and with both set
55;; nothing here shells out at all.
56
58    ;; From this tree, whatever directory the caller was in: deps.edn is what
59    ;; `path` reads.
60    (str/split (str/trim (:out (p/shell {:out :string :dir root} jolt "path"))) #":")))
62(defn root-of [k env pred]
63  (or (paths/env env nil)
64      (first (filter pred @roots))
65      (paths/die (str "jolt resolved no " (name k) " source root")
66                 "check the :deps in deps.edn")))
68;; Matched by name rather than by shape: a cache path carries the repo, the sha
69;; and — for a dependency with a :deps/root — the root inside it, and which of
70;; those it ends with is jolt's business, not this script's.
71(defn names? [root s] (str/includes? root s))
73(def glimmer-vidya
74  (root-of :glimmer-vidya "GLIMMER_VIDYA" #(names? % "glimmer-vidya")))
75(def glimmer
76  (root-of :glimmer "GLIMMER" #(and (names? % "glimmer")
77                                    (not (names? % "glimmer-vidya")))))
79(paths/require-paths! "Jolt source root" [glimmer glimmer-vidya])
Write the build in babashka, and pin the babashka   81(def module (paths/env "MODULE" "frq.app"))
82(def chez (paths/env "CHEZ_ANDROID" (str (fs/path (fs/home) ".cache" "vidya-chez-android"))))
83(def host-scheme (str (fs/path chez "ta6le" "bin" "ta6le" "scheme")))
84(def target-boot (fs/path chez "boot" "tarm64le"))
85(def xpatch (str (fs/path chez "xc-tarm64le" "s" "xpatch")))
87(paths/require-paths! "Android Chez artifact"
88                      [host-scheme (fs/path target-boot "petite.boot")
89                       (fs/path target-boot "scheme.boot")
90                       (fs/path target-boot "scheme.h") xpatch]
91                      "Build Chez's tarm64le cross target first.")
93(when-not (or (fs/executable? jolt) (fs/which jolt))
94  (paths/die (str "Jolt executable not found: " jolt)))
96;; The boot image is a pure function of the Scheme sources, the module name,
97;; the flat-split flag and Chez's own boot files — all static. Hash them, and
98;; skip the whole thing when the stamp still matches: a Rust-only APK rebuild
99;; has no reason to spend fifteen single-threaded seconds recompiling Scheme.
101;; The flag is part of the stamp on purpose. JOLT_NO_FLAT_SPLIT changes the
102;; shape of what `jolt build` emits, so an app.build/ left by an ordinary build
103;; is not reusable here; a stamp miss wipes the tree below, which is what the
104;; unconditional delete used to be defending against.
106;; The hash itself. Every input is hashed here rather than shelled out to
107;; sha256sum, so the stamp is one function to read.
108(defn sha256 [^bytes bs]
109  (->> (.digest (java.security.MessageDigest/getInstance "SHA-256") bs)
110       (map #(format "%02x" (bit-and % 0xff)))
111       (apply str)))
113(defn file-line [f]
114  (str (sha256 (fs/read-all-bytes (str f))) "  " f))
116(defn stamp []
117  (let [sources (->> [(fs/path root "src") glimmer glimmer-vidya]
118                     (mapcat #(fs/glob % "**.{jolt,edn}"))
119                     (map str)
121        lines (concat [module "JOLT_NO_FLAT_SPLIT=1"
122                       (try (paths/out jolt "--version") (catch Exception _ ""))]
123                      (map file-line sources)
124                      (map file-line [(fs/path target-boot "petite.boot")
125                                      (fs/path target-boot "scheme.boot")
127    (sha256 (.getBytes (str/join "\n" lines) "UTF-8"))))
129;; buck needs this before the work rather than after: the sources it hashes
130;; live in the jolt cache and in jolt-native, outside this cell, so nothing
131;; else makes them reach an action's digest. See the `buck` recipe in the
132;; justfile.
133(when stamp-only?
134  (println (stamp))
135  (System/exit 0))
137(def out-dir (or (first args)
138                 (paths/die "usage: build-jolt-boot.bb OUTPUT_DIRECTORY | --stamp")))
139(def stamp-file (fs/path out-dir "jolt.boot.stamp"))
140(def want (stamp))
142(when (and (fs/exists? (fs/path out-dir "jolt.boot"))
143           (fs/exists? (fs/path out-dir "scheme.h"))
144           (fs/exists? stamp-file)
145           (= want (str/trim (slurp (str stamp-file)))))
146  (binding [*out* *err*] (println "jolt boot image up to date"))
147  (System/exit 0))
149(fs/delete-if-exists stamp-file)
150(fs/delete-tree (fs/path out-dir "project"))
151(fs/delete-tree (fs/path out-dir "cross"))
152(fs/create-dirs (fs/path out-dir "project"))
153(fs/create-dirs (fs/path out-dir "cross"))
154(spit (str (fs/path out-dir "project" "deps.edn"))
155      (str "{:paths [\"" (fs/path root "src") "\" \"" glimmer "\" \"" glimmer-vidya "\"]}\n"))
157(p/shell {:dir (str (fs/path out-dir "project"))
158          :extra-env {"JOLT_NO_FLAT_SPLIT" "1"}}
159         jolt "build" "-m" module "-o" "app")
161(spit (str (fs/path out-dir "cross" "compile.ss"))
162      (str "(import (chezscheme))\n"
163           "(load \"" xpatch "\")\n"
164           "(optimize-level 2)\n"
165           "(generate-inspector-information #f)\n"
166           "(compile-file \"" (fs/path out-dir "project" "app.build" "flat.ss") "\""
167           " \"" (fs/path out-dir "cross" "flat.so") "\")\n"
168           "(make-boot-file \"" (fs/path out-dir "jolt.boot") "\" '()\n"
169           "  \"" (fs/path target-boot "petite.boot") "\"\n"
170           "  \"" (fs/path target-boot "scheme.boot") "\"\n"
171           "  \"" (fs/path out-dir "cross" "flat.so") "\")\n"))
173(p/shell {:extra-env {"SCHEMEHEAPDIRS" (str (fs/path chez "ta6le" "boot" "ta6le"))}}
174         host-scheme "--script" (str (fs/path out-dir "cross" "compile.ss")))
176(fs/copy (fs/path target-boot "scheme.h") (fs/path out-dir "scheme.h")
177         {:replace-existing true})
179;; Last, so an interrupted build leaves no stamp and the next run redoes it.
180(spit (str stamp-file) (str want "\n"))

Write the build in babashka, and pin the babashka 34832a8 nandi 18d ago	1	#!/bin/sh
	2	#_(
	3	exec "$(dirname "$0")/../scripts/bb" "$0" "$@"
	4	)
	5
	6	;; frq's Scheme, cross-compiled to an arm64 Chez boot image.
	7	;;
	8	;; build-jolt-boot.bb OUTPUT_DIRECTORY build the image
	9	;; build-jolt-boot.bb --stamp print what it would be built from
	10	;;
	11	;; The image is built from :paths alone — there is no dependency resolution
	12	;; inside a cross compile — so every source root deps.edn would have resolved
	13	;; is named here instead. Two of them are git dependencies, which means the
	14	;; jolt cache rather than a checkout; the shas come out of deps.edn so there is
	15	;; one place to bump them.
	16	(require '[babashka.classpath :as cp])
	17	(cp/add-classpath (str (babashka.fs/path (babashka.fs/parent file) ".." "scripts")))
	18	(require '[frq.paths :as paths]
	19	'[babashka.fs :as fs]
	20	'[babashka.process :as p]
	21	'[clojure.string :as str])
	22
	23	(def root (str (fs/canonicalize (fs/path (fs/parent file) ".."))))
	24	(def args command-line-args)
	25	(def stamp-only? (= "--stamp" (first args)))
	26
	27	;; The DotSlash-pinned jolt, not whatever is on PATH: an upstream jolt cannot
	28	;; open a TLS connection on Android — it reads the socket address out of
	29	;; `struct addrinfo` at glibc's offset, which is Bionic's `ai_canonname` — so a
	30	;; build made with one produces an APK that cannot sign in or send a picture.
	31	;; Override with JOLT= to use another.
	32	;;
	33	;; DOTSLASH and JOLT_MANIFEST are set when buck runs this: the manifest and the
	34	;; fetcher are inputs to that action, so the machine running it needs neither
	35	;; jolt nor DotSlash installed, and a remote worker resolves the same pin
	36	;; against the same digest. Without them the shim beside this script answers,
	37	;; which is what a person at a terminal gets.
	38	(def jolt
	39	(or (paths/env "JOLT" nil)
	40	(let [dotslash (paths/env "DOTSLASH" nil)
	41	manifest (paths/env "JOLT_MANIFEST" nil)]
	42	(if (and dotslash manifest)
	43	(paths/out dotslash "--" "fetch" manifest)
	44	(str (fs/path root "scripts" "jolt"))))))
	45
Take every jolt-native half from the release, and only from there a008d3b nandi 18d ago	46	;; The two source roots that are not this repo's, asked of jolt rather than
	47	;; guessed at. `jolt path` prints what it resolved deps.edn to, which is the
	48	;; only thing that knows where a git dependency landed: a plain :git/sha goes
	49	;; to one cache layout and one with :deps/root to another, and glimmer and
	50	;; glimmer-vidya are one of each.
	51	;;
	52	;; GLIMMER and GLIMMER_VIDYA name them instead when a caller already knows.
	53	;; buck sets the second: the jolt cache cannot be an action input, so that
	54	;; build hands over the release archive it fetched by digest, and with both set
	55	;; nothing here shells out at all.
	56	(def roots
	57	(delay
	58	;; From this tree, whatever directory the caller was in: deps.edn is what
	59	;; `path` reads.
	60	(str/split (str/trim (:out (p/shell {:out :string :dir root} jolt "path"))) #":")))
	61
	62	(defn root-of [k env pred]
	63	(or (paths/env env nil)
	64	(first (filter pred @roots))
	65	(paths/die (str "jolt resolved no " (name k) " source root")
	66	"check the :deps in deps.edn")))
	67
	68	;; Matched by name rather than by shape: a cache path carries the repo, the sha
	69	;; and — for a dependency with a :deps/root — the root inside it, and which of
	70	;; those it ends with is jolt's business, not this script's.
	71	(defn names? [root s] (str/includes? root s))
	72
	73	(def glimmer-vidya
	74	(root-of :glimmer-vidya "GLIMMER_VIDYA" #(names? % "glimmer-vidya")))
	75	(def glimmer
	76	(root-of :glimmer "GLIMMER" #(and (names? % "glimmer")
	77	(not (names? % "glimmer-vidya")))))
	78
	79	(paths/require-paths! "Jolt source root" [glimmer glimmer-vidya])
	80
Write the build in babashka, and pin the babashka 34832a8 nandi 18d ago	81	(def module (paths/env "MODULE" "frq.app"))
	82	(def chez (paths/env "CHEZ_ANDROID" (str (fs/path (fs/home) ".cache" "vidya-chez-android"))))
	83	(def host-scheme (str (fs/path chez "ta6le" "bin" "ta6le" "scheme")))
	84	(def target-boot (fs/path chez "boot" "tarm64le"))
	85	(def xpatch (str (fs/path chez "xc-tarm64le" "s" "xpatch")))
	86
	87	(paths/require-paths! "Android Chez artifact"
	88	[host-scheme (fs/path target-boot "petite.boot")
	89	(fs/path target-boot "scheme.boot")
	90	(fs/path target-boot "scheme.h") xpatch]
	91	"Build Chez's tarm64le cross target first.")
	92
	93	(when-not (or (fs/executable? jolt) (fs/which jolt))
	94	(paths/die (str "Jolt executable not found: " jolt)))
	95
	96	;; The boot image is a pure function of the Scheme sources, the module name,
	97	;; the flat-split flag and Chez's own boot files — all static. Hash them, and
	98	;; skip the whole thing when the stamp still matches: a Rust-only APK rebuild
	99	;; has no reason to spend fifteen single-threaded seconds recompiling Scheme.
	100	;;
	101	;; The flag is part of the stamp on purpose. JOLT_NO_FLAT_SPLIT changes the
	102	;; shape of what `jolt build` emits, so an app.build/ left by an ordinary build
	103	;; is not reusable here; a stamp miss wipes the tree below, which is what the
	104	;; unconditional delete used to be defending against.
	105
	106	;; The hash itself. Every input is hashed here rather than shelled out to
	107	;; sha256sum, so the stamp is one function to read.
	108	(defn sha256 [^bytes bs]
	109	(->> (.digest (java.security.MessageDigest/getInstance "SHA-256") bs)
	110	(map #(format "%02x" (bit-and % 0xff)))
	111	(apply str)))
	112
	113	(defn file-line [f]
	114	(str (sha256 (fs/read-all-bytes (str f))) " " f))
	115
	116	(defn stamp []
	117	(let [sources (->> [(fs/path root "src") glimmer glimmer-vidya]
	118	(mapcat #(fs/glob % "**.{jolt,edn}"))
	119	(map str)
	120	sort)
	121	lines (concat [module "JOLT_NO_FLAT_SPLIT=1"
	122	(try (paths/out jolt "--version") (catch Exception _ ""))]
	123	(map file-line sources)
	124	(map file-line [(fs/path target-boot "petite.boot")
	125	(fs/path target-boot "scheme.boot")
	126	xpatch]))]
	127	(sha256 (.getBytes (str/join "\n" lines) "UTF-8"))))
	128
	129	;; buck needs this before the work rather than after: the sources it hashes
	130	;; live in the jolt cache and in jolt-native, outside this cell, so nothing
	131	;; else makes them reach an action's digest. See the `buck` recipe in the
	132	;; justfile.
	133	(when stamp-only?
	134	(println (stamp))
	135	(System/exit 0))
	136
	137	(def out-dir (or (first args)
	138	(paths/die "usage: build-jolt-boot.bb OUTPUT_DIRECTORY \| --stamp")))
	139	(def stamp-file (fs/path out-dir "jolt.boot.stamp"))
	140	(def want (stamp))
	141
	142	(when (and (fs/exists? (fs/path out-dir "jolt.boot"))
	143	(fs/exists? (fs/path out-dir "scheme.h"))
	144	(fs/exists? stamp-file)
145	(= want (str/trim (slurp (str stamp-file)))))
146	(binding [out err] (println "jolt boot image up to date"))
147	(System/exit 0))
148
149	(fs/delete-if-exists stamp-file)
150	(fs/delete-tree (fs/path out-dir "project"))
151	(fs/delete-tree (fs/path out-dir "cross"))
152	(fs/create-dirs (fs/path out-dir "project"))
153	(fs/create-dirs (fs/path out-dir "cross"))
154	(spit (str (fs/path out-dir "project" "deps.edn"))
155	(str "{:paths [\"" (fs/path root "src") "\" \"" glimmer "\" \"" glimmer-vidya "\"]}\n"))
156
157	(p/shell {:dir (str (fs/path out-dir "project"))
158	:extra-env {"JOLT_NO_FLAT_SPLIT" "1"}}
159	jolt "build" "-m" module "-o" "app")
160
161	(spit (str (fs/path out-dir "cross" "compile.ss"))
162	(str "(import (chezscheme))\n"
163	"(load \"" xpatch "\")\n"
164	"(optimize-level 2)\n"
165	"(generate-inspector-information #f)\n"
166	"(compile-file \"" (fs/path out-dir "project" "app.build" "flat.ss") "\""
167	" \"" (fs/path out-dir "cross" "flat.so") "\")\n"
168	"(make-boot-file \"" (fs/path out-dir "jolt.boot") "\" '()\n"
169	" \"" (fs/path target-boot "petite.boot") "\"\n"
170	" \"" (fs/path target-boot "scheme.boot") "\"\n"
171	" \"" (fs/path out-dir "cross" "flat.so") "\")\n"))
172
173	(p/shell {:extra-env {"SCHEMEHEAPDIRS" (str (fs/path chez "ta6le" "boot" "ta6le"))}}
174	host-scheme "--script" (str (fs/path out-dir "cross" "compile.ss")))
175
176	(fs/copy (fs/path target-boot "scheme.h") (fs/path out-dir "scheme.h")
177	{:replace-existing true})
178
179	;; Last, so an interrupted build leaves no stamp and the next run redoes it.
180	(spit (str stamp-file) (str want "\n"))