BIF_RETTYPE os_set_signal_2(BIF_ALIST_2) {
if (is_atom(BIF_ARG_1) && ((BIF_ARG_2 == am_ignore) ||
(BIF_ARG_2 == am_default) ||
(BIF_ARG_2 == am_handle))) {
if (!erts_set_signal(BIF_ARG_1, BIF_ARG_2))
goto error;
BIF_RET(am_ok);
}
error:
BIF_ERROR(BIF_P, BADARG);
}
void
bridge_ornamented_rep::notify_insert (path p, tree u) {
// cout << "Insert " << p << ", " << u << " in " << st << "\n";
ASSERT (!is_nil (p), "nil path");
if (is_atom (p) || (p->item != 0)) bridge_rep::notify_insert (p, u);
else {
bool mp_flag= is_multi_paragraph (st);
body->notify_insert (p->next, u);
st= substitute (st, 0, body->st);
if (mp_flag != is_multi_paragraph (st)) initialize ();
}
status= CORRUPTED;
}
term_t cbif_spawn_monitor3(proc_t *proc, term_t *regs)
{
term_t m = regs[0];
term_t f = regs[1];
term_t args = regs[2];
if (!is_atom(m))
badarg(m);
if (!is_atom(f))
badarg(f);
if (!is_list(args))
badarg(args);
if (list_len(args) < 0)
badarg(args); // too odd
term_t ref = heap_make_ref(&proc->hp);
proc_t *new_proc = proc_make(proc->group_leader);
int x = proc_spawn_N(new_proc, m, f, args);
if (x == 0)
{
uint64_t ref_id = local_ref_id(ref);
x = monitor(ref_id, proc->pid, new_proc->pid);
}
if (x < 0)
{
//NB: no need to demonitor
proc_destroy(new_proc);
if (x == -TOO_DEEP)
fail(A_SYSTEM_LIMIT);
else
fail(A_NOT_SPAWNED);
}
return heap_tuple2(&proc->hp, new_proc->pid, ref);
}
static Module* put_module(Eterm mod, IndexTable* mod_tab)
{
Module e;
int oldsz, newsz;
Module* res;
ASSERT(is_atom(mod));
e.module = atom_val(mod);
oldsz = index_table_sz(mod_tab);
res = (Module*) index_put_entry(mod_tab, (void*) &e);
newsz = index_table_sz(mod_tab);
erts_atomic_add_nob(&tot_module_bytes, (newsz - oldsz));
return res;
}
void mark_object(object *pair) {
object *obj;
obj = pair;
while (is_pair(obj)) {
dump_object(obj);
gc_set(obj);
obj = obj_pn(obj);
}
if (is_atom(obj)) {
dump_object(obj);
gc_set(obj);
}
}
uint64_t alm_dump_heap_item(ATERM t, int stack) {
if (is_num(t))
printf("%18.1lf ", num_val(t));
else if (is_nil(t))
printf(" [] ");
else if (is_cons(t)) {
printf("<cons/0x%.3llX> ", (uint64_t)cons_ptr(t));
} else if (is_boxed(t)) {
ATERM *box = boxed_ptr(t);
if (is_atom(*box))
printf("<atom/0x%.3llX> ", (uint64_t)box);
} else if (is_header(t)) {
if (stack)
printf("<fram/0x%.3llX> ",(uint64_t)frame_val(t));
else if (is_atom(t)) {
printf("<atom/0x%.3llX> ",boxed_arity(t));
return boxed_arity(t)+1;
} else
printf("<frwd/0x%.3llX> ",(uint64_t)frame_val(t));
}
return 1;
}
gboolean
camel_url_addrspec_start (const gchar *in,
const gchar *pos,
const gchar *inend,
urlmatch_t *match)
{
register const gchar *inptr = pos;
g_assert (*inptr == '@');
if (inptr > in)
inptr--;
while (inptr > in) {
if (is_atom (*inptr))
inptr--;
else
break;
while (inptr > in && is_atom (*inptr))
inptr--;
if (inptr > in && *inptr == '.')
inptr--;
}
while (!is_atom (*inptr) || is_open_brace (*inptr))
inptr++;
if (inptr >= pos)
return FALSE;
match->um_so = (inptr - in);
return TRUE;
}
Cell eval(Cell exp, Cell env) {
if (is_self_evaluating(exp)) {
return exp;
} else if (is_atom(exp)) {
return lookup(exp, env);
} else if (is_tagged(exp, atom("define"))) {
return define(car(cdr(exp)), eval(car(cdr(cdr(exp))), env), env);
} else if (is_tagged(exp, atom("set!"))) {
return set(car(cdr(exp)), eval(car(cdr(cdr(exp))), env), env);
} else if (is_tagged(exp, atom("if"))) {
Cell cond = eval(car(cdr(exp)), env);
if (is_atom(cond) && is_eq(cond, atom("#f"))) {
exp = car(cdr(cdr(cdr(exp))));
} else {
exp = car(cdr(cdr(exp)));
}
return eval(exp, env);
} else if (is_tagged(exp, atom("vau"))) {
return procedure(exp, env);
} else if (is_pair(exp)) {
Cell proc = eval(car(exp), env);
if (is_primitive(proc)) {
return (proc->primitive)(eval_operands(cdr(exp), env));
} else if (is_procedure(proc)) {
Cell src = car(proc);
Cell e = car(cdr(cdr(src)));
Cell para = cons(e, cons(car(cdr(src)), null));
Cell args = cons(env, cons(cdr(exp), null));
Cell body = car(cdr(cdr(cdr(src))));
return eval(body, extend_env(para, args, cdr(proc)));
}
}
fprintf(stderr, "eval illegal state\n");
return atom("#<void>");
}
static void
copy_atom (const char *src, char *dest, size_t n)
{
register const char *inptr = src;
register char *outptr = dest;
char *outend = dest + n;
while (is_lwsp (*inptr))
inptr++;
while (is_atom (*inptr) && outptr < outend)
*outptr++ = *inptr++;
*outptr = '\0';
}
Module*
erts_get_module(Eterm mod)
{
Module e;
int index;
ASSERT(is_atom(mod));
e.module = atom_val(mod);
index = index_get(&module_table, (void*) &e);
if (index == -1) {
return NULL;
} else {
return (Module*) erts_index_lookup(&module_table, index);
}
}
term_t cbif_trace2(proc_t *proc, term_t *regs)
{
term_t Mask = regs[0];
term_t Mod = regs[1];
if (!is_int(Mask))
badarg(Mask);
if (!is_atom(Mod))
badarg(Mod);
#ifdef TRACE_HARNESS
trace_mask = int_value(Mask);
trace_module = Mod;
#endif
return A_OK;
}
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)
{
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 int term_order(term_t t)
{
if (is_cons(t))
return TERM_ORDER_CONS;
if (is_tuple(t))
return TERM_ORDER_TUPLE;
if (is_nil(t))
return TERM_ORDER_NIL;
if (is_int(t))
return TERM_ORDER_NUMBER;
if (is_atom(t))
return TERM_ORDER_ATOM;
if (is_short_pid(t))
return TERM_ORDER_PID;
if (is_short_oid(t))
return TERM_ORDER_OID;
assert(is_boxed(t));
switch (boxed_tag(peel_boxed(t)))
{
case SUBTAG_POS_BIGNUM:
case SUBTAG_NEG_BIGNUM:
case SUBTAG_FLOAT:
return TERM_ORDER_NUMBER;
case SUBTAG_FUN:
return TERM_ORDER_FUN;
case SUBTAG_EXPORT:
return TERM_ORDER_EXPORT;
case SUBTAG_PID:
return TERM_ORDER_PID;
case SUBTAG_OID:
return TERM_ORDER_OID;
case SUBTAG_REF:
return TERM_ORDER_REF;
case SUBTAG_PROC_BIN:
case SUBTAG_HEAP_BIN:
case SUBTAG_MATCH_CTX:
case SUBTAG_SUB_BIN:
return TERM_ORDER_BINARY;
default:
fatal_error("subtag");
}
}
term_t cbif_trace2(proc_t *proc, term_t *regs)
{
// Cloudozer's 2nd anniversary -- remove in 2016
term_t Mask = regs[0];
term_t Mod = regs[1];
if (!is_int(Mask))
badarg(Mask);
if (!is_atom(Mod))
badarg(Mod);
#ifdef TRACE_HARNESS
trace_mask = int_value(Mask);
trace_module = Mod;
#endif
return A_OK;
}
void
bridge_compound_rep::notify_insert (path p, tree u) {
// cout << "Insert " << p << ", " << u << " in " << st << "\n";
ASSERT (!is_nil (p), "nil path");
if (is_atom (p) || is_nil (body)) bridge_rep::notify_insert (p, u);
else {
// bool mp_flag= is_multi_paragraph (st);
if (is_func (fun, XMACRO, 2))
notify_macro (MACRO_INSERT, fun[0]->label, -1, p, u);
else if (is_applicable (fun) && (p->item < N(fun)))
notify_macro (MACRO_INSERT, fun[p->item-delta]->label, -1, p->next, u);
st= insert_at (st, p, u);
// if (mp_flag != is_multi_paragraph (st)) valid= false;
}
status= CORRUPTED;
}
term_t cbif_group_leader2(proc_t *proc, term_t *rs)
{
term_t Leader = rs[0];
term_t Pid = rs[1];
if (!is_short_pid(Leader) && !is_atom(Leader))
badarg(Leader);
if (!is_short_pid(Pid))
badarg(Pid);
proc_t *peer = scheduler_lookup(Pid);
if (peer == 0)
badarg(Pid);
peer->group_leader = Leader;
return A_TRUE;
}
void
bridge_compound_rep::notify_remove (path p, int nr) {
// cout << "Remove " << p << ", " << nr << " in " << st << "\n";
ASSERT (!is_nil (p), "nil path");
if (is_atom (p) || is_nil (body)) bridge_rep::notify_remove (p, nr);
else {
// bool mp_flag= is_multi_paragraph (st);
if (is_func (fun, XMACRO, 2))
notify_macro (MACRO_REMOVE, fun[0]->label, -1, p, tree (as_string (nr)));
else if (is_applicable (fun) && (p->item < N(fun)))
notify_macro (MACRO_REMOVE, fun[p->item-delta]->label, -1, p->next,
tree (as_string (nr)));
st= remove_at (st, p, nr);
// if (mp_flag != is_multi_paragraph (st)) valid= false;
}
status= CORRUPTED;
}
term_t cbif_process_flag3(proc_t *proc, term_t *regs)
{
term_t Pid = regs[0];
term_t Flag = regs[1];
term_t Value = regs[2];
if (!is_short_pid(Pid))
badarg(Pid);
proc_t *subj = scheduler_lookup(Pid);
if (subj == 0)
badarg(Pid);
if (!is_atom(Flag))
badarg(Flag);
term_t old_val = proc_set_flag(subj, Flag, Value);
if (old_val == noval)
badarg(Value);
return old_val;
}
Module*
erts_get_module(Eterm mod, ErtsCodeIndex code_ix)
{
Module e;
int index;
IndexTable* mod_tab;
ASSERT(is_atom(mod));
mod_tab = &module_tables[code_ix];
e.module = atom_val(mod);
index = index_get(mod_tab, (void*) &e);
if (index == -1) {
return NULL;
} else {
return (Module*) erts_index_lookup(mod_tab, index);
}
}
void
bridge_document_rep::notify_assign (path p, tree u) {
// cout << "Assign " << p << ", " << u << " in " << st << "\n";
ASSERT (!is_nil (p) || is_func (u, DOCUMENT) || is_func (u, PARA),
"nil path");
if (is_nil (p)) { st= u; initialize (); }
else {
if (is_atom (p)) {
replace_bridge (brs[p->item], u, descend (ip, p->item));
st= substitute (st, p->item, brs[p->item]->st);
}
else {
brs[p->item]->notify_assign (p->next, u);
st= substitute (st, p->item, brs[p->item]->st);
}
if (!is_nil (acc)) acc->notify_assign (p, u);
}
status= CORRUPTED;
}
Eterm
erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
{
Module* modp;
Eterm res;
ErtsCodeIndex code_ix;
(*redsp)++;
ASSERT(is_atom(module));
code_ix = erts_active_code_ix();
modp = erts_get_module(module, code_ix);
if (!modp)
return am_false;
erts_rlock_old_code(code_ix);
res = modp->old.code_hdr ? check_process_code(c_p, modp, allow_gc, redsp) : am_false;
erts_runlock_old_code(code_ix);
return res;
}
term_t bif_unset_brk0_2(term_t Mod, term_t Off, process_t *ctx)
{
apr_uint32_t mod_index;
if (!is_atom(Mod) || !is_int(Off))
return A_BADARG;
mod_index = code_base_mod_index(proc_code_base(ctx), Mod, 0);
if (mod_index == MOD_INDEX_NONE)
result(A_FALSE);
else
{
if (code_base_breakpoint_unset(proc_code_base(ctx),
mod_index, int_value2(Off)))
result(A_TRUE);
else
result(A_FALSE);
}
return AI_OK;
}
term_t bif_soft_purge1(term_t Mod, process_t *ctx)
{
apr_uint32_t mod_index;
if (!is_atom(Mod))
return A_BADARG;
mod_index = code_base_mod_index(proc_code_base(ctx), Mod, 1);
if (mod_index == MOD_INDEX_NONE)
result(A_FALSE);
else
{
if (proc_is_lingering(mod_index))
result(A_FALSE);
code_base_purge(proc_code_base(ctx), mod_index);
result(A_TRUE);
}
return AI_OK;
}
Eterm
erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp, int fcalls)
{
Module* modp;
Eterm res;
ErtsCodeIndex code_ix;
(*redsp)++;
ASSERT(is_atom(module));
code_ix = erts_active_code_ix();
modp = erts_get_module(module, code_ix);
if (!modp)
return am_false;
erts_rlock_old_code(code_ix);
res = (!modp->old.code_hdr ? am_false :
check_process_code(c_p, modp, flags, redsp, fcalls));
erts_runlock_old_code(code_ix);
return res;
}
static void
delete_export_references(Eterm module)
{
int i;
ASSERT(is_atom(module));
for (i = 0; i < export_list_size(); i++) {
Export *ep = export_list(i);
if (ep != NULL && (ep->code[0] == module)) {
if (ep->address == ep->code+3 &&
(ep->code[3] == (Eterm) em_apply_bif)) {
continue;
}
ep->address = ep->code+3;
ep->code[3] = (Uint) em_call_error_handler;
ep->code[4] = 0;
MatchSetUnref(ep->match_prog_set);
ep->match_prog_set = NULL;
}
}
}
void
bridge_surround_rep::notify_assign (path p, tree u) {
// cout << "Assign " << p << ", " << u << " in " << st << "\n";
ASSERT (!is_nil (p) || is_func (u, SURROUND), "nil path");
if (is_nil (p) || (p->item != 2)) {
st= substitute (st, p, u);
initialize ();
}
else {
// bool mp_flag= is_multi_paragraph (st);
if (is_atom (p)) {
body= make_bridge (ttt, u, descend (ip, 2));
st= substitute (st, 2, body->st);
}
else {
body->notify_assign (p->next, u);
st= substitute (st, p->item, body->st);
}
// if (mp_flag != is_multi_paragraph (st)) initialize ();
}
status= CORRUPTED;
}
Term ProcKeepLets(Term t, Term ind)
{
Term t1;
List l;
if(!is_compound(t) || CompoundArity(t)!=1)
{
ErrorInfo(331);
printf("bad syntax in 'keep_lets' statement.\n");
return 0;
}
t1=CommaToList(ConsumeCompoundArg(t,1));
FreeAtomic(t);
for(l=t1;l;l=ListTail(l))
{
Atom p;
p=ListFirst(l);
if(!is_atom(p))
{
ErrorInfo(332);
printf("unexpected '");
WriteTerm(p);
printf("' in 'keep_lets' statement.\n");
continue;
}
if(GetAtomProperty(p,PROP_TYPE))
{
ErrorInfo(333);
printf("'keep_lets': object '%s' is already defined.\n",
AtomValue(p));
continue;
}
SetAtomProperty(p,A_KEEP_LETS,MakeCompound1(A_KEEP_LETS,0));
}
return 0;
}
void
find_canvas_info (box b, path sp, SI& x, SI& y, SI& sx, SI& sy,
rectangle& outer, rectangle& inner)
{
if (is_nil (sp)) {
x= y= sx= sy= 0;
outer= inner= rectangle (0, 0, 0, 0);
}
else if (is_atom (sp)) {
x = 0;
y = 0;
sx = b->sx (0);
sy = b->sy (0);
outer= rectangle (b->x1, b->y1, b->x2, b->y2);
inner= rectangle (b[0]->x1, b[0]->y1, b[0]->x2, b[0]->y2);
}
else {
find_canvas_info (b[sp->item], sp->next, x, y, sx, sy, outer, inner);
x += b->sx (sp->item);
y += b->sy (sp->item);
}
}
void
bridge_ornamented_rep::notify_assign (path p, tree u) {
// cout << "Assign " << p << ", " << u << " in " << st << "\n";
if (is_nil (p)) {
st= u;
initialize ();
}
else {
bool mp_flag= is_multi_paragraph (st);
if (p->item == 0) {
if (is_atom (p)) body= make_bridge (ttt, u, descend (ip, 0));
else body->notify_assign (p->next, u);
st= substitute (st, p->item, body->st);
}
else {
st= substitute (st, p, u);
body->notify_change ();
}
if (mp_flag != is_multi_paragraph (st)) initialize ();
}
status= CORRUPTED;
}
BIF_RETTYPE erts_internal_port_info_2(BIF_ALIST_2)
{
Eterm retval;
Port* prt;
if (is_internal_port(BIF_ARG_1) || is_atom(BIF_ARG_1)) {
prt = sig_lookup_port(BIF_P, BIF_ARG_1);
if (!prt)
BIF_RET(am_undefined);
}
else if (is_external_port(BIF_ARG_1)) {
if (external_port_dist_entry(BIF_ARG_1) == erts_this_dist_entry)
BIF_RET(am_undefined);
else
BIF_RET(am_badarg);
}
else {
BIF_RET(am_badarg);
}
switch (erts_port_info(BIF_P, prt, BIF_ARG_2, &retval)) {
case ERTS_PORT_OP_CALLER_EXIT:
case ERTS_PORT_OP_BADARG:
BIF_RET(am_badarg);
case ERTS_PORT_OP_DROPPED:
BIF_RET(am_undefined);
case ERTS_PORT_OP_SCHEDULED:
ASSERT(is_internal_ordinary_ref(retval));
BIF_RET(retval);
case ERTS_PORT_OP_DONE:
ASSERT(is_not_internal_ref(retval));
BIF_RET(retval);
default:
ERTS_INTERNAL_ERROR("Unexpected erts_port_info() result");
BIF_RET(am_internal_error);
}
}
