static Scheme_Object *vector_to_values (int argc, Scheme_Object *argv[])
{
Scheme_Thread *p;
Scheme_Object *vec, **a;
long len, start, finish, i;
vec = argv[0];
if (!SCHEME_VECTORP(vec))
scheme_wrong_type("vector->values", "vector", 0, argc, argv);
len = SCHEME_VEC_SIZE(vec);
if (argc > 1)
start = scheme_extract_index("vector->values", 1, argc, argv, len + 1, 0);
else
start = 0;
if (argc > 2)
finish = scheme_extract_index("vector->values", 2, argc, argv, len + 1, 0);
else
finish = len;
if (!(start <= len)) {
bad_index("vector->values", argv[1], vec, 0);
}
if (!(finish >= start && finish <= len)) {
bad_index("vector->values", argv[2], vec, start);
}
len = finish - start;
if (len == 1)
return SCHEME_VEC_ELS(vec)[start];
p = scheme_current_thread;
if (p->values_buffer && (p->values_buffer_size >= len))
a = p->values_buffer;
else {
a = MALLOC_N(Scheme_Object *, len);
p->values_buffer = a;
p->values_buffer_size = len;
}
p->ku.multiple.array = a;
p->ku.multiple.count = len;
for (i = 0; i < len; i++) {
a[i] = SCHEME_VEC_ELS(vec)[start + i];
}
return SCHEME_MULTIPLE_VALUES;
}
Scheme_Object *
scheme_checked_vector_set(int argc, Scheme_Object *argv[])
{
Scheme_Object *vec = argv[0];
intptr_t i, len;
if (SCHEME_CHAPERONEP(vec))
vec = SCHEME_CHAPERONE_VAL(vec);
if (!SCHEME_MUTABLE_VECTORP(vec))
scheme_wrong_contract("vector-set!", "(and/c vector? (not/c immutable?))", 0, argc, argv);
len = SCHEME_VEC_SIZE(vec);
i = scheme_extract_index("vector-set!", 1, argc, argv, len, 0);
if (i >= len)
return bad_index("vector-set!", "", argv[1], argv[0], 0);
if (!SAME_OBJ(vec, argv[0]))
scheme_chaperone_vector_set(argv[0], i, argv[2]);
else
SCHEME_VEC_ELS(vec)[i] = argv[2];
return scheme_void;
}
Scheme_Object *
scheme_checked_vector_ref (int argc, Scheme_Object *argv[])
{
intptr_t i, len;
Scheme_Object *vec;
vec = argv[0];
if (SCHEME_CHAPERONEP(vec))
vec = SCHEME_CHAPERONE_VAL(vec);
if (!SCHEME_VECTORP(vec))
scheme_wrong_contract("vector-ref", "vector?", 0, argc, argv);
len = SCHEME_VEC_SIZE(vec);
i = scheme_extract_index("vector-ref", 1, argc, argv, len, 0);
if (i >= len)
return bad_index("vector-ref", "", argv[1], argv[0], 0);
if (!SAME_OBJ(vec, argv[0]))
/* chaperone */
return scheme_chaperone_vector_ref(argv[0], i);
else
return (SCHEME_VEC_ELS(vec))[i];
}
Scheme_Object *
scheme_checked_vector_ref (int argc, Scheme_Object *argv[])
{
long i, len;
if (!SCHEME_VECTORP(argv[0]))
scheme_wrong_type("vector-ref", "vector", 0, argc, argv);
len = SCHEME_VEC_SIZE(argv[0]);
i = scheme_extract_index("vector-ref", 1, argc, argv, len, 0);
if (i >= len)
return bad_index("vector-ref", argv[1], argv[0], 0);
return (SCHEME_VEC_ELS(argv[0]))[i];
}
Scheme_Object *
scheme_checked_vector_cas(int argc, Scheme_Object *argv[])
{
Scheme_Object *vec = argv[0];
intptr_t i, len;
if (!SCHEME_MUTABLE_VECTORP(vec))
scheme_wrong_contract("vector-cas!", "(and/c vector? (not/c immutable?) (not/c impersonator?))", 0, argc, argv);
len = SCHEME_VEC_SIZE(vec);
i = scheme_extract_index("vector-cas!", 1, argc, argv, len, 0);
if (i >= len)
return bad_index("vector-cas!", "", argv[1], argv[0], 0);
return unsafe_vector_star_cas(argc, argv);
}
Scheme_Object *
scheme_checked_vector_star_ref (int argc, Scheme_Object *argv[])
{
intptr_t i, len;
Scheme_Object *vec;
vec = argv[0];
if (!SCHEME_VECTORP(vec))
scheme_wrong_contract("vector*-ref", "(and/c vector? (not impersonator?))", 0, argc, argv);
len = SCHEME_VEC_SIZE(vec);
i = scheme_extract_index("vector*-ref", 1, argc, argv, len, 0);
if (i >= len)
return bad_index("vector*-ref", "", argv[1], argv[0], 0);
return (SCHEME_VEC_ELS(vec))[i];
}
Scheme_Object *
scheme_checked_vector_set(int argc, Scheme_Object *argv[])
{
long i, len;
if (!SCHEME_MUTABLE_VECTORP(argv[0]))
scheme_wrong_type("vector-set!", "mutable vector", 0, argc, argv);
len = SCHEME_VEC_SIZE(argv[0]);
i = scheme_extract_index("vector-set!", 1, argc, argv, len, 0);
if (i >= len)
return bad_index("vector-set!", argv[1], argv[0], 0);
(SCHEME_VEC_ELS(argv[0]))[i] = argv[2];
return scheme_void;
}
static Scheme_Object *
make_vector (int argc, Scheme_Object *argv[])
{
Scheme_Object *vec, *fill;
long len;
len = scheme_extract_index("make-vector", 0, argc, argv, -1, 0);
if (len == -1) {
scheme_raise_out_of_memory("make-vector", "making vector of length %s",
scheme_make_provided_string(argv[0], 1, NULL));
}
if (argc == 2)
fill = argv[1];
else
fill = scheme_make_integer(0);
vec = scheme_make_vector(len, fill);
return vec;
}
Scheme_Object *
scheme_checked_make_vector (int argc, Scheme_Object *argv[])
{
Scheme_Object *vec, *fill;
intptr_t len;
len = scheme_extract_index("make-vector", 0, argc, argv, -1, 0);
if ((len == -1)
/* also watch for overflow: */
|| (REV_VECTOR_BYTES(VECTOR_BYTES(len)) != len)) {
scheme_raise_out_of_memory("make-vector", "making vector of length %s",
scheme_make_provided_string(argv[0], 1, NULL));
}
if (argc == 2)
fill = argv[1];
else
fill = scheme_make_integer(0);
vec = scheme_make_vector(len, fill);
return vec;
}
static Scheme_Object *vector_to_values (int argc, Scheme_Object *argv[])
{
Scheme_Thread *p;
Scheme_Object *vec, **a, *plain_vec;
intptr_t len, start, finish, i;
vec = argv[0];
if (SCHEME_NP_CHAPERONEP(vec))
vec = SCHEME_CHAPERONE_VAL(vec);
if (!SCHEME_VECTORP(vec))
scheme_wrong_contract("vector->values", "vector?", 0, argc, argv);
len = SCHEME_VEC_SIZE(vec);
if (argc > 1)
start = scheme_extract_index("vector->values", 1, argc, argv, len + 1, 0);
else
start = 0;
if (argc > 2)
finish = scheme_extract_index("vector->values", 2, argc, argv, len + 1, 0);
else
finish = len;
if (!(start <= len)) {
bad_index("vector->values", "starting ", argv[1], argv[0], 0);
}
if (!(finish >= start && finish <= len)) {
bad_index("vector->values", "ending ", argv[2], argv[0], start);
}
len = finish - start;
if (len == 1) {
if (!SAME_OBJ(vec, argv[0]))
return scheme_chaperone_vector_ref(argv[0], start);
else
return SCHEME_VEC_ELS(vec)[start];
}
if (!SAME_OBJ(vec, argv[0])) {
plain_vec = scheme_make_vector(len, NULL);
for (i = 0; i < len; i++) {
vec = scheme_chaperone_vector_ref(argv[0], start + i);
SCHEME_VEC_ELS(plain_vec)[i] = vec;
}
vec = plain_vec;
start = 0;
}
p = scheme_current_thread;
if (p->values_buffer && (p->values_buffer_size >= len))
a = p->values_buffer;
else {
a = MALLOC_N(Scheme_Object *, len);
p->values_buffer = a;
p->values_buffer_size = len;
}
p->ku.multiple.array = a;
p->ku.multiple.count = len;
for (i = 0; i < len; i++) {
a[i] = SCHEME_VEC_ELS(vec)[start + i];
}
return SCHEME_MULTIPLE_VALUES;
}