Merge branch 'iso-c-compliance'
This commit is contained in:
Yuichi Nishiwaki
commit
ad04bfb9fb
44
blob.c
44
blob.c
|
|
@ -60,17 +60,15 @@ static pic_value
|
|||
pic_blob_make_bytevector(pic_state *pic)
|
||||
{
|
||||
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)
|
||||
pic_errorf(pic, "byte out of range");
|
||||
|
||||
if (k < 0)
|
||||
pic_errorf(pic, "make-bytevector: cannot create a bytevector of length %d", k);
|
||||
|
||||
blob = pic_make_blob(pic, (size_t)k);
|
||||
blob = pic_make_blob(pic, k);
|
||||
for (i = 0; i < k; ++i) {
|
||||
blob->data[i] = (unsigned char)b;
|
||||
}
|
||||
|
|
@ -85,7 +83,7 @@ pic_blob_bytevector_length(pic_state *pic)
|
|||
|
||||
pic_get_args(pic, "b", &bv);
|
||||
|
||||
return pic_int_value((int)bv->len);
|
||||
return pic_size_value(bv->len);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
|
@ -118,15 +116,16 @@ static pic_value
|
|||
pic_blob_bytevector_copy_i(pic_state *pic)
|
||||
{
|
||||
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) {
|
||||
case 3:
|
||||
start = 0;
|
||||
case 4:
|
||||
end = (int)from->len;
|
||||
end = from->len;
|
||||
}
|
||||
|
||||
if (to == from && (start <= at && at < end)) {
|
||||
|
|
@ -149,23 +148,23 @@ static pic_value
|
|||
pic_blob_bytevector_copy(pic_state *pic)
|
||||
{
|
||||
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) {
|
||||
case 1:
|
||||
start = 0;
|
||||
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)
|
||||
pic_errorf(pic, "make-bytevector: cannot create a bytevector of length %d", k);
|
||||
|
||||
to = pic_make_blob(pic, (size_t)k);
|
||||
to = pic_make_blob(pic, end - start);
|
||||
while (start < end) {
|
||||
to->data[i++] = from->data[start++];
|
||||
}
|
||||
|
|
@ -210,7 +209,7 @@ pic_blob_list_to_bytevector(pic_state *pic)
|
|||
|
||||
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;
|
||||
|
||||
|
|
@ -230,15 +229,16 @@ pic_blob_bytevector_to_list(pic_state *pic)
|
|||
{
|
||||
pic_blob *blob;
|
||||
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) {
|
||||
case 1:
|
||||
start = 0;
|
||||
case 2:
|
||||
end = (int)blob->len;
|
||||
end = blob->len;
|
||||
}
|
||||
|
||||
list = pic_nil_value();
|
||||
|
|
|
|||
3
char.c
3
char.c
|
|
@ -42,9 +42,8 @@ pic_char_integer_to_char(pic_state *pic)
|
|||
static pic_value \
|
||||
pic_char_##name##_p(pic_state *pic) \
|
||||
{ \
|
||||
size_t argc; \
|
||||
size_t argc, i; \
|
||||
pic_value *argv; \
|
||||
size_t i; \
|
||||
char c, d; \
|
||||
\
|
||||
pic_get_args(pic, "cc*", &c, &d, &argc, &argv); \
|
||||
|
|
|
|||
35
codegen.c
35
codegen.c
|
|
@ -490,7 +490,6 @@ analyze_if(analyze_state *state, pic_value obj, bool tailpos)
|
|||
switch (pic_length(pic, obj)) {
|
||||
default:
|
||||
pic_errorf(pic, "syntax error");
|
||||
break;
|
||||
case 4:
|
||||
if_false = pic_list_ref(pic, obj, 3);
|
||||
FALLTHROUGH;
|
||||
|
|
@ -956,7 +955,7 @@ create_activation(codegen_context *cxt)
|
|||
if ((n = xh_val(xh_get_int(®s, *var), size_t)) <= xv_size(&cxt->args) || (cxt->varg && n == xv_size(&cxt->args) + 1)) {
|
||||
/* copy arguments to capture variable area */
|
||||
cxt->code[cxt->clen].insn = OP_LREF;
|
||||
cxt->code[cxt->clen].u.i = n;
|
||||
cxt->code[cxt->clen].u.i = (int)n;
|
||||
cxt->clen++;
|
||||
} else {
|
||||
/* 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->name = state->cxt->name;
|
||||
irep->varg = state->cxt->varg;
|
||||
irep->argc = xv_size(&state->cxt->args) + 1;
|
||||
irep->localc = xv_size(&state->cxt->locals);
|
||||
irep->capturec = xv_size(&state->cxt->captures);
|
||||
irep->argc = (int)xv_size(&state->cxt->args) + 1;
|
||||
irep->localc = (int)xv_size(&state->cxt->locals);
|
||||
irep->capturec = (int)xv_size(&state->cxt->captures);
|
||||
irep->code = pic_realloc(pic, state->cxt->code, sizeof(pic_code) * state->cxt->clen);
|
||||
irep->clen = state->cxt->clen;
|
||||
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) {
|
||||
var = xv_get(&cxt->captures, i);
|
||||
if (*var == sym)
|
||||
return i;
|
||||
return (int)i;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
|
@ -1083,13 +1082,13 @@ index_local(codegen_state *state, pic_sym sym)
|
|||
for (i = 0; i < xv_size(&cxt->args); ++i) {
|
||||
var = xv_get(&cxt->args, i);
|
||||
if (*var == sym)
|
||||
return i + offset;
|
||||
return (int)(i + offset);
|
||||
}
|
||||
offset += i;
|
||||
for (i = 0; i < xv_size(&cxt->locals); ++i) {
|
||||
var = xv_get(&cxt->locals, i);
|
||||
if (*var == sym)
|
||||
return i + offset;
|
||||
return (int)(i + offset);
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
|
@ -1127,7 +1126,7 @@ codegen(codegen_state *state, pic_value obj)
|
|||
name = pic_sym(pic_list_ref(pic, obj, 1));
|
||||
if ((i = index_capture(state, name, 0)) != -1) {
|
||||
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++;
|
||||
return;
|
||||
}
|
||||
|
|
@ -1173,7 +1172,7 @@ codegen(codegen_state *state, pic_value obj)
|
|||
name = pic_sym(pic_list_ref(pic, var, 1));
|
||||
if ((i = index_capture(state, name, 0)) != -1) {
|
||||
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->code[cxt->clen].insn = OP_PUSHNONE;
|
||||
cxt->clen++;
|
||||
|
|
@ -1194,7 +1193,7 @@ codegen(codegen_state *state, pic_value obj)
|
|||
cxt->icapa *= 2;
|
||||
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].u.i = k;
|
||||
cxt->clen++;
|
||||
|
|
@ -1208,18 +1207,18 @@ codegen(codegen_state *state, pic_value obj)
|
|||
codegen(state, pic_list_ref(pic, obj, 1));
|
||||
|
||||
cxt->code[cxt->clen].insn = OP_JMPIF;
|
||||
s = cxt->clen++;
|
||||
s = (int)cxt->clen++;
|
||||
|
||||
/* if false branch */
|
||||
codegen(state, pic_list_ref(pic, obj, 3));
|
||||
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 */
|
||||
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;
|
||||
}
|
||||
else if (sym == pic->sBEGIN) {
|
||||
|
|
@ -1267,7 +1266,7 @@ codegen(codegen_state *state, pic_value obj)
|
|||
cxt->pcapa *= 2;
|
||||
cxt->pool = pic_realloc(pic, cxt->pool, sizeof(pic_value) * cxt->pcapa);
|
||||
}
|
||||
pidx = cxt->plen++;
|
||||
pidx = (int)cxt->plen++;
|
||||
cxt->pool[pidx] = obj;
|
||||
cxt->code[cxt->clen].insn = OP_PUSHCONST;
|
||||
cxt->code[cxt->clen].u.i = pidx;
|
||||
|
|
@ -1376,7 +1375,7 @@ codegen(codegen_state *state, pic_value obj)
|
|||
return;
|
||||
}
|
||||
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_for_each (elt, pic_cdr(pic, obj)) {
|
||||
|
|
@ -1402,7 +1401,7 @@ codegen(codegen_state *state, pic_value obj)
|
|||
return;
|
||||
}
|
||||
else if (sym == state->sRETURN) {
|
||||
int len = pic_length(pic, obj);
|
||||
int len = (int)pic_length(pic, obj);
|
||||
pic_value elt;
|
||||
|
||||
pic_for_each (elt, pic_cdr(pic, obj)) {
|
||||
|
|
|
|||
6
cont.c
6
cont.c
|
|
@ -191,7 +191,7 @@ pic_values_by_array(pic_state *pic, size_t argc, pic_value *argv)
|
|||
for (i = 0; i < argc; ++i) {
|
||||
pic->sp[i] = argv[i];
|
||||
}
|
||||
pic->ci->retc = argc;
|
||||
pic->ci->retc = (int)argc;
|
||||
|
||||
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_value v;
|
||||
size_t i;
|
||||
int i;
|
||||
|
||||
i = 0;
|
||||
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 */
|
||||
ci = pic->ci + 1;
|
||||
retc = ci->retc;
|
||||
retc = (size_t)ci->retc;
|
||||
|
||||
for (i = 0; i < retc && i < n; ++i) {
|
||||
argv[i] = ci->fp[i];
|
||||
|
|
|
|||
12
dict.c
12
dict.c
|
|
@ -12,11 +12,13 @@ xh_value_hash(const void *key, void *data)
|
|||
{
|
||||
union { double f; int i; } u;
|
||||
pic_value val = *(pic_value *)key;
|
||||
int hash;
|
||||
int hash, vtype;
|
||||
|
||||
UNUSED(data);
|
||||
|
||||
switch (pic_vtype(val)) {
|
||||
vtype = pic_vtype(val);
|
||||
|
||||
switch (vtype) {
|
||||
default:
|
||||
hash = 0;
|
||||
break;
|
||||
|
|
@ -31,11 +33,11 @@ xh_value_hash(const void *key, void *data)
|
|||
hash = pic_int(val);
|
||||
break;
|
||||
case PIC_VTYPE_HEAP:
|
||||
hash = (int)pic_ptr(val);
|
||||
hash = (int)(intptr_t)pic_ptr(val);
|
||||
break;
|
||||
}
|
||||
|
||||
return hash + (int)pic_vtype(val);
|
||||
return hash + vtype;
|
||||
}
|
||||
|
||||
static int
|
||||
|
|
@ -213,7 +215,7 @@ pic_dict_dictionary_size(pic_state *pic)
|
|||
|
||||
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
|
||||
|
|
|
|||
10
error.c
10
error.c
|
|
@ -90,7 +90,8 @@ void
|
|||
pic_push_try(pic_state *pic, struct pic_escape *escape)
|
||||
{
|
||||
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);
|
||||
|
||||
|
|
@ -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));
|
||||
|
||||
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;
|
||||
pic->xpbase = pic_realloc(pic, pic->xpbase, sizeof(struct pic_proc *) * xp_len);
|
||||
pic->xp = pic->xpbase + xp_offset;
|
||||
|
|
@ -198,12 +199,13 @@ pic_error_with_exception_handler(pic_state *pic)
|
|||
{
|
||||
struct pic_proc *handler, *thunk;
|
||||
pic_value val;
|
||||
size_t xp_len, xp_offset;
|
||||
size_t xp_len;
|
||||
ptrdiff_t xp_offset;
|
||||
|
||||
pic_get_args(pic, "ll", &handler, &thunk);
|
||||
|
||||
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;
|
||||
pic->xpbase = pic_realloc(pic, pic->xpbase, sizeof(struct pic_proc *) * xp_len);
|
||||
pic->xp = pic->xpbase + xp_offset;
|
||||
|
|
|
|||
|
|
@ -52,8 +52,8 @@ struct pic_code {
|
|||
int i;
|
||||
char c;
|
||||
struct {
|
||||
short depth;
|
||||
short idx;
|
||||
int depth;
|
||||
int idx;
|
||||
} r;
|
||||
} u;
|
||||
};
|
||||
|
|
|
|||
|
|
@ -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_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_make_list(pic_state *, int, pic_value);
|
||||
pic_value pic_make_list(pic_state *, size_t, pic_value);
|
||||
|
||||
#define pic_for_each(var, 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_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_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_cddr(pic_state *, pic_value);
|
||||
|
||||
pic_value pic_list_tail(pic_state *, pic_value, int);
|
||||
pic_value pic_list_ref(pic_state *, pic_value, int);
|
||||
void pic_list_set(pic_state *, pic_value, int, pic_value);
|
||||
pic_value pic_list_tail(pic_state *, pic_value, size_t);
|
||||
pic_value pic_list_ref(pic_state *, pic_value, size_t);
|
||||
void pic_list_set(pic_state *, pic_value, size_t, pic_value);
|
||||
pic_value pic_list_copy(pic_state *, pic_value);
|
||||
|
||||
#if defined(__cplusplus)
|
||||
|
|
|
|||
|
|
@ -189,6 +189,7 @@ static inline pic_value pic_undef_value();
|
|||
static inline pic_value pic_obj_value(void *);
|
||||
static inline pic_value pic_float_value(double);
|
||||
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_char_value(char c);
|
||||
static inline pic_value pic_none_value();
|
||||
|
|
@ -323,6 +324,17 @@ pic_bool_value(bool b)
|
|||
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
|
||||
|
||||
static inline pic_value
|
||||
|
|
|
|||
9
number.c
9
number.c
|
|
@ -162,9 +162,8 @@ pic_number_nan_p(pic_state *pic)
|
|||
static pic_value \
|
||||
pic_number_##name(pic_state *pic) \
|
||||
{ \
|
||||
size_t argc; \
|
||||
size_t argc, i; \
|
||||
pic_value *argv; \
|
||||
size_t i; \
|
||||
double f,g; \
|
||||
\
|
||||
pic_get_args(pic, "ff*", &f, &g, &argc, &argv); \
|
||||
|
|
@ -198,9 +197,8 @@ DEFINE_ARITH_CMP(>=, ge)
|
|||
static pic_value \
|
||||
pic_number_##name(pic_state *pic) \
|
||||
{ \
|
||||
size_t argc; \
|
||||
size_t argc, i; \
|
||||
pic_value *argv; \
|
||||
size_t i; \
|
||||
double f; \
|
||||
bool e = true; \
|
||||
\
|
||||
|
|
@ -230,9 +228,8 @@ DEFINE_ARITH_OP(*, mul, 1)
|
|||
static pic_value \
|
||||
pic_number_##name(pic_state *pic) \
|
||||
{ \
|
||||
size_t argc; \
|
||||
size_t argc, i; \
|
||||
pic_value *argv; \
|
||||
size_t i; \
|
||||
double f; \
|
||||
bool e; \
|
||||
\
|
||||
|
|
|
|||
64
pair.c
64
pair.c
|
|
@ -172,10 +172,10 @@ pic_list_by_array(pic_state *pic, size_t c, pic_value *vs)
|
|||
}
|
||||
|
||||
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;
|
||||
int i;
|
||||
size_t i;
|
||||
|
||||
list = pic_nil_value();
|
||||
for (i = 0; i < k; ++i) {
|
||||
|
|
@ -185,10 +185,10 @@ pic_make_list(pic_state *pic, int k, pic_value fill)
|
|||
return list;
|
||||
}
|
||||
|
||||
int
|
||||
size_t
|
||||
pic_length(pic_state *pic, pic_value obj)
|
||||
{
|
||||
int c = 0;
|
||||
size_t c = 0;
|
||||
|
||||
if (! pic_list_p(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_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) {
|
||||
list = pic_cdr(pic, list);
|
||||
|
|
@ -384,13 +384,13 @@ pic_list_tail(pic_state *pic, pic_value list, int i)
|
|||
}
|
||||
|
||||
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));
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
|
@ -533,10 +533,10 @@ pic_pair_list_p(pic_state *pic)
|
|||
static pic_value
|
||||
pic_pair_make_list(pic_state *pic)
|
||||
{
|
||||
int i;
|
||||
size_t i;
|
||||
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);
|
||||
}
|
||||
|
|
@ -559,7 +559,7 @@ pic_pair_length(pic_state *pic)
|
|||
|
||||
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
|
||||
|
|
@ -596,9 +596,9 @@ static pic_value
|
|||
pic_pair_list_tail(pic_state *pic)
|
||||
{
|
||||
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);
|
||||
}
|
||||
|
|
@ -607,9 +607,9 @@ static pic_value
|
|||
pic_pair_list_ref(pic_state *pic)
|
||||
{
|
||||
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);
|
||||
}
|
||||
|
|
@ -618,9 +618,9 @@ static pic_value
|
|||
pic_pair_list_set(pic_state *pic)
|
||||
{
|
||||
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);
|
||||
|
||||
|
|
@ -641,26 +641,26 @@ static pic_value
|
|||
pic_pair_map(pic_state *pic)
|
||||
{
|
||||
struct pic_proc *proc;
|
||||
size_t argc;
|
||||
size_t argc, i;
|
||||
pic_value *args;
|
||||
int i;
|
||||
pic_value cars, ret;
|
||||
pic_value arg, ret;
|
||||
|
||||
pic_get_args(pic, "l*", &proc, &argc, &args);
|
||||
|
||||
ret = pic_nil_value();
|
||||
do {
|
||||
cars = pic_nil_value();
|
||||
for (i = argc - 1; i >= 0; --i) {
|
||||
arg = pic_nil_value();
|
||||
for (i = 0; i < argc; ++i) {
|
||||
if (! pic_pair_p(args[i])) {
|
||||
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]);
|
||||
}
|
||||
if (i >= 0)
|
||||
if (i != argc) {
|
||||
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);
|
||||
|
||||
return pic_reverse(pic, ret);
|
||||
|
|
@ -670,25 +670,25 @@ static pic_value
|
|||
pic_pair_for_each(pic_state *pic)
|
||||
{
|
||||
struct pic_proc *proc;
|
||||
size_t argc;
|
||||
size_t argc, i;
|
||||
pic_value *args;
|
||||
int i;
|
||||
pic_value cars;
|
||||
pic_value arg;
|
||||
|
||||
pic_get_args(pic, "l*", &proc, &argc, &args);
|
||||
|
||||
do {
|
||||
cars = pic_nil_value();
|
||||
for (i = argc - 1; i >= 0; --i) {
|
||||
arg = pic_nil_value();
|
||||
for (i = 0; i < argc; ++i) {
|
||||
if (! pic_pair_p(args[i])) {
|
||||
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]);
|
||||
}
|
||||
if (i >= 0)
|
||||
if (i != argc) {
|
||||
break;
|
||||
pic_apply(pic, proc, cars);
|
||||
}
|
||||
pic_apply(pic, proc, pic_reverse(pic, arg));
|
||||
} while (1);
|
||||
|
||||
return pic_none_value();
|
||||
|
|
|
|||
34
port.c
34
port.c
|
|
@ -521,20 +521,15 @@ pic_port_read_blob(pic_state *pic)
|
|||
{
|
||||
struct pic_port *port = pic_stdin(pic);
|
||||
pic_blob *blob;
|
||||
int k;
|
||||
size_t i;
|
||||
size_t k, 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");
|
||||
|
||||
if (k < 0) {
|
||||
pic_errorf(pic, "read-bytevector: index must be non-negative %d", k);
|
||||
}
|
||||
blob = pic_make_blob(pic, k);
|
||||
|
||||
blob = pic_make_blob(pic, (size_t)k);
|
||||
|
||||
i = xfread(blob->data, sizeof(char), (size_t)k, port->file);
|
||||
i = xfread(blob->data, sizeof(char), k, port->file);
|
||||
if (i == 0) {
|
||||
return pic_eof_object();
|
||||
}
|
||||
|
|
@ -550,27 +545,27 @@ pic_port_read_blob_ip(pic_state *pic)
|
|||
{
|
||||
struct pic_port *port;
|
||||
struct pic_blob *bv;
|
||||
int n, start, end;
|
||||
int n;
|
||||
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) {
|
||||
case 1:
|
||||
port = pic_stdin(pic);
|
||||
case 2:
|
||||
start = 0;
|
||||
case 3:
|
||||
end = (int)bv->len;
|
||||
end = bv->len;
|
||||
}
|
||||
|
||||
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");
|
||||
}
|
||||
|
||||
len = (size_t)(end - start);
|
||||
len = end - start;
|
||||
|
||||
buf = pic_calloc(pic, len, sizeof(char));
|
||||
i = xfread(buf, sizeof(char), len, port->file);
|
||||
|
|
@ -581,7 +576,7 @@ pic_port_read_blob_ip(pic_state *pic)
|
|||
return pic_eof_object();
|
||||
}
|
||||
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_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) {
|
||||
case 1:
|
||||
port = pic_stdout(pic);
|
||||
case 2:
|
||||
start = 0;
|
||||
case 3:
|
||||
end = (int)blob->len;
|
||||
end = blob->len;
|
||||
}
|
||||
|
||||
assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, PIC_PORT_OPEN, "write-bytevector");
|
||||
|
|
|
|||
35
read.c
35
read.c
|
|
@ -209,7 +209,7 @@ read_symbol(pic_state *pic, struct pic_port *port, const char *str)
|
|||
|
||||
for (i = 0; i < len; ++i) {
|
||||
if (pic->reader->typecase == PIC_CASE_FOLD) {
|
||||
buf[i] = tolower(str[i]);
|
||||
buf[i] = (char)tolower(str[i]);
|
||||
} else {
|
||||
buf[i] = str[i];
|
||||
}
|
||||
|
|
@ -222,7 +222,7 @@ read_symbol(pic_state *pic, struct pic_port *port, const char *str)
|
|||
}
|
||||
len += 1;
|
||||
buf = pic_realloc(pic, buf, len + 1);
|
||||
buf[len - 1] = c;
|
||||
buf[len - 1] = (char)c;
|
||||
}
|
||||
|
||||
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");
|
||||
}
|
||||
|
||||
buf[i++] = c;
|
||||
buf[i++] = (char)c;
|
||||
while (isdigit(c = peek(port))) {
|
||||
buf[i++] = next(port);
|
||||
buf[i++] = (char)next(port);
|
||||
}
|
||||
|
||||
buf[i] = '\0';
|
||||
|
|
@ -262,12 +262,12 @@ read_suffix(pic_state *pic, struct pic_port *port, char buf[])
|
|||
return i;
|
||||
}
|
||||
|
||||
buf[i++] = next(port);
|
||||
buf[i++] = (char)next(port);
|
||||
|
||||
switch ((c = next(port))) {
|
||||
case '-':
|
||||
case '+':
|
||||
buf[i++] = c;
|
||||
buf[i++] = (char)c;
|
||||
c = next(port);
|
||||
default:
|
||||
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)) {
|
||||
case '.':
|
||||
buf[i++] = next(port);
|
||||
buf[i++] = (char)next(port);
|
||||
i += read_uinteger(pic, port, next(port), buf + i);
|
||||
read_suffix(pic, port, buf + i);
|
||||
return pic_float_value(atof(buf));
|
||||
|
||||
default:
|
||||
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:
|
||||
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;
|
||||
}
|
||||
}
|
||||
buf[cnt++] = c;
|
||||
buf[cnt++] = (char)c;
|
||||
if (cnt >= size) {
|
||||
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 'x':
|
||||
i = 0;
|
||||
while ((HEX_BUF[i++] = next(port)) != ';') {
|
||||
while ((HEX_BUF[i++] = (char)next(port)) != ';') {
|
||||
if (i >= sizeof HEX_BUF)
|
||||
read_error(pic, "expected ';'");
|
||||
}
|
||||
c = strtol(HEX_BUF, NULL, 16);
|
||||
c = (char)strtol(HEX_BUF, NULL, 16);
|
||||
break;
|
||||
}
|
||||
}
|
||||
buf[cnt++] = c;
|
||||
buf[cnt++] = (char)c;
|
||||
if (cnt >= size) {
|
||||
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;
|
||||
size_t len, i;
|
||||
char *dat, buf[256];
|
||||
char buf[256];
|
||||
unsigned char *dat;
|
||||
pic_blob *blob;
|
||||
|
||||
UNUSED(str);
|
||||
|
|
@ -530,7 +531,7 @@ read_blob(pic_state *pic, struct pic_port *port, const char *str)
|
|||
}
|
||||
len += 1;
|
||||
dat = pic_realloc(pic, dat, len);
|
||||
dat[len - 1] = n;
|
||||
dat[len - 1] = (unsigned char)n;
|
||||
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");
|
||||
}
|
||||
|
||||
buf[i++] = c;
|
||||
buf[i++] = (char)c;
|
||||
|
||||
while (i < sizeof buf) {
|
||||
trie = trie->table[c];
|
||||
|
|
@ -721,7 +722,7 @@ read_nullable(pic_state *pic, struct pic_port *port, int c)
|
|||
if (trie->table[c] == NULL) {
|
||||
break;
|
||||
}
|
||||
buf[i++] = next(port);
|
||||
buf[i++] = (char)next(port);
|
||||
}
|
||||
if (i == sizeof buf) {
|
||||
read_error(pic, "too long dispatch string");
|
||||
|
|
|
|||
36
string.c
36
string.c
|
|
@ -233,22 +233,21 @@ pic_str_string_p(pic_state *pic)
|
|||
static pic_value
|
||||
pic_str_string(pic_state *pic)
|
||||
{
|
||||
size_t argc;
|
||||
size_t argc, i;
|
||||
pic_value *argv;
|
||||
pic_str *str;
|
||||
char *buf;
|
||||
size_t i;
|
||||
|
||||
pic_get_args(pic, "*", &argc, &argv);
|
||||
|
||||
buf = pic_alloc(pic, argc);
|
||||
buf = pic_alloc(pic, (size_t)argc);
|
||||
|
||||
for (i = 0; i < argc; ++i) {
|
||||
pic_assert_type(pic, argv[i], char);
|
||||
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);
|
||||
|
||||
return pic_obj_value(str);
|
||||
|
|
@ -257,10 +256,10 @@ pic_str_string(pic_state *pic)
|
|||
static pic_value
|
||||
pic_str_make_string(pic_state *pic)
|
||||
{
|
||||
int len;
|
||||
size_t len;
|
||||
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));
|
||||
}
|
||||
|
|
@ -272,16 +271,16 @@ pic_str_string_length(pic_state *pic)
|
|||
|
||||
pic_get_args(pic, "s", &str);
|
||||
|
||||
return pic_int_value(pic_strlen(str));
|
||||
return pic_size_value(pic_strlen(str));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_str_string_ref(pic_state *pic)
|
||||
{
|
||||
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));
|
||||
}
|
||||
|
|
@ -290,9 +289,8 @@ pic_str_string_ref(pic_state *pic)
|
|||
static pic_value \
|
||||
pic_str_string_##name(pic_state *pic) \
|
||||
{ \
|
||||
size_t argc; \
|
||||
size_t argc, i; \
|
||||
pic_value *argv; \
|
||||
size_t i; \
|
||||
\
|
||||
pic_get_args(pic, "*", &argc, &argv); \
|
||||
\
|
||||
|
|
@ -321,9 +319,10 @@ static pic_value
|
|||
pic_str_string_copy(pic_state *pic)
|
||||
{
|
||||
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) {
|
||||
case 1:
|
||||
|
|
@ -358,8 +357,8 @@ static pic_value
|
|||
pic_str_string_map(pic_state *pic)
|
||||
{
|
||||
struct pic_proc *proc;
|
||||
size_t argc, i, len, j;
|
||||
pic_value *argv, vals, val;
|
||||
size_t argc, i, len, j;
|
||||
|
||||
pic_get_args(pic, "l*", &proc, &argc, &argv);
|
||||
|
||||
|
|
@ -396,7 +395,7 @@ static pic_value
|
|||
pic_str_string_for_each(pic_state *pic)
|
||||
{
|
||||
struct pic_proc *proc;
|
||||
size_t argc, i, len, j;
|
||||
size_t argc, len, i, j;
|
||||
pic_value *argv, vals, val;
|
||||
|
||||
pic_get_args(pic, "l*", &proc, &argc, &argv);
|
||||
|
|
@ -429,7 +428,7 @@ pic_str_list_to_string(pic_state *pic)
|
|||
{
|
||||
pic_str *str;
|
||||
pic_value list, e;
|
||||
int i = 0;
|
||||
size_t i = 0;
|
||||
|
||||
pic_get_args(pic, "o", &list);
|
||||
|
||||
|
|
@ -455,9 +454,10 @@ pic_str_string_to_list(pic_state *pic)
|
|||
{
|
||||
pic_str *str;
|
||||
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) {
|
||||
case 1:
|
||||
|
|
|
|||
2
symbol.c
2
symbol.c
|
|
@ -80,7 +80,7 @@ pic_ungensym(pic_state *pic, pic_sym base)
|
|||
if ((occr = strrchr(name, '@')) == NULL) {
|
||||
pic_panic(pic, "logic flaw");
|
||||
}
|
||||
return pic_intern(pic, name, occr - name);
|
||||
return pic_intern(pic, name, (size_t)(occr - name));
|
||||
}
|
||||
|
||||
bool
|
||||
|
|
|
|||
2
system.c
2
system.c
|
|
@ -105,7 +105,7 @@ pic_system_getenvs(pic_state *pic)
|
|||
|
||||
for (envp = pic->envp; *envp; ++envp) {
|
||||
pic_str *key, *val;
|
||||
int i;
|
||||
size_t i;
|
||||
|
||||
for (i = 0; (*envp)[i] != '='; ++i)
|
||||
;
|
||||
|
|
|
|||
2
time.c
2
time.c
|
|
@ -27,7 +27,7 @@ pic_current_jiffy(pic_state *pic)
|
|||
pic_get_args(pic, "");
|
||||
|
||||
c = clock();
|
||||
return pic_int_value((int)c);
|
||||
return pic_int_value((int)c); /* The year 2038 problem :-| */
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
|
|
|||
82
vector.c
82
vector.c
|
|
@ -26,7 +26,7 @@ struct pic_vector *
|
|||
pic_make_vec_from_list(pic_state *pic, pic_value data)
|
||||
{
|
||||
struct pic_vector *vec;
|
||||
size_t i, len;
|
||||
size_t len, i;
|
||||
|
||||
len = pic_length(pic, data);
|
||||
|
||||
|
|
@ -51,14 +51,13 @@ pic_vec_vector_p(pic_state *pic)
|
|||
static pic_value
|
||||
pic_vec_vector(pic_state *pic)
|
||||
{
|
||||
size_t argc;
|
||||
size_t argc, i;
|
||||
pic_value *argv;
|
||||
pic_vec *vec;
|
||||
size_t i;
|
||||
|
||||
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) {
|
||||
vec->data[i] = argv[i];
|
||||
|
|
@ -71,15 +70,15 @@ static pic_value
|
|||
pic_vec_make_vector(pic_state *pic)
|
||||
{
|
||||
pic_value v;
|
||||
int n, k;
|
||||
size_t i;
|
||||
int n;
|
||||
size_t k, i;
|
||||
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);
|
||||
if (n == 2) {
|
||||
for (i = 0; i < (size_t)k; ++i) {
|
||||
for (i = 0; i < k; ++i) {
|
||||
vec->data[i] = v;
|
||||
}
|
||||
}
|
||||
|
|
@ -93,18 +92,18 @@ pic_vec_vector_length(pic_state *pic)
|
|||
|
||||
pic_get_args(pic, "v", &v);
|
||||
|
||||
return pic_int_value(v->len);
|
||||
return pic_size_value(v->len);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_vec_vector_ref(pic_state *pic)
|
||||
{
|
||||
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");
|
||||
}
|
||||
return v->data[k];
|
||||
|
|
@ -114,12 +113,12 @@ static pic_value
|
|||
pic_vec_vector_set(pic_state *pic)
|
||||
{
|
||||
struct pic_vector *v;
|
||||
int k;
|
||||
size_t k;
|
||||
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");
|
||||
}
|
||||
v->data[k] = o;
|
||||
|
|
@ -130,9 +129,10 @@ static pic_value
|
|||
pic_vec_vector_copy_i(pic_state *pic)
|
||||
{
|
||||
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) {
|
||||
case 3:
|
||||
|
|
@ -161,9 +161,10 @@ static pic_value
|
|||
pic_vec_vector_copy(pic_state *pic)
|
||||
{
|
||||
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) {
|
||||
case 1:
|
||||
|
|
@ -172,6 +173,10 @@ pic_vec_vector_copy(pic_state *pic)
|
|||
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);
|
||||
while (start < end) {
|
||||
to->data[i++] = vec->data[start++];
|
||||
|
|
@ -183,8 +188,8 @@ pic_vec_vector_copy(pic_state *pic)
|
|||
static pic_value
|
||||
pic_vec_vector_append(pic_state *pic)
|
||||
{
|
||||
size_t argc, i, j, len;
|
||||
pic_value *argv;
|
||||
size_t argc, i, j, len;
|
||||
pic_vec *vec;
|
||||
|
||||
pic_get_args(pic, "*", &argc, &argv);
|
||||
|
|
@ -213,9 +218,10 @@ pic_vec_vector_fill_i(pic_state *pic)
|
|||
{
|
||||
pic_vec *vec;
|
||||
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) {
|
||||
case 2:
|
||||
|
|
@ -241,7 +247,7 @@ pic_vec_vector_map(pic_state *pic)
|
|||
|
||||
pic_get_args(pic, "l*", &proc, &argc, &argv);
|
||||
|
||||
len = SIZE_MAX;
|
||||
len = INT_MAX;
|
||||
for (i = 0; i < argc; ++i) {
|
||||
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);
|
||||
|
||||
len = SIZE_MAX;
|
||||
len = INT_MAX;
|
||||
for (i = 0; i < argc; ++i) {
|
||||
pic_assert_type(pic, argv[i], vec);
|
||||
|
||||
|
|
@ -315,9 +321,10 @@ pic_vec_vector_to_list(pic_state *pic)
|
|||
{
|
||||
struct pic_vector *vec;
|
||||
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) {
|
||||
case 1:
|
||||
|
|
@ -339,10 +346,11 @@ pic_vec_vector_to_string(pic_state *pic)
|
|||
{
|
||||
pic_vec *vec;
|
||||
char *buf;
|
||||
int n, start, end, i;
|
||||
int n;
|
||||
size_t start, end, i;
|
||||
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) {
|
||||
case 1:
|
||||
|
|
@ -351,6 +359,10 @@ pic_vec_vector_to_string(pic_state *pic)
|
|||
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);
|
||||
|
||||
for (i = start; i < end; ++i) {
|
||||
|
|
@ -369,10 +381,12 @@ static pic_value
|
|||
pic_vec_string_to_vector(pic_state *pic)
|
||||
{
|
||||
pic_str *str;
|
||||
int n, start, end, i;
|
||||
int n;
|
||||
size_t start, end;
|
||||
size_t i;
|
||||
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) {
|
||||
case 1:
|
||||
|
|
@ -381,10 +395,14 @@ pic_vec_string_to_vector(pic_state *pic)
|
|||
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);
|
||||
|
||||
for (i = start; i < end; ++i) {
|
||||
vec->data[i - start] = pic_char_value(pic_str_ref(pic, str, i));
|
||||
for (i = 0; i < end - start; ++i) {
|
||||
vec->data[i] = pic_char_value(pic_str_ref(pic, str, i + start));
|
||||
}
|
||||
return pic_obj_value(vec);
|
||||
}
|
||||
|
|
|
|||
122
vm.c
122
vm.c
|
|
@ -35,26 +35,27 @@ pic_get_proc(pic_state *pic)
|
|||
}
|
||||
|
||||
/**
|
||||
* char type
|
||||
* ---- ----
|
||||
* o object
|
||||
* i int
|
||||
* I int with exactness
|
||||
* f float
|
||||
* F float with exactness
|
||||
* s string object
|
||||
* z c string
|
||||
* m symbol
|
||||
* v vector object
|
||||
* b bytevector object
|
||||
* c char
|
||||
* l lambda object
|
||||
* p port object
|
||||
* d dictionary object
|
||||
* e error object
|
||||
* char type desc.
|
||||
* ---- ---- ----
|
||||
* o pic_value * object
|
||||
* i int * int
|
||||
* I int *, bool * int with exactness
|
||||
* k size_t * size_t implicitly converted from int
|
||||
* f double * float
|
||||
* F double *, bool * float with exactness
|
||||
* s pic_str ** string object
|
||||
* z char ** c string
|
||||
* m pic_sym * symbol
|
||||
* v pic_vec ** vector object
|
||||
* b pic_blob ** bytevector object
|
||||
* c char * char
|
||||
* l struct pic_proc ** lambda object
|
||||
* p struct pic_port ** port object
|
||||
* d struct pic_dict ** dictionary object
|
||||
* e struct pic_error ** error object
|
||||
*
|
||||
* | optional operator
|
||||
* * variable length operator
|
||||
* | optional operator
|
||||
* * int *, pic_value ** variable length operator
|
||||
*/
|
||||
|
||||
int
|
||||
|
|
@ -196,6 +197,35 @@ pic_get_args(pic_state *pic, const char *format, ...)
|
|||
}
|
||||
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': {
|
||||
pic_str **str;
|
||||
pic_value v;
|
||||
|
|
@ -280,14 +310,14 @@ pic_get_args(pic_state *pic, const char *format, ...)
|
|||
break;
|
||||
}
|
||||
case 'c': {
|
||||
char *c;
|
||||
char *k;
|
||||
pic_value v;
|
||||
|
||||
c = va_arg(ap, char *);
|
||||
k = va_arg(ap, char *);
|
||||
if (i < argc) {
|
||||
v = GET_OPERAND(pic,i);
|
||||
if (pic_char_p(v)) {
|
||||
*c = pic_char(v);
|
||||
*k = pic_char(v);
|
||||
}
|
||||
else {
|
||||
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 *);
|
||||
argv = va_arg(ap, pic_value **);
|
||||
if (i <= argc) {
|
||||
*n = argc - i;
|
||||
*n = (size_t)(argc - i);
|
||||
*argv = &GET_OPERAND(pic, i);
|
||||
i = argc;
|
||||
}
|
||||
|
|
@ -488,7 +518,7 @@ vm_push_env(pic_state *pic)
|
|||
{
|
||||
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->regc = ci->regc;
|
||||
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 } }
|
||||
#endif
|
||||
|
||||
#define PUSH(v) ((pic->sp >= pic->stend) ? abort() : (*pic->sp++ = (v)))
|
||||
#define PUSH(v) (*pic->sp++ = (v))
|
||||
#define POP() (*--pic->sp)
|
||||
|
||||
#define PUSHCI() (++pic->ci)
|
||||
|
|
@ -650,11 +680,10 @@ pic_apply5(pic_state *pic, struct pic_proc *proc, pic_value arg1, pic_value arg2
|
|||
#endif
|
||||
|
||||
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;
|
||||
size_t ai = pic_gc_arena_preserve(pic);
|
||||
size_t argc, i;
|
||||
pic_code boot[2];
|
||||
|
||||
#if PIC_DIRECT_THREADED_VM
|
||||
|
|
@ -674,26 +703,29 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
|
|||
pic_callinfo *cibase;
|
||||
#endif
|
||||
|
||||
if (! pic_list_p(argv)) {
|
||||
if (! pic_list_p(args)) {
|
||||
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));
|
||||
for (i = 1; i < argc; ++i) {
|
||||
PUSH(pic_car(pic, argv));
|
||||
argv = pic_cdr(pic, argv);
|
||||
PUSH(pic_obj_value(proc));
|
||||
for (i = 1; i < argc; ++i) {
|
||||
PUSH(pic_car(pic, args));
|
||||
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 {
|
||||
CASE(OP_NOP) {
|
||||
NEXT;
|
||||
|
|
@ -827,7 +859,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
|
|||
CASE(OP_CALL) {
|
||||
pic_value x, v;
|
||||
pic_callinfo *ci;
|
||||
struct pic_proc *proc;
|
||||
|
||||
if (c.u.i == -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;
|
||||
|
||||
if (pic->sp >= pic->stend) {
|
||||
pic_panic(pic, "VM stack overflow");
|
||||
}
|
||||
|
||||
ci = PUSHCI();
|
||||
ci->argc = c.u.i;
|
||||
ci->retc = 1;
|
||||
|
|
@ -954,7 +989,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
|
|||
CASE(OP_LAMBDA) {
|
||||
pic_value self;
|
||||
struct pic_irep *irep;
|
||||
struct pic_proc *proc;
|
||||
|
||||
self = pic->ci->fp[0];
|
||||
if (! pic_proc_p(self)) {
|
||||
|
|
@ -1090,7 +1124,7 @@ pic_value
|
|||
pic_apply_trampoline(pic_state *pic, struct pic_proc *proc, pic_value args)
|
||||
{
|
||||
static const pic_code iseq[2] = {
|
||||
{ OP_NOP, {} },
|
||||
{ OP_NOP, { .i = 0 } },
|
||||
{ OP_TAILCALL, { .i = -1 } }
|
||||
};
|
||||
|
||||
|
|
@ -1107,7 +1141,7 @@ pic_apply_trampoline(pic_state *pic, struct pic_proc *proc, pic_value args)
|
|||
ci = PUSHCI();
|
||||
ci->ip = (pic_code *)iseq;
|
||||
ci->fp = pic->sp;
|
||||
ci->retc = pic_length(pic, args);
|
||||
ci->retc = (int)pic_length(pic, args);
|
||||
|
||||
if (ci->retc == 0) {
|
||||
return pic_none_value();
|
||||
|
|
|
|||
Loading…
Reference in New Issue