input/output bytevectors

include/chibi/sexp.h

@@ -753,6 +753,12 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
 #define sexp_string_data(x)   (sexp_bytes_data(sexp_string_bytes(x))+sexp_string_offset(x))
 #endif
 
+#if SEXP_USE_PACKED_STRINGS
+#define sexp_string_to_bytes(ctx, x)  ((x)->tag = SEXP_BYTES, x)
+#else
+#define sexp_string_to_bytes(ctx, x)  sexp_string_bytes(x)
+#endif
+
 #define sexp_bytes_ref(x, i)    (sexp_make_fixnum((unsigned char)sexp_bytes_data(x)[sexp_unbox_fixnum(i)]))
 #define sexp_bytes_set(x, i, v) (sexp_bytes_data(x)[sexp_unbox_fixnum(i)] = sexp_unbox_fixnum(v))
 

lib/chibi/io.sld

@@ -7,7 +7,9 @@
           make-custom-input-port make-custom-output-port
           make-null-output-port make-broadcast-port make-concatenated-port
           make-generated-input-port make-filtered-output-port
-          make-filtered-input-port)
+          make-filtered-input-port
+          open-input-bytevector open-output-bytevector get-output-bytevector
+          write-u8 read-u8 peek-u8)
   (import (scheme) (chibi ast))
   (include-shared "io/io")
   (include "io/io.scm"))

lib/chibi/io/io.stub

@@ -25,3 +25,17 @@
 
 (define-c sexp (%make-custom-output-port "sexp_make_custom_output_port")
   ((value ctx sexp) (value self sexp) sexp sexp sexp))
+
+(define-c sexp (open-input-bytevector "sexp_open_input_bytevector")
+  ((value ctx sexp) (value self sexp) sexp))
+(define-c sexp (open-output-bytevector "sexp_open_output_bytevector")
+  ((value ctx sexp) (value self sexp)))
+(define-c sexp (get-output-bytevector "sexp_get_output_bytevector")
+  ((value ctx sexp) (value self sexp) sexp))
+
+(define-c sexp (write-u8 "sexp_write_u8")
+  ((value ctx sexp) (value self sexp) sexp (default (current-output-port) sexp)))
+(define-c sexp (read-u8 "sexp_read_u8")
+  ((value ctx sexp) (value self sexp) (default (current-input-port) sexp)))
+(define-c sexp (peek-u8 "sexp_peek_u8")
+  ((value ctx sexp) (value self sexp) (default (current-input-port) sexp)))

lib/chibi/io/port.c

@@ -206,3 +206,79 @@ static sexp sexp_make_custom_output_port (sexp ctx, sexp self,
   sexp_pointer_tag(res) = SEXP_OPORT;
   return res;
 }
+
+sexp sexp_bytes_to_string (sexp ctx, sexp vec) {
+  sexp res;
+#if SEXP_USE_PACKED_STRINGS
+  res = sexp_c_string(ctx, sexp_bytes_data(vec), sexp_bytes_length(vec));
+#else
+  res = sexp_alloc_type(ctx, string, SEXP_STRING);
+  sexp_string_bytes(res) = vec;
+  sexp_string_offset(res) = 0;
+  sexp_string_length(res) = sexp_bytes_length(vec);
+#endif
+  return res;
+}
+
+sexp sexp_open_input_bytevector (sexp ctx, sexp self, sexp vec) {
+  sexp_gc_var2(str, res);
+  sexp_assert_type(ctx, sexp_bytesp, SEXP_BYTES, vec);
+  sexp_gc_preserve2(ctx, str, res);
+  str = sexp_bytes_to_string(ctx, vec);
+  res = sexp_make_input_string_port(ctx, str);
+  sexp_port_binaryp(res) = 1;
+  sexp_gc_release2(ctx);
+  return res;
+}
+
+sexp sexp_open_output_bytevector (sexp ctx, sexp self) {
+  sexp res = sexp_make_output_string_port(ctx);
+  sexp_port_binaryp(res) = 1;
+  return res;
+}
+
+sexp sexp_get_output_bytevector (sexp ctx, sexp self, sexp port) {
+  sexp_gc_var1(res);
+  sexp_assert_type(ctx, sexp_oportp, SEXP_OPORT, port);
+  if (!sexp_port_binaryp(port))
+    return sexp_xtype_exception(ctx, self, "not a binary port", port);
+  sexp_gc_preserve1(ctx, res);
+  res = sexp_get_output_string(ctx, port);
+  res = sexp_string_to_bytes(ctx, res);
+  sexp_gc_release1(ctx);
+  return res;
+}
+
+sexp sexp_write_u8 (sexp ctx, sexp self, sexp u8, sexp out) {
+  sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, u8);
+  if (sexp_unbox_fixnum(u8) < 0 || sexp_unbox_fixnum(u8) > 255)
+    return sexp_xtype_exception(ctx, self, "not a u8 value", u8);
+  sexp_assert_type(ctx, sexp_oportp, SEXP_OPORT, out);
+  if (!sexp_port_binaryp(out))
+    return sexp_xtype_exception(ctx, self, "not a binary port", out);
+  sexp_write_char(ctx, sexp_unbox_fixnum(u8), out);
+  return SEXP_VOID;
+}
+
+sexp sexp_read_u8 (sexp ctx, sexp self, sexp in) {
+  int c;
+  sexp_assert_type(ctx, sexp_iportp, SEXP_IPORT, in);
+  if (!sexp_port_binaryp(in))
+    return sexp_xtype_exception(ctx, self, "not a binary port", in);
+  sexp_check_block_port(ctx, in, 0);
+  c = sexp_read_char(ctx, in);
+  return c == EOF ? SEXP_EOF : sexp_make_fixnum(c);
+}
+
+sexp sexp_peek_u8 (sexp ctx, sexp self, sexp in) {
+  int c;
+  sexp_assert_type(ctx, sexp_iportp, SEXP_IPORT, in);
+  if (!sexp_port_binaryp(in))
+    return sexp_xtype_exception(ctx, self, "not a binary port", in);
+  sexp_check_block_port(ctx, in, 0);
+  c = sexp_read_char(ctx, in);
+  if (c == EOF)
+    return SEXP_EOF;
+  sexp_push_char(ctx, c, in);
+  return sexp_make_fixnum(c);
+}