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 %{
   8     #include "gsl/gsl_nan.h"
   9     #include "gsl/gsl_math.h"
  10     #include "gsl/gsl_monte.h"
  11 %}
  12
  13 /*****************************
  14  * handle 'double const []' as an input array of doubles
  15  * We allocate the C array at the begining and free it at the end
  16  */
  17 %typemap(in) double const [] {
  18     AV *tempav;
  19     I32 len;
  20     int i;
  21     SV **tv;
  22     if (!SvROK($input))
  23         croak("Math::GSL : $$1_name is not a reference!");
  24     if (SvTYPE(SvRV($input)) != SVt_PVAV)
  25         croak("Math::GSL : $$1_name is not an array ref!");
  26
  27     tempav = (AV*)SvRV($input);
  28     len = av_len(tempav);
  29     $1 = (double *) malloc((len+1)*sizeof(double));
  30     for (i = 0; i <= len; i++) {
  31         tv = av_fetch(tempav, i, 0);
  32         $1[i] = (double) SvNV(*tv);
  33     }
  34 }
  35
  36 %typemap(freearg) double const [] {
  37         if ($1) free($1);
  38 }
  39
  40 %apply double const [] {
  41     double *data, double *dest, double *f_in, double *f_out,
  42     double data[], const double * src, double x[], double a[], double b[],
  43     const double * x, const double * y, const double * w , const double x_array[],
  44     const double xrange[], const double yrange[], double * base,
  45     const double * base, const double xrange[], const double yrange[] ,
  46     const double * array , const double data2[], const double w[] ,
  47     double *v,
  48     gsl_complex_packed_array data
  49 };
  50
  51 /*****************************
  52  * handle 'float const []' as an input array of floats
  53  * We allocate the C array at the begining and free it at the end
  54  */
  55 %typemap(in) float const [] {
  56     AV *tempav;
  57     I32 len;
  58     int i;
  59     SV **tv;
  60     if (!SvROK($input))
  61         croak("Math::GSL : $$1_name is not a reference!");
  62     if (SvTYPE(SvRV($input)) != SVt_PVAV)
  63         croak("Math::GSL : $$1_name is not an array ref!");
  64
  65     tempav = (AV*)SvRV($input);
  66     len = av_len(tempav);
  67     $1 = (float *) malloc((len+1)*sizeof(float));
  68     for (i = 0; i <= len; i++) {
  69         tv = av_fetch(tempav, i, 0);
  70         $1[i] = (float)(double) SvNV(*tv);
  71     }
  72 }
  73
  74 %typemap(freearg) float const [] {
  75         if ($1) free($1);
  76 }
  77
  78 %apply float const [] {
  79     float const *A, float const *B, float const *C, float *C
  80 };
  81
  82 /*****************************
  83  * handle 'size_t const []' as an input array of size_t
  84  * We allocate the C array at the begining and free it at the end
  85  */
  86 %typemap(in) size_t const [] {
  87     AV *tempav;
  88     I32 len;
  89     int i;
  90     SV **tv;
  91     if (!SvROK($input))
  92         croak("Math::GSL : $$1_name is not a reference!");
  93     if (SvTYPE(SvRV($input)) != SVt_PVAV)
  94         croak("Math::GSL : $$1_name is not an array ref!");
  95
  96     tempav = (AV*)SvRV($input);
  97     len = av_len(tempav);
  98     $1 = (size_t *) malloc((len+1)*sizeof(size_t));
  99     for (i = 0; i <= len; i++) {
 100         tv = av_fetch(tempav, i, 0);
 101         $1[i] = SvIV(*tv);
 102     }
 103 }
 104
 105 %typemap(freearg) size_t const [] {
 106         if ($1) free($1);
 107 }
 108
 109 %apply double const [] {
 110     double *data, double *dest, double *f_in, double *f_out,
 111     double data[], const double * src, double x[], double a[], double b[],
 112     double xu[], double xl[],
 113     const double * x, const double * y, const double * w , const double x_array[],
 114     const double xrange[], const double yrange[], double * base,
 115     const double * base, const double xrange[], const double yrange[] ,
 116     const double * array , const double data2[], const double w[] ,
 117     double *v,
 118     gsl_complex_packed_array data
 119 };
 120
 121 %apply float const [] {
 122     float const *A, float const *B, float const *C, float *C
 123 };
 124
 125 %apply size_t const [] {
 126     size_t *p
 127 }
 128
 129 /*****************************
 130  * handle some parameters as input or output
 131  */
 132 %apply int *OUTPUT { size_t *imin, size_t *imax, size_t *neval };
 133 %apply double * OUTPUT {
 134     double * min_out, double * max_out,
 135     double *abserr, double *result
 136 };
 137
 138 /*****************************
 139  * Callback managment
 140  */
 141 %{
 142     /* structure to hold required information while the gsl function call
 143        for each callback
 144      */
 145     struct gsl_function_perl {
 146         gsl_function C_gsl_function;
 147         SV * function;
 148         SV * params;
 149     };
 150     struct gsl_monte_function_perl {
 151         gsl_monte_function C_gsl_monte_function;
 152         SV * f;
 153         SV * dim;
 154         SV * params;
 155     };
 156
 157
 158     /* These functions (C callbacks) calls the perl callbacks.
 159        Info for perl callback can be found using the 'void*params' parameter
 160     */
 161     double call_gsl_function(double x , void *params){
 162         struct gsl_function_perl *F=(struct gsl_function_perl*)params;
 163         unsigned int count;
 164         double y;
 165         dSP;
 166
 167         //fprintf(stderr, "LOOKUP CALLBACK\n");
 168         ENTER;
 169         SAVETMPS;
 170
 171         PUSHMARK(SP);
 172         XPUSHs(sv_2mortal(newSVnv((double)x)));
 173         XPUSHs(F->params);
 174         PUTBACK;                                /* make local stack pointer global */
 175
 176         count = call_sv(F->function, G_SCALAR);
 177         SPAGAIN;
 178
 179         if (count != 1)
 180                 croak("Expected to call subroutine in scalar context!");
 181
 182         y = POPn;
 183
 184         PUTBACK;                                /* make local stack pointer global */
 185         FREETMPS;
 186         LEAVE;
 187
 188         return y;
 189     }
 190     double call_gsl_monte_function(double *x_array , size_t dim, void *params){
 191         struct gsl_monte_function_perl *F=(struct gsl_monte_function_perl*)params;
 192         unsigned int count;
 193         unsigned int i;
 194         AV* perl_array;
 195         double y;
 196         dSP;
 197
 198         //fprintf(stderr, "LOOKUP CALLBACK\n");
 199         ENTER;
 200         SAVETMPS;
 201
 202         PUSHMARK(SP);
 203         perl_array=newAV();
 204         sv_2mortal((SV*)perl_array);
 205         XPUSHs(sv_2mortal(newRV((SV *)perl_array)));
 206         for(i=0; i<dim; i++) {
 207                 /* no mortal : it is referenced by the array */
 208                 av_push(perl_array, newSVnv(x_array[i]));
 209         }
 210         XPUSHs(sv_2mortal(newSViv(dim)));
 211         XPUSHs(F->params);
 212         PUTBACK;                                /* make local stack pointer global */
 213
 214         count = call_sv(F->f, G_SCALAR);
 215         SPAGAIN;
 216
 217         if (count != 1)
 218                 croak("Expected to call subroutine in scalar context!");
 219
 220         y = POPn;
 221
 222         PUTBACK;                                /* make local stack pointer global */
 223         FREETMPS;
 224         LEAVE;
 225
 226         return y;
 227     }
 228 %}
 229
 230 %typemap(in) gsl_monte_function * (struct gsl_monte_function_perl w_gsl_monte_function) {
 231     SV * f = 0;
 232     SV * dim = 0;
 233     SV * params = 0;
 234     size_t C_dim;
 235
 236     if (SvROK($input) && (SvTYPE(SvRV($input)) == SVt_PVAV)) {
 237         AV* array=(AV*)SvRV($input);
 238         SV ** p_f = 0;
 239         if (av_len(array)<0) {
 240             croak("Math::GSL : $$1_name is an empty array!");
 241         }
 242         if (av_len(array)>2) {
 243             croak("Math::GSL : $$1_name is an array with more than 3 elements!");
 244         }
 245         p_f = av_fetch(array, 0, 0);
 246         f = *p_f;
 247         if (av_len(array)>0) {
 248             SV ** p_dim = 0;
 249             p_dim = av_fetch(array, 1, 0);
 250             dim = *p_dim;
 251         }
 252         if (av_len(array)>1) {
 253             SV ** p_params = 0;
 254             p_params = av_fetch(array, 1, 0);
 255             params = *p_params;
 256         }
 257     } else {
 258         f = $input;
 259     }
 260
 261     if (!f || !(SvPOK(f) || (SvROK(f) && (SvTYPE(SvRV(f)) == SVt_PVCV)))) {
 262         croak("Math::GSL : $$1_name is not a reference to code!");
 263     }
 264
 265     f = newSVsv(f);
 266
 267     if (! dim) {
 268         dim=&PL_sv_undef;
 269         C_dim=0;
 270     } else {
 271         if (!SvIOK(dim)) {
 272             croak("Math::GSL : $$1_name is not an integer for dim!");
 273         }
 274         C_dim=SvIV(dim);
 275     }
 276     dim = newSVsv(dim);
 277
 278     if (! params) {
 279         params=&PL_sv_undef;
 280     }
 281     params = newSVsv(params);
 282
 283     w_gsl_monte_function.f = f;
 284     w_gsl_monte_function.dim = dim;
 285     w_gsl_monte_function.params = params;
 286     w_gsl_monte_function.C_gsl_monte_function.f = &call_gsl_monte_function;
 287     w_gsl_monte_function.C_gsl_monte_function.dim = C_dim;
 288     w_gsl_monte_function.C_gsl_monte_function.params   = &w_gsl_monte_function;
 289     $1         = &w_gsl_monte_function.C_gsl_monte_function;
 290 };
 291
 292 %typemap(in) gsl_function * (struct gsl_function_perl w_gsl_function) {
 293     SV * function = 0;
 294     SV * params = 0;
 295
 296     if (SvROK($input) && (SvTYPE(SvRV($input)) == SVt_PVAV)) {
 297         AV* array=(AV*)SvRV($input);
 298         SV ** p_function = 0;
 299         if (av_len(array)<0) {
 300             croak("Math::GSL : $$1_name is an empty array!");
 301         }
 302         if (av_len(array)>1) {
 303             croak("Math::GSL : $$1_name is an array with more than 2 elements!");
 304         }
 305         p_function = av_fetch(array, 0, 0);
 306         function = *p_function;
 307         if (av_len(array)>0) {
 308             SV ** p_params = 0;
 309             p_params = av_fetch(array, 1, 0);
 310             params = *p_params;
 311         }
 312     } else {
 313         function = $input;
 314     }
 315
 316     if (!function || !(SvPOK(function) || (SvROK(function) && (SvTYPE(SvRV(function)) == SVt_PVCV)))) {
 317         croak("Math::GSL : $$1_name is not a reference to code!");
 318     }
 319
 320     function = newSVsv(function);
 321
 322     if (! params) {
 323         params=&PL_sv_undef;
 324     }
 325     params = newSVsv(params);
 326
 327     w_gsl_function.params = params;
 328     w_gsl_function.function = function;
 329     w_gsl_function.C_gsl_function.params   = &w_gsl_function;
 330     w_gsl_function.C_gsl_function.function = &call_gsl_function;
 331     $1         = &w_gsl_function.C_gsl_function;
 332 };
 333
 334 %typemap(freearg) gsl_monte_function * {
 335     struct gsl_monte_function_perl *p=(struct gsl_monte_function_perl *) $1->params;
 336     SvREFCNT_dec(p->f);
 337     SvREFCNT_dec(p->dim);
 338     SvREFCNT_dec(p->params);
 339 };
 340
 341 %typemap(freearg) gsl_function * {
 342     struct gsl_function_perl *p=(struct gsl_function_perl *) $1->params;
 343     SvREFCNT_dec(p->function);
 344     SvREFCNT_dec(p->params);
 345 };
 346
 347 /* TODO: same thing should be done for these kinds of callbacks */
 348 %typemap(in) gsl_function_fdf * {
 349     fprintf(stderr, 'FDF_FUNC');
 350     return GSL_NAN;
 351 }