adding read/write support for byte-vectors

eval.c

@@ -378,11 +378,10 @@ static void sexp_add_path (sexp ctx, const char *str) {
   }
 }
 
-void sexp_init_eval_context_globals (sexp ctx) {
-  sexp_gc_var3(tmp, vec, ctx2);
-  ctx = sexp_make_child_context(ctx, NULL);
-  sexp_gc_preserve3(ctx, tmp, vec, ctx2);
 #if ! SEXP_USE_NATIVE_X86
+static void sexp_init_eval_context_bytecodes (sexp ctx) {
+  sexp_gc_var3(tmp, vec, ctx2);
+  sexp_gc_preserve3(ctx, tmp, vec, ctx2);
   emit(ctx, SEXP_OP_RESUMECC);
   sexp_global(ctx, SEXP_G_RESUMECC_BYTECODE) = finalize_bytecode(ctx);
   ctx2 = sexp_make_child_context(ctx, NULL);
@@ -393,6 +392,16 @@ void sexp_init_eval_context_globals (sexp ctx) {
     = sexp_make_procedure(ctx, SEXP_ZERO, SEXP_ZERO, tmp, vec);
   sexp_bytecode_name(sexp_procedure_code(sexp_global(ctx, SEXP_G_FINAL_RESUMER)))
     = sexp_intern(ctx, "final-resumer", -1);
+  sexp_gc_release3(ctx);
+}
+#endif
+
+void sexp_init_eval_context_globals (sexp ctx) {
+  sexp_gc_var1(tmp);
+  ctx = sexp_make_child_context(ctx, NULL);
+  sexp_gc_preserve1(ctx, tmp);
+#if ! SEXP_USE_NATIVE_X86
+  sexp_init_eval_context_bytecodes(ctx);
 #endif
   sexp_global(ctx, SEXP_G_MODULE_PATH) = SEXP_NULL;
   sexp_add_path(ctx, sexp_default_module_dir);
@@ -409,7 +418,7 @@ void sexp_init_eval_context_globals (sexp ctx) {
   sexp_global(ctx, SEXP_G_THREADS_SIGNALS) = SEXP_ZERO;
   sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = SEXP_FALSE;
 #endif
-  sexp_gc_release3(ctx);
+  sexp_gc_release1(ctx);
 }
 
 sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env, sexp_uint_t size, sexp_uint_t max_size) {

include/chibi/features.h

@@ -421,6 +421,10 @@
 #define SEXP_USE_OBJECT_BRACE_LITERALS ! SEXP_USE_NO_FEATURES
 #endif
 
+#ifndef SEXP_USE_BYTEVECTOR_LITERALS
+#define SEXP_USE_BYTEVECTOR_LITERALS ! SEXP_USE_NO_FEATURES
+#endif
+
 #ifndef SEXP_USE_SELF_PARAMETER
 #define SEXP_USE_SELF_PARAMETER 1
 #endif

include/chibi/sexp.h

@@ -562,6 +562,7 @@ sexp sexp_make_flonum(sexp ctx, double f);
 #define sexp_pairp(x)       (sexp_check_tag(x, SEXP_PAIR))
 #define sexp_stringp(x)     (sexp_check_tag(x, SEXP_STRING))
 #define sexp_lsymbolp(x)    (sexp_check_tag(x, SEXP_SYMBOL))
+#define sexp_bytesp(x)      (sexp_check_tag(x, SEXP_BYTES))
 #define sexp_vectorp(x)     (sexp_check_tag(x, SEXP_VECTOR))
 #define sexp_iportp(x)      (sexp_check_tag(x, SEXP_IPORT))
 #define sexp_oportp(x)      (sexp_check_tag(x, SEXP_OPORT))

sexp.c

@@ -1452,6 +1452,18 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
       sexp_write_string(ctx, sexp_opcode_name(obj), out);
       sexp_write_char(ctx, '>', out);
       break;
+#if SEXP_USE_BYTEVECTOR_LITERALS
+    case SEXP_BYTES:
+      sexp_write_string(ctx, "#u8(", out);
+      str = sexp_bytes_data(obj);
+      len = sexp_bytes_length(obj);
+      for (i=0; i<len; i++) {
+        if (i!=0) sexp_write_char(ctx, ' ', out);
+        sexp_write(ctx, sexp_make_fixnum(str[i]), out);
+      }
+      sexp_write_char(ctx, ')', out);
+      break;
+#endif
     default:
       i = sexp_pointer_tag(obj);
       if (i < 0 || i >= sexp_context_num_types(ctx)) {
@@ -2120,6 +2132,39 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
         res = sexp_read_error(ctx, "invalid syntax #%c%c", tmp, in);
       }
       break;
+#if SEXP_USE_BYTEVECTOR_LITERALS
+    case 'v': case 'V':
+      c1 = sexp_read_char(ctx, in);
+      if (!(c1=='u'||c1=='U')) {
+        res = sexp_read_error(ctx, "invalid syntax #v%c", sexp_make_character(c1), in);
+        break;
+      }
+      /* ... FALLTHROUGH ... */
+    case 'u': case 'U':
+      if ((c1 = sexp_read_char(ctx, in)) == '8') {
+        tmp = sexp_read(ctx, in);
+        if (!sexp_listp(ctx, tmp)) {
+          res = sexp_exceptionp(tmp) ? tmp
+            : sexp_read_error(ctx, "invalid syntax object after #u8", tmp, in);
+        } else {
+          res = sexp_make_bytes(ctx, sexp_length(ctx, tmp), SEXP_VOID);
+          for (c1=0; sexp_pairp(tmp); tmp=sexp_cdr(tmp), c1++) {
+            tmp2 = sexp_car(tmp);
+            if (!(sexp_fixnump(tmp2) && sexp_unbox_fixnum(tmp2) >= 0
+                  && sexp_unbox_fixnum(tmp2) < 0x100)) {
+              res = sexp_read_error(ctx, "invalid bytevector value", tmp2, in);
+              break;
+            } else {
+              sexp_bytes_set(res, sexp_make_fixnum(c1), tmp2);
+            }
+          }
+        }
+      } else {
+        tmp = sexp_list2(ctx, sexp_make_character('u'), sexp_make_character(c1));
+        res = sexp_read_error(ctx, "invalid syntax #%c%c", tmp, in);
+      }
+      break;
+#endif
 /*     case '0': case '1': case '2': case '3': case '4': */
 /*     case '5': case '6': case '7': case '8': case '9': */
     case ';':

vm.c

@@ -1171,6 +1171,16 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
     _ARG1 = sexp_make_fixnum(sexp_vector_length(_ARG1));
     break;
   case SEXP_OP_BYTES_REF:
+    if (! sexp_bytesp(_ARG1))
+      sexp_raise("byte-vector-ref: not a byte-vector", sexp_list1(ctx, _ARG1));
+    if (! sexp_fixnump(_ARG2))
+      sexp_raise("byte-vector-ref: not an integer", sexp_list1(ctx, _ARG2));
+    i = sexp_unbox_fixnum(_ARG2);
+    if ((i < 0) || (i >= sexp_bytes_length(_ARG1)))
+      sexp_raise("byte-vector-ref: index out of range", sexp_list2(ctx, _ARG1, _ARG2));
+    _ARG2 = sexp_bytes_ref(_ARG1, _ARG2);
+    top--;
+    break;
   case SEXP_OP_STRING_REF:
     if (! sexp_stringp(_ARG1))
       sexp_raise("string-ref: not a string", sexp_list1(ctx, _ARG1));
@@ -1179,9 +1189,6 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
     i = sexp_unbox_fixnum(_ARG2);
     if ((i < 0) || (i >= sexp_string_length(_ARG1)))
       sexp_raise("string-ref: index out of range", sexp_list2(ctx, _ARG1, _ARG2));
-    if (ip[-1] == SEXP_OP_BYTES_REF)
-      _ARG2 = sexp_bytes_ref(_ARG1, _ARG2);
-    else
 #if SEXP_USE_UTF8_STRINGS
       _ARG2 = sexp_string_utf8_ref(ctx, _ARG1, _ARG2);
 #else
@@ -1193,6 +1200,22 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
 #endif
     break;
   case SEXP_OP_BYTES_SET:
+    if (! sexp_bytesp(_ARG1))
+      sexp_raise("byte-vector-set!: not a byte-vector", sexp_list1(ctx, _ARG1));
+    else if (sexp_immutablep(_ARG1))
+      sexp_raise("byte-vector-set!: immutable byte-vector", sexp_list1(ctx, _ARG1));
+    else if (! sexp_fixnump(_ARG2))
+      sexp_raise("byte-vector-set!: not an integer", sexp_list1(ctx, _ARG2));
+    else if (!(sexp_fixnump(_ARG3) && sexp_unbox_fixnum(_ARG3)>=0
+               && sexp_unbox_fixnum(_ARG3)<0x100))
+      sexp_raise("byte-vector-set!: not an octet", sexp_list1(ctx, _ARG3));
+    i = sexp_unbox_fixnum(_ARG2);
+    if ((i < 0) || (i >= sexp_bytes_length(_ARG1)))
+      sexp_raise("byte-vector-set!: index out of range", sexp_list2(ctx, _ARG1, _ARG2));
+    sexp_bytes_set(_ARG1, _ARG2, _ARG3);
+    top-=3;
+    _ARG1 = SEXP_VOID;
+    break;
   case SEXP_OP_STRING_SET:
     if (! sexp_stringp(_ARG1))
       sexp_raise("string-set!: not a string", sexp_list1(ctx, _ARG1));
@@ -1205,18 +1228,14 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
     i = sexp_unbox_fixnum(_ARG2);
     if ((i < 0) || (i >= sexp_string_length(_ARG1)))
       sexp_raise("string-set!: index out of range", sexp_list2(ctx, _ARG1, _ARG2));
-    if (ip[-1] == SEXP_OP_BYTES_SET)
-      sexp_bytes_set(_ARG1, _ARG2, _ARG3);
-    else
 #if SEXP_USE_UTF8_STRINGS
-      {
     sexp_context_top(ctx) = top;
     sexp_string_utf8_set(ctx, _ARG1, _ARG2, _ARG3);
-      }
 #else
     sexp_string_set(_ARG1, _ARG2, _ARG3);
 #endif
     top-=3;
+    _ARG1 = SEXP_VOID;
     break;
 #if SEXP_USE_UTF8_STRINGS
   case SEXP_OP_STRING_CURSOR_NEXT:
@@ -1246,7 +1265,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
     break;
 #endif
   case SEXP_OP_BYTES_LENGTH:
-    if (! sexp_stringp(_ARG1))
+    if (! sexp_bytesp(_ARG1))
       sexp_raise("bytes-length: not a byte-vector", sexp_list1(ctx, _ARG1));
     _ARG1 = sexp_make_fixnum(sexp_bytes_length(_ARG1));
     break;