/* This function is reentrant */
static int handle_signal (Signal_Type *s)
{
int status = 0;
int was_blocked;
(void) block_signal (s->sig, &was_blocked);
/* At this point, sig is blocked and the handler is about to be called.
* The pending flag can be safely set to 0 here.
*/
s->pending = 0;
if (s->handler != NULL)
{
int depth = SLstack_depth ();
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_integer (s->sig))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (s->handler)))
status = -1;
if ((status == 0)
&& (depth != SLstack_depth ()))
{
SLang_verror (SL_Application_Error, "The signal handler %s corrupted the stack", s->handler->name);
status = -1;
}
}
if (was_blocked == 0)
(void) unblock_signal (s->sig);
return status;
}
static int sl_report_function (Isis_Fit_Statistic_Type *s, void *pfp, double stat, unsigned int npts, unsigned int nvpars) /*{{{*/
{
FILE *fp = (FILE *)pfp;
char *str;
if (s == NULL || s->sl_report == NULL)
return -1;
SLang_start_arg_list ();
if ((-1 == SLang_push_double (stat))
|| (-1 == SLang_push_integer ((int) npts))
|| (-1 == SLang_push_integer ((int) nvpars)))
return -1;
SLang_end_arg_list ();
if (-1 == SLexecute_function ((SLang_Name_Type *)s->sl_report))
return -1;
if (-1 == SLang_pop_slstring (&str))
return -1;
if (EOF == fputs (str, fp))
{
SLang_free_slstring (str);
return -1;
}
SLang_free_slstring (str);
return 0;
}
int _pSLcall_bos_handler (SLFUTURE_CONST char *file, int line)
{
int status = 0;
int err;
if (BOS_Callback_Handler == NULL)
return 0;
if (Handler_Active)
return 0;
if ((0 != (err = _pSLang_Error))
&& (-1 == _pSLang_push_error_context ()))
return -1;
Handler_Active++;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_string (file))
|| (-1 == SLclass_push_int_obj (SLANG_INT_TYPE, line))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (BOS_Callback_Handler)))
{
set_bos_eos_handlers (NULL, NULL);
status = -1;
}
Handler_Active--;
if (err)
_pSLang_pop_error_context (status != 0);
return status;
}
int SLang_run_hooks (SLFUTURE_CONST char *hook, unsigned int num_args, ...)
{
unsigned int i;
va_list ap;
if (SLang_get_error ())
return -1;
if (0 == SLang_is_defined (hook))
return 0;
(void) SLang_start_arg_list ();
va_start (ap, num_args);
for (i = 0; i < num_args; i++)
{
char *arg;
arg = va_arg (ap, char *);
if (-1 == SLang_push_string (arg))
break;
}
va_end (ap);
(void) SLang_end_arg_list ();
if (_pSLang_Error) return -1;
return SLang_execute_function (hook);
}
int Plot_histogram_data (int n, float *lo, float *hi, float *val) /*{{{*/
{
int status = -1;
if (pli_undefined())
return -1;
if (PLI->plot_histogram == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: plot_histogram operation is not supported");
return -1;
}
SLang_start_arg_list ();
status = push_three_float_arrays (n, lo, hi, val);
SLang_end_arg_list ();
if ((status < 0) || (-1 == SLexecute_function (PLI->plot_histogram)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed plotting histogram");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed plotting histogram");
return -1;
}
return status;
}
int Plot_line (int n, float *x, float *y) /*{{{*/
{
int status = -1;
if (pli_undefined())
return -1;
if (PLI->plot_xy == NULL)
return -1;
SLang_start_arg_list ();
status = push_two_float_arrays (n, x, y);
SLang_end_arg_list ();
if ((status < 0) || (-1 == SLexecute_function (PLI->plot_xy)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed plotting line");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed plotting line");
return -1;
}
return status;
}
int Plot_points (int n, float *x, float *y, int symbol) /*{{{*/
{
int status = -1;
if (pli_undefined())
return -1;
if (PLI->plot_points == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: plot_points operation is not supported");
return -1;
}
SLang_start_arg_list ();
status = push_two_float_arrays (n, x, y);
SLang_push_integer (symbol);
SLang_end_arg_list ();
if ((status < 0) || (-1 == SLexecute_function (PLI->plot_points)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed plotting points");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed plotting points");
return -1;
}
return status;
}
int Plot_select_window (int device) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->select_window == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: select_window operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_integer (device);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->select_window))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed selecting plot device");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed selecting plot device");
return -1;
}
return status;
}
int Plot_subdivide (int num_x_subpanels, int num_y_subpanels) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->subdivide == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: subdivide operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_integer (num_x_subpanels);
SLang_push_integer (num_y_subpanels);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->subdivide))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed subdividing plot device");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed subdividing plot device");
return -1;
}
return status;
}
int Plot_open (char *device) /*{{{*/
{
int id;
if (pli_undefined())
return -1;
if (PLI->open == NULL)
return -1;
SLang_start_arg_list ();
SLang_push_string (device);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->open))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed opening plot device");
return -1;
}
if ((-1 == SLang_pop_integer (&id))
|| (id <= 0))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed opening plot device");
return -1;
}
return id;
}
int _Plot_set_charsize (float size) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->set_char_size == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: set_char_size operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_float (size);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->set_char_size))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: set_char_size failed");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: set_char_size failed");
return -1;
}
return status;
}
int Plot_y_errorbar (int n, float *x, float *top, float *bot, /*{{{*/
float terminal_length)
{
int status = -1;
if (pli_undefined())
return -1;
if (PLI->plot_y_errorbar == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: plot_y_errorbar operation is not supported");
return -1;
}
SLang_start_arg_list ();
status = push_three_float_arrays (n, x, top, bot);
SLang_push_float (terminal_length);
SLang_end_arg_list ();
if ((status < 0) || (-1 == SLexecute_function (PLI->plot_y_errorbar)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed plotting Y errorbar");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed plotting Y errorbar");
return -1;
}
return status;
}
/* int _pSLcall_debug_hook (char *file, int line, char *funct) */
int _pSLcall_debug_hook (SLFUTURE_CONST char *file, int line)
{
int status = 0, err;
if (Debug_Hook == NULL)
return 0;
if (Debug_Handler_Active)
return 0;
if ((0 != (err = _pSLang_Error))
&& (-1 == _pSLang_push_error_context ()))
return -1;
Debug_Handler_Active++;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_string (file))
|| (-1 == SLclass_push_int_obj (SLANG_INT_TYPE, line))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (Debug_Hook)))
{
status = -1;
set_debug_hook (NULL);
}
Debug_Handler_Active--;
if (err)
(void) _pSLang_pop_error_context (status != 0);
return status;
}
int _pSLcall_bof_handler (SLFUTURE_CONST char *fun, SLFUTURE_CONST char *file)
{
int status = 0, err;
if (BOF_Callback_Handler == NULL)
return 0;
if (Handler_Active)
return 0;
if ((0 != (err = _pSLang_Error))
&& (-1 == _pSLang_push_error_context ()))
return -1;
Handler_Active++;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_string (fun))
|| (-1 == SLang_push_string (file))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (BOF_Callback_Handler)))
{
set_bof_eof_handlers (NULL, NULL);
status = -1;
}
Handler_Active--;
if (err)
_pSLang_pop_error_context (status != 0);
return status;
}
static void rline_call_update_hook (SLrline_Type *rli,
SLFUTURE_CONST char *prompt,
SLFUTURE_CONST char *buf,
unsigned int len,
unsigned int point, VOID_STAR cd)
{
Rline_CB_Type *cb;
(void) rli;
(void) len;
cb = (Rline_CB_Type *)cd;
if (-1 == SLang_start_arg_list ())
return;
if ((-1 == SLang_push_mmt (cb->mmt))
|| (-1 == SLang_push_string (prompt))
|| (-1 == SLang_push_string (buf))
|| (-1 == SLang_push_int ((int) point))
|| ((cb->cd != NULL) && (-1 == SLang_push_anytype (cb->cd))))
{
(void) SLang_end_arg_list ();
return;
}
(void) SLexecute_function (cb->update_hook);
}
char *Plot_configure_axis (char *opt, int is_log, int has_numbers) /*{{{*/
{
char *s;
if (pli_undefined())
return NULL;
if (PLI->configure_axis == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: configure_axis operation is not supported");
return NULL;
}
SLang_start_arg_list ();
SLang_push_string (opt);
SLang_push_integer (is_log);
SLang_push_integer (has_numbers);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->configure_axis))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: configure_axis failed");
return NULL;
}
if (-1 == SLpop_string (&s))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: configure_axis failed");
return NULL;
}
return s;
}
int _pSLcall_eos_handler (void)
{
int err, status = 0;
if ((EOS_Callback_Handler == NULL)
|| (Handler_Active))
return 0;
if ((0 != (err = _pSLang_Error))
&& (-1 == _pSLang_push_error_context ()))
return -1;
Handler_Active++;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (EOS_Callback_Handler)))
{
status = -1;
set_bos_eos_handlers (NULL, NULL);
}
Handler_Active--;
if (err)
_pSLang_pop_error_context (status != 0);
return status;
}
int _Plot_label_box (char *xlabel, char *ylabel, char *tlabel) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->label_axes == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: label_axes operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_string (xlabel);
SLang_push_string (ylabel);
SLang_push_string (tlabel);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->label_axes))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: label_axes failed");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: label_axes failed");
return -1;
}
return status;
}
static int execute_fun_with_args (SLang_Name_Type *nt, unsigned int argc,
char **argv)
{
unsigned int i;
(void) SLang_start_arg_list ();
for (i = 0; i < argc; i++)
(void) SLang_push_string (argv[i]);
(void) SLang_end_arg_list ();
return SLexecute_function (nt);
}
int user_open_source (char **argv, int argc, double area,
double cosx, double cosy, double cosz)
{
char *file;
int status;
if (-1 == init_slang ())
return -1;
file = argv[0];
if ((argc == 0) || (NULL == (file = argv[0])))
{
fprintf (stderr, "No filename specified for the slang source\n");
return -1;
}
if (0 != SLang_load_file (file))
{
fprintf (stderr, "Encountered a problem loading %s\n", file);
return -1;
}
if (NULL == (Open_Source = SLang_get_function ("user_open_source")))
{
fprintf (stderr, "%s failed to define user_open_source\n", file);
return -1;
}
if (NULL == (Create_Ray = SLang_get_function ("user_create_ray")))
{
fprintf (stderr, "%s failed to define user_create_ray\n", file);
return -1;
}
if ((-1 == SLang_start_arg_list ())
|| (-1 == push_c_string_array (argv, argc))
|| (-1 == SLang_push_double (area))
|| (-1 == SLang_push_double (cosx))
|| (-1 == SLang_push_double (cosy))
|| (-1 == SLang_push_double (cosz))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (Open_Source))
|| (-1 == SLang_pop_integer (&status)))
{
SLang_verror (0, "Error occured processing user_open_source in %s", file);
return -1;
}
return status;
}
static int call_simple_update_cb (SLang_Name_Type *f, Rline_CB_Type *cb, int *opt)
{
if (f == NULL)
return 0;
if (-1 == SLang_start_arg_list ())
return -1;
if ((-1 == SLang_push_mmt (cb->mmt))
|| ((opt != NULL) && (-1 == SLang_push_int (*opt)))
|| ((cb->cd != NULL) && (-1 == SLang_push_anytype (cb->cd))))
{
(void) SLang_end_arg_list ();
return -1;
}
return SLexecute_function (f);
}
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;
}
int Plot_symbol_points (SLindex_Type n, float *x, float *y, int *symbol) /*{{{*/
{
SLang_Array_Type *sl_sym=NULL;
int status = -1;
if (pli_undefined())
return -1;
if (PLI->plot_symbol_points == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: plot_symbol_points operation is not supported");
return -1;
}
if (NULL == (sl_sym = SLang_create_array (SLANG_INT_TYPE, 0, NULL, &n, 1)))
return -1;
memcpy ((char *)sl_sym->data, (char *)symbol, n * sizeof(int));
SLang_start_arg_list ();
status = push_two_float_arrays (n, x, y);
SLang_push_array (sl_sym, 1);
SLang_end_arg_list ();
if ((status < 0) || (-1 == SLexecute_function (PLI->plot_symbol_points)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed plotting points");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed plotting points");
return -1;
}
return status;
}
int _Plot_draw_box (char *xopt, float xtick, int nxsub, /*{{{*/
char *yopt, float ytick, int nysub)
{
int status;
if (pli_undefined())
return -1;
if (PLI->draw_box == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: draw_box operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_string (xopt);
SLang_push_float (xtick);
SLang_push_integer (nxsub);
SLang_push_string (yopt);
SLang_push_float (ytick);
SLang_push_integer (nysub);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->draw_box))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: draw_box failed");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: draw_box failed");
return -1;
}
return status;
}
int Plot_put_text_offset (char *where, float offset, float ox, float oy, char *text) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->put_text_offset == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: put_text_offset operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_string (where);
SLang_push_float (offset);
SLang_push_float (ox);
SLang_push_float (oy);
SLang_push_string (text);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->put_text_offset))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: put_text_offset failed");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: put_text_offset failed");
return -1;
}
return status;
}
static int execute_read_callback (CSV_Type *csv, char **sptr)
{
char *s;
*sptr = NULL;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_anytype (csv->callback_data))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (csv->read_callback)))
return -1;
if (SLang_peek_at_stack () == SLANG_NULL_TYPE)
{
(void) SLang_pop_null ();
return 0;
}
if (-1 == SLang_pop_slstring (&s))
return -1;
*sptr = s;
return 1;
}
int Plot_put_text (float x, float y, float angle, float justify, char *txt) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->put_text_xy == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: put_text_xy operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_float (x);
SLang_push_float (y);
SLang_push_float (angle);
SLang_push_float (justify);
SLang_push_string (txt);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->put_text_xy))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: put_text_xy failed");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: put_text_xy failed");
return -1;
}
return status;
}
static int slfe_optimize (Isis_Fit_Type *ift, void *clientdata, /*{{{*/
double *x, double *y, double *weights, unsigned int npts,
double *pars, unsigned int npars)
{
Isis_Fit_Engine_Type *e;
SLang_Array_Type *sl_pars=NULL, *sl_pars_min=NULL, *sl_pars_max=NULL;
SLang_Array_Type *sl_new_pars=NULL;
SLindex_Type n;
int status = -1;
(void) clientdata; (void) x; (void) y; (void) weights; (void) npts;
if ((ift == NULL) || (pars == NULL) || (npars <= 0)
|| (Current_Fit_Object_MMT == NULL))
return -1;
e = ift->engine;
n = (SLindex_Type) npars;
sl_pars = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1);
sl_pars_min = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1);
sl_pars_max = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1);
if ((NULL == sl_pars) || (NULL == sl_pars_min) || (NULL == sl_pars_max))
return -1;
memcpy ((char *)sl_pars->data, (char *)pars, npars * sizeof(double));
memcpy ((char *)sl_pars_min->data, (char *)e->par_min, npars * sizeof(double));
memcpy ((char *)sl_pars_max->data, (char *)e->par_max, npars * sizeof(double));
/* FIXME: Increment the reference count to prevent a segv.
* There must be a better way.
*/
SLang_inc_mmt (Current_Fit_Object_MMT);
SLang_start_arg_list ();
if ((-1 == SLang_push_mmt (Current_Fit_Object_MMT))
|| (-1 == SLang_push_array (sl_pars, 1))
|| (-1 == SLang_push_array (sl_pars_min, 1))
|| (-1 == SLang_push_array (sl_pars_max, 1)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"calling user-defined optimization method '%s'",
e->engine_name);
goto return_error;
}
SLang_end_arg_list ();
if (-1 == SLexecute_function (e->sl_optimize))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"executing optimization method '%s'",
e->engine_name);
goto return_error;
}
if (-1 == SLang_pop_array_of_type (&sl_new_pars, SLANG_DOUBLE_TYPE))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"returning results from optimization method '%s'",
e->engine_name);
goto return_error;
}
if ((sl_new_pars == NULL) || (sl_new_pars->num_elements != npars))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__,
"corrupted parameter array returned from optimization method '%s'",
e->engine_name);
goto return_error;
}
memcpy ((char *)pars, (char *)sl_new_pars->data, npars * sizeof(double));
status = 0;
return_error:
SLang_free_array (sl_new_pars);
if (SLang_get_error())
{
isis_throw_exception (SLang_get_error());
return -1;
}
return status;
}
static int slfe_set_options (Isis_Fit_Engine_Type *e, Isis_Option_Type *opts) /*{{{*/
{
SLang_Array_Type *sl_opts;
SLindex_Type i, n;
if (opts == NULL)
return -1;
n = opts->num_options;
if (n == 0)
return 0;
if (NULL == (sl_opts = SLang_create_array (SLANG_STRING_TYPE, 1, NULL, &n, 1)))
return -1;
for (i = 0; i < n; i++)
{
int have_value = (opts->option_values[i] != 0);
char *s;
if (have_value)
{
s = isis_mkstrcat (opts->option_names[i], "=",
opts->option_values[i], NULL);
}
else s = opts->option_names[i];
if ((s == NULL)
|| (-1 == SLang_set_array_element (sl_opts, &i, &s)))
{
SLang_free_array (sl_opts);
if (have_value) ISIS_FREE(s);
}
if (have_value) ISIS_FREE(s);
}
SLang_start_arg_list();
(void) SLang_push_array (sl_opts, 1);
SLang_end_arg_list();
/* converts options array to a struct */
SLang_execute_function ("_isis->options_to_struct");
/* this function then pops the struct off the stack */
if (-1 == SLexecute_function (e->sl_set_options))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"setting options for fit method '%s'",
e->engine_name);
return -1;
}
if (SLang_get_error ())
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"S-Lang error while setting options for fit method '%s'",
e->engine_name);
return -1;
}
return 0;
}
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;
}
