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