ec9fde9e7e
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).
85 lines
5 KiB
Scheme
85 lines
5 KiB
Scheme
;; byte-buffer.ss — java.nio.ByteBuffer over a jolt byte-array. A buffer is a
|
|
;; jhost tagged "byte-buffer" with mutable #(backing-array position limit); the
|
|
;; backing is a jolt byte-array (vector of 0..255). Covers the slice of the API
|
|
;; portable code reaches for — wrap / get(byte[]) / array / remaining / position /
|
|
;; limit / duplicate / flip / rewind — e.g. cognitect aws-api wrapping blob bytes.
|
|
|
|
(define (make-byte-buffer backing pos limit) (make-jhost "byte-buffer" (vector backing pos limit)))
|
|
(define (bb? x) (and (jhost? x) (string=? (jhost-tag x) "byte-buffer")))
|
|
(define (bb-backing b) (vector-ref (jhost-state b) 0))
|
|
(define (bb-pos b) (vector-ref (jhost-state b) 1))
|
|
(define (bb-limit b) (vector-ref (jhost-state b) 2))
|
|
(define (bb-pos! b n) (vector-set! (jhost-state b) 1 n))
|
|
(define (bb-limit! b n) (vector-set! (jhost-state b) 2 n))
|
|
(define (bb-capacity b) (vector-length (jolt-array-vec (bb-backing b))))
|
|
|
|
;; (ByteBuffer/wrap ba) | (ByteBuffer/wrap ba off len) | (ByteBuffer/allocate n)
|
|
(register-class-statics! "ByteBuffer"
|
|
(list
|
|
(cons "wrap" (lambda (ba . rest)
|
|
(let ((cap (vector-length (jolt-array-vec ba))))
|
|
(if (pair? rest)
|
|
(let ((off (jnum->exact (car rest))) (len (jnum->exact (cadr rest))))
|
|
(make-byte-buffer ba off (+ off len)))
|
|
(make-byte-buffer ba 0 cap)))))
|
|
(cons "allocate" (lambda (n)
|
|
(let ((cap (jnum->exact n)))
|
|
(make-byte-buffer (make-jolt-array (make-vector cap 0) 'byte) 0 cap))))
|
|
;; jolt has one heap; a direct buffer is just a buffer here.
|
|
(cons "allocateDirect" (lambda (n)
|
|
(let ((cap (jnum->exact n)))
|
|
(make-byte-buffer (make-jolt-array (make-vector cap 0) 'byte) 0 cap))))))
|
|
|
|
(register-host-methods! "byte-buffer"
|
|
(list
|
|
(cons "remaining" (lambda (self) (->num (- (bb-limit self) (bb-pos self)))))
|
|
(cons "hasRemaining" (lambda (self) (> (bb-limit self) (bb-pos self))))
|
|
;; position / limit are getters with no arg, setters (returning the buffer) with one
|
|
(cons "position" (lambda (self . a)
|
|
(if (pair? a) (begin (bb-pos! self (jnum->exact (car a))) self) (->num (bb-pos self)))))
|
|
(cons "limit" (lambda (self . a)
|
|
(if (pair? a) (begin (bb-limit! self (jnum->exact (car a))) self) (->num (bb-limit self)))))
|
|
(cons "capacity" (lambda (self) (->num (bb-capacity self))))
|
|
(cons "hasArray" (lambda (self) #t))
|
|
(cons "array" (lambda (self) (bb-backing self)))
|
|
(cons "duplicate" (lambda (self) (make-byte-buffer (bb-backing self) (bb-pos self) (bb-limit self))))
|
|
(cons "rewind" (lambda (self) (bb-pos! self 0) self))
|
|
(cons "flip" (lambda (self) (bb-limit! self (bb-pos self)) (bb-pos! self 0) self))
|
|
(cons "clear" (lambda (self) (bb-pos! self 0) (bb-limit! self (bb-capacity self)) self))
|
|
;; (.get dst) | (.get dst off len): bulk copy from position into a byte-array,
|
|
;; advancing position. Returns the buffer like the JVM.
|
|
;; (.put src): copy bytes into the buffer at position, advancing it. src is
|
|
;; another ByteBuffer (its remaining bytes), a byte-array, or a single byte.
|
|
(cons "put" (lambda (self src . rest)
|
|
(let ((dv (jolt-array-vec (bb-backing self))) (dp (bb-pos self)))
|
|
(cond
|
|
((bb? src)
|
|
(let* ((sv (jolt-array-vec (bb-backing src))) (sp (bb-pos src))
|
|
(n (- (bb-limit src) sp)))
|
|
(do ((i 0 (fx+ i 1))) ((fx=? i n))
|
|
(vector-set! dv (+ dp i) (vector-ref sv (+ sp i))))
|
|
(bb-pos! src (bb-limit src)) (bb-pos! self (+ dp n))))
|
|
((jolt-array? src)
|
|
(let* ((sv (jolt-array-vec src)) (n (vector-length sv)))
|
|
(do ((i 0 (fx+ i 1))) ((fx=? i n))
|
|
(vector-set! dv (+ dp i) (vector-ref sv i)))
|
|
(bb-pos! self (+ dp n))))
|
|
(else (vector-set! dv dp (jnum->exact src)) (bb-pos! self (+ dp 1))))
|
|
self)))
|
|
(cons "get" (lambda (self dst . rest)
|
|
(let* ((src (jolt-array-vec (bb-backing self)))
|
|
(dv (jolt-array-vec dst))
|
|
(off (if (pair? rest) (jnum->exact (car rest)) 0))
|
|
(len (if (and (pair? rest) (pair? (cdr rest))) (jnum->exact (cadr rest)) (vector-length dv)))
|
|
(p (bb-pos self)))
|
|
(do ((i 0 (+ i 1))) ((= i len))
|
|
(vector-set! dv (+ off i) (vector-ref src (+ p i))))
|
|
(bb-pos! self (+ p len))
|
|
self)))))
|
|
|
|
(register-class-arm! bb? (lambda (x) "java.nio.ByteBuffer"))
|
|
(register-instance-check-arm!
|
|
(lambda (type-sym val)
|
|
(if (and (symbol-t? type-sym) (bb? val)
|
|
(member (last-dot (symbol-t-name type-sym)) '("ByteBuffer")))
|
|
#t 'pass)))
|