contrib/perl5/lib/ExtUtils/typemap

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