add some bytevector primitives

src/blob.c

@@ -13,3 +13,78 @@ pic_blob_new(pic_state *pic, char *dat, int len)
   bv->len = len;
   return bv;
 }
+
+static pic_value
+pic_blob_bytevector_p(pic_state *pic)
+{
+  pic_value v;
+
+  pic_get_args(pic, "o", &v);
+
+  return pic_bool_value(pic_blob_p(v));
+}
+
+static pic_value
+pic_blob_make_bytevector(pic_state *pic)
+{
+  int k, b = 0, i;
+  char *dat;
+
+  pic_get_args(pic, "i|i", &k, &b);
+
+  if (b < 0 || b > 255)
+    pic_error(pic, "byte out of range");
+
+  dat = pic_alloc(pic, k);
+  for (i = 0; i < k; ++i) {
+    dat[i] = b;
+  }
+
+  return pic_obj_value(pic_blob_new(pic, dat, k));
+}
+
+static pic_value
+pic_blob_bytevector_length(pic_state *pic)
+{
+  struct pic_blob *bv;
+
+  pic_get_args(pic, "b", &bv);
+
+  return pic_int_value(bv->len);
+}
+
+static pic_value
+pic_blob_bytevector_u8_ref(pic_state *pic)
+{
+  struct pic_blob *bv;
+  int k;
+
+  pic_get_args(pic, "bi", &bv, &k);
+
+  return pic_int_value(bv->data[k]);
+}
+
+static pic_value
+pic_blob_bytevector_u8_set(pic_state *pic)
+{
+  struct pic_blob *bv;
+  int k, v;
+
+  pic_get_args(pic, "bii", &bv, &k, &v);
+
+  if (v < 0 || v > 255)
+    pic_error(pic, "byte out of range");
+
+  bv->data[k] = v;
+  return pic_false_value();
+}
+
+void
+pic_init_blob(pic_state *pic)
+{
+  pic_defun(pic, "bytevector?", pic_blob_bytevector_p);
+  pic_defun(pic, "make-bytevector", pic_blob_make_bytevector);
+  pic_defun(pic, "bytevector-length", pic_blob_bytevector_length);
+  pic_defun(pic, "bytevector-u8-ref", pic_blob_bytevector_u8_ref);
+  pic_defun(pic, "bytevector-u8-set!", pic_blob_bytevector_u8_set);
+}

src/init.c

@@ -14,6 +14,7 @@ void pic_init_file(pic_state *);
 void pic_init_proc(pic_state *);
 void pic_init_symbol(pic_state *);
 void pic_init_vector(pic_state *);
+void pic_init_blob(pic_state *);
 
 void
 pic_load_stdlib(pic_state *pic)
@@ -77,6 +78,7 @@ pic_init_core(pic_state *pic)
   pic_init_proc(pic); DONE;
   pic_init_symbol(pic); DONE;
   pic_init_vector(pic); DONE;
+  pic_init_blob(pic); DONE;
 
   pic_load_stdlib(pic); DONE;
 }

src/vm.c

@@ -6,6 +6,7 @@
 #include "picrin/pair.h"
 #include "picrin/proc.h"
 #include "picrin/irep.h"
+#include "picrin/blob.h"
 
 #define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)])
 
@@ -185,6 +186,24 @@ pic_get_args(pic_state *pic, const char *format, ...)
 	}
       }
       break;
+    case 'b':
+      {
+	struct pic_blob **b;
+	pic_value v;
+
+	b = va_arg(ap, struct pic_blob **);
+	if (i < argc) {
+	  v = GET_OPERAND(pic,i);
+	  if (pic_blob_p(v)) {
+	    *b = pic_blob_ptr(v);
+	  }
+	  else {
+	    pic_error(pic, "pic_get_args: expected bytevector");
+	  }
+	  i++;
+	}
+      }
+      break;
     default:
       {
 	pic_error(pic, "pic_get_args: invalid argument specifier given");