rt_public void rout_obj_call_procedure_dynamic (
int routine_id, int is_basic_type, int written_type_id_inline_agent,
EIF_TYPED_VALUE* closed_args, int closed_count,
EIF_TYPED_VALUE* open_args, int open_count,
EIF_REFERENCE open_map)
{
EIF_GET_CONTEXT
int i = 2;
int args_count = open_count + closed_count;
int next_open = 0xFFFF;
int open_idx = 1;
int closed_idx = 1;
rt_uint_ptr nb_pushed = 0;
EIF_TYPED_VALUE* first_arg = NULL;
EIF_INTEGER* open_positions = NULL;
REQUIRE("valid_closed_args", (closed_count == 0) || closed_args);
REQUIRE("valid_open_args", (open_count == 0) || open_args);
if (open_count > 0) {
open_positions = (EIF_INTEGER*)(*(EIF_REFERENCE*)open_map);
if (open_positions [0] == 1) {
first_arg = &(open_args [1]);
open_idx = 2;
if (open_count > 1) {
next_open = open_positions [1];
}
} else {
next_open = open_positions [0];
}
}
if (first_arg == NULL) {
first_arg = &(closed_args [1]);
closed_idx = 2;
}
while (i <= args_count) {
if (i == next_open) {
fill_it (eif_opstack_push_empty(&op_stack), &(open_args [open_idx]));
nb_pushed++;
if (open_idx < open_count) {
next_open = open_positions [open_idx];
open_idx++;
} else {
next_open = 0xFFFF;
}
} else {
fill_it (eif_opstack_push_empty(&op_stack), &(closed_args [closed_idx]));
nb_pushed++;
closed_idx++;
}
i = i + 1;
}
fill_it (eif_opstack_push_empty(&op_stack), first_arg);
nb_pushed++;
/* We are calling a feature through an agent, in this case, we consider all calls
* as qualified so that the invariant is checked. */
nstcall = 1;
dynamic_eval (routine_id, written_type_id_inline_agent, is_basic_type, nb_pushed);
}
/*
doc: <routine name="execute_scoop_call" return_type="void" export="private">
doc: <summary> Execute the feature in 'a_call' and do not catch exceptions. </summary>
doc: <param name="a_call" type="struct eif_scoop_call_data*"> The feature to be executed. Must not be NULL. </param>
doc: <thread_safety> Safe, if arguments differ. </thread_safety>
doc: <synchronization> None. </synchronization>
doc: </routine>
*/
rt_private void execute_scoop_call (struct eif_scoop_call_data* a_call)
{
#ifndef WORKBENCH
a_call->pattern (a_call); /* Execute a feature in finalized mode. */
#else
/* Execute a feature in workbench mode. */
EIF_GET_CONTEXT
uint32 pid = 0; /* Pattern id of the frozen feature */
EIF_NATURAL_32 i;
EIF_NATURAL_32 n;
BODY_INDEX body_id;
EIF_TYPED_VALUE * v;
REQUIRE("call_not_null", a_call);
REQUIRE("target_not_null", a_call->target);
/* Push arguments to the evaluation stack */
for (n = a_call->count, i = 0; i < n; i++) {
v = eif_opstack_push_empty(&op_stack);
* v = a_call->argument [i];
}
if (a_call->routine_id >= 0) { /*NOTE: Tuple access has a negative routine ID.*/
/* Regular feature call. */
/* Push current to the evaluation stack */
v = eif_opstack_push_empty(&op_stack);
v->it_r = a_call->target;
v->type = SK_REF;
/* Make a feature call. */
CBodyId(body_id, a_call->routine_id,Dtype(a_call->target));
if (egc_frozen [body_id]) { /* We are below zero Celsius, i.e. ice */
pid = (uint32) FPatId(body_id);
(pattern[pid].toc)(egc_frozen[body_id]); /* Call pattern */
} else {
/* The proper way to start the interpretation of a melted feature is to call `xinterp'
* in order to initialize the calling context (which is not done by `interpret').
* `tagval' will therefore be set, but we have to resynchronize the registers anyway.
*/
xinterp(MTC melt[body_id], 0);
}
/* Save result of a call if any. */
v = a_call->result;
if (v) {
* v = * eif_opstack_pop_address(&op_stack);
}
}
else {
/* Tuple access. */
if (n == 0) {
/* Access to a tuple field. */
v = a_call->result;
eif_tuple_access (a_call->target, - a_call->routine_id, v);
}
else {
/* Assignment to a tuple field. */
v = eif_opstack_pop_address(&op_stack);
eif_tuple_assign (a_call->target, - a_call->routine_id, v);
}
}
#endif
}
rt_private void rt_apply_wcall (call_data *data)
{
EIF_GET_CONTEXT
uint32 pid = 0; /* Pattern id of the frozen feature */
EIF_NATURAL_32 i;
EIF_NATURAL_32 n;
BODY_INDEX body_id;
EIF_TYPED_VALUE * v;
REQUIRE("has data", data);
REQUIRE("has target", data->target);
/* Push arguments to the evaluation stack */
for (n = data->count, i = 0; i < n; i++) {
v = eif_opstack_push_empty(&op_stack);
* v = data->argument [i];
}
if (data->routine_id >= 0) {
/* Regular feature call. */
/* Push current to the evaluation stack */
v = eif_opstack_push_empty(&op_stack);
v->it_r = data->target;
v->type = SK_REF;
/* Make a feature call. */
CBodyId(body_id, data->routine_id,Dtype(data->target));
if (egc_frozen [body_id]) { /* We are below zero Celsius, i.e. ice */
pid = (uint32) FPatId(body_id);
(pattern[pid].toc)(egc_frozen[body_id]); /* Call pattern */
} else {
/* The proper way to start the interpretation of a melted feature is to call `xinterp'
* in order to initialize the calling context (which is not done by `interpret').
* `tagval' will therefore be set, but we have to resynchronize the registers anyway.
*/
xinterp(MTC melt[body_id], 0);
}
/* Save result of a call if any. */
v = data->result;
if (v) {
* v = * eif_opstack_pop_address(&op_stack);
}
}
else {
/* Tuple access. */
if (n == 0) {
/* Access to a tuple field. */
v = data->result;
eif_tuple_access (data->target, - data->routine_id, v);
}
else {
/* Assignment to a tuple field. */
v = eif_opstack_pop_address(&op_stack);
eif_tuple_assign (data->target, - data->routine_id, v);
}
}
}