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