Group the JVM interop shims under host/chez/java/

The host/chez directory mixed jolt's own runtime (value model, seq, reader,
vars, ns, multimethods) with the shims that emulate the JVM: java.* / javax.*
classes, clojure.lang interfaces, and the host-class registry they hang off.
Move that JVM-emulation layer into host/chez/java/ so it reads as a distinct
unit instead of being interleaved with the platform runtime.

Moved (content unchanged): host-static, host-static-methods,
host-static-classes, host-class, dot-forms, records-interop, byte-buffer,
io, io-streams, inst-time, java-time, bigdec, natives-queue, natives-str,
natives-array, math, concurrency, async, ffi.

The load paths in rt.ss/cli.ss and the build.ss runtime manifest are updated
to point at java/; the build inliner follows the (load ...) strings, so the
AOT path needs no other change. All runtime shims, no seed source touched
(the three .clj edits are doc comments), so no re-mint.

Gate green: make test (selfhost fixpoint, certify 0-new, sci 211, infer),
shakesmoke (4 apps byte-identical).
This commit is contained in:
Yogthos 2026-06-25 18:35:44 -04:00
parent 5b77efa499
commit ec9fde9e7e
26 changed files with 24 additions and 24 deletions

167
host/chez/java/ffi.ss Normal file
View file

@ -0,0 +1,167 @@
;; 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)
;; --- buffer I/O (known length) ----------------------------------------------
;; read n bytes at ptr as a string (UTF-8, falling back to latin1 for invalid
;; sequences) — for a socket recv buffer and similar fixed-length reads.
(define (ffi-read-bytes ptr n)
(let* ((n (jnum->exact n)) (p (jnum->exact ptr)) (bv (make-bytevector n)))
(do ((i 0 (+ i 1))) ((= i n)) (bytevector-u8-set! bv i (foreign-ref 'unsigned-8 p i)))
(guard (e (#t (list->string (map integer->char (bytevector->u8-list bv))))) (utf8->string bv))))
;; write a string's UTF-8 bytes into ptr (no NUL terminator); return the count.
(define (ffi-write-bytes ptr s)
(let* ((bv (string->utf8 (jolt-str-render-one s))) (n (bytevector-length bv)) (p (jnum->exact ptr)))
(do ((i 0 (+ i 1))) ((= i n)) (foreign-set! 'unsigned-8 p i (bytevector-u8-ref bv i)))
n))
(def-var! "jolt.ffi" "read-bytes" ffi-read-bytes)
(def-var! "jolt.ffi" "write-bytes" ffi-write-bytes)
;; --- byte-array buffer I/O (binary-faithful) --------------------------------
;; Move raw bytes between a jolt byte-array (jolt-array kind 'byte) and foreign
;; memory, byte-exact (no UTF-8 / latin1 decode) — for socket recv/send and the
;; zlib / OpenSSL buffers an HTTP client passes through. read-array returns a
;; fresh byte-array of n bytes; write-array copies a byte-array's bytes into ptr
;; and returns the count.
(define (ffi-read-array ptr n)
(let* ((n (jnum->exact n)) (p (jnum->exact ptr)) (v (make-vector n 0)))
(do ((i 0 (+ i 1))) ((= i n)) (vector-set! v i (foreign-ref 'unsigned-8 p i)))
(make-jolt-array v 'byte)))
(define (ffi-write-array ptr arr)
(let* ((v (jolt-array-vec arr)) (n (vector-length v)) (p (jnum->exact ptr)))
(do ((i 0 (+ i 1))) ((= i n)) (foreign-set! 'unsigned-8 p i (bitwise-and (exact (vector-ref v i)) #xff)))
n))
(def-var! "jolt.ffi" "read-array" ffi-read-array)
(def-var! "jolt.ffi" "write-array" ffi-write-array)
;; --- 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))
;; --- callbacks: receive calls FROM C ----------------------------------------
;; jolt.ffi/foreign-callable lowers to (jolt-ffi-register-callable! (foreign-callable …)).
;; A foreign-callable code object must be LOCKED (so the collector neither moves
;; nor reclaims it) and RETAINED while C may still call through its entry point.
;; Register it keyed by that entry-point address (a jolt pointer integer) — which
;; is what the caller hands to C; free-callable unlocks and drops it. A callback
;; left registered lives for the process (the GTK-signal-handler common case).
(define ffi-callable-table (make-eqv-hashtable)) ; entry-point addr -> code object
(define (jolt-ffi-register-callable! co)
(lock-object co)
(let ((addr (foreign-callable-entry-point co)))
(hashtable-set! ffi-callable-table addr co)
addr))
(define (ffi-free-callable addr)
(let* ((a (jnum->exact addr)) (co (hashtable-ref ffi-callable-table a #f)))
(when co (unlock-object co) (hashtable-delete! ffi-callable-table a))
jolt-nil))
;; --- native libraries for a standalone binary -------------------------------
;; `jolt build` bakes a project's deps.edn :jolt/native declarations into the
;; launcher, which loads them at startup (load-shared-object isn't part of the
;; saved heap, so it must run in the built process, not at heap build). process?
;; loads the running binary's own symbols (libc sockets); otherwise try each
;; platform candidate in turn and fail unless the spec is optional.
(define (jolt-build-load-native cands optional? process?)
(if process?
(begin (load-shared-object #f) #t)
(let loop ((cs cands))
(cond
((null? cs)
(unless optional?
(error 'jolt-build "required native library not found" cands))
#f)
((guard (e (#t #f)) (load-shared-object (car cs)) #t) #t)
(else (loop (cdr cs)))))))
;; --- expose under jolt.ffi ---------------------------------------------------
(def-var! "jolt.ffi" "free-callable" ffi-free-callable)
(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)