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 count(SV *sv)
  38 PROTOTYPE: $
  39 PREINIT:
  40  HV *hv;
  41  HE *key;
  42  NV c = 0;
  43 CODE:
  44  if (!SvOK(sv))
  45   XSRETURN_IV(0);
  46  if (!SvROK(sv))
  47   XSRETURN_IV(1);
  48  hv = (HV *) SvRV(sv);
  49  hv_iterinit(hv);
  50  while (key = hv_iternext(hv)) {
  51   c += SvNV(HeVAL(key));
  52  }
  53  XSRETURN_NV(c);
  54
  55 void
  56 scalops()
  57 PROTOTYPE:
  58 PREINIT:
  59  U32 cxt;
  60  int i, count = 0;
  61 CODE:
  62  cxt = GIMME_V;
  63  if (cxt == G_SCALAR) {
  64   for (i = 0; i < OP_max; ++i) {
  65    count += (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) != 0;
  66   }
  67   EXTEND(SP, 1);
  68   mPUSHi(count);
  69   XSRETURN(1);
  70  } else if (cxt == G_ARRAY) {
  71   for (i = 0; i < OP_max; ++i) {
  72    if (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) {
  73     const char *name = PL_op_name[i];
  74     XPUSHs(sv_2mortal(newSVpvn_share(name, strlen(name), 0)));
  75     ++count;
  76    }
  77   }
  78   XSRETURN(count);
  79  }
  80