]> git.saurik.com Git - wxWidgets.git/blob - wxPython/wxSWIG/swig_lib/perl5/ptrlang.i
Since I have made several changes to SWIG over the years to accomodate
[wxWidgets.git] / wxPython / wxSWIG / swig_lib / perl5 / ptrlang.i
1 //
2 // SWIG pointer conversion and utility library
3 //
4 // Dave Beazley
5 // April 19, 1997
6 //
7 // Perl5 specific implementation. This file is included
8 // by the file ../pointer.i
9
10 %{
11
12 #ifdef WIN32
13 #undef isspace
14 #define isspace(c) (c == ' ')
15 #endif
16
17 /*------------------------------------------------------------------
18 ptrcast(value,type)
19
20 Constructs a new pointer value. Value may either be a string
21 or an integer. Type is a string corresponding to either the
22 C datatype or mangled datatype.
23
24 ptrcast(0,"Vector *")
25 or
26 ptrcast(0,"Vector_p")
27 ------------------------------------------------------------------ */
28 #ifdef PERL_OBJECT
29 static SV *_ptrcast(CPerlObj *pPerl, SV *_PTRVALUE, char *type) {
30 #define ptrcast(a,b) _ptrcast(pPerl,a,b)
31 #else
32 static SV *_ptrcast(SV *_PTRVALUE, char *type) {
33 #define ptrcast(a,b) _ptrcast(a,b)
34 #endif
35 char *r,*s;
36 void *ptr;
37 SV *obj;
38 char *typestr,*c;
39
40 /* Produce a "mangled" version of the type string. */
41
42 typestr = (char *) malloc(strlen(type)+20);
43
44 /* Go through and munge the typestring */
45
46 r = typestr;
47 c = type;
48 while (*c) {
49 if (!isspace(*c)) {
50 if ((*c == '*') || (*c == '&')) {
51 strcpy(r,"Ptr");
52 r+=3;
53 } else *(r++) = *c;
54 }
55 c++;
56 }
57 *(r++) = 0;
58
59 /* Check to see if the input value is an integer */
60 if (SvIOK(_PTRVALUE)) {
61 ptr = (void *) SvIV(_PTRVALUE);
62 /* Received a numerical value. Make a pointer out of it */
63 obj = sv_newmortal();
64 sv_setref_pv(obj,typestr,ptr);
65 } else if (sv_isobject(_PTRVALUE)) {
66 /* Have a real pointer value now. Try to strip out the pointer value */
67 /* Now extract the pointer value */
68 if (!SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
69 obj = sv_newmortal();
70 sv_setref_pv(obj,typestr,ptr);
71 }
72 } else {
73 croak("ptrcast(). Not a reference.");
74 }
75 free(typestr);
76 return obj;
77 }
78
79
80
81 /*------------------------------------------------------------------
82 ptrvalue(ptr,type = 0)
83
84 Attempts to dereference a pointer value. If type is given, it
85 will try to use that type. Otherwise, this function will attempt
86 to "guess" the proper datatype by checking against all of the
87 builtin C datatypes.
88 ------------------------------------------------------------------ */
89
90 #ifdef PERL_OBJECT
91 static SV *_ptrvalue(CPerlObj *pPerl,SV *_PTRVALUE, int index, char *type) {
92 #define ptrvalue(a,b,c) _ptrvalue(pPerl,a,b,c)
93 #else
94 static SV *_ptrvalue(SV *_PTRVALUE, int index, char *type) {
95 #define ptrvalue(a,b,c) _ptrvalue(a,b,c)
96 #endif
97
98 void *ptr;
99 SV *obj = 0;
100
101
102 if (SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
103 croak("Type error it ptrvalue. Argument is not a valid pointer value.");
104 } else {
105 /* If no datatype was passed, try a few common datatypes first */
106 if (!type) {
107
108 /* No datatype was passed. Type to figure out if it's a common one */
109
110 if (!SWIG_GetPtr(_PTRVALUE,&ptr,"intPtr")) {
111 type = "int";
112 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) {
113 type = "double";
114 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) {
115 type = "short";
116 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) {
117 type = "long";
118 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) {
119 type = "float";
120 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) {
121 type = "char";
122 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtrPtr")) {
123 type = "char *";
124 } else {
125 type = "unknown";
126 }
127 }
128
129 if (!ptr) {
130 croak("Unable to dereference NULL pointer.");
131 return 0;
132 }
133
134 /* Now we have a datatype. Try to figure out what to do about it */
135 if (strcmp(type,"int") == 0) {
136 obj = sv_newmortal();
137 sv_setiv(obj,(IV) *(((int *) ptr) + index));
138 } else if (strcmp(type,"double") == 0) {
139 obj = sv_newmortal();
140 sv_setnv(obj,(double) *(((double *) ptr)+index));
141 } else if (strcmp(type,"short") == 0) {
142 obj = sv_newmortal();
143 sv_setiv(obj,(IV) *(((short *) ptr) + index));
144 } else if (strcmp(type,"long") == 0) {
145 obj = sv_newmortal();
146 sv_setiv(obj,(IV) *(((long *) ptr) + index));
147 } else if (strcmp(type,"float") == 0) {
148 obj = sv_newmortal();
149 sv_setnv(obj,(double) *(((float *) ptr)+index));
150 } else if (strcmp(type,"char") == 0) {
151 obj = sv_newmortal();
152 sv_setpv(obj,((char *) ptr)+index);
153 } else if (strcmp(type,"char *") == 0) {
154 char *c = *(((char **) ptr)+index);
155 obj = sv_newmortal();
156 if (c)
157 sv_setpv(obj,c);
158 else
159 sv_setpv(obj,"NULL");
160 } else {
161 croak("Unable to dereference unsupported datatype.");
162 obj = 0;
163 }
164 }
165 return obj;
166 }
167
168 /*------------------------------------------------------------------
169 ptrcreate(type,value = 0,numelements = 1)
170
171 Attempts to create a new object of given type. Type must be
172 a basic C datatype. Will not create complex objects.
173 ------------------------------------------------------------------ */
174 #ifdef PERL_OBJECT
175 static SV *_ptrcreate(CPerlObj *pPerl, char *type, SV *value, int numelements) {
176 #define ptrcreate(a,b,c) _ptrcreate(pPerl,a,b,c)
177 #else
178 static SV *_ptrcreate(char *type, SV *value, int numelements) {
179 #define ptrcreate(a,b,c) _ptrcreate(a,b,c)
180 #endif
181
182 void *ptr;
183 SV *obj;
184 int sz;
185 char *cast;
186 char temp[40];
187
188 /* Check the type string against a variety of possibilities */
189
190 if (strcmp(type,"int") == 0) {
191 sz = sizeof(int)*numelements;
192 cast = "intPtr";
193 } else if (strcmp(type,"short") == 0) {
194 sz = sizeof(short)*numelements;
195 cast = "shortPtr";
196 } else if (strcmp(type,"long") == 0) {
197 sz = sizeof(long)*numelements;
198 cast = "longPtr";
199 } else if (strcmp(type,"double") == 0) {
200 sz = sizeof(double)*numelements;
201 cast = "doublePtr";
202 } else if (strcmp(type,"float") == 0) {
203 sz = sizeof(float)*numelements;
204 cast = "floatPtr";
205 } else if (strcmp(type,"char") == 0) {
206 sz = sizeof(char)*numelements;
207 cast = "charPtr";
208 } else if (strcmp(type,"char *") == 0) {
209 sz = sizeof(char *)*(numelements+1);
210 cast = "charPtrPtr";
211 } else if (strcmp(type,"void") == 0) {
212 sz = numelements;
213 cast = "voidPtr";
214 } else {
215 croak("Unable to create unknown datatype.");
216 return 0;
217 }
218
219 /* Create the new object */
220
221 ptr = (void *) malloc(sz);
222 if (!ptr) {
223 croak("Out of memory in ptrcreate.");
224 return 0;
225 }
226
227 /* Now try to set its default value */
228
229 if (value) {
230 if (strcmp(type,"int") == 0) {
231 int *ip,i,ivalue;
232 ivalue = (int) SvIV(value);
233 ip = (int *) ptr;
234 for (i = 0; i < numelements; i++)
235 ip[i] = ivalue;
236 } else if (strcmp(type,"short") == 0) {
237 short *ip,ivalue;
238 int i;
239 ivalue = (short) SvIV(value);
240 ip = (short *) ptr;
241 for (i = 0; i < numelements; i++)
242 ip[i] = ivalue;
243 } else if (strcmp(type,"long") == 0) {
244 long *ip,ivalue;
245 int i;
246 ivalue = (long) SvIV(value);
247 ip = (long *) ptr;
248 for (i = 0; i < numelements; i++)
249 ip[i] = ivalue;
250 } else if (strcmp(type,"double") == 0) {
251 double *ip,ivalue;
252 int i;
253 ivalue = (double) SvNV(value);
254 ip = (double *) ptr;
255 for (i = 0; i < numelements; i++)
256 ip[i] = ivalue;
257 } else if (strcmp(type,"float") == 0) {
258 float *ip,ivalue;
259 int i;
260 ivalue = (float) SvNV(value);
261 ip = (float *) ptr;
262 for (i = 0; i < numelements; i++)
263 ip[i] = ivalue;
264 } else if (strcmp(type,"char") == 0) {
265 char *ip,*ivalue;
266 ivalue = (char *) SvPV(value,PL_na);
267 ip = (char *) ptr;
268 strncpy(ip,ivalue,numelements-1);
269 } else if (strcmp(type,"char *") == 0) {
270 char **ip, *ivalue;
271 int i;
272 ivalue = (char *) SvPV(value,PL_na);
273 ip = (char **) ptr;
274 for (i = 0; i < numelements; i++) {
275 if (ivalue) {
276 ip[i] = (char *) malloc(strlen(ivalue)+1);
277 strcpy(ip[i],ivalue);
278 } else {
279 ip[i] = 0;
280 }
281 }
282 ip[numelements] = 0;
283 }
284 }
285 /* Create the pointer value */
286
287 SWIG_MakePtr(temp,ptr,cast);
288 obj = sv_newmortal();
289 sv_setref_pv(obj,cast,ptr);
290 return obj;
291 }
292
293 /*------------------------------------------------------------------
294 ptrset(ptr,value,index = 0,type = 0)
295
296 Attempts to set the value of a pointer variable. If type is
297 given, we will use that type. Otherwise, we'll guess the datatype.
298 ------------------------------------------------------------------ */
299
300 #ifdef PERL_OBJECT
301 static void _ptrset(CPerlObj *pPerl,SV *_PTRVALUE, SV *value, int index, char *type) {
302 #define ptrset(a,b,c,d) _ptrset(pPerl,a,b,c,d)
303 #else
304 static void _ptrset(SV *_PTRVALUE, SV *value, int index, char *type) {
305 #define ptrset(a,b,c,d) _ptrset(a,b,c,d)
306 #endif
307 void *ptr;
308 SV *obj;
309
310 if (SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
311 croak("Type error in ptrset. Argument is not a valid pointer value.");
312 return;
313 }
314
315 /* If no datatype was passed, try a few common datatypes first */
316
317 if (!type) {
318
319 /* No datatype was passed. Type to figure out if it's a common one */
320
321 if (!SWIG_GetPtr(_PTRVALUE,&ptr,"intPtr")) {
322 type = "int";
323 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) {
324 type = "double";
325 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) {
326 type = "short";
327 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) {
328 type = "long";
329 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) {
330 type = "float";
331 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) {
332 type = "char";
333 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtrPtr")) {
334 type = "char *";
335 } else {
336 type = "unknown";
337 }
338 }
339
340 if (!ptr) {
341 croak("Unable to set NULL pointer.");
342 return;
343 }
344
345 /* Now we have a datatype. Try to figure out what to do about it */
346 if (strcmp(type,"int") == 0) {
347 *(((int *) ptr)+index) = (int) SvIV(value);
348 } else if (strcmp(type,"double") == 0) {
349 *(((double *) ptr)+index) = (double) SvNV(value);
350 } else if (strcmp(type,"short") == 0) {
351 *(((short *) ptr)+index) = (short) SvIV(value);
352 } else if (strcmp(type,"long") == 0) {
353 *(((long *) ptr)+index) = (long) SvIV(value);
354 } else if (strcmp(type,"float") == 0) {
355 *(((float *) ptr)+index) = (float) SvNV(value);
356 } else if (strcmp(type,"char") == 0) {
357 char *c = SvPV(value,PL_na);
358 strcpy(((char *) ptr)+index, c);
359 } else if (strcmp(type,"char *") == 0) {
360 char *c = SvPV(value,PL_na);
361 char **ca = (char **) ptr;
362 if (ca[index]) free(ca[index]);
363 if (strcmp(c,"NULL") == 0) {
364 ca[index] = 0;
365 } else {
366 ca[index] = (char *) malloc(strlen(c)+1);
367 strcpy(ca[index],c);
368 }
369 } else {
370 croak("Unable to set unsupported datatype.");
371 return;
372 }
373 }
374
375 /*------------------------------------------------------------------
376 ptradd(ptr,offset)
377
378 Adds a value to an existing pointer value. Will do a type-dependent
379 add for basic datatypes. For other datatypes, will do a byte-add.
380 ------------------------------------------------------------------ */
381
382 #ifdef PERL_OBJECT
383 static SV *_ptradd(CPerlObj *pPerl, SV *_PTRVALUE, int offset) {
384 #define ptradd(a,b) _ptradd(pPerl,a,b)
385 #else
386 static SV *_ptradd(SV *_PTRVALUE, int offset) {
387 #define ptradd(a,b) _ptradd(a,b)
388 #endif
389
390 void *ptr,*junk;
391 SV *obj;
392 char *type;
393
394 /* Try to handle a few common datatypes first */
395
396 if (!SWIG_GetPtr(_PTRVALUE,&ptr,"intPtr")) {
397 ptr = (void *) (((int *) ptr) + offset);
398 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) {
399 ptr = (void *) (((double *) ptr) + offset);
400 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) {
401 ptr = (void *) (((short *) ptr) + offset);
402 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) {
403 ptr = (void *) (((long *) ptr) + offset);
404 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) {
405 ptr = (void *) (((float *) ptr) + offset);
406 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) {
407 ptr = (void *) (((char *) ptr) + offset);
408 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
409 ptr = (void *) (((char *) ptr) + offset);
410 } else {
411 croak("Type error in ptradd. Argument is not a valid pointer value.");
412 return 0;
413 }
414 type = SWIG_GetPtr(_PTRVALUE,&junk,"INVALID POINTER");
415 obj = sv_newmortal();
416 sv_setref_pv(obj,type,ptr);
417 return obj;
418 }
419
420 /*------------------------------------------------------------------
421 ptrmap(type1,type2)
422
423 Allows a mapping between type1 and type2. (Like a typedef)
424 ------------------------------------------------------------------ */
425
426 #ifdef PERL_OBJECT
427 static void _ptrmap(CPerlObj *pPerl,char *type1, char *type2) {
428 #define ptrmap(a,b) _ptrmap(pPerl,a,b)
429 #else
430 static void _ptrmap(char *type1, char *type2) {
431 #define ptrmap(a,b) _ptrmap(a,b)
432 #endif
433 char *typestr1,*typestr2,*c,*r;
434 /* Produce a "mangled" version of the type string. */
435
436 typestr1 = (char *) malloc(strlen(type1)+20);
437
438
439 /* Go through and munge the typestring */
440
441 r = typestr1;
442 *(r++) = '_';
443 c = type1;
444
445 while (*c) {
446 if (!isspace(*c)) {
447 if ((*c == '*') || (*c == '&')) {
448 strcpy(r,"Ptr");
449 r+=3;
450 }
451 else *(r++) = *c;
452 }
453 c++;
454 }
455 *(r++) = 0;
456
457 typestr2 = (char *) malloc(strlen(type2)+20);
458
459 /* Go through and munge the typestring */
460
461 r = typestr2;
462 *(r++) = '_';
463 c = type2;
464 while (*c) {
465 if (!isspace(*c)) {
466 if ((*c == '*') || (*c == '&')) {
467 strcpy(r,"Ptr");
468 r+=3;
469 }
470 else *(r++) = *c;
471 }
472 c++;
473 }
474 *(r++) = 0;
475 SWIG_RegisterMapping(typestr1,typestr2,0);
476 SWIG_RegisterMapping(typestr2,typestr1,0);
477 }
478
479 /*------------------------------------------------------------------
480 ptrfree(ptr)
481
482 Destroys a pointer value
483 ------------------------------------------------------------------ */
484 #ifdef PERL_OBJECT
485 void _ptrfree(CPerlObj *pPerl, SV *_PTRVALUE) {
486 #define ptrfree(a) _ptrfree(pPerl, a)
487 #else
488 void _ptrfree(SV *_PTRVALUE) {
489 #define ptrfree(a) _ptrfree(a)
490 #endif
491
492 void *ptr, *junk;
493
494 if (SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
495 croak("Type error in ptrfree. Argument is not a valid pointer value.");
496 return;
497 }
498
499 /* Check to see if this pointer is a char ** */
500 if (!SWIG_GetPtr(_PTRVALUE,&junk,"charPtrPtr")) {
501 char **c = (char **) ptr;
502 if (c) {
503 int i = 0;
504 while (c[i]) {
505 free(c[i]);
506 i++;
507 }
508 }
509 }
510 if (ptr)
511 free((char *) ptr);
512 }
513
514 %}
515
516 %typemap(perl5,in) SV *ptr, SV *value {
517 $target = $source;
518 }
519
520
521 %typemap(perl5,out) SV *ptrcast,
522 SV *ptrvalue,
523 SV *ptrcreate,
524 SV *ptradd
525 {
526 $target = $source;
527 argvi++;
528 }
529
530 %typemap(perl5,ret) int ptrset {
531 if ($source == -1) return NULL;
532 }
533
534 SV *ptrcast(SV *ptr, char *type);
535 // Casts a pointer ptr to a new datatype given by the string type.
536 // type may be either the SWIG generated representation of a datatype
537 // or the C representation. For example :
538 //
539 // ptrcast($ptr,"doublePtr"); # Perl5 representation
540 // ptrcast($ptr,"double *"); # C representation
541 //
542 // A new pointer value is returned. ptr may also be an integer
543 // value in which case the value will be used to set the pointer
544 // value. For example :
545 //
546 // $a = ptrcast(0,"VectorPtr");
547 //
548 // Will create a NULL pointer of type "VectorPtr"
549 //
550 // The casting operation is sensitive to formatting. As a result,
551 // "double *" is different than "double*". As a result of thumb,
552 // there should always be exactly one space between the C datatype
553 // and any pointer specifiers (*).
554
555 SV *ptrvalue(SV *ptr, int index = 0, char *type = 0);
556 // Returns the value that a pointer is pointing to (ie. dereferencing).
557 // The type is automatically inferred by the pointer type--thus, an
558 // integer pointer will return an integer, a double will return a double,
559 // and so on. The index and type fields are optional parameters. When
560 // an index is specified, this function returns the value of ptr[index].
561 // This allows array access. When a type is specified, it overrides
562 // the given pointer type. Examples :
563 //
564 // ptrvalue($a) # Returns the value *a
565 // ptrvalue($a,10) # Returns the value a[10]
566 // ptrvalue($a,10,"double") # Returns a[10] assuming a is a double *
567
568
569 void ptrset(SV *ptr, SV *value, int index = 0, char *type = 0);
570 // Sets the value pointed to by a pointer. The type is automatically
571 // inferred from the pointer type so this function will work for
572 // integers, floats, doubles, etc... The index and type fields are
573 // optional. When an index is given, it provides array access. When
574 // type is specified, it overrides the given pointer type. Examples :
575 //
576 // ptrset($a,3) # Sets the value *a = 3
577 // ptrset($a,3,10) # Sets a[10] = 3
578 // ptrset($a,3,10,"int") # Sets a[10] = 3 assuming a is a int *
579
580
581 SV *ptrcreate(char *type, SV *value = 0, int nitems = 1);
582 // Creates a new object and returns a pointer to it. This function
583 // can be used to create various kinds of objects for use in C functions.
584 // type specifies the basic C datatype to create and value is an
585 // optional parameter that can be used to set the initial value of the
586 // object. nitems is an optional parameter that can be used to create
587 // an array. This function results in a memory allocation using
588 // malloc(). Examples :
589 //
590 // $a = ptrcreate("double") # Create a new double, return pointer
591 // $a = ptrcreate("int",7) # Create an integer, set value to 7
592 // $a = ptrcreate("int",0,1000) # Create an integer array with initial
593 // # values all set to zero
594 //
595 // This function only recognizes a few common C datatypes as listed below :
596 //
597 // int, short, long, float, double, char, char *, void
598 //
599 // All other datatypes will result in an error. However, other
600 // datatypes can be created by using the ptrcast function. For
601 // example:
602 //
603 // $a = ptrcast(ptrcreate("int",0,100),"unsigned int *")
604
605
606 void ptrfree(SV *ptr);
607 // Destroys the memory pointed to by ptr. This function calls free()
608 // and should only be used with objects created by ptrcreate(). Since
609 // this function calls free, it may work with other objects, but this
610 // is generally discouraged unless you absolutely know what you're
611 // doing.
612
613 SV *ptradd(SV *ptr, int offset);
614 // Adds a value to the current pointer value. For the C datatypes of
615 // int, short, long, float, double, and char, the offset value is the
616 // number of objects and works in exactly the same manner as in C. For
617 // example, the following code steps through the elements of an array
618 //
619 // $a = ptrcreate("double",0,100); # Create an array double a[100]
620 // $b = $a;
621 // for ($i = 0; $i < 100; $i++) {
622 // ptrset($b,0.0025*$i); # set *b = 0.0025*i
623 // $b = ptradd($b,1); # b++ (go to next double)
624 // }
625 //
626 // In this case, adding one to b goes to the next double.
627 //
628 // For all other datatypes (including all complex datatypes), the
629 // offset corresponds to bytes. This function does not perform any
630 // bounds checking and negative offsets are perfectly legal.
631
632 void ptrmap(char *type1, char *type2);
633 // This is a rarely used function that performs essentially the same
634 // operation as a C typedef. To manage datatypes at run-time, SWIG
635 // modules manage an internal symbol table of type mappings. This
636 // table keeps track of which types are equivalent to each other. The
637 // ptrmap() function provides a mechanism for scripts to add symbols
638 // to this table. For example :
639 //
640 // ptrmap("doublePtr","RealPtr");
641 //
642 // would make the types "doublePtr" and "RealPtr" equivalent to each
643 // other. Pointers of either type could now be used interchangably.
644 //
645 // Normally this function is not needed, but it can be used to
646 // circumvent SWIG's normal type-checking behavior or to work around
647 // weird type-handling problems.
648
649
650