static pic_value
pic_blob_bytevector_copy_i(pic_state *pic)
{
pic_blob *to, *from;
int n;
size_t at, start, end;
n = pic_get_args(pic, "bkb|kk", &to, &at, &from, &start, &end);
switch (n) {
case 3:
start = 0;
case 4:
end = from->len;
}
if (to == from && (start <= at && at < end)) {
/* copy in reversed order */
at += end - start;
while (start < end) {
to->data[--at] = from->data[--end];
}
return pic_none_value();
}
while (start < end) {
to->data[at++] = from->data[start++];
}
return pic_none_value();
}
static pic_value
pic_port_write_blob(pic_state *pic)
{
struct pic_blob *blob;
struct pic_port *port;
int n;
size_t start, end, i;
n = pic_get_args(pic, "b|pkk", &blob, &port, &start, &end);
switch (n) {
case 1:
port = pic_stdout(pic);
case 2:
start = 0;
case 3:
end = blob->len;
}
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, PIC_PORT_OPEN, "write-bytevector");
for (i = start; i < end; ++i) {
xfputc(blob->data[i], port->file);
}
return pic_none_value();
}
static pic_value
pic_proc_for_each(pic_state *pic)
{
struct pic_proc *proc;
size_t argc;
pic_value *args;
int i;
pic_value cars;
pic_get_args(pic, "l*", &proc, &argc, &args);
do {
cars = pic_nil_value();
for (i = argc - 1; i >= 0; --i) {
if (! pic_pair_p(args[i])) {
break;
}
cars = pic_cons(pic, pic_car(pic, args[i]), cars);
args[i] = pic_cdr(pic, args[i]);
}
if (i >= 0)
break;
pic_apply(pic, proc, cars);
} while (1);
return pic_none_value();
}
static pic_value
pic_port_close_port(pic_state *pic)
{
struct pic_port *port;
pic_get_args(pic, "p", &port);
pic_close_port(pic, port);
return pic_none_value();
}
void
pic_vec_extend_ip(pic_state *pic, struct pic_vector *vec, size_t size)
{
size_t len, i;
len = vec->len;
vec->len = size;
vec->data = (pic_value *)pic_realloc(pic, vec->data, sizeof(pic_value) * size);
for (i = len; i < size; ++i) {
vec->data[i] = pic_none_value();
}
}
static pic_value
pic_port_flush(pic_state *pic)
{
struct pic_port *port = pic_stdout(pic);
pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_OUT, PIC_PORT_OPEN, "flush-output-port");
xfflush(port->file);
return pic_none_value();
}
static pic_value
pic_port_newline(pic_state *pic)
{
struct pic_port *port = pic_stdout(pic);
pic_get_args(pic, "|p", &port);
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, PIC_PORT_OPEN, "newline");
xfputs("\n", port->file);
return pic_none_value();
}
pic_value
pic_file_delete(pic_state *pic)
{
char *fname;
pic_get_args(pic, "z", &fname);
if (remove(fname) != 0) {
file_error(pic, "file cannot be deleted");
}
return pic_none_value();
}
static pic_value
pic_port_write_byte(pic_state *pic)
{
int i;
struct pic_port *port = pic_stdout(pic);
pic_get_args(pic, "i|p", &i, &port);
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, PIC_PORT_OPEN, "write-u8");
xfputc(i, port->file);
return pic_none_value();
}
static pic_value
pic_port_write_char(pic_state *pic)
{
char c;
struct pic_port *port = pic_stdout(pic);
pic_get_args(pic, "c|p", &c, &port);
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, PIC_PORT_OPEN, "write-char");
xfputc(c, port->file);
return pic_none_value();
}
struct pic_vector *
pic_vec_new(pic_state *pic, size_t len)
{
struct pic_vector *vec;
size_t i;
vec = (struct pic_vector *)pic_obj_alloc(pic, sizeof(struct pic_vector), PIC_TT_VECTOR);
vec->len = len;
vec->data = (pic_value *)pic_alloc(pic, sizeof(pic_value) * len);
for (i = 0; i < len; ++i) {
vec->data[i] = pic_none_value();
}
return vec;
}
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_errorf(pic, "byte out of range");
bv->data[k] = (unsigned char)v;
return pic_none_value();
}
static pic_value
pic_vec_vector_set(pic_state *pic)
{
struct pic_vector *v;
int k;
pic_value o;
pic_get_args(pic, "vio", &v, &k, &o);
if (k < 0 || v->len <= (size_t)k) {
pic_error(pic, "vector-set!: index out of range");
}
v->data[k] = o;
return pic_none_value();
}
static pic_value
pic_port_write_string(pic_state *pic)
{
char *str;
struct pic_port *port;
int start, end, n, i;
n = pic_get_args(pic, "z|pii", &str, &port, &start, &end);
switch (n) {
case 1:
port = pic_stdout(pic);
case 2:
start = 0;
case 3:
end = INT_MAX;
}
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_TEXT, PIC_PORT_OPEN, "write-string");
for (i = start; i < end && str[i] != '\0'; ++i) {
xfputc(str[i], port->file);
}
return pic_none_value();
}
