add some bytevector primitives
This commit is contained in:
parent
aebf7f00f7
commit
9bba0353e8
75
src/blob.c
75
src/blob.c
|
@ -13,3 +13,78 @@ pic_blob_new(pic_state *pic, char *dat, int len)
|
||||||
bv->len = len;
|
bv->len = len;
|
||||||
return bv;
|
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);
|
||||||
|
}
|
||||||
|
|
|
@ -14,6 +14,7 @@ void pic_init_file(pic_state *);
|
||||||
void pic_init_proc(pic_state *);
|
void pic_init_proc(pic_state *);
|
||||||
void pic_init_symbol(pic_state *);
|
void pic_init_symbol(pic_state *);
|
||||||
void pic_init_vector(pic_state *);
|
void pic_init_vector(pic_state *);
|
||||||
|
void pic_init_blob(pic_state *);
|
||||||
|
|
||||||
void
|
void
|
||||||
pic_load_stdlib(pic_state *pic)
|
pic_load_stdlib(pic_state *pic)
|
||||||
|
@ -77,6 +78,7 @@ pic_init_core(pic_state *pic)
|
||||||
pic_init_proc(pic); DONE;
|
pic_init_proc(pic); DONE;
|
||||||
pic_init_symbol(pic); DONE;
|
pic_init_symbol(pic); DONE;
|
||||||
pic_init_vector(pic); DONE;
|
pic_init_vector(pic); DONE;
|
||||||
|
pic_init_blob(pic); DONE;
|
||||||
|
|
||||||
pic_load_stdlib(pic); DONE;
|
pic_load_stdlib(pic); DONE;
|
||||||
}
|
}
|
||||||
|
|
19
src/vm.c
19
src/vm.c
|
@ -6,6 +6,7 @@
|
||||||
#include "picrin/pair.h"
|
#include "picrin/pair.h"
|
||||||
#include "picrin/proc.h"
|
#include "picrin/proc.h"
|
||||||
#include "picrin/irep.h"
|
#include "picrin/irep.h"
|
||||||
|
#include "picrin/blob.h"
|
||||||
|
|
||||||
#define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)])
|
#define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)])
|
||||||
|
|
||||||
|
@ -185,6 +186,24 @@ pic_get_args(pic_state *pic, const char *format, ...)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
break;
|
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:
|
default:
|
||||||
{
|
{
|
||||||
pic_error(pic, "pic_get_args: invalid argument specifier given");
|
pic_error(pic, "pic_get_args: invalid argument specifier given");
|
||||||
|
|
Loading…
Reference in New Issue