Home | History | Annotate | Download | only in perl5
      1 /* ------------------------------------------------------------
      2  *  Typemap specializations for Perl
      3  * ------------------------------------------------------------ */
      4 
      5 /* ------------------------------------------------------------
      6  *  Fragment section
      7  * ------------------------------------------------------------ */
      8 
      9 /*
     10   in Perl we need to pass the CPerlObj value, sometimes, so, we define
     11   the decl/call macros as needed.
     12 */
     13 
     14 #define SWIG_AS_DECL_ARGS SWIG_PERL_DECL_ARGS_2
     15 #define SWIG_AS_CALL_ARGS SWIG_PERL_CALL_ARGS_2
     16 
     17 #define SWIG_FROM_DECL_ARGS  SWIG_PERL_DECL_ARGS_1
     18 #define SWIG_FROM_CALL_ARGS  SWIG_PERL_CALL_ARGS_1
     19 
     20 
     21 /* Include fundamental fragemt definitions */
     22 %include <typemaps/fragments.swg>
     23 
     24 /* Look for user fragments file. */
     25 %include <perlfragments.swg>
     26 
     27 /* Perl fragments for primitive types */
     28 %include <perlprimtypes.swg>
     29 
     30 /* Perl fragments for char* strings */
     31 %include <perlstrings.swg>
     32 
     33 
     34 /* ------------------------------------------------------------
     35  *  Unified typemap section
     36  * ------------------------------------------------------------ */
     37 
     38 /* No director supported in Perl */
     39 #ifdef SWIG_DIRECTOR_TYPEMAPS
     40 #undef SWIG_DIRECTOR_TYPEMAPS
     41 #endif
     42 
     43 
     44 /* Perl types */
     45 #define SWIG_Object                      SV *
     46 #define VOID_Object                      sv_newmortal()
     47 
     48 /* Perl $shadow flag */
     49 #define %newpointer_flags                $shadow
     50 #define %newinstance_flags               $shadow
     51 
     52 
     53 /* Complete overload of the output/constant/exception macros */
     54 
     55 /* output */
     56 %define %set_output(obj) $result = obj; argvi++ %enddef
     57 
     58 /* append output */
     59 %define %append_output(obj) if (argvi >= items) EXTEND(sp,1); %set_output(obj) %enddef
     60 
     61 /* variable output */
     62 %define %set_varoutput(obj) sv_setsv($result,obj)  %enddef
     63 
     64 /* constant */
     65 %define %set_constant(name, obj) %begin_block
     66   SV *sv = get_sv((char*) SWIG_prefix name, TRUE | 0x2 | GV_ADDMULTI);
     67   sv_setsv(sv, obj);
     68   SvREADONLY_on(sv);
     69 %end_block %enddef
     70 
     71 /* raise exception */
     72 %define %raise(obj, type, desc) sv_setsv(get_sv("@", GV_ADD), obj); SWIG_fail %enddef
     73 
     74 /* Include the unified typemap library */
     75 %include <typemaps/swigtypemaps.swg>
     76 
     77 /*  ------------------------------------------------------------
     78  *  Perl extra typemaps / typemap overrides
     79  * ------------------------------------------------------------ */
     80 
     81 %typemap(varout,type="$1_descriptor") SWIGTYPE *, SWIGTYPE []
     82     "sv_setiv(SvRV($result),PTR2IV($1));";
     83 
     84 %typemap(varout,type="$1_descriptor") SWIGTYPE &
     85     "sv_setiv(SvRV($result),PTR2IV(&$1));";
     86 
     87 %typemap(varout,type="$&1_descriptor") SWIGTYPE
     88     "sv_setiv(SvRV($result), PTR2IV(&$1));";
     89 
     90 %typemap(varout,type="$1_descriptor") SWIGTYPE (CLASS::*) {
     91   SWIG_MakePackedObj($result, (void *) &$1, sizeof($1_type), $1_descriptor);
     92 }
     93 
     94 %typemap(varout) SWIGTYPE *const = SWIGTYPE *;
     95 
     96