2
// SWIG pointer conversion and utility library
7
// Perl5 specific implementation. This file is included
8
// by the file ../pointer.i
13
/* Types used by the library */
14
static swig_type_info *SWIG_POINTER_int_p = 0;
15
static swig_type_info *SWIG_POINTER_short_p =0;
16
static swig_type_info *SWIG_POINTER_long_p = 0;
17
static swig_type_info *SWIG_POINTER_float_p = 0;
18
static swig_type_info *SWIG_POINTER_double_p = 0;
19
static swig_type_info *SWIG_POINTER_char_p = 0;
20
static swig_type_info *SWIG_POINTER_char_pp = 0;
21
static swig_type_info *SWIG_POINTER_void_p = 0;
25
SWIG_POINTER_int_p = SWIG_TypeQuery("int *");
26
SWIG_POINTER_short_p = SWIG_TypeQuery("short *");
27
SWIG_POINTER_long_p = SWIG_TypeQuery("long *");
28
SWIG_POINTER_float_p = SWIG_TypeQuery("float *");
29
SWIG_POINTER_double_p = SWIG_TypeQuery("double *");
30
SWIG_POINTER_char_p = SWIG_TypeQuery("char *");
31
SWIG_POINTER_char_pp = SWIG_TypeQuery("char **");
32
SWIG_POINTER_void_p = SWIG_TypeQuery("void *");
39
#define isspace(c) (c == ' ')
43
/*------------------------------------------------------------------
44
ptrvalue(ptr,type = 0)
46
Attempts to dereference a pointer value. If type is given, it
47
will try to use that type. Otherwise, this function will attempt
48
to "guess" the proper datatype by checking against all of the
50
------------------------------------------------------------------ */
53
static SV *_ptrvalue(CPerlObj *pPerl,SV *_PTRVALUE, int index, const char *type) {
54
#define ptrvalue(a,b,c) _ptrvalue(pPerl,a,b,c)
56
static SV *_ptrvalue(SV *_PTRVALUE, int index, const char *type) {
57
#define ptrvalue(a,b,c) _ptrvalue(a,b,c)
63
if (SWIG_ConvertPtr(_PTRVALUE, &ptr, 0) < 0) {
64
croak("Type error it ptrvalue. Argument is not a valid pointer value.");
66
/* If no datatype was passed, try a few common datatypes first */
69
/* No datatype was passed. Type to figure out if it's a common one */
71
if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_int_p) >= 0) {
73
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_double_p) >= 0) {
75
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_short_p) >= 0) {
77
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_long_p) >= 0) {
79
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_float_p) >= 0) {
81
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_p) >= 0) {
83
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_pp) >= 0) {
91
croak("Unable to dereference NULL pointer.");
95
/* Now we have a datatype. Try to figure out what to do about it */
96
if (strcmp(type,"int") == 0) {
98
sv_setiv(obj,(IV) *(((int *) ptr) + index));
99
} else if (strcmp(type,"double") == 0) {
100
obj = sv_newmortal();
101
sv_setnv(obj,(double) *(((double *) ptr)+index));
102
} else if (strcmp(type,"short") == 0) {
103
obj = sv_newmortal();
104
sv_setiv(obj,(IV) *(((short *) ptr) + index));
105
} else if (strcmp(type,"long") == 0) {
106
obj = sv_newmortal();
107
sv_setiv(obj,(IV) *(((long *) ptr) + index));
108
} else if (strcmp(type,"float") == 0) {
109
obj = sv_newmortal();
110
sv_setnv(obj,(double) *(((float *) ptr)+index));
111
} else if (strcmp(type,"char") == 0) {
112
obj = sv_newmortal();
113
sv_setpv(obj,((char *) ptr)+index);
114
} else if (strcmp(type,"char *") == 0) {
115
char *c = *(((char **) ptr)+index);
116
obj = sv_newmortal();
120
sv_setpv(obj,"NULL");
122
croak("Unable to dereference unsupported datatype.");
129
/*------------------------------------------------------------------
130
ptrcreate(type,value = 0,numelements = 1)
132
Attempts to create a new object of given type. Type must be
133
a basic C datatype. Will not create complex objects.
134
------------------------------------------------------------------ */
136
static SV *_ptrcreate(CPerlObj *pPerl, char *type, SV *value, int numelements) {
137
#define ptrcreate(a,b,c) _ptrcreate(pPerl,a,b,c)
139
static SV *_ptrcreate(char *type, SV *value, int numelements) {
140
#define ptrcreate(a,b,c) _ptrcreate(a,b,c)
146
swig_type_info *cast = 0;
148
/* Check the type string against a variety of possibilities */
150
if (strcmp(type,"int") == 0) {
151
sz = sizeof(int)*numelements;
152
cast = SWIG_POINTER_int_p;
153
} else if (strcmp(type,"short") == 0) {
154
sz = sizeof(short)*numelements;
155
cast = SWIG_POINTER_short_p;
156
} else if (strcmp(type,"long") == 0) {
157
sz = sizeof(long)*numelements;
158
cast = SWIG_POINTER_long_p;
159
} else if (strcmp(type,"double") == 0) {
160
sz = sizeof(double)*numelements;
161
cast = SWIG_POINTER_double_p;
162
} else if (strcmp(type,"float") == 0) {
163
sz = sizeof(float)*numelements;
164
cast = SWIG_POINTER_float_p;
165
} else if (strcmp(type,"char") == 0) {
166
sz = sizeof(char)*numelements;
167
cast = SWIG_POINTER_char_p;
168
} else if (strcmp(type,"char *") == 0) {
169
sz = sizeof(char *)*(numelements+1);
170
cast = SWIG_POINTER_char_pp;
171
} else if (strcmp(type,"void") == 0) {
173
cast = SWIG_POINTER_void_p;
175
croak("Unable to create unknown datatype.");
179
/* Create the new object */
181
ptr = (void *) calloc(1,sz);
183
croak("Out of memory in ptrcreate.");
187
/* Now try to set its default value */
190
if (strcmp(type,"int") == 0) {
192
ivalue = (int) SvIV(value);
194
for (i = 0; i < numelements; i++)
196
} else if (strcmp(type,"short") == 0) {
199
ivalue = (short) SvIV(value);
201
for (i = 0; i < numelements; i++)
203
} else if (strcmp(type,"long") == 0) {
206
ivalue = (long) SvIV(value);
208
for (i = 0; i < numelements; i++)
210
} else if (strcmp(type,"double") == 0) {
213
ivalue = (double) SvNV(value);
215
for (i = 0; i < numelements; i++)
217
} else if (strcmp(type,"float") == 0) {
220
ivalue = (float) SvNV(value);
222
for (i = 0; i < numelements; i++)
224
} else if (strcmp(type,"char") == 0) {
226
ivalue = (char *) SvPV(value,PL_na);
228
strncpy(ip,ivalue,numelements-1);
229
} else if (strcmp(type,"char *") == 0) {
232
ivalue = (char *) SvPV(value,PL_na);
234
for (i = 0; i < numelements; i++) {
236
ip[i] = (char *) malloc(strlen(ivalue)+1);
237
strcpy(ip[i],ivalue);
245
/* Create the pointer value */
248
obj = sv_newmortal();
249
SWIG_MakePtr(obj,ptr,cast);
253
/*------------------------------------------------------------------
254
ptrset(ptr,value,index = 0,type = 0)
256
Attempts to set the value of a pointer variable. If type is
257
given, we will use that type. Otherwise, we'll guess the datatype.
258
------------------------------------------------------------------ */
261
static void _ptrset(CPerlObj *pPerl,SV *_PTRVALUE, SV *value, int index, const char *type) {
262
#define ptrset(a,b,c,d) _ptrset(pPerl,a,b,c,d)
264
static void _ptrset(SV *_PTRVALUE, SV *value, int index, const char *type) {
265
#define ptrset(a,b,c,d) _ptrset(a,b,c,d)
271
if (SWIG_ConvertPtr(_PTRVALUE, &ptr, 0) < 0) {
272
croak("Type error it ptrvalue. Argument is not a valid pointer value.");
274
/* If no datatype was passed, try a few common datatypes first */
276
/* No datatype was passed. Type to figure out if it's a common one */
277
if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_int_p) >= 0) {
279
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_double_p) >= 0) {
281
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_short_p) >= 0) {
283
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_long_p) >= 0) {
285
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_float_p) >= 0) {
287
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_p) >= 0) {
289
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_pp) >= 0) {
297
croak("Unable to set NULL pointer.");
301
/* Now we have a datatype. Try to figure out what to do about it */
302
if (strcmp(type,"int") == 0) {
303
*(((int *) ptr)+index) = (int) SvIV(value);
304
} else if (strcmp(type,"double") == 0) {
305
*(((double *) ptr)+index) = (double) SvNV(value);
306
} else if (strcmp(type,"short") == 0) {
307
*(((short *) ptr)+index) = (short) SvIV(value);
308
} else if (strcmp(type,"long") == 0) {
309
*(((long *) ptr)+index) = (long) SvIV(value);
310
} else if (strcmp(type,"float") == 0) {
311
*(((float *) ptr)+index) = (float) SvNV(value);
312
} else if (strcmp(type,"char") == 0) {
313
char *c = SvPV(value,PL_na);
314
strcpy(((char *) ptr)+index, c);
315
} else if (strcmp(type,"char *") == 0) {
316
char *c = SvPV(value,PL_na);
317
char **ca = (char **) ptr;
318
if (ca[index]) free(ca[index]);
319
if (strcmp(c,"NULL") == 0) {
322
ca[index] = (char *) malloc(strlen(c)+1);
326
croak("Unable to set unsupported datatype.");
331
/*------------------------------------------------------------------
334
Adds a value to an existing pointer value. Will do a type-dependent
335
add for basic datatypes. For other datatypes, will do a byte-add.
336
------------------------------------------------------------------ */
339
static SV *_ptradd(CPerlObj *pPerl, SV *_PTRVALUE, int offset) {
340
#define ptradd(a,b) _ptradd(pPerl,a,b)
342
static SV *_ptradd(SV *_PTRVALUE, int offset) {
343
#define ptradd(a,b) _ptradd(a,b)
348
swig_type_info *type;
351
/* Try to handle a few common datatypes first */
353
if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_int_p) >= 0) {
354
ptr = (void *) (((int *) ptr) + offset);
355
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_double_p) >= 0) {
356
ptr = (void *) (((double *) ptr) + offset);
357
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_short_p) >= 0) {
358
ptr = (void *) (((short *) ptr) + offset);
359
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_long_p) >= 0) {
360
ptr = (void *) (((long *) ptr) + offset);
361
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_float_p) >= 0) {
362
ptr = (void *) (((float *) ptr) + offset);
363
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_p) >= 0) {
364
ptr = (void *) (((char *) ptr) + offset);
365
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,0) >= 0) {
366
ptr = (void *) (((char *) ptr) + offset);
368
croak("Type error in ptradd. Argument is not a valid pointer value.");
371
tname = HvNAME(SvSTASH(SvRV(_PTRVALUE)));
372
obj = sv_newmortal();
373
sv_setref_pv(obj,tname,ptr);
377
/*------------------------------------------------------------------
380
Destroys a pointer value
381
------------------------------------------------------------------ */
383
void _ptrfree(CPerlObj *pPerl, SV *_PTRVALUE) {
384
#define ptrfree(a) _ptrfree(pPerl, a)
386
void _ptrfree(SV *_PTRVALUE) {
387
#define ptrfree(a) _ptrfree(a)
392
if (SWIG_ConvertPtr(_PTRVALUE,&ptr,0) < 0) {
393
croak("Type error in ptrfree. Argument is not a valid pointer value.");
397
/* Check to see if this pointer is a char ** */
398
if (SWIG_ConvertPtr(_PTRVALUE,&junk,SWIG_POINTER_char_pp) >= 0) {
399
char **c = (char **) ptr;
414
%typemap(perl5,in) SV *ptr, SV *value {
419
%typemap(perl5,out) SV *ptrcast,
428
SV *ptrvalue(SV *ptr, int index = 0, char *type = 0);
429
// Returns the value that a pointer is pointing to (ie. dereferencing).
430
// The type is automatically inferred by the pointer type--thus, an
431
// integer pointer will return an integer, a double will return a double,
432
// and so on. The index and type fields are optional parameters. When
433
// an index is specified, this function returns the value of ptr[index].
434
// This allows array access. When a type is specified, it overrides
435
// the given pointer type. Examples :
437
// ptrvalue($a) # Returns the value *a
438
// ptrvalue($a,10) # Returns the value a[10]
439
// ptrvalue($a,10,"double") # Returns a[10] assuming a is a double *
442
void ptrset(SV *ptr, SV *value, int index = 0, char *type = 0);
443
// Sets the value pointed to by a pointer. The type is automatically
444
// inferred from the pointer type so this function will work for
445
// integers, floats, doubles, etc... The index and type fields are
446
// optional. When an index is given, it provides array access. When
447
// type is specified, it overrides the given pointer type. Examples :
449
// ptrset($a,3) # Sets the value *a = 3
450
// ptrset($a,3,10) # Sets a[10] = 3
451
// ptrset($a,3,10,"int") # Sets a[10] = 3 assuming a is a int *
454
SV *ptrcreate(char *type, SV *value = 0, int nitems = 1);
455
// Creates a new object and returns a pointer to it. This function
456
// can be used to create various kinds of objects for use in C functions.
457
// type specifies the basic C datatype to create and value is an
458
// optional parameter that can be used to set the initial value of the
459
// object. nitems is an optional parameter that can be used to create
460
// an array. This function results in a memory allocation using
461
// malloc(). Examples :
463
// $a = ptrcreate("double") # Create a new double, return pointer
464
// $a = ptrcreate("int",7) # Create an integer, set value to 7
465
// $a = ptrcreate("int",0,1000) # Create an integer array with initial
466
// # values all set to zero
468
// This function only recognizes a few common C datatypes as listed below :
470
// int, short, long, float, double, char, char *, void
472
// All other datatypes will result in an error. However, other
473
// datatypes can be created by using the ptrcast function. For
476
// $a = ptrcast(ptrcreate("int",0,100),"unsigned int *")
479
void ptrfree(SV *ptr);
480
// Destroys the memory pointed to by ptr. This function calls free()
481
// and should only be used with objects created by ptrcreate(). Since
482
// this function calls free, it may work with other objects, but this
483
// is generally discouraged unless you absolutely know what you're
486
SV *ptradd(SV *ptr, int offset);
487
// Adds a value to the current pointer value. For the C datatypes of
488
// int, short, long, float, double, and char, the offset value is the
489
// number of objects and works in exactly the same manner as in C. For
490
// example, the following code steps through the elements of an array
492
// $a = ptrcreate("double",0,100); # Create an array double a[100]
494
// for ($i = 0; $i < 100; $i++) {
495
// ptrset($b,0.0025*$i); # set *b = 0.0025*i
496
// $b = ptradd($b,1); # b++ (go to next double)
499
// In this case, adding one to b goes to the next double.
501
// For all other datatypes (including all complex datatypes), the
502
// offset corresponds to bytes. This function does not perform any
503
// bounds checking and negative offsets are perfectly legal.
added
removed
Lib/perl5/ptrlang.i
