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 zero(SV *sv)
  38 PROTOTYPE: $
  39 PREINIT:
  40  HV *hv;
  41  IV res;
  42 CODE:
  43  if (!SvOK(sv))
  44   XSRETURN_IV(1);
  45  if (!SvROK(sv)) {
  46   res = SvNOK(sv) ? SvNV(sv) == 0.0 : SvUV(sv) == 0;
  47   XSRETURN_IV(res);
  48  }
  49  hv = (HV *) SvRV(sv);
  50  res = hv_exists(hv, "0", 1) && hv_iterinit(hv) == 1;
  51  XSRETURN_IV(res);
  52
  53 void
  54 list(SV *sv)
  55 PROTOTYPE: $
  56 PREINIT:
  57  HV *hv;
  58  IV res;
  59 CODE:
  60  if (!SvOK(sv))
  61   XSRETURN_IV(0);
  62  if (!SvROK(sv)) {
  63   res = strEQ(SvPV_nolen(sv), "list");
  64   XSRETURN_IV(res);
  65  }
  66  hv = (HV *) SvRV(sv);
  67  res = hv_exists(hv, "list", 4) && hv_iterinit(hv) == 1;
  68  XSRETURN_IV(res);
  69
  70 void
  71 count(SV *sv)
  72 PROTOTYPE: $
  73 PREINIT:
  74  HV *hv;
  75  HE *key;
  76  NV c = 0;
  77 CODE:
  78  if (!SvOK(sv))
  79   XSRETURN_IV(0);
  80  if (!SvROK(sv))
  81   XSRETURN_IV(1);
  82  hv = (HV *) SvRV(sv);
  83  hv_iterinit(hv);
  84  while (key = hv_iternext(hv)) {
  85   c += SvNV(HeVAL(key));
  86  }
  87  XSRETURN_NV(c);
  88
  89 void
  90 scalops()
  91 PROTOTYPE:
  92 PREINIT:
  93  U32 cxt;
  94  int i, count = 0;
  95 CODE:
  96  cxt = GIMME_V;
  97  if (cxt == G_SCALAR) {
  98   for (i = 0; i < OP_max; ++i) {
  99    count += (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) != 0;
 100   }
 101   EXTEND(SP, 1);
 102   mPUSHi(count);
 103   XSRETURN(1);
 104  } else if (cxt == G_ARRAY) {
 105   for (i = 0; i < OP_max; ++i) {
 106    if (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) {
 107     const char *name = PL_op_name[i];
 108     XPUSHs(sv_2mortal(newSVpvn_share(name, strlen(name), 0)));
 109     ++count;
 110    }
 111   }
 112   XSRETURN(count);
 113  }
 114