Scheme_Object *
scheme_make_vector (intptr_t size, Scheme_Object *fill)
{
Scheme_Object *vec;
intptr_t i;
if (size < 0) {
vec = scheme_make_integer(size);
scheme_wrong_contract("make-vector", "exact-nonnegative-integer?", -1, 0, &vec);
}
if (size < 1024) {
vec = (Scheme_Object *)scheme_malloc_tagged(VECTOR_BYTES(size));
} else {
size_t sz;
sz = VECTOR_BYTES(size);
if (REV_VECTOR_BYTES(sz) != size)
/* overflow */
scheme_raise_out_of_memory(NULL, NULL);
else
vec = (Scheme_Object *)scheme_malloc_fail_ok(scheme_malloc_tagged, sz);
}
vec->type = scheme_vector_type;
SCHEME_VEC_SIZE(vec) = size;
if (fill) {
for (i = 0; i < size; i++) {
SCHEME_VEC_ELS(vec)[i] = fill;
}
}
return vec;
}
void *
scheme_malloc (size_t size)
{
void *space;
space = MALLOC(size);
if (!space)
scheme_raise_out_of_memory(NULL, NULL);
return (space);
}
void *
scheme_calloc (size_t num, size_t size)
{
void *space;
space = MALLOC(num*size);
if (!space)
scheme_raise_out_of_memory(NULL, NULL);
#ifdef NO_GC
memset(space, 0, (num*size));
#endif
return (space);
}
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 void raise_out_of_memory(void)
{
GC_out_of_memory = save_oom;
scheme_raise_out_of_memory(NULL, NULL);
}
