File Coverage

Affinity.xs

Criterion	Covered	Total	%
statement	61	84	72.6
branch	38	76	50.0
condition			n/a
subroutine			n/a
pod			n/a
total	99	160	61.8

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include
#include
#include
//#include

struct xs_state {
    cpu_set_t *set;
    size_t size;
};

typedef struct xs_state Linux_Sys_CPU_Affinity;

void init_set (Linux_Sys_CPU_Affinity *cpuset, AV *av) {

    static int available_cpus_cnt = 0;

    /* get available amount of CPU cores */
    if (available_cpus_cnt == 0)
        available_cpus_cnt = get_nprocs(); // sysconf(_SC_NPROCESSORS_ONLN);

    /* if we're failed, then use constant, mostly it equals to 1024 */
    if (available_cpus_cnt == -1)
        available_cpus_cnt = CPU_SETSIZE;

    if (cpuset->set != NULL)
        CPU_FREE(cpuset->set);

    cpuset->size = CPU_ALLOC_SIZE(available_cpus_cnt);
    cpuset->set = CPU_ALLOC(available_cpus_cnt);

    if (cpuset->set == NULL) {
        SV *msg = sv_2mortal( newSVpvf("Failed to allocate memory for %i CPUs", available_cpus_cnt) );
        Perl_croak(pTHX_ (char *) SvPV_nolen(msg));
    }

    CPU_ZERO_S(cpuset->size, cpuset->set);

    if (av != NULL) {
        SSize_t i;
        SSize_t av_len = av_len(av) + 1;
        for (i = 0; i < av_len; i++) {
            size_t cpu = SvIV((SV*)*av_fetch(av, i, 0)); // SvIVX to coerce value into IV
            //Perl_warner_nocontext(aTHX_ packWARN(WARN_QW), "value = %i\n", cpu);
            CPU_SET_S(cpu, cpuset->size, cpuset->set);
        }
    }
}

AV* _extract_and_validate_av(SV *sv) {

    if (!SvOK(sv))
        Perl_croak(aTHX_ "the CPU's list can't be undefined");

    if (SvTIED_mg(sv, PERL_MAGIC_tied))
        Perl_croak(aTHX_ "tied objects aren't supported");

    if (!SvROK(sv))
        Perl_croak(aTHX_ "the CPU's list must be an array reference");

    SV *ref = SvRV(sv);
    AV *av;

    switch (SvTYPE(ref)) {
        case SVt_PVAV: // $ref eq "ARRAY"
            av = (AV *) ref;
            break;
        default:       // $ref ne "ARRAY"
            Perl_croak(aTHX_ "the CPU's list must be an array reference");
    }

    SSize_t i;
    SSize_t bad_arg = -1;
    // SV **arr = AvARRAY(av);

    for (i = av_len(av); i >= 0; i--) {
        SV *val = (SV *) *av_fetch(av, i, 0);
        // SV *val = arr[i];
        if (!SvOK(val) || !SvIOK(val)) {
            bad_arg = i;
            break;
        }
    }

    if (bad_arg != -1) {
        // postpone SvREFCNT_dec(sv)
        SV *msg = sv_2mortal( newSVpvf("Not an integer at position %i", bad_arg) );
        Perl_croak(pTHX_ (char *) SvPV_nolen(msg));
    }

    return av;
}

MODULE = Linux::Sys::CPU::Affinity		PACKAGE = Linux::Sys::CPU::Affinity

PROTOTYPES: DISABLE

Linux_Sys_CPU_Affinity* new(class_name, sv = &PL_sv_undef)
    char *class_name
    SV *sv
PREINIT:
    Linux_Sys_CPU_Affinity *cpuset;
    AV* av = NULL;
CODE:

    if (SvOK(sv))
        av = _extract_and_validate_av(sv);

    cpuset = (Linux_Sys_CPU_Affinity *) malloc(sizeof(Linux_Sys_CPU_Affinity));

    cpuset->set = NULL;

    init_set(cpuset, av);

    RETVAL = cpuset;
OUTPUT:
    RETVAL


SV* cpu_zero(cpuset)
    Linux_Sys_CPU_Affinity *cpuset
CODE:
    init_set(cpuset, NULL);
    XSRETURN_UNDEF;
OUTPUT:
    RETVAL


SV* reset(cpuset, sv = &PL_sv_undef)
    Linux_Sys_CPU_Affinity *cpuset
    SV *sv
PREINIT:
    AV* av = NULL;
CODE:
    if (SvOK(sv))
        av = _extract_and_validate_av(sv);
    init_set(cpuset, av);
    XSRETURN_UNDEF;


IV cpu_isset (cpuset, cpu)
    Linux_Sys_CPU_Affinity *cpuset
    UV cpu
PPCODE:
    int res = CPU_ISSET_S((uint32_t) cpu, cpuset->size, cpuset->set);
    mXPUSHu( res );
    XSRETURN(1);


IV cpu_set (cpuset, cpu)
    Linux_Sys_CPU_Affinity *cpuset
    UV cpu
PPCODE:
    CPU_SET_S((uint32_t) cpu, cpuset->size, cpuset->set);
    XSRETURN_UNDEF;


IV cpu_clr (cpuset, cpu)
    Linux_Sys_CPU_Affinity *cpuset
    UV cpu
PPCODE:
    CPU_CLR_S((uint32_t) cpu, cpuset->size, cpuset->set);
    XSRETURN_UNDEF;


UV cpu_count(cpuset)
    Linux_Sys_CPU_Affinity *cpuset
PPCODE:
    int cpu_count = CPU_COUNT_S(cpuset->size, cpuset->set);
    mXPUSHu( cpu_count ); // PUSHs(sv_2mortal(newSVuv(cpu_count)));
    XSRETURN(1);


IV set_affinity(cpuset, pid)
    Linux_Sys_CPU_Affinity *cpuset
    UV pid
PPCODE:
    int res = sched_setaffinity((pid_t) pid, cpuset->size, cpuset->set);
    if (res == -1) {
        SV *error = sv_2mortal(newSV(0));
        switch (errno) {
            case EFAULT:
                sv_setpv(error, "A supplied memory address was invalid");
                break;
            case EINVAL:
                sv_setpv(error, "The affinity bit mask mask contains no processors that are currently physically on the system and permitted to the thread");
                break;
            case EPERM:
                sv_setpv(error, "The calling thread does not have appropriate privileges");
                break;
            case ESRCH:
                sv_setpv(error, "The thread whose ID is pid could not be found");
                break;
            default:
                sv_setpv(error, "Unknown error has occurred");
        }
        Perl_croak(pTHX_ (char *) SvPV_nolen(error));
    }
    mXPUSHi( res );
    XSRETURN(1);


void DESTROY (cpuset)
    Linux_Sys_CPU_Affinity *cpuset
PPCODE:
    CPU_FREE(cpuset->set);
    free(cpuset);
    XSRETURN_UNDEF;