diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml index 057c20c..740ee4a 100644 --- a/.github/workflows/release.yml +++ b/.github/workflows/release.yml @@ -154,6 +154,10 @@ jobs: # dev-machine check — see jolt-8479). `make joltc-release`, not `make joltc`. - name: Build joltc (release) run: make joltc-release + env: + # Bake the release tag into the binary (build-joltc falls back to + # `git describe` when this is empty, e.g. a workflow_dispatch dry run). + JOLT_VERSION: ${{ startsWith(github.ref, 'refs/tags/') && github.ref_name || '' }} - name: Inspect the binary (Windows) if: runner.os == 'Windows' diff --git a/bin/joltc b/bin/joltc index dfb949d..c1dc162 100755 --- a/bin/joltc +++ b/bin/joltc @@ -14,5 +14,7 @@ # JOLT_PWD. root="$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd)" export JOLT_PWD="${JOLT_PWD:-$PWD}" +# Version for --version / banners: git describe of this checkout, else "dev". +export JOLT_VERSION="${JOLT_VERSION:-$(git -C "$root" describe --tags --always --dirty 2>/dev/null || echo dev)}" cd "$root" || exit 1 exec chez --script host/chez/cli.ss "$@" diff --git a/host/chez/build-joltc.ss b/host/chez/build-joltc.ss index bd4550e..d6d1132 100644 --- a/host/chez/build-joltc.ss +++ b/host/chez/build-joltc.ss @@ -46,6 +46,15 @@ (unless (or jb-release? (string=? jb-profile "debug")) (error 'build-joltc "profile must be \"release\" or \"debug\"" jb-profile)) +;; Version baked into the binary's saved heap. Prefer $JOLT_VERSION (CI sets it to +;; the release tag); else derive it from git in this checkout; else "dev". +(define jb-version + (let ((env (getenv "JOLT_VERSION"))) + (if (and env (> (string-length env) 0)) + env + (let ((s (bld-sh-capture "git describe --tags --always --dirty 2>/dev/null"))) + (if (> (string-length s) 0) s "dev"))))) + (define jb-build (string-append jb-out ".build")) (bld-check-toolchain) (bld-system (string-append "mkdir -p '" (path-parent jb-out) "' '" jb-build "'")) @@ -164,6 +173,10 @@ (jb-emit-runtime-embeds out) (put-string out "\n;; === embedded jolt-core + stdlib source ===\n") (jb-emit-source-embeds out) + ;; Bake the version into the saved heap (runs at heap-build; loader.ss defined + ;; jolt-baked-version above, so this set! resolves). + (put-string out (string-append "\n;; === baked version ===\n(set! jolt-baked-version " + (ei-str-lit jb-version) ")\n")) (put-string out "\n;; === joltc launcher ===\n") (jb-emit-launcher out) (close-port out)) diff --git a/host/chez/loader.ss b/host/chez/loader.ss index 00bd84a..4ea8bd1 100644 --- a/host/chez/loader.ss +++ b/host/chez/loader.ss @@ -384,3 +384,14 @@ (def-var! "jolt.host" "load-namespace" (lambda (n) (load-namespace n) jolt-nil)) (def-var! "jolt.host" "file-exists?" (lambda (p) (if (file-exists? p) #t #f))) (def-var! "jolt.host" "getenv" (lambda (n) (let ((v (getenv n))) (if v v jolt-nil)))) + +;; jolt version string. A self-contained binary build bakes the real tag into the +;; saved heap by emitting (set! jolt-baked-version "…") in flat.ss; a dev run off +;; the seed leaves it #f and falls back to $JOLT_VERSION (bin/joltc sets it from +;; `git describe`), then "dev". +(define jolt-baked-version #f) +(def-var! "jolt.host" "jolt-version" + (lambda () + (or jolt-baked-version + (let ((v (getenv "JOLT_VERSION"))) (and v (> (string-length v) 0) v)) + "dev"))) diff --git a/jolt-core/jolt/deps.clj b/jolt-core/jolt/deps.clj index 4ca6cc2..f7c6799 100644 --- a/jolt-core/jolt/deps.clj +++ b/jolt-core/jolt/deps.clj @@ -66,6 +66,10 @@ (if-let [root (:deps/root spec)] (str checkout "/" root) checkout)) (:jolt/module spec) (do (warn "skipping janet dependency " coord " (:jolt/module is obsolete on Chez)") nil) + ;; jolt IS Clojure — a dependency on org.clojure/clojure is satisfied + ;; intrinsically, so skip it silently rather than warning about the (unusable) + ;; :mvn/version coordinate. + (= coord 'org.clojure/clojure) nil :else (do (warn "skipping unsupported coordinate " coord " " (pr-str spec)) nil))) diff --git a/jolt-core/jolt/main.clj b/jolt-core/jolt/main.clj index a12f81c..1dbf8a6 100644 --- a/jolt-core/jolt/main.clj +++ b/jolt-core/jolt/main.clj @@ -8,6 +8,8 @@ (defn- project-dir [] (or (jolt.host/getenv "JOLT_PWD") ".")) +(defn- version [] (jolt.host/jolt-version)) + (defn- current-platform [] (let [os (str/lower-case (or (System/getProperty "os.name") ""))] (cond (str/includes? os "mac") :darwin @@ -145,7 +147,7 @@ ;; loaded — same context a run gets, so (require '[some.lib]) works in the REPL. (try (apply-project! (deps/resolve-project (project-dir))) (catch :default _ nil)) - (println ";; jolt repl — :repl/quit or ^D to exit") + (println (str ";; jolt " (version) " repl — :repl/quit or ^D to exit")) (loop [] (let [form (repl-read-form)] (when form @@ -294,7 +296,9 @@ (when stop (stop)))))) (defn- usage [] + (println (str "jolt " (version))) (println "usage: jolt [args]") + (println " -e EXPR evaluate EXPR and print the result") (println " run -m NS [args] resolve deps.edn, load NS, call its -main") (println " run FILE load a Clojure file") (println " build -m NS [-o OUT] [--opt|--dev] [--direct-link] [--tree-shake] [--dynamic] compile a standalone binary") @@ -304,6 +308,7 @@ (println " --nrepl-server [port] start an nREPL server (default 7888) for editors") (println " path print the resolved source roots") (println " run a deps.edn :tasks entry") + (println " --version print the jolt version") (println " --help print this message")) (defn -main [& args] @@ -312,6 +317,7 @@ (nil? cmd) (usage) (= cmd "--help") (usage) (= cmd "-h") (usage) + (#{"--version" "-V"} cmd) (println (str "jolt " (version))) (= cmd "run") (cmd-run more) (= cmd "repl") (repl) (= cmd "--nrepl-server") (nrepl more) diff --git a/jolt-core/jolt/nrepl.clj b/jolt-core/jolt/nrepl.clj index e73f92d..e7b55b2 100644 --- a/jolt-core/jolt/nrepl.clj +++ b/jolt-core/jolt/nrepl.clj @@ -21,25 +21,66 @@ [jolt.ffi :as ffi])) ;; --- sockets (loopback server) --------------------------------------------- -;; Load libc (the running process's symbols) BEFORE the foreign-fn bindings below -;; — defcfn resolves the C entry point when the def is evaluated (at ns load), so -;; the socket symbols must already be available. -(ffi/load-library) +(def ^:private os-name + (str/lower-case (or (System/getProperty "os.name") ""))) +(def ^:private macos? (str/includes? os-name "mac")) +(def ^:private windows? (str/includes? os-name "win")) + +;; Load the library that provides the socket symbols BEFORE the foreign-fn +;; bindings below — defcfn resolves the C entry point when the def is evaluated +;; (at ns load), so the symbols must already be available. POSIX: the running +;; process's own libc symbols. Windows: the Winsock DLL (ws2_32), whose symbols +;; are NOT in joltc.exe's export table even though it's linked in — without this +;; explicit load, (ffi/defcfn c-socket "socket" ...) fails at load with +;; "no entry for socket". +(if windows? + (ffi/load-library "ws2_32.dll") + (ffi/load-library)) + +;; A socket is an int fd on POSIX; on Win64 it's a SOCKET (uintptr_t) handle, but +;; those are small kernel handle values that round-trip through :int, and the +;; INVALID_SOCKET error sentinel (~0) reads back as -1 — so the fd checks below +;; work unchanged on both. (ffi/defcfn c-socket "socket" [:int :int :int] :int) (ffi/defcfn c-bind "bind" [:int :pointer :int] :int) (ffi/defcfn c-listen "listen" [:int :int] :int) (ffi/defcfn c-setsockopt "setsockopt" [:int :int :int :pointer :int] :int) - (ffi/defcfn c-accept "accept" [:int :pointer :pointer] :int :blocking) - (ffi/defcfn c-recv "recv" [:int :pointer :size_t :int] :ssize_t :blocking) - (ffi/defcfn c-send "send" [:int :pointer :size_t :int] :ssize_t :blocking) -(ffi/defcfn c-close "close" [:int] :int) +(ffi/defcfn c-accept "accept" [:int :pointer :pointer] :int :blocking) + +;; recv/send and the socket-close call differ by platform. Winsock's recv/send +;; take an int length and return int (not ssize_t), and a socket is closed with +;; closesocket, not close. A symbol that exists on only one OS (closesocket on +;; Windows, close on POSIX) can only be bound there, so these live in the taken +;; platform branch — jolt interns the vars from both branches at analysis time, +;; so later references resolve either way. +(if windows? + (do + (ffi/defcfn c-recv "recv" [:int :pointer :int :int] :int :blocking) + (ffi/defcfn c-send "send" [:int :pointer :int :int] :int :blocking) + (ffi/defcfn c-close "closesocket" [:int] :int) + ;; Winsock must be initialized once per process before any socket call. + (ffi/defcfn c-wsastartup "WSAStartup" [:int :pointer] :int)) + (do + (ffi/defcfn c-recv "recv" [:int :pointer :size_t :int] :ssize_t :blocking) + (ffi/defcfn c-send "send" [:int :pointer :size_t :int] :ssize_t :blocking) + (ffi/defcfn c-close "close" [:int] :int))) (def ^:private AF-INET 2) (def ^:private SOCK-STREAM 1) -(def ^:private macos? - (str/includes? (str/lower-case (or (System/getProperty "os.name") "")) "mac")) -(def ^:private sol-socket (if macos? 0xffff 1)) -(def ^:private so-reuse (if macos? 4 2)) +;; SOL_SOCKET / SO_REUSEADDR: 0xffff / 4 on macOS and Windows, 1 / 2 on Linux. +(def ^:private sol-socket (if (or macos? windows?) 0xffff 1)) +(def ^:private so-reuse (if (or macos? windows?) 4 2)) + +;; Initialize Winsock (a no-op off Windows). WSAStartup is refcounted and must +;; precede any socket call; WSADATA is ~408 bytes on x64, so 512 is ample. +(defn- ensure-winsock! [] + (when windows? + (let [wsadata (ffi/alloc 512)] + (try + (let [r (c-wsastartup 0x0202 wsadata)] + (when-not (zero? r) + (throw (ex-info (str "WSAStartup failed: " r) {})))) + (finally (ffi/free wsadata)))))) (defn- make-sockaddr [port] (let [sa (ffi/alloc 16)] @@ -53,7 +94,7 @@ sa)) (defn- listen-socket [port] - (ffi/load-library) ; libc process symbols + (ensure-winsock!) ; no-op off Windows (let [fd (c-socket AF-INET SOCK-STREAM 0)] (when (neg? fd) (throw (ex-info "socket() failed" {}))) (let [opt (ffi/alloc 4)] (ffi/write opt :int 0 1) (c-setsockopt fd sol-socket so-reuse opt 4) (ffi/free opt)) @@ -240,7 +281,8 @@ fd (listen-socket port) ; throws on bind/listen failure stopped (atom false)] (try (spit ".nrepl-port" (str port)) (catch :default _ nil)) - (println (str "nREPL server started on port " port " (127.0.0.1) — .nrepl-port written")) + (println (str "jolt " (jolt.host/jolt-version) " nREPL server started on port " + port " (127.0.0.1) — .nrepl-port written")) (when (seq middleware) (println (str ";; middleware: " (str/join " " middleware)))) (println ";; connect your editor; ^C to stop") (future