[Summary view] [Print] [Text view]

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