static Isis_Rmf_Load_Method_t *get_user_rmf_load_method (char *options) /*{{{*/
{
static const char *delim = ":;";
Isis_Rmf_Load_Method_t *load_method;
char *s, *file, *init_name;
if (options == NULL)
return NULL;
/* options string has form
* "libname.so:init_name[;opt1;opt2;opt3;...]"
*/
if (NULL == (s = isis_make_string (options)))
return NULL;
if ((NULL == (file = strtok (s, delim)))
|| (NULL == (init_name = strtok (NULL, delim))))
{
ISIS_FREE(s);
return NULL;
}
load_method = (Isis_Rmf_Load_Method_t *)isis_load_function (file, init_name, "rmf");
ISIS_FREE(s);
return load_method;
}
static int fixup_sl_statistic_name (char *name)
{
Isis_Fit_Statistic_Type *s;
if (NULL == (s = find_statistic (name)))
return -1;
if (NULL == (s->option_string = isis_make_string (name)))
return -1;
ISIS_FREE(s->symbol);
if (NULL == (s->symbol = isis_make_string (name)))
return -1;
return 0;
}
static Isis_Fit_Engine_Type *add_slang_fit_engine (char *eng_name, char *stat_name) /*{{{*/
{
Isis_Fit_Engine_Type *e;
if (NULL == (e = (Isis_Fit_Engine_Type *) ISIS_MALLOC (sizeof(Isis_Fit_Engine_Type))))
return NULL;
memset ((char *)e, 0, sizeof (*e));
if ((NULL == (e->engine_name = isis_make_string (eng_name)))
|| (NULL == (e->default_statistic_name = isis_make_string (stat_name))))
{
slfe_deallocate (e);
ISIS_FREE (e);
return NULL;
}
e->method = &slfe_optimize;
e->deallocate = &slfe_deallocate;
e->set_options = &slfe_set_options;
e->set_range_hook = NULL;
e->range_hook = NULL;
e->verbose_hook = NULL;
e->warn_hook = NULL;
if (NULL == (e->sl_optimize = SLang_pop_function ()))
{
slfe_deallocate (e);
return NULL;
}
if (SLANG_NULL_TYPE == SLang_peek_at_stack())
SLdo_pop();
else if (NULL == (e->sl_set_options = SLang_pop_function ()))
{
slfe_deallocate (e);
return NULL;
}
if (NULL == (e->option_string = isis_make_string (eng_name)))
{
slfe_deallocate (e);
return NULL;
}
return e;
}
int Rmf_get_info (Isis_Rmf_t *rmf, Rmf_Info_Type *info) /*{{{*/
{
if ((rmf == NULL) || (info == NULL))
return -1;
info->index = rmf->index;
info->method = rmf->method;
info->order = rmf->order;
if (NULL == (info->grating = isis_make_string (rmf->grating)))
return -1;
if (NULL == (info->instrument = isis_make_string (rmf->instrument)))
return -1;
if (NULL == (info->arg_string = isis_make_string (rmf->arg_string)))
return -1;
return 0;
}
void isis_set_pager (char *pager) /*{{{*/
{
char *s;
if ((pager == NULL) || (*pager == 0))
pager = ISIS_DEFAULT_PAGER;
if (NULL == (s = isis_make_string (pager)))
return;
ISIS_FREE (Isis_Pager);
Isis_Pager = s;
}
static int rmf_load_user (Isis_Rmf_t *rmf, void *opt)
{
Isis_Rmf_Load_Method_t *load_method;
char *options;
options = (char *)opt;
if ((NULL == (load_method = get_user_rmf_load_method (options)))
|| (-1 == (*load_method)(rmf, options)))
return -1;
rmf->arg_string = isis_make_string (options); /* NULL ok */
return 0;
}
int isis_is_option_present (char *options, char *option, char **value)
{
unsigned int i, num;
Isis_Option_Type *opt;
int status;
char **option_names;
if (options == NULL)
return 0;
if (option == NULL)
return 0;
opt = isis_parse_option_string (options);
if (opt == NULL)
return -1;
option_names = opt->option_names;
num = opt->num_options;
status = 0;
for (i = 0; i < num; i++)
{
if (0 != isis_strcasecmp (option, option_names[i]))
continue;
status = 1;
if (value != NULL)
{
char *val = opt->option_values[i];
if (val != NULL)
{
if (NULL == (val = isis_make_string (val)))
status = -1;
}
*value = val;
}
break;
}
isis_free_options (opt);
return status;
}
static Isis_Fit_Statistic_Type *init_sl_statistic (void) /*{{{*/
{
SLang_Name_Type *statistic_fun, *report_fun;
Isis_Fit_Statistic_Type *s;
if (NULL == (s = (Isis_Fit_Statistic_Type *) ISIS_MALLOC (sizeof(Isis_Fit_Statistic_Type))))
return NULL;
memset ((char *)s, 0, sizeof (*s));
if (NULL == (report_fun = SLang_pop_function ()))
{
ISIS_FREE (s);
return NULL;
}
if (NULL == (statistic_fun = SLang_pop_function ()))
{
ISIS_FREE (s);
SLang_free_function (report_fun);
return NULL;
}
if (NULL == (s->symbol = isis_make_string (statistic_fun->name)))
{
ISIS_FREE(s);
SLang_free_function (report_fun);
SLang_free_function (statistic_fun);
return NULL;
}
s->compute_statistic = sl_statistic_function;
s->deallocate = sl_deallocate_function;
s->report = sl_report_function;
s->sl_fun = statistic_fun;
s->sl_report = report_fun;
return s;
}
int isis_fit_add_statistic (char *name, Isis_Fit_Statistic_Init_Type *init) /*{{{*/
{
Statistic_List_Type *s;
if ((name == NULL)
|| (init == NULL))
return -1;
if (NULL == (s = (Statistic_List_Type *) ISIS_MALLOC (sizeof *s)))
return -1;
memset ((char *)s, 0, sizeof (*s));
if (NULL == (s->sname = isis_make_string (name)))
{
free_statistic_type (s);
return -1;
}
if (NULL == (s->stat = (*init)()))
{
free_statistic_type (s);
return -1;
}
/* Keep a read-only backup copy of the s->fun pointer
* so we can temporarily over-write it and then restore
* the original (e.g. to introduce Lagrange multiplier
* constraints).
*/
s->stat->assigned_fun = s->stat->compute_statistic;
s->next = Statistic_List;
Statistic_List = s;
return 0;
}
Isis_Option_Type *isis_parse_option_string (char *str)
{
unsigned int num;
Isis_Option_Type *t;
char *estr;
if (NULL == (t = (Isis_Option_Type *) ISIS_MALLOC (sizeof(Isis_Option_Type))))
return NULL;
memset ((char *) t, 0, sizeof (Isis_Option_Type));
if (str == NULL)
str = "";
str = isis_skip_whitespace (str);
if (NULL == (str = isis_make_string (str)))
{
ISIS_FREE (t);
return NULL;
}
t->subsystem = str;
/* Now skip to the first field */
str = skip_and_truncate_field (str, FIELD_SEP_CHAR);
unescape_and_trim_string (t->subsystem);
/* Count the number of commas as an estimate on the number of fields */
/* Allow for a final NULL. */
num = 2;
estr = str;
while (NULL != (estr = strchr (estr, FIELD_SEP_CHAR)))
{
num++;
estr++;
}
if (NULL == (t->option_names = (char **) ISIS_MALLOC (num * sizeof(char *))))
{
isis_free_options (t);
return NULL;
}
if (NULL == (t->option_values = (char **) ISIS_MALLOC (num * sizeof(char *))))
{
isis_free_options (t);
return NULL;
}
/* Ok, now get the options */
num = 0;
while (1)
{
str = isis_skip_whitespace (str);
if (*str == 0)
break;
t->option_names[num] = str;
estr = skip_and_truncate_field (str, FIELD_SEP_CHAR);
/* Now look for = form */
str = skip_and_truncate_field (str, '=');
str = isis_skip_whitespace (str);
if (*str == 0)
t->option_values[num] = NULL;
else
t->option_values[num] = str;
unescape_and_trim_string (t->option_names[num]);
unescape_and_trim_string (t->option_values[num]);
str = estr;
num++;
}
t->option_values [num] = NULL;
t->option_names [num] = NULL;
t->num_options = num;
return t;
}
