/*
* dispatch FUNCTION call. Caller must inspect relevant result_xxx
* variable afterwards
*/
void
c_dispatch_function(EIF_REFERENCE obj, char *feat_name, EIF_REFERENCE arg, EIF_INTEGER feat_type)
{
void *ef;
EIF_TYPE_ID eti;
eti = Dtype(obj);
switch (feat_type) {
case EIF_NO_TYPE:
eif_panic("No type id");
break;
case EIF_REFERENCE_TYPE:
ef = eif_reference_function(feat_name, eti);
if (ef != NULL) result_obj = ((EIF_REFERENCE_FUNCTION) ef)(obj, arg);
break;
case EIF_BOOLEAN_TYPE:
ef = eif_boolean_function(feat_name, eti);
if (ef != NULL) result_bool = ((EIF_BOOLEAN_FUNCTION) ef)(obj, arg);
break;
case EIF_CHARACTER_TYPE:
ef = eif_character_function(feat_name, eti);
if (ef != NULL) result_char = ((EIF_CHARACTER_FUNCTION) ef)(obj, arg);
break;
case EIF_INTEGER_TYPE:
ef = eif_integer_function(feat_name, eti);
if (ef != NULL) result_int = ((EIF_INTEGER_FUNCTION) ef)(obj, arg);
break;
case EIF_REAL_TYPE:
ef = eif_real_function(feat_name, eti);
if (ef != NULL) result_float = ((EIF_REAL_FUNCTION) ef)(obj, arg);
break;
case EIF_DOUBLE_TYPE:
ef = eif_double_function(feat_name, eti);
if (ef != NULL) result_double = ((EIF_DOUBLE_FUNCTION) ef)(obj, arg);
break;
case EIF_POINTER_TYPE:
ef = eif_pointer_function(feat_name, eti);
if (ef != NULL) result_pointer = ((EIF_POINTER_FUNCTION) ef)(obj, arg);
break;
case EIF_BIT_TYPE:
ef = eif_bit_function(feat_name, eti);
if (ef != NULL) result_bit = ((EIF_BIT_FUNCTION) ef)(obj, arg);
break;
default:
break;
}
}
/*
* dispatch a field access to character field
*/
void
c_dispatch_character_field(EIF_POINTER obj, char *feat_name)
{
EIF_TYPE_ID eti;
eti = Dtype(obj);
if (eti != EIF_NO_TYPE)
result_char = eif_field((EIF_REFERENCE)obj, feat_name, EIF_CHARACTER);
else
eif_panic("No type id");
}
/*
* dispatch a field access to double field
*/
void
c_dispatch_double_field(EIF_POINTER obj, char *feat_name)
{
EIF_TYPE_ID eti;
eti = Dtype(obj);
if (eti != EIF_NO_TYPE)
result_double = eif_field((EIF_REFERENCE)obj, feat_name, EIF_DOUBLE);
else
eif_panic("No type id");
}
/*
* dispatch a field access to real field
*/
void
c_dispatch_real_field(EIF_POINTER obj, char *feat_name)
{
EIF_TYPE_ID eti;
eti = Dtype(obj);
if (eti != EIF_NO_TYPE)
result_float = eif_field((EIF_REFERENCE)obj, feat_name, EIF_REAL);
else
eif_panic("No type id");
}
/*
* dispatch a field access to boolean field
*/
void
c_dispatch_boolean_field(EIF_POINTER obj, char *feat_name)
{
EIF_TYPE_ID eti;
eti = Dtype(obj);
if (eti != EIF_NO_TYPE)
result_bool = eif_field((EIF_REFERENCE)obj, feat_name, EIF_BOOLEAN);
else
eif_panic("No type id");
}
/*
* dispatch REFERENCE FIELD call.
*/
void
c_dispatch_reference_field(EIF_REFERENCE obj, char *feat_name)
{
EIF_TYPE_ID eti;
eti = Dtype(obj);
if (eti != EIF_NO_TYPE)
result_obj = eif_field(obj, feat_name, EIF_REFERENCE);
else
eif_panic("No type id");
}
rt_shared void initstk(void)
{
/* Initialize both the local stack and the hector stack. Those two stacks
* may have their context saved and restored in an Eiffel routine, so they
* need to be correctly initialized.
* In workbench mode, the debugger stack is also created here.
*/
EIF_GET_CONTEXT
#ifdef ISE_GC
char **top;
#endif
#ifdef EIF_ASSERTIONS
#if defined(EIF_WINDOWS) && defined(_DEBUG)
int tmpDbgFlag = 0;
_CrtSetReportMode(_CRT_WARN, _CRTDBG_MODE_FILE);
_CrtSetReportFile(_CRT_WARN, _CRTDBG_FILE_STDOUT);
_CrtSetReportMode(_CRT_ERROR, _CRTDBG_MODE_FILE);
_CrtSetReportFile(_CRT_ERROR, _CRTDBG_FILE_STDOUT);
_CrtSetReportMode(_CRT_ASSERT, _CRTDBG_MODE_FILE);
_CrtSetReportFile(_CRT_ASSERT, _CRTDBG_FILE_STDOUT);
tmpDbgFlag = _CrtSetDbgFlag(_CRTDBG_REPORT_FLAG);
tmpDbgFlag |= _CRTDBG_DELAY_FREE_MEM_DF;
tmpDbgFlag |= _CRTDBG_LEAK_CHECK_DF;
tmpDbgFlag |= _CRTDBG_CHECK_ALWAYS_DF;
_CrtSetDbgFlag(tmpDbgFlag);
#endif
#endif
#if defined(EIF_WINDOWS) && defined(_MSC_VER)
/* This is to catch CRT raised exception when passing incorrect arguments to CRT routines. */
_set_invalid_parameter_handler(eif_invalid_paramter_handler);
#endif
#ifdef ISE_GC
top = st_alloc(&loc_set, eif_stack_chunk);
if (top != (char **) 0)
top = st_alloc(&hec_stack, eif_stack_chunk);
if (top == (char **) 0)
eif_panic(MTC "can't create runtime stacks");
#endif
#ifdef WORKBENCH
initdb(); /* Initialize debugger stack */
#endif
}
/*
doc: <routine name="rt_scoop_setup" return_type="void" export="shared">
doc: <summary> Initialize the SCOOP subsystem and mark the root thread as a processor with ID 0. </summary>
doc: <param name="is_scoop_enabled" type="int"> Whether SCOOP was enabled in the project settings. Depending on this value initialization may be partially skipped. </param>
doc: <thread_safety> Not safe. </thread_safety>
doc: <synchronization> Only call during program startup. </synchronization>
doc: </routine>
*/
rt_public void rt_scoop_setup (int is_scoop_enabled)
{
/* Note: We initialize the SCOOP processor_registry in any case,
* because of a bug in the interpreter which may sometimes execute RTS_OU
* even in non-SCOOP systems. */
int error = rt_processor_registry_init ();
if (T_OK == error && is_scoop_enabled) {
/* Record that the current thread is associated with a processor of a PID 0. */
rt_set_processor_id (0);
}
if (T_OK != error) {
eif_panic ("Could not initialize SCOOP subsystem.");
}
}
EIF_REFERENCE
c_create_make_object_by_id(EIF_TYPE_ID eti, char *make_proc_name, EIF_REFERENCE make_arg)
{
EIF_OBJECT new_obj;
EIF_PROCEDURE ep;
if (eti != EIF_NO_TYPE) {
new_obj = eif_create(eti);
if (make_proc_name != NULL) {
ep = eif_procedure(make_proc_name, eti);
(ep)(eif_access(new_obj), make_arg);
}
}
else
eif_panic("No type id");
c_marshal_args_reset();
return eif_wean(new_obj);
}
int main (int argc,char **argv,char **envp) {
EIF_INTEGER *c_array;
int i, j;
EIF_PROCEDURE p_make; /* `make ' from MY_ARRAY [INTEGER] */
EIF_PROCEDURE p_put; /* `put' from MY_ARRAY [INTEGER] */
EIF_PROCEDURE p_display; /* `display' from MY_ARRAY [INTEGER] */
EIF_TYPE_ID my_array_tid; /* MY_ARRAY [INTEGER] type id */
EIF_OBJECT o_array; /* Protected indirection to an array of integers */
EIF_INITIALIZE (failure) /* Initialization of Eiffel run-time */
/* Enable visible exception: raised whenever `eif_procedure'
* returns a NULL pointer.
* Note: not necessary, since it is set by default */
eif_enable_visible_exception ();
/* Set Type id. */
/* `eif_type_id has been extended to generic type since v4.3 */
my_array_tid = eif_type_id ("MY_ARRAY[INTEGER]");
if (my_array_tid == EIF_NO_TYPE)
/* MY_ARRAY's type id not found. */
eif_panic ("No type id.");
/* Set procedures. */
p_make = eif_procedure ("make", my_array_tid);
p_display = eif_procedure ("display", my_array_tid);
p_put = eif_procedure ("put", my_array_tid);
/* o_array is a protected indirection
* it has to be accessed with `eif_access'
* and freed with `eif_wean' */
o_array = eif_create (my_array_tid);
/* Call `make (1, 10)' on new array */
(p_make) (eif_access (o_array), 1, 10);
printf ("Enter 10 integers:\n");
c_array = (EIF_INTEGER *) malloc (10*sizeof (EIF_INTEGER));
/* Set C array */
for (i = 0; i < 10; i++) {
printf ("Enter element %d: ", i + 1);
scanf ("%d", &j);
c_array [i] = (EIF_INTEGER) j;
}
printf ("\n");
/* Set Eiffel array from C array */
for (i = 0; i < 10; i++) {
/* Call `put (value, i)' on array */
(p_put) (eif_access (o_array), (EIF_INTEGER) c_array [i], i+1);
}
(p_display) (eif_access (o_array)); /* Call `display on array */
eif_wean (o_array); /* Reclaim protected indirection so that the GC can
* collect it */
EIF_DISPOSE_ALL /* Reclaim all objects allocated by Eiffel run-time. */
return 0;
}
