static term_t compile_pattern(term_t pat, heap_t *hp)
{
term_t result = nil;
if (is_cons(pat))
{
term_t l = pat;
do {
term_t *cons = peel_cons(l);
if (!is_boxed_binary(cons[0]))
return A_BADARG;
term_t ctx = do_compile_pattern(cons[0], hp);
if (is_atom(ctx))
return ctx;
result = heap_cons(hp, ctx, result);
l = cons[1];
} while (is_cons(l));
if (l != nil)
return A_BADARG;
}
else if is_boxed_binary(pat)
{
term_t ctx = do_compile_pattern(pat, hp);
if (is_atom(ctx))
return ctx;
result = heap_cons(hp, ctx, result);
}
else
return A_BADARG;
static term_t parse_cmd_line(heap_t *hp, int8_t *cmd_line)
{
term_t args = nil;
int8_t *p = cmd_line;
while (*p != 0)
{
while (*p == ' ')
p++;
int8_t *token1, *token2;
if (*p == '\'' || *p == '"')
{
int8_t quote = *p++;
token1 = p;
while (*p != 0 && *p != quote)
p++;
token2 = p;
if (*p != 0)
p++;
}
else
{
token1 = p;
while (*p != 0 && *p != ' ')
p++;
token2 = p;
}
uint8_t *data;
term_t bin = heap_make_bin(hp, token2 -token1, &data);
memcpy(data, token1, token2 -token1);
args = heap_cons(hp, bin, args);
}
return list_rev(args, hp);
}
term_t embed_list_bucket(term_t bucket, heap_t *hp)
{
embed_buck_t *eb = find_bucket(bucket);
if (eb == 0)
return noval;
term_t names = nil;
for (int i = eb->start_index; i < eb->end_index; i++)
names = heap_cons(hp, embed_bins[i].name, names);
return names;
}
term_t scheduler_list_registered(heap_t *hp)
{
hash_index_t hi;
hash_start(named_processes, &hi);
proc_t *proc;
term_t regs = nil;
while ((proc = hash_next(&hi)) != 0)
regs = heap_cons(hp, proc->name, regs);
return regs;
}
term_t scheduler_list_processes(heap_t *hp)
{
hash_index_t hi;
hash_start(registry, &hi);
proc_t *proc;
term_t ps = nil;
while ((proc = hash_next(&hi)) != 0)
ps = heap_cons(hp, proc->pid, ps);
return ps;
}
term_t list_monitors(term_t pid1, heap_t *hp)
{
monitor_t *m = active_monitors;
term_t list = nil;
while (m != 0)
{
if (m->pid1 == pid1)
list = heap_cons(hp, heap_tuple2(hp, A_PROCESS, m->pid2), list);
m = m->next;
}
return list;
}
term_t list_monitored_by(term_t pid2, heap_t *hp)
{
monitor_t *m = active_monitors;
term_t list = nil;
while (m != 0)
{
if (m->pid2 == pid2)
list = heap_cons(hp, m->pid1, list);
m = m->next;
}
return list;
}
term_t embed_all_buckets(heap_t *hp)
{
term_t buckets = nil;
embed_buck_t *ptr = embed_bucks;
embed_buck_t *end = ptr +nr_embed_bucks;
while (ptr < end)
{
buckets = heap_cons(hp, ptr->bucket, buckets);
ptr++;
}
return buckets;
}
term_t list_rev(term_t t, heap_t *hp)
{
term_t r = nil;
while (is_cons(t))
{
term_t *cons = peel_cons(t);
r = heap_cons(hp, cons[0], r);
t = cons[1];
}
assert(is_nil(t));
return r;
}
// maps:values/1 [17]
term_t cbif_values1(proc_t *proc, term_t *regs)
{
term_t Map = regs[0];
if (!is_boxed_map(Map))
badarg();
term_t out = nil;
t_map_t *m = (t_map_t *)peel_boxed(Map);
int n = map_size(m);
term_t *v = m->values;
v += n;
while (n-- > 0)
{
v--;
out = heap_cons(&proc->hp, *v, out);
}
return out;
}
// maps:to_list/1 [19]
term_t cbif_to_list1(proc_t *proc, term_t *regs)
{
term_t Map = regs[0];
if (!is_boxed_map(Map))
badarg(Map);
term_t out = nil;
t_map_t *m = (t_map_t *)peel_boxed(Map);
term_t *p = peel_tuple(m->keys);
int n = *p++;
term_t *v = m->values;
p += n;
v += n;
while (n-- > 0)
{
p--; v--;
term_t kv = heap_tuple2(&proc->hp, *p, *v);
out = heap_cons(&proc->hp, kv, out);
}
return out;
}
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);
}
