LXR perl/ext/Time-HiRes/typemap

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