int64_t sixty_four_bits(Lisp_Object a)
{
switch ((int)a & TAG_BITS)
{
case TAG_FIXNUM:
return int_of_fixnum(a);
case TAG_NUMBERS:
if (is_bignum(a))
{ int len = bignum_length(a);
switch (len)
{
case CELL+4:
return (int64_t)bignum_digits(a)[0]; /* One word bignum */
case CELL+8:
return bignum_digits(a)[0] |
((int64_t)bignum_digits(a)[1] << 31);
default:
return bignum_digits(a)[0] |
((int64_t)bignum_digits(a)[1] << 31) |
((int64_t)bignum_digits(a)[2] << 62);
}
}
/* else drop through */
case TAG_BOXFLOAT:
default:
/*
* return 0 for all non-fixnums
*/
return 0;
}
}
int32_t thirty_two_bits(Lisp_Object a)
/*
* return a 32 bit integer value for the Lisp integer (fixnum or bignum)
* passed down - ignore any higher order bits and return 0 if the arg was
* floating, rational etc or not a number at all. Only really wanted where
* links between C-specific code (that might really want 32-bit values)
* and Lisp are being coded.
*/
{
switch ((int)a & TAG_BITS)
{
case TAG_FIXNUM:
return int_of_fixnum(a);
case TAG_NUMBERS:
if (is_bignum(a))
{ int len = bignum_length(a);
/*
* Note that I keep 31 bits per word and use a 2s complement representation.
* thus if I have a one-word bignum I just want its contents but in all
* other cases I need just one bit from the next word up.
*/
if (len == CELL+4) return bignum_digits(a)[0]; /* One word bignum */
return bignum_digits(a)[0] | (bignum_digits(a)[1] << 31);
}
/* else drop through */
case TAG_BOXFLOAT:
default:
/*
* return 0 for all non-fixnums
*/
return 0;
}
}
void seek_live(term_t *tp, apr_memnode_t *newest, heap_t *hp)
{
term_t t = *tp;
apr_memnode_t *node;
term_box_t *ptr;
// newest node - the node last generation the term may belong to
// the node chain starts with the newest and goes to hp->gc_spot
if (is_immed(t))
return;
ptr = peel(t);
node = newest;
while (node != hp->gc_spot)
{
if (node_contains(node, ptr))
{
// the term belongs to the newer generation
// of terms; recurse to find possible references
// to live terms in hp->gc_spot
// only tuples, conses, funs (frozen)
// and binaries (data, parent) contain references
// order of popularity:
// cons - tuple - binary - fun
if (is_cons(t))
{
seek_live(&ptr->cons.head, node, hp);
seek_live(&ptr->cons.tail, node, hp);
}
else if (is_tuple(t))
{
int i;
int n = ptr->tuple.size;
for (i = 0; i < n; i++)
seek_live(&ptr->tuple.elts[i], node, hp);
}
else if (is_binary(t))
{
if (ptr->binary.parent != noval)
{
term_box_t *parent;
seek_live(&ptr->binary.parent, node, hp);
parent = peel(ptr->binary.parent);
ptr->binary.data = parent->binary.data + ptr->binary.offset;
}
}
else if (is_fun(t))
{
seek_live(&ptr->fun.frozen, node, hp);
}
return;
}
node = node->next;
}
if (node_contains(hp->gc_spot, ptr))
{
// the term should be recreated
// the term may have already been moved
// and the term value has been replaced with
// the buried reference to the new location
if (is_grave(t))
{
*tp = ptr->grave.skeleton;
return;
}
// list - tuple - binary - fun - bignum - pid - float
if (is_list(t))
{
term_t cons = heap_cons2(hp, ptr->cons.head, ptr->cons.tail);
term_box_t *box = peel(cons);
seek_live(&box->cons.head, hp->gc_spot, hp);
seek_live(&box->cons.tail, hp->gc_spot, hp);
*tp = cons;
}
else if (is_tuple(t))
{
term_t tuple = heap_tuple(hp, ptr->tuple.size);
term_box_t *box = peel(tuple);
int i;
for (i = 0; i < ptr->tuple.size; i++)
{
box->tuple.elts[i] = ptr->tuple.elts[i];
seek_live(&box->tuple.elts[i], hp->gc_spot, hp);
}
*tp = tuple;
}
else if (is_binary(t))
{
term_t parent = ptr->binary.parent;
term_t b;
if (parent == noval)
b = heap_binary(hp, ptr->binary.bit_size, ptr->binary.data);
else
{
apr_byte_t *data;
seek_live(&parent, hp->gc_spot, hp);
data = peel(parent)->binary.data + ptr->binary.offset;
b = heap_binary_shared(hp, ptr->binary.bit_size, data, parent);
}
*tp = b;
}
else if (is_fun(t))
{
term_t f = heap_fun(hp,
ptr->fun.module, ptr->fun.function, ptr->fun.arity,
ptr->fun.uniq, ptr->fun.index, ptr->fun.frozen);
seek_live(&peel(f)->fun.frozen, hp->gc_spot, hp);
*tp = f;
}
else if (is_bignum(t))
{
mp_int ma = bignum_to_mp(t);
*tp = heap_bignum(hp, SIGN(&ma), USED(&ma), DIGITS(&ma));
}
else if (is_long_id(t))
{
*tp = heap_long_id(hp,
ptr->long_id.node,
ptr->long_id.serial,
ptr->long_id.tag_creation);
}
else // if (is_float(t))
{
assert(is_float(t));
*tp = heap_float(hp, float_value(t));
}
// bury the term
ptr->grave.cross = MAGIC_CROSS;
ptr->grave.skeleton = *tp;
return;
}
else
{
// the term belong to the older generation or
// to the literal pool of the module -- ignore
return;
}
}
static CSLbool numeqsr(Lisp_Object a, Lisp_Object b)
/*
* Here I will rely somewhat on the use of IEEE floating point values
* (an in particular the weaker supposition that I have floating point
* with a binary radix). Then for equality the denominator of b must
* be a power of 2, which I can test for and then account for.
*/
{
Lisp_Object nb = numerator(b), db = denominator(b);
double d = float_of_number(a), d1;
int x;
int32_t dx, w, len;
uint32_t u, bit;
/*
* first I will check that db (which will be positive) is a power of 2,
* and set dx to indicate what power of two it is.
* Note that db != 0 and that one of the top two words of a bignum
* must be nonzero (for normalisation) so I end up with a nonzero
* value in the variable 'bit'
*/
if (is_fixnum(db))
{ bit = int_of_fixnum(db);
w = bit;
if (w != (w & (-w))) return NO; /* not a power of 2 */
dx = 0;
}
else if (is_numbers(db) && is_bignum(db))
{ int32_t lenb = (bignum_length(db)-CELL-4)/4;
bit = bignum_digits(db)[lenb];
/*
* I need to cope with bignums where the leading digits is zero because
* the 0x80000000 bit of the next word down is 1. To do this I treat
* the number as having one fewer digits.
*/
if (bit == 0) bit = bignum_digits(db)[--lenb];
w = bit;
if (w != (w & (-w))) return NO; /* not a power of 2 */
dx = 31*lenb;
while (--lenb >= 0) /* check that the rest of db is zero */
if (bignum_digits(db)[lenb] != 0) return NO;
}
else return NO; /* Odd - what type IS db here? Maybe error. */
if ((bit & 0xffffU) == 0) dx += 16, bit = bit >> 16;
if ((bit & 0xff) == 0) dx += 8, bit = bit >> 8;
if ((bit & 0xf) == 0) dx += 4, bit = bit >> 4;
if ((bit & 0x3) == 0) dx += 2, bit = bit >> 2;
if ((bit & 0x1) == 0) dx += 1;
if (is_fixnum(nb))
{ double d1 = (double)int_of_fixnum(nb);
/*
* The ldexp on the next line could potentially underflow. In that case C
* defines that the result 0.0 be returned. To avoid trouble I put in a
* special test the relies on that fact that a value represented as a rational
* would not have been zero.
*/
if (dx > 10000) return NO; /* Avoid gross underflow */
d1 = ldexp(d1, (int)-dx);
return (d == d1 && d != 0.0);
}
len = (bignum_length(nb)-CELL-4)/4;
if (len == 0) /* One word bignums can be treated specially */
{ int32_t v = bignum_digits(nb)[0];
double d1;
if (dx > 10000) return NO; /* Avoid gross underflow */
d1 = ldexp((double)v, (int)-dx);
return (d == d1 && d != 0.0);
}
d1 = frexp(d, &x); /* separate exponent from mantissa */
if (d1 == 1.0) d1 = 0.5, x++; /* For Zortech */
dx += x; /* adjust to allow for the denominator */
d1 = ldexp(d1, (int)(dx % 31));
/* can neither underflow nor overflow here */
/*
* At most 3 words in the bignum may contain nonzero data - I subtract
* the (double) value of those bits off and check that (a) the floating
* result left is zero and (b) there are no more bits left.
*/
dx = dx / 31;
if (dx != len) return NO;
w = bignum_digits(nb)[len];
d1 = (d1 - (double)w) * TWO_31;
u = bignum_digits(nb)[--len];
d1 = (d1 - (double)u) * TWO_31;
if (len > 0)
{ u = bignum_digits(nb)[--len];
d1 = d1 - (double)u;
}
if (d1 != 0.0) return NO;
while (--len >= 0)
if (bignum_digits(nb)[len] != 0) return NO;
return YES;
}
int are_terms_equal(term_t a, term_t b, int exact)
{
assert(a != b); // should be checked elsewhere
if (is_immed(a) || is_immed(b))
{
if (exact)
return 0;
if (is_int(a) && is_boxed(b))
{
uint32_t *term_data = peel_boxed(b);
return (boxed_tag(term_data) == SUBTAG_FLOAT)
&& (double)int_value(a) == float_value(term_data);
}
else if (is_boxed(a) && is_int(b))
{
uint32_t *term_data = peel_boxed(a);
return (boxed_tag(term_data) == SUBTAG_FLOAT)
&& (float_value(term_data) == (double)int_value(b));
}
return 0;
}
if (is_cons(a))
{
if (is_cons(b))
{
do {
uint32_t *cons1 = peel_cons(a);
uint32_t *cons2 = peel_cons(b);
if (cons1[0] != cons2[0]
&& !are_terms_equal(cons1[0], cons2[0], exact))
return 0;
a = cons1[1];
b = cons2[1];
} while (is_cons(a) && is_cons(b));
return (a == b) || are_terms_equal(a, b, exact);
}
else
return 0;
}
else if (is_tuple(a))
{
if (is_tuple(b))
{
uint32_t *data1 = peel_tuple(a);
uint32_t *data2 = peel_tuple(b);
if (data1[0] != data2[0])
return 0;
for (int i = 1; i <= data1[0]; i++)
if (data1[i] != data2[i]
&& !are_terms_equal(data1[i], data2[i], exact))
return 0;
return 1;
}
else
return 0;
}
else
{
assert(is_boxed(a));
if (!is_boxed(b))
return 0;
uint32_t *term_data1 = peel_boxed(a);
uint32_t *term_data2 = peel_boxed(b);
uint32_t subtag = boxed_tag(term_data1);
if (!exact && subtag == SUBTAG_FLOAT && is_bignum(term_data2))
return float_value(term_data1) == bignum_to_double((bignum_t *)term_data2);
if (!exact && is_bignum(term_data1) && boxed_tag(term_data2) == SUBTAG_FLOAT)
return bignum_to_double((bignum_t *)term_data1) == float_value(term_data2);
if (subtag != boxed_tag(term_data2) &&
!(is_binary(term_data1) && is_binary(term_data2)))
return 0;
switch (subtag)
{
case SUBTAG_POS_BIGNUM:
case SUBTAG_NEG_BIGNUM:
{
bignum_t *bn1 = (bignum_t *)term_data1;
bignum_t *bn2 = (bignum_t *)term_data2;
return bignum_compare(bn1, bn2) == 0;
}
case SUBTAG_FUN:
{
t_fun_t *f1 = (t_fun_t *)term_data1;
t_fun_t *f2 = (t_fun_t *)term_data2;
if (f1->module != f2->module ||
f1->index != f2->index ||
f1->old_uniq != f2->old_uniq)
return 0;
int num_free = fun_num_free(term_data1);
assert(num_free == fun_num_free(term_data2));
for (int i = 0; i < num_free; i++)
{
term_t v1 = f1->frozen[i];
term_t v2 = f2->frozen[i];
if (v1 != v2 && !are_terms_equal(v1, v2, exact))
return 0;
}
return 1;
}
case SUBTAG_EXPORT:
{
export_t *e1 = ((t_export_t *)term_data1)->e;
export_t *e2 = ((t_export_t *)term_data2)->e;
return e1->module == e2->module &&
e1->function == e2->function &&
e1->arity == e2->arity;
}
case SUBTAG_PID:
{
t_long_pid_t *pid1 = (t_long_pid_t *)term_data1;
t_long_pid_t *pid2 = (t_long_pid_t *)term_data2;
return pid1->node == pid2->node &&
pid1->serial == pid2->serial &&
opr_hdr_id(pid1) == opr_hdr_id(pid2) &&
opr_hdr_creat(pid1) == opr_hdr_creat(pid2);
}
case SUBTAG_OID:
{
t_long_oid_t *oid1 = (t_long_oid_t *)term_data1;
t_long_oid_t *oid2 = (t_long_oid_t *)term_data2;
return oid1->node == oid2->node &&
opr_hdr_id(oid1) == opr_hdr_id(oid2) &&
opr_hdr_creat(oid1) == opr_hdr_creat(oid2);
}
case SUBTAG_REF:
{
t_long_ref_t *ref1 = (t_long_ref_t *)term_data1;
t_long_ref_t *ref2 = (t_long_ref_t *)term_data2;
return ref1->node == ref2->node &&
ref1->id1 == ref2->id1 &&
ref1->id2 == ref2->id2 &&
opr_hdr_id(ref1) == opr_hdr_id(ref2) &&
opr_hdr_creat(ref1) == opr_hdr_creat(ref2);
}
case SUBTAG_PROC_BIN:
case SUBTAG_HEAP_BIN:
case SUBTAG_MATCH_CTX:
case SUBTAG_SUB_BIN:
{
bits_t bs1, bs2;
bits_get_real(term_data1, &bs1);
bits_get_real(term_data2, &bs2);
return (bits_compare(&bs1, &bs2) == 0);
}
default:
assert(subtag == SUBTAG_FLOAT);
return float_value(term_data1) == float_value(term_data2);
}
return 1;
}
}
int is_term_smaller(term_t a, term_t b)
{
if (a == b)
return 0;
if (are_both_immed(a, b))
{
if (are_both_int(a, b))
return int_value(a) < int_value(b);
if (is_int(a)) // !is_int(b)
return 1;
if (is_nil(a)) // !is_nil(b)
return 0;
if (is_nil(b)) // !is_nil(a)
return 1;
if (is_atom(a))
{
if (is_int(b))
return 0;
else if (is_atom(b))
{
uint8_t *print1 = atoms_get(atom_index(a));
uint8_t *print2 = atoms_get(atom_index(b));
int short_len = (print1[0] < print2[0])
? print1[0]
: print2[0];
int d = memcmp(print1+1, print2+1, short_len);
if (d == 0)
return print1[0] < print2[0];
return d < 0;
}
else
return 1;
}
else if (is_short_oid(a))
{
if (is_int(b) || is_atom(b))
return 0;
else if (is_short_oid(b))
return short_oid_id(a) < short_oid_id(b);
else
return 1;
}
else if (is_short_pid(a))
{
if (is_int(b) || is_atom(b) || is_short_oid(b))
return 0;
else
{
assert(is_short_pid(b));
return short_pid_id(a) < short_pid_id(b);
}
}
}
//TODO: comparison of bignum and float: docs mention the
// number 9007199254740992.0 and a loss of transitivity
if (!is_immed(a) && !is_immed(b) &&
primary_tag(a) == primary_tag(b))
{
if (is_cons(a))
return is_term_smaller_1(a, b);
else if (is_tuple(a))
return is_term_smaller_2(a, b);
else
{
assert(is_boxed(a) && is_boxed(b));
uint32_t *adata = peel_boxed(a);
uint32_t *bdata = peel_boxed(b);
if (boxed_tag(adata) == boxed_tag(bdata) ||
(is_binary(adata) && is_binary(bdata)) ||
(is_bignum(adata) && is_bignum(bdata)))
{
switch(boxed_tag(adata))
{
case SUBTAG_POS_BIGNUM:
case SUBTAG_NEG_BIGNUM:
return bignum_compare((bignum_t *)adata,
(bignum_t *)bdata) < 0;
case SUBTAG_FUN:
return fun_compare((t_fun_t *)adata,
(t_fun_t *)bdata) < 0;
case SUBTAG_EXPORT:
return export_compare((t_export_t *)adata,
(t_export_t *)bdata) < 0;
case SUBTAG_PID:
return pid_compare((t_long_pid_t *)adata,
(t_long_pid_t *)bdata) < 0;
case SUBTAG_OID:
return oid_compare((t_long_oid_t *)adata,
(t_long_oid_t *)bdata) < 0;
case SUBTAG_REF:
return ref_compare((t_long_ref_t *)adata,
(t_long_ref_t *)bdata) < 0;
case SUBTAG_PROC_BIN:
case SUBTAG_HEAP_BIN:
case SUBTAG_MATCH_CTX:
case SUBTAG_SUB_BIN:
return is_term_smaller_3(adata, bdata);
default:
assert(boxed_tag(adata) == SUBTAG_FLOAT);
return float_value(adata) < float_value(bdata);
}
}
}
}
// Number comparison with (mandatory) coercion
//
int use_float = (is_boxed(a) && boxed_tag(peel_boxed(a)) == SUBTAG_FLOAT) ||
(is_boxed(b) && boxed_tag(peel_boxed(b)) == SUBTAG_FLOAT);
if (use_float)
{
if (is_int(a)) // b is always float
return (double)int_value(a) < float_value(peel_boxed(b));
else if (is_boxed(a))
{
uint32_t *adata = peel_boxed(a);
if (is_bignum(adata)) // b is always float
return bignum_to_double((bignum_t *)adata) < float_value(peel_boxed(b));
if (boxed_tag(adata) == SUBTAG_FLOAT)
{
if (is_int(b))
return float_value(adata) < (double)int_value(b);
if (is_boxed(b))
{
uint32_t *bdata = peel_boxed(b);
if (is_bignum(bdata))
return float_value(adata) < bignum_to_double((bignum_t *)bdata);
}
}
}
}
else // use integer
{
if (is_int(a))
{
if (is_boxed(b))
{
uint32_t *bdata = peel_boxed(b);
if (is_bignum(bdata))
{
bignum_t *bbn = (bignum_t *)bdata;
return !bignum_is_neg(bbn);
}
assert(boxed_tag(bdata) != SUBTAG_FLOAT);
}
}
else if (is_boxed(a))
{
uint32_t *adata = peel_boxed(a);
if (is_bignum(adata))
{
bignum_t *abn = (bignum_t *)adata;
if (is_int(b))
return bignum_is_neg(abn);
if (is_boxed(b))
{
uint32_t *bdata = peel_boxed(b);
if (is_bignum(bdata))
return bignum_compare(abn, (bignum_t *)bdata);
assert(boxed_tag(bdata) != SUBTAG_FLOAT);
}
}
assert(boxed_tag(adata) != SUBTAG_FLOAT);
}
}
// a and b are quaranteed to have different types
//
return term_order(a) < term_order(b);
}
//cons - tuple - binary - fun
term_t heap_marshal(term_t t, heap_t *hp)
{
term_box_t *box;
if (is_immed(t))
return t;
box = peel(t);
if (is_cons(t))
{
term_t first = nil;
term_t last = nil;
do {
term_box_t *cb = peel(t);
term_t v = heap_marshal(cb->cons.head, hp);
cons_up(first, last, v, hp);
t = cb->cons.tail;
} while (is_cons(t));
if (t != nil)
peel(last)->cons.tail = heap_marshal(t, hp);
return first;
}
else if (is_tuple(t))
{
int n = box->tuple.size;
term_t tuple = heap_tuple(hp, n);
term_box_t *tb = peel(tuple);
int i;
for (i = 0; i < n; i++)
tb->tuple.elts[i] = heap_marshal(box->tuple.elts[i], hp);
return tuple;
}
else if (is_binary(t))
{
//NB: for shared binaries parent not copied; shared becomes root
term_t binary = heap_binary(hp, box->binary.bit_size, box->binary.data);
return binary;
}
else if (is_bignum(t))
{
bignum_t *bb = (bignum_t *)peel(t);
term_t biggie = heap_bignum(hp, bb->sign, bb->used, bb->dp);
return biggie;
}
else if (is_float(t))
{
term_t f = heap_float(hp, float_value(t));
return f;
}
else if (is_fun(t))
{
term_t fun = heap_fun(hp,
box->fun.module,
box->fun.function,
box->fun.arity,
box->fun.uniq,
box->fun.index,
heap_marshal(box->fun.frozen, hp));
return fun;
}
else // long_id
{
term_t id;
assert(is_long_id(t));
id = heap_long_id(hp,
box->long_id.node,
box->long_id.serial,
box->long_id.tag_creation);
return id;
}
}
int code_base_load(code_base_t *self, named_tuples_t *nm_tuples,
term_t module, term_t exports, term_t fun_table, term_t attrs, term_t preloaded, term_t misc)
{
module_t *m;
apr_pool_t *pool;
apr_pool_create(&pool, 0);
m = apr_palloc(pool, sizeof(*m));
m->mod_pool = pool;
m->literals = heap_make(pool);
m->key.module = module;
m->key.is_old = 0;
m->code_size = 0;
m->code = 0;
m->exports = apr_hash_make(pool);
m->nfuns = 0;
m->funs = 0;
m->files = 0;
m->source = 0;
if (preloaded != nil)
{
int i;
int n = list_length(preloaded);
term_t cons = preloaded;
int ok = 1;
m->code = apr_palloc(pool, n*sizeof(codel_t));
m->code_size = n;
i = 0;
while (ok && is_cons(cons))
{
term_box_t *cbox = peel(cons);
if (is_int(cbox->cons.head))
{
m->code[i].i = int_value(cbox->cons.head);
}
else if (is_tuple(cbox->cons.head))
{
term_box_t *tbox = peel(cbox->cons.head);
if (tbox->tuple.size == 2)
{
term_t selector = tbox->tuple.elts[0];
term_t value = tbox->tuple.elts[1];
switch (selector)
{
case AT__: // {'@',Offset}
m->code[i].l = m->code + int_value(value);
break;
case A_T: // {t,Literal}
m->code[i].t = heap_marshal(value, m->literals);
break;
case A_B:
m->code[i].bif = builtins[int_value(value)].entry;
break;
case A_N: // {n,{N,F}}
if (is_tuple(value))
{
term_box_t *vb = peel(value);
if (vb->tuple.size == 2)
{
term_t name = vb->tuple.elts[0];
term_t field = vb->tuple.elts[1];
int index = named_tuples_set(nm_tuples, name, field);
m->code[i].t = tag_int(index);
}
else
ok = 0;
}
else
ok = 0;
break;
default:
ok = 0;
}
}
}
else if (is_bignum(cbox->cons.head))
{
mp_int mp = bignum_to_mp(cbox->cons.head);
m->code[i].i = mp_get_int(&mp);
}
else
ok = 0;
i++;
cons = cbox->cons.tail;
}
if (!ok)
{
apr_pool_destroy(pool);
return 1;
}
}
// misc:
// source line info:
// {file,Files}
// {source,[{F,L,S,E}]}
if (misc != nil)
{
term_t cons = misc;
while (is_cons(cons))
{
term_box_t *cb = peel(cons);
term_t t = cb->cons.head;
if (is_tuple(t))
{
term_box_t *tb = peel(t);
if (tb->tuple.size >= 2)
{
term_t selector = tb->tuple.elts[0];
term_t info = tb->tuple.elts[1];
switch (selector)
{
case A_FILES:
m->files = source_files_names(info, pool);
break;
case A_SOURCE:
m->source = source_line_blocks(info, pool);
break;
}
}
}
cons = cb->cons.tail;
}
}
if (fun_table != nil)
{
int i;
int nfuns = list_length(fun_table);
term_t cons = fun_table;
int ok = 1;
m->funs = apr_palloc(pool, nfuns*sizeof(fun_slot_t));
m->nfuns = nfuns;
for (i = 0; ok && i < nfuns; i++)
{
term_box_t *cbox = peel(cons);
if (is_tuple(cbox->cons.head))
{
term_box_t *tbox = peel(cbox->cons.head);
if (tbox->tuple.size == 2)
{
term_t uniq = tbox->tuple.elts[0];
term_t offset = tbox->tuple.elts[1];
if ((is_int(uniq) || is_bignum(uniq)) && is_int(offset))
{
fun_slot_t *slot = &m->funs[i];
if (is_int(uniq))
slot->uniq = int_value(uniq);
else
{
mp_int mp = bignum_to_mp(uniq);
slot->uniq = (uint)mp_get_int(&mp);
}
slot->entry = m->code + int_value(offset);
}
else
ok = 0;
}
else
ok = 0;
}
else
ok = 0;
cons = cbox->cons.tail;
}
if (!ok)
{
apr_pool_destroy(pool);
return 1;
}
}
//TODO: attrs ingnored
if (exports != nil)
{
int ok = 1;
term_t cons = exports;
while (ok && is_cons(cons))
{
term_box_t *cbox = peel(cons);
// {Function,Arity,Offset}
if (is_tuple(cbox->cons.head))
{
term_box_t *tbox = peel(cbox->cons.head);
if (tbox->tuple.size == 3)
{
term_t function = tbox->tuple.elts[0];
term_t arity = tbox->tuple.elts[1];
term_t offset = tbox->tuple.elts[2];
if (is_atom(function) && is_int(arity) && is_int(offset))
{
export_t *exp = apr_palloc(pool, sizeof(*exp));
exp->key.function = function;
exp->key.arity = int_value(arity);
exp->entry = m->code + int_value(offset);
apr_hash_set(m->exports, &exp->key, sizeof(exp->key), exp);
}
else
ok = 0;
}
else
ok = 0;
}
else
ok = 0;
cons = cbox->cons.tail;
}
if (!ok)
{
apr_pool_destroy(pool);
return 1;
}
}
apr_hash_set(self->modules, &m->key, sizeof(m->key), m);
return 0;
}
