1 /* This file is part of the Sub::Nary Perl module.
2 * See http://search.cpan.org/dist/Sub::Nary/ */
4 #define PERL_NO_GET_CONTEXT
10 # define mPUSHi(I) PUSHs(sv_2mortal(newSViv(I)))
13 /* --- XS ------------------------------------------------------------------ */
15 MODULE = Sub::Nary PACKAGE = Sub::Nary
23 ST(0) = sv_2mortal(newSVuv(SvIV(SvRV(op))));
32 o = INT2PTR(OP *, SvIV(SvRV(op)));
33 ST(0) = sv_2mortal(newSVuv(o == NULL));
46 res = SvNOK(sv) ? SvNV(sv) == 0.0 : SvUV(sv) == 0;
50 res = hv_exists(hv, "0", 1) && hv_iterinit(hv) == 1;
63 res = strEQ(SvPV_nolen(sv), "list");
67 res = hv_exists(hv, "list", 4) && hv_iterinit(hv) == 1;
84 while (key = hv_iternext(hv)) {
85 c += SvNV(HeVAL(key));
103 if (!hv_store_ent(res, sv, val, 0)) {
108 hv = (HV *) SvRV(sv);
109 if (!hv_iterinit(hv)) {
111 if (!hv_store(res, "0", 1, val, 0)) {
116 while (key = hv_iternext(hv)) {
117 c += SvNV(HeVAL(key));
120 while (key = hv_iternext(hv)) {
121 val = newSVnv(SvNV(HeVAL(key)) / c);
122 if (!hv_store_ent(res, HeSVKEY_force(key), val, HeHASH(key)))
127 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
138 if (cxt == G_SCALAR) {
139 for (i = 0; i < OP_max; ++i) {
140 count += (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) != 0;
145 } else if (cxt == G_ARRAY) {
146 for (i = 0; i < OP_max; ++i) {
147 if (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) {
148 const char *name = PL_op_name[i];
149 XPUSHs(sv_2mortal(newSVpvn_share(name, strlen(name), 0)));