Affix

 view release on metacpan or  search on metacpan

lib/Affix.c  view on Meta::CPAN


    if (!addr)
        croak("Could not resolve memory address for pin");
    if (!type_sig)
        croak("Type signature required for pin");

    infix_type * type = nullptr;
    infix_arena_t * arena = nullptr;
    if (infix_type_from_signature(&type, &arena, type_sig, MY_CXT.registry) != INFIX_SUCCESS) {
        if (arena)
            infix_arena_destroy(arena);
        croak("Invalid type signature: %s", type_sig);
    }

    // Bind to the target scalar
    bind_placeholder(aTHX_ target_sv, addr, type, 0, 0, true, owner, arena, false, true);

    // Clean up temporary type_sig if we generated it from infix_type_print
    if (items == 2 && type_sig)
        safefree((void *)type_sig);

    ST(0) = target_sv;
    XSRETURN(1);
}
XS_INTERNAL(Affix_unpin) {
    dXSARGS;
    if (items != 1)
        croak_xs_usage(cv, "var");

    SV * sv = ST(0);
    // Pins are often references to magical scalars; unwrap if necessary
    if (SvROK(sv) && !sv_isobject(sv))
        sv = SvRV(sv);

    if (SvMAGICAL(sv)) {
        MAGIC * mg = mg_find(sv, PERL_MAGIC_ext);
        while (mg) {
            // Check if this magic belongs to the Affix 2.0 memory system
            if (is_v2_vtable(mg->mg_virtual)) {
                // sv_unmagicext returns 0 on success
                if (sv_unmagicext(sv, PERL_MAGIC_ext, mg->mg_virtual) == 0)
                    XSRETURN_YES;
            }
            mg = mg->mg_moremagic;
        }
    }
    XSRETURN_NO;
}
// Handles UTF-16LE (Windows) and UTF-32 (Linux/Mac) conversion to UTF-8 SV
static void pull_pointer_as_wstring(pTHX_ Affix * affix, SV * sv, const infix_type * type, void * p, bool readonly) {
    PERL_UNUSED_VAR(affix);
    PERL_UNUSED_VAR(type);

    wchar_t * wstr = *(wchar_t **)p;

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

    // Calculate length (like wcslen)
    size_t wlen = 0;
    while (wstr[wlen])
        wlen++;

    // Pre-allocate SV buffer.
    // Worst case UTF-8 expansion: 1 wchar (4 bytes) -> 4 UTF-8 bytes.
    // +1 for null terminator.
    SvPVCLEAR(sv);
    char * d = SvGROW(sv, (wlen * sizeof(wchar_t)) + 1);
    wchar_t * s = wstr;

    while (*s) {
        UV uv = (UV)*s++;

        // Handle Windows Surrogate Pairs (UTF-16LE)
        if (sizeof(wchar_t) == 2 && uv >= 0xD800 && uv <= 0xDBFF) {
            if (*s >= 0xDC00 && *s <= 0xDFFF) {
                UV low = (UV)*s++;
                uv = ((uv - 0xD800) << 10) + (low - 0xDC00) + 0x10000;
            }
        }

        d = (char *)uvchr_to_utf8((U8 *)d, uv);
    }
    *d = 0;

    // Set Perl SV properties
    SvCUR_set(sv, d - SvPVX(sv));
    SvPOK_on(sv);
    SvUTF8_on(sv);
}

// Direct marshalling experiment
void Affix_trigger_backend(pTHX_ CV * cv) {
    // Backend optimization is not yet thread-clone friendly in this patch.
    // For now, assume it works or isn't used in the threading test.
    dSP;
    dAXMARK;
    dXSTARG;

    Affix_Backend * backend = (Affix_Backend *)CvXSUBANY(cv).any_ptr;

    if (UNLIKELY((SP - MARK) != backend->num_args))
        croak("Wrong number of arguments to affixed function. Expected %" UVuf ", got %" UVuf,
              (UV)backend->num_args,
              (UV)(SP - MARK));

    size_t ret_size = infix_type_get_size(backend->ret_type);
    void * ret_buffer;
    if (ret_size <= 2048)
        ret_buffer = alloca(ret_size);
    else {
        Newxz(ret_buffer, ret_size, char);
        SAVEFREEPV(ret_buffer);
    }
    SV ** perl_stack_frame = &ST(0);

    backend->cif(ret_buffer, (void **)perl_stack_frame);

    switch (backend->ret_opcode) {

lib/Affix.c  view on Meta::CPAN

                    SvREFCNT_dec(key_sv);
                }
                break;
            }
        }
    }
    if (affix->variadic_cache) {
        // Destroy all cached JIT trampolines
        hv_iterinit(affix->variadic_cache);
        HE * he;
        while ((he = hv_iternext(affix->variadic_cache))) {
            SV * val = HeVAL(he);
            infix_forward_t * t = INT2PTR(infix_forward_t *, SvIV(val));
            infix_forward_destroy(t);
        }
        SvREFCNT_dec(affix->variadic_cache);
    }
    if (affix->infix)
        infix_forward_destroy(affix->infix);
    if (affix->args_arena)
        infix_arena_destroy(affix->args_arena);
    if (affix->ret_arena)
        infix_arena_destroy(affix->ret_arena);
    if (affix->plan)
        safefree(affix->plan);
    if (affix->out_param_info)
        safefree(affix->out_param_info);
    if (affix->c_args)
        safefree(affix->c_args);
    if (affix->sig_str)
        safefree(affix->sig_str);
    if (affix->sym_name)
        safefree(affix->sym_name);
    if (affix->return_sv)
        SvREFCNT_dec(affix->return_sv);
    safefree(affix);
}

static int Affix_cv_free(pTHX_ SV * sv, MAGIC * mg) {
    Affix * affix = (Affix *)mg->mg_ptr;
    if (affix) {
#ifdef MULTIPLICITY
        if (affix->owner_perl != aTHX) {
            // warn("Affix_cv_free: %p (owner=%p, current=%p) SKIPPING", affix, (void*)affix->owner_perl, (void*)aTHX);
            return 0;
        }
#endif
        _affix_destroy(aTHX_ affix);
    }
    return 0;
}
static int Affix_cv_dup(pTHX_ MAGIC * mg, CLONE_PARAMS * param) {
    Affix * old_affix = (Affix *)mg->mg_ptr;
    Affix * new_affix;
    Newxz(new_affix, 1, Affix);

    //~ warn("Affix_cv_dup: old=%p -> new=%p", old_affix, new_affix);

    /* Basic copy of metadata */
    new_affix->num_args = old_affix->num_args;
    new_affix->plan_length = old_affix->plan_length;
    new_affix->total_args_size = old_affix->total_args_size;
    new_affix->ret_opcode = old_affix->ret_opcode;
    new_affix->num_out_params = old_affix->num_out_params;
    new_affix->num_fixed_args = old_affix->num_fixed_args;
    new_affix->ret_readonly = old_affix->ret_readonly;

    /* Reconstruct strings */
    if (old_affix->sig_str)
        new_affix->sig_str = savepv(old_affix->sig_str);
    if (old_affix->sym_name)
        new_affix->sym_name = savepv(old_affix->sym_name);
    new_affix->target_addr = old_affix->target_addr;

    new_affix->infix = nullptr;
    new_affix->args_arena = nullptr;
    new_affix->ret_arena = nullptr;
    new_affix->call_args_arena = nullptr;
    new_affix->call_ret_arena = nullptr;
    new_affix->c_args = nullptr;
    new_affix->plan = nullptr;
    new_affix->out_param_info = nullptr;
    new_affix->return_sv = nullptr;
    new_affix->variadic_cache = nullptr;  // Don't copy cache, let it rebuild

    mg->mg_ptr = (char *)new_affix;

#ifdef MULTIPLICITY
    new_affix->owner_perl = aTHX;
#endif

    // Update the new CV's fast access pointer
    CV * new_cv = (CV *)mg->mg_obj;
    CvXSUBANY(new_cv).any_ptr = (void *)new_affix;

    return 1;
}

// Helper to rebuild Affix data in the new thread
static void rebuild_affix_data(pTHX_ Affix * affix) {
    //~ warn("rebuild_affix_data: %p", affix);
    dMY_CXT;
    infix_arena_t * parse_arena = nullptr;
    infix_type * ret_type = nullptr;
    infix_function_argument * args = nullptr;
    size_t num_args = 0, num_fixed = 0;

    // Re-parse signature using THIS thread's registry
    infix_status status =
        infix_signature_parse(affix->sig_str, &parse_arena, &ret_type, &args, &num_args, &num_fixed, MY_CXT.registry);

    if (status != INFIX_SUCCESS) {
        if (parse_arena)
            infix_arena_destroy(parse_arena);
        croak("Affix failed to rebuild in new thread: signature parse error");
    }

    // Prepare JIT types (handle array decay)
    infix_type ** jit_arg_types = nullptr;
    if (num_args > 0) {
        jit_arg_types = safemalloc(sizeof(infix_type *) * num_args);
        for (size_t i = 0; i < num_args; ++i) {
            infix_type * t = args[i].type;
            if (t->category == INFIX_TYPE_ARRAY) {
                infix_type * ptr_type = nullptr;
                status = infix_type_create_pointer_to(parse_arena, &ptr_type, t->meta.array_info.element_type);
                if (status != INFIX_SUCCESS) {
                    if (parse_arena)
                        infix_arena_destroy(parse_arena);
                    croak("Affix failed to rebuild in new thread: type clone error");
                }
                jit_arg_types[i] = ptr_type;
            }
            else
                jit_arg_types[i] = t;
        }
    }

    // Create trampoline
    status =
        infix_forward_create_manual(&affix->infix, ret_type, jit_arg_types, num_args, num_fixed, affix->target_addr);

    if (jit_arg_types)
        safefree(jit_arg_types);

    if (status != INFIX_SUCCESS) {
        infix_arena_destroy(parse_arena);
        croak("Affix failed to rebuild trampoline in new thread");
    }

    affix->cif = infix_forward_get_code(affix->infix);
    affix->ret_type = infix_forward_get_return_type(affix->infix);
    affix->unwrapped_ret_type = _unwrap_pin_type(affix->ret_type);
    affix->ret_pull_handler = get_pull_handler(aTHX_ affix->ret_type);
    // affix->ret_opcode is already set from parent, but safe to assume it matches

    // Allocate arenas & SV
    affix->args_arena = infix_arena_create(4096);
    affix->ret_arena = infix_arena_create(1024);
    affix->return_sv = newSV(0);
    if (affix->num_args > 0)
        Newx(affix->c_args, affix->num_args, void *);

    affix->variadic_cache = newHV();

    // Rebuild plan
    Newxz(affix->plan, affix->plan_length + 1, Affix_Plan_Step);

    size_t out_param_count = 0;
    OutParamInfo * temp_out_info = safemalloc(sizeof(OutParamInfo) * (affix->num_args > 0 ? affix->num_args : 1));
    size_t current_offset = 0;

    for (size_t i = 0; i < affix->num_args; ++i) {
        // Deep copy types from parse_arena to persistent args_arena
        const infix_type * original_type = _copy_type_graph_to_arena(affix->args_arena, args[i].type);

        // Recalculate offsets (logic duplication from Affix_affix, but necessary)
        size_t alignment, size;
        if (original_type->category == INFIX_TYPE_ARRAY) {
            alignment = _Alignof(void *);
            size = sizeof(void *);
        }
        else {
            alignment = infix_type_get_alignment(original_type);
            size = infix_type_get_size(original_type);
        }
        if (alignment == 0)
            alignment = 1;

        current_offset = (current_offset + alignment - 1) & ~(alignment - 1);
        affix->plan[i].data.c_arg_offset = current_offset;
        current_offset += size;

        affix->plan[i].executor = get_plan_step_executor(original_type);
        affix->plan[i].opcode = get_opcode_for_type(aTHX_ original_type);
        affix->plan[i].data.type = original_type;
        affix->plan[i].data.index = i;

        // Re-detect out params
        if (original_type->category == INFIX_TYPE_POINTER) {
            const infix_type * pointee = original_type->meta.pointer_info.pointee_type;
            const char * pointee_name = infix_type_get_name(pointee);
            if (!pointee_name && pointee->category == INFIX_TYPE_NAMED_REFERENCE)
                pointee_name = pointee->meta.named_reference.name;
            bool is_sv_pointer = pointee_name && (strEQ(pointee_name, "SV") || strEQ(pointee_name, "@SV"));

            if (!is_sv_pointer && pointee->category != INFIX_TYPE_REVERSE_TRAMPOLINE &&
                pointee->category != INFIX_TYPE_VOID) {
                temp_out_info[out_param_count].perl_stack_index = i;
                temp_out_info[out_param_count].pointee_type = pointee;
                temp_out_info[out_param_count].writer = get_out_param_writer(pointee);
                out_param_count++;
            }
        }
        else if (original_type->category == INFIX_TYPE_ARRAY) {
            temp_out_info[out_param_count].perl_stack_index = i;
            temp_out_info[out_param_count].pointee_type = original_type;
            temp_out_info[out_param_count].writer = affix_array_writeback;
            out_param_count++;
        }
    }
    affix->plan[affix->num_args].opcode = OP_DONE;

    // Setup OUT params
    if (out_param_count > 0) {
        affix->out_param_info = safemalloc(sizeof(OutParamInfo) * out_param_count);
        memcpy(affix->out_param_info, temp_out_info, sizeof(OutParamInfo) * out_param_count);

lib/Affix.c  view on Meta::CPAN

    // Object init & trampoline generation
    Affix * affix;
    Newxz(affix, 1, Affix);
    affix->return_sv = newSV(0);
    affix->variadic_cache = newHV();

    bool is_variadic = (strstr(signature, ";") != nullptr);
    affix->sig_str = savepv(signature);
    if (rename_str)
        affix->sym_name = savepv(rename_str);
    affix->target_addr = symbol;
    if (lib_handle_for_symbol)
        affix->lib_handle = lib_handle_for_symbol;

    // Create Trampoline using the JIT-optimized types
    status = infix_forward_create_manual(&affix->infix, ret_type, jit_arg_types, num_args, num_fixed, symbol);

    if (jit_arg_types)
        safefree(jit_arg_types);

    if (status != INFIX_SUCCESS) {
        infix_error_details_t err = infix_get_last_error();
        warn("Failed to create trampoline: %s", err.message);
        _affix_destroy(aTHX_ affix);
        infix_arena_destroy(parse_arena);
        XSRETURN_UNDEF;
    }

    affix->cif = infix_forward_get_code(affix->infix);
    affix->num_args = num_args;
    affix->num_fixed_args = num_fixed;

    affix->ret_type = infix_forward_get_return_type(affix->infix);
    affix->unwrapped_ret_type = _unwrap_pin_type(affix->ret_type);
    affix->ret_pull_handler = get_pull_handler(aTHX_ affix->ret_type);
    affix->ret_opcode = get_ret_opcode_for_type(aTHX_ affix->ret_type);

    // Extract outer constness if specified for the return type via objects
    affix->ret_readonly = false;
    if (ret_sv && _is_const_obj(aTHX_ ret_sv))
        affix->ret_readonly = true;
    else if (sig_sv && _is_const_obj(aTHX_ sig_sv))
        affix->ret_readonly = true;

    if (affix->ret_pull_handler == nullptr) {
        _affix_destroy(aTHX_ affix);
        warn("Unsupported return type");
        infix_arena_destroy(parse_arena);
        XSRETURN_UNDEF;
    }

    if (affix->num_args > 0)
        Newx(affix->c_args, affix->num_args, void *);
    else
        affix->c_args = nullptr;

    affix->args_arena = infix_arena_create(4096);
    affix->ret_arena = infix_arena_create(1024);

    // Build execution plan
    affix->plan_length = affix->num_args;
    Newxz(affix->plan, affix->plan_length + 1, Affix_Plan_Step);

    size_t current_offset = 0;
    size_t out_param_count = 0;
    OutParamInfo * temp_out_info = safemalloc(sizeof(OutParamInfo) * (affix->num_args > 0 ? affix->num_args : 1));

    for (size_t i = 0; i < affix->num_args; ++i) {
        // Deep copy from temporary parse_arena to persistent args_arena.
        // We use the ORIGINAL types (args[i].type) so marshalling knows it's an Array.
        const infix_type * original_type = _copy_type_graph_to_arena(affix->args_arena, args[i].type);

        // Calculate offset based on JIT expectation (Array Decay -> Pointer size)
        size_t alignment, size;
        if (original_type->category == INFIX_TYPE_ARRAY) {
            alignment = _Alignof(void *);
            size = sizeof(void *);
        }
        else {
            alignment = infix_type_get_alignment(original_type);
            size = infix_type_get_size(original_type);
        }
        if (alignment == 0)
            alignment = 1;

        current_offset = (current_offset + alignment - 1) & ~(alignment - 1);
        affix->plan[i].data.c_arg_offset = current_offset;
        current_offset += size;

        affix->plan[i].executor = get_plan_step_executor(original_type);
        affix->plan[i].opcode = get_opcode_for_type(aTHX_ original_type);
        affix->plan[i].data.type = original_type;  // Now points to persistent memory
        affix->plan[i].data.index = i;

        if (original_type->category == INFIX_TYPE_POINTER) {
            const infix_type * pointee = original_type->meta.pointer_info.pointee_type;
            const char * pointee_name = infix_type_get_name(pointee);
            if (!pointee_name && pointee->category == INFIX_TYPE_NAMED_REFERENCE)
                pointee_name = pointee->meta.named_reference.name;
            // Skip writeback for Pointer[@SV] to avoid corrupting Perl variables with void return values
            // We assume SV* passed to C is owned by C for the duration and shouldn't be auto-updated
            // (since the SV* itself is the value, not a pointer to a value we want copied back).
            bool is_sv_pointer = pointee_name && (strEQ(pointee_name, "SV") || strEQ(pointee_name, "@SV"));

            if (!is_sv_pointer && pointee->category != INFIX_TYPE_REVERSE_TRAMPOLINE &&
                pointee->category != INFIX_TYPE_VOID) {
                temp_out_info[out_param_count].perl_stack_index = i;
                temp_out_info[out_param_count].pointee_type = pointee;
                temp_out_info[out_param_count].writer = get_out_param_writer(pointee);
                out_param_count++;
            }
        }
        else if (original_type->category == INFIX_TYPE_ARRAY) {
            // Register write-back handler for Arrays
            temp_out_info[out_param_count].perl_stack_index = i;
            temp_out_info[out_param_count].pointee_type = original_type;
            temp_out_info[out_param_count].writer = affix_array_writeback;
            out_param_count++;
        }
    }
    affix->plan[affix->num_args].opcode = OP_DONE;
    affix->total_args_size = current_offset;

lib/Affix.c  view on Meta::CPAN

    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);

    const char * msg = strerror(err_code);
    if (msg)
        sv_setpv(dual, msg);
    else
        sv_setpv(dual, "Unknown system error");

    SvIV_set(dual, (IV)err_code);
    SvIOK_on(dual);
#endif

    ST(0) = sv_2mortal(dual);
    XSRETURN(1);
}


static void * _resolve_writable_ptr(pTHX_ SV * sv) { return get_address_v2(aTHX_ sv); }
static const void * _resolve_readable_ptr(pTHX_ SV * sv) {
    void * ptr = get_address_v2(aTHX_ sv);
    if (ptr)
        return ptr;
    if (SvPOK(sv) && !SvROK(sv))
        return (const void *)SvPV_nolen(sv);
    return nullptr;
}

XS_INTERNAL(Affix_dump) {
    dVAR;
    dXSARGS;
    if (items != 2)
        croak_xs_usage(cv, "scalar, length_in_bytes");

    const void * ptr = _resolve_readable_ptr(aTHX_ ST(0));

    if (!ptr) {
        warn("scalar is not a valid pointer, memory address, or string");
        XSRETURN_EMPTY;
    }

    UV length = SvUV(ST(1));
    if (length == 0) {
        warn("Dump length cannot be zero");
        XSRETURN_EMPTY;
    }

    /* Extract Perl-level file and line info for the dump header */
    const char * file = "Unknown";
    int line = 0;
    if (LIKELY(PL_curcop)) {
        file = OutCopFILE(PL_curcop);
        line = CopLINE(PL_curcop);
    }

    /* Call the internal hex-dump utility */
    _DumpHex(aTHX_ ptr, (size_t)length, file, line);

    /* Return the original scalar as a pass-through */
    ST(0) = ST(0);
    XSRETURN(1);
}

XS_INTERNAL(Affix_raw) {
    dVAR;
    dXSARGS;
    if (items != 2)
        croak_xs_usage(cv, "scalar, length_in_bytes");

    const void * ptr = _resolve_readable_ptr(aTHX_ ST(0));

    if (!ptr) {
        warn("scalar is not a valid pointer, memory address, or string");
        XSRETURN_UNDEF;
    }

    UV length = SvUV(ST(1));
    if (length == 0) {
        ST(0) = sv_2mortal(newSVpvn("", 0));
        XSRETURN(1);
    }

    ST(0) = sv_2mortal(newSVpvn((const char *)ptr, length));
    XSRETURN(1);
}

XS_INTERNAL(Affix_snapshot) {
    dVAR;
    dXSARGS;
    if (items != 1)
        croak_xs_usage(cv, "pin");

    Affix_Pin_2_Point_Oh * pin = get_pin_v2(aTHX_ ST(0));
    if (!pin || !pin->type || !pin->ptr) {
        warn("Argument is not a pinned pointer");
        XSRETURN_UNDEF;
    }

    SV * ret_val = sv_newmortal();
    ptr2sv(aTHX_ nullptr, pin->ptr, ret_val, pin->type, pin->readonly);
    ST(0) = ret_val;
    XSRETURN(1);
}

XS_INTERNAL(Affix_memcpy) {
    dXSARGS;
    if (items != 3)
        croak_xs_usage(cv, "dest, src, n");
    void * dest = _resolve_writable_ptr(aTHX_ ST(0));
    if (!dest) {
        warn("dest must be a pinned pointer or address");
        XSRETURN_UNDEF;
    }
    const void * src = _resolve_readable_ptr(aTHX_ ST(1));
    if (!src) {
        warn("src must be a pinned pointer, address, or string");
        XSRETURN_UNDEF;
    }
    size_t n = (size_t)SvUV(ST(2));
    memcpy(dest, src, n);
    XSRETURN(1);
}

XS_INTERNAL(Affix_memmove) {
    dXSARGS;
    if (items != 3)
        croak_xs_usage(cv, "dest, src, n");
    void * dest = _resolve_writable_ptr(aTHX_ ST(0));
    if (!dest) {
        warn("dest must be a pinned pointer or address");
        XSRETURN_UNDEF;
    }
    const void * src = _resolve_readable_ptr(aTHX_ ST(1));
    if (!src) {
        warn("src must be a pinned pointer, address, or string");
        XSRETURN_UNDEF;
    }
    size_t n = (size_t)SvUV(ST(2));
    memmove(dest, src, n);
    XSRETURN(1);
}

XS_INTERNAL(Affix_memset) {



( run in 0.794 second using v1.01-cache-2.11-cpan-364913b4093 )