Exemplo n.º 1
0
static int push_three_float_arrays (SLindex_Type n, float *a, float *b, float *c) /*{{{*/
{
   SLang_Array_Type *sl_a=NULL, *sl_b=NULL, *sl_c=NULL;
   int status = -1;

   if (a == NULL || b == NULL || c == NULL)
     return -1;

   if ((NULL == (sl_a = SLang_create_array (SLANG_FLOAT_TYPE, 0, NULL, &n, 1)))
       || NULL == (sl_b = SLang_create_array (SLANG_FLOAT_TYPE, 0, NULL, &n, 1))
       || NULL == (sl_c = SLang_create_array (SLANG_FLOAT_TYPE, 0, NULL, &n, 1)))
     goto return_status;

   memcpy ((char *)sl_a->data, (char *)a, n * sizeof(float));
   memcpy ((char *)sl_b->data, (char *)b, n * sizeof(float));
   memcpy ((char *)sl_c->data, (char *)c, n * sizeof(float));

   SLang_push_array (sl_a, 1);
   SLang_push_array (sl_b, 1);
   SLang_push_array (sl_c, 1);

   status = 0;
return_status:
   if (status)
     {
        SLang_free_array (sl_a);
        SLang_free_array (sl_b);
        SLang_free_array (sl_c);
     }

   return status;
}
Exemplo n.º 2
0
Arquivo: math.c Projeto: hankem/ISIS
static void _fft1d (int *isign, double *scaling) /*{{{*/
{
   SLang_Array_Type *re, *im;
   int dims;
   int ndim = 1;

   re = im = NULL;

   if (-1 == SLang_pop_array_of_type (&im, SLANG_DOUBLE_TYPE)
       || im == NULL
       || -1 == SLang_pop_array_of_type (&re, SLANG_DOUBLE_TYPE)
       || re == NULL
       || re->num_elements != im->num_elements
       || abs(*isign) != 1)
     {
        isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "invalid input to FFT");
        goto push_values;
     }

   dims = (int) re->num_elements;

   if (-1 == JDMfftn (ndim, &dims, (double *)re->data,
                      (double *)im->data, *isign, *scaling))
     isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "computing FFT");

   JDMfft_free ();

   push_values:
   (void) SLang_push_array (re, 1);
   (void) SLang_push_array (im, 1);
}
Exemplo n.º 3
0
static void read_image (int flipped)
{
   int color_type;
   char *file;
   SLang_Ref_Type *ref = NULL;
   SLang_Array_Type *at;

   if ((SLang_Num_Function_Args == 2)
       && (-1 == SLang_pop_ref (&ref)))
     return;

   if (-1 == SLang_pop_slstring (&file))
     {
	file = NULL;
	goto free_return;
     }

   if (NULL == (at = read_image_internal (file, flipped, &color_type)))
     goto free_return;

   if ((ref != NULL)
       && (-1 == SLang_assign_to_ref (ref, SLANG_INT_TYPE, &color_type)))
     {
	SLang_free_array (at);
	goto free_return;
     }

   (void) SLang_push_array (at, 1);

   free_return:
   SLang_free_slstring (file);
   if (ref != NULL)
     SLang_free_ref (ref);
}
Exemplo n.º 4
0
Arquivo: math.c Projeto: hankem/ISIS
static void lu_solve_intrin (void)
{
   Linear_System_Type t;
   SLang_Array_Type *sl_b = NULL;
   unsigned int *piv = NULL;

   if ((-1 == pop_linear_system (&t))
       || (NULL == (piv = (unsigned int *) ISIS_MALLOC (t.n * sizeof(unsigned int)))))
     {
        isis_throw_exception (Isis_Error);
        goto the_return;
     }

   if (-1 == isis_lu_solve (t.a, t.n, piv, t.b))
     goto the_return;

   sl_b = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &t.n, 1);
   if (sl_b != NULL)
     {
        memcpy ((char *)sl_b->data, (char *)t.b, t.n * sizeof (double));
     }

the_return:
   SLang_push_array (sl_b, 1);
   free_linear_system (&t);
   ISIS_FREE(piv);
}
Exemplo n.º 5
0
static int push_values_array (Values_Array_Type *av, int allow_empty_array)
{
   SLang_Array_Type *at;
   char **new_values;

   if (av->num == 0)
     {
	if (allow_empty_array == 0)
	  return SLang_push_null ();
	SLfree ((char *) av->values);
	av->values = NULL;
     }
   else
     {
	if (NULL == (new_values = (char **)SLrealloc ((char *)av->values, av->num*sizeof(char *))))
	  return -1;
	av->values = new_values;
     }

   av->num_allocated = av->num;
   at = SLang_create_array (SLANG_STRING_TYPE, 0, av->values, &av->num, 1);

   if (at == NULL)
     return -1;

   av->num_allocated = 0;
   av->num = 0;
   av->values = NULL;

   return SLang_push_array (at, 1);
}
Exemplo n.º 6
0
static void intrin_atof (void)
{
   char *s;
   SLang_Array_Type *ats;
   SLang_Array_Type *ati;
   double *ip;
   char **strp, **strpmax;

   if (-1 == pop_array_or_string (SLANG_DOUBLE_TYPE, &s, &ats, &ati))
     return;

   if (s != NULL)
     {
	(void) SLang_push_double(_pSLang_atof(s));
	SLang_free_slstring (s);
	return;
     }

   strp = (char **) ats->data;
   strpmax = strp + ats->num_elements;
   ip = (double *) ati->data;
	
   while (strp < strpmax)
     {
	if (*strp == NULL)
	  *ip++ = _pSLang_NaN;
	else
	  *ip++ = _pSLang_atof (*strp);
	strp++;
     }
   SLang_free_array (ats);
   (void) SLang_push_array (ati, 1);
}
Exemplo n.º 7
0
static int push_cols (double *d, unsigned int n, unsigned int ncols) /*{{{*/
{
   SLindex_Type nrows;
   unsigned int c;

   if ((ncols == 0) || (d == NULL))
     return -1;

   nrows = n / ncols;
   for (c = 0; c < ncols; c++)
     {
        SLang_Array_Type *at;
        unsigned int k, i;
        double *x;

        at = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &nrows, 1);
        if (at == NULL)
          return -1;

        x = (double *) at->data;

        i = 0;
        for (k = c; k < n; k += ncols)
          {
             x[i++] = d[k];
          }

        SLang_push_array (at, 1);
     }

   return 0;
}
Exemplo n.º 8
0
static void atoll_intrin (void)
{
   char *s;
   SLang_Array_Type *ats;
   SLang_Array_Type *ati;
   long long *ip;
   char **strp, **strpmax;

   if (-1 == pop_array_or_string (_pSLANG_LLONG_TYPE, &s, &ats, &ati))
     return;

   if (s != NULL)
     {
	(void) SLang_push_long_long (ATOLL_FUN(s));
	SLang_free_slstring (s);
	return;
     }

   strp = (char **) ats->data;
   strpmax = strp + ats->num_elements;
   ip = (long long *) ati->data;

   while (strp < strpmax)
     {
	if (*strp == NULL)
	  *ip++ = 0;
	else
	  *ip++ = ATOLL_FUN (*strp);
	strp++;
     }
   SLang_free_array (ats);
   (void) SLang_push_array (ati, 1);
}
Exemplo n.º 9
0
static void atoi_intrin (void)
{
   char *s;
   SLang_Array_Type *ats;
   SLang_Array_Type *ati;
   int *ip;
   char **strp, **strpmax;

   if (-1 == pop_array_or_string (SLANG_INT_TYPE, &s, &ats, &ati))
     return;

   if (s != NULL)
     {
	(void) SLang_push_integer (atoi (s));
	SLang_free_slstring (s);
	return;
     }

   strp = (char **) ats->data;
   strpmax = strp + ats->num_elements;
   ip = (int *) ati->data;
	
   while (strp < strpmax)
     {
	if (*strp == NULL)
	  *ip++ = 0;
	else
	  *ip++ = atoi (*strp);
	strp++;
     }
   SLang_free_array (ats);
   (void) SLang_push_array (ati, 1);
}
Exemplo n.º 10
0
static void get_onig_names (Name_Map_Type *map)
{
   SLindex_Type i, num;
   SLang_Array_Type *at;
   char **names;
   Name_Map_Type *table;

   table = map;
   while (table->name != NULL)
     table++;
   num = (SLindex_Type) (table - map);

   if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &num, 1)))
     return;

   table = map;
   names = (char **)at->data;
   for (i = 0; i < num; i++)
     {
	if (NULL == (names[i] = SLang_create_slstring (table->name)))
	  {
	     SLang_free_array (at);
	     return;
	  }
	table++;
     }
   (void) SLang_push_array (at, 1);
}
Exemplo n.º 11
0
static void assoc_get_keys (SLang_Assoc_Array_Type *a)
{
   SLang_Array_Type *at;
   SLindex_Type i, num;
   char **data;
   _pSLAssoc_Array_Element_Type *e, *emax;

   /* Note: If support for threads is added, then we need to modify this
    * algorithm to prevent another thread from modifying the array.
    * However, that should be handled in inner_interp.
    */
   num = a->num_occupied - a->num_deleted;

   if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &num, 1)))
     return;

   data = (char **)at->data;
   
   e = a->elements;
   emax = e + a->table_len;
   
   i = 0;
   while (e < emax)
     {
	if ((e->key != NULL) && (e->key != Deleted_Key))
	  {
	     /* Next cannot fail because it is an slstring */
	     data [i] = _pSLstring_dup_hashed_string (e->key, e->hash);
	     i++;
	  }
	e++;
     }
   (void) SLang_push_array (at, 1);
}
Exemplo n.º 12
0
static int do_binary_function (double (*f)(double, double))
{
   SLtype type;
   Array_Or_Scalar_Type a_ast, b_ast, c_ast;

   if (-1 == pop_2_arrays_or_scalar (&a_ast, &b_ast))
     return -1;

   c_ast.is_float = (a_ast.is_float && b_ast.is_float);
   c_ast.at = NULL;
   c_ast.num = 1;
   c_ast.inc = 0;
   if (c_ast.is_float)
     {
	type = SLANG_FLOAT_TYPE;
	c_ast.fptr = &c_ast.f;
     }
   else
     {
	type = SLANG_DOUBLE_TYPE;
	c_ast.dptr = &c_ast.d;
     }

   if ((a_ast.at != NULL) || (b_ast.at != NULL))
     {
	if (NULL == (c_ast.at = create_from_tmp_array (a_ast.at, b_ast.at, type)))
	  {
	     free_array_or_scalar (&a_ast);
	     free_array_or_scalar (&b_ast);
	     return -1;
	  }
	c_ast.fptr = (float *) c_ast.at->data;
	c_ast.dptr = (double *) c_ast.at->data;
	c_ast.num = c_ast.at->num_elements;
	c_ast.inc = 1;
     }

   if (a_ast.is_float)
     {
	if (b_ast.is_float)
	  (void) do_ff_fun (f, &a_ast, &b_ast, &c_ast);
	else
	  (void) do_fd_fun (f, &a_ast, &b_ast, &c_ast);
     }
   else if (b_ast.is_float)
     (void) do_df_fun (f, &a_ast, &b_ast, &c_ast);
   else
     (void) do_dd_fun (f, &a_ast, &b_ast, &c_ast);
   
   free_array_or_scalar (&a_ast);
   free_array_or_scalar (&b_ast);

   if (c_ast.at != NULL)
     return SLang_push_array (c_ast.at, 1);

   if (c_ast.is_float)
     return SLang_push_float (c_ast.f);

   return SLang_push_double (c_ast.d);
}
Exemplo n.º 13
0
Arquivo: math.c Projeto: hankem/ISIS
static void prand_array (double *rate, SLindex_Type *num) /*{{{*/
{
   SLang_Array_Type *at = NULL;
   double *ai;
   SLindex_Type i, n;

   n = *num;

   if (n == 0)
     return;
   else if (n == 1)
     {
        SLang_push_double (prand (*rate));
        return;
     }

   if (NULL == (at = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &n, 1)))
     {
        isis_vmesg (INTR, I_FAILED, __FILE__, __LINE__, "creating array of random values");
        return;
     }

   ai = (double *) at->data;
   for (i = 0; i < n; i++)
     {
        ai[i] = prand (*rate);
     }

   SLang_push_array (at, 1);
}
Exemplo n.º 14
0
Arquivo: math.c Projeto: hankem/ISIS
static void rand_array (SLindex_Type num, double (*rand_fun)(void)) /*{{{*/
{
   SLang_Array_Type *at = NULL;
   double *ad;
   SLindex_Type i;

   if (num <= 0)
     return;
   else if (num == 1)
     {
        SLang_push_double ((*rand_fun)());
        return;
     }

   if (NULL == (at = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &num, 1)))
     {
        isis_vmesg (INTR, I_FAILED, __FILE__, __LINE__, "creating array of random values");
        return;
     }

   ad = (double *) at->data;
   for (i = 0; i < num; i++)
     ad[i] = (*rand_fun) ();

   SLang_push_array (at, 1);
}
Exemplo n.º 15
0
static int do_binary_function_c (int (*f)(double, double,VOID_STAR), VOID_STAR cd)
{
   Array_Or_Scalar_Type a_ast, b_ast, c_ast;

   if (-1 == pop_2_arrays_or_scalar (&a_ast, &b_ast))
     return -1;

   c_ast.at = NULL;
   c_ast.num = 1;
   c_ast.inc = 0;
   c_ast.cptr = &c_ast.c;

   if ((a_ast.at != NULL) || (b_ast.at != NULL))
     {
	if (a_ast.at != NULL)
	  c_ast.at = SLang_create_array1 (SLANG_CHAR_TYPE, 0, NULL, a_ast.at->dims, a_ast.at->num_dims, 1);
	else
	  c_ast.at = SLang_create_array1 (SLANG_CHAR_TYPE, 0, NULL, b_ast.at->dims, b_ast.at->num_dims, 1);
	
	if (c_ast.at == NULL)
	  {
	     free_array_or_scalar (&a_ast);
	     free_array_or_scalar (&b_ast);
	     return -1;
	  }
	c_ast.cptr = (char *) c_ast.at->data;
	c_ast.num = c_ast.at->num_elements;
	c_ast.inc = 1;
     }

   if (a_ast.is_float)
     {
	if (b_ast.is_float)
	  (void) do_c_ff_fun (f, cd, &a_ast, &b_ast, &c_ast);
	else
	  (void) do_c_fd_fun (f, cd, &a_ast, &b_ast, &c_ast);
     }
   else if (b_ast.is_float)
     (void) do_c_df_fun (f, cd, &a_ast, &b_ast, &c_ast);
   else
     (void) do_c_dd_fun (f, cd, &a_ast, &b_ast, &c_ast);

   free_array_or_scalar (&a_ast);
   free_array_or_scalar (&b_ast);

   if (c_ast.at != NULL)
     return SLang_push_array (c_ast.at, 1);

   return SLang_push_char (c_ast.c);
}
Exemplo n.º 16
0
Arquivo: math.c Projeto: hankem/ISIS
static void prand_vec (void) /*{{{*/
{
   SLang_Array_Type *rate = NULL;
   double *r;
   SLindex_Type i, n;

   if (-1 == SLang_pop_array_of_type (&rate, SLANG_DOUBLE_TYPE)
       || rate == NULL)
     {
        SLang_free_array (rate); rate = NULL;
        SLang_push_array (rate, 1);
        return;
     }

   n = rate->num_elements;
   r = (double *)rate->data;

   for (i = 0; i < n; i++)
     {
        r[i] = prand (r[i]);
     }

   SLang_push_array (rate, 1);
}
static void termios_get_cc (struct termios *s)
{
    SLang_Array_Type *at;
    SLindex_Type dims = NCCS;
    int i;
    unsigned char *at_data;

    at = SLang_create_array (SLANG_UCHAR_TYPE, 0, NULL, &dims, 1);
    if (at == NULL)
        return;
    at_data = (unsigned char *) at->data;

    for (i = 0; i < NCCS; i++)
        at_data[i] = (unsigned char) s->c_cc[i];

    (void) SLang_push_array (at, 1);
}
Exemplo n.º 18
0
static void nint_intrin (void)
{
   double x;
   SLang_Array_Type *at, *bt;
   int (*at_to_int_fun)(SLang_Array_Type *, SLang_Array_Type *);

   if (SLang_peek_at_stack () != SLANG_ARRAY_TYPE)
     {
	if (-1 == SLang_pop_double (&x))
	  return;
	(void) SLang_push_int (do_nint (x));
	return;
     }
   switch (SLang_peek_at_stack1 ())
     {
      case -1:
	return;

      case SLANG_INT_TYPE:
	return;

      case SLANG_FLOAT_TYPE:
	if (-1 == SLang_pop_array_of_type (&at, SLANG_FLOAT_TYPE))
	  return;
	at_to_int_fun = float_to_nint;
	break;

      case SLANG_DOUBLE_TYPE:
      default:
	if (-1 == SLang_pop_array_of_type (&at, SLANG_DOUBLE_TYPE))
	  return;
	at_to_int_fun = double_to_nint;
	break;
     }
   
   if (NULL == (bt = SLang_create_array1 (SLANG_INT_TYPE, 0, NULL, at->dims, at->num_dims, 1)))
     {
	SLang_free_array (at);
	return;
     }
   if (0 == (*at_to_int_fun) (at, bt))
     (void) SLang_push_array (bt, 0);
   
   SLang_free_array (bt);
   SLang_free_array (at);
}
Exemplo n.º 19
0
int _pSLstring_list_push (_pSLString_List_Type *p, int delete_list)
{
   SLang_Array_Type *at;

   if ((p == NULL)
       || (p->buf == NULL))
     {
	int ret = SLang_push_null ();
	if (delete_list)
	  _pSLstring_list_delete (p);
	return ret;
     }
   
   if (NULL == (at = string_list_to_array (p, delete_list)))
     return -1;

   return SLang_push_array (at, 1);
}
Exemplo n.º 20
0
static void assoc_get_values (SLang_Assoc_Array_Type *a)
{
   SLang_Array_Type *at;
   SLindex_Type num;
   char *dest_data;
   SLtype type;
   SLang_Class_Type *cl;
   unsigned int sizeof_type;
   _pSLAssoc_Array_Element_Type *e, *emax;

   /* Note: If support for threads is added, then we need to modify this
    * algorithm to prevent another thread from modifying the array.
    * However, that should be handled in inner_interp.
    */
   num = a->num_occupied - a->num_deleted;
   type = a->type;

   cl = _pSLclass_get_class (type);
   sizeof_type = cl->cl_sizeof_type;

   if (NULL == (at = SLang_create_array (type, 0, NULL, &num, 1)))
     return;

   dest_data = (char *)at->data;

   e = a->elements;
   emax = e + a->table_len;
   
   while (e < emax)
     {
	if ((e->key != NULL) && (e->key != Deleted_Key))
	  {
	     if (-1 == transfer_element (cl, (VOID_STAR) dest_data, &e->value))
	       {
		  SLang_free_array (at);
		  return;
	       }
	     dest_data += sizeof_type;
	  }
	e++;
     }
   (void) SLang_push_array (at, 1);
}
Exemplo n.º 21
0
static void intrin_apropos (void)
{
   int num_args;
   char *pat;
   char *namespace_name;
   unsigned int flags;
   SLang_Array_Type *at;

   num_args = SLang_Num_Function_Args;

   if (-1 == SLang_pop_uinteger (&flags))
     return;
   if (-1 == SLang_pop_slstring (&pat))
     return;
   
   namespace_name = NULL;
   at = NULL;
   if (num_args == 3)
     {
	if (-1 == SLang_pop_slstring (&namespace_name))
	  goto free_and_return;
     }

   at = _pSLang_apropos (namespace_name, pat, flags);
   if (num_args == 3)
     {
	(void) SLang_push_array (at, 0);
	goto free_and_return;
     }

   /* Maintain compatibility with old version of the function.  That version
    * did not take three arguments and returned everything to the stack.
    * Yuk.
    */
   (void) push_string_array_elements (at);

   free_and_return:
   /* NULLs ok */
   SLang_free_slstring (namespace_name);
   SLang_free_slstring (pat);
   SLang_free_array (at);
}
Exemplo n.º 22
0
static void nth_match (Onig_Type *o, int *np)
{
   unsigned int start, stop;
   SLang_Array_Type *at;
   SLindex_Type two = 2;
   int *data;

   if (-1 == get_nth_start_stop (o, (unsigned int) *np, &start, &stop))
     {
	SLang_push_null ();
	return;
     }

   if (NULL == (at = SLang_create_array (SLANG_INT_TYPE, 0, NULL, &two, 1)))
     return;

   data = (int *)at->data;
   data[0] = (int)start;
   data[1] = (int)stop;
   (void) SLang_push_array (at, 1);
}
Exemplo n.º 23
0
static int push_c_string_array (char **argv, int argc)
{
   SLang_Array_Type *at;
   char **strs;
   int i;

   if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 1, NULL, &argc, 1)))
     return -1;
   
   strs = (char **) at->data;
   for (i = 0; i < argc; i++)
     {
	if (NULL == (strs[i] = SLang_create_slstring (argv[i])))
	  {
	     SLang_free_array (at);
	     return -1;
	  }
     }
   
   return SLang_push_array (at, 1);
}
Exemplo n.º 24
0
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;
}
Exemplo n.º 25
0
static void sl_ssl_get_cert(void){
  SLssl_Type *ssl;
  SLang_MMT_Type *sslmmt;
  STACK_OF(X509) *cert;
  unsigned char **buf;
  SLang_BString_Type **certout;
  SLang_Array_Type *arr;
  SLindex_Type nelem;
  int len,i;

  if (NULL==(sslmmt=SLang_pop_mmt(SLssl_Type_Id)))
    return;

  ssl=(SLssl_Type *)SLang_object_from_mmt(sslmmt);

  cert=SSL_get_peer_cert_chain((SSL *)ssl->ssl);

  if (cert==NULL)
    return NULL;

  nelem=(SLindex_Type)sk_X509_num(cert);
  // now we have chain of certs, create array of pointers and the
  // array to hold them
  buf = (unsigned char **)malloc(nelem*sizeof(unsigned char *));
  arr = SLang_create_array(SLANG_BSTRING_TYPE,0,NULL,&nelem,1);
  // array data structure is of bstring type
  certout = (SLang_BString_Type **)arr->data;
  
  for (i=0;i<nelem;i++){
    buf[i] = NULL;
    len = i2d_X509(sk_X509_value(cert,i), &(buf[i]));
    certout[i] = SLbstring_create(buf[i],len);
  }
  
  SLang_push_array(arr,1);
  // free the X509 stack
  sk_X509_pop_free(cert,X509_free);
}
Exemplo n.º 26
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;
}
Exemplo n.º 27
0
static void rline_get_history_intrinsic (void)
{
   SLindex_Type i, num;
   RL_History_Type *h;
   char **data;
   SLang_Array_Type *at;
   
   if (Active_Rline_Info == NULL)
     {
	SLang_push_null ();
	return;
     }
   
   num = 0;
   h = Active_Rline_Info->root;
   while (h != NULL)
     {
	h = h->next;
	num++;
     }
   if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &num, 1)))
     return;

   data = (char **)at->data;
   h = Active_Rline_Info->root;
   for (i = 0; i < num; i++)
     {
	if (NULL == (data[i] = SLang_create_slstring (h->buf)))
	  {
	     SLang_free_array (at);
	     return;
	  }
	h = h->next;
     }
   
   (void) SLang_push_array (at, 1);
}
Exemplo n.º 28
0
Arquivo: math.c Projeto: hankem/ISIS
static void svd_solve_intrin (void)
{
   Linear_System_Type t;
   SLang_Array_Type *sl_b = NULL;

   if (-1 == pop_linear_system (&t))
     {
        isis_throw_exception (Isis_Error);
        goto the_return;
     }

   if (-1 == isis_svd_solve (t.a, t.n, t.b))
     goto the_return;

   sl_b = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &t.n, 1);
   if (sl_b != NULL)
     {
        memcpy ((char *)sl_b->data, (char *)t.b, t.n * sizeof (double));
     }

the_return:
   SLang_push_array (sl_b, 1);
   free_linear_system (&t);
}
Exemplo n.º 29
0
static void intrin_get_namespaces (void)
{
   SLang_push_array (_pSLns_list_namespaces (), 1);
}
Exemplo n.º 30
0
Arquivo: math.c Projeto: hankem/ISIS
static void make_2d_histogram (int *reverse) /*{{{*/
{
   SLang_Array_Type *grid_x, *grid_y, *sl_x, *sl_y, *b;
   SLang_Array_Type *rev;
   double *x, *y, *bx, *by;
   double xmax, ymax;
   SLindex_Type *num;
   SLindex_Type dims[2];
   SLindex_Type i, n, nx, ny, nbins;
   SLindex_Type *r = NULL;

   grid_x = grid_y = sl_x = sl_y = b = rev = NULL;

   if (-1 == pop_two_darrays (&grid_x, &grid_y))
     goto push_result;

   /* need at least 1 point */
   if ((-1 == pop_two_darrays (&sl_x, &sl_y))
       || (sl_x->num_elements != sl_y->num_elements)
       || (sl_x->num_elements < 1))
     goto push_result;

   n = sl_x->num_elements;
   nx = grid_x->num_elements;
   ny = grid_y->num_elements;

   if (*reverse == 0)
     r = NULL;
   else
     {
        if (NULL == (r = (SLindex_Type *) ISIS_MALLOC (n * sizeof (SLindex_Type))))
          {
             isis_throw_exception (Isis_Error);
             goto push_result;
          }
        for (i = 0; i < n; i++)
          {
             r[i] = -1;
          }
     }

   dims[0] = nx;
   dims[1] = ny;
   nbins = dims[0] * dims[1];
   if (NULL == (b = SLang_create_array (SLANG_INT_TYPE, 0, NULL, dims, 2)))
     {
        isis_throw_exception (Isis_Error);
        goto push_result;
     }

   num = (SLindex_Type *)b->data;
   memset ((char *)num, 0, nbins * sizeof(SLindex_Type));

   bx = (double *)sl_x->data;
   by = (double *)sl_y->data;
   x = (double *)grid_x->data;
   y = (double *)grid_y->data;

   xmax = x[nx-1];
   ymax = y[ny-1];

   for (i = 0; i < n; i++)
     {
        double b_x = bx[i];
        double b_y = by[i];
        SLindex_Type ix, iy, k;

        if (b_x >= xmax)
          ix = nx-1;
        else if ((ix = find_bin (b_x, x, x+1, nx-1)) < 0)
          continue;

        if (b_y >= ymax)
          iy = ny-1;
        else if ((iy = find_bin (b_y, y, y+1, ny-1)) < 0)
          continue;

        k = iy + ny * ix;

        num[k] += 1;
        if (r != NULL) r[i] = k;
     }

   if ((r != NULL)
       && (NULL == (rev = convert_reverse_indices (r, n, nx*ny))))
     goto push_result;

   push_result:

   SLang_free_array (sl_x);
   SLang_free_array (sl_y);
   SLang_free_array (grid_x);
   SLang_free_array (grid_y);

   ISIS_FREE(r);

   SLang_push_array (b, 1);
   SLang_push_array (rev, 1);
}