/* 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); } } }
rt_public void rout_obj_call_function_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, void* res) { EIF_GET_CONTEXT EIF_TYPED_VALUE* it = NULL; rout_obj_call_procedure_dynamic (routine_id, is_basic_type, written_type_id_inline_agent, closed_args, closed_count, open_args, open_count, open_map); it = eif_opstack_pop_address(&op_stack); switch (it->type) { case SK_BOOL: *((EIF_BOOLEAN *) res) = it->it_bool; break; case SK_CHAR8: *((EIF_CHARACTER_8 *) res) = it->it_char; break; case SK_REAL64: *((EIF_REAL_64 *)res) = it->it_real64; break; case SK_UINT8: *((EIF_NATURAL_8* )res) = it->it_uint8; break; case SK_UINT16: *((EIF_NATURAL_16 *)res) = it->it_uint16; break; case SK_UINT32: *((EIF_NATURAL_32 *)res) = it->it_uint32; break; case SK_UINT64: *((EIF_NATURAL_64 *)res)= it->it_uint64; break; case SK_INT8: *((EIF_INTEGER_8 *)res) = it->it_int8; break; case SK_INT16: *((EIF_INTEGER_16 *)res) = it->it_int16; break; case SK_INT32: *((EIF_INTEGER_32 *)res) = it->it_int32; break; case SK_INT64: *((EIF_INTEGER_64 *)res) = it->it_int64; break; case SK_POINTER: *((EIF_POINTER *)res) = it->it_ptr; break; case SK_REAL32: *((EIF_REAL_32 *)res) = it->it_real32; break; case SK_CHAR32: *((EIF_CHARACTER_32* )res) = it->it_wchar; break; default: *((EIF_REFERENCE *)res) = it->it_ref; } }