Merge branch 'bleed' of ssh://leto.net/git/Math-GSL into bleed
[Math-GSL.git] / swig / gsl_typemaps.i
blob987e713897d46679d43d521760fc7ddc59e376cf
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
7 %{
8 #include "gsl/gsl_nan.h"
9 #include "gsl/gsl_math.h"
10 #include "gsl/gsl_monte.h"
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
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!");
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);
36 %typemap(freearg) double const [] {
37 if ($1) free($1);
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
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
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!");
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);
74 %typemap(freearg) float const [] {
75 if ($1) free($1);
78 %apply float const [] {
79 float const *A, float const *B, float const *C
82 /*****************************
83 * handle 'float []' as an in/out array of floats
84 * We allocate the C array at the begining and free it at the end
85 * We modify the perl array IN PLACE (not sure other langage can do that
86 * but perl can)
87 * Note the trick to store some private info before the C array
88 * as swig require that $1 points to the C array (as it uses it
89 * when calling the gsl function)
92 struct perl_array {
93 I32 len;
94 AV *array;
98 %typemap(in) float [] {
99 struct perl_array * p_array = 0;
100 I32 len;
101 AV *array;
102 int i;
103 SV **tv;
104 if (!SvROK($input))
105 croak("Math::GSL : $$1_name is not a reference!");
106 if (SvTYPE(SvRV($input)) != SVt_PVAV)
107 croak("Math::GSL : $$1_name is not an array ref!");
109 array = (AV*)SvRV($input);
110 len = av_len(array);
111 p_array = (struct perl_array *) malloc((len+1)*sizeof(float)+sizeof(struct perl_array));
112 p_array->len=len;
113 p_array->array=array;
114 $1 = (float *)&p_array[1];
115 for (i = 0; i <= len; i++) {
116 tv = av_fetch(array, i, 0);
117 $1[i] = (float)(double) SvNV(*tv);
121 %typemap(argout) float [] {
122 struct perl_array * p_array = 0;
123 int i;
124 SV **tv;
125 p_array=(struct perl_array *)(((char*)$1)-sizeof(struct perl_array));
126 for (i = 0; i <= p_array->len; i++) {
127 double val=(double)(float)($1[i]);
128 tv = av_fetch(p_array->array, i, 0);
129 sv_setnv(*tv, val);
130 if (argvi >= items) {
131 EXTEND(sp,1); /* Extend the stack by 1 object */
133 $result = sv_newmortal();
134 sv_setnv($result, val);
135 argvi++;
139 %typemap(freearg) float [] {
140 if ($1) free(((char*)$1)-sizeof(struct perl_array));
143 %apply float const [] {
144 float *C
147 /*****************************
148 * handle 'size_t const []' as an input array of size_t
149 * We allocate the C array at the begining and free it at the end
151 %typemap(in) size_t const [] {
152 AV *tempav;
153 I32 len;
154 int i;
155 SV **tv;
156 if (!SvROK($input))
157 croak("Math::GSL : $$1_name is not a reference!");
158 if (SvTYPE(SvRV($input)) != SVt_PVAV)
159 croak("Math::GSL : $$1_name is not an array ref!");
161 tempav = (AV*)SvRV($input);
162 len = av_len(tempav);
163 $1 = (size_t *) malloc((len+1)*sizeof(size_t));
164 for (i = 0; i <= len; i++) {
165 tv = av_fetch(tempav, i, 0);
166 $1[i] = SvIV(*tv);
170 %typemap(freearg) size_t const [] {
171 if ($1) free($1);
174 %apply double const [] {
175 double *data, double *dest, double *f_in, double *f_out,
176 double data[], const double * src, double x[], double a[], double b[],
177 double xu[], double xl[],
178 const double * x, const double * y, const double * w , const double x_array[],
179 const double xrange[], const double yrange[], double * base,
180 const double * base, const double xrange[], const double yrange[] ,
181 const double * array , const double data2[], const double w[] ,
182 double *v,
183 gsl_complex_packed_array data
186 %apply float const [] {
187 float const *A, float const *B, float const *C, float *C
190 %apply size_t const [] {
191 size_t *p
194 /*****************************
195 * handle some parameters as input or output
197 %apply int *OUTPUT { size_t *imin, size_t *imax, size_t *neval };
198 %apply double * OUTPUT {
199 double * min_out, double * max_out,
200 double *abserr, double *result
203 /*****************************
204 * Callback managment
207 /* structure to hold required information while the gsl function call
208 for each callback
210 struct gsl_function_perl {
211 gsl_function C_gsl_function;
212 SV * function;
213 SV * params;
215 struct gsl_monte_function_perl {
216 gsl_monte_function C_gsl_monte_function;
217 SV * f;
218 SV * dim;
219 SV * params;
223 /* These functions (C callbacks) calls the perl callbacks.
224 Info for perl callback can be found using the 'void*params' parameter
226 double call_gsl_function(double x , void *params){
227 struct gsl_function_perl *F=(struct gsl_function_perl*)params;
228 unsigned int count;
229 double y;
230 dSP;
232 //fprintf(stderr, "LOOKUP CALLBACK\n");
233 ENTER;
234 SAVETMPS;
236 PUSHMARK(SP);
237 XPUSHs(sv_2mortal(newSVnv((double)x)));
238 XPUSHs(F->params);
239 PUTBACK; /* make local stack pointer global */
241 count = call_sv(F->function, G_SCALAR);
242 SPAGAIN;
244 if (count != 1)
245 croak("Expected to call subroutine in scalar context!");
247 y = POPn;
249 PUTBACK; /* make local stack pointer global */
250 FREETMPS;
251 LEAVE;
253 return y;
255 double call_gsl_monte_function(double *x_array , size_t dim, void *params){
256 struct gsl_monte_function_perl *F=(struct gsl_monte_function_perl*)params;
257 unsigned int count;
258 unsigned int i;
259 AV* perl_array;
260 double y;
261 dSP;
263 //fprintf(stderr, "LOOKUP CALLBACK\n");
264 ENTER;
265 SAVETMPS;
267 PUSHMARK(SP);
268 perl_array=newAV();
269 sv_2mortal((SV*)perl_array);
270 XPUSHs(sv_2mortal(newRV((SV *)perl_array)));
271 for(i=0; i<dim; i++) {
272 /* no mortal : it is referenced by the array */
273 av_push(perl_array, newSVnv(x_array[i]));
275 XPUSHs(sv_2mortal(newSViv(dim)));
276 XPUSHs(F->params);
277 PUTBACK; /* make local stack pointer global */
279 count = call_sv(F->f, G_SCALAR);
280 SPAGAIN;
282 if (count != 1)
283 croak("Expected to call subroutine in scalar context!");
285 y = POPn;
287 PUTBACK; /* make local stack pointer global */
288 FREETMPS;
289 LEAVE;
291 return y;
295 %typemap(in) gsl_monte_function * (struct gsl_monte_function_perl w_gsl_monte_function) {
296 SV * f = 0;
297 SV * dim = 0;
298 SV * params = 0;
299 size_t C_dim;
301 if (SvROK($input) && (SvTYPE(SvRV($input)) == SVt_PVAV)) {
302 AV* array=(AV*)SvRV($input);
303 SV ** p_f = 0;
304 if (av_len(array)<0) {
305 croak("Math::GSL : $$1_name is an empty array!");
307 if (av_len(array)>2) {
308 croak("Math::GSL : $$1_name is an array with more than 3 elements!");
310 p_f = av_fetch(array, 0, 0);
311 f = *p_f;
312 if (av_len(array)>0) {
313 SV ** p_dim = 0;
314 p_dim = av_fetch(array, 1, 0);
315 dim = *p_dim;
317 if (av_len(array)>1) {
318 SV ** p_params = 0;
319 p_params = av_fetch(array, 1, 0);
320 params = *p_params;
322 } else {
323 f = $input;
326 if (!f || !(SvPOK(f) || (SvROK(f) && (SvTYPE(SvRV(f)) == SVt_PVCV)))) {
327 croak("Math::GSL : $$1_name is not a reference to code!");
330 f = newSVsv(f);
332 if (! dim) {
333 dim=&PL_sv_undef;
334 C_dim=0;
335 } else {
336 if (!SvIOK(dim)) {
337 croak("Math::GSL : $$1_name is not an integer for dim!");
339 C_dim=SvIV(dim);
341 dim = newSVsv(dim);
343 if (! params) {
344 params=&PL_sv_undef;
346 params = newSVsv(params);
348 w_gsl_monte_function.f = f;
349 w_gsl_monte_function.dim = dim;
350 w_gsl_monte_function.params = params;
351 w_gsl_monte_function.C_gsl_monte_function.f = &call_gsl_monte_function;
352 w_gsl_monte_function.C_gsl_monte_function.dim = C_dim;
353 w_gsl_monte_function.C_gsl_monte_function.params = &w_gsl_monte_function;
354 $1 = &w_gsl_monte_function.C_gsl_monte_function;
357 %typemap(in) gsl_function * (struct gsl_function_perl w_gsl_function) {
358 SV * function = 0;
359 SV * params = 0;
361 if (SvROK($input) && (SvTYPE(SvRV($input)) == SVt_PVAV)) {
362 AV* array=(AV*)SvRV($input);
363 SV ** p_function = 0;
364 if (av_len(array)<0) {
365 croak("Math::GSL : $$1_name is an empty array!");
367 if (av_len(array)>1) {
368 croak("Math::GSL : $$1_name is an array with more than 2 elements!");
370 p_function = av_fetch(array, 0, 0);
371 function = *p_function;
372 if (av_len(array)>0) {
373 SV ** p_params = 0;
374 p_params = av_fetch(array, 1, 0);
375 params = *p_params;
377 } else {
378 function = $input;
381 if (!function || !(SvPOK(function) || (SvROK(function) && (SvTYPE(SvRV(function)) == SVt_PVCV)))) {
382 croak("Math::GSL : $$1_name is not a reference to code!");
385 function = newSVsv(function);
387 if (! params) {
388 params=&PL_sv_undef;
390 params = newSVsv(params);
392 w_gsl_function.params = params;
393 w_gsl_function.function = function;
394 w_gsl_function.C_gsl_function.params = &w_gsl_function;
395 w_gsl_function.C_gsl_function.function = &call_gsl_function;
396 $1 = &w_gsl_function.C_gsl_function;
399 %typemap(freearg) gsl_monte_function * {
400 struct gsl_monte_function_perl *p=(struct gsl_monte_function_perl *) $1->params;
401 SvREFCNT_dec(p->f);
402 SvREFCNT_dec(p->dim);
403 SvREFCNT_dec(p->params);
406 %typemap(freearg) gsl_function * {
407 struct gsl_function_perl *p=(struct gsl_function_perl *) $1->params;
408 SvREFCNT_dec(p->function);
409 SvREFCNT_dec(p->params);
412 /* TODO: same thing should be done for these kinds of callbacks */
413 %typemap(in) gsl_function_fdf * {
414 fprintf(stderr, 'FDF_FUNC');
415 return GSL_NAN;