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); }