Affix

 view release on metacpan or  search on metacpan

lib/Affix.c  view on Meta::CPAN

        sv_setpv(sv, (const char *)c_ptr);
}

static void pull_pointer_as_struct(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * ptr) {
    void * c_ptr = *(void **)ptr;
    if (c_ptr == nullptr)
        sv_setsv(sv, &PL_sv_undef);
    else {
        const infix_type * pointee_type = type->meta.pointer_info.pointee_type;
        pull_struct(aTHX_ affix, sv, pointee_type, c_ptr);
    }
}

static void pull_struct_as_live(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * ptr) {
    void * c_ptr = *(void **)ptr;
    if (c_ptr == nullptr) {
        sv_setsv(sv, &PL_sv_undef);
        return;
    }
    const infix_type * pointee_type = type->meta.pointer_info.pointee_type;
    HV * hv = newHV();
    SV * rv = newRV_noinc(MUTABLE_SV(hv));
    sv_bless(rv, gv_stashpv("Affix::Live", GV_ADD));
    _populate_hv_from_c_struct(aTHX_ affix, hv, pointee_type, c_ptr, true, nullptr);
    sv_setsv(sv, rv);
    SvREFCNT_dec(rv);
}

static void pull_pointer_as_array(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * ptr) {
    void * c_ptr = *(void **)ptr;
    if (c_ptr == nullptr)
        sv_setsv(sv, &PL_sv_undef);
    else {
        const infix_type * pointee_type = type->meta.pointer_info.pointee_type;
        pull_array(aTHX_ affix, sv, pointee_type, c_ptr);
    }
}

static void pull_pointer_as_pin(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * ptr) {
    void * c_ptr = *(void **)ptr;

    if (c_ptr == nullptr) {
        sv_setsv(sv, &PL_sv_undef);
        return;
    }

    Affix_Pin * pin;
    Newxz(pin, 1, Affix_Pin);
    pin->pointer = c_ptr;

    // Ensure we point to the content type, not Pointer[Content]
    pin->type = _unwrap_pin_type(type);
    pin->managed = false;

    SV * obj_data = newSV(0);
    sv_setiv(obj_data, PTR2IV(pin));

    // Create the Reference
    SV * rv = sv_2mortal(newRV_noinc(obj_data));

    // Bless into Affix::Pointer BEFORE attaching magic to avoid triggering 'set' during blessing
    (void)sv_bless(rv, gv_stashpv("Affix::Pointer", GV_ADD));

    MAGIC * mg = sv_magicext(obj_data, nullptr, PERL_MAGIC_ext, &Affix_pin_vtbl, nullptr, 0);
    mg->mg_ptr = (char *)pin;

    // Update the target SV
    sv_setsv(sv, rv);
}

static void pull_sv(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * ptr) {
    void * c_ptr = *(void **)ptr;
    if (c_ptr == nullptr)
        sv_setsv(sv, &PL_sv_undef);
    else
        sv_setsv(sv, (SV *)c_ptr);
}

static void pull_file(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * ptr) {
    PERL_UNUSED_VAR(affix);
    PERL_UNUSED_VAR(type);
    FILE * fp = *(FILE **)ptr;
    if (!fp) {
        sv_setsv(sv, &PL_sv_undef);
        return;
    }

    // Duplicate FD to avoid double-close issues
    int fd =
#ifdef _WIN32
        _fileno
#else
        fileno
#endif
        (fp);
    if (fd < 0) {
        sv_setsv(sv, &PL_sv_undef);
        return;
    }

    int new_fd = PerlLIO_dup(fd);
    if (new_fd < 0) {
        sv_setsv(sv, &PL_sv_undef);
        return;
    }

    PerlIO * new_pio = PerlIO_fdopen(new_fd, "r+");  // Assuming R/W safe
    if (!new_pio) {
        PerlLIO_close(new_fd);
        sv_setsv(sv, &PL_sv_undef);
        return;
    }

    GV * gv = newGVgen("Affix::FileHandle");
    if (do_open(gv, "+<&", 3, FALSE, 0, 0, new_pio))
        sv_setsv(sv, sv_2mortal(newRV((SV *)gv)));
    else {
        PerlIO_close(new_pio);
        sv_setsv(sv, &PL_sv_undef);
    }
}

lib/Affix.c  view on Meta::CPAN

    }
    else {
        Newxz(pin, 1, Affix_Pin);
        mg = sv_magicext(sv, nullptr, PERL_MAGIC_ext, &Affix_pin_vtbl, nullptr, 0);
    }
    // Re-assign mg_ptr because sv_magicext(..., 0) likely corrupted it by treating pin as a string
    mg->mg_ptr = (char *)pin;

    pin->pointer = pointer;
    pin->managed = managed;
    pin->bit_offset = bit_offset;
    pin->bit_width = bit_width;

    if (owner_sv) {
        pin->owner_sv = owner_sv;
        SvREFCNT_inc(pin->owner_sv);
    }

    pin->type_arena = infix_arena_create(2048);
    if (!pin->type_arena) {
        safefree(pin);
        mg->mg_ptr = nullptr;
        croak("Failed to create memory arenas for pin's type information");
    }
    pin->type = _copy_type_graph_to_arena(pin->type_arena, type);
    if (!pin->type) {
        infix_arena_destroy(pin->type_arena);
        safefree(pin);
        mg->mg_ptr = nullptr;
        croak("Failed to copy type information into pin");
    }
}
XS_INTERNAL(Affix_find_symbol) {
    dXSARGS;
    dMY_CXT;  // Require the thread-local context
    if (items != 2 || !sv_isobject(ST(0)) || !sv_derived_from(ST(0), "Affix::Lib"))
        croak_xs_usage(cv, "Affix_Lib_object, symbol_name");
    IV tmp = SvIV((SV *)SvRV(ST(0)));
    infix_library_t * lib = INT2PTR(infix_library_t *, tmp);
    const char * name = SvPV_nolen(ST(1));
    void * symbol = infix_library_get_symbol(lib, name);
    if (symbol) {
        Affix_Pin * pin;
        Newxz(pin, 1, Affix_Pin);
        pin->pointer = symbol;
        pin->managed = false;
        pin->owner_sv = ST(0);
        SvREFCNT_inc(pin->owner_sv);
        pin->type_arena = infix_arena_create(256);
        infix_type * void_ptr_type = nullptr;
        if (infix_type_create_pointer_to(pin->type_arena, &void_ptr_type, infix_type_create_void()) != INFIX_SUCCESS) {
            safefree(pin);
            infix_arena_destroy(pin->type_arena);
            croak("Internal error: Failed to create pointer type for pin");
        }
        pin->type = void_ptr_type;
        SV * obj_data = newSV(0);
        sv_setiv(obj_data, PTR2IV(pin));
        SV * rv = newRV_inc(obj_data);

        // Bless into Affix::Pointer BEFORE attaching magic to avoid triggering 'set' during blessing
        (void)sv_bless(rv, gv_stashpv("Affix::Pointer", GV_ADD));

        MAGIC * mg = sv_magicext(obj_data, nullptr, PERL_MAGIC_ext, &Affix_pin_vtbl, nullptr, 0);
        mg->mg_ptr = (char *)pin;
        ST(0) = sv_2mortal(rv);
        XSRETURN(1);
    }
    XSRETURN_UNDEF;
}

XS_INTERNAL(Affix_pin) {
    dXSARGS;
    dMY_CXT;
    if (items != 4)
        croak_xs_usage(cv, "var, lib, symbol, type");
    SV * target_sv = ST(0);
    const char * lib_path_or_name = SvPV_nolen(ST(1));
    const char * symbol_name = SvPV_nolen(ST(2));
    const char * signature = SvPV_nolen(ST(3));
    infix_library_t * lib = infix_library_open(lib_path_or_name);
    if (lib == nullptr) {
        warn("Failed to load library from path '%s' for pinning: %s", lib_path_or_name, infix_get_last_error().message);
        XSRETURN_UNDEF;
    }
    void * ptr = infix_library_get_symbol(lib, symbol_name);
    infix_library_close(lib);
    if (ptr == nullptr) {
        warn("Failed to locate symbol '%s' in library '%s'", symbol_name, lib_path_or_name);
        XSRETURN_UNDEF;
    }
    infix_type * type = nullptr;
    infix_arena_t * arena = nullptr;
    const char * sig_to_parse = signature;
    char * clean_sig = nullptr;
    if (strstr(signature, "+")) {
        clean_sig = savepv(signature);
        const char * p = signature;
        char * d = clean_sig;
        while (*p) {
            // Strip '+' only if it precedes a signature character: * [ { ! < ( @
            if (*p == '+' &&
                (p[1] == '*' || p[1] == '[' || p[1] == '{' || p[1] == '!' || p[1] == '<' || p[1] == '(' || p[1] == '@'))
                p++;
            else
                *d++ = *p++;
        }
        *d = '\0';
        sig_to_parse = clean_sig;
    }

    if (infix_type_from_signature(&type, &arena, sig_to_parse, MY_CXT.registry) != INFIX_SUCCESS) {
        SV * err_sv = _format_parse_error(aTHX_ "for pin", sig_to_parse, infix_get_last_error());
        warn_sv(err_sv);
        if (arena)
            infix_arena_destroy(arena);
        if (clean_sig)
            safefree(clean_sig);
        XSRETURN_UNDEF;
    }
    _pin_sv(aTHX_ target_sv, type, ptr, false, nullptr, 0, 0);

lib/Affix.c  view on Meta::CPAN

             * Primitives expect a pointer to the value.
             * 'ptr_val' IS the address of the value. We pass 'ptr_val'.
             * The handler reads *(int*)ptr_val.
             */
            ptr2sv(aTHX_ nullptr, ptr_val, ret_val, new_type);
        }

        infix_arena_destroy(parse_arena);
        ST(0) = ret_val;
    }
    else {
        /* Return Alias Pin */
        Affix_Pin * new_pin;
        Newxz(new_pin, 1, Affix_Pin);
        new_pin->pointer = ptr_val;
        new_pin->managed = false;
        new_pin->type_arena = parse_arena;

        if (pin) {
            new_pin->owner_sv = pin->owner_sv ? pin->owner_sv : arg;
            SvREFCNT_inc(new_pin->owner_sv);
        }

        if (new_type->category == INFIX_TYPE_POINTER)
            new_pin->type = _unwrap_pin_type(new_type);
        else
            new_pin->type = new_type;

        // Create the object (SV wrapped in RV)
        SV * rv = _new_pointer_obj(aTHX_ new_pin);

        // Return the RV
        ST(0) = sv_2mortal(rv);
    }
    XSRETURN(1);
}

XS_INTERNAL(Affix_own) {
    dXSARGS;
    if (items < 1)
        croak_xs_usage(cv, "pin, [should_own]");

    Affix_Pin * pin = _get_pin_from_sv(aTHX_ ST(0));
    if (!pin) {
        warn("Argument is not a pinned pointer");
        XSRETURN_UNDEF;
    }

    if (items > 1) {
        // Don't dirty the memory if value hasn't changed
        bool new_val = SvTRUE(ST(1));
        if (pin->managed != new_val)
            pin->managed = new_val;
    }

    // Return current state as fast booleans (PL_sv_yes/no are essentially singletons)
    ST(0) = pin->managed ? &PL_sv_yes : &PL_sv_no;
    XSRETURN(1);
}

XS_INTERNAL(Affix_attach_destructor) {
    dXSARGS;
    if (items < 2)
        croak_xs_usage(cv, "pin, destructor_ptr, [lib_obj]");

    Affix_Pin * pin = _get_pin_from_sv(aTHX_ ST(0));
    if (!pin) {
        warn("First argument to attach_destructor must be a pinned pointer");
        XSRETURN_UNDEF;
    }

    void * destructor_ptr = nullptr;
    if (SvIOK(ST(1)))
        destructor_ptr = INT2PTR(void *, SvUV(ST(1)));
    else {
        Affix_Pin * dpin = _get_pin_from_sv(aTHX_ ST(1));
        if (dpin)
            destructor_ptr = dpin->pointer;
    }

    if (!destructor_ptr) {
        warn("Destructor pointer cannot be null");
        XSRETURN_UNDEF;
    }

    pin->destructor = (void (*)(void *))destructor_ptr;

    if (items > 2 && sv_isobject(ST(2)) && sv_derived_from(ST(2), "Affix::Lib"))
        pin->destructor_lib_sv = newSVsv(ST(2));

    XSRETURN_YES;
}

XS_INTERNAL(Affix_errno) {
    dXSARGS;
    PERL_UNUSED_VAR(items);

    SV * dual = newSV(1);

#ifdef _WIN32
    DWORD err_code = GetLastError();
    sv_setuv(dual, (UV)err_code);

    char * buf = nullptr;
    DWORD len =
        FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
                       nullptr,
                       err_code,
                       MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
                       (LPSTR)&buf,
                       0,
                       nullptr);

    if (buf) {
        while (len > 0 && (buf[len - 1] == '\n' || buf[len - 1] == '\r'))
            buf[--len] = '\0';
        sv_setpvn(dual, buf, len);
        LocalFree(buf);
    }
    else
        sv_setpvn(dual, "Unknown system error", 20);

    SvIOK_on(dual);
    SvIsUV_on(dual);  // Mark as unsigned for DWORD
#else
    int err_code = errno;
    sv_setiv(dual, err_code);

lib/Affix.c  view on Meta::CPAN

        sv_setsv(get_sv("Affix::()", TRUE), &PL_sv_yes);
        (void)newXSproto_portable("Affix::()", Affix_as_string, __FILE__, "$;@");

        sv_setsv(get_sv("Affix::Lib::()", TRUE), &PL_sv_yes);
        (void)newXSproto_portable("Affix::Lib::(0+", Affix_Lib_as_string, __FILE__, "$;@");
        (void)newXSproto_portable("Affix::Lib::()", Affix_as_string, __FILE__, "$;@");

        // Library & core utils
        XSUB_EXPORT(load_library, "$", "lib");
        XSUB_EXPORT(find_symbol, "$$", "lib");
        XSUB_EXPORT(get_last_error_message, "", "core");

        // Scalar pins
        XSUB_EXPORT(pin, "$$$$", "pin");
        XSUB_EXPORT(unpin, "$", "pin");

        // Introspection
        XSUB_EXPORT(sizeof, "$", "core");
        XSUB_EXPORT(alignof, "$", "core");
        XSUB_EXPORT(offsetof, "$$", "core");

        // Type registry
        (void)newXSproto_portable("Affix::_typedef", Affix_typedef, __FILE__, "$;$");
        (void)newXSproto_portable("Affix::_register_enum_values", Affix_register_enum_values, __FILE__, "$$$");
        (void)newXSproto_portable("Affix::types", Affix_defined_types, __FILE__, "");

        // Debugging
        (void)newXSproto_portable("Affix::sv_dump", Affix_sv_dump, __FILE__, "$");

        // Memory management & pointers
        XSUB_EXPORT(address, "$", "memory");
        XSUB_EXPORT(malloc, "$", "memory");
        XSUB_EXPORT(calloc, "$$", "memory");
        XSUB_EXPORT(realloc, "$$", "memory");
        XSUB_EXPORT(free, "$", "memory");
        XSUB_EXPORT(cast, "$$", "memory");
        XSUB_EXPORT(dump, "$$", "memory");
        XSUB_EXPORT(own, "$;$", "memory");

        // Raw memory operations
        XSUB_EXPORT(memcpy, "$$$", "memory");
        XSUB_EXPORT(memmove, "$$$", "memory");
        XSUB_EXPORT(memset, "$$$", "memory");
        XSUB_EXPORT(memcmp, "$$$", "memory");
        XSUB_EXPORT(memchr, "$$$", "memory");

        // Pointer utils
        XSUB_EXPORT(ptr_add, "$$", "memory");
        XSUB_EXPORT(ptr_diff, "$$", "memory");
        XSUB_EXPORT(strdup, "$", "memory");
        XSUB_EXPORT(strnlen, "$$", "memory");
        XSUB_EXPORT(is_null, "$", "memory");

        // Pin internals (for Affix::Pointer)
        (void)newXSproto_portable("Affix::_pin_type", Affix_pin_type, __FILE__, "$");
        (void)newXSproto_portable("Affix::_pin_element_type", Affix_pin_element_type, __FILE__, "$");
        (void)newXSproto_portable("Affix::_pin_count", Affix_pin_count, __FILE__, "$");
        (void)newXSproto_portable("Affix::_pin_size", Affix_pin_size, __FILE__, "$");
        (void)newXSproto_portable("Affix::_pin_get_at", Affix_pin_get_at, __FILE__, "$$");
        (void)newXSproto_portable("Affix::_pin_set_at", Affix_pin_set_at, __FILE__, "$$$");
        (void)newXSproto_portable("Affix::_attach_destructor", Affix_attach_destructor, __FILE__, "$$;$");
    }

    XSUB_EXPORT(coerce, "$$", "core");

    XSUB_EXPORT(errno, "", "core");
    (void)newXSproto_portable("Affix::set_destruct_level", Affix_set_destruct_level, __FILE__, "$");

#undef XSUB_EXPORT

    Perl_xs_boot_epilog(aTHX_ ax);
}