diff --git a/src/blob.c b/src/blob.c index a6adcc1f..02f6112a 100644 --- a/src/blob.c +++ b/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); +} diff --git a/src/init.c b/src/init.c index e72ff457..59d1f6cd 100644 --- a/src/init.c +++ b/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; } diff --git a/src/vm.c b/src/vm.c index e4b8f59a..cd450224 100644 --- a/src/vm.c +++ b/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");