swig/gsl_typemaps.i

   1 %include "system.i"
   2 %include "gsl/gsl_nan.h"
   3 #if defined(GSL_MINOR_VERSION) &&  GSL_MINOR_VERSION >= 12
   4     %include "gsl/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 /*  This caused gsl_vector_view  functions to fail, can we
  34  *  turn this off for those functions?
  35 %typemap(freearg) double const [] {
  36         if ($1) free($1);
  37 }
  38 */
  39 %typemap(in) float const [] {
  40     AV *tempav;
  41     I32 len;
  42     int i;
  43     SV **tv;
  44     if (!SvROK($input))
  45         croak("Math::GSL : $$1_name is not a reference!");
  46     if (SvTYPE(SvRV($input)) != SVt_PVAV)
  47         croak("Math::GSL : $$1_name is not an array ref!");
  48
  49     tempav = (AV*)SvRV($input);
  50     len = av_len(tempav);
  51     $1 = (float *) malloc((len+1)*sizeof(float));
  52     for (i = 0; i <= len; i++) {
  53         tv = av_fetch(tempav, i, 0);
  54         $1[i] = (float)(double) SvNV(*tv);
  55     }
  56 }
  57
  58 %typemap(freearg) float const [] {
  59         if ($1) free($1);
  60 }
  61
  62 %typemap(in) size_t const [] {
  63     AV *tempav;
  64     I32 len;
  65     int i;
  66     SV **tv;
  67     if (!SvROK($input))
  68         croak("Math::GSL : $$1_name is not a reference!");
  69     if (SvTYPE(SvRV($input)) != SVt_PVAV)
  70         croak("Math::GSL : $$1_name is not an array ref!");
  71
  72     tempav = (AV*)SvRV($input);
  73     len = av_len(tempav);
  74     $1 = (size_t *) malloc((len+1)*sizeof(size_t));
  75     for (i = 0; i <= len; i++) {
  76         tv = av_fetch(tempav, i, 0);
  77         $1[i] = SvIV(*tv);
  78     }
  79 }
  80
  81 %typemap(freearg) size_t const [] {
  82         if ($1) free($1);
  83 }
  84
  85 %apply double const [] {
  86     double *data, double *dest, double *f_in, double *f_out,
  87     double data[], const double * src, double x[], double a[], double b[],
  88     const double * x, const double * y, const double * w , const double x_array[],
  89     const double xrange[], const double yrange[], double * base,
  90     const double * base, const double xrange[], const double yrange[] ,
  91     const double * array , const double data2[], const double w[] ,
  92     double *v,
  93     gsl_complex_packed_array data
  94 };
  95
  96 %apply float const [] {
  97     float const *A, float const *B, float const *C, float *C
  98 };
  99
 100 %apply size_t const [] {
 101     size_t *p
 102 }
 103
 104 %apply int *OUTPUT { size_t *imin, size_t *imax, size_t *neval };
 105 %apply double * OUTPUT {
 106     double * min_out, double * max_out,
 107     double *abserr, double *result
 108 };
 109 %{
 110
 111     struct gsl_function_perl {
 112         gsl_function C_gsl_function;
 113         SV * function;
 114         SV * params;
 115     };
 116     struct gsl_monte_function_perl {
 117         gsl_monte_function C_gsl_monte_function;
 118         SV * f;
 119         SV * dim;
 120         SV * params;
 121     };
 122
 123
 124     /* this function returns the value
 125         of evaluating the function pointer
 126         stored in func with argument x
 127     */
 128     double call_gsl_function(double x , void *params){
 129         struct gsl_function_perl *F=(struct gsl_function_perl*)params;
 130         unsigned int count;
 131         double y;
 132         dSP;
 133
 134         //fprintf(stderr, "LOOKUP CALLBACK\n");
 135         ENTER;
 136         SAVETMPS;
 137
 138         PUSHMARK(SP);
 139         XPUSHs(sv_2mortal(newSVnv((double)x)));
 140         XPUSHs(F->params);
 141         PUTBACK;                                /* make local stack pointer global */
 142
 143         count = call_sv(F->function, G_SCALAR);
 144         SPAGAIN;
 145
 146         if (count != 1)
 147                 croak("Expected to call subroutine in scalar context!");
 148
 149         y = POPn;
 150
 151         PUTBACK;                                /* make local stack pointer global */
 152         FREETMPS;
 153         LEAVE;
 154
 155         return y;
 156     }
 157     double call_gsl_monte_function(double *x_array , size_t dim, void *params){
 158         struct gsl_monte_function_perl *F=(struct gsl_monte_function_perl*)params;
 159         unsigned int count;
 160         unsigned int i;
 161         AV* perl_array;
 162         double y;
 163         dSP;
 164
 165         //fprintf(stderr, "LOOKUP CALLBACK\n");
 166         ENTER;
 167         SAVETMPS;
 168
 169         PUSHMARK(SP);
 170         perl_array=newAV();
 171         sv_2mortal((SV*)perl_array);
 172         XPUSHs(sv_2mortal(newRV((SV *)perl_array)));
 173         for(i=0; i<dim; i++) {
 174                 /* no mortal : it is referenced by the array */
 175                 av_push(perl_array, newSVnv(x_array[i]));
 176         }
 177         XPUSHs(sv_2mortal(newSViv(dim)));
 178         XPUSHs(F->params);
 179         PUTBACK;                                /* make local stack pointer global */
 180
 181         count = call_sv(F->f, G_SCALAR);
 182         SPAGAIN;
 183
 184         if (count != 1)
 185                 croak("Expected to call subroutine in scalar context!");
 186
 187         y = POPn;
 188
 189         PUTBACK;                                /* make local stack pointer global */
 190         FREETMPS;
 191         LEAVE;
 192
 193         return y;
 194     }
 195 %}
 196
 197 %typemap(in) gsl_monte_function * (struct gsl_monte_function_perl w_gsl_monte_function) {
 198     SV * f = 0;
 199     SV * dim = 0;
 200     SV * params = 0;
 201     size_t C_dim;
 202
 203     if (SvROK($input) && (SvTYPE(SvRV($input)) == SVt_PVAV)) {
 204         AV* array=(AV*)SvRV($input);
 205         SV ** p_f = 0;
 206         if (av_len(array)<0) {
 207             croak("Math::GSL : $$1_name is an empty array!");
 208         }
 209         if (av_len(array)>2) {
 210             croak("Math::GSL : $$1_name is an array with more than 3 elements!");
 211         }
 212         p_f = av_fetch(array, 0, 0);
 213         f = *p_f;
 214         if (av_len(array)>0) {
 215             SV ** p_dim = 0;
 216             p_dim = av_fetch(array, 1, 0);
 217             dim = *p_dim;
 218         }
 219         if (av_len(array)>1) {
 220             SV ** p_params = 0;
 221             p_params = av_fetch(array, 1, 0);
 222             params = *p_params;
 223         }
 224     } else {
 225         f = $input;
 226     }
 227
 228     if (!f || !(SvPOK(f) || (SvROK(f) && (SvTYPE(SvRV(f)) == SVt_PVCV)))) {
 229         croak("Math::GSL : $$1_name is not a reference to code!");
 230     }
 231
 232     f = newSVsv(f);
 233
 234     if (! dim) {
 235         dim=&PL_sv_undef;
 236         C_dim=0;
 237     } else {
 238         if (!SvIOK(dim)) {
 239             croak("Math::GSL : $$1_name is not an integer for dim!");
 240         }
 241         C_dim=SvIV(dim);
 242     }
 243     dim = newSVsv(dim);
 244
 245     if (! params) {
 246         params=&PL_sv_undef;
 247     }
 248     params = newSVsv(params);
 249
 250     w_gsl_monte_function.f = f;
 251     w_gsl_monte_function.dim = dim;
 252     w_gsl_monte_function.params = params;
 253     w_gsl_monte_function.C_gsl_monte_function.f = &call_gsl_monte_function;
 254     w_gsl_monte_function.C_gsl_monte_function.dim = C_dim;
 255     w_gsl_monte_function.C_gsl_monte_function.params   = &w_gsl_monte_function;
 256     $1         = &w_gsl_monte_function.C_gsl_monte_function;
 257 };
 258
 259 %typemap(in) gsl_function * (struct gsl_function_perl w_gsl_function) {
 260     SV * function = 0;
 261     SV * params = 0;
 262
 263     if (SvROK($input) && (SvTYPE(SvRV($input)) == SVt_PVAV)) {
 264         AV* array=(AV*)SvRV($input);
 265         SV ** p_function = 0;
 266         if (av_len(array)<0) {
 267             croak("Math::GSL : $$1_name is an empty array!");
 268         }
 269         if (av_len(array)>1) {
 270             croak("Math::GSL : $$1_name is an array with more than 2 elements!");
 271         }
 272         p_function = av_fetch(array, 0, 0);
 273         function = *p_function;
 274         if (av_len(array)>0) {
 275             SV ** p_params = 0;
 276             p_params = av_fetch(array, 1, 0);
 277             params = *p_params;
 278         }
 279     } else {
 280         function = $input;
 281     }
 282
 283     if (!function || !(SvPOK(function) || (SvROK(function) && (SvTYPE(SvRV(function)) == SVt_PVCV)))) {
 284         croak("Math::GSL : $$1_name is not a reference to code!");
 285     }
 286
 287     function = newSVsv(function);
 288
 289     if (! params) {
 290         params=&PL_sv_undef;
 291     }
 292     params = newSVsv(params);
 293
 294     w_gsl_function.params = params;
 295     w_gsl_function.function = function;
 296     w_gsl_function.C_gsl_function.params   = &w_gsl_function;
 297     w_gsl_function.C_gsl_function.function = &call_gsl_function;
 298     $1         = &w_gsl_function.C_gsl_function;
 299 };
 300
 301 %typemap(freearg) gsl_monte_function * {
 302     struct gsl_monte_function_perl *p=(struct gsl_monte_function_perl *) $1->params;
 303     SvREFCNT_dec(p->f);
 304     SvREFCNT_dec(p->dim);
 305     SvREFCNT_dec(p->params);
 306 };
 307
 308 %typemap(freearg) gsl_function * {
 309     struct gsl_function_perl *p=(struct gsl_function_perl *) $1->params;
 310     SvREFCNT_dec(p->function);
 311     SvREFCNT_dec(p->params);
 312 };
 313
 314 %typemap(in) gsl_function_fdf * {
 315     fprintf(stderr, 'FDF_FUNC');
 316     return GSL_NAN;
 317 }