Affix

 view release on metacpan or  search on metacpan

lib/Affix.c  view on Meta::CPAN

    for (size_t i = 0; i < num_args; ++i) {
        const infix_type * type = infix_reverse_get_arg_type(ctx, i);
        Affix_Pull puller = get_pull_handler(aTHX_ type);
        if (!puller)
            croak("Unsupported callback argument type");
        SV * arg_sv = newSV(0);
        puller(aTHX_ nullptr, arg_sv, type, args[i], false);
        mXPUSHs(arg_sv);
    }
    PUTBACK;
    const infix_type * ret_type = infix_reverse_get_return_type(ctx);
    U32 call_flags = /* G_EVAL |*/ G_KEEPERR | ((ret_type->category == INFIX_TYPE_VOID) ? G_VOID : G_SCALAR);
    size_t count = call_sv(cb_data->coderef_rv, call_flags);
    if (SvTRUE(ERRSV)) {
        Perl_warn(aTHX_ "Perl callback died: %" SVf, ERRSV);
        sv_setsv(ERRSV, &PL_sv_undef);
        if (retval && !(call_flags & G_VOID))
            memset(retval, 0, infix_type_get_size(ret_type));
    }
    else if (call_flags & G_SCALAR) {
        SPAGAIN;
        SV * return_sv = (count == 1) ? POPs : &PL_sv_undef;
        sv2ptr(aTHX_ nullptr, return_sv, retval, ret_type);
        PUTBACK;
    }
    FREETMPS;
    LEAVE;
}

XS_INTERNAL(Affix_as_string) {
    dVAR;
    dXSARGS;
    if (items < 1)
        croak_xs_usage(cv, "$affix");

lib/Affix.c  view on Meta::CPAN

    if (!get_cvs("Data::Printer::p", GV_NOADD_NOINIT | GV_NO_SVGMAGIC))
        return;
    fflush(stdout);
    dSP;
    int count;
    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    EXTEND(SP, 1);
    PUSHs(scalar);
    PUTBACK;
    count = call_pv("Data::Printer::p", G_SCALAR);
    SPAGAIN;
    if (count != 1) {
        warn("Big trouble\n");
        return;
    }
    STRLEN len;
    const char * s = SvPVx(POPs, len);
    printf("%s at %s line %d\n", s, file, line);
    fflush(stdout);
    PUTBACK;
    FREETMPS;
    LEAVE;
}

XS_INTERNAL(Affix_sv_dump) {
    dXSARGS;
    if (items != 1)
        croak_xs_usage(cv, "sv");
    sv_dump(ST(0));
    XSRETURN_EMPTY;

lib/Affix/marshal.c  view on Meta::CPAN

        const infix_type * type = infix_reverse_get_arg_type(ctx, i);
        Affix_Pull puller = get_pull_handler(aTHX_ type);

        if (!puller)
            croak("Unsupported struct callback argument type");

        SV * arg_sv = newSV(0);
        puller(aTHX_ nullptr, arg_sv, type, args[i], false);
        mXPUSHs(arg_sv);
    }
    PUTBACK;

    const infix_type * ret_type = infix_reverse_get_return_type(ctx);
    U32 call_flags = G_KEEPERR | ((ret_type->category == INFIX_TYPE_VOID) ? G_VOID : G_SCALAR);

    size_t count = call_sv((SV *)perl_sub, call_flags);
    SPAGAIN;

    /* Retrieve Perl return value and pass it back to C using Affix 2.0 push handlers */
    if (SvTRUE(ERRSV)) {
        Perl_warn(aTHX_ "Perl struct callback died: %" SVf, ERRSV);
        sv_setsv(ERRSV, &PL_sv_undef);
        if (ret && !(call_flags & G_VOID))
            memset(ret, 0, infix_type_get_size(ret_type));
    }
    else if (call_flags & G_SCALAR) {
        SV * return_sv = (count == 1) ? POPs : &PL_sv_undef;
        sv2ptr(aTHX_ nullptr, return_sv, ret, ret_type);
    }

    PUTBACK;
    FREETMPS;
    LEAVE;
}

void pull_pointer_as_callable(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
    void * c_ptr = *(void **)p;
    if (c_ptr == nullptr) {
        sv_setsv(sv, &PL_sv_undef);
        return;
    }

lib/Affix/marshal.c  view on Meta::CPAN

        sig_ptr++;

    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    EXTEND(SP, 2);
    /* Push arguments for Affix::wrap($address, $signature_string) */
    PUSHs(sv_2mortal(newSVuv(PTR2UV(addr))));
    PUSHs(sv_2mortal(newSVpv(sig_ptr, 0)));
    PUTBACK;

    int count = call_pv("Affix::wrap", G_SCALAR);
    SPAGAIN;

    SV * ret = newSV(0);
    if (count == 1) {
        SV * wrapped = POPs;
        if (SvOK(wrapped))
            sv_setsv(ret, wrapped);
        else
            sv_setuv(ret, PTR2UV(addr));
    }
    else {
        sv_setuv(ret, PTR2UV(addr));
    }

    PUTBACK;
    FREETMPS;
    LEAVE;

    return ret;
}

int get_ptr(pTHX_ SV * sv, MAGIC * mg) {
    Affix_Pin_2_Point_Oh * im = (Affix_Pin_2_Point_Oh *)mg->mg_ptr;
    SvSMAGICAL_off(sv);