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