view release on metacpan or  search on metacpan

lib/Affix.h  view on Meta::CPAN

#pragma once

#ifndef DEBUG
#define DEBUG 0
#endif

// Disables the implicit 'pTHX_' context pointer argument, which is good practice for
// modern Perl XS code that uses the 'aTHX_' macro explicitly.
#define PERL_NO_GET_CONTEXT 1
#include <EXTERN.h>
#include <perl.h>
// Disables Perl's internal locking mechanisms for certain structures.
// This is often used when the XS module manages its own thread safety.
#define NO_XSLOCKS
#include <XSUB.h>
// Route infix's memory allocation through Perl's allocator. boot_Affix
// (lib/Affix.c) installs the static affix_infix_* callbacks (defined just above
// it, forwarding to Perl_safesysmalloc/Perl_safesyscalloc/Perl_safesysrealloc/
// Perl_safesysfree) via infix_set_allocator() once at load time, so ownership
// is consistent on both sides: every infix allocation goes through Perl's
// allocator and can be freed here with the same allocator, and Perl tracks all
// of it (leak detection and pool validation under PERL_TRACK_MEMPOOL).
//
// This is only safe because infix objects are never shared across interpreters:
// library handles, trampolines, arenas, and the type registry are all per-thread
// (see Affix_CLONE and Affix_cv_dup, which rebuild infix objects for the new
// interpreter rather than sharing them), so each allocation is created and
// destroyed on the same interpreter.
#include "common/infix_internals.h"
#include <infix/infix.h>

/**
 * @defgroup ThreadContext Thread-Safe Globals
 *
 * This structure defines the thread-local storage for our module. Under ithreads,
 * each Perl thread will get its own private instance of this struct.
 * @{
 */
typedef struct {
    /// A per-thread hash table to store loaded libraries.
    /// Maps library path -> LibRegistryEntry*.
    /// This prevents reloading the same .so/.dll and manages its lifecycle.
    HV * lib_registry;
    // A per-thread hash table to cache callback trampolines, preventing re-creation and leaks.
    // Maps the memory address of a Perl CV* to its corresponding Implicit_Callback_Magic* struct.
    HV * callback_registry;
    /// Type alias for an infix type registry. Represents a collection of named types.
    infix_registry_t * registry;
    /// // Smart enums
    HV * enum_registry;
    // Cache for coercion strings to avoid re-fetching from SV objects
    HV * coercion_cache;
    HV * stash_pointer;  // Cache for Affix::Pointer stash
} my_cxt_t;
START_MY_CXT;
/** @} */

// Helper macro to fetch a value from a hash if it exists, otherwise return a default.
#define hv_existsor(hv, key, _or) hv_exists(hv, key, strlen(key)) ? *hv_fetch(hv, key, strlen(key), 0) : _or
// Macros to handle passing the Perl interpreter context ('THX') explicitly,
// which is necessary for thread-safe code.
#ifdef MULTIPLICITY
#define storeTHX(var) (var) = aTHX
#define dTHXfield(var) tTHX var;
#else
#define storeTHX(var) dNOOP
#define dTHXfield(var)
#endif

// Forward-declare the primary structures.
typedef struct Affix Affix;
typedef struct Affix_Backend Affix_Backend;
typedef struct Affix_Plan_Step Affix_Plan_Step;
typedef struct OutParamInfo OutParamInfo;
/**
 * The single, homogeneous function pointer signature for all steps in the execution plan.
 * @param pTHX_ The Perl interpreter context.
 * @param affix The main Affix context object.
 * @param step A pointer to the current plan step, containing its pre-calculated data.
 * @param perl_stack_frame A pointer to the base of the Perl stack frame (&ST(0)).
 * @param c_args The array of pointers to be passed to the C function.
 * @param ret_buffer A pointer to the memory allocated for the C function's return value.
 */
typedef void (*Affix_Step_Executor)(pTHX_ Affix * affix,
                                    Affix_Plan_Step * step,
                                    SV ** perl_stack_frame,
                                    void * args_buffer,
                                    void ** c_args,
                                    void * ret_buffer);
/// Function pointer type for a "pull" operation: marshalling from C (void*) to Perl (SV).
typedef void (*Affix_Pull)(pTHX_ Affix *, SV *, const infix_type *, void *, bool);

/// Function pointer type for a "push" operation: marshalling from Perl (SV) to C (void*).
typedef void (*Affix_Push_Handler)(pTHX_ Affix * affix, SV *, void *);
/**
 * Function pointer for a specialized out-parameter write-back handler.
 * By pre-resolving this function, we avoid conditional logic in the hot path.
 * @param pTHX_ The Perl interpreter context.
 * @param affix The main Affix context object.
 * @param info A pointer to the OutParamInfo struct for this parameter.
 * @param perl_sv The referenced SV* to be modified (e.g., the scalar backing `$$foo`).
 * @param c_arg_ptr The pointer from the c_args array (e.g., `T**` for a `T*` out-param).
 */
typedef void (*Affix_Out_Param_Writer)(pTHX_ Affix * affix, const OutParamInfo * info, SV * perl_sv, void * c_arg_ptr);
/// Stores the pre-calculated information needed to write back an "out" parameter.
struct OutParamInfo {
    size_t perl_stack_index;          // Index of the SV* in the perl_stack_frame
    const infix_type * pointee_type;  // The type of the data pointed to (e.g., 'int' for 'int*')
    Affix_Out_Param_Writer writer;    // Pre-resolved handler to perform the write-back.
};
/// The data payload for a single step in the execution plan.
typedef struct {
    const infix_type * type;  // Type info for this step (arg or ret).
    size_t index;             // Index into perl_stack_frame for args, or c_args for out-params.
    Affix_Pull pull_handler;  // Pre-resolved pull handler for the return step.
    size_t c_arg_offset;      // Pre-calculated offset into the C arguments buffer.
} Affix_Step_Data;

typedef enum {
    // argument marshalling opcodes

lib/Affix.h  view on Meta::CPAN

    infix_library_t * lib_handle;  ///< Handle for library cleanup.
    const infix_type * ret_type;   ///< Cached return type info.
    Affix_Pull pull_handler;       ///< Pre-resolved handler for marshalling the return value.
    Affix_Opcode ret_opcode;       ///< Optimized return opcode.
    bool ret_readonly;             ///< Should the returned aggregate prevent perl-side mutations?
    size_t num_args;               ///< Cached number of arguments.

    char * sig_str;
    char * sym_name;
    void * target_addr;
    char * lib_path;
    dTHXfield(owner_perl)
};

// Trigger function for the experimental backend (shh!)
extern void Affix_trigger_backend(pTHX_ CV *);

// Main execution trigger
extern void Affix_trigger_stack(pTHX_ CV *);
extern void Affix_trigger_arena(pTHX_ CV *);
extern void Affix_trigger_variadic(pTHX_ CV *);

// Marshalling (Perl -> C)
void sv2ptr(pTHX_ Affix * affix, SV * perl_sv, void * c_ptr, const infix_type * type);
void push_struct(pTHX_ Affix * affix, const infix_type * type, SV * sv, void * p);
void push_array(pTHX_ Affix * affix, const infix_type * type, SV * sv, void * p);
void push_reverse_trampoline(pTHX_ Affix * affix, const infix_type * type, SV * sv, void * p);

// Marshalling (Perl <- C)
void ptr2sv(pTHX_ Affix *, void *, SV *, const infix_type *, bool);
void _populate_hv_from_c_struct(
    pTHX_ Affix * affix, HV * hv, const infix_type * type, void * p, bool live, SV * owner_sv, bool);

// Handler resolution
Affix_Step_Executor get_plan_step_executor(const infix_type * type);
Affix_Pull get_pull_handler(pTHX_ const infix_type * type);
Affix_Out_Param_Writer get_out_param_writer(const infix_type * type);

// Pin management

// Reverse trampolines
void _affix_callback_handler_entry(infix_context_t *, void *, void **);

// Misc.
void _export_function(pTHX_ HV *, const char *, const char *);

// XS Bootstrap
void boot_Affix(pTHX_ CV *);

// 'Portable' XS MACROS
#ifdef newXS_flags
#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
#else
#define newXSproto_portable(name, c_impl, file, proto) \
    (PL_Sv = (SV *)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV *)PL_Sv)
#endif
#define newXS_deffile(a, b) Perl_newXS_deffile(aTHX_ a, b)
#define export_function(package, what, tag) \
    _export_function(aTHX_ get_hv(form("%s::EXPORT_TAGS", package), GV_ADD), what, tag)

// Debugging Macros
#if DEBUG > 1
#define PING warn("Ping at %s line %d", __FILE__, __LINE__);
#else
#define PING
#endif
#define DumpHex(addr, len) _DumpHex(aTHX_ addr, len, __FILE__, __LINE__)
void _DumpHex(pTHX_ const void *, size_t, const char *, int);
#define DD(scalar) _DD(aTHX_ scalar, __FILE__, __LINE__)
void _DD(pTHX_ SV *, const char *, int);

#include <string.h>
#include <wchar.h>

void * _extract_pointer_value(pTHX_ SV * sv, MAGIC * ignore_mg);
void * get_address_v2(pTHX_ SV * sv);
bool is_pin_v2(pTHX_ SV * sv);
const infix_type * resolve_type(pTHX_ const infix_type * type);
SV * wrap_callable_pointer(pTHX_ void * addr, const infix_type * type);
void pull_pointer_as_callable(pTHX_ Affix *, SV *, const infix_type *, void *, bool);
const infix_type * _unwrap_pin_type(const infix_type * type);
void bind_placeholder(
    pTHX_ SV *, void *, const infix_type *, uint8_t, uint8_t, bool, SV *, infix_arena_t *, bool, bool);
void pull_pointer_as_pin(pTHX_ Affix *, SV *, const infix_type *, void *, bool);
IV sizeof_type(pTHX_ const char * name);
SV * cast(pTHX_ SV * in, const char * name);
SV * alloc_owned(pTHX_ UV size);
void free_owned(pTHX_ SV * rv);
int is_v2_vtable(MGVTBL * v);
int is_string_list_type(pTHX_ const infix_type * type);

extern MGVTBL vtbl_lazy_aggregate;
extern MGVTBL vtbl_array;

extern MGVTBL vtbl_sint8, vtbl_uint8, vtbl_sint16, vtbl_uint16, vtbl_sint32, vtbl_uint32, vtbl_sint64, vtbl_uint64,
    vtbl_float, vtbl_double, vtbl_float16, vtbl_bool, vtbl_sint128, vtbl_uint128, vtbl_void, vtbl_bitfield,
    vtbl_pointer, vtbl_array, string_vtable, wstring_vtable, vtbl_lazy_aggregate, vtbl_enum;
Affix_Pin_2_Point_Oh * get_pin_v2(pTHX_ SV * sv);
SV * bind_aggregate(pTHX_ void *, const infix_type *, SV *, bool);
SV * bind_aggregate_anon(pTHX_ void *, const infix_type *, SV * owner, infix_arena_t * a, bool);
void * get_address_v2(pTHX_ SV * sv);