Resolve optional libc entries at runtime, not boot load

A literal (foreign-procedure "chmod" ...) in compiled code becomes a fasl
relocation resolved when the boot loads — on Windows (no chmod/sigemptyset/
sigaddset in the CRT) that killed joltc.exe before any guard could run
(msvcrt abort, exit 3). jolt-foreign-proc-safe defers the lookup through
eval at evaluation time, where the guard works and a missing entry just
yields the fallback. chmod also skips the /bin/sh fallback on nt (execute
is by extension).
This commit is contained in:
Yogthos 2026-07-02 18:36:40 -04:00
parent 225073a11b
commit af12f77dcd
4 changed files with 26 additions and 12 deletions

View file

@ -579,9 +579,9 @@
;; pthread_sigmask"). Guard so a non-POSIX host yields #f; jolt-set-sigint-blocked ;; pthread_sigmask"). Guard so a non-POSIX host yields #f; jolt-set-sigint-blocked
;; then no-ops (Windows delivers ^C through the console, not a per-thread mask). ;; then no-ops (Windows delivers ^C through the console, not a per-thread mask).
(define c-pthread-sigmask (define c-pthread-sigmask
(guard (e (#t #f)) (foreign-procedure "pthread_sigmask" (int u8* u8*) int))) (jolt-foreign-proc-safe "pthread_sigmask" '(int u8* u8*) 'int))
(define c-sigemptyset (guard (e (#t #f)) (foreign-procedure "sigemptyset" (u8*) int))) (define c-sigemptyset (jolt-foreign-proc-safe "sigemptyset" '(u8*) 'int))
(define c-sigaddset (guard (e (#t #f)) (foreign-procedure "sigaddset" (u8* int) int))) (define c-sigaddset (jolt-foreign-proc-safe "sigaddset" '(u8* int) 'int))
;; POSIX SIG_BLOCK/SIG_UNBLOCK numerics differ by platform: Linux/glibc 0/1, ;; POSIX SIG_BLOCK/SIG_UNBLOCK numerics differ by platform: Linux/glibc 0/1,
;; Darwin/macOS 1/2 (SIG_UNBLOCK is SIG_BLOCK+1 on both). Resolve SIG_BLOCK for ;; Darwin/macOS 1/2 (SIG_UNBLOCK is SIG_BLOCK+1 on both). Resolve SIG_BLOCK for
;; this host from the machine-type symbol — macOS builds contain "osx". ;; this host from the machine-type symbol — macOS builds contain "osx".

View file

@ -55,9 +55,7 @@
(lambda () (lambda ()
(unless tried? (unless tried?
(set! tried? #t) (set! tried? #t)
(set! fp (guard (e (#t #f)) (set! fp (jolt-foreign-proc-safe "sched_yield" '() 'int)))
(load-shared-object #f)
(foreign-procedure "sched_yield" () int))))
(if fp (fp) (sleep (make-time 'time-duration 0 0))) (if fp (fp) (sleep (make-time 'time-duration 0 0)))
jolt-nil))) jolt-nil)))

View file

@ -80,13 +80,18 @@
;; every Chez binary) — no external toolchain. Falls back to /bin/sh chmod if the ;; every Chez binary) — no external toolchain. Falls back to /bin/sh chmod if the
;; symbol can't be resolved. ;; symbol can't be resolved.
(define jolt-chmod-755 (define jolt-chmod-755
(let ((c (guard (e (#t #f)) (let ((c (jolt-foreign-proc-safe "chmod" '(string int) 'int)))
(load-shared-object #f)
(foreign-procedure "chmod" (string int) int))))
(lambda (path) (lambda (path)
(if c (cond
(c path #o755) (c (c path #o755))
(system (string-append "chmod 755 '" path "'")))))) ;; Windows has no chmod and needs none (execute is by extension)
((let ((m (symbol->string (machine-type))))
(let loop ((i 0))
(cond ((> (+ i 2) (string-length m)) #f)
((string=? (substring m i (+ i 2)) "nt") #t)
(else (loop (+ i 1))))))
0)
(else (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

View file

@ -11,6 +11,17 @@
;; Emitted programs do `(load "host/chez/rt.ss")`; this loads values.ss in turn. ;; Emitted programs do `(load "host/chez/rt.ss")`; this loads values.ss in turn.
(load "host/chez/values.ss") (load "host/chez/values.ss")
;; Resolve a libc entry point at RUN time. A literal (foreign-procedure "name" …)
;; in COMPILED code becomes a fasl relocation resolved when the boot loads — on a
;; platform lacking the symbol (chmod/sigaddset on Windows) that kills the boot
;; before any guard can run. eval defers the lookup to evaluation time, where the
;; guard works; returns #f when the entry doesn't exist.
(define (jolt-foreign-proc-safe name args res)
(guard (e (#t #f))
(load-shared-object #f)
(and (foreign-entry? name)
(eval `(foreign-procedure ,name ,args ,res)))))
(load "host/chez/collections.ss") (load "host/chez/collections.ss")
(load "host/chez/seq.ss") (load "host/chez/seq.ss")