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 is defined in <rpc/rpc.h>
  18 bool_t                  T_IV
  19 size_t                  T_UV
  20 ssize_t                 T_IV
  21 time_t                  T_NV
  22 unsigned long *         T_OPAQUEPTR
  23 char **                 T_PACKEDARRAY
  24 void *                  T_PTR
  25 Time_t *                T_PV
  26 SV *                    T_SV
  27
  28 # These are the backwards-compatibility AV*/HV* typemaps that
  29 # do not decrement refcounts. Locally override with
  30 # "AV*  T_AVREF_REFCOUNT_FIXED", "HV*   T_HVREF_REFCOUNT_FIXED",
  31 # "CV*  T_CVREF_REFCOUNT_FIXED", "SVREF T_SVREF_REFCOUNT_FIXED",
  32 # to get the fixed versions.
  33 SVREF                   T_SVREF
  34 CV *                    T_CVREF
  35 AV *                    T_AVREF
  36 HV *                    T_HVREF
  37
  38 IV                      T_IV
  39 UV                      T_UV
  40 NV                      T_NV
  41 I32                     T_IV
  42 I16                     T_IV
  43 I8                      T_IV
  44 STRLEN                  T_UV
  45 U32                     T_U_LONG
  46 U16                     T_U_SHORT
  47 U8                      T_UV
  48 Result                  T_U_CHAR
  49 Boolean                 T_BOOL
  50 float                   T_FLOAT
  51 double                  T_DOUBLE
  52 SysRet                  T_SYSRET
  53 SysRetLong              T_SYSRET
  54 FILE *                  T_STDIO
  55 PerlIO *                T_INOUT
  56 FileHandle              T_PTROBJ
  57 InputStream             T_IN
  58 InOutStream             T_INOUT
  59 OutputStream            T_OUT
  60 bool                    T_BOOL
  61
  62 #############################################################################
  63 INPUT
  64 T_SV
  65         $var = $arg
  66 T_SVREF
  67         STMT_START {
  68                 SV* const xsub_tmp_sv = $arg;
  69                 SvGETMAGIC(xsub_tmp_sv);
  70                 if (SvROK(xsub_tmp_sv)){
  71                     $var = SvRV(xsub_tmp_sv);
  72                 }
  73                 else{
  74                     Perl_croak_nocontext(\"%s: %s is not a reference\",
  75                                 ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
  76                                 \"$var\");
  77                 }
  78         } STMT_END
  79 T_SVREF_REFCOUNT_FIXED
  80         STMT_START {
  81                 SV* const xsub_tmp_sv = $arg;
  82                 SvGETMAGIC(xsub_tmp_sv);
  83                 if (SvROK(xsub_tmp_sv)){
  84                     $var = SvRV(xsub_tmp_sv);
  85                 }
  86                 else{
  87                     Perl_croak_nocontext(\"%s: %s is not a reference\",
  88                                 ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
  89                                 \"$var\");
  90                 }
  91         } STMT_END
  92 T_AVREF
  93         STMT_START {
  94                 SV* const xsub_tmp_sv = $arg;
  95                 SvGETMAGIC(xsub_tmp_sv);
  96                 if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){
  97                     $var = (AV*)SvRV(xsub_tmp_sv);
  98                 }
  99                 else{
 100                     Perl_croak_nocontext(\"%s: %s is not an ARRAY reference\",
 101                                 ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 102                                 \"$var\");
 103                 }
 104         } STMT_END
 105 T_AVREF_REFCOUNT_FIXED
 106         STMT_START {
 107                 SV* const xsub_tmp_sv = $arg;
 108                 SvGETMAGIC(xsub_tmp_sv);
 109                 if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){
 110                     $var = (AV*)SvRV(xsub_tmp_sv);
 111                 }
 112                 else{
 113                     Perl_croak_nocontext(\"%s: %s is not an ARRAY reference\",
 114                                 ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 115                                 \"$var\");
 116                 }
 117         } STMT_END
 118 T_HVREF
 119         STMT_START {
 120                 SV* const xsub_tmp_sv = $arg;
 121                 SvGETMAGIC(xsub_tmp_sv);
 122                 if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVHV){
 123                     $var = (HV*)SvRV(xsub_tmp_sv);
 124                 }
 125                 else{
 126                     Perl_croak_nocontext(\"%s: %s is not a HASH reference\",
 127                                 ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 128                                 \"$var\");
 129                 }
 130         } STMT_END
 131 T_HVREF_REFCOUNT_FIXED
 132         STMT_START {
 133                 SV* const xsub_tmp_sv = $arg;
 134                 SvGETMAGIC(xsub_tmp_sv);
 135                 if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVHV){
 136                     $var = (HV*)SvRV(xsub_tmp_sv);
 137                 }
 138                 else{
 139                     Perl_croak_nocontext(\"%s: %s is not a HASH reference\",
 140                                 ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 141                                 \"$var\");
 142                 }
 143         } STMT_END
 144 T_CVREF
 145         STMT_START {
 146                 HV *st;
 147                 GV *gvp;
 148                 SV * const xsub_tmp_sv = $arg;
 149                 SvGETMAGIC(xsub_tmp_sv);
 150                 $var = sv_2cv(xsub_tmp_sv, &st, &gvp, 0);
 151                 if (!$var) {
 152                     Perl_croak_nocontext(\"%s: %s is not a CODE reference\",
 153                                 ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 154                                 \"$var\");
 155                 }
 156         } STMT_END
 157 T_CVREF_REFCOUNT_FIXED
 158         STMT_START {
 159                 HV *st;
 160                 GV *gvp;
 161                 SV * const xsub_tmp_sv = $arg;
 162                 SvGETMAGIC(xsub_tmp_sv);
 163                 $var = sv_2cv(xsub_tmp_sv, &st, &gvp, 0);
 164                 if (!$var) {
 165                     Perl_croak_nocontext(\"%s: %s is not a CODE reference\",
 166                                 ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 167                                 \"$var\");
 168                 }
 169         } STMT_END
 170 T_SYSRET
 171         $var NOT IMPLEMENTED
 172 T_UV
 173         $var = ($type)SvUV($arg)
 174 T_IV
 175         $var = ($type)SvIV($arg)
 176 T_INT
 177         $var = (int)SvIV($arg)
 178 T_ENUM
 179         $var = ($type)SvIV($arg)
 180 T_BOOL
 181         $var = (bool)SvTRUE($arg)
 182 T_U_INT
 183         $var = (unsigned int)SvUV($arg)
 184 T_SHORT
 185         $var = (short)SvIV($arg)
 186 T_U_SHORT
 187         $var = (unsigned short)SvUV($arg)
 188 T_LONG
 189         $var = (long)SvIV($arg)
 190 T_U_LONG
 191         $var = (unsigned long)SvUV($arg)
 192 T_CHAR
 193         $var = (char)*SvPV_nolen($arg)
 194 T_U_CHAR
 195         $var = (unsigned char)SvUV($arg)
 196 T_FLOAT
 197         $var = (float)SvNV($arg)
 198 T_NV
 199         $var = ($type)SvNV($arg)
 200 T_DOUBLE
 201         $var = (double)SvNV($arg)
 202 T_PV
 203         $var = ($type)SvPV_nolen($arg)
 204 T_PTR
 205         $var = INT2PTR($type,SvIV($arg))
 206 T_PTRREF
 207         if (SvROK($arg)) {
 208             IV tmp = SvIV((SV*)SvRV($arg));
 209             $var = INT2PTR($type,tmp);
 210         }
 211         else
 212             Perl_croak_nocontext(\"%s: %s is not a reference\",
 213                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 214                         \"$var\")
 215 T_REF_IV_REF
 216         if (sv_isa($arg, \"${ntype}\")) {
 217             IV tmp = SvIV((SV*)SvRV($arg));
 218             $var = *INT2PTR($type *, tmp);
 219         }
 220         else
 221             Perl_croak_nocontext(\"%s: %s is not of type %s\",
 222                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 223                         \"$var\", \"$ntype\")
 224 T_REF_IV_PTR
 225         if (sv_isa($arg, \"${ntype}\")) {
 226             IV tmp = SvIV((SV*)SvRV($arg));
 227             $var = INT2PTR($type, tmp);
 228         }
 229         else
 230             Perl_croak_nocontext(\"%s: %s is not of type %s\",
 231                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 232                         \"$var\", \"$ntype\")
 233 T_PTROBJ
 234         if (SvROK($arg) && sv_derived_from($arg, \"${ntype}\")) {
 235             IV tmp = SvIV((SV*)SvRV($arg));
 236             $var = INT2PTR($type,tmp);
 237         }
 238         else
 239             Perl_croak_nocontext(\"%s: %s is not of type %s\",
 240                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 241                         \"$var\", \"$ntype\")
 242 T_PTRDESC
 243         if (sv_isa($arg, \"${ntype}\")) {
 244             IV tmp = SvIV((SV*)SvRV($arg));
 245             ${type}_desc = (\U${type}_DESC\E*) tmp;
 246             $var = ${type}_desc->ptr;
 247         }
 248         else
 249             Perl_croak_nocontext(\"%s: %s is not of type %s\",
 250                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 251                         \"$var\", \"$ntype\")
 252 T_REFREF
 253         if (SvROK($arg)) {
 254             IV tmp = SvIV((SV*)SvRV($arg));
 255             $var = *INT2PTR($type,tmp);
 256         }
 257         else
 258             Perl_croak_nocontext(\"%s: %s is not a reference\",
 259                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 260                         \"$var\")
 261 T_REFOBJ
 262         if (sv_isa($arg, \"${ntype}\")) {
 263             IV tmp = SvIV((SV*)SvRV($arg));
 264             $var = *INT2PTR($type,tmp);
 265         }
 266         else
 267             Perl_croak_nocontext(\"%s: %s is not of type %s\",
 268                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 269                         \"$var\", \"$ntype\")
 270 T_OPAQUE
 271         $var = *($type *)SvPV_nolen($arg)
 272 T_OPAQUEPTR
 273         $var = ($type)SvPV_nolen($arg)
 274 T_PACKED
 275         $var = XS_unpack_$ntype($arg)
 276 T_PACKEDARRAY
 277         $var = XS_unpack_$ntype($arg)
 278 T_ARRAY
 279         U32 ix_$var = $argoff;
 280         $var = $ntype(items -= $argoff);
 281         while (items--) {
 282             DO_ARRAY_ELEM;
 283             ix_$var++;
 284         }
 285         /* this is the number of elements in the array */
 286         ix_$var -= $argoff
 287 T_STDIO
 288         $var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
 289 T_IN
 290         $var = IoIFP(sv_2io($arg))
 291 T_INOUT
 292         $var = IoIFP(sv_2io($arg))
 293 T_OUT
 294         $var = IoOFP(sv_2io($arg))
 295 #############################################################################
 296 OUTPUT
 297 T_SV
 298         $arg = $var;
 299 T_SVREF
 300         $arg = newRV((SV*)$var);
 301 T_SVREF_REFCOUNT_FIXED
 302         $arg = newRV_noinc((SV*)$var);
 303 T_AVREF
 304         $arg = newRV((SV*)$var);
 305 T_AVREF_REFCOUNT_FIXED
 306         $arg = newRV_noinc((SV*)$var);
 307 T_HVREF
 308         $arg = newRV((SV*)$var);
 309 T_HVREF_REFCOUNT_FIXED
 310         $arg = newRV_noinc((SV*)$var);
 311 T_CVREF
 312         $arg = newRV((SV*)$var);
 313 T_CVREF_REFCOUNT_FIXED
 314         $arg = newRV_noinc((SV*)$var);
 315 T_IV
 316         sv_setiv($arg, (IV)$var);
 317 T_UV
 318         sv_setuv($arg, (UV)$var);
 319 T_INT
 320         sv_setiv($arg, (IV)$var);
 321 T_SYSRET
 322         if ($var != -1) {
 323             if ($var == 0)
 324                 sv_setpvn($arg, "0 but true", 10);
 325             else
 326                 sv_setiv($arg, (IV)$var);
 327         }
 328 T_ENUM
 329         sv_setiv($arg, (IV)$var);
 330 T_BOOL
 331         ${"$var" eq "RETVAL" ? \"$arg = boolSV($var);" : \"sv_setsv($arg, boolSV($var));"}
 332 T_U_INT
 333         sv_setuv($arg, (UV)$var);
 334 T_SHORT
 335         sv_setiv($arg, (IV)$var);
 336 T_U_SHORT
 337         sv_setuv($arg, (UV)$var);
 338 T_LONG
 339         sv_setiv($arg, (IV)$var);
 340 T_U_LONG
 341         sv_setuv($arg, (UV)$var);
 342 T_CHAR
 343         sv_setpvn($arg, (char *)&$var, 1);
 344 T_U_CHAR
 345         sv_setuv($arg, (UV)$var);
 346 T_FLOAT
 347         sv_setnv($arg, (double)$var);
 348 T_NV
 349         sv_setnv($arg, (NV)$var);
 350 T_DOUBLE
 351         sv_setnv($arg, (double)$var);
 352 T_PV
 353         sv_setpv((SV*)$arg, $var);
 354 T_PTR
 355         sv_setiv($arg, PTR2IV($var));
 356 T_PTRREF
 357         sv_setref_pv($arg, Nullch, (void*)$var);
 358 T_REF_IV_REF
 359         sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
 360 T_REF_IV_PTR
 361         sv_setref_pv($arg, \"${ntype}\", (void*)$var);
 362 T_PTROBJ
 363         sv_setref_pv($arg, \"${ntype}\", (void*)$var);
 364 T_PTRDESC
 365         sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
 366 T_REFREF
 367         NOT_IMPLEMENTED
 368 T_REFOBJ
 369         NOT IMPLEMENTED
 370 T_OPAQUE
 371         sv_setpvn($arg, (char *)&$var, sizeof($var));
 372 T_OPAQUEPTR
 373         sv_setpvn($arg, (char *)$var, sizeof(*$var));
 374 T_PACKED
 375         XS_pack_$ntype($arg, $var);
 376 T_PACKEDARRAY
 377         XS_pack_$ntype($arg, $var, count_$ntype);
 378 T_ARRAY
 379         {
 380             U32 ix_$var;
 381             SSize_t extend_size =
 382                 /* The weird way this is written is because g++ is dumb
 383                  * enough to warn "comparison is always false" on something
 384                  * like:
 385                  *
 386                  * sizeof(a) > sizeof(b) && a > B_t_MAX
 387                  *
 388                  * (where the LH condition is false)
 389                  */
 390                 (size_$var > (sizeof(size_$var) > sizeof(SSize_t)
 391                               ? SSize_t_MAX : size_$var))
 392                 ? -1 : (SSize_t)size_$var;
 393             EXTEND(SP, extend_size);
 394             for (ix_$var = 0; ix_$var < size_$var; ix_$var++) {
 395                 ST(ix_$var) = sv_newmortal();
 396         DO_ARRAY_ELEM
 397             }
 398         }
 399 T_STDIO
 400         {
 401             GV *gv = (GV *)sv_newmortal();
 402             PerlIO *fp = PerlIO_importFILE($var,0);
 403             gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
 404             if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) {
 405                 SV *rv = newRV_inc((SV*)gv);
 406                 rv = sv_bless(rv, GvSTASH(gv));
 407                 ${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"
 408                     : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}
 409             }${"$var" ne "RETVAL" ? \"
 410             else
 411                 sv_setsv($arg, &PL_sv_undef);\n" : \""}
 412         }
 413 T_IN
 414         {
 415             GV *gv = (GV *)sv_newmortal();
 416             gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
 417             if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) {
 418                 SV *rv = newRV_inc((SV*)gv);
 419                 rv = sv_bless(rv, GvSTASH(gv));
 420                 ${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"
 421                     : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}
 422             }${"$var" ne "RETVAL" ? \"
 423             else
 424                 sv_setsv($arg, &PL_sv_undef);\n" : \""}
 425         }
 426 T_INOUT
 427         {
 428             GV *gv = (GV *)sv_newmortal();
 429             gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
 430             if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) {
 431                 SV *rv = newRV_inc((SV*)gv);
 432                 rv = sv_bless(rv, GvSTASH(gv));
 433                 ${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"
 434                     : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}
 435             }${"$var" ne "RETVAL" ? \"
 436             else
 437                 sv_setsv($arg, &PL_sv_undef);\n" : \""}
 438         }
 439 T_OUT
 440         {
 441             GV *gv = (GV *)sv_newmortal();
 442             gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
 443             if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) {
 444                 SV *rv = newRV_inc((SV*)gv);
 445                 rv = sv_bless(rv, GvSTASH(gv));
 446                 ${"$var" eq "RETVAL" ? \"$arg = sv_2mortal(rv);"
 447                     : \"sv_setsv($arg, rv);\n\t\tSvREFCNT_dec_NN(rv);"}
 448             }${"$var" ne "RETVAL" ? \"
 449             else
 450                 sv_setsv($arg, &PL_sv_undef);\n" : \""}
 451         }