rickub
Sign in Get started
nandi/frqpublic⑂ Fork 0
⑂ 43cc3f0376f08659dea357cd994b3b465d00d9aa
Branches
claude/add-remote-repository-47d12e main View all branches → View all tags →
Commits
⬇ Clone ▾
git clone https://git.rickub.com/nandi/frq.git
git clone ssh://git@rickub.com/nandi/frq.git

Host key fingerprint (ed25519): SHA256:iycHnxEyq0Q7uyVpB7JlznP0G7JrTPXLYRcAU5CSLhc — verify it before your first connect.

build-jolt-boot.bb · 169 lines · 7.6 KBBlitzBasic Blame HistoryRaw
Write the build in babashka, and pin the babashka 34832a8 nandi 18d ago1#!/bin/sh
2#_(
3exec "$(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 jolt-native (paths/jolt-native root))
25(def args *command-line-args*)
26(def stamp-only? (= "--stamp" (first args)))
27
28(def glimmer
29 (paths/env "GLIMMER"
30 (str (fs/path (fs/home) ".jolt" "gitlibs"
31 "https___gitlab.com_nandithebull_glimmer"
32 (paths/dep-sha root "https://gitlab.com/nandithebull/glimmer")
33 "src"))))
34
35;; glimmer-vidya lives inside jolt-native, so a sibling checkout answers for it
36;; the way it answers for libvidya; the cache is the fallback, at the sha
37;; deps.edn pins.
38(def glimmer-vidya
39 (or (paths/env "GLIMMER_VIDYA" nil)
40 (let [in-checkout (fs/path jolt-native "jolt" "glimmer-vidya" "src")]
41 (if (fs/directory? in-checkout)
42 (str in-checkout)
43 (str (fs/path (fs/home) ".jolt" "gitlibs"
44 "https___gitlab.com_nandithebull_jolt-native"
45 (paths/dep-sha root "https://gitlab.com/nandithebull/jolt-native")
46 "jolt" "glimmer-vidya" "src"))))))
47
48(paths/require-paths! "Jolt source root" [glimmer glimmer-vidya]
49 "run `jolt -M:frq --help` once to populate the git cache")
50
51;; The DotSlash-pinned jolt, not whatever is on PATH: an upstream jolt cannot
52;; open a TLS connection on Android — it reads the socket address out of
53;; `struct addrinfo` at glibc's offset, which is Bionic's `ai_canonname` — so a
54;; build made with one produces an APK that cannot sign in or send a picture.
55;; Override with JOLT= to use another.
56;;
57;; DOTSLASH and JOLT_MANIFEST are set when buck runs this: the manifest and the
58;; fetcher are inputs to that action, so the machine running it needs neither
59;; jolt nor DotSlash installed, and a remote worker resolves the same pin
60;; against the same digest. Without them the shim beside this script answers,
61;; which is what a person at a terminal gets.
62(def jolt
63 (or (paths/env "JOLT" nil)
64 (let [dotslash (paths/env "DOTSLASH" nil)
65 manifest (paths/env "JOLT_MANIFEST" nil)]
66 (if (and dotslash manifest)
67 (paths/out dotslash "--" "fetch" manifest)
68 (str (fs/path root "scripts" "jolt"))))))
69
70(def module (paths/env "MODULE" "frq.app"))
71(def chez (paths/env "CHEZ_ANDROID" (str (fs/path (fs/home) ".cache" "vidya-chez-android"))))
72(def host-scheme (str (fs/path chez "ta6le" "bin" "ta6le" "scheme")))
73(def target-boot (fs/path chez "boot" "tarm64le"))
74(def xpatch (str (fs/path chez "xc-tarm64le" "s" "xpatch")))
75
76(paths/require-paths! "Android Chez artifact"
77 [host-scheme (fs/path target-boot "petite.boot")
78 (fs/path target-boot "scheme.boot")
79 (fs/path target-boot "scheme.h") xpatch]
80 "Build Chez's tarm64le cross target first.")
81
82(when-not (or (fs/executable? jolt) (fs/which jolt))
83 (paths/die (str "Jolt executable not found: " jolt)))
84
85;; The boot image is a pure function of the Scheme sources, the module name,
86;; the flat-split flag and Chez's own boot files — all static. Hash them, and
87;; skip the whole thing when the stamp still matches: a Rust-only APK rebuild
88;; has no reason to spend fifteen single-threaded seconds recompiling Scheme.
89;;
90;; The flag is part of the stamp on purpose. JOLT_NO_FLAT_SPLIT changes the
91;; shape of what `jolt build` emits, so an app.build/ left by an ordinary build
92;; is not reusable here; a stamp miss wipes the tree below, which is what the
93;; unconditional delete used to be defending against.
94
95;; The hash itself. Every input is hashed here rather than shelled out to
96;; sha256sum, so the stamp is one function to read.
97(defn sha256 [^bytes bs]
98 (->> (.digest (java.security.MessageDigest/getInstance "SHA-256") bs)
99 (map #(format "%02x" (bit-and % 0xff)))
100 (apply str)))
101
102(defn file-line [f]
103 (str (sha256 (fs/read-all-bytes (str f))) " " f))
104
105(defn stamp []
106 (let [sources (->> [(fs/path root "src") glimmer glimmer-vidya]
107 (mapcat #(fs/glob % "**.{jolt,edn}"))
108 (map str)
109 sort)
110 lines (concat [module "JOLT_NO_FLAT_SPLIT=1"
111 (try (paths/out jolt "--version") (catch Exception _ ""))]
112 (map file-line sources)
113 (map file-line [(fs/path target-boot "petite.boot")
114 (fs/path target-boot "scheme.boot")
115 xpatch]))]
116 (sha256 (.getBytes (str/join "\n" lines) "UTF-8"))))
117
118;; buck needs this before the work rather than after: the sources it hashes
119;; live in the jolt cache and in jolt-native, outside this cell, so nothing
120;; else makes them reach an action's digest. See the `buck` recipe in the
121;; justfile.
122(when stamp-only?
123 (println (stamp))
124 (System/exit 0))
125
126(def out-dir (or (first args)
127 (paths/die "usage: build-jolt-boot.bb OUTPUT_DIRECTORY | --stamp")))
128(def stamp-file (fs/path out-dir "jolt.boot.stamp"))
129(def want (stamp))
130
131(when (and (fs/exists? (fs/path out-dir "jolt.boot"))
132 (fs/exists? (fs/path out-dir "scheme.h"))
133 (fs/exists? stamp-file)
134 (= want (str/trim (slurp (str stamp-file)))))
135 (binding [*out* *err*] (println "jolt boot image up to date"))
136 (System/exit 0))
137
138(fs/delete-if-exists stamp-file)
139(fs/delete-tree (fs/path out-dir "project"))
140(fs/delete-tree (fs/path out-dir "cross"))
141(fs/create-dirs (fs/path out-dir "project"))
142(fs/create-dirs (fs/path out-dir "cross"))
143(spit (str (fs/path out-dir "project" "deps.edn"))
144 (str "{:paths [\"" (fs/path root "src") "\" \"" glimmer "\" \"" glimmer-vidya "\"]}\n"))
145
146(p/shell {:dir (str (fs/path out-dir "project"))
147 :extra-env {"JOLT_NO_FLAT_SPLIT" "1"}}
148 jolt "build" "-m" module "-o" "app")
149
150(spit (str (fs/path out-dir "cross" "compile.ss"))
151 (str "(import (chezscheme))\n"
152 "(load \"" xpatch "\")\n"
153 "(optimize-level 2)\n"
154 "(generate-inspector-information #f)\n"
155 "(compile-file \"" (fs/path out-dir "project" "app.build" "flat.ss") "\""
156 " \"" (fs/path out-dir "cross" "flat.so") "\")\n"
157 "(make-boot-file \"" (fs/path out-dir "jolt.boot") "\" '()\n"
158 " \"" (fs/path target-boot "petite.boot") "\"\n"
159 " \"" (fs/path target-boot "scheme.boot") "\"\n"
160 " \"" (fs/path out-dir "cross" "flat.so") "\")\n"))
161
162(p/shell {:extra-env {"SCHEMEHEAPDIRS" (str (fs/path chez "ta6le" "boot" "ta6le"))}}
163 host-scheme "--script" (str (fs/path out-dir "cross" "compile.ss")))
164
165(fs/copy (fs/path target-boot "scheme.h") (fs/path out-dir "scheme.h")
166 {:replace-existing true})
167
168;; Last, so an interrupted build leaves no stamp and the next run redoes it.
169(spit (str stamp-file) (str want "\n"))