Added write-bytevector

CHANGELOG.md

@@ -2,6 +2,10 @@
 
 ## 0.11.8 - TBD
 
+Features
+
+- Added `write-bytevector` from R7RS.
+
 Bug Fixes
 
 - Fixed Windows build using MSYS2 and setup a continuous integration job for this platform to prevent breaking this build in the future.

include/cyclone/runtime.h

@@ -259,6 +259,7 @@ object Cyc_io_peek_char(void *data, object cont, object port);
 object Cyc_write_u8(void *data, object c, object port);
 object Cyc_io_read_u8(void *data, object cont, object port);
 object Cyc_io_peek_u8(void *data, object cont, object port);
+object Cyc_write_bytevector(void *data, object bvec, object port, object start, object end);
 object Cyc_io_read_line(void *data, object cont, object port);
 void Cyc_io_read_token(void *data, object cont, object port);
 /**@}*/

runtime.c

@@ -1227,6 +1227,39 @@ object Cyc_write_u8(void *data, object c, object port)
   return quote_void;
 }
 
+object Cyc_write_bytevector(void *data, object bvec, object port, object start, object end)
+{
+  Cyc_check_port(data, port);
+  Cyc_check_bvec(data, bvec);
+  Cyc_check_fixnum(data, start);
+  Cyc_check_fixnum(data, end);
+
+  bytevector bv = (bytevector) bvec;
+  FILE *fp = ((port_type *) port)->fp;
+  char *bytes = bv->data;
+  int s = obj_obj2int(start);
+  int e = obj_obj2int(end);
+
+  if (s < 0) { 
+    s = 0; 
+  } else if (s > bv->len) { 
+    s = bv->len; 
+  }
+
+  if (e < 0 || e > bv->len) {
+    e = bv->len;
+  }
+
+  if (s > e) {
+    s = e;
+  }
+
+  size_t rv = fwrite(
+    bytes + s,
+    sizeof(char), e - s, fp);
+  return obj_int2obj(rv);
+}
+
 /* Fast versions of member and assoc */
 object memberp(void *data, object x, list l)
 {

scheme/base.sld

@@ -192,7 +192,7 @@
 ;    ; following byte vector functions are not implemented yet:
 ;    read-bytevector
 ;    read-bytevector!
-;    write-bytevector
+    write-bytevector
 ;
 ;    : No unicode support at this time
     peek-u8
@@ -713,6 +713,18 @@
       (if (null? port)
         (Cyc-display str (current-output-port))
         (Cyc-display str (car port))))
+    (define (write-bytevector vec . opts)
+      (letrec ((len (bytevector-length vec))
+               (port (if (> (length opts) 0) (car opts) (current-output-port)))
+               (start (if (> (length opts) 1) (cadr opts) 0))
+               (end (if (> (length opts) 2) (caddr opts) len))
+               )
+        (%write-bytevector vec port start end)))
+    (define-c %write-bytevector
+      "(void *data, int argc, closure _, object k, object bv, object port, object start, object end)"
+      " return_closcall1(data, k, Cyc_write_bytevector(data, bv, port, start, end));"
+      "(void *data, object ptr, object bv, object port, object start, object end)"
+      " return Cyc_write_bytevector(data, bv, port, start, end);")
     (define (write-char char . port)
       (if (null? port)
         (Cyc-write-char char (current-output-port))