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
;; then no-ops (Windows delivers ^C through the console, not a per-thread mask).
(define c-pthread-sigmask
(guard (e (#t #f)) (foreign-procedure "pthread_sigmask" (int u8* u8*) int)))
(define c-sigemptyset (guard (e (#t #f)) (foreign-procedure "sigemptyset" (u8*) int)))
(define c-sigaddset (guard (e (#t #f)) (foreign-procedure "sigaddset" (u8* int) int)))
(jolt-foreign-proc-safe "pthread_sigmask" '(int u8* u8*) 'int))
(define c-sigemptyset (jolt-foreign-proc-safe "sigemptyset" '(u8*) '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,
;; 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".

View file

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

View file

@ -80,13 +80,18 @@
;; every Chez binary) — no external toolchain. Falls back to /bin/sh chmod if the
;; symbol can't be resolved.
(define jolt-chmod-755
(let ((c (guard (e (#t #f))
(load-shared-object #f)
(foreign-procedure "chmod" (string int) int))))
(let ((c (jolt-foreign-proc-safe "chmod" '(string int) 'int)))
(lambda (path)
(if c
(c path #o755)
(system (string-append "chmod 755 '" path "'"))))))
(cond
(c (c path #o755))
;; 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
;; 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.
(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/seq.ss")