static Scheme_Object *
vector_fill (int argc, Scheme_Object *argv[])
{
int i, sz;
Scheme_Object *v, *vec = argv[0];
if (SCHEME_NP_CHAPERONEP(vec))
vec = SCHEME_CHAPERONE_VAL(vec);
if (!SCHEME_MUTABLE_VECTORP(vec))
scheme_wrong_contract("vector-fill!", "(and/c vector? (not/c immutable?))", 0, argc, argv);
v = argv[1];
sz = SCHEME_VEC_SIZE(vec);
if (SAME_OBJ(vec, argv[0])) {
for (i = 0; i < sz; i++) {
SCHEME_VEC_ELS(argv[0])[i] = v;
}
} else {
for (i = 0; i < sz; i++) {
scheme_chaperone_vector_set(argv[0], i, v);
}
}
return scheme_void;
}
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;
}
static Scheme_Object *vector_copy_bang(int argc, Scheme_Object *argv[])
{
Scheme_Object *s1, *s2;
intptr_t istart, ifinish;
intptr_t ostart, ofinish;
int slow = 0;
s1 = argv[0];
if (SCHEME_NP_CHAPERONEP(s1)) {
slow = 1;
s1 = SCHEME_CHAPERONE_VAL(s1);
}
if (!SCHEME_MUTABLE_VECTORP(s1))
scheme_wrong_contract("vector-copy!", "(and/c vector? (not/c immutable?))", 0, argc, argv);
scheme_do_get_substring_indices("vector-copy!", s1,
argc, argv, 1, 5,
&ostart, &ofinish, SCHEME_VEC_SIZE(s1));
s2 = argv[2];
if (SCHEME_NP_CHAPERONEP(s2)) {
slow = 1;
s2 = SCHEME_CHAPERONE_VAL(s2);
}
if (!SCHEME_VECTORP(s2))
scheme_wrong_contract("vector-copy!", "vector?", 2, argc, argv);
scheme_do_get_substring_indices("vector-copy!", s2,
argc, argv, 3, 4,
&istart, &ifinish, SCHEME_VEC_SIZE(s2));
if ((ofinish - ostart) < (ifinish - istart)) {
scheme_contract_error("vector-copy!",
"not enough room in target vector",
"target vector", 1, argv[2],
"starting index", 1, scheme_make_integer(ostart),
"element count", 1, scheme_make_integer(ofinish - ostart),
NULL);
return NULL;
}
if (slow) {
int i, o;
for (i = istart, o = ostart; i < ifinish; i++, o++) {
scheme_chaperone_vector_set(argv[0], o, scheme_chaperone_vector_ref(argv[2], i));
}
} else {
memmove(SCHEME_VEC_ELS(s1) + ostart,
SCHEME_VEC_ELS(s2) + istart,
(ifinish - istart) * sizeof(Scheme_Object*));
}
return scheme_void;
}
static Scheme_Object *vector_copy_bang(int argc, Scheme_Object *argv[])
{
Scheme_Object *s1, *s2;
intptr_t istart, ifinish;
intptr_t ostart, ofinish;
int slow = 0;
s1 = argv[0];
if (SCHEME_NP_CHAPERONEP(s1)) {
slow = 1;
s1 = SCHEME_CHAPERONE_VAL(s1);
}
if (!SCHEME_MUTABLE_VECTORP(s1))
scheme_wrong_type("vector-copy!", "mutable vector", 0, argc, argv);
scheme_do_get_substring_indices("vector-copy!", s1,
argc, argv, 1, 5,
&ostart, &ofinish, SCHEME_VEC_SIZE(s1));
s2 = argv[2];
if (SCHEME_NP_CHAPERONEP(s2)) {
slow = 1;
s2 = SCHEME_CHAPERONE_VAL(s2);
}
if (!SCHEME_VECTORP(s2))
scheme_wrong_type("vector-copy!", "vector", 2, argc, argv);
scheme_do_get_substring_indices("vector-copy!", s2,
argc, argv, 3, 4,
&istart, &ifinish, SCHEME_VEC_SIZE(s2));
if ((ofinish - ostart) < (ifinish - istart)) {
scheme_arg_mismatch("vector-copy!",
"not enough room in target vector: ",
argv[2]);
return NULL;
}
if (slow) {
int i, o;
for (i = istart, o = ostart; i < ifinish; i++, o++) {
scheme_chaperone_vector_set(argv[0], o, scheme_chaperone_vector_ref(argv[2], i));
}
} else {
memmove(SCHEME_VEC_ELS(s1) + ostart,
SCHEME_VEC_ELS(s2) + istart,
(ifinish - istart) * sizeof(Scheme_Object*));
}
return scheme_void;
}
static Scheme_Object *
vector_fill (int argc, Scheme_Object *argv[])
{
int i;
if (!SCHEME_MUTABLE_VECTORP(argv[0]))
scheme_wrong_type("vector-fill!", "mutable vector", 0, argc, argv);
for (i = 0; i < SCHEME_VEC_SIZE(argv[0]); i++) {
SCHEME_VEC_ELS(argv[0])[i] = argv[1];
}
return argv[0];
}
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_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;
}