swig/gsl_typemaps.i

   1 %include "system.i"
   2 %include "gsl/gsl_nan.h"
   3 #ifdef GSL_MINOR_VERSION &&  GSL_MINOR_VERSION >= 12
   4     %include "gsl_inline.h"
   5 #endif
   6
   7 typedef int size_t;
   8
   9 %{
  10     #include "gsl/gsl_nan.h"
  11     #include "gsl/gsl_math.h"
  12     #include "gsl/gsl_monte.h"
  13 %}
  14
  15 %typemap(in) double const [] {
  16     AV *tempav;
  17     I32 len;
  18     int i;
  19     SV **tv;
  20     if (!SvROK($input))
  21         croak("Math::GSL : $$1_name is not a reference!");
  22     if (SvTYPE(SvRV($input)) != SVt_PVAV)
  23         croak("Math::GSL : $$1_name is not an array ref!");
  24
  25     tempav = (AV*)SvRV($input);
  26     len = av_len(tempav);
  27     $1 = (double *) malloc((len+1)*sizeof(double));
  28     for (i = 0; i <= len; i++) {
  29         tv = av_fetch(tempav, i, 0);
  30         $1[i] = (double) SvNV(*tv);
  31     }
  32 }
  33
  34 %apply double const [] {
  35     size_t *p ,double *data, double *dest, double *f_in, double *f_out,
  36     double data[], const double * src, double x[], double a[], double b[],
  37     const double * x, const double * y, const double * w , const double x_array[],
  38     const double xrange[], const double yrange[], double * base,
  39     const double * base, const double xrange[], const double yrange[] ,
  40     const double * array , const double data2[], const double w[] ,
  41     float const *A, float const *B, float const *C, float *C, double *v,
  42     gsl_complex_packed_array data
  43 };
  44
  45 %apply int *OUTPUT { size_t *imin, size_t *imax, size_t *neval };
  46 %apply double * OUTPUT {
  47     double * min_out, double * max_out,
  48     double *abserr, double *result
  49 };
  50 %{
  51 <<<<<<< HEAD:swig/gsl_typemaps.i
  52     static HV * Callbacks = (HV*)NULL;  // Hash of callbacks, stored by memory address
  53     SV * Last_Call        = (SV*)NULL;  // last used callback, used as fudge for systems with MULTIPLICITY
  54
  55     /* this function returns the value of evaluating the function pointer stored in func with argument x */
  56
  57     double callthis(double x , int func, void *params){
  58         SV ** sv;
  59 =======
  60
  61     struct gsl_function_perl {
  62         gsl_function C_gsl_function;
  63         SV * function;
  64         SV * params;
  65     };
  66     struct gsl_monte_function_perl {
  67         gsl_monte_function C_gsl_monte_function;
  68         SV * f;
  69         SV * dim;
  70         SV * params;
  71     };
  72
  73
  74     /* this function returns the value
  75         of evaluating the function pointer
  76         stored in func with argument x
  77     */
  78     double call_gsl_function(double x , void *params){
  79         struct gsl_function_perl *F=(struct gsl_function_perl*)params;
  80         unsigned int count;
  81         double y;
  82         dSP;
  83
  84         //fprintf(stderr, "LOOKUP CALLBACK\n");
  85         ENTER;
  86         SAVETMPS;
  87
  88         PUSHMARK(SP);
  89         XPUSHs(sv_2mortal(newSVnv((double)x)));
  90         XPUSHs(F->params);
  91         PUTBACK;                                /* make local stack pointer global */
  92
  93         count = call_sv(F->function, G_SCALAR);
  94         SPAGAIN;
  95
  96         if (count != 1)
  97                 croak("Expected to call subroutine in scalar context!");
  98
  99         y = POPn;
 100
 101         PUTBACK;                                /* make local stack pointer global */
 102         FREETMPS;
 103         LEAVE;
 104
 105         return y;
 106     }
 107     double call_gsl_monte_function(double *x_array , size_t dim, void *params){
 108         struct gsl_monte_function_perl *F=(struct gsl_monte_function_perl*)params;
 109         unsigned int count;
 110         unsigned int i;
 111         AV* perl_array;
 112         double y;
 113         dSP;
 114
 115         //fprintf(stderr, "LOOKUP CALLBACK\n");
 116         ENTER;
 117         SAVETMPS;
 118
 119         PUSHMARK(SP);
 120         perl_array=newAV();
 121         sv_2mortal((SV*)perl_array);
 122         XPUSHs(sv_2mortal(newRV((SV *)perl_array)));
 123         for(i=0; i<dim; i++) {
 124                 /* no mortal : it is referenced by the array */
 125                 av_push(perl_array, newSVnv(x_array[i]));
 126         }
 127         XPUSHs(sv_2mortal(newSViv(dim)));
 128         XPUSHs(F->params);
 129         PUTBACK;                                /* make local stack pointer global */
 130
 131         count = call_sv(F->f, G_SCALAR);
 132         SPAGAIN;
 133
 134         if (count != 1)
 135                 croak("Expected to call subroutine in scalar context!");
 136
 137         y = POPn;
 138
 139         PUTBACK;                                /* make local stack pointer global */
 140         FREETMPS;
 141         LEAVE;
 142
 143         return y;
 144     }
 145 %}
 146
 147 %typemap(in) gsl_monte_function * (struct gsl_monte_function_perl w_gsl_monte_function) {
 148     SV * f = 0;
 149     SV * dim = 0;
 150     SV * params = 0;
 151     size_t C_dim;
 152
 153     if (SvROK($input) && (SvTYPE(SvRV($input)) == SVt_PVAV)) {
 154         AV* array=(AV*)SvRV($input);
 155         SV ** p_f = 0;
 156         if (av_len(array)<0) {
 157             croak("Math::GSL : $$1_name is an empty array!");
 158         }
 159         if (av_len(array)>2) {
 160             croak("Math::GSL : $$1_name is an array with more than 3 elements!");
 161         }
 162         p_f = av_fetch(array, 0, 0);
 163         f = *p_f;
 164         if (av_len(array)>0) {
 165             SV ** p_dim = 0;
 166             p_dim = av_fetch(array, 1, 0);
 167             dim = *p_dim;
 168         }
 169         if (av_len(array)>1) {
 170             SV ** p_params = 0;
 171             p_params = av_fetch(array, 1, 0);
 172             params = *p_params;
 173         }
 174     } else {
 175         f = $input;
 176     }
 177
 178     if (!f || !(SvPOK(f) || (SvROK(f) && (SvTYPE(SvRV(f)) == SVt_PVCV)))) {
 179         croak("Math::GSL : $$1_name is not a reference to code!");
 180     }
 181
 182     f = newSVsv(f);
 183
 184     if (! dim) {
 185         dim=&PL_sv_undef;
 186         C_dim=0;
 187     } else {
 188         if (!SvIOK(dim)) {
 189             croak("Math::GSL : $$1_name is not an integer for dim!");
 190         }
 191         C_dim=SvIV(dim);
 192     }
 193     dim = newSVsv(dim);
 194
 195     if (! params) {
 196         params=&PL_sv_undef;
 197     }
 198     params = newSVsv(params);
 199
 200     w_gsl_monte_function.f = f;
 201     w_gsl_monte_function.dim = dim;
 202     w_gsl_monte_function.params = params;
 203     w_gsl_monte_function.C_gsl_monte_function.f = &call_gsl_monte_function;
 204     w_gsl_monte_function.C_gsl_monte_function.dim = C_dim;
 205     w_gsl_monte_function.C_gsl_monte_function.params   = &w_gsl_monte_function;
 206     $1         = &w_gsl_monte_function.C_gsl_monte_function;
 207 };
 208
 209 %typemap(in) gsl_function * (struct gsl_function_perl w_gsl_function) {
 210     SV * function = 0;
 211     SV * params = 0;
 212
 213     if (SvROK($input) && (SvTYPE(SvRV($input)) == SVt_PVAV)) {
 214         AV* array=(AV*)SvRV($input);
 215         SV ** p_function = 0;
 216         if (av_len(array)<0) {
 217             croak("Math::GSL : $$1_name is an empty array!");
 218         }
 219         if (av_len(array)>1) {
 220             croak("Math::GSL : $$1_name is an array with more than 2 elements!");
 221         }
 222         p_function = av_fetch(array, 0, 0);
 223         function = *p_function;
 224         if (av_len(array)>0) {
 225             SV ** p_params = 0;
 226             p_params = av_fetch(array, 1, 0);
 227             params = *p_params;
 228         }
 229     } else {
 230         function = $input;
 231     }
 232
 233     if (!function || !(SvPOK(function) || (SvROK(function) && (SvTYPE(SvRV(function)) == SVt_PVCV)))) {
 234         croak("Math::GSL : $$1_name is not a reference to code!");
 235     }
 236
 237     function = newSVsv(function);
 238
 239     if (! params) {
 240         params=&PL_sv_undef;
 241     }
 242     params = newSVsv(params);
 243
 244     w_gsl_function.params = params;
 245     w_gsl_function.function = function;
 246     w_gsl_function.C_gsl_function.params   = &w_gsl_function;
 247     w_gsl_function.C_gsl_function.function = &call_gsl_function;
 248     $1         = &w_gsl_function.C_gsl_function;
 249 };
 250
 251 %typemap(freearg) gsl_monte_function * {
 252     struct gsl_monte_function_perl *p=(struct gsl_monte_function_perl *) $1->params;
 253     SvREFCNT_dec(p->f);
 254     SvREFCNT_dec(p->dim);
 255     SvREFCNT_dec(p->params);
 256 };
 257
 258 %typemap(freearg) gsl_function * {
 259     struct gsl_function_perl *p=(struct gsl_function_perl *) $1->params;
 260     SvREFCNT_dec(p->function);
 261     SvREFCNT_dec(p->params);
 262 };
 263
 264 %typemap(in) gsl_function_fdf * {
 265     fprintf(stderr, 'FDF_FUNC');
 266     return GSL_NAN;
 267 }
 268