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;
}
static int is_paragraph_sep(void) /*{{{*/
{
int ret;
Jed_Buffer_Hook_Type *h = CBuf->buffer_hooks;
if ((h != NULL)
&& (h->par_sep != NULL))
{
if ((-1 == SLexecute_function(h->par_sep))
|| (-1 == SLang_pop_integer(&ret)))
ret = -1;
return ret;
}
push_spot ();
(void) bol ();
jed_skip_whitespace ();
if (eolp ())
{
pop_spot ();
return 1;
}
pop_spot ();
return 0;
}
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_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_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_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_close (void) /*{{{*/
{
int status;
SLSig_Fun_Type *sig_func;
if (pli_undefined())
return -1;
if (PLI->close == NULL)
return -1;
sig_func = SLsignal (SIGSEGV, sig_segv);
if (SIG_ERR == sig_func)
fprintf (stderr, "warning: failed initializing signal handler for SIGSEGV\n");
if (-1 == SLexecute_function (PLI->close))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed closing plot device");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "function closing plot device did not return status integer");
return -1;
}
if (SLsignal (SIGSEGV, sig_func) == SIG_ERR)
fprintf (stderr, "warning: failed to re-set signal handler\n");
return status;
}
static void sl_ssl_read(void){
SLssl_Type *ssl;
SLang_MMT_Type *sslmmt;
SLang_Ref_Type *buff;
void *ibuff;
SLang_BString_Type *data;
int r, rlen;
if (SLang_pop_integer(&rlen)==-1 ||
SLang_pop_ref(&buff)==-1 ||
NULL==(sslmmt=SLang_pop_mmt(SLssl_Type_Id)))
return;
ssl=(SLssl_Type *)SLang_object_from_mmt(sslmmt);
ibuff=(void *)malloc(rlen);
r=SSL_read((SSL *)ssl->ssl,ibuff,rlen);
data=SLbstring_create((unsigned char *)ibuff,r);
SLang_assign_to_ref(buff, SLANG_BSTRING_TYPE, (VOID_STAR)&data);
if (r>=0)
SLang_push_integer(r);
else
SLang_verror(r,"SSL read returned error code %d",
SSL_get_error((SSL *)ssl->ssl,r));
SLang_free_ref(buff);
}
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;
}
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_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;
}
static int pop_4_ints (int *x1, int *x2, int *x3, int *x4)
{
if ((x4 != NULL)
&& (-1 == SLang_pop_integer (x4)))
return -1;
if ((x3 != NULL)
&& (-1 == SLang_pop_integer (x3)))
return -1;
if ((x2 != NULL)
&& (-1 == SLang_pop_integer (x2)))
return -1;
if ((x1 != NULL)
&& (-1 == SLang_pop_integer (x1)))
return -1;
return 0;
}
static int pop_string_int_int (char **s, int *a, int *b)
{
*s = NULL;
if ((-1 == SLang_pop_integer (b))
|| (-1 == pop_string_int (s, a)))
return -1;
return 0;
}
static int execute_is_ok_hook (SLang_Name_Type *hook)
{
int ret;
if (-1 == SLexecute_function (hook))
return -1;
if (-1 == SLang_pop_integer (&ret))
return -1;
return (ret != 0);
}
static int pop_string_int (char **s, int *i)
{
*s = NULL;
if ((-1 == SLang_pop_integer (i))
|| (-1 == SLang_pop_slstring (s)))
return -1;
return 0;
}
static void sl_ssl_client (void){
// create an ssl object and return the memory managed type back to
// SLang. It needs the file descriptor of the object upon which
// communication will occur, and the protocol to use.
//
SSL_CTX *ctx;
SSL *ssl;
int proto, cret;
SLang_MMT_Type *mmt, *sslmmt;
SLsslctx_Type *slctx;
char *cadir=NULL, *cafile=NULL;
if (SLang_Num_Function_Args == 3)
if (SLang_pop_slstring(&cadir) == -1)
return;
if (SLang_Num_Function_Args > 1)
if (SLANG_NULL_TYPE==SLang_peek_at_stack())
SLdo_pop();
else if (SLang_pop_slstring(&cafile) == -1)
goto free;
if (SLang_pop_integer(&proto) == -1)
goto free;
if (proto==SSL_PROTO_SSL2)
ctx = SSL_CTX_new(SSLv23_client_method());
else if (proto==SSL_PROTO_SSL3)
ctx = SSL_CTX_new(SSLv3_client_method());
else if (proto==SSL_PROTO_TLS1)
ctx = SSL_CTX_new(TLSv1_client_method());
else if (proto==SSL_PROTO_ANY)
ctx = SSL_CTX_new(SSLv23_client_method());
cret = SSL_CTX_load_verify_locations(ctx, cafile, cadir);
if (cret == 0 && SLang_Num_Function_Args > 1){
SLang_verror(SL_APPLICATION_ERROR, "Failed to load CA file or path");
goto free;
}
slctx = (SLsslctx_Type *)malloc(sizeof(SLsslctx_Type));
slctx->is_server = 0;
slctx->ctx = (void *)ctx;
sslmmt = SLang_create_mmt(SLsslctx_Type_Id, (VOID_STAR) slctx);
if (0!=SLang_push_mmt(sslmmt))
SLang_free_mmt(sslmmt);
free:
if (NULL!=cadir)
SLang_free_slstring(cadir);
if (NULL!=cafile)
SLang_free_slstring(cafile);
}
static int jed_run_hooks (char *name, int method, unsigned int argc, char **argv)
{
Hook_List_Type *l;
Hook_Type *h;
if (NULL == (l = find_hook_list (name)))
h = NULL;
else
h = l->hooks;
while (h != NULL)
{
int status;
Hook_Type *next;
if (0 == h->is_valid)
{
h = h->next;
continue;
}
lock_hook (h);
status = execute_fun_with_args (h->nt, argc, argv);
next = h->next;
release_hook (l, h);
h = next;
if (status == -1)
return -1;
if (method == JED_HOOKS_RUN_ALL)
continue;
if (-1 == SLang_pop_integer (&status))
return -1;
if (method == JED_HOOKS_RUN_UNTIL_0)
{
if (status == 0)
return 0;
continue;
}
/* else method = JED_HOOKS_RUN_UNTIL_NON_0 */
if (status)
return 1;
}
if (method == JED_HOOKS_RUN_UNTIL_0)
return 1;
return 0;
}
static int intp_pop (SLtype unused, VOID_STAR ptr)
{
int *addr;
(void) unused;
addr = *(int **)ptr;
if (addr == NULL)
{
SLang_verror (SL_VariableUninitialized_Error, "_IntegerP_Type: integer pointer address is NULL");
return -1;
}
return SLang_pop_integer (addr);
}
static void run_hooks_cmd (void)
{
unsigned int n;
SLang_Array_Type *at;
int method;
char *hook;
n = (unsigned int) SLang_Num_Function_Args;
at = NULL;
hook = NULL;
switch (n)
{
case 3:
if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE))
return;
/* drop */
case 2:
if (-1 == SLang_pop_integer (&method))
goto the_return;
if (-1 == SLang_pop_slstring (&hook))
goto the_return;
break;
default:
SLang_verror (SL_USAGE_ERROR, "usage: expecting 2 or 3 arguments");
return;
}
switch (method)
{
case JED_HOOKS_RUN_ALL:
case JED_HOOKS_RUN_UNTIL_0:
case JED_HOOKS_RUN_UNTIL_NON_0:
break;
default:
SLang_verror (SL_INVALID_PARM, "run method %d is not supported", method);
goto the_return;
}
if (at == NULL)
(void) jed_run_hooks (hook, method, 0, NULL);
else
(void) jed_run_hooks (hook, method, at->num_elements, (char **) at->data);
the_return:
SLang_free_slstring (hook);
SLang_free_array (at);
}
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 void list_pop (void)
{
int indx = 0;
SLang_List_Type *list;
if (SLang_Num_Function_Args == 2)
{
if (-1 == SLang_pop_integer (&indx))
return;
}
if (-1 == pop_list (&list))
return;
(void) list_pop_nth (list, indx);
free_list (list);
}
static int do_default_eqs (SLang_Class_Type *a_cl, VOID_STAR pa,
SLang_Class_Type *b_cl, VOID_STAR pb)
{
SLang_Class_Type *c_cl;
int (*binary_fun) (int,
SLtype, VOID_STAR, unsigned int,
SLtype, VOID_STAR, unsigned int,
VOID_STAR);
VOID_STAR pc;
int ret;
if (NULL == (binary_fun = _pSLclass_get_binary_fun (SLANG_EQ, a_cl, b_cl, &c_cl, 0)))
{
if (a_cl != b_cl)
return 0;
switch (a_cl->cl_class_type)
{
case SLANG_CLASS_TYPE_MMT:
case SLANG_CLASS_TYPE_PTR:
return (*(VOID_STAR *)pa == *(VOID_STAR *)pb);
case SLANG_CLASS_TYPE_SCALAR:
case SLANG_CLASS_TYPE_VECTOR:
return !memcmp ((char *)pa, (char *)pb, a_cl->cl_sizeof_type);
}
return 0;
}
pc = c_cl->cl_transfer_buf;
if (1 != (*binary_fun) (SLANG_EQ, a_cl->cl_data_type, pa, 1, b_cl->cl_data_type, pb, 1, pc))
return 0;
/* apush will create a copy, so make sure we free after the push */
ret = (*c_cl->cl_apush)(c_cl->cl_data_type, pc);
(*c_cl->cl_adestroy)(c_cl->cl_data_type, pc);
if (ret != 0)
return -1;
if (-1 == SLang_pop_integer (&ret))
return -1;
return (ret != 0);
}
static void list_new (void)
{
SLang_List_Type *list;
int len = DEFAULT_CHUNK_SIZE;
if (SLang_Num_Function_Args == 1)
{
if (-1 == SLang_pop_integer (&len))
return;
if (len <= 0) len = DEFAULT_CHUNK_SIZE;
}
if (NULL == (list = allocate_list (len)))
return;
(void) push_list (list, 1);
}
static int pop_insert_append_args (SLang_List_Type **listp,
SLang_Object_Type *obj, int *indx)
{
if (SLang_Num_Function_Args == 3)
{
if (-1 == SLang_pop_integer (indx))
return -1;
}
if (-1 == SLang_pop (obj))
return -1;
if (-1 == pop_list (listp))
{
SLang_free_object (obj);
return -1;
}
return 0;
}
/* usage here is a1 a2 ... an n x ==> a1x^n + a2 x ^(n - 1) + ... + an */
static double math_poly (void)
{
int n;
double xn = 1.0, sum = 0.0;
double an, x;
if ((SLang_pop_double(&x))
|| (SLang_pop_integer(&n))) return(0.0);
while (n-- > 0)
{
if (SLang_pop_double(&an)) break;
sum += an * xn;
xn = xn * x;
}
return (double) sum;
}
/* horizontal or vertical error bar */
static void _pgerrb (double *t)
{
SLang_Array_Type *x, *y, *e;
int dir;
if (-1 == pop_three_float_vectors (&x, &y, &e))
return;
if (-1 != SLang_pop_integer (&dir))
{
cpgerrb (dir, (int)x->num_elements,
(float*)x->data, (float*)y->data, (float*)e->data,
(float) *t);
}
free_arrays (x, y, e, NULL);
}
static void _pgaxis (void)
{
char *opt;
float x1, y_1, x2, y2, v1, v2, step;
int nsub;
float dmajl, dmajr, f_min, disp, orient;
if (-1 == pop_5_floats (&dmajl, &dmajr, &f_min, &disp, &orient))
return;
if (-1 == SLang_pop_integer (&nsub))
return;
if (-1 == pop_5_floats (&x2, &y2, &v1, &v2, &step))
return;
if (-1 == pop_5_floats (&x1, &y_1, NULL, NULL, NULL))
return;
if (-1 == SLang_pop_slstring (&opt))
return;
cpgaxis (opt, x1, y_1, x2, y2, v1, v2, step,
nsub, dmajl, dmajr, f_min, disp, orient);
SLang_free_slstring (opt);
}
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_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;
}
