conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'iso-c-compliance'

This commit is contained in:
Yuichi Nishiwaki 2014-09-27 20:44:08 +09:00
parent 5748cec548 1b37102676
commit ad04bfb9fb
19 changed files with 292 additions and 232 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
blob.c
View File

@ -60,17 +60,15 @@ static pic_value
pic_blob_make_bytevector(pic_state *pic) pic_blob_make_bytevector(pic_state *pic)
{ {
pic_blob *blob; pic_blob *blob;
int k, b = 0, i; size_t k, i;
int b = 0;
pic_get_args(pic, "i|i", &k, &b); pic_get_args(pic, "k|i", &k, &b);
if (b < 0 || b > 255) if (b < 0 || b > 255)
pic_errorf(pic, "byte out of range"); pic_errorf(pic, "byte out of range");
if (k < 0) blob = pic_make_blob(pic, k);
pic_errorf(pic, "make-bytevector: cannot create a bytevector of length %d", k);
blob = pic_make_blob(pic, (size_t)k);
for (i = 0; i < k; ++i) { for (i = 0; i < k; ++i) {
blob->data[i] = (unsigned char)b; blob->data[i] = (unsigned char)b;
} }
@ -85,7 +83,7 @@ pic_blob_bytevector_length(pic_state *pic)
pic_get_args(pic, "b", &bv); pic_get_args(pic, "b", &bv);
return pic_int_value((int)bv->len); return pic_size_value(bv->len);
} }
static pic_value static pic_value
@ -118,15 +116,16 @@ static pic_value
pic_blob_bytevector_copy_i(pic_state *pic) pic_blob_bytevector_copy_i(pic_state *pic)
{ {
pic_blob *to, *from; pic_blob *to, *from;
int n, at, start, end; int n;
size_t at, start, end;
n = pic_get_args(pic, "bib|ii", &to, &at, &from, &start, &end); n = pic_get_args(pic, "bkb|kk", &to, &at, &from, &start, &end);
switch (n) { switch (n) {
case 3: case 3:
start = 0; start = 0;
case 4: case 4:
end = (int)from->len; end = from->len;
} }
if (to == from && (start <= at && at < end)) { if (to == from && (start <= at && at < end)) {
@ -149,23 +148,23 @@ static pic_value
pic_blob_bytevector_copy(pic_state *pic) pic_blob_bytevector_copy(pic_state *pic)
{ {
pic_blob *from, *to; pic_blob *from, *to;
int n, start, end, k, i = 0; int n;
size_t start, end, i = 0;
n = pic_get_args(pic, "b|ii", &from, &start, &end); n = pic_get_args(pic, "b|kk", &from, &start, &end);
switch (n) { switch (n) {
case 1: case 1:
start = 0; start = 0;
case 2: case 2:
end = (int)from->len; end = from->len;
} }
k = end - start; if (end < start) {
pic_errorf(pic, "make-bytevector: end index must not be less than start index");
}
if (k < 0) to = pic_make_blob(pic, end - start);
pic_errorf(pic, "make-bytevector: cannot create a bytevector of length %d", k);
to = pic_make_blob(pic, (size_t)k);
while (start < end) { while (start < end) {
to->data[i++] = from->data[start++]; to->data[i++] = from->data[start++];
} }
@ -210,7 +209,7 @@ pic_blob_list_to_bytevector(pic_state *pic)
pic_get_args(pic, "o", &list); pic_get_args(pic, "o", &list);
blob = pic_make_blob(pic, (size_t)pic_length(pic, list)); blob = pic_make_blob(pic, pic_length(pic, list));
data = blob->data; data = blob->data;
@ -230,15 +229,16 @@ pic_blob_bytevector_to_list(pic_state *pic)
{ {
pic_blob *blob; pic_blob *blob;
pic_value list; pic_value list;
int n, start, end, i; int n;
size_t start, end, i;
n = pic_get_args(pic, "b|ii", &blob, &start, &end); n = pic_get_args(pic, "b|kk", &blob, &start, &end);
switch (n) { switch (n) {
case 1: case 1:
start = 0; start = 0;
case 2: case 2:
end = (int)blob->len; end = blob->len;
} }
list = pic_nil_value(); list = pic_nil_value();

3
char.c
View File

@ -42,9 +42,8 @@ pic_char_integer_to_char(pic_state *pic)
static pic_value \ static pic_value \
pic_char_##name##_p(pic_state *pic) \ pic_char_##name##_p(pic_state *pic) \
{ \ { \
size_t argc; \ size_t argc, i; \
pic_value *argv; \ pic_value *argv; \
size_t i; \
char c, d; \ char c, d; \
\ \
pic_get_args(pic, "cc*", &c, &d, &argc, &argv); \ pic_get_args(pic, "cc*", &c, &d, &argc, &argv); \

35
codegen.c
View File

@ -490,7 +490,6 @@ analyze_if(analyze_state *state, pic_value obj, bool tailpos)
switch (pic_length(pic, obj)) { switch (pic_length(pic, obj)) {
default: default:
pic_errorf(pic, "syntax error"); pic_errorf(pic, "syntax error");
break;
case 4: case 4:
if_false = pic_list_ref(pic, obj, 3); if_false = pic_list_ref(pic, obj, 3);
FALLTHROUGH; FALLTHROUGH;
@ -956,7 +955,7 @@ create_activation(codegen_context *cxt)
if ((n = xh_val(xh_get_int(&regs, *var), size_t)) <= xv_size(&cxt->args) || (cxt->varg && n == xv_size(&cxt->args) + 1)) { if ((n = xh_val(xh_get_int(&regs, *var), size_t)) <= xv_size(&cxt->args) || (cxt->varg && n == xv_size(&cxt->args) + 1)) {
/* copy arguments to capture variable area */ /* copy arguments to capture variable area */
cxt->code[cxt->clen].insn = OP_LREF; cxt->code[cxt->clen].insn = OP_LREF;
cxt->code[cxt->clen].u.i = n; cxt->code[cxt->clen].u.i = (int)n;
cxt->clen++; cxt->clen++;
} else { } else {
/* otherwise, just extend the stack */ /* otherwise, just extend the stack */
@ -1030,9 +1029,9 @@ pop_codegen_context(codegen_state *state)
irep = (struct pic_irep *)pic_obj_alloc(pic, sizeof(struct pic_irep), PIC_TT_IREP); irep = (struct pic_irep *)pic_obj_alloc(pic, sizeof(struct pic_irep), PIC_TT_IREP);
irep->name = state->cxt->name; irep->name = state->cxt->name;
irep->varg = state->cxt->varg; irep->varg = state->cxt->varg;
irep->argc = xv_size(&state->cxt->args) + 1; irep->argc = (int)xv_size(&state->cxt->args) + 1;
irep->localc = xv_size(&state->cxt->locals); irep->localc = (int)xv_size(&state->cxt->locals);
irep->capturec = xv_size(&state->cxt->captures); irep->capturec = (int)xv_size(&state->cxt->captures);
irep->code = pic_realloc(pic, state->cxt->code, sizeof(pic_code) * state->cxt->clen); irep->code = pic_realloc(pic, state->cxt->code, sizeof(pic_code) * state->cxt->clen);
irep->clen = state->cxt->clen; irep->clen = state->cxt->clen;
irep->irep = pic_realloc(pic, state->cxt->irep, sizeof(struct pic_irep *) * state->cxt->ilen); irep->irep = pic_realloc(pic, state->cxt->irep, sizeof(struct pic_irep *) * state->cxt->ilen);
@ -1067,7 +1066,7 @@ index_capture(codegen_state *state, pic_sym sym, int depth)
for (i = 0; i < xv_size(&cxt->captures); ++i) { for (i = 0; i < xv_size(&cxt->captures); ++i) {
var = xv_get(&cxt->captures, i); var = xv_get(&cxt->captures, i);
if (*var == sym) if (*var == sym)
return i; return (int)i;
} }
return -1; return -1;
} }
@ -1083,13 +1082,13 @@ index_local(codegen_state *state, pic_sym sym)
for (i = 0; i < xv_size(&cxt->args); ++i) { for (i = 0; i < xv_size(&cxt->args); ++i) {
var = xv_get(&cxt->args, i); var = xv_get(&cxt->args, i);
if (*var == sym) if (*var == sym)
return i + offset; return (int)(i + offset);
} }
offset += i; offset += i;
for (i = 0; i < xv_size(&cxt->locals); ++i) { for (i = 0; i < xv_size(&cxt->locals); ++i) {
var = xv_get(&cxt->locals, i); var = xv_get(&cxt->locals, i);
if (*var == sym) if (*var == sym)
return i + offset; return (int)(i + offset);
} }
return -1; return -1;
} }
@ -1127,7 +1126,7 @@ codegen(codegen_state *state, pic_value obj)
name = pic_sym(pic_list_ref(pic, obj, 1)); name = pic_sym(pic_list_ref(pic, obj, 1));
if ((i = index_capture(state, name, 0)) != -1) { if ((i = index_capture(state, name, 0)) != -1) {
cxt->code[cxt->clen].insn = OP_LREF; cxt->code[cxt->clen].insn = OP_LREF;
cxt->code[cxt->clen].u.i = i + xv_size(&cxt->args) + xv_size(&cxt->locals) + 1; cxt->code[cxt->clen].u.i = i + (int)xv_size(&cxt->args) + (int)xv_size(&cxt->locals) + 1;
cxt->clen++; cxt->clen++;
return; return;
} }
@ -1173,7 +1172,7 @@ codegen(codegen_state *state, pic_value obj)
name = pic_sym(pic_list_ref(pic, var, 1)); name = pic_sym(pic_list_ref(pic, var, 1));
if ((i = index_capture(state, name, 0)) != -1) { if ((i = index_capture(state, name, 0)) != -1) {
cxt->code[cxt->clen].insn = OP_LSET; cxt->code[cxt->clen].insn = OP_LSET;
cxt->code[cxt->clen].u.i = i + xv_size(&cxt->args) + xv_size(&cxt->locals) + 1; cxt->code[cxt->clen].u.i = i + (int)xv_size(&cxt->args) + (int)xv_size(&cxt->locals) + 1;
cxt->clen++; cxt->clen++;
cxt->code[cxt->clen].insn = OP_PUSHNONE; cxt->code[cxt->clen].insn = OP_PUSHNONE;
cxt->clen++; cxt->clen++;
@ -1194,7 +1193,7 @@ codegen(codegen_state *state, pic_value obj)
cxt->icapa *= 2; cxt->icapa *= 2;
cxt->irep = pic_realloc(pic, cxt->irep, sizeof(struct pic_irep *) * cxt->icapa); cxt->irep = pic_realloc(pic, cxt->irep, sizeof(struct pic_irep *) * cxt->icapa);
} }
k = cxt->ilen++; k = (int)cxt->ilen++;
cxt->code[cxt->clen].insn = OP_LAMBDA; cxt->code[cxt->clen].insn = OP_LAMBDA;
cxt->code[cxt->clen].u.i = k; cxt->code[cxt->clen].u.i = k;
cxt->clen++; cxt->clen++;
@ -1208,18 +1207,18 @@ codegen(codegen_state *state, pic_value obj)
codegen(state, pic_list_ref(pic, obj, 1)); codegen(state, pic_list_ref(pic, obj, 1));
cxt->code[cxt->clen].insn = OP_JMPIF; cxt->code[cxt->clen].insn = OP_JMPIF;
s = cxt->clen++; s = (int)cxt->clen++;
/* if false branch */ /* if false branch */
codegen(state, pic_list_ref(pic, obj, 3)); codegen(state, pic_list_ref(pic, obj, 3));
cxt->code[cxt->clen].insn = OP_JMP; cxt->code[cxt->clen].insn = OP_JMP;
t = cxt->clen++; t = (int)cxt->clen++;
cxt->code[s].u.i = cxt->clen - s; cxt->code[s].u.i = (int)cxt->clen - s;
/* if true branch */ /* if true branch */
codegen(state, pic_list_ref(pic, obj, 2)); codegen(state, pic_list_ref(pic, obj, 2));
cxt->code[t].u.i = cxt->clen - t; cxt->code[t].u.i = (int)cxt->clen - t;
return; return;
} }
else if (sym == pic->sBEGIN) { else if (sym == pic->sBEGIN) {
@ -1267,7 +1266,7 @@ codegen(codegen_state *state, pic_value obj)
cxt->pcapa *= 2; cxt->pcapa *= 2;
cxt->pool = pic_realloc(pic, cxt->pool, sizeof(pic_value) * cxt->pcapa); cxt->pool = pic_realloc(pic, cxt->pool, sizeof(pic_value) * cxt->pcapa);
} }
pidx = cxt->plen++; pidx = (int)cxt->plen++;
cxt->pool[pidx] = obj; cxt->pool[pidx] = obj;
cxt->code[cxt->clen].insn = OP_PUSHCONST; cxt->code[cxt->clen].insn = OP_PUSHCONST;
cxt->code[cxt->clen].u.i = pidx; cxt->code[cxt->clen].u.i = pidx;
@ -1376,7 +1375,7 @@ codegen(codegen_state *state, pic_value obj)
return; return;
} }
else if (sym == state->sCALL || sym == state->sTAILCALL) { else if (sym == state->sCALL || sym == state->sTAILCALL) {
int len = pic_length(pic, obj); int len = (int)pic_length(pic, obj);
pic_value elt; pic_value elt;
pic_for_each (elt, pic_cdr(pic, obj)) { pic_for_each (elt, pic_cdr(pic, obj)) {
@ -1402,7 +1401,7 @@ codegen(codegen_state *state, pic_value obj)
return; return;
} }
else if (sym == state->sRETURN) { else if (sym == state->sRETURN) {
int len = pic_length(pic, obj); int len = (int)pic_length(pic, obj);
pic_value elt; pic_value elt;
pic_for_each (elt, pic_cdr(pic, obj)) { pic_for_each (elt, pic_cdr(pic, obj)) {

6
cont.c
View File

@ -191,7 +191,7 @@ pic_values_by_array(pic_state *pic, size_t argc, pic_value *argv)
for (i = 0; i < argc; ++i) { for (i = 0; i < argc; ++i) {
pic->sp[i] = argv[i]; pic->sp[i] = argv[i];
} }
pic->ci->retc = argc; pic->ci->retc = (int)argc;
return argc == 0 ? pic_none_value() : pic->sp[0]; return argc == 0 ? pic_none_value() : pic->sp[0];
} }
@ -200,7 +200,7 @@ pic_value
pic_values_by_list(pic_state *pic, pic_value list) pic_values_by_list(pic_state *pic, pic_value list)
{ {
pic_value v; pic_value v;
size_t i; int i;
i = 0; i = 0;
pic_for_each (v, list) { pic_for_each (v, list) {
@ -219,7 +219,7 @@ pic_receive(pic_state *pic, size_t n, pic_value *argv)
/* take info from discarded frame */ /* take info from discarded frame */
ci = pic->ci + 1; ci = pic->ci + 1;
retc = ci->retc; retc = (size_t)ci->retc;
for (i = 0; i < retc && i < n; ++i) { for (i = 0; i < retc && i < n; ++i) {
argv[i] = ci->fp[i]; argv[i] = ci->fp[i];

12
dict.c
View File

@ -12,11 +12,13 @@ xh_value_hash(const void *key, void *data)
{ {
union { double f; int i; } u; union { double f; int i; } u;
pic_value val = *(pic_value *)key; pic_value val = *(pic_value *)key;
int hash; int hash, vtype;
UNUSED(data); UNUSED(data);
switch (pic_vtype(val)) { vtype = pic_vtype(val);
switch (vtype) {
default: default:
hash = 0; hash = 0;
break; break;
@ -31,11 +33,11 @@ xh_value_hash(const void *key, void *data)
hash = pic_int(val); hash = pic_int(val);
break; break;
case PIC_VTYPE_HEAP: case PIC_VTYPE_HEAP:
hash = (int)pic_ptr(val); hash = (int)(intptr_t)pic_ptr(val);
break; break;
} }
return hash + (int)pic_vtype(val); return hash + vtype;
} }
static int static int
@ -213,7 +215,7 @@ pic_dict_dictionary_size(pic_state *pic)
pic_get_args(pic, "d", &dict); pic_get_args(pic, "d", &dict);
return pic_int_value((int)pic_dict_size(pic, dict)); return pic_size_value(pic_dict_size(pic, dict));
} }
static pic_value static pic_value

10
error.c
View File

@ -90,7 +90,8 @@ void
pic_push_try(pic_state *pic, struct pic_escape *escape) pic_push_try(pic_state *pic, struct pic_escape *escape)
{ {
struct pic_proc *cont, *handler; struct pic_proc *cont, *handler;
size_t xp_len, xp_offset; size_t xp_len;
ptrdiff_t xp_offset;
cont = pic_make_econt(pic, escape); cont = pic_make_econt(pic, escape);
@ -99,7 +100,7 @@ pic_push_try(pic_state *pic, struct pic_escape *escape)
pic_attr_set(pic, pic_obj_value(handler), "@@escape", pic_obj_value(cont)); pic_attr_set(pic, pic_obj_value(handler), "@@escape", pic_obj_value(cont));
if (pic->xp >= pic->xpend) { if (pic->xp >= pic->xpend) {
xp_len = (pic->xpend - pic->xpbase) * 2; xp_len = (size_t)(pic->xpend - pic->xpbase) * 2;
xp_offset = pic->xp - pic->xpbase; xp_offset = pic->xp - pic->xpbase;
pic->xpbase = pic_realloc(pic, pic->xpbase, sizeof(struct pic_proc *) * xp_len); pic->xpbase = pic_realloc(pic, pic->xpbase, sizeof(struct pic_proc *) * xp_len);
pic->xp = pic->xpbase + xp_offset; pic->xp = pic->xpbase + xp_offset;
@ -198,12 +199,13 @@ pic_error_with_exception_handler(pic_state *pic)
{ {
struct pic_proc *handler, *thunk; struct pic_proc *handler, *thunk;
pic_value val; pic_value val;
size_t xp_len, xp_offset; size_t xp_len;
ptrdiff_t xp_offset;
pic_get_args(pic, "ll", &handler, &thunk); pic_get_args(pic, "ll", &handler, &thunk);
if (pic->xp >= pic->xpend) { if (pic->xp >= pic->xpend) {
xp_len = (pic->xpend - pic->xpbase) * 2; xp_len = (size_t)(pic->xpend - pic->xpbase) * 2;
xp_offset = pic->xp - pic->xpbase; xp_offset = pic->xp - pic->xpbase;
pic->xpbase = pic_realloc(pic, pic->xpbase, sizeof(struct pic_proc *) * xp_len); pic->xpbase = pic_realloc(pic, pic->xpbase, sizeof(struct pic_proc *) * xp_len);
pic->xp = pic->xpbase + xp_offset; pic->xp = pic->xpbase + xp_offset;

4
include/picrin/irep.h
View File

@ -52,8 +52,8 @@ struct pic_code {
int i; int i;
char c; char c;
struct { struct {
short depth; int depth;
short idx; int idx;
} r; } r;
} u; } u;
}; };

10
include/picrin/pair.h
View File

@ -57,7 +57,7 @@ pic_value pic_list5(pic_state *, pic_value, pic_value, pic_value, pic_value, pic
pic_value pic_list6(pic_state *, pic_value, pic_value, pic_value, pic_value, pic_value, pic_value); pic_value pic_list6(pic_state *, pic_value, pic_value, pic_value, pic_value, pic_value, pic_value);
pic_value pic_list7(pic_state *, pic_value, pic_value, pic_value, pic_value, pic_value, pic_value, pic_value); pic_value pic_list7(pic_state *, pic_value, pic_value, pic_value, pic_value, pic_value, pic_value, pic_value);
pic_value pic_list_by_array(pic_state *, size_t, pic_value *); pic_value pic_list_by_array(pic_state *, size_t, pic_value *);
pic_value pic_make_list(pic_state *, int, pic_value); pic_value pic_make_list(pic_state *, size_t, pic_value);
#define pic_for_each(var, list) \ #define pic_for_each(var, list) \
pic_for_each_helper_(var, GENSYM(tmp), list) pic_for_each_helper_(var, GENSYM(tmp), list)
@ -69,7 +69,7 @@ pic_value pic_make_list(pic_state *, int, pic_value);
#define pic_push(pic, item, place) (place = pic_cons(pic, item, place)) #define pic_push(pic, item, place) (place = pic_cons(pic, item, place))
#define pic_pop(pic, place) (place = pic_cdr(pic, place)) #define pic_pop(pic, place) (place = pic_cdr(pic, place))
int pic_length(pic_state *, pic_value); size_t pic_length(pic_state *, pic_value);
pic_value pic_reverse(pic_state *, pic_value); pic_value pic_reverse(pic_state *, pic_value);
pic_value pic_append(pic_state *, pic_value, pic_value); pic_value pic_append(pic_state *, pic_value, pic_value);
@ -88,9 +88,9 @@ pic_value pic_cadr(pic_state *, pic_value);
pic_value pic_cdar(pic_state *, pic_value); pic_value pic_cdar(pic_state *, pic_value);
pic_value pic_cddr(pic_state *, pic_value); pic_value pic_cddr(pic_state *, pic_value);
pic_value pic_list_tail(pic_state *, pic_value, int); pic_value pic_list_tail(pic_state *, pic_value, size_t);
pic_value pic_list_ref(pic_state *, pic_value, int); pic_value pic_list_ref(pic_state *, pic_value, size_t);
void pic_list_set(pic_state *, pic_value, int, pic_value); void pic_list_set(pic_state *, pic_value, size_t, pic_value);
pic_value pic_list_copy(pic_state *, pic_value); pic_value pic_list_copy(pic_state *, pic_value);
#if defined(__cplusplus) #if defined(__cplusplus)

12
include/picrin/value.h
View File

@ -189,6 +189,7 @@ static inline pic_value pic_undef_value();
static inline pic_value pic_obj_value(void *); static inline pic_value pic_obj_value(void *);
static inline pic_value pic_float_value(double); static inline pic_value pic_float_value(double);
static inline pic_value pic_int_value(int); static inline pic_value pic_int_value(int);
static inline pic_value pic_size_value(size_t);
static inline pic_value pic_sym_value(pic_sym); static inline pic_value pic_sym_value(pic_sym);
static inline pic_value pic_char_value(char c); static inline pic_value pic_char_value(char c);
static inline pic_value pic_none_value(); static inline pic_value pic_none_value();
@ -323,6 +324,17 @@ pic_bool_value(bool b)
return v; return v;
} }
static inline pic_value
pic_size_value(size_t s)
{
if (sizeof(unsigned) < sizeof(size_t)) {
if (s > (size_t)INT_MAX) {
return pic_float_value(s);
}
}
return pic_int_value((int)s);
}
#if PIC_NAN_BOXING #if PIC_NAN_BOXING
static inline pic_value static inline pic_value

9
number.c
View File

@ -162,9 +162,8 @@ pic_number_nan_p(pic_state *pic)
static pic_value \ static pic_value \
pic_number_##name(pic_state *pic) \ pic_number_##name(pic_state *pic) \
{ \ { \
size_t argc; \ size_t argc, i; \
pic_value *argv; \ pic_value *argv; \
size_t i; \
double f,g; \ double f,g; \
\ \
pic_get_args(pic, "ff*", &f, &g, &argc, &argv); \ pic_get_args(pic, "ff*", &f, &g, &argc, &argv); \
@ -198,9 +197,8 @@ DEFINE_ARITH_CMP(>=, ge)
static pic_value \ static pic_value \
pic_number_##name(pic_state *pic) \ pic_number_##name(pic_state *pic) \
{ \ { \
size_t argc; \ size_t argc, i; \
pic_value *argv; \ pic_value *argv; \
size_t i; \
double f; \ double f; \
bool e = true; \ bool e = true; \
\ \
@ -230,9 +228,8 @@ DEFINE_ARITH_OP(*, mul, 1)
static pic_value \ static pic_value \
pic_number_##name(pic_state *pic) \ pic_number_##name(pic_state *pic) \
{ \ { \
size_t argc; \ size_t argc, i; \
pic_value *argv; \ pic_value *argv; \
size_t i; \
double f; \ double f; \
bool e; \ bool e; \
\ \

64
pair.c
View File

@ -172,10 +172,10 @@ pic_list_by_array(pic_state *pic, size_t c, pic_value *vs)
} }
pic_value pic_value
pic_make_list(pic_state *pic, int k, pic_value fill) pic_make_list(pic_state *pic, size_t k, pic_value fill)
{ {
pic_value list; pic_value list;
int i; size_t i;
list = pic_nil_value(); list = pic_nil_value();
for (i = 0; i < k; ++i) { for (i = 0; i < k; ++i) {
@ -185,10 +185,10 @@ pic_make_list(pic_state *pic, int k, pic_value fill)
return list; return list;
} }
int size_t
pic_length(pic_state *pic, pic_value obj) pic_length(pic_state *pic, pic_value obj)
{ {
int c = 0; size_t c = 0;
if (! pic_list_p(obj)) { if (! pic_list_p(obj)) {
pic_errorf(pic, "length: expected list, but got ~s", obj); pic_errorf(pic, "length: expected list, but got ~s", obj);
@ -375,7 +375,7 @@ pic_cddr(pic_state *pic, pic_value v)
} }
pic_value pic_value
pic_list_tail(pic_state *pic, pic_value list, int i) pic_list_tail(pic_state *pic, pic_value list, size_t i)
{ {
while (i-- > 0) { while (i-- > 0) {
list = pic_cdr(pic, list); list = pic_cdr(pic, list);
@ -384,13 +384,13 @@ pic_list_tail(pic_state *pic, pic_value list, int i)
} }
pic_value pic_value
pic_list_ref(pic_state *pic, pic_value list, int i) pic_list_ref(pic_state *pic, pic_value list, size_t i)
{ {
return pic_car(pic, pic_list_tail(pic, list, i)); return pic_car(pic, pic_list_tail(pic, list, i));
} }
void void
pic_list_set(pic_state *pic, pic_value list, int i, pic_value obj) pic_list_set(pic_state *pic, pic_value list, size_t i, pic_value obj)
{ {
pic_pair_ptr(pic_list_tail(pic, list, i))->car = obj; pic_pair_ptr(pic_list_tail(pic, list, i))->car = obj;
} }
@ -533,10 +533,10 @@ pic_pair_list_p(pic_state *pic)
static pic_value static pic_value
pic_pair_make_list(pic_state *pic) pic_pair_make_list(pic_state *pic)
{ {
int i; size_t i;
pic_value fill = pic_none_value(); pic_value fill = pic_none_value();
pic_get_args(pic, "i|o", &i, &fill); pic_get_args(pic, "k|o", &i, &fill);
return pic_make_list(pic, i, fill); return pic_make_list(pic, i, fill);
} }
@ -559,7 +559,7 @@ pic_pair_length(pic_state *pic)
pic_get_args(pic, "o", &list); pic_get_args(pic, "o", &list);
return pic_int_value(pic_length(pic, list)); return pic_size_value(pic_length(pic, list));
} }
static pic_value static pic_value
@ -596,9 +596,9 @@ static pic_value
pic_pair_list_tail(pic_state *pic) pic_pair_list_tail(pic_state *pic)
{ {
pic_value list; pic_value list;
int i; size_t i;
pic_get_args(pic, "oi", &list, &i); pic_get_args(pic, "ok", &list, &i);
return pic_list_tail(pic, list, i); return pic_list_tail(pic, list, i);
} }
@ -607,9 +607,9 @@ static pic_value
pic_pair_list_ref(pic_state *pic) pic_pair_list_ref(pic_state *pic)
{ {
pic_value list; pic_value list;
int i; size_t i;
pic_get_args(pic, "oi", &list, &i); pic_get_args(pic, "ok", &list, &i);
return pic_list_ref(pic, list, i); return pic_list_ref(pic, list, i);
} }
@ -618,9 +618,9 @@ static pic_value
pic_pair_list_set(pic_state *pic) pic_pair_list_set(pic_state *pic)
{ {
pic_value list, obj; pic_value list, obj;
int i; size_t i;
pic_get_args(pic, "oio", &list, &i, &obj); pic_get_args(pic, "oko", &list, &i, &obj);
pic_list_set(pic, list, i, obj); pic_list_set(pic, list, i, obj);
@ -641,26 +641,26 @@ static pic_value
pic_pair_map(pic_state *pic) pic_pair_map(pic_state *pic)
{ {
struct pic_proc *proc; struct pic_proc *proc;
size_t argc; size_t argc, i;
pic_value *args; pic_value *args;
int i; pic_value arg, ret;
pic_value cars, ret;
pic_get_args(pic, "l*", &proc, &argc, &args); pic_get_args(pic, "l*", &proc, &argc, &args);
ret = pic_nil_value(); ret = pic_nil_value();
do { do {
cars = pic_nil_value(); arg = pic_nil_value();
for (i = argc - 1; i >= 0; --i) { for (i = 0; i < argc; ++i) {
if (! pic_pair_p(args[i])) { if (! pic_pair_p(args[i])) {
break; break;
} }
cars = pic_cons(pic, pic_car(pic, args[i]), cars); pic_push(pic, pic_car(pic, args[i]), arg);
args[i] = pic_cdr(pic, args[i]); args[i] = pic_cdr(pic, args[i]);
} }
if (i >= 0) if (i != argc) {
break; break;
ret = pic_cons(pic, pic_apply(pic, proc, cars), ret); }
pic_push(pic, pic_apply(pic, proc, pic_reverse(pic, arg)), ret);
} while (1); } while (1);
return pic_reverse(pic, ret); return pic_reverse(pic, ret);
@ -670,25 +670,25 @@ static pic_value
pic_pair_for_each(pic_state *pic) pic_pair_for_each(pic_state *pic)
{ {
struct pic_proc *proc; struct pic_proc *proc;
size_t argc; size_t argc, i;
pic_value *args; pic_value *args;
int i; pic_value arg;
pic_value cars;
pic_get_args(pic, "l*", &proc, &argc, &args); pic_get_args(pic, "l*", &proc, &argc, &args);
do { do {
cars = pic_nil_value(); arg = pic_nil_value();
for (i = argc - 1; i >= 0; --i) { for (i = 0; i < argc; ++i) {
if (! pic_pair_p(args[i])) { if (! pic_pair_p(args[i])) {
break; break;
} }
cars = pic_cons(pic, pic_car(pic, args[i]), cars); pic_push(pic, pic_car(pic, args[i]), arg);
args[i] = pic_cdr(pic, args[i]); args[i] = pic_cdr(pic, args[i]);
} }
if (i >= 0) if (i != argc) {
break; break;
pic_apply(pic, proc, cars); }
pic_apply(pic, proc, pic_reverse(pic, arg));
} while (1); } while (1);
return pic_none_value(); return pic_none_value();

34
port.c
View File

@ -521,20 +521,15 @@ pic_port_read_blob(pic_state *pic)
{ {
struct pic_port *port = pic_stdin(pic); struct pic_port *port = pic_stdin(pic);
pic_blob *blob; pic_blob *blob;
int k; size_t k, i;
size_t i;
pic_get_args(pic, "i|p", &k, &port); pic_get_args(pic, "k|p", &k, &port);
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector");
if (k < 0) { blob = pic_make_blob(pic, k);
pic_errorf(pic, "read-bytevector: index must be non-negative %d", k);
}
blob = pic_make_blob(pic, (size_t)k); i = xfread(blob->data, sizeof(char), k, port->file);
i = xfread(blob->data, sizeof(char), (size_t)k, port->file);
if (i == 0) { if (i == 0) {
return pic_eof_object(); return pic_eof_object();
} }
@ -550,27 +545,27 @@ pic_port_read_blob_ip(pic_state *pic)
{ {
struct pic_port *port; struct pic_port *port;
struct pic_blob *bv; struct pic_blob *bv;
int n, start, end; int n;
char *buf; char *buf;
size_t i, len; size_t start, end, i, len;
n = pic_get_args(pic, "b|pii", &bv, &port, &start, &end); n = pic_get_args(pic, "b|pkk", &bv, &port, &start, &end);
switch (n) { switch (n) {
case 1: case 1:
port = pic_stdin(pic); port = pic_stdin(pic);
case 2: case 2:
start = 0; start = 0;
case 3: case 3:
end = (int)bv->len; end = bv->len;
} }
assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector!"); assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector!");
if (end - start < 0) { if (end < start) {
pic_errorf(pic, "read-bytevector!: end index must be greater than or equal to start index"); pic_errorf(pic, "read-bytevector!: end index must be greater than or equal to start index");
} }
len = (size_t)(end - start); len = end - start;
buf = pic_calloc(pic, len, sizeof(char)); buf = pic_calloc(pic, len, sizeof(char));
i = xfread(buf, sizeof(char), len, port->file); i = xfread(buf, sizeof(char), len, port->file);
@ -581,7 +576,7 @@ pic_port_read_blob_ip(pic_state *pic)
return pic_eof_object(); return pic_eof_object();
} }
else { else {
return pic_int_value((int)i); return pic_size_value(i);
} }
} }
@ -656,16 +651,17 @@ pic_port_write_blob(pic_state *pic)
{ {
struct pic_blob *blob; struct pic_blob *blob;
struct pic_port *port; struct pic_port *port;
int start, end, n, i; int n;
size_t start, end, i;
n = pic_get_args(pic, "b|pii", &blob, &port, &start, &end); n = pic_get_args(pic, "b|pkk", &blob, &port, &start, &end);
switch (n) { switch (n) {
case 1: case 1:
port = pic_stdout(pic); port = pic_stdout(pic);
case 2: case 2:
start = 0; start = 0;
case 3: case 3:
end = (int)blob->len; end = blob->len;
} }
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, PIC_PORT_OPEN, "write-bytevector"); assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, PIC_PORT_OPEN, "write-bytevector");

35
read.c
View File

@ -209,7 +209,7 @@ read_symbol(pic_state *pic, struct pic_port *port, const char *str)
for (i = 0; i < len; ++i) { for (i = 0; i < len; ++i) {
if (pic->reader->typecase == PIC_CASE_FOLD) { if (pic->reader->typecase == PIC_CASE_FOLD) {
buf[i] = tolower(str[i]); buf[i] = (char)tolower(str[i]);
} else { } else {
buf[i] = str[i]; buf[i] = str[i];
} }
@ -222,7 +222,7 @@ read_symbol(pic_state *pic, struct pic_port *port, const char *str)
} }
len += 1; len += 1;
buf = pic_realloc(pic, buf, len + 1); buf = pic_realloc(pic, buf, len + 1);
buf[len - 1] = c; buf[len - 1] = (char)c;
} }
sym = pic_intern(pic, buf, len); sym = pic_intern(pic, buf, len);
@ -240,9 +240,9 @@ read_uinteger(pic_state *pic, struct pic_port *port, int c, char buf[])
read_error(pic, "expected one or more digits"); read_error(pic, "expected one or more digits");
} }
buf[i++] = c; buf[i++] = (char)c;
while (isdigit(c = peek(port))) { while (isdigit(c = peek(port))) {
buf[i++] = next(port); buf[i++] = (char)next(port);
} }
buf[i] = '\0'; buf[i] = '\0';
@ -262,12 +262,12 @@ read_suffix(pic_state *pic, struct pic_port *port, char buf[])
return i; return i;
} }
buf[i++] = next(port); buf[i++] = (char)next(port);
switch ((c = next(port))) { switch ((c = next(port))) {
case '-': case '-':
case '+': case '+':
buf[i++] = c; buf[i++] = (char)c;
c = next(port); c = next(port);
default: default:
return i + read_uinteger(pic, port, c, buf + i); return i + read_uinteger(pic, port, c, buf + i);
@ -284,14 +284,14 @@ read_unsigned(pic_state *pic, struct pic_port *port, int c)
switch (peek(port)) { switch (peek(port)) {
case '.': case '.':
buf[i++] = next(port); buf[i++] = (char)next(port);
i += read_uinteger(pic, port, next(port), buf + i); i += read_uinteger(pic, port, next(port), buf + i);
read_suffix(pic, port, buf + i); read_suffix(pic, port, buf + i);
return pic_float_value(atof(buf)); return pic_float_value(atof(buf));
default: default:
read_suffix(pic, port, buf + i); read_suffix(pic, port, buf + i);
return pic_int_value((int)atof(buf)); return pic_int_value((int)(atof(buf)));
} }
} }
@ -404,7 +404,7 @@ read_char(pic_state *pic, struct pic_port *port, const char *str)
} }
} }
return pic_char_value(c); return pic_char_value((char)c);
fail: fail:
read_error(pic, "unexpected character while reading character literal"); read_error(pic, "unexpected character while reading character literal");
@ -436,7 +436,7 @@ read_string(pic_state *pic, struct pic_port *port, const char *name)
case 'r': c = '\r'; break; case 'r': c = '\r'; break;
} }
} }
buf[cnt++] = c; buf[cnt++] = (char)c;
if (cnt >= size) { if (cnt >= size) {
buf = pic_realloc(pic, buf, size *= 2); buf = pic_realloc(pic, buf, size *= 2);
} }
@ -474,15 +474,15 @@ read_pipe(pic_state *pic, struct pic_port *port, const char *str)
case 'r': c = '\r'; break; case 'r': c = '\r'; break;
case 'x': case 'x':
i = 0; i = 0;
while ((HEX_BUF[i++] = next(port)) != ';') { while ((HEX_BUF[i++] = (char)next(port)) != ';') {
if (i >= sizeof HEX_BUF) if (i >= sizeof HEX_BUF)
read_error(pic, "expected ';'"); read_error(pic, "expected ';'");
} }
c = strtol(HEX_BUF, NULL, 16); c = (char)strtol(HEX_BUF, NULL, 16);
break; break;
} }
} }
buf[cnt++] = c; buf[cnt++] = (char)c;
if (cnt >= size) { if (cnt >= size) {
buf = pic_realloc(pic, buf, size *= 2); buf = pic_realloc(pic, buf, size *= 2);
} }
@ -500,7 +500,8 @@ read_blob(pic_state *pic, struct pic_port *port, const char *str)
{ {
int nbits, n, c; int nbits, n, c;
size_t len, i; size_t len, i;
char *dat, buf[256]; char buf[256];
unsigned char *dat;
pic_blob *blob; pic_blob *blob;
UNUSED(str); UNUSED(str);
@ -530,7 +531,7 @@ read_blob(pic_state *pic, struct pic_port *port, const char *str)
} }
len += 1; len += 1;
dat = pic_realloc(pic, dat, len); dat = pic_realloc(pic, dat, len);
dat[len - 1] = n; dat[len - 1] = (unsigned char)n;
c = next(port); c = next(port);
} }
@ -710,7 +711,7 @@ read_nullable(pic_state *pic, struct pic_port *port, int c)
read_error(pic, "invalid character at the seeker head"); read_error(pic, "invalid character at the seeker head");
} }
buf[i++] = c; buf[i++] = (char)c;
while (i < sizeof buf) { while (i < sizeof buf) {
trie = trie->table[c]; trie = trie->table[c];
@ -721,7 +722,7 @@ read_nullable(pic_state *pic, struct pic_port *port, int c)
if (trie->table[c] == NULL) { if (trie->table[c] == NULL) {
break; break;
} }
buf[i++] = next(port); buf[i++] = (char)next(port);
} }
if (i == sizeof buf) { if (i == sizeof buf) {
read_error(pic, "too long dispatch string"); read_error(pic, "too long dispatch string");

36
string.c
View File

@ -233,22 +233,21 @@ pic_str_string_p(pic_state *pic)
static pic_value static pic_value
pic_str_string(pic_state *pic) pic_str_string(pic_state *pic)
{ {
size_t argc; size_t argc, i;
pic_value *argv; pic_value *argv;
pic_str *str; pic_str *str;
char *buf; char *buf;
size_t i;
pic_get_args(pic, "*", &argc, &argv); pic_get_args(pic, "*", &argc, &argv);
buf = pic_alloc(pic, argc); buf = pic_alloc(pic, (size_t)argc);
for (i = 0; i < argc; ++i) { for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], char); pic_assert_type(pic, argv[i], char);
buf[i] = pic_char(argv[i]); buf[i] = pic_char(argv[i]);
} }
str = pic_make_str(pic, buf, argc); str = pic_make_str(pic, buf, (size_t)argc);
pic_free(pic, buf); pic_free(pic, buf);
return pic_obj_value(str); return pic_obj_value(str);
@ -257,10 +256,10 @@ pic_str_string(pic_state *pic)
static pic_value static pic_value
pic_str_make_string(pic_state *pic) pic_str_make_string(pic_state *pic)
{ {
int len; size_t len;
char c = ' '; char c = ' ';
pic_get_args(pic, "i|c", &len, &c); pic_get_args(pic, "k|c", &len, &c);
return pic_obj_value(pic_make_str_fill(pic, len, c)); return pic_obj_value(pic_make_str_fill(pic, len, c));
} }
@ -272,16 +271,16 @@ pic_str_string_length(pic_state *pic)
pic_get_args(pic, "s", &str); pic_get_args(pic, "s", &str);
return pic_int_value(pic_strlen(str)); return pic_size_value(pic_strlen(str));
} }
static pic_value static pic_value
pic_str_string_ref(pic_state *pic) pic_str_string_ref(pic_state *pic)
{ {
pic_str *str; pic_str *str;
int k; size_t k;
pic_get_args(pic, "si", &str, &k); pic_get_args(pic, "sk", &str, &k);
return pic_char_value(pic_str_ref(pic, str, k)); return pic_char_value(pic_str_ref(pic, str, k));
} }
@ -290,9 +289,8 @@ pic_str_string_ref(pic_state *pic)
static pic_value \ static pic_value \
pic_str_string_##name(pic_state *pic) \ pic_str_string_##name(pic_state *pic) \
{ \ { \
size_t argc; \ size_t argc, i; \
pic_value *argv; \ pic_value *argv; \
size_t i; \
\ \
pic_get_args(pic, "*", &argc, &argv); \ pic_get_args(pic, "*", &argc, &argv); \
\ \
@ -321,9 +319,10 @@ static pic_value
pic_str_string_copy(pic_state *pic) pic_str_string_copy(pic_state *pic)
{ {
pic_str *str; pic_str *str;
int n, start, end; int n;
size_t start, end;
n = pic_get_args(pic, "s|ii", &str, &start, &end); n = pic_get_args(pic, "s|kk", &str, &start, &end);
switch (n) { switch (n) {
case 1: case 1:
@ -358,8 +357,8 @@ static pic_value
pic_str_string_map(pic_state *pic) pic_str_string_map(pic_state *pic)
{ {
struct pic_proc *proc; struct pic_proc *proc;
size_t argc, i, len, j;
pic_value *argv, vals, val; pic_value *argv, vals, val;
size_t argc, i, len, j;
pic_get_args(pic, "l*", &proc, &argc, &argv); pic_get_args(pic, "l*", &proc, &argc, &argv);
@ -396,7 +395,7 @@ static pic_value
pic_str_string_for_each(pic_state *pic) pic_str_string_for_each(pic_state *pic)
{ {
struct pic_proc *proc; struct pic_proc *proc;
size_t argc, i, len, j; size_t argc, len, i, j;
pic_value *argv, vals, val; pic_value *argv, vals, val;
pic_get_args(pic, "l*", &proc, &argc, &argv); pic_get_args(pic, "l*", &proc, &argc, &argv);
@ -429,7 +428,7 @@ pic_str_list_to_string(pic_state *pic)
{ {
pic_str *str; pic_str *str;
pic_value list, e; pic_value list, e;
int i = 0; size_t i = 0;
pic_get_args(pic, "o", &list); pic_get_args(pic, "o", &list);
@ -455,9 +454,10 @@ pic_str_string_to_list(pic_state *pic)
{ {
pic_str *str; pic_str *str;
pic_value list; pic_value list;
int n, start, end, i; int n;
size_t start, end, i;
n = pic_get_args(pic, "s|ii", &str, &start, &end); n = pic_get_args(pic, "s|kk", &str, &start, &end);
switch (n) { switch (n) {
case 1: case 1:

2
symbol.c
View File

@ -80,7 +80,7 @@ pic_ungensym(pic_state *pic, pic_sym base)
if ((occr = strrchr(name, '@')) == NULL) { if ((occr = strrchr(name, '@')) == NULL) {
pic_panic(pic, "logic flaw"); pic_panic(pic, "logic flaw");
} }
return pic_intern(pic, name, occr - name); return pic_intern(pic, name, (size_t)(occr - name));
} }
bool bool

2
system.c
View File

@ -105,7 +105,7 @@ pic_system_getenvs(pic_state *pic)
for (envp = pic->envp; *envp; ++envp) { for (envp = pic->envp; *envp; ++envp) {
pic_str *key, *val; pic_str *key, *val;
int i; size_t i;
for (i = 0; (*envp)[i] != '='; ++i) for (i = 0; (*envp)[i] != '='; ++i)
; ;

2
time.c
View File

@ -27,7 +27,7 @@ pic_current_jiffy(pic_state *pic)
pic_get_args(pic, ""); pic_get_args(pic, "");
c = clock(); c = clock();
return pic_int_value((int)c); return pic_int_value((int)c); /* The year 2038 problem :-| */
} }
static pic_value static pic_value

82
vector.c
View File

@ -26,7 +26,7 @@ struct pic_vector *
pic_make_vec_from_list(pic_state *pic, pic_value data) pic_make_vec_from_list(pic_state *pic, pic_value data)
{ {
struct pic_vector *vec; struct pic_vector *vec;
size_t i, len; size_t len, i;
len = pic_length(pic, data); len = pic_length(pic, data);
@ -51,14 +51,13 @@ pic_vec_vector_p(pic_state *pic)
static pic_value static pic_value
pic_vec_vector(pic_state *pic) pic_vec_vector(pic_state *pic)
{ {
size_t argc; size_t argc, i;
pic_value *argv; pic_value *argv;
pic_vec *vec; pic_vec *vec;
size_t i;
pic_get_args(pic, "*", &argc, &argv); pic_get_args(pic, "*", &argc, &argv);
vec = pic_make_vec(pic, argc); vec = pic_make_vec(pic, (size_t)argc);
for (i = 0; i < argc; ++i) { for (i = 0; i < argc; ++i) {
vec->data[i] = argv[i]; vec->data[i] = argv[i];
@ -71,15 +70,15 @@ static pic_value
pic_vec_make_vector(pic_state *pic) pic_vec_make_vector(pic_state *pic)
{ {
pic_value v; pic_value v;
int n, k; int n;
size_t i; size_t k, i;
struct pic_vector *vec; struct pic_vector *vec;
n = pic_get_args(pic, "i|o", &k, &v); n = pic_get_args(pic, "k|o", &k, &v);
vec = pic_make_vec(pic, k); vec = pic_make_vec(pic, k);
if (n == 2) { if (n == 2) {
for (i = 0; i < (size_t)k; ++i) { for (i = 0; i < k; ++i) {
vec->data[i] = v; vec->data[i] = v;
} }
} }
@ -93,18 +92,18 @@ pic_vec_vector_length(pic_state *pic)
pic_get_args(pic, "v", &v); pic_get_args(pic, "v", &v);
return pic_int_value(v->len); return pic_size_value(v->len);
} }
static pic_value static pic_value
pic_vec_vector_ref(pic_state *pic) pic_vec_vector_ref(pic_state *pic)
{ {
struct pic_vector *v; struct pic_vector *v;
int k; size_t k;
pic_get_args(pic, "vi", &v, &k); pic_get_args(pic, "vk", &v, &k);
if (k < 0 || v->len <= (size_t)k) { if (v->len <= k) {
pic_errorf(pic, "vector-ref: index out of range"); pic_errorf(pic, "vector-ref: index out of range");
} }
return v->data[k]; return v->data[k];
@ -114,12 +113,12 @@ static pic_value
pic_vec_vector_set(pic_state *pic) pic_vec_vector_set(pic_state *pic)
{ {
struct pic_vector *v; struct pic_vector *v;
int k; size_t k;
pic_value o; pic_value o;
pic_get_args(pic, "vio", &v, &k, &o); pic_get_args(pic, "vko", &v, &k, &o);
if (k < 0 || v->len <= (size_t)k) { if (v->len <= k) {
pic_errorf(pic, "vector-set!: index out of range"); pic_errorf(pic, "vector-set!: index out of range");
} }
v->data[k] = o; v->data[k] = o;
@ -130,9 +129,10 @@ static pic_value
pic_vec_vector_copy_i(pic_state *pic) pic_vec_vector_copy_i(pic_state *pic)
{ {
pic_vec *to, *from; pic_vec *to, *from;
int n, at, start, end; int n;
size_t at, start, end;
n = pic_get_args(pic, "viv|ii", &to, &at, &from, &start, &end); n = pic_get_args(pic, "vkv|kk", &to, &at, &from, &start, &end);
switch (n) { switch (n) {
case 3: case 3:
@ -161,9 +161,10 @@ static pic_value
pic_vec_vector_copy(pic_state *pic) pic_vec_vector_copy(pic_state *pic)
{ {
pic_vec *vec, *to; pic_vec *vec, *to;
int n, start, end, i = 0; int n;
size_t start, end, i = 0;
n = pic_get_args(pic, "v|ii", &vec, &start, &end); n = pic_get_args(pic, "v|kk", &vec, &start, &end);
switch (n) { switch (n) {
case 1: case 1:
@ -172,6 +173,10 @@ pic_vec_vector_copy(pic_state *pic)
end = vec->len; end = vec->len;
} }
if (end < start) {
pic_errorf(pic, "vector-copy: end index must not be less than start index");
}
to = pic_make_vec(pic, end - start); to = pic_make_vec(pic, end - start);
while (start < end) { while (start < end) {
to->data[i++] = vec->data[start++]; to->data[i++] = vec->data[start++];
@ -183,8 +188,8 @@ pic_vec_vector_copy(pic_state *pic)
static pic_value static pic_value
pic_vec_vector_append(pic_state *pic) pic_vec_vector_append(pic_state *pic)
{ {
size_t argc, i, j, len;
pic_value *argv; pic_value *argv;
size_t argc, i, j, len;
pic_vec *vec; pic_vec *vec;
pic_get_args(pic, "*", &argc, &argv); pic_get_args(pic, "*", &argc, &argv);
@ -213,9 +218,10 @@ pic_vec_vector_fill_i(pic_state *pic)
{ {
pic_vec *vec; pic_vec *vec;
pic_value obj; pic_value obj;
int n, start, end; int n;
size_t start, end;
n = pic_get_args(pic, "vo|ii", &vec, &obj, &start, &end); n = pic_get_args(pic, "vo|kk", &vec, &obj, &start, &end);
switch (n) { switch (n) {
case 2: case 2:
@ -241,7 +247,7 @@ pic_vec_vector_map(pic_state *pic)
pic_get_args(pic, "l*", &proc, &argc, &argv); pic_get_args(pic, "l*", &proc, &argc, &argv);
len = SIZE_MAX; len = INT_MAX;
for (i = 0; i < argc; ++i) { for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], vec); pic_assert_type(pic, argv[i], vec);
@ -272,7 +278,7 @@ pic_vec_vector_for_each(pic_state *pic)
pic_get_args(pic, "l*", &proc, &argc, &argv); pic_get_args(pic, "l*", &proc, &argc, &argv);
len = SIZE_MAX; len = INT_MAX;
for (i = 0; i < argc; ++i) { for (i = 0; i < argc; ++i) {
pic_assert_type(pic, argv[i], vec); pic_assert_type(pic, argv[i], vec);
@ -315,9 +321,10 @@ pic_vec_vector_to_list(pic_state *pic)
{ {
struct pic_vector *vec; struct pic_vector *vec;
pic_value list; pic_value list;
int n, start, end, i; int n;
size_t start, end, i;
n = pic_get_args(pic, "v|ii", &vec, &start, &end); n = pic_get_args(pic, "v|kk", &vec, &start, &end);
switch (n) { switch (n) {
case 1: case 1:
@ -339,10 +346,11 @@ pic_vec_vector_to_string(pic_state *pic)
{ {
pic_vec *vec; pic_vec *vec;
char *buf; char *buf;
int n, start, end, i; int n;
size_t start, end, i;
pic_str *str; pic_str *str;
n = pic_get_args(pic, "v|ii", &vec, &start, &end); n = pic_get_args(pic, "v|kk", &vec, &start, &end);
switch (n) { switch (n) {
case 1: case 1:
@ -351,6 +359,10 @@ pic_vec_vector_to_string(pic_state *pic)
end = vec->len; end = vec->len;
} }
if (end < start) {
pic_errorf(pic, "vector->string: end index must not be less than start index");
}
buf = pic_alloc(pic, end - start); buf = pic_alloc(pic, end - start);
for (i = start; i < end; ++i) { for (i = start; i < end; ++i) {
@ -369,10 +381,12 @@ static pic_value
pic_vec_string_to_vector(pic_state *pic) pic_vec_string_to_vector(pic_state *pic)
{ {
pic_str *str; pic_str *str;
int n, start, end, i; int n;
size_t start, end;
size_t i;
pic_vec *vec; pic_vec *vec;
n = pic_get_args(pic, "s|ii", &str, &start, &end); n = pic_get_args(pic, "s|kk", &str, &start, &end);
switch (n) { switch (n) {
case 1: case 1:
@ -381,10 +395,14 @@ pic_vec_string_to_vector(pic_state *pic)
end = pic_strlen(str); end = pic_strlen(str);
} }
if (end < start) {
pic_errorf(pic, "string->vector: end index must not be less than start index");
}
vec = pic_make_vec(pic, end - start); vec = pic_make_vec(pic, end - start);
for (i = start; i < end; ++i) { for (i = 0; i < end - start; ++i) {
vec->data[i - start] = pic_char_value(pic_str_ref(pic, str, i)); vec->data[i] = pic_char_value(pic_str_ref(pic, str, i + start));
} }
return pic_obj_value(vec); return pic_obj_value(vec);
} }

122
vm.c
View File

@ -35,26 +35,27 @@ pic_get_proc(pic_state *pic)
} }
/** /**
* char type * char type desc.
* ---- ---- * ---- ---- ----
* o object * o pic_value * object
* i int * i int * int
* I int with exactness * I int *, bool * int with exactness
* f float * k size_t * size_t implicitly converted from int
* F float with exactness * f double * float
* s string object * F double *, bool * float with exactness
* z c string * s pic_str ** string object
* m symbol * z char ** c string
* v vector object * m pic_sym * symbol
* b bytevector object * v pic_vec ** vector object
* c char * b pic_blob ** bytevector object
* l lambda object * c char * char
* p port object * l struct pic_proc ** lambda object
* d dictionary object * p struct pic_port ** port object
* e error object * d struct pic_dict ** dictionary object
* e struct pic_error ** error object
* *
* | optional operator * | optional operator
* * variable length operator * * int *, pic_value ** variable length operator
*/ */
int int
@ -196,6 +197,35 @@ pic_get_args(pic_state *pic, const char *format, ...)
} }
break; break;
} }
case 'k': {
size_t *k;
k = va_arg(ap, size_t *);
if (i < argc) {
pic_value v;
int x;
v = GET_OPERAND(pic, i);
switch (pic_type(v)) {
case PIC_TT_INT:
x = pic_int(v);
if (x < 0) {
pic_errorf(pic, "pic_get_args: expected non-negative int, but got ~s", v);
}
if (sizeof(unsigned) > sizeof(size_t)) {
if ((unsigned)x > (unsigned)SIZE_MAX) {
pic_errorf(pic, "pic_get_args: int unrepresentable with size_t ~s", v);
}
}
*k = (size_t)x;
break;
default:
pic_errorf(pic, "pic_get_args: expected int, but got ~s", v);
}
i++;
}
break;
}
case 's': { case 's': {
pic_str **str; pic_str **str;
pic_value v; pic_value v;
@ -280,14 +310,14 @@ pic_get_args(pic_state *pic, const char *format, ...)
break; break;
} }
case 'c': { case 'c': {
char *c; char *k;
pic_value v; pic_value v;
c = va_arg(ap, char *); k = va_arg(ap, char *);
if (i < argc) { if (i < argc) {
v = GET_OPERAND(pic,i); v = GET_OPERAND(pic,i);
if (pic_char_p(v)) { if (pic_char_p(v)) {
*c = pic_char(v); *k = pic_char(v);
} }
else { else {
pic_errorf(pic, "pic_get_args: expected char, but got ~s", v); pic_errorf(pic, "pic_get_args: expected char, but got ~s", v);
@ -392,7 +422,7 @@ pic_get_args(pic_state *pic, const char *format, ...)
n = va_arg(ap, size_t *); n = va_arg(ap, size_t *);
argv = va_arg(ap, pic_value **); argv = va_arg(ap, pic_value **);
if (i <= argc) { if (i <= argc) {
*n = argc - i; *n = (size_t)(argc - i);
*argv = &GET_OPERAND(pic, i); *argv = &GET_OPERAND(pic, i);
i = argc; i = argc;
} }
@ -488,7 +518,7 @@ vm_push_env(pic_state *pic)
{ {
pic_callinfo *ci = pic->ci; pic_callinfo *ci = pic->ci;
ci->env = (struct pic_env *)pic_obj_alloc(pic, offsetof(struct pic_env, storage) + sizeof(pic_value) * ci->regc, PIC_TT_ENV); ci->env = (struct pic_env *)pic_obj_alloc(pic, offsetof(struct pic_env, storage) + sizeof(pic_value) * (size_t)(ci->regc), PIC_TT_ENV);
ci->env->up = ci->up; ci->env->up = ci->up;
ci->env->regc = ci->regc; ci->env->regc = ci->regc;
ci->env->regs = ci->regs; ci->env->regs = ci->regs;
@ -581,7 +611,7 @@ pic_apply5(pic_state *pic, struct pic_proc *proc, pic_value arg1, pic_value arg2
# define VM_LOOP_END } } # define VM_LOOP_END } }
#endif #endif
#define PUSH(v) ((pic->sp >= pic->stend) ? abort() : (*pic->sp++ = (v))) #define PUSH(v) (*pic->sp++ = (v))
#define POP() (*--pic->sp) #define POP() (*--pic->sp)
#define PUSHCI() (++pic->ci) #define PUSHCI() (++pic->ci)
@ -650,11 +680,10 @@ pic_apply5(pic_state *pic, struct pic_proc *proc, pic_value arg1, pic_value arg2
#endif #endif
pic_value pic_value
pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv) pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
{ {
pic_code c; pic_code c;
size_t ai = pic_gc_arena_preserve(pic); size_t ai = pic_gc_arena_preserve(pic);
size_t argc, i;
pic_code boot[2]; pic_code boot[2];
#if PIC_DIRECT_THREADED_VM #if PIC_DIRECT_THREADED_VM
@ -674,26 +703,29 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
pic_callinfo *cibase; pic_callinfo *cibase;
#endif #endif
if (! pic_list_p(argv)) { if (! pic_list_p(args)) {
pic_errorf(pic, "argv must be a proper list"); pic_errorf(pic, "argv must be a proper list");
} }
else {
int argc, i;
argc = pic_length(pic, argv) + 1; argc = (int)pic_length(pic, args) + 1;
VM_BOOT_PRINT; VM_BOOT_PRINT;
PUSH(pic_obj_value(proc)); PUSH(pic_obj_value(proc));
for (i = 1; i < argc; ++i) { for (i = 1; i < argc; ++i) {
PUSH(pic_car(pic, argv)); PUSH(pic_car(pic, args));
argv = pic_cdr(pic, argv); args = pic_cdr(pic, args);
}
/* boot! */
boot[0].insn = OP_CALL;
boot[0].u.i = argc;
boot[1].insn = OP_STOP;
pic->ip = boot;
} }
/* boot! */
boot[0].insn = OP_CALL;
boot[0].u.i = argc;
boot[1].insn = OP_STOP;
pic->ip = boot;
VM_LOOP { VM_LOOP {
CASE(OP_NOP) { CASE(OP_NOP) {
NEXT; NEXT;
@ -827,7 +859,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
CASE(OP_CALL) { CASE(OP_CALL) {
pic_value x, v; pic_value x, v;
pic_callinfo *ci; pic_callinfo *ci;
struct pic_proc *proc;
if (c.u.i == -1) { if (c.u.i == -1) {
pic->sp += pic->ci[1].retc - 1; pic->sp += pic->ci[1].retc - 1;
@ -843,6 +874,10 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
VM_CALL_PRINT; VM_CALL_PRINT;
if (pic->sp >= pic->stend) {
pic_panic(pic, "VM stack overflow");
}
ci = PUSHCI(); ci = PUSHCI();
ci->argc = c.u.i; ci->argc = c.u.i;
ci->retc = 1; ci->retc = 1;
@ -954,7 +989,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
CASE(OP_LAMBDA) { CASE(OP_LAMBDA) {
pic_value self; pic_value self;
struct pic_irep *irep; struct pic_irep *irep;
struct pic_proc *proc;
self = pic->ci->fp[0]; self = pic->ci->fp[0];
if (! pic_proc_p(self)) { if (! pic_proc_p(self)) {
@ -1090,7 +1124,7 @@ pic_value
pic_apply_trampoline(pic_state *pic, struct pic_proc *proc, pic_value args) pic_apply_trampoline(pic_state *pic, struct pic_proc *proc, pic_value args)
{ {
static const pic_code iseq[2] = { static const pic_code iseq[2] = {
{ OP_NOP, {} }, { OP_NOP, { .i = 0 } },
{ OP_TAILCALL, { .i = -1 } } { OP_TAILCALL, { .i = -1 } }
}; };
@ -1107,7 +1141,7 @@ pic_apply_trampoline(pic_state *pic, struct pic_proc *proc, pic_value args)
ci = PUSHCI(); ci = PUSHCI();
ci->ip = (pic_code *)iseq; ci->ip = (pic_code *)iseq;
ci->fp = pic->sp; ci->fp = pic->sp;
ci->retc = pic_length(pic, args); ci->retc = (int)pic_length(pic, args);
if (ci->retc == 0) { if (ci->retc == 0) {
return pic_none_value(); return pic_none_value();