(import s2j) (import serial-io) (import buffers) (define-java-class ) (define-java-class ) (define-java-class ) (define-java-class ) (define-java-class ) (define-java-class ) (define-generic-java-method java-close |close|) (define-generic-java-method java-flush |flush|) (define-generic-java-method to-byte-array |toByteArray|) (define-java-class ) (define-generic-java-method sisc-current-interpreter |currentInterpreter|) (define-generic-java-method sisc-get-ctx |getCtx|) (define sysnull (java-null (java-class '|java.lang.System|))) (define-generic-java-method arraycopy) (define-generic-java-field-accessor :buf) (define (copy-buffer->jbuffer buffer buffer-offset jbuffer jbuffer-offset . len) (let ([len (if (null? len) (- (buffer-length buffer) buffer-offset) (car len))]) (arraycopy sysnull (:buf (java-wrap buffer)) (->jint buffer-offset) jbuffer (->jint jbuffer-offset) (->jint len)))) (define (copy-jbuffer->buffer jbuffer jbuffer-offset buffer buffer-offset . len) (let ([len (if (null? len) (- (java-array-length jbuffer) jbuffer-offset) (car len))]) (arraycopy sysnull jbuffer (->jint jbuffer-offset) (:buf (java-wrap buffer)) (->jint buffer-offset) (->jint len)))) (define (call-with-serial-output-buffer thunk) (let* ((output-stream (java-new )) (buffer (java-new output-stream)) (port (java-new buffer (->jboolean #f)))) (thunk (java-unwrap port)) (close-output-port (java-unwrap port)) (let* ((byte-array (to-byte-array output-stream)) (buffer (make-buffer (java-array-length byte-array)))) (copy-jbuffer->buffer byte-array 0 buffer 0 (buffer-length buffer)) buffer))) (define (call-with-serial-input-buffer buffer thunk) (let ((byte-array (java-array-new (buffer-length buffer)))) (copy-buffer->jbuffer buffer 0 byte-array 0 (buffer-length buffer)) (let* ((input-stream (java-new byte-array)) (buffer (java-new input-stream)) (port (java-new (sisc-get-ctx (sisc-current-interpreter (java-null ))) buffer))) (let ((result (thunk (java-unwrap port)))) (close-input-port (java-unwrap port)) result)))) #| (define x (lambda () (display "two\n"))) (define buf (call-with-serial-output-buffer (lambda (port) (serialize x port)))) ((call-with-serial-input-buffer buf deserialize)) |#