Affix
view release on metacpan or search on metacpan
# C: union { int key_code; float pressure; };
typedef Event => Union[ key_code => Int, pressure => Float ];
```
### `Packed[ $align, $aggregate ]`
Forces specific byte alignment on a Struct or Union (e.g., `#pragma pack(1)`).
```perl
# C: #pragma pack(push, 1) ...
Packed[ 1, Struct[ flag => Char, data => Int ] ];
```
### `Array[ $type, $count ]`
A fixed-size C array. Maps to a Perl `ArrayRef`.
```perl
# C: double Vector3[3];
typedef Vector3 => Array[ Double, 3 ];
```
my $v1 = pack('f8', 1..8);
my $v2 = pack('f8', 10, 20, 30, 40, 50, 60, 70, 80);
my $packed_res = add_vecs( $v1, $v2 );
```
# MEMORY MANAGEMENT
When bridging Perl and C, handling raw memory safely is critical. Affix uses **Pins** to manage this boundary.
A Pin (an `Affix::Pointer` object) is a magical scalar reference that holds a C memory address, its associated type
information, and an ownership flag. If a Pin is "managed", Perl will automatically free the underlying memory when the
variable goes out of scope.
## Allocation & Deallocation
These functions allocate memory on the C heap. Memory allocated via these functions is **managed by Perl** by default.
### `malloc( $size )`
Allocates `$size` bytes of uninitialized memory. Returns a managed `Pointer[Void]` pin.
my $ptr = strdup("Affix Debugging");
dump($ptr, 16);
# Output:
# Dumping 16 bytes from 0x55E9A8A5 at script.pl line 42
# 000 41 66 66 69 78 20 44 65 62 75 67 67 69 6e 67 00 | Affix Debugging.
```
### `sv_dump( $scalar )`
Dumps Perl's internal interpreter structure (SV) for a given scalar to `STDOUT`. This exposes the raw flags, reference
counts, and memory layout of the Perl variable itself.
```perl
my $val = 42;
sv_dump($val);
# Exposes IV flags, memory addresses of the SV head, etc.
```
## Advanced Debugging
### `set_destruct_level( $level )`
Sets the internal `PL_perl_destruct_level` variable.
When testing XS/FFI code for memory leaks using tools like Valgrind or AddressSanitizer, you often want Perl to
meticulously clean up all global memory during its destruction phase (otherwise the leak checker will be flooded with
builder/Affix/Builder.pm view on Meta::CPAN
# Not in CORE
use Path::Tiny qw[path cwd];
use ExtUtils::Helpers 0.028 qw[make_executable split_like_shell detildefy];
# infix and Affix stuff
use Config qw[%Config];
field $force : param //= 0;
field $debug : param = 0;
field $libver;
field $cflags;
field $ldflags;
field $cppver = 'c++17'; # https://en.wikipedia.org/wiki/C%2B%2B20#Compiler_support
field $cver = 'c17'; # https://en.wikipedia.org/wiki/C17_(C_standard_revision)
field $make : param //= $Config{make};
#
field $action : param //= 'build';
field $meta : reader = CPAN::Meta->load_file('META.json');
# Params to Build script
field $install_base : param //= '';
field $installdirs : param //= '';
builder/Affix/Builder.pm view on Meta::CPAN
field $jobs : param //= 1;
field $destdir : param //= '';
field $prefix : param //= '';
#
ADJUST {
-e 'META.json' or die "No META information provided\n";
# Configure Flags
my $is_bsd = $^O =~ /bsd/i;
my $is_win = $^O =~ /MSWin32/i;
$cflags = $is_bsd ? '' : '-fPIC ';
$ldflags = $is_bsd ? '' : ' -flto=auto ';
if ( $debug > 0 ) {
$cflags
.= '-DDEBUG=' .
$debug .
' -g3 -gdwarf-4 ' .
' -Wno-deprecated -pipe ' .
' -Wall -Wextra -Wpedantic -Wvla -Wnull-dereference ' .
' -Wswitch-enum -Wduplicated-cond ' .
' -Wduplicated-branches';
$cflags .= ' -fvar-tracking-assignments' unless $Config{osname} eq 'darwin';
}
elsif ( !$is_win ) {
$cflags
.= ' -DNDEBUG -DBOOST_DISABLE_ASSERTS -Ofast -ftree-vectorize -ffast-math -fno-align-functions -fno-align-loops -fno-omit-frame-pointer -flto=auto';
}
# Threading support (Critical for shm_open/librt on Linux)
if ( !$is_win ) {
$cflags .= ' -pthread';
$ldflags .= ' -pthread';
}
}
method write_file( $filename, $content ) { path($filename)->spew_raw($content) or die "Could not open $filename: $!\n" }
method read_file ($filename) { path($filename)->slurp_utf8 or die "Could not open $filename: $!\n" }
method step_build() {
$self->step_affix;
my %modules = map { $_ => catfile( 'blib', $_ ) } find( qr/\.pm$/, 'lib' );
my %docs = map { $_ => catfile( 'blib', $_ ) } find( qr/\.pod$/, 'lib' );
my %scripts = map { $_ => catfile( 'blib', $_ ) } find( qr/(?:)/, 'script' );
builder/Affix/Builder.pm view on Meta::CPAN
# Detect Compiler settings using Perl's Config as base
my $cc_cmd = $Config{cc} || 'cc';
my $cc_type = 'gcc'; # Default flavor
if ( $cc_cmd =~ /cl(\.exe)?$/i ) { $cc_type = 'msvc'; }
elsif ( $cc_cmd =~ /clang/i ) { $cc_type = 'clang'; }
elsif ( $cc_cmd =~ /gcc/i ) { $cc_type = 'gcc'; }
elsif ( $cc_cmd =~ /egcc/i ) { $cc_type = 'gcc'; }
# Setup Flags
my ( $ar_cmd, @cflags, @arflags, $out_flag_cc, $out_flag_ar );
my @includes = map { ( $cc_type eq 'msvc' ? '/I' : '-I' ) . $_ } @include_dirs;
if ( $cc_type eq 'msvc' ) {
$ar_cmd = 'lib';
@cflags = ( '/nologo', '/c', '/std:c11', '/W3', '/GS', '/MD', '/O2', @includes );
@cflags = ( @cflags, '/DINFIX_DEBUG_ENABLED=1' ) if $verbose;
@arflags = ('/nologo');
$out_flag_cc = '/Fo';
$out_flag_ar = '/OUT:';
}
else {
# GCC / Clang
$ar_cmd = 'ar';
@cflags = ( '-std=c11', '-Wall', '-Wextra', '-O2', '-fPIC', @includes );
@cflags = ( @cflags, '-DINFIX_DEBUG_ENABLED=1' ) if $verbose;
@arflags = ('rcs');
$out_flag_cc = '-o';
$out_flag_ar = '';
# Pass pthread to compilation of static lib too (safe practice)
push @cflags, '-pthread' unless $^O eq 'MSWin32';
}
# Compile infix.c -> infix.o
my $obj_ext = $cc_type eq 'msvc' ? '.obj' : '.o';
my $obj_file = $build_lib->child( 'infix' . $obj_ext );
my @compile_cmd;
if ( $cc_type eq 'msvc' ) {
@compile_cmd = ( $cc_cmd, @cflags, $out_flag_cc . $obj_file, $src_file );
}
else {
@compile_cmd = ( $cc_cmd, @cflags, '-c', $src_file, $out_flag_cc, $obj_file );
}
warn " Compiling: @compile_cmd\n" if $verbose;
if ( system(@compile_cmd) != 0 ) {
die "Failed to compile infix.c";
}
# Archive infix.o -> libinfix.a
my @archive_cmd;
if ( $cc_type eq 'msvc' ) {
@archive_cmd = ( $ar_cmd, @arflags, $out_flag_ar . $lib_file, $obj_file );
}
else {
@archive_cmd = ( $ar_cmd, @arflags, $lib_file, $obj_file );
}
warn " Archiving: @archive_cmd\n" if $verbose;
if ( system(@archive_cmd) != 0 ) {
die "Failed to create infix static library";
}
warn "Infix library built: $lib_file\n" if $verbose;
return 0;
}
# Detects if linking against librt is required (common on Linux/BSD/Solaris for shm_open)
builder/Affix/Builder.pm view on Meta::CPAN
$builder->compile(
quiet => 0,
'C++' => $cxx,
source => $source->stringify,
defines => { VERSION => qq/"$version"/, XS_VERSION => qq/"$version"/ },
include_dirs => [
cwd->stringify, cwd->child('infix')->realpath->stringify,
cwd->child('infix')->child('include')->realpath->stringify, cwd->child('infix')->child('src')->realpath->stringify,
$source->dirname, $pre->child( $meta->name, 'include' )->stringify
],
extra_compiler_flags =>
( '-fPIC -std=' . ( $cxx ? $cppver : $cver ) . ' ' . $cflags . ( $debug ? ' -ggdb3 -g -Wall -Wextra -pedantic' : '' ) )
) :
$obj;
}
# Point to the Architecture-specific build lib
my $infix_build_lib = cwd->absolute->child('infix')->child( 'build_lib', $Config{archname} )->stringify;
# Check for -lrt requirement
my $lrt_flag = $self->check_for_lrt();
my $data = {
# Removed incorrect -lstdc++ logic. Added -lm for math.
# -pthread is already in $ldflags via ADJUST
extra_linker_flags => ( $ldflags . ' -L' . $infix_build_lib . ' -linfix ' . $lrt_flag . ' -lm' ),
objects => [@objs],
lib_file => $lib_file,
module_name => join '::',
@parts
};
return $builder->link(%$data);
}
};
1;
infix/include/infix/infix.h view on Meta::CPAN
typedef void (*infix_closure_handler_fn)(infix_context_t *, void *, void **);
/**
* @brief Enumerates the possible status codes returned by `infix` API functions.
*/
typedef enum {
INFIX_SUCCESS = 0, /**< The operation completed successfully. */
INFIX_ERROR_ALLOCATION_FAILED, /**< A memory allocation failed. Check `infix_get_last_error` for details. */
INFIX_ERROR_INVALID_ARGUMENT, /**< An invalid argument was provided. Check `infix_get_last_error`. */
INFIX_ERROR_UNSUPPORTED_ABI, /**< The current platform's ABI is not supported. */
INFIX_ERROR_LAYOUT_FAILED, /**< Failed to calculate a valid memory layout for a type. */
INFIX_ERROR_PROTECTION_FAILED, /**< Failed to set memory protection flags (e.g., for W^X). */
INFIX_ERROR_ /**< Placeholder to ensure enum is sized correctly. */
} infix_status;
/**
* @defgroup registry_api Named Type Registry
* @brief APIs for defining, storing, and reusing complex types by name.
* @ingroup high_level_api
* @{
*/
/**
* @brief Creates a new, empty named type registry.
infix/include/infix/infix.h view on Meta::CPAN
// General Codes (0-99)
INFIX_CODE_SUCCESS = 0, /**< No error occurred. */
INFIX_CODE_UNKNOWN, /**< An unspecified error occurred. */
INFIX_CODE_NULL_POINTER, /**< A required pointer argument was NULL. */
INFIX_CODE_MISSING_REGISTRY, /**< A type registry was required but not provided. */
INFIX_CODE_NATIVE_EXCEPTION, /**< A native exception (C++/SEH) was thrown during execution. */
// Allocation Codes (100-199)
INFIX_CODE_OUT_OF_MEMORY = 100, /**< A call to `malloc`, `calloc`, etc. failed. */
INFIX_CODE_EXECUTABLE_MEMORY_FAILURE, /**< Failed to allocate executable memory from the OS. */
INFIX_CODE_PROTECTION_FAILURE, /**< Failed to change memory protection flags (e.g., `mprotect`). */
INFIX_CODE_INVALID_ALIGNMENT, /**< An invalid alignment (0 or not power-of-two) was requested. */
// Parser Codes (200-299)
INFIX_CODE_UNEXPECTED_TOKEN = 200, /**< Encountered an unexpected character or token. */
INFIX_CODE_UNTERMINATED_AGGREGATE, /**< A struct, union, or array was not properly closed. */
INFIX_CODE_INVALID_KEYWORD, /**< An unknown or misspelled type keyword was used. */
INFIX_CODE_MISSING_RETURN_TYPE, /**< A function signature was missing the '->' and return type. */
INFIX_CODE_INTEGER_OVERFLOW, /**< An integer overflow occurred during layout calculation. */
INFIX_CODE_RECURSION_DEPTH_EXCEEDED, /**< A type definition was too deeply nested. */
INFIX_CODE_EMPTY_MEMBER_NAME, /**< A named member was declared with an empty name. */
infix/src/arch/aarch64/abi_arm64_emitters.c view on Meta::CPAN
}
}
// Arithmetic Emitters
/*
* @internal
* Generic helper for emitting ARM64 `ADD` or `SUB` with an immediate.
* It handles large immediates by falling back to a multi-instruction sequence that
* uses a scratch register (X15), since single instructions have a limited immediate range.
*/
INFIX_INTERNAL void emit_arm64_arith_imm(
code_buffer * buf, bool is_sub, bool is64, bool set_flags, arm64_gpr dest, arm64_gpr base, uint32_t imm) {
uint32_t instr = is_sub ? 0x51000000 : 0x11000000;
if (is64)
instr |= (1u << 31);
if (set_flags)
instr |= (1u << 29);
if (imm <= 0xFFF) // Check for un-shifted 12-bit immediate.
instr |= (imm & 0xFFF) << 10;
else if ((imm & 0xFFF) == 0 && (imm >> 12) <= 0xFFF && (imm >> 12) > 0) { // Check for shifted 12-bit immediate.
instr |= (1u << 22); // 'sh' bit selects LSL #12 shift.
instr |= ((imm >> 12) & 0xFFF) << 10;
}
else {
// Immediate is too large. Load it into a scratch register (X15) and do a register-based operation.
arm64_gpr scratch_reg = X15_REG;
emit_arm64_load_u64_immediate(buf, scratch_reg, imm);
uint32_t reg_instr = is_sub ? 0x4B000000 : 0x0B000000;
if (is64)
reg_instr |= (1u << 31);
if (set_flags)
reg_instr |= (1u << 29);
reg_instr |= (uint32_t)(scratch_reg & 0x1F) << 16;
reg_instr |= (uint32_t)(base & 0x1F) << 5;
reg_instr |= (uint32_t)(dest & 0x1F);
emit_int32(buf, reg_instr);
return;
}
instr |= (uint32_t)(base & 0x1F) << 5;
instr |= (uint32_t)(dest & 0x1F);
emit_int32(buf, instr);
}
/*
* Implementation for emit_arm64_add_imm.
* Opcode (64-bit): 10_0_10001_... (0x91...)
* Opcode (32-bit): 00_0_10001_... (0x11...)
*/
INFIX_INTERNAL void emit_arm64_add_imm(
code_buffer * buf, bool is64, bool set_flags, arm64_gpr dest, arm64_gpr base, uint32_t imm) {
emit_arm64_arith_imm(buf, false, is64, set_flags, dest, base, imm);
}
/*
* Implementation for emit_arm64_sub_imm.
* Opcode (64-bit): 11_0_10001_... (0xD1...)
* Opcode (32-bit): 01_0_10001_... (0x51...)
*/
INFIX_INTERNAL void emit_arm64_sub_imm(
code_buffer * buf, bool is64, bool set_flags, arm64_gpr dest, arm64_gpr base, uint32_t imm) {
emit_arm64_arith_imm(buf, true, is64, set_flags, dest, base, imm);
}
/**
* @internal
* @brief Emits `CMP <Xn|Wn>, <Xm|Wm>` instruction (alias for SUBS <Xd>, <Xn>, <Xm> with XZR destination).
* @details Opcode (64-bit): 11101011...
*/
INFIX_INTERNAL void emit_arm64_cmp_reg_reg(code_buffer * buf, bool is64, arm64_gpr reg1, arm64_gpr reg2) {
if (buf->error)
return;
// SUBS <Xd>, <Xn>, <Xm> { , <shift> #<amount> }
infix/src/arch/aarch64/abi_arm64_emitters.h view on Meta::CPAN
INFIX_INTERNAL void emit_arm64_ldr_vpr(code_buffer * buf, size_t size, arm64_vpr dest, arm64_gpr base, int32_t offset);
/** @internal @brief Emits `STR <Ht|St|Dt>, [<Xn|SP>, #imm]` to store a 16/32/64-bit FP value to memory. */
INFIX_INTERNAL void emit_arm64_str_vpr(code_buffer * buf, size_t size, arm64_vpr src, arm64_gpr base, int32_t offset);
/** @internal @brief Emits `LDR <Qt>, [<Xn|SP>, #imm]` for a 128-bit load into a SIMD&FP register. */
INFIX_INTERNAL void emit_arm64_ldr_q_imm(code_buffer * buf, arm64_vpr dest, arm64_gpr base, int32_t offset);
/** @internal @brief Emits `STR <Qt>, [<Xn|SP>, #imm]` for a 128-bit store from a SIMD&FP register. */
INFIX_INTERNAL void emit_arm64_str_q_imm(code_buffer * buf, arm64_vpr src, arm64_gpr base, int32_t offset);
// Arithmetic Emitters
/** @internal @brief Emits `ADD(S) <Xd|Wd>, <Xn|Wn>, #imm` to add an immediate to a GPR. */
INFIX_INTERNAL void emit_arm64_add_imm(
code_buffer * buf, bool is64, bool set_flags, arm64_gpr dest, arm64_gpr base, uint32_t imm);
/** @internal @brief Emits `SUB(S) <Xd|Wd>, <Xn|Wn>, #imm` to subtract an immediate from a GPR. */
INFIX_INTERNAL void emit_arm64_sub_imm(
code_buffer * buf, bool is64, bool set_flags, arm64_gpr dest, arm64_gpr base, uint32_t imm);
/** @internal @brief Emits `CMP <Xn|Wn>, <Xm|Wm>` to compare two registers. */
INFIX_INTERNAL void emit_arm64_cmp_reg_reg(code_buffer * buf, bool is64, arm64_gpr reg1, arm64_gpr reg2);
// Control Flow Emitters
/** @internal @brief Emits `BLR <Xn>` to branch with link to a register. */
INFIX_INTERNAL void emit_arm64_blr_reg(code_buffer * buf, arm64_gpr reg);
/** @internal @brief Emits `RET [Xn]` to return from a function (defaults to `RET X30`). */
INFIX_INTERNAL void emit_arm64_ret(code_buffer * buf, arm64_gpr reg);
/** @internal @brief Emits `B.<cond> #imm` for a conditional branch. */
INFIX_INTERNAL void emit_arm64_b_cond(code_buffer * buf, arm64_cond cond, int32_t offset);
/** @internal @brief Emits `CBNZ <Xt>, #imm` to compare and branch if register is not zero. */
infix/src/common/infix_config.h view on Meta::CPAN
#else
#error "Unsupported architecture. Only x86-64 and AArch64 are currently supported."
#endif
// Target ABI Logic Selection
/**
* @details This is the most critical section of the configuration. It determines
* which ABI implementation will be compiled and used by the JIT engine.
*
* It supports two modes:
* 1. **Forced ABI:** A user can define `INFIX_FORCE_ABI_*` (e.g., via a compiler
* flag like `-DINFIX_FORCE_ABI_SYSV_X64`) to override automatic detection.
* This is essential for cross-compilation, where the host compiler's macros
* would not reflect the target environment.
*
* 2. **Automatic Detection:** If no ABI is forced, it uses the `INFIX_ARCH_*` and
* `INFIX_OS_*` macros to deduce the correct ABI for the current build target.
*/
#if defined(INFIX_FORCE_ABI_WINDOWS_X64)
#define INFIX_ABI_WINDOWS_X64 1
#define INFIX_ABI_FORCED 1
#elif defined(INFIX_FORCE_ABI_SYSV_X64)
infix/src/common/infix_internals.h view on Meta::CPAN
* @brief Internal definition of a memory arena.
* @details An arena is a fast, region-based allocator. It pre-allocates a single
* block of memory and serves subsequent small allocation requests by simply
* "bumping" a pointer. All memory allocated from an arena is freed at once by
* destroying the arena itself, eliminating the need to track individual allocations.
*/
struct infix_arena_t {
char * buffer; /**< The backing memory buffer for the arena. */
size_t capacity; /**< The total size of the buffer. */
size_t current_offset; /**< The current high-water mark of allocation. */
bool error; /**< A flag set if any allocation fails, preventing subsequent allocations. */
struct infix_arena_t * next_block; /**< A pointer to the next block in the chain, if this one is full. */
size_t block_size; /**< The size of this specific block's buffer, for chained arenas. */
};
// Mutex Abstraction for Internal Synchronization
#if defined(INFIX_OS_WINDOWS)
#include <windows.h>
typedef SRWLOCK infix_mutex_t;
#define INFIX_MUTEX_INITIALIZER SRWLOCK_INIT
#define INFIX_MUTEX_LOCK(m) AcquireSRWLockExclusive(m)
#define INFIX_MUTEX_UNLOCK(m) ReleaseSRWLockExclusive(m)
infix/src/common/infix_internals.h view on Meta::CPAN
} parser_state;
/**
* @struct code_buffer
* @brief A dynamic buffer for staged machine code generation.
*/
typedef struct {
uint8_t * code; /**< A pointer to the code buffer, allocated from the arena. */
size_t capacity; /**< The current capacity of the buffer. */
size_t size; /**< The number of bytes currently written to the buffer. */
bool error; /**< A flag set on allocation failure. */
infix_arena_t * arena; /**< The temporary arena used for code generation. */
} code_buffer;
/**
* @struct infix_library_t
* @brief Internal definition of a dynamic library handle.
* @details This is a simple wrapper around the platform's native library handle to provide a consistent API.
*
* On Windows, GetModuleHandle(NULL) returns a special handle to the main executable that must NOT be freed with
* FreeLibrary. This flag tracks that state to ensure infix_library_close behaves correctly.
*/
struct infix_library_t {
void * handle; /**< The platform-native library handle (`HMODULE` on Windows, `void*` on POSIX). */
#if defined(INFIX_OS_WINDOWS)
bool is_pseudo_handle; /**< True if the handle is a "pseudo-handle" from GetModuleHandle. */
#endif
};
// ABI Abstraction Layer
/**
* @def INFIX_MAX_STACK_ALLOC
infix/src/core/arena.c view on Meta::CPAN
* @brief Allocates a block of memory from an arena with a specified alignment.
*
* This is a "bump" allocator. It calculates the next memory address that satisfies
* the requested alignment, checks if there is sufficient capacity in the arena's
* buffer, and if so, "bumps" the `current_offset` pointer and returns the address.
*
* This operation is extremely fast as it involves no system calls, only simple
* integer and pointer arithmetic.
*
* If an allocation fails (due to insufficient space or invalid arguments), the
* arena's `error` flag is set, a detailed error is reported, and all subsequent
* allocations from this arena will also fail.
*
* @param arena The arena to allocate from.
* @param size The number of bytes to allocate.
* @param alignment The required alignment for the allocation. Must be a power of two.
* @return A pointer to the allocated memory, or `nullptr` if the arena is out of
* memory, has its error flag set, or an invalid alignment is requested.
*/
INFIX_API c23_nodiscard void * infix_arena_alloc(infix_arena_t * arena, size_t size, size_t alignment) {
if (arena == nullptr)
return nullptr;
// Ensure alignment is power of 2
if (alignment == 0 || (alignment & (alignment - 1)) != 0) {
arena->error = true;
_infix_set_error(INFIX_CATEGORY_GENERAL, INFIX_CODE_INVALID_ALIGNMENT, 0);
return nullptr;
infix/src/core/error.c view on Meta::CPAN
return "A required pointer argument was NULL";
case INFIX_CODE_MISSING_REGISTRY:
return "A type registry was required but not provided";
case INFIX_CODE_NATIVE_EXCEPTION:
return "A native exception was thrown across the FFI boundary";
case INFIX_CODE_OUT_OF_MEMORY:
return "Out of memory";
case INFIX_CODE_EXECUTABLE_MEMORY_FAILURE:
return "Failed to allocate executable memory";
case INFIX_CODE_PROTECTION_FAILURE:
return "Failed to change memory protection flags";
case INFIX_CODE_INVALID_ALIGNMENT:
return "Invalid alignment requested (must be power of two > 0)";
case INFIX_CODE_UNEXPECTED_TOKEN:
return "Unexpected token or character";
case INFIX_CODE_UNTERMINATED_AGGREGATE:
return "Unterminated aggregate (missing '}', '>', ']', or ')')'";
case INFIX_CODE_INVALID_KEYWORD:
return "Invalid type keyword";
case INFIX_CODE_MISSING_RETURN_TYPE:
return "Function signature missing '->' or return type";
infix/src/core/type_registry.c view on Meta::CPAN
_infix_registry_entry_t * entry = src->buckets[i];
while (entry) {
// Create a new entry in the destination registry.
// _registry_insert handles allocating the entry and copying the name string.
_infix_registry_entry_t * new_entry = _registry_insert(dest, entry->name);
if (!new_entry) {
infix_registry_destroy(dest);
return nullptr;
}
// Copy flags
new_entry->is_forward_declaration = entry->is_forward_declaration;
// Deep copy the type graph into the new registry's arena
if (entry->type) {
new_entry->type = _copy_type_graph_to_arena(dest->arena, entry->type);
if (!new_entry->type) {
infix_registry_destroy(dest);
return nullptr;
}
}
infix/src/core/type_registry.c view on Meta::CPAN
goto cleanup;
}
// Update the entry. If a placeholder already exists (from forward decl), we MUST update it in-place
// to preserve pointers from other types that have already resolved to it.
if (entry->type) {
// Struct-copy the new definition into the existing placeholder memory.
*entry->type = *new_def;
// Restore the self-reference if the copy logic pointed the arena elsewhere.
entry->type->arena = registry->arena;
// The new definition is complete, so ensure the flag is cleared.
entry->type->is_incomplete = false;
}
else {
entry->type = new_def;
entry->type->is_incomplete = false;
}
// Ensure the name is attached and the flag is cleared.
entry->type->name = entry->name;
entry->is_forward_declaration = false;
}
infix_arena_destroy(parser_arena);
// Pass 3: Resolve and layout all the newly defined types.
for (size_t i = 0; i < num_defs_found; ++i) {
_infix_registry_entry_t * entry = defs_found[i].entry;
if (entry->type) {
infix/src/core/types.c view on Meta::CPAN
infix_struct_member * arena_members = nullptr;
infix_status status = _create_aggregate_setup(arena, &type, &arena_members, members, num_members);
if (status != INFIX_SUCCESS) {
*out_type = nullptr;
return status;
}
type->is_arena_allocated = true;
type->category = INFIX_TYPE_UNION;
type->meta.aggregate_info.members = arena_members;
type->meta.aggregate_info.num_members = num_members;
type->meta.aggregate_info.is_packed = false; // Unions don't use this flag currently
// A union's size is the size of its largest member, and its alignment is the
// alignment of its most-aligned member.
size_t max_size = 0;
size_t max_alignment = 1;
for (size_t i = 0; i < num_members; ++i) {
arena_members[i].offset = 0; // All union members have an offset of 0.
if (arena_members[i].type->size > max_size)
max_size = arena_members[i].type->size;
if (arena_members[i].type->alignment > max_alignment)
max_alignment = arena_members[i].type->alignment;
infix/src/core/types.c view on Meta::CPAN
dest_type->name = dest_name;
}
switch (src_type->category) {
case INFIX_TYPE_POINTER:
dest_type->meta.pointer_info.pointee_type =
_copy_type_graph_to_arena_recursive(dest_arena, src_type->meta.pointer_info.pointee_type, memo_head);
break;
case INFIX_TYPE_ARRAY:
dest_type->meta.array_info.element_type =
_copy_type_graph_to_arena_recursive(dest_arena, src_type->meta.array_info.element_type, memo_head);
// Explicitly copy the flexible flag to ensure it persists.
dest_type->meta.array_info.is_flexible = src_type->meta.array_info.is_flexible;
break;
case INFIX_TYPE_STRUCT:
case INFIX_TYPE_UNION:
if (src_type->meta.aggregate_info.num_members > 0) {
// Copy the members array itself.
size_t members_size = sizeof(infix_struct_member) * src_type->meta.aggregate_info.num_members;
dest_type->meta.aggregate_info.members =
infix_arena_alloc(dest_arena, members_size, _Alignof(infix_struct_member));
if (dest_type->meta.aggregate_info.members == nullptr)
return nullptr;
dest_type->meta.aggregate_info.is_packed = src_type->meta.aggregate_info.is_packed; // Copy packed flag
// Now, recurse for each member's type and copy its name.
for (size_t i = 0; i < src_type->meta.aggregate_info.num_members; ++i) {
dest_type->meta.aggregate_info.members[i] = src_type->meta.aggregate_info.members[i];
dest_type->meta.aggregate_info.members[i].type = _copy_type_graph_to_arena_recursive(
dest_arena, src_type->meta.aggregate_info.members[i].type, memo_head);
const char * src_name = src_type->meta.aggregate_info.members[i].name;
if (src_name) {
size_t name_len = strlen(src_name) + 1;
char * dest_name = infix_arena_alloc(dest_arena, name_len, 1);
if (!dest_name)
infix/src/jit/executor.c view on Meta::CPAN
#include <fcntl.h>
#include <pthread.h>
#include <sys/mman.h>
#include <sys/types.h>
#include <unistd.h>
#endif
#if defined(INFIX_OS_MACOS)
#include <dlfcn.h>
#include <libkern/OSCacheControl.h>
#endif
// Polyfills for mmap flags for maximum POSIX compatibility.
#if defined(INFIX_ENV_POSIX) && !defined(INFIX_OS_WINDOWS)
#if !defined(MAP_ANON) && defined(MAP_ANONYMOUS)
#define MAP_ANON MAP_ANONYMOUS
#endif
static pthread_mutex_t g_dwarf_mutex = PTHREAD_MUTEX_INITIALIZER;
#endif
#if defined(INFIX_OS_WINDOWS) && defined(INFIX_ARCH_X64)
// SEH Unwind Info Opcodes and Structures for JIT code on Windows x64.
// These are defined in winnt.h but we redefine them here for clarity and to ensure availability.
infix/src/jit/executor.c view on Meta::CPAN
_infix_set_system_error(
INFIX_CATEGORY_ALLOCATION, INFIX_CODE_EXECUTABLE_MEMORY_FAILURE, GetLastError(), nullptr);
return exec;
}
exec.rw_ptr = code;
exec.rx_ptr = code;
#elif defined(INFIX_OS_MACOS) || defined(INFIX_OS_ANDROID) || defined(INFIX_OS_OPENBSD) || defined(INFIX_OS_DRAGONFLY)
// Single-mapping POSIX platforms. Allocate as RW, later change to RX via mprotect.
void * code = MAP_FAILED;
#if defined(MAP_ANON)
int flags = MAP_PRIVATE | MAP_ANON;
#if defined(INFIX_OS_MACOS)
// On macOS, we perform a one-time check for JIT support.
static bool g_use_secure_jit_path = false;
static bool g_checked_jit_support = false;
if (!g_checked_jit_support) {
g_use_secure_jit_path = has_jit_entitlement();
INFIX_DEBUG_PRINTF("macOS JIT check: Entitlement found = %s. Using %s API.",
g_use_secure_jit_path ? "yes" : "no",
g_use_secure_jit_path ? "secure (MAP_JIT)" : "legacy (mprotect)");
g_checked_jit_support = true;
}
// If entitled, use the modern, more secure MAP_JIT flag.
if (g_use_secure_jit_path)
flags |= MAP_JIT;
#endif // INFIX_OS_MACOS
code = mmap(nullptr, size, PROT_READ | PROT_WRITE, flags, -1, 0);
#if defined(INFIX_OS_MACOS)
if (code != MAP_FAILED && g_use_secure_jit_path) {
// Switch thread to Write mode. enabled=0 means Write allowed.
g_macos_apis.pthread_jit_write_protect_np(0);
}
#endif
#endif // MAP_ANON
if (code == MAP_FAILED) { // Fallback for older systems without MAP_ANON
int fd = open("/dev/zero", O_RDWR);
if (fd != -1) {
infix/src/jit/trampoline.c view on Meta::CPAN
#else
// sysconf is the standard POSIX way to get system configuration values.
return sysconf(_SC_PAGESIZE);
#endif
}
/**
* @internal
* @brief The core implementation for creating a reverse trampoline (callback or closure).
*
* @details This function orchestrates the JIT compilation pipeline for reverse calls.
* It has a special `is_callback` flag that distinguishes between the two reverse
* trampoline models:
*
* - **Type-safe Callback (`is_callback = true`):** In this model, the user provides a
* standard C function pointer with a matching signature. This function internally
* creates a *forward* trampoline (`cached_forward_trampoline`) that is used by the
* universal C dispatcher to call the user's handler in a type-safe way.
*
* - **Generic Closure (`is_callback = false`):** The user provides a generic handler of
* type `infix_closure_handler_fn`. The universal dispatcher calls this handler
* directly, without needing a cached forward trampoline.
lib/Affix.c view on Meta::CPAN
static infix_direct_value_t affix_marshaller_uint(void * sv_raw) {
dTHX;
infix_direct_value_t val;
val.u64 = SvUV((SV *)sv_raw);
return val;
}
static infix_direct_value_t affix_marshaller_double(void * sv_raw) {
infix_direct_value_t val;
SV * sv = (SV *)sv_raw;
U32 flags = SvFLAGS(sv);
if (LIKELY(flags & SVf_NOK)) {
val.f64 = SvNVX(sv);
}
else if (flags & SVf_IOK) {
if (flags & SVf_IVisUV)
val.f64 = (double)SvUVX(sv);
else
val.f64 = (double)SvIVX(sv);
}
else {
dTHX;
val.f64 = (double)SvNV(sv);
}
return val;
}
lib/Affix.c view on Meta::CPAN
PERL_UNUSED_VAR(ret_buffer); \
SV * sv = perl_stack_frame[step->data.index]; \
void * c_arg_ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(c_type *)c_arg_ptr = (c_type)sv_accessor(sv); \
c_args[step->data.index] = c_arg_ptr; \
}
#define DEFINE_IV_PUSH_HANDLER(name, c_type) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
U32 flags = SvFLAGS(sv); \
if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
*(c_type *)c_ptr = (c_type)SvUVX(sv); \
else \
*(c_type *)c_ptr = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
*(c_type *)c_ptr = (c_type)SvIV(sv); \
} \
return; \
}
#define DEFINE_UV_PUSH_HANDLER(name, c_type) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
U32 flags = SvFLAGS(sv); \
if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
*(c_type *)c_ptr = (c_type)SvUVX(sv); \
else \
*(c_type *)c_ptr = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
*(c_type *)c_ptr = (c_type)SvUV(sv); \
} \
return; \
}
#define DEFINE_NV_PUSH_HANDLER(name, c_type) \
static void push_handler_##name(pTHX_ Affix * affix, SV * sv, void * c_ptr) { \
PERL_UNUSED_VAR(affix); \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(c_type *)c_ptr = SvNVX(sv); \
else if (flags & SVf_IOK) { \
if (flags & SVf_IVisUV) \
*(c_type *)c_ptr = (c_type)SvUVX(sv); \
else \
*(c_type *)c_ptr = (c_type)SvIVX(sv); \
} \
else { \
dTHX; \
*(c_type *)c_ptr = (c_type)SvNV(sv); \
} \
return; \
}
lib/Affix.c view on Meta::CPAN
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
*(infix_float16_t *)ptr = float_to_half((float)SvNV(sv)); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_FLOAT: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(float *)ptr = (float)SvNVX(sv); \
else if (flags & SVf_IOK) \
*(float *)ptr = (float)((flags & SVf_IVisUV) ? SvUVX(sv) : SvIVX(sv)); \
else \
*(float *)ptr = (float)SvNV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_DOUBLE: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(double *)ptr = SvNVX(sv); \
else if (flags & SVf_IOK) \
*(double *)ptr = (double)((flags & SVf_IVisUV) ? SvUVX(sv) : SvIVX(sv)); \
else \
*(double *)ptr = (double)SvNV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_LONGDOUBLE: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
U32 flags = SvFLAGS(sv); \
if (LIKELY(flags & SVf_NOK)) \
*(long double *)ptr = SvNVX(sv); \
else if (flags & SVf_IOK) \
*(long double *)ptr = (long double)((flags & SVf_IVisUV) ? SvUVX(sv) : SvIVX(sv)); \
else \
*(long double *)ptr = (long double)SvNV(sv); \
c_args[step->data.index] = ptr; \
DISPATCH(); \
} \
CASE_OP_PUSH_PTR_CHAR: \
{ \
SV * sv = ST(step->data.index); \
void * ptr = (char *)args_buffer + step->data.c_arg_offset; \
c_args[step->data.index] = ptr; \
lib/Affix.c view on Meta::CPAN
// Look up the integer value in the hash
// Keys in Perl hashes are strings, so we format the IV.
char key[64];
snprintf(key, 64, "%" IVdf, val);
SV ** name_sv = hv_fetch(enum_map, key, strlen(key), 0);
if (name_sv && SvPOK(*name_sv)) {
// Set the String Value (creating Dualvar)
// sv_setpv overwrites the IV. We need to set PV while keeping IOK.
const char * name_str = SvPV_nolen(*name_sv);
sv_setpv(sv, name_str); // Sets PV, clears IV? No, usually clears flags, right?
// Force dualvar state by manually reinstating the IV
SvIV_set(sv, val);
SvIOK_on(sv); // It is valid Integer
// SvPOK is on from sv_setpv
}
}
}
}
}
lib/Affix.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 callback argument type");
SV * arg_sv = newSV(0);
puller(aTHX_ nullptr, arg_sv, type, args[i]);
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) {
lib/Affix.h view on Meta::CPAN
// 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
lib/Affix.pod view on Meta::CPAN
A C union, mapped to a Perl C<HashRef> with exactly one key.
# C: union { int key_code; float pressure; };
typedef Event => Union[ key_code => Int, pressure => Float ];
=head3 C<Packed[ $align, $aggregate ]>
Forces specific byte alignment on a Struct or Union (e.g., C<#pragma pack(1)>).
# C: #pragma pack(push, 1) ...
Packed[ 1, Struct[ flag => Char, data => Int ] ];
=head3 C<Array[ $type, $count ]>
A fixed-size C array. Maps to a Perl C<ArrayRef>.
# C: double Vector3[3];
typedef Vector3 => Array[ Double, 3 ];
=head3 Bitfields
lib/Affix.pod view on Meta::CPAN
affix $lib, 'add_vecs', [ M256, M256 ] => M256;
my $v1 = pack('f8', 1..8);
my $v2 = pack('f8', 10, 20, 30, 40, 50, 60, 70, 80);
my $packed_res = add_vecs( $v1, $v2 );
=head1 MEMORY MANAGEMENT
When bridging Perl and C, handling raw memory safely is critical. Affix uses B<Pins> to manage this boundary.
A Pin (an C<Affix::Pointer> object) is a magical scalar reference that holds a C memory address, its associated type
information, and an ownership flag. If a Pin is "managed", Perl will automatically free the underlying memory when the
variable goes out of scope.
=head2 Allocation & Deallocation
These functions allocate memory on the C heap. Memory allocated via these functions is B<managed by Perl> by default.
=head3 C<malloc( $size )>
Allocates C<$size> bytes of uninitialized memory. Returns a managed C<Pointer[Void]> pin.
lib/Affix.pod view on Meta::CPAN
my $ptr = strdup("Affix Debugging");
dump($ptr, 16);
# Output:
# Dumping 16 bytes from 0x55E9A8A5 at script.pl line 42
# 000 41 66 66 69 78 20 44 65 62 75 67 67 69 6e 67 00 | Affix Debugging.
=head3 C<sv_dump( $scalar )>
Dumps Perl's internal interpreter structure (SV) for a given scalar to C<STDOUT>. This exposes the raw flags, reference
counts, and memory layout of the Perl variable itself.
my $val = 42;
sv_dump($val);
# Exposes IV flags, memory addresses of the SV head, etc.
=head2 Advanced Debugging
=head3 C<set_destruct_level( $level )>
Sets the internal C<PL_perl_destruct_level> variable.
When testing XS/FFI code for memory leaks using tools like Valgrind or AddressSanitizer, you often want Perl to
meticulously clean up all global memory during its destruction phase (otherwise the leak checker will be flooded with
false-positive "leaks" that are actually just memory Perl intentionally leaves to the OS to reclaim).
lib/Affix/Build.pm view on Meta::CPAN
class Affix::Build {
# Public Parameters
field $os : param : reader //= $^O;
field $clean : param : reader //= 0;
field $build_dir : param : reader //= Path::Tiny->tempdir( CLEANUP => $clean );
field $name : param : reader //= 'affix_lib';
field $debug : param : reader //= 0;
field $version : param : reader //= ();
# Global flags applied to all compilations of that type
# cflags, cxxflags, ldflags, rustflags, etc.
field $flags : param : reader //= {};
# Internal State
field @sources;
field $libname : reader;
field $linker : reader;
# Cached Flag Arrays
field @cflags;
field @cxxflags;
field @ldflags;
field $_lib;
#
ADJUST {
my $so_ext = $Config{so} // 'so';
$build_dir = Path::Tiny->new($build_dir) unless builtin::blessed $build_dir;
# Standard convention: Windows DLLs don't need 'lib' prefix, Unix SOs do.
my $prefix = ( $os eq 'MSWin32' || $name =~ /^lib/ ) ? '' : 'lib';
my $suffix = defined $version ? ".$version" : '';
$libname = $build_dir->child("$prefix$name.$so_ext$suffix")->absolute;
# We prefer C++ drivers (g++, clang++) to handle standard libraries for mixed code (C+Rust, C+C++)
$linker = $self->_can_run(qw[g++ clang++ c++ icpx]) || $self->_can_run(qw[cc gcc clang icx cl]) || 'c++';
# Parse global flags...
@cflags = map { chomp; $_ } grep { defined && length } Text::ParseWords::parse_line( q/ /, 1, $flags->{cflags} // '' );
@cxxflags = map { chomp; $_ } grep { defined && length } Text::ParseWords::parse_line( q/ /, 1, $flags->{cxxflags} // '' );
@ldflags = map { chomp; $_ } grep { defined && length } Text::ParseWords::parse_line( q/ /, 1, $flags->{ldflags} // '' );
}
method add ( $input, %args ) {
$_lib = (); # Reset cached library handle
my ( $path, $lang );
if ( ref $input eq 'SCALAR' ) { # Inline source code
$args{lang} // croak q[Parameter 'lang' (extension) is required for inline source];
$lang = lc $args{lang};
# Generate a unique filename in the build dir
lib/Affix/Build.pm view on Meta::CPAN
$path = $build_dir->child($fname);
$path->spew_utf8($$input);
}
else { # File path
$path = Path::Tiny::path($input)->absolute;
croak "File not found: $path" unless $path->exists;
($lang) = $path =~ /\.([^.]+)$/;
$lang = lc( $lang // '' );
}
# Handle local flags
my $local_flags = $args{flags} // [];
$local_flags = [ split ' ', $local_flags ] unless builtin::reftype $local_flags eq 'ARRAY';
push @sources, { path => $path, lang => $lang, flags => $local_flags };
}
method compile_and_link () {
croak "No sources added" unless @sources;
# Check if we are mixing languages
my %langs = map { $_->{lang} => 1 } @sources;
if ( ( scalar keys %langs ) > 1 ) {
return $self->_strategy_polyglot();
}
lib/Affix/Build.pm view on Meta::CPAN
}
else {
push @cmd, $p;
}
}
my %seen;
for my $l (@libs) {
next if $seen{$l}++;
push @cmd, "-l$l";
}
push @cmd, @ldflags;
$self->_run(@cmd);
return $libname;
}
# Helper to map extensions to method names
method _resolve_handler ($l) {
# Normalize
if ( $l =~ /^(cpp|cxx|cc|c\+\+)$/ ) { return '_build_cpp'; }
elsif ( $l =~ /^(f|f90|f95|for|fortran)$/ ) { return '_build_fortran'; }
lib/Affix/Build.pm view on Meta::CPAN
my $abs = File::Spec->catfile( $dir, $c );
return $abs if MM->maybe_command($abs);
}
}
return undef;
}
method _base ($file) { return $file->basename(qr/\.[^.]+$/); }
#
method _build_c ( $src, $out, $mode ) {
my $file = $src->{path};
my @local = @{ $src->{flags} };
my $cc = $Config{cc} // 'cc';
if ( $mode eq 'dynamic' ) {
# Combine Global CFLAGS + Local Flags + Global LDFLAGS
my @cmd = ( $cc, '-shared', @cflags, @local, "$file", '-o', "$out", @ldflags );
push @cmd, '-fPIC' unless $os eq 'MSWin32';
$self->_run(@cmd);
return $out;
}
else {
my $obj = $build_dir->child( $self->_base($file) . $Config{_o} );
# Combine Global CFLAGS + Local Flags
my @cmd = ( $cc, '-c', @cflags, @local, "$file", '-o', "$obj" );
push @cmd, '-fPIC' unless $os eq 'MSWin32';
$self->_run(@cmd);
return { file => $obj };
}
}
method _build_cpp ( $src, $out, $mode ) {
my $file = $src->{path};
my @local = @{ $src->{flags} };
my $cxx = ( $Config{cc} =~ /gcc/ ) ? 'g++' : ( ( $Config{cc} =~ /clang/ ) ? 'clang++' : 'c++' );
if ( $mode eq 'dynamic' ) {
my @cmd = ( $cxx, '-shared', @cxxflags, @local, "$file", '-o', "$out", @ldflags );
push @cmd, '-fPIC' unless $os eq 'MSWin32';
$self->_run(@cmd);
return $out;
}
else {
my $obj = $build_dir->child( $self->_base($file) . $Config{_o} );
my @cmd = ( $cxx, '-c', @cxxflags, @local, "$file", '-o', "$obj" );
push @cmd, '-fPIC' unless $os eq 'MSWin32';
$self->_run(@cmd);
return { file => $obj };
}
}
#~ https://fasterthanli.me/series/making-our-own-executable-packer/part-5
#~ https://stackoverflow.com/questions/71704813/writing-and-linking-shared-libraries-in-assembly-32-bit
#~ https://github.com/therealdreg/nasm_linux_x86_64_pure_sharedlib
method _build_asm ( $src, $out, $mode ) {
my $file = $src->{path};
my @local = @{ $src->{flags} };
my $obj = $build_dir->child( $self->_base($file) . $Config{_o} );
# Detect Assembler Type: .asm (Intel/NASM) vs .s (AT&T/CC)
my $is_nasm = ( $file =~ /\.asm$/i );
my $compiled = 0;
if ($is_nasm) { # .asm = Intel syntax = NASM
my $nasm = $self->_can_run('nasm') // croak "NASM not found";
my $fmt = $os eq 'MSWin32' ? 'win64' : ( $os eq 'darwin' ? 'macho64' : 'elf64' );
$self->_run( $nasm, '-f', $fmt, @local, "$file", '-o', "$obj" );
$compiled = 1;
lib/Affix/Build.pm view on Meta::CPAN
my $cc = $Config{cc};
if ( $cc && $self->_can_run($cc) ) {
my @cmd = ( $cc, '-c', @local, "$file", '-o', "$obj" );
push @cmd, '-fPIC' unless $os eq 'MSWin32';
$self->_run(@cmd);
$compiled = 1;
}
}
croak 'Assembly failed' unless $compiled && -e "$obj";
if ( $mode eq 'dynamic' ) {
my @cmd = ( $linker, '-shared', "$obj", '-o', "$out", @ldflags );
push @cmd, '-fPIC' unless $os eq 'MSWin32';
if ( $os eq 'MSWin32' && $linker =~ /gcc|g\+\+/ ) {
push @cmd, '-Wl,--export-all-symbols';
}
$self->_run(@cmd);
return $out;
}
return { file => $obj };
}
#~ https://blog.asleson.org/2021/02/23/how-to-writing-a-c-shared-library-in-rust/
method _build_rust ( $src, $out, $mode ) {
my $file = $src->{path};
my @local = @{ $src->{flags} };
my $rc = $self->_can_run('rustc') // croak "Rustc not found";
if ( $mode eq 'dynamic' ) {
$self->_run( $rc, '--crate-type', 'cdylib', @local, '-o', "$out", "$file" );
return $out;
}
else {
my $lib = $build_dir->child( $self->_base($file) . $Config{_a} );
my @cmd = ( $rc, '--crate-type=staticlib', '--emit=link', '-C', 'panic=abort', @local, "$file", '-o', "$lib" );
# Force GNU target on MinGW to ensure compatibility with Perl's linker
lib/Affix/Build.pm view on Meta::CPAN
$self->_run(@cmd);
my @deps = $os eq 'MSWin32' ? qw(ws2_32 userenv bcrypt advapi32 ntdll) : qw(dl pthread m);
return { file => $lib, libs => \@deps };
}
}
#~ https://medium.com/@walkert/fun-building-shared-libraries-in-go-639500a6a669
#~ https://github.com/vladimirvivien/go-cshared-examples
method _build_go ( $src, $out, $mode ) {
my $file = $src->{path};
my @local = @{ $src->{flags} }; # passed to go build args
# MinGW GCC 8.3.0 had known issues guaranteeing the 16-byte stack alignment required by the
# Go runtime (and SSE/AVX instructions) on Windows x64. If Perl calls your library with a
# 8-byte aligned stack (which was common in older GCC optimization flags), Go will segfault
# immediately when it tries to access the stack.
push @local, q[-ldflags "-extldflags '-static -static-libgcc -static-libstdc++'"] if $^O eq 'MSWin32';
if ( $mode eq 'dynamic' ) {
$self->_run( 'go', 'build', '-buildmode=c-shared', @local, '-o', "$out", "$file" );
return $out;
}
else {
my $lib = $build_dir->child( $self->_base($file) . $Config{_a} );
$self->_run( 'go', 'build', '-buildmode=c-archive', @local, '-o', "$lib", "$file" );
return { file => $lib, libs => ['pthread'] };
}
}
#~ https://odin-lang.org/news/calling-odin-from-python/
#~ https://odin-lang.org/docs/install/#release-requirements--notes
method _build_odin ( $src, $out, $mode ) {
my $file = $src->{path};
my @local = @{ $src->{flags} };
my $odin = $self->_can_run('odin') // croak "Odin not found";
if ( $mode eq 'dynamic' ) {
$self->_run( $odin, 'build', "$file", '-file', '-build-mode:dll', @local, "-out:$out" );
return $out;
}
else {
my $obj = $build_dir->child( $self->_base($file) . $Config{_o} );
my @cmd = ( $odin, 'build', "$file", '-file', '-build-mode:obj', @local, "-out:$obj" );
push @cmd, '-reloc-mode:pic' unless $os eq 'MSWin32';
$self->_run(@cmd);
lib/Affix/Build.pm view on Meta::CPAN
<PublishAot>true</PublishAot>
<NativeLib>$lib_type</NativeLib>
<SelfContained>true</SelfContained>
</PropertyGroup>
$items
</Project>
XML
my $out_dir = $proj_dir->child('out');
my $rid = $os eq 'MSWin32' ? 'win-x64' : 'linux-x64';
# Local flags? Dotnet CLI args are tricky, assuming they aremsbuild props?
# Ignoring for now to keep it safe, or pass as raw args if user knows what they do.
my @local = @{ $src->{flags} };
$self->_run( "$dotnet", 'publish', "$proj", '-r', $rid, '-o', "$out_dir", @local );
if ( $mode eq 'dynamic' ) {
my $dll_ext = $Config{so};
$dll_ext = ".$dll_ext" unless $dll_ext =~ /^\./;
my ($artifact) = grep {/\Q$dll_ext\E$/} $out_dir->children;
croak "Dotnet build failed" unless $artifact;
Path::Tiny::path($artifact)->move($out);
return $out;
}
else {
lib/Affix/Build.pm view on Meta::CPAN
my ($artifact) = grep {/\Q$lib_ext\E$/} $out_dir->children;
croak "Dotnet build failed" unless $artifact;
return { file => Path::Tiny::path($artifact) };
}
}
#~ https://ziglang.org/documentation/0.13.0/#Exporting-a-C-Library
#~ zig build-lib mathtest.zig -dynamic
method _build_zig ( $src, $out, $mode ) {
my $file = $src->{path};
my @local = @{ $src->{flags} };
my $zig = $self->_can_run('zig') // croak "Zig not found";
if ( $mode eq 'dynamic' ) {
$self->_run( $zig, 'build-lib', '-dynamic', @local, "$file", "-femit-bin=$out" );
return $out;
}
else {
my $lib = $build_dir->child( $self->_base($file) . $Config{_a} );
$self->_run( $zig, 'build-lib', '-static', @local, "$file", "-femit-bin=$lib" );
return { file => $lib, libs => ( $os eq 'MSWin32' ? ['ntdll'] : [] ) };
}
}
method _build_fortran ( $src, $out, $mode ) {
my $file = $src->{path};
my @local = @{ $src->{flags} };
my $fc = $self->_can_run(qw[gfortran ifx ifort]) // croak "No Fortran compiler";
if ( $mode eq 'dynamic' ) {
my @cmd = ( $fc, '-shared', @local, "$file", '-o', "$out", @ldflags );
push @cmd, '-fPIC' unless $os eq 'MSWin32';
$self->_run(@cmd);
return $out;
}
else {
my $obj = $build_dir->child( $self->_base($file) . $Config{_o} );
my @cmd = ( $fc, '-c', @local, "$file", '-o', "$obj" );
push @cmd, '-fPIC' unless $os eq 'MSWin32';
$self->_run(@cmd);
return { file => $obj, libs => ( $os eq 'MSWin32' ? [] : ['gfortran'] ) };
lib/Affix/Build.pm view on Meta::CPAN
return { file => $obj };
}
}
#~ https://github.com/crystal-lang/crystal/issues/921#issuecomment-2413541412
method _build_crystal ( $src, $out, $mode ) {
my $file = $src->{path};
my $cr = $self->_can_run('crystal') // croak "Crystal not found";
if ( $mode eq 'dynamic' ) {
# Experimental: Attempt to pass linker flags
# Crystal doesn't have a native 'build shared' flag easily exposed
# It prefers static binaries.
$self->_run( $cr, 'build', "$file", '--link-flags', '-shared', '-o', "$out" );
return $out;
}
else {
my $obj = $build_dir->child( $self->_base($file) . $Config{_o} );
my @cmd = ( $cr, 'build', '--emit', 'obj', "$file", '-o', "$obj" );
push @cmd, '--link-flags', '-fPIC' unless $os eq 'MSWin32';
$self->_run(@cmd);
return { file => $obj, libs => [ 'pcre', 'gc' ] };
}
}
#~ https://futhark.readthedocs.io/en/stable/usage.html
method _build_futhark ( $src, $out, $mode ) {
my $file = $src->{path};
my $fut = $self->_can_run('futhark') // croak "Futhark not found";
lib/Affix/Build.pod view on Meta::CPAN
$rust->add( \<<~'RUST', lang => 'rust' );
#[no_mangle]
pub extern "C" fn add(a: i32, b: i32) -> i32 { a + b }
RUST
my $rust_dll = $rust->link();
# Example 2: Polyglot (C and Go)
my $mix = Affix::Build->new(
name => 'hybrid_lib',
flags => { cflags => '-O3', ldflags => '-L/opt/lib' },
debug => 1
);
# Add file with per-file compiler overrides
$mix->add('src/wrapper.c', flags => '-DDEBUG');
$mix->add('src/core.go');
my $poly_dll = $mix->link();
=head1 DESCRIPTION
C<Affix::Build> is a cross-platform compilation utility designed to generate shared libraries (C<.dll>, C<.so>,
C<.dylib>) from source code in over 20 different programming languages.
While originally developed to compile test fixtures for the Affix suite, it has evolved into a robust tool for creating
polyglot extensions. It abstracts away the complexity of invoking various compilers, normalizing object file
extensions, handling platform-specific linker flags (such as MinGW vs. MSVC on Windows), and ensuring that language
runtimes (like the Go GC or .NET Runtime) are correctly initialized.
It serves as a powerful, polyglot alternative to C<Inline::*> modules—allowing you to write native code in your
language of choice and instantly bind to it from Perl using L<Affix>.
=head2 Build Strategies
The builder automatically selects the optimal strategy based on the input sources:
=over
lib/Affix/Build.pod view on Meta::CPAN
=item * B<C<name>>: The base name of the resulting library (default: C<'affix_lib'>). The compiler will automatically append the OS-specific extension (C<.dll> on Windows, C<.dylib> on macOS, C<.so> on Linux).
=item * B<C<version>>: Optional version string to append to the library name.
=item * B<C<build_dir>>: The directory where intermediate artifacts and the final library will be written. If not provided, a temporary directory is created via L<Path::Tiny>.
=item * B<C<clean>>: If true, the generated C<build_dir> and all its contents will be deleted when the object is destroyed (default: C<0>).
=item * B<C<debug>>: If true, the exact system commands executed by the compiler will be printed to C<STDERR> (default: C<0>).
=item * B<C<flags>>: A HashRef of global flags applied across all files. Keys can be C<cflags>, C<cxxflags>, and C<ldflags>.
=item * B<C<os>>: Override the detected operating system (defaults to C<$^O>).
=back
=head1 METHODS
=head2 C<add( $input, %args )>
Adds a source file to the build manifest.
$builder->add( 'path/to/file.c' );
$builder->add( 'file.c', flags => ['-DDEBUG', '-Wall'] );
$builder->add( \"int main(){}", lang => 'c' );
=over
=item * B<File Path:> If C<$input> is a string, it is treated as a file path. The compiler auto-detects the language based on the extension.
=item * B<Inline Code:> If C<$input> is a SCALAR reference, you B<must> provide the C<lang> argument (e.g., C<'c'>, C<'rust'>) so the compiler knows how to handle it.
=item * B<C<flags>>: An ArrayRef or space-separated string of compiler flags specific to this source file.
=back
=head2 C<compile_and_link( )>
Performs the build process:
=over
=item 1. Inspects added sources to determine the Build Strategy.
lib/Test2/Tools/Affix.pm view on Meta::CPAN
$filename = path($filename)->canonpath;
$line++;
$filename =~ s[\\][\\\\]g; # Windows...
$opt->spew_utf8(qq[#line $line "$filename"\r\n$name]);
}
if ( !$opt ) {
$c->fail('Failed to locate test source');
$c->release;
return ();
}
$aggs->{cflags} .= ' -I' . $Inc;
my $compiler = Affix::Build->new( debug => 0, name => 'testing', version => '1.0', flags => $aggs );
$compiler->add( $opt->canonpath );
$compiler->link;
push @cleanup, $opt->canonpath, $compiler->link unless $keep;
$c->ok( 1, 'build lib: ' . $compiler->link );
$c->release;
$compiler->link;
}
sub affix_ok ( $lib, $name, $args, $ret ) {
my $c = context;
t/012_enum.t view on Meta::CPAN
ok $val eq 'STATE_RUNNING', 'String equality';
# Case 2: RUNNING -> PAUSED
my $val2 = $next->( STATE_RUNNING() );
is 0 + $val2, 11, 'Numeric value is 11';
is "$val2", 'STATE_PAUSED', 'String value is "STATE_PAUSED"';
};
subtest 'Unknown Values' => sub {
# Create a function that returns a value NOT in our enum definition
# (Simulating C library adding a new flag we don't know about yet)
my $raw_lib = compile_ok(<<'END_RAW');
#include "std.h"
//ext: .c
DLLEXPORT int get_unknown() { return 555; }
END_RAW
my $get_unknown = wrap( $raw_lib, 'get_unknown', [] => MachineState() );
my $val = $get_unknown->();
is 0 + $val, 555, 'Unknown integer value preserved';
# Behavior for unknown strings depends on impl, usually just the number as string
t/018_sv_type.t view on Meta::CPAN
use ExtUtils::Embed;
#
diag '$Config{useshrplib} claims to be ' . $Config{useshrplib};
diag '$Config{libperl} is ' . $Config{libperl};
#~ $Config{useshrplib} eq 'true' || exit skip_all 'Cannot embed perl in a shared lib without building a shared libperl.';
eval {
# See https://metacpan.org/release/RJBS/perl-5.36.0/view/INSTALL#Building-a-shared-Perl-library
#
# Compile C Library 1 (Basic Operations)
my $cflags = ccopts(); #$Config{ccflags} . ' -I' . $Config{archlib} . '\CORE';
my $ldflags = '';
if ( $^O eq 'MSWin32' ) {
$ldflags .= ' "' . $Config{archlib} . '/CORE/' . $Config{libperl} . '"';
}
elsif ( $^O eq 'darwin' ) { # macOS/ARM64 requires ignoring undefined symbols from the host Perl
$ldflags .= ' -Wl,-undefined,dynamic_lookup';
}
else {
if ( $Config{useshrplib} && $Config{useshrplib} ne 'false' ) {
$ldflags .= '-L"' . $Config{archlib} . '/CORE" -l' . ( $Config{libperl} =~ s/^(?:lib)?([^.]+).*$/-l$1/r );
}
}
diag $cflags;
diag $ldflags;
my $lib = compile_ok( <<~'END', { cflags => $cflags, ldflags => $ldflags } );
#include "std.h"
//ext: .c
#undef warn
#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter *my_perl;
#define NO_XSLOCKS
#include <XSUB.h>
t/018_sv_type.t view on Meta::CPAN
# Test Return Value (SV)
isa_ok my $make = wrap( $lib, 'make_sv', [Int] => Pointer [SV] ), ['Affix'];
my $res = $make->(42);
is $res, 42, 'Received SV from C';
# Test within Callbacks
# Define a callback type that accepts and returns an SV*
typedef CallbackSV => Callback [ [ Pointer [SV] ] => Pointer [SV] ];
# We need a C function that takes this callback
my $lib2 = compile_ok( <<~'END', { cflags => $cflags, ldflags => $ldflags } );
#include "std.h"
//ext: .c
#undef warn
#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter *my_perl;
#define NO_XSLOCKS
#include <XSUB.h>
t/020_deep_types.t view on Meta::CPAN
typedef union {
int32_t as_int;
double as_double;
char as_char;
} Variant;
/* Recursive Struct (Linked List) with Array and Union */
typedef struct Node {
int id;
Variant data;
int type_flag; // 0 = int, 1 = double, 2 = char
int matrix[2][2]; // Nested fixed-size array
struct Node* next; // Recursive pointer
} Node;
/*
* Calculates the area of a Rect passed by value.
* Tests nested struct marshalling (Perl -> C).
*/
DLLEXPORT int rect_area(Rect r) {
int width = r.bottom_right.x - r.top_left.x;
t/020_deep_types.t view on Meta::CPAN
/*
* Traverses a linked list of Nodes and sums the values.
* Tests recursive types, pointers, unions, and arrays.
*/
DLLEXPORT double sum_nodes(Node* head) {
double total = 0;
Node* current = head;
while (current) {
// Add value from union based on flag
if (current->type_flag == 0) total += current->data.as_int;
else if (current->type_flag == 1) total += current->data.as_double;
else if (current->type_flag == 2) total += current->data.as_char;
// Add diagonal of the matrix
total += current->matrix[0][0];
total += current->matrix[1][1];
current = current->next;
}
return total;
}
t/020_deep_types.t view on Meta::CPAN
# Union: Variant
my $Variant = Union [ as_int => Int, as_double => Double, as_char => Char ];
# Recursive Struct: Node
# We use a named typedef here so the 'next' field can refer to itself.
typedef 'Node';
typedef 'Node' => Struct [
id => Int,
data => $Variant,
type_flag => Int,
# 2x2 Array of Ints (Array of Arrays)
matrix => Array [ Array [ Int, 2 ], 2 ],
next => Pointer [ Node() ]
];
# Bind Functions
# -----------------
# int rect_area(Rect r)
isa_ok my $rect_area = wrap( $lib, 'rect_area', [$Rect] => Int ), ['Affix'];
t/020_deep_types.t view on Meta::CPAN
$move_point->( $p, 50, -25 );
is $p->{x}, 150, 'Struct member X modified via pointer';
is $p->{y}, 75, 'Struct member Y modified via pointer';
};
subtest 'Unions, Arrays, and Recursive Linked Lists' => sub {
# Construct a linked list in Perl: Node1 -> Node2 -> Node3 -> NULL
# Node 3: Char type (value 10), Matrix diag (1, 1) = sum 12
my $node3 = {
id => 3,
type_flag => 2, # char
data => { as_char => 10 },
matrix => [ [ 1, 0 ], [ 0, 1 ] ],
next => undef
};
# Node 2: Double type (value 5.5), Matrix diag (2, 2) = sum 9.5
my $node2 = {
id => 2,
type_flag => 1, # double
data => { as_double => 5.5 },
matrix => [ [ 2, 0 ], [ 0, 2 ] ],
next => $node3 # Link to node 3
};
# Node 1: Int type (value 100), Matrix diag (0, 0) = sum 100
my $node1 = {
id => 1,
type_flag => 0, # int
data => { as_int => 100 },
matrix => [ [ 0, 0 ], [ 0, 0 ] ],
next => $node2 # Link to node 2
};
# Expected sum:
# N3: 10 + 1 + 1 = 12
# N2: 5.5 + 2 + 2 = 9.5
# N1: 100 + 0 + 0 = 100
# Total = 121.5
t/027_thread_safety.t view on Meta::CPAN
#endif
}
C
# Pass reference (\$c_source) so Affix::Build treats it as code, not a filename
my $lib = compile_ok($c_source);
ok $lib && -e $lib, 'Compiled a threaded test library';
#
ok affix( $lib, 'run_in_foreign_thread', [ Callback_t(), Int ] => Void ), 'affix run_in_foreign_thread';
#
my $ok_flag = 0;
my $str;
# This calls C, which spawns a thread, which calls this sub
run_in_foreign_thread(
sub ($val) {
# Allocating memory here (creating SVs) tests the memory allocator context
$str = 'Received: ' . $val;
$ok_flag = $val;
},
123
);
is $ok_flag, 123, 'Callback executed successfully from foreign thread without crashing';
diag $str;
};
#
subtest ithreads => sub {
skip_all 'No ithreads', 1 unless $Config{useithreads};
require threads;
# Test core affix cloning and usage across threads
ok affix libc(), [ abs => 'absolute' ], [Int] => Int;
is absolute(-42), 42, 'Main thread: absolute(-42) == 42';
( run in 2.458 seconds using v1.01-cache-2.11-cpan-cdf2f3d4e48 )