Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2)
{
Sint arity;
/*
* Verify argument 2 (arity); arity must be >= 0.
*/
if (is_small(arg2)) {
arity = signed_val(arg2);
if (arity < 0) {
error:
BIF_ERROR(p, BADARG);
}
} else if (is_big(arg2) && !bignum_header_is_neg(*big_val(arg2))) {
/* A positive bignum is OK, but can't possibly match. */
arity = -1;
} else {
/* Everything else (including negative bignum) is an error. */
goto error;
}
if (is_fun(arg1)) {
ErlFunThing* funp = (ErlFunThing *) fun_val(arg1);
if (funp->arity == (Uint) arity) {
BIF_RET(am_true);
}
} else if (is_export(arg1)) {
Export* exp = (Export *) (export_val(arg1)[1]);
if (exp->info.mfa.arity == (Uint) arity) {
BIF_RET(am_true);
}
}
BIF_RET(am_false);
}
Uint
size_object(Eterm obj)
{
Uint sum = 0;
Eterm* ptr;
int arity;
DECLARE_ESTACK(s);
for (;;) {
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST:
sum += 2;
ptr = list_val(obj);
obj = *ptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
}
obj = *ptr;
break;
case TAG_PRIMARY_BOXED:
{
Eterm hdr = *boxed_val(obj);
ASSERT(is_header(hdr));
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
ptr = tuple_val(obj);
arity = header_arity(hdr);
sum += arity + 1;
if (arity == 0) { /* Empty tuple -- unusual. */
goto pop_next;
}
while (arity-- > 1) {
obj = *++ptr;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
}
}
obj = *++ptr;
break;
case FUN_SUBTAG:
{
Eterm* bptr = fun_val(obj);
ErlFunThing* funp = (ErlFunThing *) bptr;
unsigned eterms = 1 /* creator */ + funp->num_free;
unsigned sz = thing_arityval(hdr);
sum += 1 /* header */ + sz + eterms;
bptr += 1 /* header */ + sz;
while (eterms-- > 1) {
obj = *bptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
}
}
obj = *bptr;
break;
}
case SUB_BINARY_SUBTAG:
{
Eterm real_bin;
Uint offset; /* Not used. */
Uint bitsize;
Uint bitoffs;
Uint extra_bytes;
Eterm hdr;
ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize);
if ((bitsize + bitoffs) > 8) {
sum += ERL_SUB_BIN_SIZE;
extra_bytes = 2;
} else if ((bitsize + bitoffs) > 0) {
sum += ERL_SUB_BIN_SIZE;
extra_bytes = 1;
} else {
extra_bytes = 0;
}
hdr = *binary_val(real_bin);
if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) {
sum += PROC_BIN_SIZE;
} else {
sum += heap_bin_size(binary_size(obj)+extra_bytes);
}
goto pop_next;
}
break;
case BIN_MATCHSTATE_SUBTAG:
erl_exit(ERTS_ABORT_EXIT,
"size_object: matchstate term not allowed");
default:
sum += thing_arityval(hdr) + 1;
goto pop_next;
}
}
break;
case TAG_PRIMARY_IMMED1:
pop_next:
if (ESTACK_ISEMPTY(s)) {
DESTROY_ESTACK(s);
return sum;
}
obj = ESTACK_POP(s);
break;
default:
erl_exit(ERTS_ABORT_EXIT, "size_object: bad tag for %#x\n", obj);
}
}
}
Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
{
unsigned result;
#if NR_ARG_REGS > 5
/* When NR_ARG_REGS > 5, we need to protect the process' input
reduction count (which BEAM stores in def_arg_reg[5]) from
being clobbered by the arch glue code. */
Eterm reds_in = p->def_arg_reg[5];
#endif
#if NR_ARG_REGS > 4
Eterm o_reds = p->def_arg_reg[4];
#endif
p->i = NULL;
DPRINTF("cmd == %#x (%s)", cmd, code_str(cmd));
HIPE_CHECK_PCB(p);
p->arity = 0;
switch (cmd & 0xFF) {
case HIPE_MODE_SWITCH_CMD_CALL: {
/* BEAM calls a native code function */
unsigned arity = cmd >> 8;
/* p->hipe.ncallee set in beam_emu */
if (p->cp == hipe_beam_pc_return) {
/* Native called BEAM, which now tailcalls native. */
hipe_pop_beam_trap_frame(p);
result = hipe_tailcall_to_native(p, arity, reg);
break;
}
DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity);
result = hipe_call_to_native(p, arity, reg);
break;
}
case HIPE_MODE_SWITCH_CMD_CALL_CLOSURE: {
/* BEAM calls a native code closure */
unsigned arity = cmd >> 8; /* #formals + #fvs (closure not counted) */
Eterm fun;
ErlFunThing *funp;
/* drop the fvs, move the closure, correct arity */
fun = reg[arity];
HIPE_ASSERT(is_fun(fun));
funp = (ErlFunThing*)fun_val(fun);
HIPE_ASSERT(funp->num_free <= arity);
arity -= funp->num_free; /* arity == #formals */
reg[arity] = fun;
++arity; /* correct for having added the closure */
/* HIPE_ASSERT(p->hipe.ncallee == (void(*)(void))funp->native_address); */
/* just like a normal call from now on */
/* p->hipe.ncallee set in beam_emu */
if (p->cp == hipe_beam_pc_return) {
/* Native called BEAM, which now tailcalls native. */
hipe_pop_beam_trap_frame(p);
result = hipe_tailcall_to_native(p, arity, reg);
break;
}
DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity);
result = hipe_call_to_native(p, arity, reg);
break;
}
case HIPE_MODE_SWITCH_CMD_THROW: {
/* BEAM just executed hipe_beam_pc_throw[] */
/* Native called BEAM, which now throws an exception back to native. */
DPRINTF("beam throws freason %#lx fvalue %#lx", p->freason, p->fvalue);
hipe_pop_beam_trap_frame(p);
do_throw_to_native:
p->def_arg_reg[0] = exception_tag[GET_EXC_CLASS(p->freason)];
hipe_find_handler(p);
result = hipe_throw_to_native(p);
break;
}
case HIPE_MODE_SWITCH_CMD_RETURN: {
/* BEAM just executed hipe_beam_pc_return[] */
/* Native called BEAM, which now returns back to native. */
/* pop trap frame off estack */
hipe_pop_beam_trap_frame(p);
p->def_arg_reg[0] = reg[0];
result = hipe_return_to_native(p);
break;
}
do_resume:
case HIPE_MODE_SWITCH_CMD_RESUME: {
/* BEAM just executed hipe_beam_pc_resume[] */
/* BEAM called native, which suspended. */
if (p->flags & F_TIMO) {
/* XXX: The process will immediately execute 'clear_timeout',
repeating these two statements. Remove them? */
p->flags &= ~F_TIMO;
JOIN_MESSAGE(p);
p->def_arg_reg[0] = 0; /* make_small(0)? */
} else
p->def_arg_reg[0] = 1; /* make_small(1)? */
result = hipe_return_to_native(p);
break;
}
default:
erl_exit(1, "hipe_mode_switch: cmd %#x\r\n", cmd);
}
do_return_from_native:
DPRINTF("result == %#x (%s)", result, code_str(result));
HIPE_CHECK_PCB(p);
switch (result) {
case HIPE_MODE_SWITCH_RES_RETURN: {
hipe_return_from_native(p);
reg[0] = p->def_arg_reg[0];
DPRINTF("returning with r(0) == %#lx", reg[0]);
break;
}
case HIPE_MODE_SWITCH_RES_THROW: {
DPRINTF("native throws freason %#lx fvalue %#lx", p->freason, p->fvalue);
hipe_throw_from_native(p);
break;
}
case HIPE_MODE_SWITCH_RES_TRAP: {
/*
* Native code called a BIF, which "failed" with a TRAP to BEAM.
* Prior to returning, the BIF stored (see BIF_TRAP<N>):
* the callee's address in p->def_arg_reg[3]
* the callee's parameters in p->def_arg_reg[0..2]
* the callee's arity in p->arity (for BEAM gc purposes)
*
* We need to remove the BIF's parameters from the native
* stack: to this end hipe_${ARCH}_glue.S stores the BIF's
* arity in p->hipe.narity.
*/
unsigned int i, is_recursive, callee_arity;
/* Save p->arity, then update it with the original BIF's arity.
Get rid of any stacked parameters in that call. */
/* XXX: hipe_call_from_native_is_recursive() copies data to
reg[], which is useless in the TRAP case. Maybe write a
specialised hipe_trap_from_native_is_recursive() later. */
callee_arity = p->arity;
p->arity = p->hipe.narity; /* caller's arity */
is_recursive = hipe_call_from_native_is_recursive(p, reg);
p->i = (Eterm *)(p->def_arg_reg[3]);
p->arity = callee_arity;
for (i = 0; i < p->arity; ++i)
reg[i] = p->def_arg_reg[i];
if (is_recursive)
hipe_push_beam_trap_frame(p, reg, p->arity);
result = HIPE_MODE_SWITCH_RES_CALL;
break;
}
case HIPE_MODE_SWITCH_RES_CALL: {
/* Native code calls or tailcalls BEAM.
*
* p->i is the callee's BEAM code
* p->arity is the callee's arity
* p->def_arg_reg[] contains the register parameters
* p->hipe.nsp[] contains the stacked parameters
*/
if (hipe_call_from_native_is_recursive(p, reg)) {
/* BEAM called native, which now calls BEAM */
hipe_push_beam_trap_frame(p, reg, p->arity);
}
break;
}
case HIPE_MODE_SWITCH_RES_CALL_CLOSURE: {
/* Native code calls or tailcalls a closure in BEAM
*
* In native code a call to a closure of arity n looks like
* F(A1, ..., AN, Closure),
* The BEAM code for a closure expects to get:
* F(A1, ..., AN, FV1, ..., FVM, Closure)
* (Where Ai is argument i and FVj is free variable j)
*
* p->hipe.closure contains the closure
* p->def_arg_reg[] contains the register parameters
* p->hipe.nsp[] contains the stacked parameters
*/
ErlFunThing *closure;
unsigned num_free, arity, i, is_recursive;
HIPE_ASSERT(is_fun(p->hipe.closure));
closure = (ErlFunThing*)fun_val(p->hipe.closure);
num_free = closure->num_free;
arity = closure->fe->arity;
/* Store the arity in p->arity for the stack popping. */
/* Note: we already have the closure so only need to move arity
values to reg[]. However, there are arity+1 parameters in the
native code state that need to be removed. */
p->arity = arity+1; /* +1 for the closure */
/* Get parameters, don't do GC just yet. */
is_recursive = hipe_call_from_native_is_recursive(p, reg);
if ((Sint)closure->fe->address[-1] < 0) {
/* Unloaded. Let beam_emu.c:call_fun() deal with it. */
result = HIPE_MODE_SWITCH_RES_CALL_CLOSURE;
} else {
/* The BEAM code is present. Prepare to call it. */
/* Append the free vars after the actual parameters. */
for (i = 0; i < num_free; ++i)
reg[arity+i] = closure->env[i];
/* Update arity to reflect the new parameters. */
arity += i;
/* Make a call to the closure's BEAM code. */
p->i = closure->fe->address;
/* Change result code to the faster plain CALL type. */
result = HIPE_MODE_SWITCH_RES_CALL;
}
/* Append the closure as the last parameter. Don't increment arity. */
reg[arity] = p->hipe.closure;
if (is_recursive) {
/* BEAM called native, which now calls BEAM.
Need to put a trap-frame on the beam stack.
This may cause GC, which is safe now that
the arguments, free vars, and most
importantly the closure, all are in reg[]. */
hipe_push_beam_trap_frame(p, reg, arity+1);
}
break;
}
case HIPE_MODE_SWITCH_RES_SUSPEND: {
p->i = hipe_beam_pc_resume;
p->arity = 0;
erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
if (p->status != P_SUSPENDED)
erts_add_to_runq(p);
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
goto do_schedule;
}
case HIPE_MODE_SWITCH_RES_WAIT:
case HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT: {
/* same semantics, different debug trace messages */
#ifdef ERTS_SMP
/* XXX: BEAM has different entries for the locked and unlocked
cases. HiPE doesn't, so we must check dynamically. */
if (p->hipe_smp.have_receive_locks)
p->hipe_smp.have_receive_locks = 0;
else
erts_smp_proc_lock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
#endif
p->i = hipe_beam_pc_resume;
p->arity = 0;
p->status = P_WAITING;
erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
do_schedule:
{
#if !(NR_ARG_REGS > 5)
int reds_in = p->def_arg_reg[5];
#endif
p = schedule(p, reds_in - p->fcalls);
#ifdef ERTS_SMP
p->hipe_smp.have_receive_locks = 0;
reg = p->scheduler_data->save_reg;
#endif
}
{
Eterm *argp;
int i;
argp = p->arg_reg;
for (i = p->arity; --i >= 0;)
reg[i] = argp[i];
}
{
#if !(NR_ARG_REGS > 5)
Eterm reds_in;
#endif
#if !(NR_ARG_REGS > 4)
Eterm o_reds;
#endif
reds_in = p->fcalls;
o_reds = 0;
if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) {
o_reds = reds_in;
reds_in = 0;
p->fcalls = 0;
}
p->def_arg_reg[4] = o_reds;
p->def_arg_reg[5] = reds_in;
if (p->i == hipe_beam_pc_resume) {
p->i = NULL;
p->arity = 0;
goto do_resume;
}
}
HIPE_CHECK_PCB(p);
result = HIPE_MODE_SWITCH_RES_CALL;
p->def_arg_reg[3] = result;
return p;
}
case HIPE_MODE_SWITCH_RES_APPLY: {
Eterm mfa[3], args;
unsigned int arity;
void *address;
hipe_pop_params(p, 3, &mfa[0]);
/* Unroll the arglist onto reg[]. */
args = mfa[2];
arity = 0;
while (is_list(args)) {
if (arity < 255) {
reg[arity++] = CAR(list_val(args));
args = CDR(list_val(args));
} else
goto do_apply_fail;
}
if (is_not_nil(args))
goto do_apply_fail;
/* find a native code entry point for {M,F,A} for a remote call */
address = hipe_get_remote_na(mfa[0], mfa[1], arity);
if (!address)
goto do_apply_fail;
p->hipe.ncallee = (void(*)(void)) address;
result = hipe_tailcall_to_native(p, arity, reg);
goto do_return_from_native;
do_apply_fail:
p->freason = BADARG;
goto do_throw_to_native;
}
default:
erl_exit(1, "hipe_mode_switch: result %#x\r\n", result);
}
HIPE_CHECK_PCB(p);
p->def_arg_reg[3] = result;
#if NR_ARG_REGS > 4
p->def_arg_reg[4] = o_reds;
#endif
#if NR_ARG_REGS > 5
p->def_arg_reg[5] = reds_in;
#endif
return p;
}
Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
{
unsigned result;
Eterm reds_in = p->def_arg_reg[5];
/*
* Process is in the normal case scheduled out when reduction
* count reach zero. When "save calls" is enabled reduction
* count is subtracted with CONTEXT_REDS, i.e. initial reduction
* count will be zero or less and process is scheduled out
* when -CONTEXT_REDS is reached.
*
* HiPE does not support the "save calls" feature, so we switch
* to using a positive reduction counter when executing in
* hipe mode, but need to restore the "save calls" when
* returning to beam. We also need to hide the save calls buffer
* from BIFs. We do that by moving the saved calls buf to
* suspended saved calls buf.
*
* Beam has initial reduction count in stored in p->def_arg_reg[5].
*
* Beam expects -neg_o_reds to be found in p->def_arg_reg[4]
* on return to beam.
*/
{
struct saved_calls *scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL);
if (scb) {
reds_in += CONTEXT_REDS;
p->fcalls += CONTEXT_REDS;
ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, scb);
}
}
p->flags |= F_HIPE_MODE; /* inform bifs where we are comming from... */
p->i = NULL;
/* Set current_function to undefined. stdlib hibernate tests rely on it. */
p->current = NULL;
DPRINTF("cmd == %#x (%s)", cmd, code_str(cmd));
HIPE_CHECK_PCB(p);
p->arity = 0;
switch (cmd & 0xFF) {
case HIPE_MODE_SWITCH_CMD_CALL: {
/* BEAM calls a native code function */
unsigned arity = cmd >> 8;
/* p->hipe.u.ncallee set in beam_emu */
if (p->cp == hipe_beam_pc_return) {
/* Native called BEAM, which now tailcalls native. */
hipe_pop_beam_trap_frame(p);
result = hipe_tailcall_to_native(p, arity, reg);
break;
}
DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity);
result = hipe_call_to_native(p, arity, reg);
break;
}
case HIPE_MODE_SWITCH_CMD_CALL_CLOSURE: {
/* BEAM calls a native code closure */
unsigned arity = cmd >> 8; /* #formals + #fvs (closure not counted) */
Eterm fun;
ErlFunThing *funp;
/* drop the fvs, move the closure, correct arity */
fun = reg[arity];
HIPE_ASSERT(is_fun(fun));
funp = (ErlFunThing*)fun_val(fun);
HIPE_ASSERT(funp->num_free <= arity);
arity -= funp->num_free; /* arity == #formals */
reg[arity] = fun;
++arity; /* correct for having added the closure */
/* HIPE_ASSERT(p->hipe.u.ncallee == (void(*)(void))funp->native_address); */
/* just like a normal call from now on */
/* p->hipe.u.ncallee set in beam_emu */
if (p->cp == hipe_beam_pc_return) {
/* Native called BEAM, which now tailcalls native. */
hipe_pop_beam_trap_frame(p);
result = hipe_tailcall_to_native(p, arity, reg);
break;
}
DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity);
result = hipe_call_to_native(p, arity, reg);
break;
}
case HIPE_MODE_SWITCH_CMD_THROW: {
/* BEAM just executed hipe_beam_pc_throw[] */
/* Native called BEAM, which now throws an exception back to native. */
DPRINTF("beam throws freason %#lx fvalue %#lx", p->freason, p->fvalue);
hipe_pop_beam_trap_frame(p);
do_throw_to_native:
p->def_arg_reg[0] = exception_tag[GET_EXC_CLASS(p->freason)];
hipe_find_handler(p);
result = hipe_throw_to_native(p);
break;
}
case HIPE_MODE_SWITCH_CMD_RETURN: {
/* BEAM just executed hipe_beam_pc_return[] */
/* Native called BEAM, which now returns back to native. */
/* pop trap frame off estack */
hipe_pop_beam_trap_frame(p);
p->def_arg_reg[0] = reg[0];
result = hipe_return_to_native(p);
break;
}
do_resume:
case HIPE_MODE_SWITCH_CMD_RESUME: {
/* BEAM just executed hipe_beam_pc_resume[] */
/* BEAM called native, which suspended. */
if (p->flags & F_TIMO) {
/* XXX: The process will immediately execute 'clear_timeout',
repeating these two statements. Remove them? */
p->flags &= ~F_TIMO;
JOIN_MESSAGE(p);
p->def_arg_reg[0] = 0; /* make_small(0)? */
} else
p->def_arg_reg[0] = 1; /* make_small(1)? */
result = hipe_return_to_native(p);
break;
}
default:
erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: cmd %#x\r\n", cmd);
}
do_return_from_native:
DPRINTF("result == %#x (%s)", result, code_str(result));
HIPE_CHECK_PCB(p);
switch (result) {
case HIPE_MODE_SWITCH_RES_RETURN: {
hipe_return_from_native(p);
reg[0] = p->def_arg_reg[0];
DPRINTF("returning with r(0) == %#lx", reg[0]);
break;
}
case HIPE_MODE_SWITCH_RES_THROW: {
DPRINTF("native throws freason %#lx fvalue %#lx", p->freason, p->fvalue);
hipe_throw_from_native(p);
break;
}
case HIPE_MODE_SWITCH_RES_TRAP: {
/*
* Native code called a BIF, which "failed" with a TRAP to BEAM.
* Prior to returning, the BIF stored (see BIF_TRAP<N>):
* the callee's address in p->i
* the callee's parameters in reg[0..2]
* the callee's arity in p->arity (for BEAM gc purposes)
*
* We need to remove the BIF's parameters from the native
* stack: to this end hipe_${ARCH}_glue.S stores the BIF's
* arity in p->hipe.narity.
*
* If the BIF emptied the stack (typically hibernate), p->hipe.nstack
* is NULL and there is no need to get rid of stacked parameters.
*/
unsigned int i, is_recursive = 0;
if (p->hipe.nstack != NULL) {
ASSERT(p->hipe.nsp != NULL);
is_recursive = hipe_trap_from_native_is_recursive(p);
}
else {
/* Some architectures (risc) need this re-reset of nsp as the
* BIF wrapper do not detect stack change and causes an obsolete
* stack pointer to be saved in p->hipe.nsp before return to us.
*/
p->hipe.nsp = NULL;
}
/* Schedule next process if current process was hibernated or is waiting
for messages */
if (p->flags & F_HIBERNATE_SCHED) {
p->flags &= ~F_HIBERNATE_SCHED;
goto do_schedule;
}
if (!(erts_atomic32_read_acqb(&p->state) & ERTS_PSFLG_ACTIVE)) {
for (i = 0; i < p->arity; ++i)
p->arg_reg[i] = reg[i];
goto do_schedule;
}
if (is_recursive)
hipe_push_beam_trap_frame(p, reg, p->arity);
result = HIPE_MODE_SWITCH_RES_CALL_BEAM;
break;
}
case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: {
/* Native code calls or tailcalls BEAM.
*
* p->hipe.u.callee_exp is the callee's export entry
* p->arity is the callee's arity
* p->def_arg_reg[] contains the register parameters
* p->hipe.nsp[] contains the stacked parameters
*/
if (hipe_call_from_native_is_recursive(p, reg)) {
/* BEAM called native, which now calls BEAM */
hipe_push_beam_trap_frame(p, reg, p->arity);
}
break;
}
case HIPE_MODE_SWITCH_RES_CALL_CLOSURE: {
/* Native code calls or tailcalls a closure in BEAM
*
* In native code a call to a closure of arity n looks like
* F(A1, ..., AN, Closure),
* The BEAM code for a closure expects to get:
* F(A1, ..., AN, FV1, ..., FVM, Closure)
* (Where Ai is argument i and FVj is free variable j)
*
* p->hipe.u.closure contains the closure
* p->def_arg_reg[] contains the register parameters
* p->hipe.nsp[] contains the stacked parameters
*/
ErlFunThing *closure;
unsigned num_free, arity, i, is_recursive;
HIPE_ASSERT(is_fun(p->hipe.u.closure));
closure = (ErlFunThing*)fun_val(p->hipe.u.closure);
num_free = closure->num_free;
arity = closure->fe->arity;
/* Store the arity in p->arity for the stack popping. */
/* Note: we already have the closure so only need to move arity
values to reg[]. However, there are arity+1 parameters in the
native code state that need to be removed. */
p->arity = arity+1; /* +1 for the closure */
/* Get parameters, don't do GC just yet. */
is_recursive = hipe_call_from_native_is_recursive(p, reg);
if ((Sint)closure->fe->address[-1] < 0) {
/* Unloaded. Let beam_emu.c:call_fun() deal with it. */
result = HIPE_MODE_SWITCH_RES_CALL_CLOSURE;
} else {
/* The BEAM code is present. Prepare to call it. */
/* Append the free vars after the actual parameters. */
for (i = 0; i < num_free; ++i)
reg[arity+i] = closure->env[i];
/* Update arity to reflect the new parameters. */
arity += i;
/* Make a call to the closure's BEAM code. */
p->i = closure->fe->address;
/* Change result code to the faster plain CALL type. */
result = HIPE_MODE_SWITCH_RES_CALL_BEAM;
}
/* Append the closure as the last parameter. Don't increment arity. */
reg[arity] = p->hipe.u.closure;
if (is_recursive) {
/* BEAM called native, which now calls BEAM.
Need to put a trap-frame on the beam stack.
This may cause GC, which is safe now that
the arguments, free vars, and most
importantly the closure, all are in reg[]. */
hipe_push_beam_trap_frame(p, reg, arity+1);
}
break;
}
case HIPE_MODE_SWITCH_RES_SUSPEND: {
p->i = hipe_beam_pc_resume;
p->arity = 0;
goto do_schedule;
}
case HIPE_MODE_SWITCH_RES_WAIT:
case HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT: {
/* same semantics, different debug trace messages */
/* XXX: BEAM has different entries for the locked and unlocked
cases. HiPE doesn't, so we must check dynamically. */
if (p->flags & F_HIPE_RECV_LOCKED)
p->flags &= ~F_HIPE_RECV_LOCKED;
else
erts_proc_lock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
p->i = hipe_beam_pc_resume;
p->arity = 0;
if (erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_EXITING)
ASSERT(erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_ACTIVE);
else if (!(p->flags & F_HIPE_RECV_YIELD))
erts_atomic32_read_band_relb(&p->state, ~ERTS_PSFLG_ACTIVE);
else {
/* Yielded from receive */
ERTS_VBUMP_ALL_REDS(p);
p->flags &= ~F_HIPE_RECV_YIELD;
}
erts_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE);
do_schedule:
{
struct saved_calls *scb;
scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, NULL);
if (scb)
ERTS_PROC_SET_SAVED_CALLS_BUF(p, scb);
/* The process may have died while it was executing,
if so we return out from native code to the interpreter */
if (erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_EXITING)
p->i = beam_exit;
#ifdef DEBUG
ASSERT(p->debug_reds_in == reds_in);
#endif
p->flags &= ~F_HIPE_MODE;
ERTS_UNREQ_PROC_MAIN_LOCK(p);
p = erts_schedule(NULL, p, reds_in - p->fcalls);
ERTS_REQ_PROC_MAIN_LOCK(p);
ASSERT(!(p->flags & F_HIPE_MODE));
p->flags &= ~F_HIPE_RECV_LOCKED;
reg = p->scheduler_data->x_reg_array;
}
{
Eterm *argp;
int i;
argp = p->arg_reg;
for (i = p->arity; --i >= 0;)
reg[i] = argp[i];
}
{
struct saved_calls *scb;
reds_in = p->fcalls;
p->def_arg_reg[5] = reds_in;
#ifdef DEBUG
p->debug_reds_in = reds_in;
#endif
if (p->i == hipe_beam_pc_resume) {
p->flags |= F_HIPE_MODE; /* inform bifs where we are comming from... */
scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL);
if (scb)
ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, scb);
p->i = NULL;
p->arity = 0;
goto do_resume;
}
scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p);
if (!scb)
p->def_arg_reg[4] = 0;
else {
p->def_arg_reg[4] = CONTEXT_REDS;
p->fcalls = -CONTEXT_REDS + reds_in;
}
}
HIPE_CHECK_PCB(p);
result = HIPE_MODE_SWITCH_RES_CALL_BEAM;
p->def_arg_reg[3] = result;
return p;
}
case HIPE_MODE_SWITCH_RES_APPLY: {
Eterm mfa[3], args;
unsigned int arity;
void *address;
hipe_pop_params(p, 3, &mfa[0]);
/* Unroll the arglist onto reg[]. */
args = mfa[2];
arity = 0;
while (is_list(args)) {
if (arity < 255) {
reg[arity++] = CAR(list_val(args));
args = CDR(list_val(args));
} else
goto do_apply_fail;
}
if (is_not_nil(args))
goto do_apply_fail;
/* find a native code entry point for {M,F,A} for a remote call */
address = hipe_get_remote_na(mfa[0], mfa[1], arity);
if (!address)
goto do_apply_fail;
p->hipe.u.ncallee = (void(*)(void)) address;
result = hipe_tailcall_to_native(p, arity, reg);
goto do_return_from_native;
do_apply_fail:
p->freason = BADARG;
goto do_throw_to_native;
}
default:
erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: result %#x\r\n", result);
}
{
struct saved_calls *scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, NULL);
if (!scb)
p->def_arg_reg[4] = 0;
else {
p->def_arg_reg[4] = CONTEXT_REDS;
p->fcalls -= CONTEXT_REDS;
ERTS_PROC_SET_SAVED_CALLS_BUF(p, scb);
}
}
HIPE_CHECK_PCB(p);
p->def_arg_reg[3] = result;
#if NR_ARG_REGS > 5
/*
* When NR_ARG_REGS > 5, we need to protect the process' input
* reduction count (which BEAM stores in def_arg_reg[5]) from
* being clobbered by the arch glue code.
*/
p->def_arg_reg[5] = reds_in;
#endif
p->flags &= ~F_HIPE_MODE;
return p;
}