simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

ffi: foreign-callable — receive callbacks from C

Browse source 
jolt could call C (foreign-fn -> foreign-procedure) but C could not call back
into jolt, which GTK signals (and any callback-taking C API) require. Add the
inverse: jolt.ffi/foreign-callable wraps a jolt fn as a C-callable function
pointer, mirroring the foreign-fn pipeline.

A new jolt.ffi/__ccallable special form carries the fn as a child expression
(analyzed + walked by the passes; ir.clj gains an :ffi-callable arm in both
child walks) plus literal arg/ret type keywords. The back end lowers it to a
locked Chez foreign-callable and returns its entry-point address as a jolt
pointer; host/chez/ffi.ss registers the code object so the collector keeps it,
and free-callable unlocks it. :collect-safe emits the convention that
reactivates the thread on entry, for callbacks fired while it is parked in a
:blocking call (a GTK main loop).

Test: ffi-binding-test.ss sorts an int array through libc qsort with a jolt
comparator (C -> jolt -> C). Re-minted seed.
This commit is contained in:
Yogthos 2026-06-23 09:54:32 -04:00
parent 91eed2b622
commit c91b6092bc
7 changed files with 178 additions and 70 deletions
Download patch file Download diff file Expand all files Collapse all files

24
test/chez/ffi-binding-test.ss
View file

@ -61,5 +61,29 @@
(let loop ((i 0)) (when (fx<? i 30000000) (loop (fx+ i 1)))) ; spin so the thread enters usleep
(ok "blocking ffi call is collect-safe" (guard (e (#t #f)) (collect) #t)))
;; callbacks: receive a call FROM C. A foreign-callable wraps a jolt fn as a
;; C-callable function pointer (what GTK signal handlers / qsort comparators need).
;; Build a comparator and sort an int array through libc qsort.
(ev "(def cmp (jolt.ffi/__ccallable
(fn [pa pb]
(let [a (jolt.ffi/read pa :int) b (jolt.ffi/read pb :int)]
(cond (< a b) -1 (> a b) 1 :else 0)))
[:pointer :pointer] :int))")
(ok "foreign-callable returns a pointer"
(let ((p (jnum->exact (var-deref "user" "cmp")))) (and (integer? p) (> p 0))))
(ev "(def c-qsort (jolt.ffi/__cfn \"qsort\" [:pointer :size_t :size_t :pointer] :void))")
(ok "C calls back into jolt: qsort with a jolt comparator"
(jolt-truthy?
(ev "(let [n 5 w (jolt.ffi/sizeof :int) p (jolt.ffi/alloc (* n w))]
(doseq [[i v] (map vector (range n) [3 1 4 1 5])]
(jolt.ffi/write p :int (* i w) v))
(c-qsort p n w cmp)
(let [out (mapv (fn [i] (jolt.ffi/read p :int (* i w))) (range n))]
(jolt.ffi/free p)
(= out [1 1 3 4 5])))")))
;; free-callable unlocks + drops the code object, returning nil.
(ok "free-callable releases the callback"
(jolt-nil? (ev "(jolt.ffi/free-callable cmp)")))
(printf "~a/~a passed~n" (- total fails) total)
(exit (if (zero? fails) 0 1))