int cst_val_consp(const cst_val *v)
{
/* To keep a val cell down to 8 bytes we identify non-cons cells */
/* with non-zero values in the least significant bit of the first */
/* address in the cell (this is a standard technique used on Lisp */
/* machines */
#if 0
void *t;
int t1;
/* Hmm this still isn't right (it can be) but this isn't it */
t = CST_VAL_CAR(v);
t1 = *(int *)&t;
if ((t1&0x1) == 0)
return TRUE;
else
return FALSE;
#endif
const cst_val_atom *t;
t = (const cst_val_atom *)v;
if (t->type % 2 == 0)
return TRUE;
else
return FALSE;
}
const cst_val *set_car(cst_val *v1, const cst_val *v2)
{
/* destructive set car, be careful you have a pointer to current cdr */
if (!cst_val_consp(v1))
{
cst_errmsg("VAL: tried to set car of non-consp cell\n");
cst_error();
return NULL;
}
else
{
val_dec_refcount(CST_VAL_CAR(v1));
val_inc_refcount(v1);
CST_VAL_CAR(v1) = (cst_val *)v2;
}
return v1;
}
cst_val *cons_val(const cst_val *a, const cst_val *b)
{
cst_val *v = new_val();
CST_VAL_CAR(v)=((!a || cst_val_consp(a)) ?
(cst_val *)(void *)a:val_inc_refcount(a));
CST_VAL_CDR(v)=((!b || cst_val_consp(b)) ?
(cst_val *)(void *)b:val_inc_refcount(b));
return v;
}
const cst_val *val_car(const cst_val *v)
{
if (v && cst_val_consp(v))
return CST_VAL_CAR(v);
else
{
cst_errmsg("VAL: tried to access car in %d typed val\n",
(v ? CST_VAL_TYPE(v) : -1));
cst_error();
}
return 0;
}
void delete_val(cst_val *v)
{
if (v)
{
if (cst_val_consp(v))
{
delete_val(CST_VAL_CAR(v));
delete_val(CST_VAL_CDR(v));
cst_free(v);
}
else if (val_dec_refcount(v) == 0)
{
if (CST_VAL_TYPE(v) == CST_VAL_TYPE_STRING)
cst_free(CST_VAL_VOID(v));
else if (CST_VAL_TYPE(v) >= CST_VAL_TYPE_FIRST_FREE)
(cst_val_defs[CST_VAL_TYPE(v)/2].delete_function)(CST_VAL_VOID(v));
cst_free(v);
}
}
}