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_ROPV
  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(aTHX_ \"%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(aTHX_ \"%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(aTHX_ \"%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(aTHX_ \"%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(aTHX_ \"%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(aTHX_ \"%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(aTHX_ \"%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(aTHX_ \"%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         STMT_START {
 204                 SV * const t_pv_tmp_sv = $arg;
 205                 /* Note: This code works in 5.16 as well as 5.20, which is
 206                    not strictly necessary, since this typemap is not dual-
 207                    lifed.  However, keeping this extra logic will make it
 208                    easier to backport if we decide to dual-life it, or if
 209                    someone copies the latest typemap into a CPAN dist.  */
 210                 /* This takes advantage of the fact that SvIsCOW always
 211                    returned 1 or 0 back when all COWs were marked read-only
 212                    (pre-v5.17.5-484-ge3918bb0, when SvREADONLY did not nec-
 213                    essarily actually mean read-only) and SVf_IsCOW or 0
 214                    thereafter. */
 215                 if ((SvIsCOW(t_pv_tmp_sv) && !SvREADONLY(t_pv_tmp_sv))
 216                  || SvIsCOW(t_pv_tmp_sv) == 1)
 217                     sv_force_normal(t_pv_tmp_sv);
 218                 $var = ($type)SvPV_nolen(t_pv_tmp_sv);
 219         } STMT_END
 220 T_ROPV
 221         $var = ($type)SvPV_nolen($arg)
 222 T_PTR
 223         $var = INT2PTR($type,SvIV($arg))
 224 T_PTRREF
 225         if (SvROK($arg)) {
 226             IV tmp = SvIV((SV*)SvRV($arg));
 227             $var = INT2PTR($type,tmp);
 228         }
 229         else
 230             Perl_croak(aTHX_ \"%s: %s is not a reference\",
 231                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 232                         \"$var\")
 233 T_REF_IV_REF
 234         if (sv_isa($arg, \"${ntype}\")) {
 235             IV tmp = SvIV((SV*)SvRV($arg));
 236             $var = *INT2PTR($type *, tmp);
 237         }
 238         else
 239             Perl_croak(aTHX_ \"%s: %s is not of type %s\",
 240                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 241                         \"$var\", \"$ntype\")
 242 T_REF_IV_PTR
 243         if (sv_isa($arg, \"${ntype}\")) {
 244             IV tmp = SvIV((SV*)SvRV($arg));
 245             $var = INT2PTR($type, tmp);
 246         }
 247         else
 248             Perl_croak(aTHX_ \"%s: %s is not of type %s\",
 249                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 250                         \"$var\", \"$ntype\")
 251 T_PTROBJ
 252         if (SvROK($arg) && sv_derived_from($arg, \"${ntype}\")) {
 253             IV tmp = SvIV((SV*)SvRV($arg));
 254             $var = INT2PTR($type,tmp);
 255         }
 256         else
 257             Perl_croak(aTHX_ \"%s: %s is not of type %s\",
 258                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 259                         \"$var\", \"$ntype\")
 260 T_PTRDESC
 261         if (sv_isa($arg, \"${ntype}\")) {
 262             IV tmp = SvIV((SV*)SvRV($arg));
 263             ${type}_desc = (\U${type}_DESC\E*) tmp;
 264             $var = ${type}_desc->ptr;
 265         }
 266         else
 267             Perl_croak(aTHX_ \"%s: %s is not of type %s\",
 268                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 269                         \"$var\", \"$ntype\")
 270 T_REFREF
 271         if (SvROK($arg)) {
 272             IV tmp = SvIV((SV*)SvRV($arg));
 273             $var = *INT2PTR($type,tmp);
 274         }
 275         else
 276             Perl_croak(aTHX_ \"%s: %s is not a reference\",
 277                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 278                         \"$var\")
 279 T_REFOBJ
 280         if (sv_isa($arg, \"${ntype}\")) {
 281             IV tmp = SvIV((SV*)SvRV($arg));
 282             $var = *INT2PTR($type,tmp);
 283         }
 284         else
 285             Perl_croak(aTHX_ \"%s: %s is not of type %s\",
 286                         ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
 287                         \"$var\", \"$ntype\")
 288 T_OPAQUE
 289         $var = *($type *)SvPV_nolen($arg)
 290 T_OPAQUEPTR
 291         $var = ($type)SvPV_nolen($arg)
 292 T_PACKED
 293         $var = XS_unpack_$ntype($arg)
 294 T_PACKEDARRAY
 295         $var = XS_unpack_$ntype($arg)
 296 T_ARRAY
 297         U32 ix_$var = $argoff;
 298         $var = $ntype(items -= $argoff);
 299         while (items--) {
 300             DO_ARRAY_ELEM;
 301             ix_$var++;
 302         }
 303         /* this is the number of elements in the array */
 304         ix_$var -= $argoff
 305 T_STDIO
 306         $var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
 307 T_IN
 308         $var = IoIFP(sv_2io($arg))
 309 T_INOUT
 310         $var = IoIFP(sv_2io($arg))
 311 T_OUT
 312         $var = IoOFP(sv_2io($arg))
 313 #############################################################################
 314 OUTPUT
 315 T_SV
 316         $arg = $var;
 317 T_SVREF
 318         $arg = newRV((SV*)$var);
 319 T_SVREF_REFCOUNT_FIXED
 320         $arg = newRV_noinc((SV*)$var);
 321 T_AVREF
 322         $arg = newRV((SV*)$var);
 323 T_AVREF_REFCOUNT_FIXED
 324         $arg = newRV_noinc((SV*)$var);
 325 T_HVREF
 326         $arg = newRV((SV*)$var);
 327 T_HVREF_REFCOUNT_FIXED
 328         $arg = newRV_noinc((SV*)$var);
 329 T_CVREF
 330         $arg = newRV((SV*)$var);
 331 T_CVREF_REFCOUNT_FIXED
 332         $arg = newRV_noinc((SV*)$var);
 333 T_IV
 334         sv_setiv($arg, (IV)$var);
 335 T_UV
 336         sv_setuv($arg, (UV)$var);
 337 T_INT
 338         sv_setiv($arg, (IV)$var);
 339 T_SYSRET
 340         if ($var != -1) {
 341             if ($var == 0)
 342                 sv_setpvn($arg, "0 but true", 10);
 343             else
 344                 sv_setiv($arg, (IV)$var);
 345         }
 346 T_ENUM
 347         sv_setiv($arg, (IV)$var);
 348 T_BOOL
 349         ${"$var" eq "RETVAL" ? \"$arg = boolSV($var);" : \"sv_setsv($arg, boolSV($var));"}
 350 T_U_INT
 351         sv_setuv($arg, (UV)$var);
 352 T_SHORT
 353         sv_setiv($arg, (IV)$var);
 354 T_U_SHORT
 355         sv_setuv($arg, (UV)$var);
 356 T_LONG
 357         sv_setiv($arg, (IV)$var);
 358 T_U_LONG
 359         sv_setuv($arg, (UV)$var);
 360 T_CHAR
 361         sv_setpvn($arg, (char *)&$var, 1);
 362 T_U_CHAR
 363         sv_setuv($arg, (UV)$var);
 364 T_FLOAT
 365         sv_setnv($arg, (double)$var);
 366 T_NV
 367         sv_setnv($arg, (NV)$var);
 368 T_DOUBLE
 369         sv_setnv($arg, (double)$var);
 370 T_PV
 371         sv_setpv((SV*)$arg, $var);
 372 T_ROPV
 373         sv_setpv((SV*)$arg, $var);
 374 T_PTR
 375         sv_setiv($arg, PTR2IV($var));
 376 T_PTRREF
 377         sv_setref_pv($arg, Nullch, (void*)$var);
 378 T_REF_IV_REF
 379         sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
 380 T_REF_IV_PTR
 381         sv_setref_pv($arg, \"${ntype}\", (void*)$var);
 382 T_PTROBJ
 383         sv_setref_pv($arg, \"${ntype}\", (void*)$var);
 384 T_PTRDESC
 385         sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
 386 T_REFREF
 387         NOT_IMPLEMENTED
 388 T_REFOBJ
 389         NOT IMPLEMENTED
 390 T_OPAQUE
 391         sv_setpvn($arg, (char *)&$var, sizeof($var));
 392 T_OPAQUEPTR
 393         sv_setpvn($arg, (char *)$var, sizeof(*$var));
 394 T_PACKED
 395         XS_pack_$ntype($arg, $var);
 396 T_PACKEDARRAY
 397         XS_pack_$ntype($arg, $var, count_$ntype);
 398 T_ARRAY
 399         {
 400             U32 ix_$var;
 401             EXTEND(SP,size_$var);
 402             for (ix_$var = 0; ix_$var < size_$var; ix_$var++) {
 403                 ST(ix_$var) = sv_newmortal();
 404         DO_ARRAY_ELEM
 405             }
 406         }
 407 T_STDIO
 408         {
 409             GV *gv = newGVgen("$Package");
 410             PerlIO *fp = PerlIO_importFILE($var,0);
 411             if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) )
 412                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 413             else
 414                 $arg = &PL_sv_undef;
 415         }
 416 T_IN
 417         {
 418             GV *gv = newGVgen("$Package");
 419             if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
 420                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 421             else
 422                 $arg = &PL_sv_undef;
 423         }
 424 T_INOUT
 425         {
 426             GV *gv = newGVgen("$Package");
 427             if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
 428                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 429             else
 430                 $arg = &PL_sv_undef;
 431         }
 432 T_OUT
 433         {
 434             GV *gv = newGVgen("$Package");
 435             if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
 436                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 437             else
 438                 $arg = &PL_sv_undef;
 439         }