Nary.xs

   1 /* This file is part of the Sub::Nary Perl module.
   2  * See http://search.cpan.org/dist/Sub::Nary/ */
   3
   4 #define PERL_NO_GET_CONTEXT
   5 #include "EXTERN.h"
   6 #include "perl.h"
   7 #include "XSUB.h"
   8
   9 #ifndef mPUSHi
  10 # define mPUSHi(I) PUSHs(sv_2mortal(newSViv(I)))
  11 #endif /* !mPUSHi */
  12
  13 /* --- XS ------------------------------------------------------------------ */
  14
  15 MODULE = Sub::Nary            PACKAGE = Sub::Nary
  16
  17 PROTOTYPES: ENABLE
  18
  19 void
  20 tag(SV *op)
  21 PROTOTYPE: $
  22 CODE:
  23  ST(0) = sv_2mortal(newSVuv(SvIV(SvRV(op))));
  24  XSRETURN(1);
  25
  26 void
  27 null(SV *op)
  28 PROTOTYPE: $
  29 PREINIT:
  30  OP *o;
  31 CODE:
  32  o = INT2PTR(OP *, SvIV(SvRV(op)));
  33  ST(0) = sv_2mortal(newSVuv(o == NULL));
  34  XSRETURN(1);
  35
  36 void
  37 scalops()
  38 PROTOTYPE:
  39 PREINIT:
  40  U32 cxt;
  41  int i, count = 0;
  42 CODE:
  43  cxt = GIMME_V;
  44  if (cxt == G_SCALAR) {
  45   for (i = 0; i < OP_max; ++i) {
  46    count += (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) != 0;
  47   }
  48   EXTEND(SP, 1);
  49   mPUSHi(count);
  50   XSRETURN(1);
  51  } else if (cxt == G_ARRAY) {
  52   for (i = 0; i < OP_max; ++i) {
  53    if (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) {
  54     const char *name = PL_op_name[i];
  55     XPUSHs(sv_2mortal(newSVpvn_share(name, strlen(name), 0)));
  56     ++count;
  57    }
  58   }
  59   XSRETURN(count);
  60  }
  61