view release on metacpan or  search on metacpan

XS.xs  view on Meta::CPAN

PROTOTYPE: ;$
CODE:
{
    int i;
    int exhausted = 1;

    /* 'cv' is the hidden argument with which
     * XS_List__SomeUtils__XS__array_iterator (this XSUB) is called. The
     * closure_arg struct is stored in this CV. */

    arrayeach_args *args = (arrayeach_args *)(CvXSUBANY(cv).any_ptr);

    if (strEQ(method, "index")) {
        EXTEND(SP, 1);
        ST(0) = args->curidx > 0 ? sv_2mortal(newSViv(args->curidx-1)) : &PL_sv_undef;
        XSRETURN(1);
    }

    EXTEND(SP, args->navs);

    for (i = 0; i < args->navs; i++) {
        AV *av = args->avs[i];
        if (args->curidx <= av_len(av)) {
            ST(i) = sv_2mortal(newSVsv(*av_fetch(av, args->curidx, FALSE)));
            exhausted = 0;
            continue;
        }
        ST(i) = &PL_sv_undef;
    }

    if (exhausted)
        XSRETURN_EMPTY;

    args->curidx++;
    XSRETURN(args->navs);
}

SV *
each_array (...)
PROTOTYPE: \@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@
CODE:
{
    EACH_ARRAY_BODY;
}
OUTPUT:
    RETVAL

SV *
each_arrayref (...)
CODE:
{
    EACH_ARRAY_BODY;
}
OUTPUT:
    RETVAL

void
pairwise (code, ...)
    SV *code;
PROTOTYPE: &\@\@
PPCODE:
{
#define av_items(a) (av_len(a)+1)

    /* This function is not quite as efficient as it ought to be: We call
     * 'code' multiple times and want to gather its return values all in one
     * list. However, each call resets the stack pointer so there is no
     * obvious way to get the return values onto the stack without making
     * intermediate copies of the pointers.  The above disabled solution would
     * be more efficient. Unfortunately it doesn't work (and, as of now,
     * wouldn't deal with 'code' returning more than one value).
     *
     * The current solution is a fair trade-off. It only allocates memory for
     * a list of SV-pointers, as many as there are return values. It
     * temporarily stores 'code's return values in this list and, when done,
     * copies them down to SP. */

    int i, j;
    AV *avs[2];
    SV **buf, **p;  /* gather return values here and later copy down to SP */
    int alloc;

    int nitems = 0, maxitems = 0;
    int d;

    if (!codelike(code))
        croak_xs_usage(cv,  "code, list, list");
    if (!arraylike(ST(1)))
        croak_xs_usage(cv,  "code, list, list");
    if (!arraylike(ST(2)))
        croak_xs_usage(cv,  "code, list, list");

    if (in_pad(aTHX_ code)) {
        croak("Can't use lexical $a or $b in pairwise code block");
    }

    /* deref AV's for convenience and
     * get maximum items */
    avs[0] = (AV*)SvRV(ST(1));
    avs[1] = (AV*)SvRV(ST(2));
    maxitems = av_items(avs[0]);
    if (av_items(avs[1]) > maxitems)
        maxitems = av_items(avs[1]);

    if (!PL_firstgv || !PL_secondgv) {
        SAVESPTR(PL_firstgv);
        SAVESPTR(PL_secondgv);
        PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
        PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
    }

    New(0, buf, alloc = maxitems, SV*);

    ENTER;
    for (d = 0, i = 0; i < maxitems; i++) {
        int nret;
        SV **svp = av_fetch(avs[0], i, FALSE);
        GvSV(PL_firstgv) = svp ? *svp : &PL_sv_undef;
        svp = av_fetch(avs[1], i, FALSE);
        GvSV(PL_secondgv) = svp ? *svp : &PL_sv_undef;
        PUSHMARK(SP);

XS.xs  view on Meta::CPAN

OUTPUT:
    RETVAL

int
bsearchidx (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    HV *stash;
    GV *gv;
    I32 gimme = GIMME_V; /* perl-5.5.4 bus-errors out later when using GIMME
                            therefore we save its value in a fresh variable */
    SV **args = &PL_stack_base[ax];

    long i, j;
    int val = -1;

    if (!codelike(code))
        croak_xs_usage(cv,  "code, ...");

    RETVAL = -1;

    if (items > 1) {
        CV *_cv = sv_2cv(code, &stash, &gv, 0);
        PUSH_MULTICALL(_cv);
        SAVESPTR(GvSV(PL_defgv));

        i = 0;
        j = items - 1;
        do {
            long k = (i + j) / 2;

            if (k >= items-1)
                break;

            GvSV(PL_defgv) = args[1+k];
            MULTICALL;
            val = SvIV(*PL_stack_sp);

            if (val == 0) {
                RETVAL = k;
                break;
            }
            if (val < 0) {
                i = k+1;
            } else {
                j = k-1;
            }
        } while (i <= j);
        POP_MULTICALL;
    }
}
OUTPUT:
    RETVAL

void
mode (...)
PROTOTYPE: @
PPCODE:
{
    int i;
    unsigned int max = 0;
    unsigned int c = 0;
    unsigned int modality = 0;
    SV **args = &PL_stack_base[ax];
    HV *hv = newHV();
    SV *tmp = sv_newmortal();
    HE *he;

    sv_2mortal(newRV_noinc((SV*)hv));
    if (!items) {
        if (GIMME_V == G_SCALAR) {
            mPUSHi(0);
            PUTBACK;
            return;
        }
        else {
            XSRETURN_EMPTY;
        }
    }

    for (i = 0; i < items; i++) {
        SvGETMAGIC(args[i]);

        SvSetSV_nosteal(tmp, args[i]);
        he = hv_fetch_ent(hv, tmp, 0, 0);

        if (NULL == he) {
            hv_store_ent(hv, tmp, newSViv(1), 0);
        }
        else {
            SV *v = HeVAL(he);
            IV how_many = SvIVX(v);
            sv_setiv(v, ++how_many);
        }
    }

    hv_iterinit(hv);
    while ((he = hv_iternext(hv))) {
        c = SvIV(HeVAL(he));
        if (c > max) {
            max = c;
        }
    }

    i = 0;
    hv_iterinit(hv);
    while ((he = hv_iternext(hv))) {
        if (SvIV(HeVAL(he)) == max) {
            if (GIMME_V == G_SCALAR) {
                modality++;
            } else {
                XPUSHs(HeSVKEY_force(he));
            }
        }
    }

    if  (GIMME_V == G_SCALAR) {
        mXPUSHu(modality);