/*
* Create a TUPLE. For each element in the tuple
* bump its reference counter.
*/
ETERM *erl_mk_tuple (ETERM **arr,int size)
{
ETERM *ep;
int i;
if ((!arr) || (size < 0)) return NULL;
for (i=0; i<size; i++) if (!arr[i]) return NULL;
/* ASSERT(arr != NULL); */
ep = erl_alloc_eterm(ERL_TUPLE);
ERL_COUNT(ep) = 1;
ERL_TUPLE_SIZE(ep) = size;
ERL_TUPLE_ELEMS(ep) = (ETERM**) erl_malloc((size) * (sizeof(ETERM*)));
for (i = 0; i < size; i++) {
/* ASSERT(arr[i] != NULL); */
ERL_COUNT(arr[i])++;
ERL_TUPLE_ELEMENT(ep, i) = arr[i];
}
return ep;
}
/*
* FIXME: Deep (the whole tree) or shallow (just the top term) copy?
* The documentation never says, but the code as written below will
* make a deep copy. This should be documented.
*/
ETERM *erl_copy_term(const ETERM *ep)
{
int i;
ETERM *cp;
if (!ep) return NULL;
/* ASSERT(ep != NULL); */
cp = erl_alloc_eterm(ERL_TYPE(ep));
ERL_COUNT(cp) = 1;
switch(ERL_TYPE(cp)) {
case ERL_INTEGER:
case ERL_SMALL_BIG:
ERL_INT_VALUE(cp) = ERL_INT_VALUE(ep);
break;
case ERL_U_INTEGER:
case ERL_U_SMALL_BIG:
ERL_INT_UVALUE(cp) = ERL_INT_UVALUE(ep);
break;
case ERL_LONGLONG:
ERL_LL_VALUE(cp) = ERL_LL_VALUE(ep);
break;
case ERL_U_LONGLONG:
ERL_LL_UVALUE(cp) = ERL_LL_UVALUE(ep);
break;
case ERL_FLOAT:
ERL_FLOAT_VALUE(cp) = ERL_FLOAT_VALUE(ep);
break;
case ERL_ATOM:
if (!erl_atom_copy(&cp->uval.aval.d, &ep->uval.aval.d))
{
erl_free_term(cp);
erl_errno = ENOMEM;
return NULL;
}
break;
case ERL_PID:
/* FIXME: First copy the bit pattern, then duplicate the node
name and plug in. Somewhat ugly (also done with port and
ref below). */
memcpy(&cp->uval.pidval, &ep->uval.pidval, sizeof(Erl_Pid));
erl_atom_copy(&cp->uval.pidval.node, &ep->uval.pidval.node);
ERL_COUNT(cp) = 1;
break;
case ERL_PORT:
memcpy(&cp->uval.portval, &ep->uval.portval, sizeof(Erl_Port));
erl_atom_copy(&cp->uval.portval.node, &ep->uval.portval.node);
ERL_COUNT(cp) = 1;
break;
case ERL_REF:
memcpy(&cp->uval.refval, &ep->uval.refval, sizeof(Erl_Ref));
erl_atom_copy(&cp->uval.refval.node, &ep->uval.refval.node);
ERL_COUNT(cp) = 1;
break;
case ERL_LIST:
HEAD(cp) = erl_copy_term(HEAD(ep));
TAIL(cp) = erl_copy_term(TAIL(ep));
break;
case ERL_EMPTY_LIST:
break;
case ERL_TUPLE:
i = ERL_TUPLE_SIZE(cp) = ERL_TUPLE_SIZE(ep);
ERL_TUPLE_ELEMS(cp) = (ETERM**) erl_malloc(i * sizeof(ETERM*));
for(i=0; i < ERL_TUPLE_SIZE(ep); i++)
ERL_TUPLE_ELEMENT(cp,i) = erl_copy_term(ERL_TUPLE_ELEMENT(ep, i));
break;
case ERL_BINARY:
ERL_BIN_SIZE(cp) = ERL_BIN_SIZE(ep);
ERL_BIN_PTR(cp) = (unsigned char *) erl_malloc(ERL_BIN_SIZE(ep));
memcpy(ERL_BIN_PTR(cp), ERL_BIN_PTR(ep), ERL_BIN_SIZE(ep));
break;
case ERL_FUNCTION:
i = ERL_CLOSURE_SIZE(cp) = ERL_CLOSURE_SIZE(ep);
ERL_FUN_ARITY(cp) = ERL_FUN_ARITY(ep);
ERL_FUN_NEW_INDEX(cp) = ERL_FUN_NEW_INDEX(ep);
ERL_FUN_INDEX(cp) = erl_copy_term(ERL_FUN_INDEX(ep));
ERL_FUN_UNIQ(cp) = erl_copy_term(ERL_FUN_UNIQ(ep));
ERL_FUN_CREATOR(cp) = erl_copy_term(ERL_FUN_CREATOR(ep));
ERL_FUN_MODULE(cp) = erl_copy_term(ERL_FUN_MODULE(ep));
memcpy(ERL_FUN_MD5(cp), ERL_FUN_MD5(ep), sizeof(ERL_FUN_MD5(ep)));
ERL_CLOSURE(cp) = (ETERM**) erl_malloc(i * sizeof(ETERM*));
for(i=0; i < ERL_CLOSURE_SIZE(ep); i++)
ERL_CLOSURE_ELEMENT(cp,i) =
erl_copy_term(ERL_CLOSURE_ELEMENT(ep, i));
break;
default:
erl_err_msg("<ERROR> erl_copy_term: wrong type encountered !");
erl_free_term(cp);
return (ETERM *) NULL;
}
return cp;
}
/*
* Dump (print for debugging) a term. Useful if/when things go wrong.
*/
void
dump_term (FILE *fp, ETERM *t)
{
if (fp == NULL) return;
fprintf(fp, "#<%p ", t);
if(t != NULL)
{
fprintf(fp, "count:%d, type:%d", ERL_COUNT(t), ERL_TYPE(t));
switch(ERL_TYPE(t))
{
case ERL_UNDEF:
fprintf(fp, "==undef");
break;
case ERL_INTEGER:
fprintf(fp, "==int, val:%d", ERL_INT_VALUE(t));
break;
case ERL_U_INTEGER:
fprintf(fp, "==uint, val:%u", ERL_INT_UVALUE(t));
break;
case ERL_FLOAT:
fprintf(fp, "==float, val:%g", ERL_FLOAT_VALUE(t));
break;
case ERL_ATOM:
fprintf(fp, "==atom, name:%p \"%s\"",
ERL_ATOM_PTR(t), ERL_ATOM_PTR(t));
break;
case ERL_BINARY:
fprintf(fp, "==binary, data:%p,%u",
ERL_BIN_PTR(t), ERL_BIN_SIZE(t));
break;
case ERL_PID:
fprintf(fp, "==pid, node:%p \"%s\"",
ERL_PID_NODE(t), ERL_PID_NODE(t));
break;
case ERL_PORT:
fprintf(fp, "==port, node:%p \"%s\"",
ERL_PORT_NODE(t), ERL_PORT_NODE(t));
break;
case ERL_REF:
fprintf(fp, "==ref, node:%p \"%s\"",
ERL_REF_NODE(t), ERL_REF_NODE(t));
break;
case ERL_CONS:
fprintf(fp, "==cons");
fprintf(fp, ", car:");
dump_term(fp, ERL_CONS_HEAD(t));
fprintf(fp, ", cdr:");
dump_term(fp, ERL_CONS_TAIL(t));
break;
case ERL_NIL:
fprintf(fp, "==nil");
break;
case ERL_TUPLE:
fprintf(fp, "==tuple, elems:%p,%u",
ERL_TUPLE_ELEMS(t), ERL_TUPLE_SIZE(t));
{
size_t i;
for(i = 0; i < ERL_TUPLE_SIZE(t); i++)
{
fprintf(fp, "elem[%u]:", i);
dump_term(fp, ERL_TUPLE_ELEMENT(t, i));
}
}
break;
case ERL_VARIABLE:
fprintf(fp, "==variable, name:%p \"%s\"",
ERL_VAR_NAME(t), ERL_VAR_NAME(t));
fprintf(fp, ", value:");
dump_term(fp, ERL_VAR_VALUE(t));
break;
default:
break;
}
}
fprintf(fp, ">");
}
