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