static void moment (void) /*{{{*/
{
SLang_Array_Type *sx = NULL;
Moment_Type m;
double s[2]; /* mean, stddev */
double xmax, xmin;
double *x;
int i, n;
if ((-1 == SLang_pop_array_of_type (&sx, SLANG_DOUBLE_TYPE))
|| (sx == NULL))
{
isis_throw_exception (Isis_Error);
goto error_return;
}
if (sx->num_elements < 1)
{
m.num = 0;
m.ave = m.var = m.sdev = m.sdom = m.min = m.max = isis_nan();
SLang_push_cstruct ((VOID_STAR)&m, Moment_Layout);
return;
}
x = (double *)sx->data;
n = sx->num_elements;
m.num = n;
xmin = xmax = x[0];
for (i = 0; i < n; i++)
{
double x_i = x[i];
if (x_i > xmax)
xmax = x_i;
else if (x_i < xmin)
xmin = x_i;
}
m.min = xmin;
m.max = xmax;
if (-1 == mean_stddev_doubles (x, n, s))
{
isis_throw_exception (Isis_Error);
goto error_return;
}
m.ave = s[0];
m.sdev = s[1];
m.var = m.sdev * m.sdev;
m.sdom = m.sdev / sqrt(n);
error_return:
SLang_free_array (sx);
SLang_push_cstruct ((VOID_STAR)&m, Moment_Layout);
}
static int read_plot_cursor (Cursor_Config_Type *cc, float *x, float *y, char *ch) /*{{{*/
{
if (pli_undefined())
return -1;
if (PLI->read_cursor == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: read_cursor operation is not supported");
return -1;
}
if (-1 == SLang_push_cstruct ((VOID_STAR)cc, Cursor_Config_Table))
return -1;
if (-1 == SLexecute_function (PLI->read_cursor))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: read_cursor failed");
return -1;
}
if (SLstack_depth() < 3)
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: read_cursor failed");
return -1;
}
SLang_pop_char (ch);
SLang_pop_float (y);
SLang_pop_float (x);
return 0;
}
static int push_opt_data (Isis_Fit_Statistic_Optional_Data_Type *opt_data) /*{{{*/
{
Optional_Data_Type odt;
int n, status=-1;
if (opt_data == NULL)
{
SLang_push_null ();
return 0;
}
memset ((char *)&odt, 0, sizeof odt);
n = opt_data->num;
if ((NULL == (odt.bkg = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1)))
|| (NULL == (odt.bkg_at = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1)))
|| ((NULL == (odt.src_at = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1)))))
goto free_and_return;
memcpy ((char *)odt.bkg->data, (char *)opt_data->bkg, n*sizeof(double));
memcpy ((char *)odt.bkg_at->data, (char *)opt_data->bkg_at, n*sizeof(double));
memcpy ((char *)odt.src_at->data, (char *)opt_data->src_at, n*sizeof(double));
if (-1 == SLang_push_cstruct ((VOID_STAR)&odt, Optional_Data_Type_Layout))
goto free_and_return;
status = 0;
free_and_return:
SLang_free_array (odt.bkg);
SLang_free_array (odt.bkg_at);
SLang_free_array (odt.src_at);
return status;
}
static int get_struct_sockopt (Socket_Type *s, int level, int optname,
SLang_CStruct_Field_Type *cs, VOID_STAR v,
socklen_t len)
{
if (-1 == do_getsockopt (s->fd, level, optname, v, &len))
return -1;
return SLang_push_cstruct (v, cs);
}
static void times_cmd (void)
{
TMS_Type d;
struct tms t;
(void) times (&t);
d.tms_utime = SECS_PER_TICK * (double)t.tms_utime;
d.tms_stime = SECS_PER_TICK * (double)t.tms_stime;
d.tms_cutime = SECS_PER_TICK * (double)t.tms_cutime;
d.tms_cstime = SECS_PER_TICK * (double)t.tms_cstime;
(void) SLang_push_cstruct ((VOID_STAR)&d, TMS_Struct);
}
void Plot_push_library_interface (void) /*{{{*/
{
Plot_Library_Interface_Type pli;
if (PLI == NULL)
memset ((char *)&pli, 0, sizeof pli);
else
{
/* struct copy */
pli = *PLI;
}
if (-1 == SLang_push_cstruct ((VOID_STAR)&pli, Plot_Library_Interface_Table))
{
isis_vmesg (INTR, I_FAILED, __FILE__, __LINE__, "couldn't set library interface");
return;
}
}
static int apply_line_modifier (Model_t *m, Model_Info_Type *info, DB_line_t *line, double *emis) /*{{{*/
{
Plasma_State_Type lm_state;
lm_state.temperature = m->temperature;
lm_state.ndensity = m->density;
SLang_start_arg_list ();
SLang_push_array (info->line_emis_modifier_params, 0);
SLang_push_int (line->indx);
if (-1 == SLang_push_cstruct ((VOID_STAR)&lm_state, Plasma_State_Layout))
return -1;
SLang_push_double (*emis);
if (info->line_emis_modifier_args != NULL)
isis_push_args (info->line_emis_modifier_args);
if (info->line_emis_modifier_qualifiers == NULL)
{
SLang_end_arg_list ();
if (-1 == SLexecute_function (info->line_emis_modifier))
return -1;
}
else
{
if ((-1 == SLang_push_function (info->line_emis_modifier))
|| (-1 == SLang_push_struct (info->line_emis_modifier_qualifiers)))
return -1;
SLang_end_arg_list ();
if (-1 == SLang_execute_function ("_isis->do_eval_with_qualifiers"))
return -1;
}
if (-1 == SLang_pop_double (emis))
return -1;
return 0;
}
static void waitpid_intrinsic (int *pid, int *options)
{
int status, ret;
Waitpid_Type s;
while (-1 == (ret = waitpid ((pid_t)*pid, &status, *options)))
{
if (errno == EINTR)
{
if (-1 != SLang_handle_interrupt ())
continue;
}
(void) SLerrno_set_errno (errno);
(void) SLang_push_null ();
return;
}
memset ((char *)&s, 0, sizeof(Waitpid_Type));
if (WIFEXITED(status))
{
s.exited = 1;
s.exit_status = WEXITSTATUS(status);
}
if (WIFSIGNALED(status))
{
s.signal = WTERMSIG(status);
#ifdef WCOREDUMP
s.coredump = WCOREDUMP(status) != 0;
#endif
}
if (WIFSTOPPED(status))
s.stopped = WSTOPSIG(status);
#ifdef WIFCONTINUED
s.continued = WIFCONTINUED(status);
#endif
s.pid = ret;
(void) SLang_push_cstruct ((VOID_STAR)&s, Waitpid_Struct);
}
static void getrusage_intrin (void)
{
RUsage_Type rut;
int who = RUSAGE_SELF;
if ((SLang_Num_Function_Args == 1)
&& (-1 == SLang_pop_int (&who)))
return;
if (-1 == getrusage (who, &rut.r))
{
_pSLerrno_errno = errno;
(void) SLang_push_null ();
return;
}
rut.ru_stimesecs
= (double)rut.r.ru_stime.tv_sec + 1e-6*rut.r.ru_stime.tv_usec;
rut.ru_utimesecs
= (double)rut.r.ru_utime.tv_sec + 1e-6*rut.r.ru_utime.tv_usec;
(void) SLang_push_cstruct ((VOID_STAR) &rut, RUsage_Struct);
}
static void get_c_struct (void)
{
check_cstruct ();
(void) SLang_push_cstruct ((VOID_STAR) &C_Struct_Buf, C_Struct);
}
static int call_ionpop_modifier (Model_t *m, Model_Info_Type *info, float *ionpop_new) /*{{{*/
{
Plasma_State_Type s;
SLang_Array_Type *sl_ionpop = NULL;
int Z, q, status = -1;
int n = ISIS_MAX_PROTON_NUMBER;
s.temperature = m->temperature;
s.ndensity = m->density;
/* Float_Type[n,n] = ionpop_modifier (params, state, last_ionpop, [,args]) */
SLang_start_arg_list ();
SLang_push_array (info->ionpop_params, 0);
if (-1 == SLang_push_cstruct ((VOID_STAR)&s, Plasma_State_Layout))
{
SLang_end_arg_list ();
return -1;
}
SLang_push_array (m->last_ionpop, 0);
if (info->ionpop_args != NULL)
isis_push_args (info->ionpop_args);
if (info->ionpop_qualifiers == NULL)
{
SLang_end_arg_list ();
if (-1 == SLexecute_function (info->ionpop_modifier))
return -1;
}
else
{
if ((-1 == SLang_push_function (info->ionpop_modifier))
|| (-1 == SLang_push_struct (info->ionpop_qualifiers)))
return -1;
SLang_end_arg_list ();
if (-1 == SLang_execute_function ("_isis->do_eval_with_qualifiers"))
return -1;
}
if (-1 == SLang_pop_array_of_type (&sl_ionpop, SLANG_FLOAT_TYPE))
return -1;
if ((sl_ionpop == NULL)
|| (sl_ionpop->num_dims != 2)
|| ((sl_ionpop->dims[0] != n+1) || (sl_ionpop->dims[1] != n+1)))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__,
"ionpop_modifier: invalid return value, expecting: Float_Type[n,n] with n=%d", n+1);
goto return_status;
}
for (Z = 1; Z <= n; Z++)
{
for (q = 0; q <= Z; q++)
{
int i[2];
i[0] = Z; i[1] = q;
if (-1 == SLang_get_array_element (sl_ionpop, i, &ionpop_new[Z*(n+1)+q]))
goto return_status;
}
}
SLang_free_array (m->last_ionpop);
m->last_ionpop = sl_ionpop;
status = 0;
return_status:
if (status != 0)
{
SLang_free_array (sl_ionpop);
}
return status;
}
static int push_tm_struct (struct tm *tms)
{
if (tms == NULL)
return SLang_push_null ();
return SLang_push_cstruct ((VOID_STAR) tms, TM_Struct);
}
