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