// inet:getaddrs0/2 [4]
term_t bif_getaddrs0_2(term_t Addr, term_t Family, proc_t *proc)
{
apr_status_t rs;
apr_pool_t *tmp;
apr_sockaddr_t *sa;
const char *host;
term_t addrs = nil;
if (!is_binary(Addr) || !is_atom(Family))
bif_bad_arg0();
if (Family != A_INET)
bif_exception(A_NOT_SUPPORTED);
host = (const char *)peel(Addr)->binary.data; //null-terminated by caller
apr_pool_create(&tmp, 0);
rs = apr_sockaddr_info_get(&sa, host, APR_INET, 0, 0, tmp);
if (rs == 0)
{
term_t first = nil;
term_t last = nil;
while (sa)
{
struct in_addr ia = *(struct in_addr *)sa->ipaddr_ptr;
apr_byte_t qs[4];
term_t ip;
#if APR_IS_BIGENDIAN
PUT32(qs, ia.s_addr);
#else
PUT32_LE(qs, ia.s_addr);
#endif
ip = heap_tuple4(proc->heap,
tag_int(qs[0]),
tag_int(qs[1]),
tag_int(qs[2]),
tag_int(qs[3]));
cons_up(first, last, ip, proc->heap);
sa = sa->next;
}
addrs = first;
}
apr_pool_destroy(tmp);
if (rs != 0)
bif_exception(decipher_status(rs));
return addrs;
}
static void disk_async(proc_t *caller,
term_t reply, term_t oid, uint16_t tag, term_t result)
{
//
// no need to marshal: reply is always an atom, result is either an atom or
// a binary allocated on the caller's heap
//
uint32_t *p = heap_alloc_N(&caller->hp, 1 +4);
if (p == 0)
goto nomem;
heap_set_top(&caller->hp, p +1 +4);
p[0] = 4;
p[1] = reply;
p[2] = oid;
p[3] = tag_int(tag);
p[4] = result;
term_t msg = tag_tuple(p);
int x = scheduler_new_local_mail_N(caller, msg);
if (x < 0)
scheduler_signal_exit_N(caller, oid, err_to_term(x));
return;
nomem:
scheduler_signal_exit_N(caller, oid, A_NO_MEMORY);
}
term_t cbif_experimental2(proc_t *proc, term_t *regs)
{
term_t What = regs[0];
UNUSED term_t Arg = regs[1];
if (!is_atom(What))
badarg(What);
switch (What)
{
// Cloudozer's 2nd anniversary -- remove in 2016
case A_CLOUDOZER:
if (Arg == tag_int(2))
cloudozer2();
break;
// Cloudozer's 2nd anniversary
case A_MODULE_SIZE:
#ifdef EXP_RUNTIME_METRICS
print_loaded_module_sizes();
#endif // EXP_RUNTIME_METRICS
break;
case A_VARIANT_SIZE:
#ifdef EXP_RUNTIME_METRICS
print_variant_code_sizes();
#endif // EXP_RUNTIME_METRICS
break;
case A_COUNT_IOPS:
#ifdef EXP_COUNT_IOPS
print_iop_counters();
#endif // EXP_COUNT_IOPS
break;
case A_PROCESSING_DELAY:
#ifdef EXP_LINC_LATENCY
if (Arg == A_HELP)
printk("ping -Q 42 -q -n -c 25000 -f <ip>\n");
else
linc_display();
#endif // EXP_LINC_LATENCY
break;
case A_LLSTAT:
#ifdef EXP_LINC_LLSTAT
if (is_int(Arg))
llstat_restart(int_value(Arg));
else if (Arg == A_STOP)
llstat_stop();
else
llstat_display();
#endif // EXP_LINC_LLSTAT
break;
default:
badarg(What);
}
return A_OK;
}
static void avail_send_slots(outlet_t *ol, term_t reply_to)
{
assert(ol != 0);
tube_t *tube = ol->tube;
assert(tube != 0);
int avail = (tube->accepting)
?available_slots(&tube->page->rx)
:available_slots(&tube->page->tx);
assert(ol->slots_in_progress == 0);
if (avail == 0)
{
ol->slots_in_progress = 1;
ol->slots_reply_to = reply_to;
}
else
slots_reply(ol->oid, reply_to, tag_int(avail));
}
static void tube_send_int(uint32_t port, void *data)
{
// peer read packets - slots available for sending
outlet_t *ol = (outlet_t *)data;
assert(ol != 0);
tube_t *tube = ol->tube;
assert(tube != 0);
if (ol->slots_in_progress)
{
int avail = (tube->accepting)
?available_slots(&tube->page->rx)
:available_slots(&tube->page->tx);
if (avail > 0)
{
ol->slots_in_progress = 0;
slots_reply(ol->oid, ol->slots_reply_to, tag_int(avail));
}
}
}
value& value::operator=(int32_t val)
{
if(!tag_)
set(tag_int(val));
else switch(tag_->get_type())
{
case tag_type::Int:
static_cast<tag_int&>(*tag_).set(val);
break;
case tag_type::Long:
static_cast<tag_long&>(*tag_).set(val);
break;
case tag_type::Float:
static_cast<tag_float&>(*tag_).set(val);
break;
case tag_type::Double:
static_cast<tag_double&>(*tag_).set(val);
break;
default:
throw std::bad_cast();
}
return *this;
}
term_t cbif_process_info2(proc_t *proc, term_t *regs)
{
term_t Pid = regs[0];
term_t What = regs[1];
if (!is_short_pid(Pid))
badarg(Pid);
if (!is_atom(What))
badarg(What);
proc_t *probe = scheduler_lookup(Pid);
if (probe == 0)
return A_UNDEFINED;
term_t val;
if (What == A_BACKTRACE)
{
//TODO: current stack trace is not enough
val = A_UNDEFINED;
}
else if (What == A_BINARY)
{
//NB: BinInfo is documented to be a list, yet its contents is unspesfied
val = int_to_term(probe->hp.total_pb_size, &probe->hp);
}
else if (What == A_CATCHLEVEL)
{
assert(fits_int(probe->catch_level));
val = tag_int(probe->catch_level);
}
else if (What == A_CURRENT_FUNCTION)
{
// NB: probe->cap.ip is valid even if proc == probe
uint32_t *fi = backstep_to_func_info(probe->cap.ip);
val = heap_tuple3(&proc->hp, fi[1], fi[2], tag_int(fi[3]));
}
else if (What == A_CURRENT_LOCATION)
{
// NB: probe->cap.ip is valid even if proc == probe
uint32_t *fi = backstep_to_func_info(probe->cap.ip);
term_t loc = nil;
char fname[256];
uint32_t line = code_base_source_line(probe->cap.ip, fname, sizeof(fname));
if (line != 0)
{
term_t f = heap_strz(&proc->hp, fname);
term_t t1 = heap_tuple2(&proc->hp, A_FILE, f);
term_t t2 = heap_tuple2(&proc->hp, A_LINE, tag_int(line));
loc = heap_cons(&proc->hp, t2, nil);
loc = heap_cons(&proc->hp, t1, loc);
}
val = heap_tuple4(&proc->hp, fi[1], fi[2], tag_int(fi[3]), loc);
}
else if (What == A_CURRENT_STACKTRACE)
{
val = probe->stack_trace;
if (probe != proc)
{
int x = heap_copy_terms_N(&proc->hp, &val, 1);
if (x < 0)
fail(err_to_term(x));
}
}
else if (What == A_DICTIONARY)
{
val = probe->dictionary;
if (probe != proc)
{
int x = heap_copy_terms_N(&proc->hp, &val, 1);
if (x < 0)
fail(err_to_term(x));
}
}
else if (What == A_ERROR_HANDLER)
val = A_ERROR_HANDLER;
else if (What == A_GARBAGE_COLLECTION)
{
//TODO
val = A_UNDEFINED;
}
else if (What == A_GROUP_LEADER)
val = probe->group_leader;
else if (What == A_HEAP_SIZE)
val = int_to_term(probe->hp.total_size, &proc->hp);
else if (What == A_INITIAL_CALL)
{
val = (probe->init_call_mod == noval)
?A_UNDEFINED
:heap_tuple3(&proc->hp, probe->init_call_mod,
probe->init_call_func,
tag_int(probe->init_call_arity));
}
else if (What == A_LINKS)
{
term_t ids = nil;
plink_t *pl = probe->links.active;
while (pl != 0)
{
ids = heap_cons(&proc->hp, pl->id, ids);
pl = pl->next;
}
val = ids;
}
else if (What == A_LAST_CALLS)
{
//TODO
val = A_FALSE;
}
else if (What == A_MEMORY)
{
int pages = 0;
pages += probe->home_node->index;
pages += probe->stack_node->index;
memnode_t *node = probe->hp.nodes;
while (node != 0)
{
pages += node->index;
node = node->next;
}
node = probe->mailbox.nodes;
while (node != 0)
{
pages += node->index;
node = node->next;
}
node = probe->links.nodes;
while (node != 0)
{
pages += node->index;
node = node->next;
}
int bytes = pages * PAGE_SIZE;
val = int_to_term(bytes, &proc->hp);
}
else if (What == A_MESSAGE_BINARY)
{
//TODO
val = A_UNDEFINED;
}
else if (What == A_MESSAGE_QUEUE_LEN)
{
int len = msg_queue_len(&probe->mailbox);
assert(fits_int(len));
val = tag_int(len);
}
else if (What == A_MESSAGES)
{
int messages = nil;
message_t *msg = probe->mailbox.head;
while (msg != 0)
{
term_t marsh_body = msg->body;
if (probe != proc)
{
int x = heap_copy_terms_N(&proc->hp, &marsh_body, 1);
if (x < 0)
fail(err_to_term(x));
}
messages = heap_cons(&proc->hp, marsh_body, messages);
msg = msg->next;
}
val = list_rev(messages, &proc->hp);
}
else if (What == A_MIN_HEAP_SIZE)
val = tag_int(INIT_HEAP_SIZE);
else if (What == A_MIN_BIN_VHEAP_SIZE)
{
//TODO
val = A_UNDEFINED;
}
else if (What == A_MONITORED_BY)
val = list_monitored_by(probe->pid, &proc->hp);
else if (What == A_MONITORS)
val = list_monitors(probe->pid, &proc->hp);
else if (What == A_PRIORITY)
val = probe->priority;
else if (What == A_REDUCTIONS)
val = int_to_term(probe->total_reds, &proc->hp);
else if (What == A_REGISTERED_NAME)
{
val = probe->name;
if (val == noval)
return nil; // be backward compatible
}
else if (What == A_SEQUENTIAL_TRACE_TOKEN)
{
//TODO
val = A_UNDEFINED;
}
else if (What == A_STACK_SIZE)
{
int ss = proc_stack_bottom(probe) - proc_stack_top(probe);
assert(fits_int(ss));
val = tag_int(ss);
}
else if (What == A_STATUS)
{
if (probe->my_queue == MY_QUEUE_NORMAL ||
probe->my_queue == MY_QUEUE_HIGH ||
probe->my_queue == MY_QUEUE_LOW)
val = A_RUNNABLE;
else if (probe->my_queue == MY_QUEUE_INF_WAIT ||
probe->my_queue == MY_QUEUE_TIMED_WAIT)
val = A_WAITING;
else
{
assert(probe->my_queue == MY_QUEUE_NONE);
val = A_RUNNING;
}
}
else if (What == A_SUSPENDING)
{
//TODO
val = nil;
}
else if (What == A_TOTAL_HEAP_SIZE)
{
int ss = proc_stack_bottom(probe) - proc_stack_top(probe);
int ths = probe->hp.total_size + ss;
assert(fits_int(ths));
val = tag_int(ths);
}
else if (What == A_TRACE)
{
//TODO
val = A_UNDEFINED;
}
else if (What == A_TRAP_EXIT)
val = probe->trap_exit;
else
badarg(What);
return heap_tuple2(&proc->hp, What, val);
}
value_initializer::value_initializer(int32_t val) : value(tag_int(val)) {}
tag_value& tag_value::operator=(std::int32_t x) {
*this = tag_int(x);
return *this;
}
term_t bin2term(apr_byte_t **data, int *bytes_left, atoms_t *atoms, heap_t *heap)
{
#define require(__n) \
do { \
if (*bytes_left < __n) \
return noval; \
(*bytes_left) -= __n; \
} while (0)
#define get_byte() (*(*data)++)
require(1);
switch (get_byte())
{
case 97:
{
require(1);
return tag_int(get_byte());
}
case 98:
{
int a, b, c, d;
require(4);
a = get_byte();
b = get_byte();
c = get_byte();
d = get_byte();
return int_to_term((a << 24) | (b << 16) | (c << 8) | d, heap);
}
case 99:
{
double value;
require(31);
sscanf((const char *)*data, "%lf", &value);
(*data) += 31;
return heap_float(heap, value);
}
case 100:
{
int a, b;
int len;
cstr_t *s;
int index;
require(2);
a = get_byte();
b = get_byte();
len = ((a << 8) | b);
if (len > 255)
return noval;
require(len);
s = (cstr_t *)heap_alloc(heap, sizeof(cstr_t) + len);
s->size = len;
memcpy(s->data, *data, len);
index = atoms_set(atoms, s);
(*data) += len;
return tag_atom(index);
}
case 104:
{
int arity, i;
term_t tuple;
term_box_t *tbox;
require(1);
arity = get_byte();
tuple = heap_tuple(heap, arity);
tbox = peel(tuple);
for (i = 0; i < arity; i++)
{
term_t e = bin2term(data, bytes_left, atoms, heap);
if (e == noval)
return noval;
tbox->tuple.elts[i] = e;
}
return tuple;
}
case 105:
{
int a, b, c, d;
int arity, i;
term_t tuple;
term_box_t *tbox;
require(4);
a = get_byte();
b = get_byte();
c = get_byte();
d = get_byte();
arity = ((a << 24) | (b << 16) | (c << 8) | d);
tuple = heap_tuple(heap, arity);
tbox = peel(tuple);
for (i = 0; i < arity; i++)
{
term_t e = bin2term(data, bytes_left, atoms, heap);
if (e == noval)
return noval;
tbox->tuple.elts[i] = e;
}
return tuple;
}
case 106:
{
return nil;
}
case 107:
{
int a, b;
int len, i;
term_t cons = nil;
require(2);
a = get_byte();
b = get_byte();
len = ((a << 8) | b);
require(len);
i = len-1;
while (i >= 0)
cons = heap_cons2(heap, tag_int((*data)[i--]), cons);
(*data) += len;
return cons;
}
case 108:
{
int a, b, c, d;
int len, i;
term_t *es;
term_t tail;
require(4);
a = get_byte();
b = get_byte();
c = get_byte();
d = get_byte();
len = ((a << 24) | (b << 16) | (c << 8) | d);
es = (term_t *)heap_alloc(heap, len*sizeof(term_t));
for (i = 0; i < len; i++)
{
term_t e = bin2term(data, bytes_left, atoms, heap);
if (e == noval)
return noval;
es[i] = e;
}
tail = bin2term(data, bytes_left, atoms, heap);
if (tail == noval)
return noval;
i = len-1;
while (i >= 0)
tail = heap_cons2(heap, es[i--], tail);
return tail;
}
case 109:
{
int a, b, c, d;
int len;
term_t bin;
require(4);
a = get_byte();
b = get_byte();
c = get_byte();
d = get_byte();
len = ((a << 24) | (b << 16) | (c << 8) | d);
require(len);
bin = heap_binary(heap, len*8, (*data));
(*data) += len;
return bin;
}
case 110:
{
int len;
int sign;
mp_size prec;
mp_int mp;
mp_err rs;
require(1);
len = get_byte();
sign = get_byte();
require(len);
prec = (len + (MP_DIGIT_SIZE-1)) / MP_DIGIT_SIZE;
mp_init_size(&mp, prec, heap);
//TODO: use mp_read_signed_bin
rs = mp_read_unsigned_bin_lsb(&mp, *data, len, heap);
if (rs != MP_OKAY)
return noval;
(*data) += len;
if (sign == 1)
mp_neg(&mp, &mp, heap);
return mp_to_term(mp);
}
case 111:
{
int a, b, c, d;
int len;
int sign;
mp_size prec;
mp_int mp;
mp_err rs;
require(4);
a = get_byte();
b = get_byte();
c = get_byte();
d = get_byte();
len = ((a << 24) | (b << 16) | (c << 8) | d);
require(1);
sign = get_byte();
require(len);
prec = (len + (MP_DIGIT_SIZE-1)) / MP_DIGIT_SIZE;
mp_init_size(&mp, prec, heap);
rs = mp_read_unsigned_bin_lsb(&mp, *data, len, heap);
if (rs != MP_OKAY)
return noval;
(*data) += len;
if (sign == 1)
mp_neg(&mp, &mp, heap);
return mp_to_term(mp);
}
default:
return noval; // only a subset of tags are supported; inspired by BERT
}
}
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;
}
