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 void check_hash_table_flags(const char *name, int i, int argc, Scheme_Object **argv, int *flags)
{
for (; i < argc; i++) {
int j;
if (SAME_OBJ(argv[i], weak_symbol))
j = 0;
else if (SAME_OBJ(argv[i], equal_symbol))
j = 1;
else {
scheme_wrong_type(name, "'weak or 'equal", i, argc, argv);
return;
}
if (flags[j])
scheme_arg_mismatch(name, "redundant flag: ", argv[i]);
flags[j] = 1;
}
}
