Add a Clojure FFI so libraries can bind native code (jolt.ffi)
A jolt library can now bind its own native dependencies and expose a Clojure API over them — no jolt built-in required. This is the foundation for moving the http-client / db / adapter functionality out of the host and into real libraries. - jolt.ffi/foreign-fn (sugar: defcfn) is a compiler special form: a compile-time -typed C signature lowers to a real Chez foreign-procedure (analyzer :ffi-fn -> backend foreign-procedure), so calls are typed and marshaled, not eval'd. - host/chez/ffi.ss provides the rest under jolt.ffi: load-library, alloc/free, read/write/sizeof, ptr<->string, null/null?. Loaded after the loader snapshot so a library's (require '[jolt.ffi]) still loads the macro side. - Types: int/uint/long/ulong/int64/uint64/size_t/ssize_t/iptr/uptr/double/float/ pointer/string/void/uint8/char. Validated end to end: a pure-Clojure file binds libc (getpid/strlen/abs) and libsqlite3 (open/prepare/step/column/finalize over out-param pointers) and runs a query. Gate test test/chez/ffi-binding-test.ss (make ffi); selfhost holds.
This commit is contained in:
parent
ccf93c896a
commit
537cb360b4
8 changed files with 282 additions and 62 deletions
1
Makefile
1
Makefile
|
|
@ -45,6 +45,7 @@ sci:
|
|||
# FFI + threading: HTTP server GC-safety (blocking calls deactivate the thread)
|
||||
# and http-client temp-file uniqueness, plus a live request.
|
||||
ffi:
|
||||
@chez --script test/chez/ffi-binding-test.ss
|
||||
@chez --script test/chez/ffi-server-test.ss
|
||||
|
||||
# Transients: mutable backing, snapshot on persistent!, and linear-time builds.
|
||||
|
|
|
|||
|
|
@ -22,8 +22,12 @@
|
|||
(load "host/chez/png.ss") ; jolt.png — a baked namespace before the snapshot
|
||||
(load "host/chez/http-client.ss") ; jolt.http-client (libcurl)
|
||||
(load "host/chez/sqlite.ss") ; jolt.sqlite + jdbc.core (libsqlite3)
|
||||
(load "host/chez/http-server.ss") ; jolt.http.server + ring-janet.adapter (BSD sockets)
|
||||
(load "host/chez/http-server.ss") ; jolt.http.server (BSD sockets)
|
||||
(load "host/chez/loader.ss")
|
||||
;; jolt.ffi host primitives (memory / library loading) load AFTER the loader's
|
||||
;; baked-ns snapshot, so a library's (require '[jolt.ffi]) still loads jolt.ffi's
|
||||
;; Clojure side (the foreign-fn / defcfn macros, src/jolt/jolt/ffi.clj).
|
||||
(load "host/chez/ffi.ss") ; jolt.ffi (FFI: a library binds native code)
|
||||
|
||||
;; jolt.main + jolt.deps live under jolt-core; keep them (and src/jolt) on the
|
||||
;; roots so the CLI's own namespaces — and any jolt.* an app pulls in — resolve.
|
||||
|
|
|
|||
98
host/chez/ffi.ss
Normal file
98
host/chez/ffi.ss
Normal file
|
|
@ -0,0 +1,98 @@
|
|||
;; ffi.ss — the runtime side of jolt's foreign-function interface (jolt.ffi).
|
||||
;;
|
||||
;; A jolt LIBRARY binds native code itself: it loads a shared object and declares
|
||||
;; typed foreign functions, then exposes a Clojure API. The TYPED CALL is lowered
|
||||
;; at compile time to a Chez `foreign-procedure` by the backend (the
|
||||
;; `jolt.ffi/foreign-fn` special form) — this file provides everything that does
|
||||
;; NOT need compile-time types: loading libraries, allocating/reading/writing
|
||||
;; foreign memory, and string/pointer marshaling. All exposed under `jolt.ffi`.
|
||||
;;
|
||||
;; A foreign pointer is a Chez machine address (an exact integer / uptr), the same
|
||||
;; representation `void*` arguments and results use, so pointers flow between
|
||||
;; foreign-fn calls and these helpers transparently.
|
||||
|
||||
;; --- loading shared objects --------------------------------------------------
|
||||
;; (jolt.ffi/load-library name) loads a .so/.dylib by name (resolved by the OS
|
||||
;; loader against the standard search paths). A library typically calls this once
|
||||
;; at load with a platform-specific name. (load-library) with no name (or #f)
|
||||
;; loads the running process's own symbols (libc, sockets).
|
||||
(define (ffi-load-library . args)
|
||||
(if (or (null? args) (jolt-nil? (car args)))
|
||||
(begin (load-shared-object #f) jolt-nil)
|
||||
(begin (load-shared-object (jolt-str-render-one (car args))) jolt-nil)))
|
||||
|
||||
(define (ffi-loaded? name)
|
||||
(guard (e (#t #f)) (load-shared-object (jolt-str-render-one name)) #t))
|
||||
|
||||
;; --- foreign type keywords ---------------------------------------------------
|
||||
;; The keyword type names jolt.ffi accepts (in foreign-fn signatures and the
|
||||
;; memory accessors) map to Chez foreign types. Kept in one place so the backend
|
||||
;; (compile-time, for foreign-procedure) and these accessors (runtime, for
|
||||
;; foreign-ref/set!) agree.
|
||||
(define (ffi-type->chez kw)
|
||||
(let ((n (if (keyword-t? kw) (keyword-t-name kw) (jolt-str-render-one kw))))
|
||||
(cond
|
||||
((string=? n "int") 'int)
|
||||
((string=? n "uint") 'unsigned-int)
|
||||
((string=? n "long") 'long)
|
||||
((string=? n "ulong") 'unsigned-long)
|
||||
((string=? n "int64") 'integer-64)
|
||||
((string=? n "uint64") 'unsigned-64)
|
||||
((string=? n "size_t") 'size_t)
|
||||
((string=? n "ssize_t") 'ssize_t)
|
||||
((string=? n "iptr") 'iptr)
|
||||
((string=? n "uptr") 'uptr)
|
||||
((string=? n "double") 'double)
|
||||
((string=? n "float") 'float)
|
||||
((or (string=? n "pointer") (string=? n "void*")) 'void*)
|
||||
((string=? n "string") 'string)
|
||||
((string=? n "void") 'void)
|
||||
((or (string=? n "uint8") (string=? n "u8") (string=? n "byte")) 'unsigned-8)
|
||||
((string=? n "char") 'char)
|
||||
(else (error #f (string-append "jolt.ffi: unknown foreign type :" n))))))
|
||||
|
||||
;; --- foreign memory ----------------------------------------------------------
|
||||
;; alloc returns a pointer (integer address). The caller frees it. read/write take
|
||||
;; a type keyword and an optional byte offset.
|
||||
(define (ffi-alloc nbytes) (foreign-alloc (jnum->exact nbytes)))
|
||||
(define (ffi-free ptr) (foreign-free (jnum->exact ptr)) jolt-nil)
|
||||
(define (ffi-read ptr ty . off)
|
||||
(foreign-ref (ffi-type->chez ty) (jnum->exact ptr) (if (pair? off) (jnum->exact (car off)) 0)))
|
||||
(define (ffi-write ptr ty off val)
|
||||
(foreign-set! (ffi-type->chez ty) (jnum->exact ptr) (jnum->exact off) val) jolt-nil)
|
||||
;; sizeof a foreign type (for laying out structs / arrays).
|
||||
(define (ffi-sizeof ty) (foreign-sizeof (ffi-type->chez ty)))
|
||||
(define (ffi-null? ptr) (and (number? ptr) (= (jnum->exact ptr) 0)))
|
||||
(define ffi-null 0)
|
||||
|
||||
;; --- string / bytevector marshaling ------------------------------------------
|
||||
;; A C string result already comes back as a jolt string (the `string` foreign
|
||||
;; type). For a `void*` that points at a NUL-terminated C string, read it here.
|
||||
(define (ffi-ptr->string ptr)
|
||||
(if (ffi-null? ptr) jolt-nil
|
||||
(let ((p (jnum->exact ptr)))
|
||||
(let loop ((i 0) (acc '()))
|
||||
(let ((b (foreign-ref 'unsigned-8 p i)))
|
||||
(if (= b 0) (utf8->string (u8-list->bytevector (reverse acc)))
|
||||
(loop (+ i 1) (cons b acc))))))))
|
||||
;; Copy a jolt string's UTF-8 bytes into a freshly alloc'd NUL-terminated buffer;
|
||||
;; the caller frees it. Returns the pointer.
|
||||
(define (ffi-string->ptr s)
|
||||
(let* ((bv (string->utf8 (jolt-str-render-one s))) (n (bytevector-length bv))
|
||||
(p (foreign-alloc (+ n 1))))
|
||||
(do ((i 0 (+ i 1))) ((= i n)) (foreign-set! 'unsigned-8 p i (bytevector-u8-ref bv i)))
|
||||
(foreign-set! 'unsigned-8 p n 0)
|
||||
p))
|
||||
|
||||
;; --- expose under jolt.ffi ---------------------------------------------------
|
||||
(def-var! "jolt.ffi" "load-library" ffi-load-library)
|
||||
(def-var! "jolt.ffi" "loaded?" (lambda (n) (if (ffi-loaded? n) #t #f)))
|
||||
(def-var! "jolt.ffi" "alloc" ffi-alloc)
|
||||
(def-var! "jolt.ffi" "free" ffi-free)
|
||||
(def-var! "jolt.ffi" "read" ffi-read)
|
||||
(def-var! "jolt.ffi" "write" ffi-write)
|
||||
(def-var! "jolt.ffi" "sizeof" ffi-sizeof)
|
||||
(def-var! "jolt.ffi" "null?" (lambda (p) (if (ffi-null? p) #t #f)))
|
||||
(def-var! "jolt.ffi" "null" ffi-null)
|
||||
(def-var! "jolt.ffi" "ptr->string" ffi-ptr->string)
|
||||
(def-var! "jolt.ffi" "string->ptr" ffi-string->ptr)
|
||||
File diff suppressed because one or more lines are too long
|
|
@ -393,6 +393,20 @@
|
|||
(defn- analyze-ctor [ctx class args env]
|
||||
(host-new class (mapv #(analyze ctx % env) args)))
|
||||
|
||||
;; jolt.ffi/__cfn (jolt-ffi): the low-level foreign-function form a jolt library
|
||||
;; uses (via the jolt.ffi/foreign-fn macro) to bind native code. Shape:
|
||||
;; (jolt.ffi/__cfn "c_symbol" [:argtype ...] :rettype)
|
||||
;; The C symbol is a string literal and the types are literal keywords, read here
|
||||
;; at compile time; the Chez back end lowers it to a real `foreign-procedure`
|
||||
;; (typed marshaling, no runtime eval). A leaf IR node.
|
||||
(defn- analyze-ffi-fn [ctx items env]
|
||||
(when (not= 4 (count items))
|
||||
(throw (str "jolt.ffi/foreign-fn expects (foreign-fn \"sym\" [argtypes] rettype)")))
|
||||
{:op :ffi-fn
|
||||
:csym (nth items 1)
|
||||
:argtypes (mapv name (form-vec-items (nth items 2)))
|
||||
:rettype (name (nth items 3))})
|
||||
|
||||
;; The `.` special form: `(. target member arg*)` — member access / method call.
|
||||
;; A symbol member whose name starts with "-" is a field read; otherwise it is a
|
||||
;; method (call with the trailing args). Both lower to a :host-call carrying the
|
||||
|
|
@ -476,6 +490,11 @@
|
|||
;; read -> macroexpand -> analyze. A local shadows both.
|
||||
(and (form-sym? head) (not shadowed) (form-macro? ctx head))
|
||||
(analyze ctx (form-expand-1 ctx form) env)
|
||||
;; jolt.ffi/__cfn — the foreign-function special form (always emitted
|
||||
;; fully-qualified by the jolt.ffi/foreign-fn macro, so aliases resolve).
|
||||
(and (form-sym? head) (= "jolt.ffi" (form-sym-ns head))
|
||||
(= "__cfn" (form-sym-name head)))
|
||||
(analyze-ffi-fn ctx items env)
|
||||
;; special-form heads are NOT shadowable (unlike macros): a local named
|
||||
;; `if` does not change the meaning of (if …) in operator position, per
|
||||
;; spec §3 and the reference. No (not shadowed) guard here.
|
||||
|
|
|
|||
|
|
@ -279,6 +279,23 @@
|
|||
body (binding [*recur-target* label] (emit (:body node)))]
|
||||
(str "(let* (" seq-bs ") (let " label " (" rebinds ") " body "))")))
|
||||
|
||||
;; jolt.ffi/__cfn -> a Chez foreign-procedure (jolt-ffi). The C symbol + types are
|
||||
;; compile-time literals from the analyzer, so this emits a real typed binding;
|
||||
;; the resulting Scheme procedure is callable like any jolt fn. The library must
|
||||
;; have loaded the shared object (jolt.ffi/load-library) before this def runs.
|
||||
(def ^:private ffi-types
|
||||
{"int" "int" "uint" "unsigned-int" "long" "long" "ulong" "unsigned-long"
|
||||
"int64" "integer-64" "uint64" "unsigned-64" "size_t" "size_t" "ssize_t" "ssize_t"
|
||||
"iptr" "iptr" "uptr" "uptr" "double" "double" "float" "float"
|
||||
"pointer" "void*" "void*" "void*" "string" "string" "void" "void"
|
||||
"uint8" "unsigned-8" "u8" "unsigned-8" "byte" "unsigned-8" "char" "char"})
|
||||
(defn- ffi-type->chez [t]
|
||||
(or (ffi-types t) (throw (ex-info (str "jolt.ffi: unknown foreign type :" t) {}))))
|
||||
(defn- emit-ffi-fn [node]
|
||||
(str "(foreign-procedure " (chez-str-lit (:csym node))
|
||||
" (" (str/join " " (map ffi-type->chez (:argtypes node))) ") "
|
||||
(ffi-type->chez (:rettype node)) ")"))
|
||||
|
||||
(defn- emit-recur [node]
|
||||
(when-not *recur-target* (throw (ex-info "emit: recur outside a loop/fn target" {})))
|
||||
(let [arg-nodes (:args node)]
|
||||
|
|
@ -491,6 +508,7 @@
|
|||
:let (emit-let node)
|
||||
:loop (emit-loop node)
|
||||
:recur (emit-recur node)
|
||||
:ffi-fn (emit-ffi-fn node)
|
||||
:fn (emit-fn node)
|
||||
;; (def name) with no init (declare): reserve the cell. A def with non-empty
|
||||
;; reader metadata lowers to def-var-with-meta! (ported in a later increment).
|
||||
|
|
|
|||
29
src/jolt/jolt/ffi.clj
Normal file
29
src/jolt/jolt/ffi.clj
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
(ns jolt.ffi
|
||||
"Foreign-function interface for jolt libraries. A library loads a shared object
|
||||
and declares typed foreign functions, then exposes a Clojure API over them — no
|
||||
jolt built-in required.
|
||||
|
||||
(require '[jolt.ffi :as ffi])
|
||||
(ffi/load-library {:darwin \"libsqlite3.0.dylib\" :linux \"libsqlite3.so.0\"})
|
||||
(ffi/defcfn sqlite3-open \"sqlite3_open\" [:string :pointer] :int)
|
||||
(let [pp (ffi/alloc (ffi/sizeof :pointer))]
|
||||
(sqlite3-open \"x.db\" pp)
|
||||
(let [db (ffi/read pp :pointer)] ...)
|
||||
(ffi/free pp))
|
||||
|
||||
Types (keywords): :int :uint :long :ulong :int64 :uint64 :size_t :ssize_t
|
||||
:iptr :uptr :double :float :pointer :string :void :uint8 :char.
|
||||
|
||||
The memory/library primitives (alloc/free/read/write/sizeof/load-library/
|
||||
ptr->string/string->ptr/null/null?) are provided by the host. foreign-fn lowers
|
||||
a compile-time-typed signature to a real Chez foreign-procedure.")
|
||||
|
||||
;; foreign-fn binds C symbol `csym` to a typed callable. Expands to the __cfn
|
||||
;; special form (always fully-qualified, so an :as alias on jolt.ffi resolves):
|
||||
;; the analyzer/back end turn it into a Chez foreign-procedure.
|
||||
(defmacro foreign-fn [csym argtypes rettype]
|
||||
(list 'jolt.ffi/__cfn csym argtypes rettype))
|
||||
|
||||
;; (defcfn name "c_symbol" [argtypes] rettype) — def a foreign function.
|
||||
(defmacro defcfn [name csym argtypes rettype]
|
||||
(list 'def name (list 'jolt.ffi/__cfn csym argtypes rettype)))
|
||||
43
test/chez/ffi-binding-test.ss
Normal file
43
test/chez/ffi-binding-test.ss
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
;; jolt.ffi regression: a compile-time-typed foreign binding lowers to a real
|
||||
;; Chez foreign-procedure and calls native code. Run:
|
||||
;; chez --script test/chez/ffi-binding-test.ss
|
||||
;; Binds a few libc functions (process symbols, always present) through the
|
||||
;; jolt.ffi/__cfn special form + the host memory primitives — the same path a
|
||||
;; library uses to bind its native deps.
|
||||
|
||||
(import (chezscheme))
|
||||
(load "host/chez/rt.ss")
|
||||
(set-chez-ns! "clojure.core")
|
||||
(load "host/chez/seed/prelude.ss")
|
||||
(load "host/chez/post-prelude.ss")
|
||||
(set-chez-ns! "user")
|
||||
(load "host/chez/host-contract.ss")
|
||||
(load "host/chez/seed/image.ss")
|
||||
(load "host/chez/compile-eval.ss")
|
||||
(load "host/chez/ffi.ss")
|
||||
|
||||
(define total 0) (define fails 0)
|
||||
(define (ok name pred) (set! total (+ total 1)) (unless pred (set! fails (+ fails 1)) (printf "FAIL: ~a\n" name)))
|
||||
;; eval one form (string) in `user`, like the loader does form-by-form, so a def
|
||||
;; is visible to a later form.
|
||||
(define (ev s) (jolt-compile-eval s "user"))
|
||||
|
||||
;; load libc (process symbols) and bind typed foreign functions
|
||||
(ev "(jolt.ffi/load-library)")
|
||||
(ev "(def c-strlen (jolt.ffi/__cfn \"strlen\" [:string] :size_t))")
|
||||
(ev "(def c-abs (jolt.ffi/__cfn \"abs\" [:int] :int))")
|
||||
|
||||
(ok "foreign-procedure built for strlen" (procedure? (var-deref "user" "c-strlen")))
|
||||
(ok "typed call: strlen(\"hello\") = 5" (= 5 (jnum->exact (ev "(c-strlen \"hello\")"))))
|
||||
(ok "typed call: abs(-7) = 7" (= 7 (jnum->exact (ev "(c-abs -7)"))))
|
||||
|
||||
;; memory: alloc / write / read roundtrip through the host primitives
|
||||
(ok "mem int roundtrip"
|
||||
(= 4242 (jnum->exact
|
||||
(ev "(let [p (jolt.ffi/alloc (jolt.ffi/sizeof :int))]
|
||||
(jolt.ffi/write p :int 0 4242)
|
||||
(let [v (jolt.ffi/read p :int)] (jolt.ffi/free p) v))"))))
|
||||
(ok "sizeof :pointer is a word" (let ((n (jnum->exact (ev "(jolt.ffi/sizeof :pointer)")))) (or (= n 8) (= n 4))))
|
||||
|
||||
(printf "~a/~a passed~n" (- total fails) total)
|
||||
(exit (if (zero? fails) 0 1))
|
||||
Loading…
Add table
Add a link
Reference in a new issue