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