/* -*- mode: C; mode: fold; -*- */
/*
  Copyright (c) 2003, 2004, 2005 Massachusetts Institute of Technology

  This software was developed by the MIT Center for Space Research
  under contract SV1-61010 from the Smithsonian Institution.

  Permission to use, copy, modify, distribute, and sell this software
  and its documentation for any purpose is hereby granted without fee,
  provided that the above copyright notice appear in all copies and
  that both that copyright notice and this permission notice appear in
  the supporting documentation, and that the name of the Massachusetts
  Institute of Technology not be used in advertising or publicity
  pertaining to distribution of the software without specific, written
  prior permission.  The Massachusetts Institute of Technology makes
  no representations about the suitability of this software for any
  purpose.  It is provided "as is" without express or implied warranty.

  THE MASSACHUSETTS INSTITUTE OF TECHNOLOGY DISCLAIMS ALL WARRANTIES
  WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
  MERCHANTABILITY AND FITNESS.  IN NO EVENT SHALL THE MASSACHUSETTS
  INSTITUTE OF TECHNOLOGY BE LIABLE FOR ANY SPECIAL, INDIRECT OR
  CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
  OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
  NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
  WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*/

/* Author: John E. Davis (jed@jedsoft.org) */

#include <stdio.h>
#include <slang.h>

#include <gsl/gsl_errno.h>
#include <gsl/gsl_version.h>

#include "slgsl.h"
#include "version.h"

#ifdef __cplusplus
extern "C" {
#endif

SLANG_MODULE(gslcore);

#ifdef __cplusplus
}
#endif

/*{{{ Error Handling Routines */

#define MAX_ERRNO 128
#define SIZEOF_BITMAP (8 * sizeof(long))
#define NUM_BITMAPS (MAX_ERRNO/SIZEOF_BITMAP)

typedef struct
{
   unsigned long error;
   unsigned long warn;
   unsigned long ignore;
   SLang_Name_Type *callbacks[SIZEOF_BITMAP];
}
Error_Bitmap_Type;

static Error_Bitmap_Type Pos_Error_Bitmaps[NUM_BITMAPS];
static Error_Bitmap_Type Neg_Error_Bitmaps[NUM_BITMAPS];

static unsigned long Num_Errors;

void slgsl_reset_errors (void)
{
   unsigned int i;

   for (i = 0; i < NUM_BITMAPS; i++)
     {
	Pos_Error_Bitmaps[i].error = 0;
	Neg_Error_Bitmaps[i].error = 0;
     }
   Num_Errors = 0;
}

static void do_bitmap (char *func, Error_Bitmap_Type *bitmaps, int dir)
{
   unsigned int b;

   for (b = 0; b < NUM_BITMAPS; b++)
     {
	unsigned long e_bitmap = bitmaps[b].error;
	unsigned long w_bitmap = bitmaps[b].warn;
	SLang_Name_Type **callbacks = bitmaps[b].callbacks;
	unsigned int i = b * SIZEOF_BITMAP;

	while (e_bitmap)
	  {
	     if (e_bitmap & 1)
	       {
		  int gsl_errno = dir * (b * SIZEOF_BITMAP + i);

		  if (callbacks[i] != NULL)
		    {
		       if ((-1 == SLang_start_arg_list ())
			   || (-1 == SLang_push_string (func))
			   || (-1 == SLang_push_integer (gsl_errno))
			   || (-1 == SLang_start_arg_list ())
			   || (-1 == SLexecute_function (callbacks[i])))
			 return;
		    }
		  else if (w_bitmap & 1)
		    SLang_vmessage ("*** Warning: %s: %s\r\n", func, gsl_strerror (gsl_errno));
		  else
		    SLang_verror (SL_INTRINSIC_ERROR, "%s: %s", func, gsl_strerror (gsl_errno));
	       }

	     e_bitmap = e_bitmap >> 1;
	     w_bitmap = w_bitmap >> 1;
	     i++;
	  }
     }
}

void slgsl_check_errors (const char *funct)
{
   if (Num_Errors == 0)
     return;

   do_bitmap (funct, Pos_Error_Bitmaps, 1);
   do_bitmap (funct, Neg_Error_Bitmaps, -1);

   Num_Errors = 0;
}

static Error_Bitmap_Type *find_bitmap (int gsl_errno, int slerr,
				       unsigned long *mask,
				       unsigned int *ofsp)
{
   Error_Bitmap_Type *bitmaps;
   int ofs;

   if (gsl_errno > 0)
     bitmaps = Pos_Error_Bitmaps;
   else
     {
	bitmaps = Neg_Error_Bitmaps;
	gsl_errno = -gsl_errno;
     }

   if (gsl_errno >= MAX_ERRNO)
     {
	SLang_verror (slerr, "GLS errno (%d) is larger than supported value (%d)\n",
		      gsl_errno, MAX_ERRNO-1);
	return NULL;
     }

   bitmaps += gsl_errno/SIZEOF_BITMAP;
   ofs = gsl_errno % SIZEOF_BITMAP;

   *mask = (1L << ofs);

   if (ofsp != NULL)
     *ofsp = (unsigned int)ofs;

   return bitmaps;
}

static void err_handler (const char * reason,
			 const char * file,
			 int line,
			 int gsl_errno)
{
   Error_Bitmap_Type *bitmap;
   unsigned long mask;

   (void) reason;
   (void) file;
   (void) line;

   if (gsl_errno == 0)
     return;

   if (NULL == (bitmap = find_bitmap (gsl_errno, SL_APPLICATION_ERROR, &mask, NULL)))
     {
	Num_Errors++;
	return;
     }

   if (bitmap->ignore & mask)
     return;

   bitmap->error |= mask;
   Num_Errors++;
}

static int set_gsl_error_disposition (int gsl_errno, int how,
				      SLang_Name_Type *callback)
{
   Error_Bitmap_Type *bitmap;
   unsigned long mask;
   unsigned int ofs;

   if (NULL == (bitmap = find_bitmap (gsl_errno, SL_INVALID_PARM, &mask, &ofs)))
     return -1;

   bitmap->ignore &= ~mask;
   bitmap->warn &= ~mask;

   SLang_free_function (bitmap->callbacks[ofs]);   /* NULL ok */

   if (NULL != (bitmap->callbacks[ofs] = callback))
     return -1;

   if (how == 0)
     bitmap->ignore |= mask;
   else if (how == 1)
     bitmap->warn |= mask;

   return 0;
}

static void set_error_disposition (void)
{
   int gsl_errno;
   int how = 0;
   SLang_Name_Type *callback = NULL;

   if (SLang_peek_at_stack () == SLANG_INT_TYPE)
     {
	if (-1 == SLang_pop_integer (&how))
	  return;
     }
   else if (NULL == (callback = SLang_pop_function ()))
     return;

   if ((-1 == SLang_pop_integer (&gsl_errno))
       || (-1 == set_gsl_error_disposition (gsl_errno, how, callback)))
     SLang_free_function (callback);/* NULL ok */
}

/*}}}*/

/*{{{ Array popping routines */

static int pop_array (SLang_Array_Type **atp, SLtype type, unsigned int ndims)
{
   SLang_Array_Type *at;

   *atp = 0;

   if (-1 == SLang_pop_array_of_type (&at, type))
     return -1;

   if (at->num_dims != ndims)
     {
	SLang_verror (SL_INVALID_PARM, "Context requires a %d-d array", ndims);
	SLang_free_array (at);
	return -1;
     }
   *atp = at;
   return 0;
}

void slgsl_free_d_array (SLGSL_Double_Array_Type *a)
{
   if (a->at != NULL)
     SLang_free_array (a->at);
}

int slgsl_push_d_array (SLGSL_Double_Array_Type *a, int do_free)
{
   if (a->at != NULL)
     return SLang_push_array (a->at, do_free);

   return SLang_push_double (a->x);
}

void slgsl_free_i_array (SLGSL_Int_Array_Type *a)
{
   if (a->at != NULL)
     SLang_free_array (a->at);
}

int slgsl_push_i_array (SLGSL_Int_Array_Type *a, int do_free)
{
   if (a->at != NULL)
     return SLang_push_array (a->at, do_free);

   return SLang_push_integer (a->x);
}

int slgsl_create_d_array (SLGSL_Double_Array_Type *a, SLGSL_Double_Array_Type *b)
{
   if (a->at != NULL)
     {
	if (NULL == (b->at = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, a->at->dims, a->at->num_dims)))
	  return -1;
	b->xp = (double *)b->at->data;
	b->num_elements = b->at->num_elements;
	b->inc = 1;
	return 0;
     }
   b->inc = 0;
   b->xp = &b->x;
   b->num_elements = 1;
   b->at = NULL;
   return 0;
}

int slgsl_pop_d_array (SLGSL_Double_Array_Type *a, int array_required)
{
   if (array_required
       || (SLang_peek_at_stack () == SLANG_ARRAY_TYPE))
     {
	if (-1 == SLang_pop_array_of_type (&a->at, SLANG_DOUBLE_TYPE))
	  return -1;
	a->xp = (double *) a->at->data;
	a->inc = 1;
	a->num_elements = a->at->num_elements;
	return 0;
     }

   a->at = NULL;
   a->xp = &a->x;
   a->inc = 0;
   a->num_elements = 1;
#if SLANG_VERSION < 20000
   return SLang_pop_double (a->xp, NULL, NULL);
#else
   return SLang_pop_double (a->xp);
#endif
}

/* Complex wrappers */
void slgsl_free_c_array (SLGSL_Complex_Array_Type *a)
{
   if (a->at != NULL)
     SLang_free_array (a->at);
}

int slgsl_push_c_array (SLGSL_Complex_Array_Type *a, int do_free)
{
   if (a->at != NULL)
     return SLang_push_array (a->at, do_free);

   return SLang_push_complex (a->x[0], a->x[1]);
}

int slgsl_create_c_array (SLGSL_Complex_Array_Type *a, SLGSL_Complex_Array_Type *b)
{
   if (a->at != NULL)
     {
	if (NULL == (b->at = SLang_create_array (SLANG_COMPLEX_TYPE, 0, NULL, a->at->dims, a->at->num_dims)))
	  return -1;
	b->xp = (double *)b->at->data;
	b->num_elements = b->at->num_elements;
	b->inc = 1;
	return 0;
     }
   b->inc = 0;
   b->xp = &b->x;
   b->num_elements = 1;
   b->at = NULL;
   return 0;
}

int slgsl_pop_c_array (SLGSL_Complex_Array_Type *a, int array_required)
{
   if (array_required
       || (SLang_peek_at_stack () == SLANG_ARRAY_TYPE))
     {
	if (-1 == SLang_pop_array_of_type (&a->at, SLANG_COMPLEX_TYPE))
	  return -1;
	a->xp = (double *) a->at->data;
	a->inc = 1;
	a->num_elements = a->at->num_elements;
	return 0;
     }

   a->at = NULL;
   a->xp = a->x;
   a->inc = 0;
   a->num_elements = 1;

   return SLang_pop_complex (&a->x[0], &a->x[1]);
}

int slgsl_pop_i_array (SLGSL_Int_Array_Type *a, int array_required)
{
   if (array_required
       || (SLang_peek_at_stack () == SLANG_ARRAY_TYPE))
     {
	if (-1 == SLang_pop_array_of_type (&a->at, SLANG_INT_TYPE))
	  return -1;
	a->xp = (int *) a->at->data;
	a->inc = 1;
	a->num_elements = a->at->num_elements;
	return 0;
     }

   a->at = NULL;
   a->xp = &a->x;
   a->inc = 0;
   a->num_elements = 1;
   return SLang_pop_integer (a->xp);
}

int slgsl_pop_dd_array (SLGSL_Double_Array_Type *a, SLGSL_Double_Array_Type *b,
			int array_required)
{
   if (-1 == slgsl_pop_d_array (b, array_required))
     return -1;

   if (-1 == slgsl_pop_d_array (a, array_required))
     return -1;

   if ((a->at != NULL) && (b->at != NULL)
       && (a->num_elements != b->num_elements))
     {
	SLang_verror (SL_TYPE_MISMATCH, "This function requires arrays of the same size");
	SLang_free_array (a->at);
	SLang_free_array (b->at);
	return -1;
     }
   return 0;
}

int slgsl_pop_id_array (SLGSL_Int_Array_Type *a, SLGSL_Double_Array_Type *b,
			int array_required)
{
   if (-1 == slgsl_pop_d_array (b, array_required))
     return -1;

   if (-1 == slgsl_pop_i_array (a, array_required))
     return -1;

   if ((a->at != NULL) && (b->at != NULL)
       && (a->num_elements != b->num_elements))
     {
	SLang_verror (SL_TYPE_MISMATCH, "This function requires arrays of the same size");
	SLang_free_array (a->at);
	SLang_free_array (b->at);
	return -1;
     }
   return 0;
}

int slgsl_pop_idd_array (SLGSL_Int_Array_Type *a, SLGSL_Double_Array_Type *b, SLGSL_Double_Array_Type *c,
			 int array_required)
{
   if (-1 == slgsl_pop_dd_array (b, c, array_required))
     return -1;

   if (-1 == slgsl_pop_i_array (a, array_required))
     return -1;

   if (a->at != NULL)
     {
	if (((b->at != NULL) && (a->num_elements != b->num_elements))
	    || ((c->at != NULL) && (a->num_elements != c->num_elements)))
	  {
	     SLang_verror (SL_TYPE_MISMATCH, "This function requires arrays of the same size");
	     SLang_free_array (a->at);
	     SLang_free_array (b->at);
	     SLang_free_array (c->at);
	     return -1;
	  }
     }
   return 0;
}

int slgsl_pop_iid_array (SLGSL_Int_Array_Type *a, SLGSL_Int_Array_Type *b, SLGSL_Double_Array_Type *c,
			 int array_required)
{
   if (-1 == slgsl_pop_id_array (b, c, array_required))
     return -1;

   if (-1 == slgsl_pop_i_array (a, array_required))
     return -1;

   if (a->at != NULL)
     {
	if (((b->at != NULL) && (a->num_elements != b->num_elements))
	    || ((c->at != NULL) && (a->num_elements != c->num_elements)))
	  {
	     SLang_verror (SL_TYPE_MISMATCH, "This function requires arrays of the same size");
	     SLang_free_array (a->at);
	     SLang_free_array (b->at);
	     SLang_free_array (c->at);
	     return -1;
	  }
     }
   return 0;
}

int slgsl_pop_iidd_array (SLGSL_Int_Array_Type *a, SLGSL_Int_Array_Type *b,
			  SLGSL_Double_Array_Type *c, SLGSL_Double_Array_Type *d,
			  int array_required)
{
   if (-1 == slgsl_pop_idd_array (b, c, d, array_required))
     return -1;

   if (-1 == slgsl_pop_i_array (a, array_required))
     return -1;

   if (a->at != NULL)
     {
	if (((b->at != NULL) && (a->at->num_elements != b->at->num_elements))
	    || ((c->at != NULL) && (a->at->num_elements != c->at->num_elements))
	    || ((d->at != NULL) && (a->at->num_elements != d->at->num_elements)))
	  {
	     SLang_verror (SL_TYPE_MISMATCH, "This function requires arrays of the same size");
	     SLang_free_array (a->at);
	     SLang_free_array (b->at);
	     SLang_free_array (c->at);
	     SLang_free_array (d->at);
	     return -1;
	  }
     }
   return 0;
}

int slgsl_pop_ddd_array (SLGSL_Double_Array_Type *a, SLGSL_Double_Array_Type *b, SLGSL_Double_Array_Type *c,
			 int array_required)
{
   if (-1 == slgsl_pop_dd_array (b, c, array_required))
     return -1;

   if (-1 == slgsl_pop_d_array (a, array_required))
     return -1;

   if (a->at != NULL)
     {
	if (((b->at != NULL) && (a->num_elements != b->num_elements))
	    || ((c->at != NULL) && (a->num_elements != c->num_elements)))
	  {
	     SLang_verror (SL_TYPE_MISMATCH, "This function requires arrays of the same size");
	     SLang_free_array (a->at);
	     SLang_free_array (b->at);
	     SLang_free_array (c->at);
	     return -1;
	  }
     }
   return 0;
}

int slgsl_pop_dddd_array (SLGSL_Double_Array_Type *a, SLGSL_Double_Array_Type *b,
			  SLGSL_Double_Array_Type *c, SLGSL_Double_Array_Type *d,
			  int array_required)
{
   if (-1 == slgsl_pop_ddd_array (b, c, d, array_required))
     return -1;

   if (-1 == slgsl_pop_d_array (a, array_required))
     return -1;

   if (a->at != NULL)
     {
	if (((b->at != NULL) && (a->num_elements != b->num_elements))
	    || ((c->at != NULL) && (a->num_elements != c->num_elements))
	    || ((d->at != NULL) && (a->num_elements != d->num_elements)))
	  {
	     SLang_verror (SL_TYPE_MISMATCH, "This function requires arrays of the same size");
	     SLang_free_array (a->at);
	     SLang_free_array (b->at);
	     SLang_free_array (c->at);
	     SLang_free_array (d->at);
	     return -1;
	  }
     }
   return 0;
}

/*}}}*/

/*{{{ Utility functions for GLS Vector/Matrix types */

static void free_double_matrix (SLGSL_Matrix_Type *matrix)
{
   if (matrix->at != NULL)
     SLang_free_array (matrix->at);
   else if (matrix->m.d.data != NULL)
     SLfree ((char *) matrix->m.d.data);
}

static int push_double_matrix (SLGSL_Matrix_Type *matrix)
{
   SLang_Array_Type *at;
   SLtype type;
   gsl_matrix *m;
   SLindex_Type dims[2];
   double *data;

   if (NULL != (at = matrix->at))
     return SLang_push_array (at, 0);

   m = &matrix->m.d;
   type = SLANG_DOUBLE_TYPE;
   data = m->data;

   dims[0] = m->size1;
   dims[1] = m->size2;
   at = SLang_create_array (type, 0, data, dims, 2);
   if (at == NULL)
     return -1;

   /* stealing the data array */
   m->data = NULL;

   return SLang_push_array (at, 1);
}

static int init_double_matrix (SLGSL_Matrix_Type *matrix,
			       unsigned int n0, unsigned int n1,
			       int copy, SLang_Array_Type *at)
{
   gsl_matrix *m;

   m = &matrix->m.d;

   matrix->size1 = m->size1 = n0;
   matrix->size2 = m->size2 = n1;
   m->tda = n1;
   m->owner = 0;

   if ((at != NULL) && (copy == 0))
     {
	m->data = (double *) at->data;
	matrix->at = at;
     }
   else
     {
	unsigned int nbytes = n0*n1*sizeof(double);
	if (NULL == (m->data = (double *)SLmalloc (nbytes)))
	  return -1;
	if (at != NULL)
	  memcpy ((char *)m->data, (char *)at->data, nbytes);
	matrix->at = NULL;
     }
   matrix->is_complex = 0;
   matrix->free_method = free_double_matrix;
   matrix->push_method = push_double_matrix;
   return 0;
}

static void free_complex_matrix (SLGSL_Matrix_Type *matrix)
{
   if (matrix->at != NULL)
     SLang_free_array (matrix->at);
   else if (matrix->m.c.data != NULL)
     SLfree ((char *) matrix->m.c.data);
}

static int push_complex_matrix (SLGSL_Matrix_Type *matrix)
{
   SLang_Array_Type *at;
   SLtype type;
   gsl_matrix_complex *c;
   SLindex_Type dims[2];
   double *data;

   if (NULL != (at = matrix->at))
     return SLang_push_array (at, 0);

   c = &matrix->m.c;
   type = SLANG_COMPLEX_TYPE;
   data = c->data;

   dims[0] = c->size1;
   dims[1] = c->size2;
   at = SLang_create_array (type, 0, data, dims, 2);
   if (at == NULL)
     return -1;

   /* stealing the data array */
   c->data = NULL;

   return SLang_push_array (at, 1);
}

static int init_complex_matrix (SLGSL_Matrix_Type *matrix,
				unsigned int n0, unsigned int n1,
				int copy, SLang_Array_Type *at)
{
   gsl_matrix_complex *c;

   c = &matrix->m.c;

   matrix->size1 = c->size1 = n0;
   matrix->size2 = c->size2 = n1;
   c->tda = n1;
   c->owner = 0;

   if ((at != NULL) && (copy == 0))
     {
	c->data = (double *) at->data;
	matrix->at = at;
     }
   else
     {
	unsigned int nbytes = 2*n0*n1*sizeof(double);
	if (NULL == (c->data = (double *)SLmalloc (nbytes)))
	  return -1;
	if (at != NULL)
	  memcpy ((char *)c->data, (char *)at->data, nbytes);
	matrix->at = NULL;
     }

   matrix->is_complex = 1;
   matrix->free_method = free_complex_matrix;
   matrix->push_method = push_complex_matrix;
   return 0;
}

void slgsl_free_matrix (SLGSL_Matrix_Type *matrix)
{
   if (matrix == NULL)
     return;

   (*matrix->free_method)(matrix);
   SLfree ((char *)matrix);
}

SLGSL_Matrix_Type *slgsl_new_matrix (SLtype type, unsigned int n0, unsigned int n1,
				int copy, SLang_Array_Type *at)
{
   SLGSL_Matrix_Type *matrix;
   int status;

   if (NULL == (matrix = (SLGSL_Matrix_Type *)SLcalloc (1, sizeof (SLGSL_Matrix_Type))))
     return NULL;

   if (type == SLANG_COMPLEX_TYPE)
     status = init_complex_matrix (matrix, n0, n1, copy, at);
   else
     status = init_double_matrix (matrix, n0, n1, copy, at);

   if (status == -1)
     {
	SLfree ((char *) matrix);
	return NULL;
     }
   return matrix;
}

int slgsl_push_matrix (SLGSL_Matrix_Type *matrix)
{
   return (*matrix->push_method)(matrix);
}

int slgsl_pop_matrix (SLGSL_Matrix_Type **matrixp, SLtype type, int copy)
{
   SLang_Array_Type *at;
   SLGSL_Matrix_Type *matrix;

   *matrixp = NULL;
   if (-1 == pop_array (&at, type, 2))
     return -1;

   if (NULL == (matrix = new_matrix (type, at->dims[0], at->dims[1], copy, at)))
     {
	SLang_free_array (at);
	return -1;
     }

   if (copy)
     SLang_free_array (at);

   *matrixp = matrix;
   return 0;
}

int slgsl_pop_square_matrix (SLGSL_Matrix_Type **matrixp, SLtype type, int copy)
{
   SLGSL_Matrix_Type *matrix;

   if (-1 == pop_matrix (&matrix, type, copy))
     {
	*matrixp = NULL;
	return -1;
     }

   if (matrix->size1 != matrix->size2)
     {
	SLang_verror (SL_INVALID_PARM, "Expecting a square matrix");
	free_matrix (matrix);
	return -1;
     }

   *matrixp = matrix;
   return 0;
}

/* Functions to create/destroy vectors */
static void free_double_vector (SLGSL_Vector_Type *vector)
{
   if (vector->at != NULL)
     SLang_free_array (vector->at);
   else if (vector->v.d.data != NULL)
     SLfree ((char *) vector->v.d.data);
}

static int push_double_vector (SLGSL_Vector_Type *vector)
{
   SLang_Array_Type *at;
   SLtype type;
   gsl_vector *v;
   SLindex_Type dims[1];
   double *data;

   if (NULL != (at = vector->at))
     return SLang_push_array (at, 0);

   v = &vector->v.d;
   type = SLANG_DOUBLE_TYPE;
   data = v->data;

   dims[0] = v->size;
   at = SLang_create_array (type, 0, data, dims, 1);
   if (at == NULL)
     return -1;

   /* stealing the data array */
   v->data = NULL;

   return SLang_push_array (at, 1);
}

static int init_double_vector (SLGSL_Vector_Type *vector, unsigned int n,
			       int copy, SLang_Array_Type *at)
{
   gsl_vector *v;

   v = &vector->v.d;

   vector->size = v->size = n;
   v->stride = 1;
   v->owner = 0;

   if ((at != NULL) && (copy == 0))
     {
	v->data = (double *) at->data;
	vector->at = at;
     }
   else
     {
	unsigned int nbytes = n*sizeof(double);
	if (NULL == (v->data = (double *)SLmalloc (nbytes)))
	  return -1;
	if (at != NULL)
	  memcpy ((char *)v->data, (char *)at->data, nbytes);
	vector->at = NULL;
     }
   vector->is_complex = 0;
   vector->free_method = free_double_vector;
   vector->push_method = push_double_vector;
   return 0;
}

static void free_complex_vector (SLGSL_Vector_Type *vector)
{
   if (vector->at != NULL)
     SLang_free_array (vector->at);
   else if (vector->v.c.data != NULL)
     SLfree ((char *) vector->v.c.data);
}

static int push_complex_vector (SLGSL_Vector_Type *vector)
{
   SLang_Array_Type *at;
   SLtype type;
   gsl_vector_complex *v;
   SLindex_Type dims[1];
   double *data;

   if (NULL != (at = vector->at))
     return SLang_push_array (at, 0);

   v = &vector->v.c;
   type = SLANG_COMPLEX_TYPE;
   data = v->data;

   dims[0] = v->size;
   at = SLang_create_array (type, 0, data, dims, 1);
   if (at == NULL)
     return -1;

   /* stealing the data array */
   v->data = NULL;

   return SLang_push_array (at, 1);
}

static int init_complex_vector (SLGSL_Vector_Type *vector, unsigned int n,
				int copy, SLang_Array_Type *at)
{
   gsl_vector_complex *v;

   v = &vector->v.c;

   vector->size = v->size = n;
   v->stride = 1;
   v->owner = 0;

   if ((at != NULL) && (copy == 0))
     {
	v->data = (double *) at->data;
	vector->at = at;
     }
   else
     {
	unsigned int nbytes = 2*n*sizeof(double);
	if (NULL == (v->data = (double *)SLmalloc (nbytes)))
	  return -1;
	if (at != NULL)
	  memcpy ((char *)v->data, (char *)at->data, nbytes);
	vector->at = NULL;
     }
   vector->is_complex = 0;
   vector->free_method = free_complex_vector;
   vector->push_method = push_complex_vector;
   return 0;
}

void slgsl_free_vector (SLGSL_Vector_Type *vector)
{
   if (vector == NULL)
     return;
   (*vector->free_method)(vector);
   SLfree ((char *)vector);
}

SLGSL_Vector_Type *slgsl_new_vector (SLtype type, unsigned int n,
			       int copy, SLang_Array_Type *at)
{
   SLGSL_Vector_Type *vector;
   int status;

   if (NULL == (vector = (SLGSL_Vector_Type *)SLcalloc (1, sizeof (SLGSL_Vector_Type))))
     return NULL;

   if (type == SLANG_COMPLEX_TYPE)
     status = init_complex_vector (vector, n, copy, at);
   else
     status = init_double_vector (vector, n, copy, at);

   if (status == -1)
     {
	SLfree ((char *) vector);
	return NULL;
     }

   return vector;
}

int slgsl_push_vector (SLGSL_Vector_Type *vector)
{
   return (*vector->push_method)(vector);
}

int slgsl_assign_vector_to_ref (SLGSL_Vector_Type *vector, SLang_Ref_Type *ref)
{
   SLang_Array_Type *at;
   int status;

   if (-1 == push_vector (vector))
     return -1;

   if (-1 == SLang_pop_array (&at, 0))
     return -1;

   status = SLang_assign_to_ref (ref, SLANG_ARRAY_TYPE, (VOID_STAR)&at);
   SLang_free_array (at);
   return status;
}

int slgsl_pop_vector (SLGSL_Vector_Type **vectorp, SLtype type, int copy)
{
   SLang_Array_Type *at;
   SLGSL_Vector_Type *vector;

   *vectorp = NULL;
   if (-1 == pop_array (&at, type, 1))
     return -1;

   if (NULL == (vector = new_vector (type, at->dims[0], copy, at)))
     {
	SLang_free_array (at);
	return -1;
     }

   if (copy)
     SLang_free_array (at);

   *vectorp = vector;
   return 0;
}

/*}}}*/

/*{{{ Vectorized routines for scalar functions */

static void do_d_d (double (*f)(double))
{
   SLGSL_Double_Array_Type a;
   SLang_Array_Type *in, *out;
   unsigned int i, n;
   double *xp, *yp;

   if (-1 == slgsl_pop_d_array (&a, 0))
     return;

   if (NULL == (in = a.at))
     {
	(void) SLang_push_double ((*f)(a.x));
	return;
     }

   if (NULL == (out = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, in->dims, in->num_dims)))
     {
	SLang_free_array (in);
	return;
     }

   n = in->num_elements;
   xp = a.xp;
   yp = (double *) out->data;
   for (i = 0; i < n; i++)
     yp[i] = (*f)(xp[i]);

   (void) SLang_push_array (out, 1);
   SLang_free_array (in);
}

static void do_i_d (int (*f)(double))
{
   SLGSL_Double_Array_Type a;
   SLang_Array_Type *in, *out;
   unsigned int i, n;
   double *xp;
   int *yp;

   if (-1 == slgsl_pop_d_array (&a, 0))
     return;

   if (NULL == (in = a.at))
     {
	(void) SLang_push_integer ((*f)(a.x));
	return;
     }

   if (NULL == (out = SLang_create_array (SLANG_INT_TYPE, 0, NULL, in->dims, in->num_dims)))
     {
	SLang_free_array (in);
	return;
     }

   n = in->num_elements;
   xp = a.xp;
   yp = (int *) out->data;
   for (i = 0; i < n; i++)
     yp[i] = (*f)(xp[i]);

   (void) SLang_push_array (out, 1);
   SLang_free_array (in);
}

static void do_d_dd (double (*f)(double, double))
{
   SLGSL_Double_Array_Type a, b;
   SLang_Array_Type *atz;
   unsigned int i, n;
   double *xp, *yp, *zp;
   unsigned int xinc, yinc;

   if (-1 == slgsl_pop_dd_array (&a, &b, 0))
     return;

   if ((NULL == (atz = a.at))
       && (NULL == (atz = b.at)))
     {
	(void) SLang_push_double ((*f)(a.x, b.x));
	return;
     }

   atz = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, atz->dims, atz->num_dims);
   if (atz == NULL)
     {
	SLang_free_array (a.at);
	SLang_free_array (b.at);
	return;
     }

   n = atz->num_elements;
   zp = (double *) atz->data;
   xp = a.xp;
   yp = b.xp;
   xinc = a.inc;
   yinc = b.inc;

   for (i = 0; i < n; i++)
     {
	zp[i] = (*f)(*xp, *yp);
	xp += xinc;
	yp += yinc;
     }

   (void) SLang_push_array (atz, 1);
   SLang_free_array (a.at);
   SLang_free_array (b.at);
}

static void do_d_i (double (*f)(int))
{
   SLGSL_Int_Array_Type a;
   SLang_Array_Type *in, *out;
   unsigned int i, n;
   double *yp;
   int *xp;

   if (-1 == slgsl_pop_i_array (&a, 0))
     return;

   if (NULL == (in = a.at))
     {
	(void) SLang_push_double ((*f)(a.x));
	return;
     }

   if (NULL == (out = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, in->dims, in->num_dims)))
     {
	SLang_free_array (in);
	return;
     }

   n = in->num_elements;
   xp = a.xp;
   yp = (double *) out->data;
   for (i = 0; i < n; i++)
     yp[i] = (*f)(xp[i]);

   (void) SLang_push_array (out, 1);
   SLang_free_array (in);
}

static void do_d_id (double (*f)(int, double))
{
   SLGSL_Double_Array_Type b;
   SLGSL_Int_Array_Type a;
   SLang_Array_Type *atz;
   unsigned int i, n;
   double *yp, *zp;
   int *xp;
   unsigned int xinc, yinc;

   if (-1 == slgsl_pop_id_array (&a, &b, 0))
     return;

   if (NULL == (atz = a.at))
     {
	if (b.at == NULL)
	  {
	     (void) SLang_push_double ((*f)(a.x, b.x));
	     return;
	  }
	atz = b.at;
     }

   atz = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, atz->dims, atz->num_dims);
   if (atz == NULL)
     {
	SLang_free_array (a.at);
	SLang_free_array (b.at);
	return;
     }

   n = atz->num_elements;
   zp = (double *) atz->data;
   xp = a.xp;
   yp = b.xp;
   xinc = a.inc;
   yinc = b.inc;

   for (i = 0; i < n; i++)
     {
	zp[i] = (*f)(*xp, *yp);
	xp += xinc;
	yp += yinc;
     }

   (void) SLang_push_array (atz, 1);
   SLang_free_array (a.at);
   SLang_free_array (b.at);
}

static void do_d_idd (double (*f)(int, double, double))
{
   SLGSL_Int_Array_Type a;
   SLGSL_Double_Array_Type b, c;
   SLang_Array_Type *atz;
   unsigned int i, n;
   double *bp, *cp, *zp;
   int *ap;
   unsigned int ainc, binc, cinc;

   if (-1 == slgsl_pop_idd_array (&a, &b, &c, 0))
     return;

   if ((NULL == (atz = a.at))
       && (NULL == (atz = b.at))
       && (NULL == (atz = c.at)))
     {
	(void) SLang_push_double ((*f)(a.x, b.x, c.x));
	return;
     }

   atz = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, atz->dims, atz->num_dims);
   if (atz == NULL)
     {
	SLang_free_array (a.at);
	SLang_free_array (b.at);
	SLang_free_array (c.at);
	return;
     }

   n = atz->num_elements;
   zp = (double *) atz->data;
   ap = a.xp;
   bp = b.xp;
   cp = c.xp;
   ainc = a.inc;
   binc = b.inc;
   cinc = c.inc;

   for (i = 0; i < n; i++)
     {
	zp[i] = (*f)(*ap, *bp, *cp);
	ap += ainc;
	bp += binc;
	cp += cinc;
     }

   (void) SLang_push_array (atz, 1);
   SLang_free_array (a.at);
   SLang_free_array (b.at);
   SLang_free_array (c.at);
}

static void do_d_iid (double (*f)(int, int, double))
{
   SLGSL_Int_Array_Type a, b;
   SLGSL_Double_Array_Type c;
   SLang_Array_Type *atz;
   unsigned int i, n;
   double *cp, *zp;
   int *ap, *bp;
   unsigned int ainc, binc, cinc;

   if (-1 == slgsl_pop_iid_array (&a, &b, &c, 0))
     return;

   if ((NULL == (atz = a.at))
       && (NULL == (atz = b.at))
       && (NULL == (atz = c.at)))
     {
	(void) SLang_push_double ((*f)(a.x, b.x, c.x));
	return;
     }

   atz = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, atz->dims, atz->num_dims);
   if (atz == NULL)
     {
	SLang_free_array (a.at);
	SLang_free_array (b.at);
	SLang_free_array (c.at);
	return;
     }

   n = atz->num_elements;
   zp = (double *) atz->data;
   ap = a.xp;
   bp = b.xp;
   cp = c.xp;
   ainc = a.inc;
   binc = b.inc;
   cinc = c.inc;

   for (i = 0; i < n; i++)
     {
	zp[i] = (*f)(*ap, *bp, *cp);
	ap += ainc;
	bp += binc;
	cp += cinc;
     }

   (void) SLang_push_array (atz, 1);
   SLang_free_array (a.at);
   SLang_free_array (b.at);
   SLang_free_array (c.at);
}

static void do_d_iidd (double (*f)(int, int, double, double))
{
   SLGSL_Int_Array_Type a, b;
   SLGSL_Double_Array_Type c, d;
   SLang_Array_Type *atz;
   unsigned int i, n;
   double *cp, *dp, *zp;
   int *ap, *bp;
   unsigned int ainc, binc, cinc, dinc;

   if (-1 == slgsl_pop_iidd_array (&a, &b, &c, &d, 0))
     return;

   if ((NULL == (atz = a.at))
       && (NULL == (atz = b.at))
       && (NULL == (atz = c.at))
       && (NULL == (atz = d.at)))
     {
	(void) SLang_push_double ((*f)(a.x, b.x, c.x, d.x));
	return;
     }

   atz = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, atz->dims, atz->num_dims);
   if (atz == NULL)
     {
	SLang_free_array (a.at);
	SLang_free_array (b.at);
	SLang_free_array (c.at);
	SLang_free_array (d.at);
	return;
     }

   n = atz->num_elements;
   zp = (double *) atz->data;
   ap = a.xp;
   bp = b.xp;
   cp = c.xp;
   dp = d.xp;
   ainc = a.inc;
   binc = b.inc;
   cinc = c.inc;
   dinc = d.inc;

   for (i = 0; i < n; i++)
     {
	zp[i] = (*f)(*ap, *bp, *cp, *dp);
	ap += ainc;
	bp += binc;
	cp += cinc;
	dp += dinc;
     }

   (void) SLang_push_array (atz, 1);
   SLang_free_array (a.at);
   SLang_free_array (b.at);
   SLang_free_array (c.at);
   SLang_free_array (d.at);
}

static void do_d_ddd (double (*f)(double, double, double))
{
   SLGSL_Double_Array_Type a, b, c;
   SLang_Array_Type *atz;
   unsigned int i, n;
   double *ap, *bp, *cp, *zp;
   unsigned int ainc, binc, cinc;

   if (-1 == slgsl_pop_ddd_array (&a, &b, &c, 0))
     return;

   if ((NULL == (atz = a.at))
       && (NULL == (atz = b.at))
       && (NULL == (atz = c.at)))
     {
	(void) SLang_push_double ((*f)(a.x, b.x, c.x));
	return;
     }

   atz = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, atz->dims, atz->num_dims);
   if (atz == NULL)
     {
	SLang_free_array (a.at);
	SLang_free_array (b.at);
	SLang_free_array (c.at);
	return;
     }

   n = atz->num_elements;
   zp = (double *) atz->data;
   ap = a.xp;
   bp = b.xp;
   cp = c.xp;
   ainc = a.inc;
   binc = b.inc;
   cinc = c.inc;

   for (i = 0; i < n; i++)
     {
	zp[i] = (*f)(*ap, *bp, *cp);
	ap += ainc;
	bp += binc;
	cp += cinc;
     }

   (void) SLang_push_array (atz, 1);
   SLang_free_array (a.at);
   SLang_free_array (b.at);
   SLang_free_array (c.at);
}

static void do_d_dddd (double (*f)(double, double, double, double))
{
   SLGSL_Double_Array_Type a, b, c, d;
   SLang_Array_Type *atz;
   unsigned int i, n;
   double *ap, *bp, *cp, *dp, *zp;
   unsigned int ainc, binc, cinc, dinc;

   if (-1 == slgsl_pop_dddd_array (&a, &b, &c, &d, 0))
     return;

   if ((NULL == (atz = a.at))
       && (NULL == (atz = b.at))
       && (NULL == (atz = c.at))
       && (NULL == (atz = d.at)))
     {
	(void) SLang_push_double ((*f)(a.x, b.x, c.x, d.x));
	return;
     }

   atz = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, atz->dims, atz->num_dims);
   if (atz == NULL)
     {
	SLang_free_array (a.at);
	SLang_free_array (b.at);
	SLang_free_array (c.at);
	SLang_free_array (d.at);
	return;
     }

   n = atz->num_elements;
   zp = (double *) atz->data;
   ap = a.xp;
   bp = b.xp;
   cp = c.xp;
   dp = c.xp;
   ainc = a.inc;
   binc = b.inc;
   cinc = c.inc;
   dinc = d.inc;

   for (i = 0; i < n; i++)
     {
	zp[i] = (*f)(*ap, *bp, *cp, *dp);
	ap += ainc;
	bp += binc;
	cp += cinc;
	dp += dinc;
     }

   (void) SLang_push_array (atz, 1);
   SLang_free_array (a.at);
   SLang_free_array (b.at);
   SLang_free_array (c.at);
   SLang_free_array (d.at);
}

void slgsl_do_d_d_fun (char *fun, double (*f)(double))
{
   if (SLang_Num_Function_Args != 1)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(double)", fun);
	return;
     }
   slgsl_reset_errors ();
   do_d_d (f);
   slgsl_check_errors (fun);
}

void slgsl_do_d_i_fun (char *fun, double (*f)(int))
{
   if (SLang_Num_Function_Args != 1)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(int)", fun);
	return;
     }
   slgsl_reset_errors ();
   do_d_i (f);
   slgsl_check_errors (fun);
}

void slgsl_do_d_dd_fun (char *fun, double (*f)(double, double))
{
   if (SLang_Num_Function_Args != 2)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(double, double)", fun);
	return;
     }
   slgsl_reset_errors ();
   do_d_dd (f);
   slgsl_check_errors (fun);
}

void slgsl_do_d_ddd_fun (char *fun, double (*f)(double, double, double))
{
   if (SLang_Num_Function_Args != 3)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(double, double, double)", fun);
	return;
     }
   slgsl_reset_errors ();
   do_d_ddd (f);
   slgsl_check_errors (fun);
}

void slgsl_do_d_dddd_fun (char *fun, double (*f)(double, double, double,double))
{
   if (SLang_Num_Function_Args != 4)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(double, double, double, double)", fun);
	return;
     }
   slgsl_reset_errors ();
   do_d_dddd (f);
   slgsl_check_errors (fun);
}

void slgsl_do_d_id_fun (char *fun, double (*f)(int, double))
{
   if (SLang_Num_Function_Args != 2)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(int, double)", fun);
	return;
     }
   slgsl_reset_errors ();
   do_d_id (f);
   slgsl_check_errors (fun);
}

void slgsl_do_d_idd_fun (char *fun, double (*f)(int, double, double))
{
   if (SLang_Num_Function_Args != 3)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(int, double, double)", fun);
	return;
     }
   slgsl_reset_errors ();
   do_d_idd (f);
   slgsl_check_errors (fun);
}

void slgsl_do_d_iid_fun (char *fun, double (*f)(int, int, double))
{
   if (SLang_Num_Function_Args != 3)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(int, int, double)", fun);
	return;
     }
   slgsl_reset_errors ();
   do_d_iid (f);
   slgsl_check_errors (fun);
}

void slgsl_do_d_iidd_fun (char *fun, double (*f)(int, int, double, double))
{
   if (SLang_Num_Function_Args != 3)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(int, int, double, double)", fun);
	return;
     }
   slgsl_reset_errors ();
   do_d_iidd (f);
   slgsl_check_errors (fun);
}

void slgsl_do_i_d_fun (char *fun, int (*f)(double))
{
   if (SLang_Num_Function_Args != 1)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(double)", fun);
	return;
     }
   slgsl_reset_errors ();
   do_i_d (f);
   slgsl_check_errors (fun);
}

/* Complex functions */
static void do_c_c (int (*f)(double, double, gsl_sf_result*, gsl_sf_result*))
{
   SLGSL_Complex_Array_Type a;
   SLang_Array_Type *in, *out;
   unsigned int i, n;
   gsl_sf_result gsl_zr, gsl_zi;
   double *xp, *yp, zr, zi;

   if (-1 == slgsl_pop_c_array (&a, 0))
     return;

   if (NULL == (in = a.at))
     {
        (void) (*f)(a.x[0], a.x[1], &gsl_zr, gsl_zi);
	(void) SLang_push_complex (gsl_zr.val, gsl_zi.val);
	return;
     }

   if (NULL == (out = SLang_create_array (SLANG_COMPLEX_TYPE, 0, NULL, in->dims, in->num_dims)))
     {
	SLang_free_array (in);
	return;
     }

   n = in->num_elements;
   xp = a.xp;
   yp = (double *) out->data;
   for (i = 0; i < 2*n; i+=2)
     {
        (void) (*f)(xp[i], xp[i+1], &gsl_zr, &gsl_zi);
        yp[i] = gsl_zr.val;
        yp[i+1] = gsl_zi.val;
     }

   (void) SLang_push_array (out, 1);
   SLang_free_array (in);
}

void slgsl_do_c_c_fun (const char *fun, int (*f)(double, double, gsl_sf_result*, gsl_sf_result*))
{
   if (SLang_Num_Function_Args != 1)
     {
	SLang_verror (SL_USAGE_ERROR, "Usage: y=%s(complex)", fun);
	return;
     }
   slgsl_reset_errors ();
   do_c_c (f);
   slgsl_check_errors (fun);
}


/*}}}*/

static SLang_Intrin_Fun_Type Module_Intrinsics [] =
{
   MAKE_INTRINSIC_0("gsl_set_error_disposition", set_error_disposition, SLANG_VOID_TYPE),
   SLANG_END_INTRIN_FUN_TABLE
};

static SLang_Intrin_Var_Type Module_Variables [] =
{
   MAKE_VARIABLE("_gslcore_module_version_string", &Module_Version_String, SLANG_STRING_TYPE, 1),
   MAKE_VARIABLE("GSL_VERSION", &gsl_version, SLANG_STRING_TYPE, 1),
   SLANG_END_INTRIN_VAR_TABLE
};

static SLang_IConstant_Type Module_IConstants [] =
{
   MAKE_ICONSTANT("_gslcore_module_version", MODULE_VERSION_NUMBER),

   MAKE_ICONSTANT("GSL_SUCCESS", GSL_SUCCESS),
   MAKE_ICONSTANT("GSL_FAILURE", GSL_FAILURE),
   MAKE_ICONSTANT("GSL_CONTINUE", GSL_CONTINUE),
   MAKE_ICONSTANT("GSL_EDOM", GSL_EDOM),
   MAKE_ICONSTANT("GSL_ERANGE", GSL_ERANGE),
   MAKE_ICONSTANT("GSL_EFAULT", GSL_EFAULT),
   MAKE_ICONSTANT("GSL_EINVAL", GSL_EINVAL),
   MAKE_ICONSTANT("GSL_EFAILED", GSL_EFAILED),
   MAKE_ICONSTANT("GSL_EFACTOR", GSL_EFACTOR),
   MAKE_ICONSTANT("GSL_ESANITY", GSL_ESANITY),
   MAKE_ICONSTANT("GSL_ENOMEM", GSL_ENOMEM),
   MAKE_ICONSTANT("GSL_EBADFUNC", GSL_EBADFUNC),
   MAKE_ICONSTANT("GSL_ERUNAWAY", GSL_ERUNAWAY),
   MAKE_ICONSTANT("GSL_EMAXITER", GSL_EMAXITER),
   MAKE_ICONSTANT("GSL_EZERODIV", GSL_EZERODIV),
   MAKE_ICONSTANT("GSL_EBADTOL", GSL_EBADTOL),
   MAKE_ICONSTANT("GSL_ETOL", GSL_ETOL),
   MAKE_ICONSTANT("GSL_EUNDRFLW", GSL_EUNDRFLW),
   MAKE_ICONSTANT("GSL_EOVRFLW", GSL_EOVRFLW),
   MAKE_ICONSTANT("GSL_ELOSS", GSL_ELOSS),
   MAKE_ICONSTANT("GSL_EROUND", GSL_EROUND),
   MAKE_ICONSTANT("GSL_EBADLEN", GSL_EBADLEN),
   MAKE_ICONSTANT("GSL_ENOTSQR", GSL_ENOTSQR),
   MAKE_ICONSTANT("GSL_ESING", GSL_ESING),
   MAKE_ICONSTANT("GSL_EDIVERGE", GSL_EDIVERGE),
   MAKE_ICONSTANT("GSL_EUNSUP", GSL_EUNSUP),
   MAKE_ICONSTANT("GSL_EUNIMPL", GSL_EUNIMPL),
   MAKE_ICONSTANT("GSL_ECACHE", GSL_ECACHE),
   MAKE_ICONSTANT("GSL_ETABLE", GSL_ETABLE),
   MAKE_ICONSTANT("GSL_ENOPROG", GSL_ENOPROG),
   MAKE_ICONSTANT("GSL_ENOPROGJ", GSL_ENOPROGJ),
   MAKE_ICONSTANT("GSL_ETOLF", GSL_ETOLF),
   MAKE_ICONSTANT("GSL_ETOLX", GSL_ETOLX),
   MAKE_ICONSTANT("GSL_ETOLG", GSL_ETOLG),
   MAKE_ICONSTANT("GSL_EOF", GSL_EOF),

   SLANG_END_ICONST_TABLE
};

int init_gslcore_module_ns (char *ns_name)
{
   SLang_NameSpace_Type *ns = SLns_create_namespace (ns_name);
   static int initialized = 0;

   if (ns == NULL)
     return -1;

   if (
       (-1 == SLns_add_intrin_var_table (ns, Module_Variables, NULL))
       || (-1 == SLns_add_intrin_fun_table (ns, Module_Intrinsics, NULL))
       || (-1 == SLns_add_iconstant_table (ns, Module_IConstants, NULL))
       )
     return -1;

   if (initialized == 0)
     {
	(void) gsl_set_error_handler (&err_handler);
	set_gsl_error_disposition (GSL_EDOM, 1, NULL);
	set_gsl_error_disposition (GSL_ERANGE, 1, NULL);
	initialized = 1;
     }
   return 0;
}

/* This function is optional */
void deinit_gslcore_module (void)
{
}
