Move bytevector input ports implementation to Scheme

* module/ice-9/binary-ports.scm (open-bytevector-input-port): New
implementation.
* libguile/r6rs-ports.c (scm_open_bytevector_input_port): Proxy to
Scheme.

module/ice-9/binary-ports.scm

@@ -53,6 +53,9 @@
 ;; Note that this extension also defines %make-transcoded-port, which is
 ;; not exported but is used by (rnrs io ports).
 
+(load-extension (string-append "libguile-" (effective-version))
+                "scm_init_r6rs_ports")
+
 (define (bytevector-concatenate-reverse bvs)
   (let* ((len (let lp ((bvs bvs) (len 0))
                 (match bvs
@@ -73,7 +76,42 @@
   (let ((dst (make-bytevector count)))
     (bytevector-copy! src start dst 0 count)
     dst))
-  
+
+(define* (open-bytevector-input-port src #:optional transcoder)
+  "Return an input port whose contents are drawn from bytevector @var{src}."
+  (unless (bytevector? src)
+    (error "not a bytevector" src))
+  (when transcoder
+    (error "transcoders not implemented"))
+  (define pos 0)
+  (define (bv-read port dst start count)
+    (let ((to-copy (min count (- (bytevector-length src) pos))))
+      (bytevector-copy! src pos dst start to-copy)
+      (set! pos (+ pos to-copy))
+      to-copy))
+
+  (define (bv-seek port offset whence)
+    (define len (bytevector-length src))
+    (define base
+      (cond
+       ((eq? whence SEEK_SET) 0)
+       ((eq? whence SEEK_CUR) pos)
+       ((eq? whence SEEK_END) len)
+       (else (error "bad whence value" whence))))
+    (define dst (+ base offset))
+    (unless (<= 0 dst len)
+      (error "out of range" dst))
+    (set! pos dst)
+    dst)
+
+  (make-custom-port #:id "bytevector-input-port"
+                    #:read bv-read
+                    #:seek bv-seek
+                    #:random-access? (lambda (_) #t)
+                    ;; FIXME: Instead default to current encoding, if
+                    ;; someone reads text from this port.
+                    #:encoding 'ISO-8859-1 #:conversion-strategy 'error))
+
 (define* (open-bytevector-output-port #:optional transcoder)
   "Return two values: an output port and a procedure.  The latter should be
 called with zero arguments to obtain a bytevector containing the data
@@ -143,9 +181,6 @@ accumulated by the port."
               (force-output port))
             (get-output-bytevector))))
 
-(load-extension (string-append "libguile-" (effective-version))
-                "scm_init_r6rs_ports")
-
 (define (call-with-input-bytevector bv proc)
   "Call the one-argument procedure @var{proc} with a newly created
 binary input port from which the bytevector @var{bv}'s contents may be