PageRenderTime 12ms CodeModel.GetById 2ms app.highlight 6ms RepoModel.GetById 1ms app.codeStats 0ms

/trunk/Lib/perl5/perlrun.swg

#
Unknown | 506 lines | 428 code | 78 blank | 0 comment | 0 complexity | 085939992c90b7470224f6fcd2e98477 MD5 | raw file
  1/* -----------------------------------------------------------------------------
  2 * perlrun.swg
  3 *
  4 * This file contains the runtime support for Perl modules
  5 * and includes code for managing global variables and pointer
  6 * type checking.
  7 * ----------------------------------------------------------------------------- */
  8
  9#ifdef PERL_OBJECT
 10#define SWIG_PERL_OBJECT_DECL CPerlObj *SWIGUNUSEDPARM(pPerl),
 11#define SWIG_PERL_OBJECT_CALL pPerl,
 12#else
 13#define SWIG_PERL_OBJECT_DECL
 14#define SWIG_PERL_OBJECT_CALL
 15#endif
 16
 17/* Common SWIG API */
 18
 19/* for raw pointers */
 20#define SWIG_ConvertPtr(obj, pp, type, flags)           SWIG_Perl_ConvertPtr(SWIG_PERL_OBJECT_CALL obj, pp, type, flags)
 21#define SWIG_ConvertPtrAndOwn(obj, pp, type, flags,own) SWIG_Perl_ConvertPtrAndOwn(SWIG_PERL_OBJECT_CALL obj, pp, type, flags, own)
 22#define SWIG_NewPointerObj(p, type, flags)              SWIG_Perl_NewPointerObj(SWIG_PERL_OBJECT_CALL p, type, flags)
 23
 24/* for raw packed data */
 25#define SWIG_ConvertPacked(obj, p, s, type)             SWIG_Perl_ConvertPacked(SWIG_PERL_OBJECT_CALL obj, p, s, type)
 26#define SWIG_NewPackedObj(p, s, type)	                SWIG_Perl_NewPackedObj(SWIG_PERL_OBJECT_CALL p, s, type)
 27
 28/* for class or struct pointers */
 29#define SWIG_ConvertInstance(obj, pptr, type, flags)    SWIG_ConvertPtr(obj, pptr, type, flags)
 30#define SWIG_NewInstanceObj(ptr, type, flags)           SWIG_NewPointerObj(ptr, type, flags)
 31
 32/* for C or C++ function pointers */
 33#define SWIG_ConvertFunctionPtr(obj, pptr, type)        SWIG_ConvertPtr(obj, pptr, type, 0)
 34#define SWIG_NewFunctionPtrObj(ptr, type)               SWIG_NewPointerObj(ptr, type, 0)
 35
 36/* for C++ member pointers, ie, member methods */
 37#define SWIG_ConvertMember(obj, ptr, sz, ty)            SWIG_ConvertPacked(obj, ptr, sz, ty)
 38#define SWIG_NewMemberObj(ptr, sz, type)                SWIG_NewPackedObj(ptr, sz, type)
 39
 40
 41/* Runtime API */
 42
 43#define SWIG_GetModule(clientdata)                      SWIG_Perl_GetModule()
 44#define SWIG_SetModule(clientdata, pointer)             SWIG_Perl_SetModule(pointer)
 45
 46
 47/* Error manipulation */
 48
 49#define SWIG_ErrorType(code)                            SWIG_Perl_ErrorType(code)               
 50#define SWIG_Error(code, msg)            		sv_setpvf(get_sv("@", GV_ADD), "%s %s", SWIG_ErrorType(code), msg)
 51#define SWIG_fail                        		goto fail						    
 52
 53/* Perl-specific SWIG API */
 54
 55#define SWIG_MakePtr(sv, ptr, type, flags)              SWIG_Perl_MakePtr(SWIG_PERL_OBJECT_CALL sv, ptr, type, flags)
 56#define SWIG_MakePackedObj(sv, p, s, type)	        SWIG_Perl_MakePackedObj(SWIG_PERL_OBJECT_CALL sv, p, s, type)
 57#define SWIG_SetError(str)                              SWIG_Error(SWIG_RuntimeError, str)
 58
 59
 60#define SWIG_PERL_DECL_ARGS_1(arg1)                     (SWIG_PERL_OBJECT_DECL arg1)
 61#define SWIG_PERL_CALL_ARGS_1(arg1)                     (SWIG_PERL_OBJECT_CALL arg1)
 62#define SWIG_PERL_DECL_ARGS_2(arg1, arg2)               (SWIG_PERL_OBJECT_DECL arg1, arg2)
 63#define SWIG_PERL_CALL_ARGS_2(arg1, arg2)               (SWIG_PERL_OBJECT_CALL arg1, arg2)
 64
 65/* -----------------------------------------------------------------------------
 66 * pointers/data manipulation
 67 * ----------------------------------------------------------------------------- */
 68
 69/* For backward compatibility only */
 70#define SWIG_POINTER_EXCEPTION  0
 71
 72#ifdef __cplusplus
 73extern "C" {
 74#endif
 75
 76#define SWIG_OWNER   SWIG_POINTER_OWN
 77#define SWIG_SHADOW  SWIG_OWNER << 1
 78
 79#define SWIG_MAYBE_PERL_OBJECT SWIG_PERL_OBJECT_DECL
 80
 81/* SWIG Perl macros */
 82
 83/* Macro to declare an XS function */
 84#ifndef XSPROTO
 85#   define XSPROTO(name) void name(pTHX_ CV* cv)
 86#endif
 87
 88/* Macro to call an XS function */
 89#ifdef PERL_OBJECT 
 90#  define SWIG_CALLXS(_name) _name(cv,pPerl) 
 91#else 
 92#  ifndef MULTIPLICITY 
 93#    define SWIG_CALLXS(_name) _name(cv) 
 94#  else 
 95#    define SWIG_CALLXS(_name) _name(PERL_GET_THX, cv) 
 96#  endif 
 97#endif 
 98
 99#ifdef PERL_OBJECT
100#define MAGIC_PPERL  CPerlObj *pPerl = (CPerlObj *) this;
101
102#ifdef __cplusplus
103extern "C" {
104#endif
105typedef int (CPerlObj::*SwigMagicFunc)(SV *, MAGIC *);
106#ifdef __cplusplus
107}
108#endif
109
110#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
111#define SWIGCLASS_STATIC
112
113#else /* PERL_OBJECT */
114
115#define MAGIC_PPERL
116#define SWIGCLASS_STATIC static SWIGUNUSED
117
118#ifndef MULTIPLICITY
119#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
120
121#ifdef __cplusplus
122extern "C" {
123#endif
124typedef int (*SwigMagicFunc)(SV *, MAGIC *);
125#ifdef __cplusplus
126}
127#endif
128
129#else /* MULTIPLICITY */
130
131#define SWIG_MAGIC(a,b) (struct interpreter *interp, SV *a, MAGIC *b)
132
133#ifdef __cplusplus
134extern "C" {
135#endif
136typedef int (*SwigMagicFunc)(struct interpreter *, SV *, MAGIC *);
137#ifdef __cplusplus
138}
139#endif
140
141#endif /* MULTIPLICITY */
142#endif /* PERL_OBJECT */
143
144#  ifdef PERL_OBJECT
145#    define SWIG_croak_null() SWIG_Perl_croak_null(pPerl)
146static void SWIG_Perl_croak_null(CPerlObj *pPerl)
147#  else
148static void SWIG_croak_null()
149#  endif
150{
151  SV *err = get_sv("@", GV_ADD);
152#  if (PERL_VERSION < 6)
153  croak("%_", err);
154#  else
155  if (sv_isobject(err))
156    croak(0);
157  else
158    croak("%s", SvPV_nolen(err));
159#  endif
160}
161
162
163/* 
164   Define how strict is the cast between strings and integers/doubles
165   when overloading between these types occurs.
166   
167   The default is making it as strict as possible by using SWIG_AddCast
168   when needed.
169   
170   You can use -DSWIG_PERL_NO_STRICT_STR2NUM at compilation time to
171   disable the SWIG_AddCast, making the casting between string and
172   numbers less strict.
173
174   In the end, we try to solve the overloading between strings and
175   numerical types in the more natural way, but if you can avoid it,
176   well, avoid it using %rename, for example.
177*/
178#ifndef SWIG_PERL_NO_STRICT_STR2NUM
179# ifndef SWIG_PERL_STRICT_STR2NUM
180#  define SWIG_PERL_STRICT_STR2NUM
181# endif
182#endif
183#ifdef SWIG_PERL_STRICT_STR2NUM
184/* string takes precedence */
185#define SWIG_Str2NumCast(x) SWIG_AddCast(x)  
186#else
187/* number takes precedence */
188#define SWIG_Str2NumCast(x) x
189#endif
190
191
192
193#include <stdlib.h>
194
195SWIGRUNTIME const char *
196SWIG_Perl_TypeProxyName(const swig_type_info *type) {
197  if (!type) return NULL;
198  if (type->clientdata != NULL) {
199    return (const char*) type->clientdata;
200  } 
201  else {
202    return type->name;
203  }
204}
205
206/* Identical to SWIG_TypeCheck, except for strcmp comparison */
207SWIGRUNTIME swig_cast_info *
208SWIG_TypeProxyCheck(const char *c, swig_type_info *ty) {
209  if (ty) {
210    swig_cast_info *iter = ty->cast;
211    while (iter) {
212      if (strcmp(SWIG_Perl_TypeProxyName(iter->type), c) == 0) {
213        if (iter == ty->cast)
214          return iter;
215        /* Move iter to the top of the linked list */
216        iter->prev->next = iter->next;
217        if (iter->next)
218          iter->next->prev = iter->prev;
219        iter->next = ty->cast;
220        iter->prev = 0;
221        if (ty->cast) ty->cast->prev = iter;
222        ty->cast = iter;
223        return iter;
224      }
225      iter = iter->next;
226    }
227  }
228  return 0;
229}
230
231/* Function for getting a pointer value */
232
233SWIGRUNTIME int
234SWIG_Perl_ConvertPtrAndOwn(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags, int *own) {
235  swig_cast_info *tc;
236  void *voidptr = (void *)0;
237  SV *tsv = 0;
238
239  if (own)
240    *own = 0;
241
242  /* If magical, apply more magic */
243  if (SvGMAGICAL(sv))
244    mg_get(sv);
245
246  /* Check to see if this is an object */
247  if (sv_isobject(sv)) {
248    IV tmp = 0;
249    tsv = (SV*) SvRV(sv);
250    if ((SvTYPE(tsv) == SVt_PVHV)) {
251      MAGIC *mg;
252      if (SvMAGICAL(tsv)) {
253        mg = mg_find(tsv,'P');
254        if (mg) {
255          sv = mg->mg_obj;
256          if (sv_isobject(sv)) {
257	    tsv = (SV*)SvRV(sv);
258            tmp = SvIV(tsv);
259          }
260        }
261      } else {
262        return SWIG_ERROR;
263      }
264    } else {
265      tmp = SvIV(tsv);
266    }
267    voidptr = INT2PTR(void *,tmp);
268  } else if (! SvOK(sv)) {            /* Check for undef */
269    *(ptr) = (void *) 0;
270    return SWIG_OK;
271  } else if (SvTYPE(sv) == SVt_RV) {  /* Check for NULL pointer */
272    if (!SvROK(sv)) {
273      /* In Perl 5.12 and later, SVt_RV == SVt_IV, so sv could be a valid integer value.  */
274      if (SvIOK(sv)) {
275        return SWIG_ERROR;
276      } else {
277        /* NULL pointer (reference to undef). */
278        *(ptr) = (void *) 0;
279        return SWIG_OK;
280      }
281    } else {
282      return SWIG_ERROR;
283    }
284  } else {                            /* Don't know what it is */
285    return SWIG_ERROR;
286  }
287  if (_t) {
288    /* Now see if the types match */
289    char *_c = HvNAME(SvSTASH(SvRV(sv)));
290    tc = SWIG_TypeProxyCheck(_c,_t);
291    if (!tc) {
292      return SWIG_ERROR;
293    }
294    {
295      int newmemory = 0;
296      *ptr = SWIG_TypeCast(tc,voidptr,&newmemory);
297      if (newmemory == SWIG_CAST_NEW_MEMORY) {
298        assert(own); /* badly formed typemap which will lead to a memory leak - it must set and use own to delete *ptr */
299        if (own)
300          *own = *own | SWIG_CAST_NEW_MEMORY;
301      }
302    }
303  } else {
304    *ptr = voidptr;
305  }
306
307  /* 
308   *  DISOWN implementation: we need a perl guru to check this one.
309   */
310  if (tsv && (flags & SWIG_POINTER_DISOWN)) {
311    /* 
312     *  almost copy paste code from below SWIG_POINTER_OWN setting
313     */
314    SV *obj = sv;
315    HV *stash = SvSTASH(SvRV(obj));
316    GV *gv = *(GV**)hv_fetch(stash, "OWNER", 5, TRUE);
317    if (isGV(gv)) {
318      HV *hv = GvHVn(gv);
319      /*
320       * To set ownership (see below), a newSViv(1) entry is added. 
321       * Hence, to remove ownership, we delete the entry.
322       */
323      if (hv_exists_ent(hv, obj, 0)) {
324	hv_delete_ent(hv, obj, 0, 0);
325      }
326    }
327  }
328  return SWIG_OK;
329}
330
331SWIGRUNTIME int
332SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags) {
333  return SWIG_Perl_ConvertPtrAndOwn(sv, ptr, _t, flags, 0);
334}
335
336SWIGRUNTIME void
337SWIG_Perl_MakePtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, swig_type_info *t, int flags) {
338  if (ptr && (flags & (SWIG_SHADOW | SWIG_POINTER_OWN))) {
339    SV *self;
340    SV *obj=newSV(0);
341    HV *hash=newHV();
342    HV *stash;
343    sv_setref_pv(obj, SWIG_Perl_TypeProxyName(t), ptr);
344    stash=SvSTASH(SvRV(obj));
345    if (flags & SWIG_POINTER_OWN) {
346      HV *hv;
347      GV *gv = *(GV**)hv_fetch(stash, "OWNER", 5, TRUE);
348      if (!isGV(gv))
349        gv_init(gv, stash, "OWNER", 5, FALSE);
350      hv=GvHVn(gv);
351      hv_store_ent(hv, obj, newSViv(1), 0);
352    }
353    sv_magic((SV *)hash, (SV *)obj, 'P', Nullch, 0);
354    SvREFCNT_dec(obj);
355    self=newRV_noinc((SV *)hash);
356    sv_setsv(sv, self);
357    SvREFCNT_dec((SV *)self);
358    sv_bless(sv, stash);
359  }
360  else {
361    sv_setref_pv(sv, SWIG_Perl_TypeProxyName(t), ptr);
362  }
363}
364
365SWIGRUNTIMEINLINE SV *
366SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT void *ptr, swig_type_info *t, int flags) {
367  SV *result = sv_newmortal();
368  SWIG_MakePtr(result, ptr, t, flags);
369  return result;
370}
371
372SWIGRUNTIME void
373SWIG_Perl_MakePackedObj(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, int sz, swig_type_info *type) {
374  char result[1024];
375  char *r = result;
376  if ((2*sz + 1 + strlen(SWIG_Perl_TypeProxyName(type))) > 1000) return;
377  *(r++) = '_';
378  r = SWIG_PackData(r,ptr,sz);
379  strcpy(r,SWIG_Perl_TypeProxyName(type));
380  sv_setpv(sv, result);
381}
382
383SWIGRUNTIME SV *
384SWIG_Perl_NewPackedObj(SWIG_MAYBE_PERL_OBJECT void *ptr, int sz, swig_type_info *type) {
385  SV *result = sv_newmortal();
386  SWIG_Perl_MakePackedObj(result, ptr, sz, type);
387  return result;
388}
389
390/* Convert a packed value value */
391SWIGRUNTIME int
392SWIG_Perl_ConvertPacked(SWIG_MAYBE_PERL_OBJECT SV *obj, void *ptr, int sz, swig_type_info *ty) {
393  swig_cast_info *tc;
394  const char  *c = 0;
395
396  if ((!obj) || (!SvOK(obj))) return SWIG_ERROR;
397  c = SvPV_nolen(obj);
398  /* Pointer values must start with leading underscore */
399  if (*c != '_') return SWIG_ERROR;
400  c++;
401  c = SWIG_UnpackData(c,ptr,sz);
402  if (ty) {
403    tc = SWIG_TypeCheck(c,ty);
404    if (!tc) return SWIG_ERROR;
405  }
406  return SWIG_OK;
407}
408
409
410/* Macros for low-level exception handling */
411#define SWIG_croak(x)    { SWIG_Error(SWIG_RuntimeError, x); SWIG_fail; }
412
413
414typedef XSPROTO(SwigPerlWrapper);
415typedef SwigPerlWrapper *SwigPerlWrapperPtr;
416
417/* Structure for command table */
418typedef struct {
419  const char         *name;
420  SwigPerlWrapperPtr  wrapper;
421} swig_command_info;
422
423/* Information for constant table */
424
425#define SWIG_INT     1
426#define SWIG_FLOAT   2
427#define SWIG_STRING  3
428#define SWIG_POINTER 4
429#define SWIG_BINARY  5
430
431/* Constant information structure */
432typedef struct swig_constant_info {
433    int              type;
434    const char      *name;
435    long             lvalue;
436    double           dvalue;
437    void            *pvalue;
438    swig_type_info **ptype;
439} swig_constant_info;
440
441
442/* Structure for variable table */
443typedef struct {
444  const char   *name;
445  SwigMagicFunc   set;
446  SwigMagicFunc   get;
447  swig_type_info  **type;
448} swig_variable_info;
449
450/* Magic variable code */
451#ifndef PERL_OBJECT
452# ifdef __cplusplus
453#  define swig_create_magic(s,a,b,c) _swig_create_magic(s,const_cast<char*>(a),b,c)
454# else
455#  define swig_create_magic(s,a,b,c) _swig_create_magic(s,(char*)(a),b,c)
456# endif
457# ifndef MULTIPLICITY
458SWIGRUNTIME void _swig_create_magic(SV *sv, char *name, int (*set)(SV *, MAGIC *), int (*get)(SV *,MAGIC *)) 
459# else
460SWIGRUNTIME void _swig_create_magic(SV *sv, char *name, int (*set)(struct interpreter*, SV *, MAGIC *), int (*get)(struct interpreter*, SV *,MAGIC *)) 
461# endif
462#else
463#  define swig_create_magic(s,a,b,c) _swig_create_magic(pPerl,s,a,b,c)
464SWIGRUNTIME void _swig_create_magic(CPerlObj *pPerl, SV *sv, const char *name, int (CPerlObj::*set)(SV *, MAGIC *), int (CPerlObj::*get)(SV *, MAGIC *)) 
465#endif
466{
467  MAGIC *mg;
468  sv_magic(sv,sv,'U',name,strlen(name));
469  mg = mg_find(sv,'U');
470  mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL));
471  mg->mg_virtual->svt_get = (SwigMagicFunc) get;
472  mg->mg_virtual->svt_set = (SwigMagicFunc) set;
473  mg->mg_virtual->svt_len = 0;
474  mg->mg_virtual->svt_clear = 0;
475  mg->mg_virtual->svt_free = 0;
476}
477
478
479SWIGRUNTIME swig_module_info *
480SWIG_Perl_GetModule(void) {
481  static void *type_pointer = (void *)0;
482  SV *pointer;
483
484  /* first check if pointer already created */
485  if (!type_pointer) {
486    pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, FALSE | GV_ADDMULTI);
487    if (pointer && SvOK(pointer)) {
488      type_pointer = INT2PTR(swig_type_info **, SvIV(pointer));
489    }
490  }
491
492  return (swig_module_info *) type_pointer;
493}
494
495SWIGRUNTIME void
496SWIG_Perl_SetModule(swig_module_info *module) {
497  SV *pointer;
498
499  /* create a new pointer */
500  pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, TRUE | GV_ADDMULTI);
501  sv_setiv(pointer, PTR2IV(module));
502}
503
504#ifdef __cplusplus
505}
506#endif