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 size_t const [] {
 110     size_t *p
 111 }
 112
 113 /*****************************
 114  * handle some parameters as input or output
 115  */
 116 %apply int *OUTPUT { size_t *imin, size_t *imax, size_t *neval };
 117 %apply double * OUTPUT {
 118     double * min_out, double * max_out,
 119     double *abserr, double *result
 120 };
 121
 122 /*****************************
 123  * Callback managment
 124  */
 125 %{
 126     /* structure to hold required information while the gsl function call
 127        for each callback
 128      */
 129     struct gsl_function_perl {
 130         gsl_function C_gsl_function;
 131         SV * function;
 132         SV * params;
 133     };
 134     struct gsl_monte_function_perl {
 135         gsl_monte_function C_gsl_monte_function;
 136         SV * f;
 137         SV * dim;
 138         SV * params;
 139     };
 140
 141
 142     /* These functions (C callbacks) calls the perl callbacks.
 143        Info for perl callback can be found using the 'void*params' parameter
 144     */
 145     double call_gsl_function(double x , void *params){
 146         struct gsl_function_perl *F=(struct gsl_function_perl*)params;
 147         unsigned int count;
 148         double y;
 149         dSP;
 150
 151         //fprintf(stderr, "LOOKUP CALLBACK\n");
 152         ENTER;
 153         SAVETMPS;
 154
 155         PUSHMARK(SP);
 156         XPUSHs(sv_2mortal(newSVnv((double)x)));
 157         XPUSHs(F->params);
 158         PUTBACK;                                /* make local stack pointer global */
 159
 160         count = call_sv(F->function, G_SCALAR);
 161         SPAGAIN;
 162
 163         if (count != 1)
 164                 croak("Expected to call subroutine in scalar context!");
 165
 166         y = POPn;
 167
 168         PUTBACK;                                /* make local stack pointer global */
 169         FREETMPS;
 170         LEAVE;
 171
 172         return y;
 173     }
 174     double call_gsl_monte_function(double *x_array , size_t dim, void *params){
 175         struct gsl_monte_function_perl *F=(struct gsl_monte_function_perl*)params;
 176         unsigned int count;
 177         unsigned int i;
 178         AV* perl_array;
 179         double y;
 180         dSP;
 181
 182         //fprintf(stderr, "LOOKUP CALLBACK\n");
 183         ENTER;
 184         SAVETMPS;
 185
 186         PUSHMARK(SP);
 187         perl_array=newAV();
 188         sv_2mortal((SV*)perl_array);
 189         XPUSHs(sv_2mortal(newRV((SV *)perl_array)));
 190         for(i=0; i<dim; i++) {
 191                 /* no mortal : it is referenced by the array */
 192                 av_push(perl_array, newSVnv(x_array[i]));
 193         }
 194         XPUSHs(sv_2mortal(newSViv(dim)));
 195         XPUSHs(F->params);
 196         PUTBACK;                                /* make local stack pointer global */
 197
 198         count = call_sv(F->f, G_SCALAR);
 199         SPAGAIN;
 200
 201         if (count != 1)
 202                 croak("Expected to call subroutine in scalar context!");
 203
 204         y = POPn;
 205
 206         PUTBACK;                                /* make local stack pointer global */
 207         FREETMPS;
 208         LEAVE;
 209
 210         return y;
 211     }
 212 %}
 213
 214 %typemap(in) gsl_monte_function * (struct gsl_monte_function_perl w_gsl_monte_function) {
 215     SV * f = 0;
 216     SV * dim = 0;
 217     SV * params = 0;
 218     size_t C_dim;
 219
 220     if (SvROK($input) && (SvTYPE(SvRV($input)) == SVt_PVAV)) {
 221         AV* array=(AV*)SvRV($input);
 222         SV ** p_f = 0;
 223         if (av_len(array)<0) {
 224             croak("Math::GSL : $$1_name is an empty array!");
 225         }
 226         if (av_len(array)>2) {
 227             croak("Math::GSL : $$1_name is an array with more than 3 elements!");
 228         }
 229         p_f = av_fetch(array, 0, 0);
 230         f = *p_f;
 231         if (av_len(array)>0) {
 232             SV ** p_dim = 0;
 233             p_dim = av_fetch(array, 1, 0);
 234             dim = *p_dim;
 235         }
 236         if (av_len(array)>1) {
 237             SV ** p_params = 0;
 238             p_params = av_fetch(array, 1, 0);
 239             params = *p_params;
 240         }
 241     } else {
 242         f = $input;
 243     }
 244
 245     if (!f || !(SvPOK(f) || (SvROK(f) && (SvTYPE(SvRV(f)) == SVt_PVCV)))) {
 246         croak("Math::GSL : $$1_name is not a reference to code!");
 247     }
 248
 249     f = newSVsv(f);
 250
 251     if (! dim) {
 252         dim=&PL_sv_undef;
 253         C_dim=0;
 254     } else {
 255         if (!SvIOK(dim)) {
 256             croak("Math::GSL : $$1_name is not an integer for dim!");
 257         }
 258         C_dim=SvIV(dim);
 259     }
 260     dim = newSVsv(dim);
 261
 262     if (! params) {
 263         params=&PL_sv_undef;
 264     }
 265     params = newSVsv(params);
 266
 267     w_gsl_monte_function.f = f;
 268     w_gsl_monte_function.dim = dim;
 269     w_gsl_monte_function.params = params;
 270     w_gsl_monte_function.C_gsl_monte_function.f = &call_gsl_monte_function;
 271     w_gsl_monte_function.C_gsl_monte_function.dim = C_dim;
 272     w_gsl_monte_function.C_gsl_monte_function.params   = &w_gsl_monte_function;
 273     $1         = &w_gsl_monte_function.C_gsl_monte_function;
 274 };
 275
 276 %typemap(in) gsl_function * (struct gsl_function_perl w_gsl_function) {
 277     SV * function = 0;
 278     SV * params = 0;
 279
 280     if (SvROK($input) && (SvTYPE(SvRV($input)) == SVt_PVAV)) {
 281         AV* array=(AV*)SvRV($input);
 282         SV ** p_function = 0;
 283         if (av_len(array)<0) {
 284             croak("Math::GSL : $$1_name is an empty array!");
 285         }
 286         if (av_len(array)>1) {
 287             croak("Math::GSL : $$1_name is an array with more than 2 elements!");
 288         }
 289         p_function = av_fetch(array, 0, 0);
 290         function = *p_function;
 291         if (av_len(array)>0) {
 292             SV ** p_params = 0;
 293             p_params = av_fetch(array, 1, 0);
 294             params = *p_params;
 295         }
 296     } else {
 297         function = $input;
 298     }
 299
 300     if (!function || !(SvPOK(function) || (SvROK(function) && (SvTYPE(SvRV(function)) == SVt_PVCV)))) {
 301         croak("Math::GSL : $$1_name is not a reference to code!");
 302     }
 303
 304     function = newSVsv(function);
 305
 306     if (! params) {
 307         params=&PL_sv_undef;
 308     }
 309     params = newSVsv(params);
 310
 311     w_gsl_function.params = params;
 312     w_gsl_function.function = function;
 313     w_gsl_function.C_gsl_function.params   = &w_gsl_function;
 314     w_gsl_function.C_gsl_function.function = &call_gsl_function;
 315     $1         = &w_gsl_function.C_gsl_function;
 316 };
 317
 318 %typemap(freearg) gsl_monte_function * {
 319     struct gsl_monte_function_perl *p=(struct gsl_monte_function_perl *) $1->params;
 320     SvREFCNT_dec(p->f);
 321     SvREFCNT_dec(p->dim);
 322     SvREFCNT_dec(p->params);
 323 };
 324
 325 %typemap(freearg) gsl_function * {
 326     struct gsl_function_perl *p=(struct gsl_function_perl *) $1->params;
 327     SvREFCNT_dec(p->function);
 328     SvREFCNT_dec(p->params);
 329 };
 330
 331 /* TODO: same thing should be done for these kinds of callbacks */
 332 %typemap(in) gsl_function_fdf * {
 333     fprintf(stderr, 'FDF_FUNC');
 334     return GSL_NAN;
 335 }