/* *** ptrvalue creating *** */
cons_t *cons_new(vm_t *vm) {
cons_t *cons = (cons_t *) vm_realloc(vm, NULL, 0, sizeof(cons_t));
ptr_init(vm, &cons->p, T_CONS);
cons->car = NIL_VAL;
cons->cdr = NIL_VAL;
return cons;
}
primitive_t *primitive_new(vm_t *vm, primitive_fn fn) {
primitive_t *prim =
(primitive_t *) vm_realloc(vm, NULL, 0, sizeof(primitive_t));
ptr_init(vm, &prim->p, T_PRIMITIVE);
prim->name = NULL;
prim->fn = fn;
return prim;
}
env_t *env_new(vm_t *vm, value_t variables, env_t *up) {
env_t *env = (env_t *) vm_realloc(vm, NULL, 0, sizeof(env_t));
ptr_init(vm, &env->p, T_ENV);
env->variables = variables;
env->up = up;
vm->env = env;
return env;
}
function_t *function_new(vm_t *vm, env_t *env, value_t params, value_t body) {
function_t *fn = (function_t *) vm_realloc(vm, NULL, 0, sizeof(function_t));
ptr_init(vm, &fn->p, T_FUNCTION);
fn->name = NULL;
fn->env = env;
fn->params = params;
fn->body = body;
return fn;
}
function_t *macro_new(vm_t *vm, env_t *env, value_t params, value_t body) {
function_t *macro =
(function_t *) vm_realloc(vm, NULL, 0, sizeof(function_t));
ptr_init(vm, ¯o->p, T_MACRO);
macro->name = NULL;
macro->env = env;
macro->params = params;
macro->body = body;
return macro;
}
vector_t *vector_new(vm_t *vm, uint32_t count) {
value_t *data = NULL;
if (count > 0) {
data = (value_t *) vm_realloc(vm, NULL, 0, sizeof(value_t) * count);
}
vector_t *vec = (vector_t *) vm_realloc(vm, NULL, 0, sizeof(vector_t));
ptr_init(vm, &vec->p, T_VECTOR);
vec->capacity = count;
vec->count = count;
vec->data = data;
return vec;
}
string_t *string_new(vm_t *vm, const char *text, size_t len) {
string_t *str = (string_t *) vm_realloc(
vm, NULL, 0, sizeof(string_t) + sizeof(char) * (len + 1));
ptr_init(vm, &str->p, T_STRING);
str->len = (uint32_t) len;
str->value[len] = '\0';
if (len > 0 && text != NULL) {
memcpy(str->value, text, len);
}
hash_string(str);
return str;
}
symbol_t *symbol_new(vm_t *vm, const char *name, size_t len) {
if (len == 0 || name == NULL) {
error_runtime(vm, "NULL or 0-length symbols are not allowed!");
return NULL;
}
symbol_t *sym = (symbol_t *) vm_realloc(
vm, NULL, 0, sizeof(symbol_t) + sizeof(char) * (len + 1));
ptr_init(vm, &sym->p, T_SYMBOL);
sym->len = (uint32_t) len;
sym->name[len] = '\0';
sym->next = NULL;
memcpy(sym->name, name, len);
return sym;
}
void *
daav(
unsigned int data_size,
unsigned int num_dim,
unsigned int *dim,
int *st,
int *err_code,
char **free_ptr,
char *init_ptr)
{
unsigned int i, j;
/* array of current dimension indices */
int dim_ind[MAX_DIM];
char *p_data, /* pointer to array data */
*p; /* tmp pointer */
/* points to base of allocated array */
char *base_ptr;
/* points to base of pointers to pointers to ... to data */
char *ptr_ptr;
/* product of dimensions from 0 to index, dim[0]*dim[1]...dim[index] */
unsigned int dp[MAX_DIM];
if ( num_dim < 1 || num_dim > MAX_DIM )
{
*err_code = ERRS_INV_DIMS;
return NULL;
}
if ( data_size < 1 )
{
*err_code = ERRS_INV_REQ_SIZE;
return NULL;
}
/*
* set dim_ind to all zeros, the multiple invocations of the recursive
* array allocation routine ptr_init() will pass changed by 1 dim_ind arrays
* to each invocation of ptr_init(). set dp[] from dim[] input array.
*/
dp[0] = dim[0];
for ( i = 0 ; i < num_dim ; i++ )
{
dim_ind[i] = 0;
if ( dim[i] <= 0 )
{
*err_code = ERRS_INV_DIM;
return NULL;
}
if ( i > 0 )
{
dp[i] = dp[i-1] * dim[i];
}
}
/*
* allocate enough memory for the data(dp[num_dim-1]*data_size) plus all
* the array pointers(off(num_dim-1, dp)*sizeof(char *)) plus an extra
* sizeof(char *) to allow for possible realignment of start of pointer
* area on pointer alignment boundary.
*/
if ( (base_ptr = (char *) valloc(dp[num_dim-1] * data_size +
off(num_dim-1, dp) * sizeof(char *) + sizeof(char *))) == NULL )
{
*err_code = ERRS_FAIL_ALLOC;
return NULL;
}
/*
* calculate address of start of pointers. If not
* sizeof(char *) aligned make it so.
*/
ptr_ptr = base_ptr + dp[num_dim-1] * data_size;
for ( i = 0 ; i < sizeof(char *) ; i++, ++ptr_ptr )
{
if ( ((unsigned long)ptr_ptr)%sizeof(char *) == 0 )
{
break;
}
}
/* return allocated space pointer that caller should use to free space */
*free_ptr = base_ptr;
/* if init_ptr is NULL skip initialization */
if ( init_ptr != NULL )
{
/* set p_data to point to the start of the data area */
p_data = base_ptr;
/* initialize the array */
for ( i = 0 ; i < dp[num_dim-1] ; i++ )
{
p = init_ptr;
for ( j = 0 ; j < data_size ; j++ )
{
*p_data++ = *p++;
}
}
}
/* do array setup i.e. all the pointer stuff */
return ptr_init(0, dim_ind, data_size, num_dim, base_ptr,
ptr_ptr, dim, st, dp);
}
static char *
ptr_init(
unsigned int level,
int *dim_ind,
unsigned int data_size,
unsigned int num_dim,
char *data_ptr,
char *ptr_ptr,
unsigned int *dim,
int *st,
unsigned int *dp)
{
char **ptrs;
unsigned long i;
/*
* if level is not final level get pointer to array of pointers
* for that level and recursively call ptr_init() to return pointers to
* fill the array of pointers. if level is final level calculate
* position of data and return pointer to level-1.
*/
if ( level < (num_dim - 1) )
{
/*
* ptrs points to the start of a subarray of pointers to the
* next dimension level of pointers or data
*/
ptrs = (char **) (ptr_ptr + off(level, dp) * sizeof(char *) +
((level == 0)?0:doff(level, dim_ind,
dp[level], dp) * sizeof(char *)));
/* fill the array of pointers that ptrs points to */
for ( i = 0 ; i < dim[level] ; i++ )
{
dim_ind[level] = i;
/*
* the recursive call to ptr_init() returns a pointer to the
* next level and is then adjusted by st[] for a
* non-zero based subscript
*/
ptrs[i] = ptr_init(level+1, dim_ind, data_size, num_dim, data_ptr,
ptr_ptr, dim, st, dp) - st[level+1] *
((level+1 == num_dim-1)?data_size:sizeof(char *));
}
/*
* adjust zeroth level pointer that is passed back to root
* of recursive tree call
*/
if ( level == 0 )
{
ptrs -= st[0];
}
}
else
{
/*
* calculate pointers to data subarrays. if one dimensional
* array and non-zero subscripting adjust returned pointer
*/
ptrs = (char **) (data_ptr + doff(level, dim_ind, dp[level], dp) *
data_size - ((level == 0)?(st[0] * data_size):0));
}
return (char *) ptrs;
}
