ext/typemap

   1 # $Header$
   2 # basic C types
   3 int                     T_INT
   4 unsigned                T_U_INT
   5 unsigned int            T_U_INT
   6 long                    T_LONG
   7 unsigned long           T_U_LONG
   8 short                   T_SHORT
   9 unsigned short          T_U_SHORT
  10 char                    T_CHAR
  11 char *                  T_STRING
  12 unsigned char *         T_STRING
  13 caddr_t                 T_STRING
  14 unsigned long *         T_OPAQUEPTR
  15 char **                 T_PACKED
  16 void *                  T_PTR
  17 SV *                    T_SV
  18 SV *                    T_SVOBJ
  19 AV *                    T_AVOBJ
  20 HV *                    T_HVOBJ
  21 CV *                    T_CVOBJ
  22
  23 I32                     T_LONG
  24 I16                     T_SHORT
  25 U32                     T_U_LONG
  26 U16                     T_U_SHORT
  27 Result                  T_U_CHAR
  28 Boolean                 T_U_CHAR
  29 double                  T_DOUBLE
  30 SysRet                  T_SYSRET
  31
  32 #############################################################################
  33 INPUT
  34 T_SV
  35         $var = $arg;
  36 T_SVOBJ
  37         if (sv_isa($arg, \"${ntype}\"))
  38             $var = (AV*)SvRV($arg);
  39         else
  40             croak(\"$var is not of type ${ntype}\")
  41 T_AVOBJ
  42         if (sv_isa($arg, \"${ntype}\"))
  43             $var = (AV*)SvRV($arg);
  44         else
  45             croak(\"$var is not of type ${ntype}\")
  46 T_HVOBJ
  47         if (sv_isa($arg, \"${ntype}\"))
  48             $var = (HV*)SvRV($arg);
  49         else
  50             croak(\"$var is not of type ${ntype}\")
  51 T_CVOBJ
  52         if (sv_isa($arg, \"${ntype}\"))
  53             $var = (CV*)SvRV($arg);
  54         else
  55             croak(\"$var is not of type ${ntype}\")
  56 T_SYSRET
  57         $var NOT IMPLEMENTED
  58 T_INT
  59         $var = (int)SvIV($arg)
  60 T_ENUM
  61         $var = ($type)SvIV($arg)
  62 T_U_INT
  63         $var = (unsigned int)SvIV($arg)
  64 T_SHORT
  65         $var = (short)SvIV($arg)
  66 T_U_SHORT
  67         $var = (unsigned short)SvIV($arg)
  68 T_LONG
  69         $var = (long)SvIV($arg)
  70 T_U_LONG
  71         $var = (unsigned long)SvIV($arg)
  72 T_CHAR
  73         $var = (char)*SvPV($arg,na)
  74 T_U_CHAR
  75         $var = (unsigned char)SvIV($arg)
  76 T_FLOAT
  77         $var = (float)SvNV($arg)
  78 T_DOUBLE
  79         $var = SvNV($arg)
  80 T_STRING
  81         $var = SvPV($arg,na)
  82 T_PTR
  83         $var = ($type)(unsigned long)SvNV($arg)
  84 T_PTRREF
  85         if (SvROK($arg))
  86             $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg));
  87         else
  88             croak(\"$var is not a reference\")
  89 T_PTROBJ
  90         if (sv_isa($arg, \"${ntype}\"))
  91             $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg));
  92         else
  93             croak(\"$var is not of type ${ntype}\")
  94 T_PTRDESC
  95         if (sv_isa($arg, \"${ntype}\")) {
  96             ${type}_desc = (\U${type}_DESC\E*)(unsigned long)SvNV((SV*)SvRV($arg));
  97             $var = ${type}_desc->ptr;
  98         }
  99         else
 100             croak(\"$var is not of type ${ntype}\")
 101 T_REFREF
 102         if (SvROK($arg))
 103             $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg));
 104         else
 105             croak(\"$var is not a reference\")
 106 T_REFOBJ
 107         if (sv_isa($arg, \"${ntype}\"))
 108             $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg));
 109         else
 110             croak(\"$var is not of type ${ntype}\")
 111 T_OPAQUE
 112         $var NOT IMPLEMENTED
 113 T_OPAQUEPTR
 114         $var = ($type)SvPV($arg,na)
 115 T_PACKED
 116         $var = XS_unpack_$ntype($arg)
 117 T_PACKEDARRAY
 118         $var = XS_unpack_$ntype($arg)
 119 T_CALLBACK
 120         $var = make_perl_cb_$type($arg)
 121 T_ARRAY
 122         $var = $ntype(items -= $argoff);
 123         U32 ix_$var = $argoff;
 124         while (items--) {
 125             DO_ARRAY_ELEM;
 126         }
 127 #############################################################################
 128 OUTPUT
 129 T_SV
 130         $arg = $var;
 131 T_SVOBJ
 132         $arg = newRV((SV*)$var);
 133 T_AVOBJ
 134         $arg = newRV((SV*)$var);
 135 T_HVOBJ
 136         $arg = newRV((SV*)$var);
 137 T_CVOBJ
 138         $arg = newRV((SV*)$var);
 139 T_INT
 140         sv_setiv($arg, (I32)$var);
 141 T_SYSRET
 142         if ($var != -1) {
 143             if ($var == 0)
 144                 sv_setpvn($arg, "0 but true", 10);
 145             else
 146                 sv_setiv($arg, (I32)$var);
 147         }
 148 T_ENUM
 149         sv_setiv($arg, (I32)$var);
 150 T_U_INT
 151         sv_setiv($arg, (I32)$var);
 152 T_SHORT
 153         sv_setiv($arg, (I32)$var);
 154 T_U_SHORT
 155         sv_setiv($arg, (I32)$var);
 156 T_LONG
 157         sv_setiv($arg, (I32)$var);
 158 T_U_LONG
 159         sv_setiv($arg, (I32)$var);
 160 T_CHAR
 161         sv_setpvn($arg, (char *)&$var, 1);
 162 T_U_CHAR
 163         sv_setiv($arg, (I32)$var);
 164 T_FLOAT
 165         sv_setnv($arg, (double)$var);
 166 T_DOUBLE
 167         sv_setnv($arg, $var);
 168 T_STRING
 169         sv_setpv($arg, $var);
 170 T_PTR
 171         sv_setnv($arg, (double)(unsigned long)$var);
 172 T_PTRREF
 173         sv_setptrref($arg, $var);
 174 T_PTROBJ
 175         sv_setptrobj($arg, $var, \"${ntype}\");
 176 T_PTRDESC
 177         sv_setptrobj($arg, (void*)new\U${type}_DESC\E($var), \"${ntype}\");
 178 T_REFREF
 179         sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
 180                     ($var ? (void*)new $ntype($var) : 0));
 181 T_REFOBJ
 182         NOT IMPLEMENTED
 183 T_OPAQUE
 184         sv_setpvn($arg, (char *)&$var, sizeof($var));
 185 T_OPAQUEPTR
 186         sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
 187 T_PACKED
 188         XS_pack_$ntype($arg, $var);
 189 T_PACKEDARRAY
 190         XS_pack_$ntype($arg, $var, count_$ntype);
 191 T_DATAUNIT
 192         sv_setpvn($arg, $var.chp(), $var.size());
 193 T_CALLBACK
 194         sv_setpvn($arg, $var.context.value().chp(),
 195                 $var.context.value().size());
 196 T_ARRAY
 197         ST_EXTEND($var.size);
 198         for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
 199                 ST(ix_$var) = sv_newmortal();
 200         DO_ARRAY_ELEM
 201         }
 202         sp += $var.size - 1;