write-string works with bytevectors as well

include/chibi/sexp.h

@@ -1240,6 +1240,7 @@ SEXP_API sexp sexp_c_string(sexp ctx, const char *str, sexp_sint_t slen);
 SEXP_API sexp sexp_make_bytes_op(sexp ctx, sexp self, sexp_sint_t n, sexp len, sexp i);
 SEXP_API sexp sexp_make_string_op(sexp ctx, sexp self, sexp_sint_t n, sexp len, sexp ch);
 SEXP_API sexp sexp_substring_op (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp start, sexp end);
+SEXP_API sexp sexp_subbytes_op (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp start, sexp end);
 SEXP_API sexp sexp_string_concatenate_op (sexp ctx, sexp self, sexp_sint_t n, sexp str_ls, sexp sep);
 SEXP_API sexp sexp_intern (sexp ctx, const char *str, sexp_sint_t len);
 SEXP_API sexp sexp_string_to_symbol_op (sexp ctx, sexp self, sexp_sint_t n, sexp str);
@@ -1382,6 +1383,7 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx, sexp self, sexp_sint_t n, sexp obj
 #define sexp_make_string(ctx, l, c) sexp_make_string_op(ctx, NULL, 2, l, c)
 #define sexp_string_cmp(ctx, a, b, c) sexp_string_cmp_op(ctx, NULL, 3, a, b, c)
 #define sexp_substring(ctx, a, b, c) sexp_substring_op(ctx, NULL, 3, a, b, c)
+#define sexp_subbytes(ctx, a, b, c) sexp_subbytes_op(ctx, NULL, 3, a, b, c)
 #define sexp_string_concatenate(ctx, ls, s) sexp_string_concatenate_op(ctx, NULL, 2, ls, s)
 #define sexp_memq(ctx, a, b) sexp_memq_op(ctx, NULL, 2, a, b)
 #define sexp_assq(ctx, a, b) sexp_assq_op(ctx, NULL, 2, a, b)

lib/scheme/extras.scm

@@ -58,7 +58,9 @@
   (write-string (utf8->string vec) (bytevector-length vec) (if (pair? o) (car o) (current-output-port))))
 
 (define (write-partial-bytevector vec start end . o)
-  (apply write-bytevector (bytevector-copy-partial vec start end) o))
+  (if (zero? start)
+      (apply write-bytevector vec end o)
+      (apply write-bytevector (bytevector-copy-partial vec start end) o)))
 
 (define (make-list n . o)
   (let ((init (and (pair? o) (car o))))
@@ -120,10 +122,7 @@
 (define (bytevector-copy! from to)
   (bytevector-copy-partial! from 0 (bytevector-length from) to 0))
 
-(define (bytevector-copy-partial bv start end)
+(define bytevector-copy-partial subbytes)
-  (let ((res (make-bytevector (- end start))))
-    (bytevector-copy-partial! bv start end res 0)
-    res))
 
 (define (bytevector-copy-partial! from start end to at)
   (do ((i start (+ i 1)))

opcodes.c

@@ -198,6 +198,7 @@ _FN3OPT(_I(SEXP_STRING), _I(SEXP_STRING), _I(SEXP_FIXNUM), _I(SEXP_FIXNUM), "sub
 #else
 _FN3OPT(_I(SEXP_STRING), _I(SEXP_STRING), _I(SEXP_FIXNUM), _I(SEXP_FIXNUM), "substring", SEXP_FALSE, sexp_substring_op),
 #endif
+_FN3OPT(_I(SEXP_BYTES), _I(SEXP_BYTES), _I(SEXP_FIXNUM), _I(SEXP_FIXNUM), "subbytes", SEXP_FALSE, sexp_subbytes_op),
 #if SEXP_USE_FOLD_CASE_SYMS
 _FN1(SEXP_VOID, _I(SEXP_IPORT), "port-fold-case?", 0, sexp_get_port_fold_case),
 _FN2(SEXP_VOID, _I(SEXP_IPORT), _I(SEXP_BOOLEAN), "set-port-fold-case!", 0, sexp_set_port_fold_case),

sexp.c

@@ -967,6 +967,26 @@ sexp sexp_substring_op (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp start
   return res;
 }
 
+sexp sexp_subbytes_op (sexp ctx, sexp self, sexp_sint_t n, sexp vec, sexp start, sexp end) {
+  sexp res;
+  sexp_gc_var1(str);
+  sexp_assert_type(ctx, sexp_bytesp, SEXP_BYTES, vec);
+  sexp_gc_preserve1(ctx, str);
+#if SEXP_USE_PACKED_STRINGS
+  str = sexp_c_string(ctx, sexp_bytes_data(vec), sexp_bytes_length(vec));
+#else
+  str = sexp_alloc_type(ctx, string, SEXP_STRING);
+  sexp_string_bytes(str) = vec;
+  sexp_string_offset(str) = 0;
+  sexp_string_length(str) = sexp_bytes_length(vec);
+#endif
+  res = sexp_substring_op(ctx, self, n, str, start, end);
+  if (!sexp_exceptionp(res))
+    res = sexp_string_to_bytes(ctx, res);
+  sexp_gc_release1(ctx);
+  return res;
+}
+
 #if SEXP_USE_UTF8_STRINGS
 sexp sexp_utf8_substring_op (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp start, sexp end) {
   sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, str);

vm.c

@@ -1783,45 +1783,53 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
     _ARG1 = SEXP_VOID;
     break;
   case SEXP_OP_WRITE_STRING:
-    if (! sexp_stringp(_ARG1))
+    if (sexp_stringp(_ARG1))
-      sexp_raise("write-string: not a string", sexp_list1(ctx, _ARG1));
+#if SEXP_USE_PACKED_STRINGS
+      tmp1 = _ARG1;
+#else
+      tmp1 = sexp_string_bytes(_ARG1);
+#endif
+    else if (sexp_bytesp(_ARG1))
+      tmp1 = _ARG1;
+    else
+      sexp_raise("write-string: not a string or bytes", sexp_list1(ctx, _ARG1));
     if (! sexp_fixnump(_ARG2)) {
       if (_ARG2 == SEXP_TRUE)
-        _ARG2 = sexp_make_fixnum(sexp_string_length(_ARG1));
+        _ARG2 = sexp_make_fixnum(sexp_bytes_length(tmp1));
       else
         sexp_raise("write-string: not an integer", sexp_list1(ctx, _ARG2));
     }
-    if (sexp_unbox_fixnum(_ARG2) < 0 || sexp_unbox_fixnum(_ARG2) > sexp_string_length(_ARG1))
+    if (sexp_unbox_fixnum(_ARG2) < 0 || sexp_unbox_fixnum(_ARG2) > sexp_bytes_length(tmp1))
-      sexp_raise("write-string: not a valid string count", sexp_list2(ctx, _ARG1, _ARG2));
+      sexp_raise("write-string: not a valid string count", sexp_list2(ctx, tmp1, _ARG2));
     if (! sexp_oportp(_ARG3))
       sexp_raise("write-string: not an output-port", sexp_list1(ctx, _ARG3));
     sexp_context_top(ctx) = top;
     if (sexp_port_stream(_ARG3)) {
-      i = fwrite(sexp_string_data(_ARG1), 1, sexp_unbox_fixnum(_ARG2), sexp_port_stream(_ARG3));
+      i = fwrite(sexp_bytes_data(tmp1), 1, sexp_unbox_fixnum(_ARG2), sexp_port_stream(_ARG3));
 #if SEXP_USE_GREEN_THREADS
       if ((i < sexp_unbox_fixnum(_ARG2)) && ferror(sexp_port_stream(_ARG3))
           && (errno == EAGAIN)
           && sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER))) {
-        clearerr(sexp_port_stream(_ARG3));
-        sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG3);
-        fuel = 0;
         if (i > 0) {
           /* modify stack in-place so we continue where we left off next time */
           _ARG1 = sexp_substring(ctx, _ARG1, SEXP_ZERO, sexp_make_fixnum(i));
           _ARG2 = sexp_make_fixnum(sexp_unbox_fixnum(_ARG2) - i);
         }
+        clearerr(sexp_port_stream(_ARG3));
+        sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), _ARG3);
+        fuel = 0;
         ip--;      /* try again */
         goto loop;
       }
 #endif
     } else {  /* not a stream-backed string */
-      if (sexp_string_length(_ARG1) != sexp_unbox_fixnum(_ARG2))
+      if (sexp_bytes_length(tmp1) != sexp_unbox_fixnum(_ARG2))
-        _ARG1 = sexp_substring(ctx, _ARG1, SEXP_ZERO, _ARG2);
+        tmp1 = sexp_subbytes(ctx, tmp1, SEXP_ZERO, _ARG2);
-      sexp_write_string(ctx, sexp_string_data(_ARG1), _ARG3);
+      sexp_write_string(ctx, sexp_bytes_data(tmp1), _ARG3);
     }
-    i = _ARG2;
+    tmp1 = _ARG2;     /* return the number of bytes written */
     top-=2;
-    _ARG1 = sexp_make_fixnum(i);
+    _ARG1 = tmp1;
     break;
   case SEXP_OP_READ_CHAR:
     if (! sexp_iportp(_ARG1))