lib/ExtUtils/typemap

   1 # basic C types
   2 int                     T_IV
   3 unsigned                T_UV
   4 unsigned int            T_UV
   5 long                    T_IV
   6 unsigned long           T_UV
   7 short                   T_IV
   8 unsigned short          T_UV
   9 char                    T_CHAR
  10 unsigned char           T_U_CHAR
  11 char *                  T_PV
  12 unsigned char *         T_PV
  13 const char *            T_PV
  14 caddr_t                 T_PV
  15 wchar_t *               T_PV
  16 wchar_t                 T_IV
  17 bool_t                  T_IV
  18 size_t                  T_UV
  19 ssize_t                 T_IV
  20 time_t                  T_NV
  21 unsigned long *         T_OPAQUEPTR
  22 char **                 T_PACKEDARRAY
  23 void *                  T_PTR
  24 Time_t *                T_PV
  25 SV *                    T_SV
  26 SVREF                   T_SVREF
  27 AV *                    T_AVREF
  28 HV *                    T_HVREF
  29 CV *                    T_CVREF
  30
  31 IV                      T_IV
  32 UV                      T_UV
  33 NV                      T_NV
  34 I32                     T_IV
  35 I16                     T_IV
  36 I8                      T_IV
  37 STRLEN                  T_UV
  38 U32                     T_U_LONG
  39 U16                     T_U_SHORT
  40 U8                      T_UV
  41 Result                  T_U_CHAR
  42 Boolean                 T_BOOL
  43 float                   T_FLOAT
  44 double                  T_DOUBLE
  45 SysRet                  T_SYSRET
  46 SysRetLong              T_SYSRET
  47 FILE *                  T_STDIO
  48 PerlIO *                T_INOUT
  49 FileHandle              T_PTROBJ
  50 InputStream             T_IN
  51 InOutStream             T_INOUT
  52 OutputStream            T_OUT
  53 bool                    T_BOOL
  54
  55 #############################################################################
  56 INPUT
  57 T_SV
  58         $var = $arg
  59 T_SVREF
  60         if (SvROK($arg))
  61             $var = (SV*)SvRV($arg);
  62         else
  63             Perl_croak(aTHX_ \"$var is not a reference\")
  64 T_AVREF
  65         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
  66             $var = (AV*)SvRV($arg);
  67         else
  68             Perl_croak(aTHX_ \"$var is not an array reference\")
  69 T_HVREF
  70         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV)
  71             $var = (HV*)SvRV($arg);
  72         else
  73             Perl_croak(aTHX_ \"$var is not a hash reference\")
  74 T_CVREF
  75         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV)
  76             $var = (CV*)SvRV($arg);
  77         else
  78             Perl_croak(aTHX_ \"$var is not a code reference\")
  79 T_SYSRET
  80         $var NOT IMPLEMENTED
  81 T_UV
  82         $var = ($type)SvUV($arg)
  83 T_IV
  84         $var = ($type)SvIV($arg)
  85 T_INT
  86         $var = (int)SvIV($arg)
  87 T_ENUM
  88         $var = ($type)SvIV($arg)
  89 T_BOOL
  90         $var = (bool)SvTRUE($arg)
  91 T_U_INT
  92         $var = (unsigned int)SvUV($arg)
  93 T_SHORT
  94         $var = (short)SvIV($arg)
  95 T_U_SHORT
  96         $var = (unsigned short)SvUV($arg)
  97 T_LONG
  98         $var = (long)SvIV($arg)
  99 T_U_LONG
 100         $var = (unsigned long)SvUV($arg)
 101 T_CHAR
 102         $var = (char)*SvPV_nolen($arg)
 103 T_U_CHAR
 104         $var = (unsigned char)SvUV($arg)
 105 T_FLOAT
 106         $var = (float)SvNV($arg)
 107 T_NV
 108         $var = ($type)SvNV($arg)
 109 T_DOUBLE
 110         $var = (double)SvNV($arg)
 111 T_PV
 112         $var = ($type)SvPV_nolen($arg)
 113 T_PTR
 114         $var = INT2PTR($type,SvIV($arg))
 115 T_PTRREF
 116         if (SvROK($arg)) {
 117             IV tmp = SvIV((SV*)SvRV($arg));
 118             $var = INT2PTR($type,tmp);
 119         }
 120         else
 121             Perl_croak(aTHX_ \"$var is not a reference\")
 122 T_REF_IV_REF
 123         if (sv_isa($arg, \"${ntype}\")) {
 124             IV tmp = SvIV((SV*)SvRV($arg));
 125             $var = *INT2PTR($type *, tmp);
 126         }
 127         else
 128             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
 129 T_REF_IV_PTR
 130         if (sv_isa($arg, \"${ntype}\")) {
 131             IV tmp = SvIV((SV*)SvRV($arg));
 132             $var = INT2PTR($type, tmp);
 133         }
 134         else
 135             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
 136 T_PTROBJ
 137         if (sv_derived_from($arg, \"${ntype}\")) {
 138             IV tmp = SvIV((SV*)SvRV($arg));
 139             $var = INT2PTR($type,tmp);
 140         }
 141         else
 142             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
 143 T_PTRDESC
 144         if (sv_isa($arg, \"${ntype}\")) {
 145             IV tmp = SvIV((SV*)SvRV($arg));
 146             ${type}_desc = (\U${type}_DESC\E*) tmp;
 147             $var = ${type}_desc->ptr;
 148         }
 149         else
 150             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
 151 T_REFREF
 152         if (SvROK($arg)) {
 153             IV tmp = SvIV((SV*)SvRV($arg));
 154             $var = *INT2PTR($type,tmp);
 155         }
 156         else
 157             Perl_croak(aTHX_ \"$var is not a reference\")
 158 T_REFOBJ
 159         if (sv_isa($arg, \"${ntype}\")) {
 160             IV tmp = SvIV((SV*)SvRV($arg));
 161             $var = *INT2PTR($type,tmp);
 162         }
 163         else
 164             Perl_croak(aTHX_ \"$var is not of type ${ntype}\")
 165 T_OPAQUE
 166         $var = *($type *)SvPV_nolen($arg)
 167 T_OPAQUEPTR
 168         $var = ($type)SvPV_nolen($arg)
 169 T_PACKED
 170         $var = XS_unpack_$ntype($arg)
 171 T_PACKEDARRAY
 172         $var = XS_unpack_$ntype($arg)
 173 T_CALLBACK
 174         $var = make_perl_cb_$type($arg)
 175 T_ARRAY
 176         U32 ix_$var = $argoff;
 177         $var = $ntype(items -= $argoff);
 178         while (items--) {
 179             DO_ARRAY_ELEM;
 180             ix_$var++;
 181         }
 182         /* this is the number of elements in the array */
 183         ix_$var -= $argoff
 184 T_STDIO
 185         $var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
 186 T_IN
 187         $var = IoIFP(sv_2io($arg))
 188 T_INOUT
 189         $var = IoIFP(sv_2io($arg))
 190 T_OUT
 191         $var = IoOFP(sv_2io($arg))
 192 #############################################################################
 193 OUTPUT
 194 T_SV
 195         $arg = $var;
 196 T_SVREF
 197         $arg = newRV((SV*)$var);
 198 T_AVREF
 199         $arg = newRV((SV*)$var);
 200 T_HVREF
 201         $arg = newRV((SV*)$var);
 202 T_CVREF
 203         $arg = newRV((SV*)$var);
 204 T_IV
 205         sv_setiv($arg, (IV)$var);
 206 T_UV
 207         sv_setuv($arg, (UV)$var);
 208 T_INT
 209         sv_setiv($arg, (IV)$var);
 210 T_SYSRET
 211         if ($var != -1) {
 212             if ($var == 0)
 213                 sv_setpvn($arg, "0 but true", 10);
 214             else
 215                 sv_setiv($arg, (IV)$var);
 216         }
 217 T_ENUM
 218         sv_setiv($arg, (IV)$var);
 219 T_BOOL
 220         $arg = boolSV($var);
 221 T_U_INT
 222         sv_setuv($arg, (UV)$var);
 223 T_SHORT
 224         sv_setiv($arg, (IV)$var);
 225 T_U_SHORT
 226         sv_setuv($arg, (UV)$var);
 227 T_LONG
 228         sv_setiv($arg, (IV)$var);
 229 T_U_LONG
 230         sv_setuv($arg, (UV)$var);
 231 T_CHAR
 232         sv_setpvn($arg, (char *)&$var, 1);
 233 T_U_CHAR
 234         sv_setuv($arg, (UV)$var);
 235 T_FLOAT
 236         sv_setnv($arg, (double)$var);
 237 T_NV
 238         sv_setnv($arg, (NV)$var);
 239 T_DOUBLE
 240         sv_setnv($arg, (double)$var);
 241 T_PV
 242         sv_setpv((SV*)$arg, $var);
 243 T_PTR
 244         sv_setiv($arg, PTR2IV($var));
 245 T_PTRREF
 246         sv_setref_pv($arg, Nullch, (void*)$var);
 247 T_REF_IV_REF
 248         sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
 249 T_REF_IV_PTR
 250         sv_setref_pv($arg, \"${ntype}\", (void*)$var);
 251 T_PTROBJ
 252         sv_setref_pv($arg, \"${ntype}\", (void*)$var);
 253 T_PTRDESC
 254         sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
 255 T_REFREF
 256         NOT_IMPLEMENTED
 257 T_REFOBJ
 258         NOT IMPLEMENTED
 259 T_OPAQUE
 260         sv_setpvn($arg, (char *)&$var, sizeof($var));
 261 T_OPAQUEPTR
 262         sv_setpvn($arg, (char *)$var, sizeof(*$var));
 263 T_PACKED
 264         XS_pack_$ntype($arg, $var);
 265 T_PACKEDARRAY
 266         XS_pack_$ntype($arg, $var, count_$ntype);
 267 T_DATAUNIT
 268         sv_setpvn($arg, $var.chp(), $var.size());
 269 T_CALLBACK
 270         sv_setpvn($arg, $var.context.value().chp(),
 271                 $var.context.value().size());
 272 T_ARRAY
 273         {
 274             U32 ix_$var;
 275             EXTEND(SP,size_$var);
 276             for (ix_$var = 0; ix_$var < size_$var; ix_$var++) {
 277                 ST(ix_$var) = sv_newmortal();
 278         DO_ARRAY_ELEM
 279             }
 280         }
 281 T_STDIO
 282         {
 283             GV *gv = newGVgen("$Package");
 284             PerlIO *fp = PerlIO_importFILE($var,0);
 285             if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) )
 286                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 287             else
 288                 $arg = &PL_sv_undef;
 289         }
 290 T_IN
 291         {
 292             GV *gv = newGVgen("$Package");
 293             if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
 294                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 295             else
 296                 $arg = &PL_sv_undef;
 297         }
 298 T_INOUT
 299         {
 300             GV *gv = newGVgen("$Package");
 301             if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
 302                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 303             else
 304                 $arg = &PL_sv_undef;
 305         }
 306 T_OUT
 307         {
 308             GV *gv = newGVgen("$Package");
 309             if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
 310                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 311             else
 312                 $arg = &PL_sv_undef;
 313         }