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; }