Affix
view release on metacpan or search on metacpan
This function will parse a pointer into a given target type.
The source pointer would have normally been obtained from a call to a native
subroutine that returned a pointer, a lvalue pointer to a native subroutine,
or, as part of a `Struct[ ... ]`.
## `DumpHex( ... )`
```
DumpHex( $ptr, $length );
```
Dumps `$length` bytes of raw data from a given point in memory.
This is a debugging function that probably shouldn't find its way into your
code and might not be public in the future.
# Types
Raku offers a set of native types with a fixed, and known, representation in
memory but this is Perl so we need to do the work ourselves with a pseudo-type
system. Affix supports the fundamental types (void, int, etc.), aggregates
(struct, array, union), and .
year => Int
];
```
All fundamental and aggregate types may be found inside of a `Struct`.
## `ArrayRef[ ... ]`
The elements of the array must pass the additional size constraint.
An array length must be given:
```
ArrayRef[Int, 5]; # int arr[5]
ArrayRef[Any, 20]; # SV * arr[20]
ArrayRef[Char, 5]; # char arr[5]
ArrayRef[Str, 10]; # char *arr[10]
```
## `Union[ ... ]`
builder/Affix.pm view on Meta::CPAN
my $response = $http->get('https://dyncall.org/download');
die sprintf "Failed to download %s: %s!", $response->{url}, $response->{content}
unless $response->{success};
#print "$response->{status} $response->{reason}\n";
#while ( my ( $k, $v ) = each %{ $response->{headers} } ) {
# for ( ref $v eq 'ARRAY' ? @$v : $v ) {
# print "$k: $_\n";
# }
#}
#print $response->{content} if length $response->{content};
# https://dyncall.org/r1.2/dyncall-1.2-windows-xp-x64-r.zip
# https://dyncall.org/r1.2/dyncall-1.2-windows-xp-x86-r.zip
# https://dyncall.org/r1.2/dyncall-1.2-windows-10-arm64-r.zip
if ( $opt{config}->get('osname') eq 'MSWin32' ) { # Use prebuilt libs on Windows
my $x64 = $opt{config}->get('ptrsize') == 8;
my $plat = $x64 ? '64' : '86';
my %versions;
for my $url ( map { 'https://dyncall.org/' . $_ }
$response->{content}
=~ m[href="(.+/dyncall-\d\.\d+\-windows-xp-x${plat}(?:-r)?\.zip)"]g ) {
dyncall/configure view on Meta::CPAN
printf "AR=psp-ar\n" >>$C
printf "CFLAGS=-I${SDKROOT}/include/\n" >>$C
printf "CXXFLAGS=-I${SDKROOT}/include/\n" >>$C
# Pulling in dyncall libs below is a hack, for some reason psp-ld is super-picky about order.
# Use your C lib of choice, from the PSPSDK, or...
#printf "LDLIBS=-L${SDKROOT}/lib/ -L${SRCTOP}/dyncall -L${SRCTOP}/dyncallback -ldyncall_s -ldyncallback_s -lm -lpspdebug -lpspdisplay -lpspge -lpspctrl -lpspsdk -lstdc++ -lpsplibc -lpspnet -lpspnet_inet -lpspnet_apctl -lpspnet_resolver -lpsputili...
# ... newlib.
printf "LDLIBS=-L${SDKROOT}/lib/ -L${SRCTOP}/dyncall -L${SRCTOP}/dyncallback -ldyncall_s -ldyncallback_s -lm -lpspdebug -lpspdisplay -lpspge -lpspctrl -lpspsdk -lstdc++ -lc -lpspnet -lpspnet_inet -lpspnet_apctl -lpspnet_resolver -lpsputilit...
;;
?)
cat $0 | awk '/^esac$/{b=0}/^ [A-Za-z0-9|]+\)/{if(b==1) print substr($1,1,length($1)-1)}BEGIN{b=0}/^case.*TARGET.*uname.*in$/{b=1}' | tr '|' '\n'
exit 0
;;
esac
# removed, b/c platform support not consistent and ELF flags checked often not having any result
#
## Assure objects not asking for an execstack (or binary that links dyncall might end
## up with one, for no reason).
#
dyncall/doc/manual/manual.tex view on Meta::CPAN
% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
%
%//////////////////////////////////////////////////////////////////////////////
% Set the normal line height for the entire document (some command depend on it).
\newcommand{\normallineheight}{10pt}
\documentclass[\normallineheight,a4paper]{article}
% Value multiplier.
\newlength\mrbraceheight
\newcommand{\tassimultiply}[2]{%
\setlength{\mrbraceheight}{0pt}%
\newcount\qq%
\qq=1 % Subtract 1 by starting at 1 .
\loop%
\addtolength\mrbraceheight{#2}%
\advance\qq by 1%
\ifnum\qq < #1 \repeat%
}
% Conditional if tex4ht is on or not
\newcommand{\ifhtml}[1]{%
\ifx\HCode\Undef \else%
#1%
\fi%
dyncall/doc/manual/manual.tex view on Meta::CPAN
\newcommand{\shell}[1]{\noindent{\tt #1}}
% Multiline table row with left or right curly brace.
%\newcommand{\mrrbrace}[2]{\tassimultiply{#1}{5pt} \multirow{#1}{*}{$\smash{\left. {\vrule height 0pt depth \mrbraceheight width 0pt}\right\}}$#2}}
\newcommand{\mrrbrace}[2]{\rdelim\}{#1}{\normallineheight} \multirow{#1}{*}{#2} }
\newcommand{\mrlbrace}[2]{ \multirow{#1}{*}{#2} \ldelim\{{#1}{\normallineheight}}
\newcommand{\tablewidth}{130mm}
%\setlength{\oddsidemargin}{10mm}
%\setlength{\textwidth}{140mm}
%\setlength{\parindent}{0mm}
%\setlength{\parskip}{1ex plus 0.5ex minus 0.2ex}
\newcommand{\ninety}[1]{\begin{sideways}#1\end{sideways}}
\renewcommand{\paragraph}[1]{%
\par\vspace{12pt}%
\noindent%
\textbf{#1}%
\par%
\vspace{6pt}%
}%
% Set a watermark, but not when running htlatex
\ifnhtml{%
\watermark{%
\begingroup%
\setlength{\unitlength}{1mm}%
\begin{picture}(0,0)(32,300)%
\includegraphics[scale=1.0]{dyncall_watermark}%
\end{picture}%
\endgroup%
}%
}
% Use a sans-serif font.
\renewcommand{\familydefault}{\sfdefault}
dyncall/doc/manual/manual_title.tex view on Meta::CPAN
% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
%
%//////////////////////////////////////////////////////////////////////////////
\newcommand{\dyncallversion}{1.4}
\newcommand{\titlelogo}{%
\begingroup%
\setlength{\unitlength}{1mm}%
\begin{picture}(0,0)(-38,110)%
\includegraphics[scale=0.35]{dyncall_logo}%
\end{picture}%
\endgroup%
%\begingroup
%\setlength{\unitlength}{1bp}%
%\begin{picture}(250,400)%
%\end{picture}%
%\endgroup
%
%
%\setlength{\unitlength}{1mm}
%\begin{picture}(60, 40)
%\put(42,31){\circle*{1}}
%\put(42,30){\circle{2}}
%\put(40,31){\circle{4}}
%\put(40,30){\circle{8}}
%\put(41,31){\circle{16}}
%\put(41,30){\circle{32}}
%\put(19,31){\circle{1}}
%\put(20,30){\circle*{2}}
%\put(21,31){\circle{3}}
dyncall/dyncall/dyncall_vector.h view on Meta::CPAN
#define dcVecInit(p,size) (p)->mTotal=size;(p)->mSize=0
#define dcVecReset(p) (p)->mSize=0
#define dcVecResize(p,size) (p)->mSize=(size)
#define dcVecSkip(p,size) (p)->mSize+=(size)
#define dcVecData(p) ( (unsigned char*) (((DCVecHead*)(p))+1) )
#define dcVecAt(p,index) ( dcVecData(p)+index )
#define dcVecSize(p) ( (p)->mSize )
#define dcVecAlign(p,align) (p)->mSize=( (p)->mSize + align-1 ) & -align
void dcVecAppend(DCVecHead* pHead, const void* source, size_t length);
#endif /* DC_VECTOR_H */
dyncall/dynload/dynload_unix.c view on Meta::CPAN
/* for dlopen-based dlGetLibraryPath impls below, prefer RTLD_NOLOAD that
* merely checks lib names */
#if defined(RTLD_NOLOAD)
# define RTLD_LIGHTEST RTLD_LAZY|RTLD_NOLOAD
#else
# define RTLD_LIGHTEST RTLD_LAZY
#endif
/* helper copying string if buffer big enough, returning length (without \0) */
static int dl_strlen_strcpy(char* dst, const char* src, int dstSize)
{
int l = strlen(src);
if(l < dstSize) /* l+'\0' <= bufSize */
strcpy(dst, src);
return l;
}
/* code for dlGetLibraryPath() is platform specific */
dyncall/dynload/dynload_windows.c view on Meta::CPAN
void dlFreeLibrary(DLLib* pLib)
{
FreeLibrary((HINSTANCE)pLib);
}
int dlGetLibraryPath(DLLib* pLib, char* sOut, int bufSize)
{
/* get the path name as wide chars, then convert to UTF-8; we need */
/* some trial and error to figure out needed wide char string length */
wchar_t* ws;
int r;
/* num chars to alloc temp space for, and upper limit, must be both power */
/* of 2s for loop to be precise and to test allow testing up to 32768 chars */
/* (including \0), which is the extended path ("\\?\...") maximum */
static const int MAX_EXT_PATH = 1<<15; /* max extended path length (32768) */
int nc = 1<<6; /* guess start buffer size, */
while(nc <= MAX_EXT_PATH)/*@@@ add testcode for super long paths*/
{
ws = (wchar_t*)dlAllocMem(nc * sizeof(wchar_t));
if(!ws)
break;
r = GetModuleFileNameW((HMODULE)pLib, ws, nc);
eg/Cookbook/xor_cipher.pl view on Meta::CPAN
use YAML();
use Affix;
affix './xor_cipher.so', 'string_crypt_free', [ Pointer [Void] ], Void;
sub string_crypt {
CORE::state $string_crypt //= wrap './xor_cipher.so', 'string_crypt', [ Str, Int, Str ],
Pointer [Char];
my ( $input, $key ) = @_;
my $ptr = $string_crypt->( $input, length($input), $key );
my $out = $ptr->raw( length $input );
string_crypt_free($ptr);
$out;
}
#
my $orig = "hello world";
my $key = "foobar";
print YAML::Dump($orig);
my $encrypted = string_crypt( $orig, $key );
print YAML::Dump($encrypted);
my $decrypted = string_crypt( $encrypted, $key );
lib/Affix.pm view on Meta::CPAN
my $vp = 0; # void *
sub _mangle_name ($$) {
my ( $func, $name ) = @_;
if ( grep { $_ eq $name } @cache ) {
return join '', 'S', ( grep { $cache[$_] eq $name } 0 .. $#cache ), '_';
}
push @cache, $name;
$name =~ s[^$func][S0_];
sprintf $name =~ '::' ? 'N%sE' : '%s',
join( '', ( map { length($_) . $_ } split '::', $name ) );
}
sub _mangle_type {
my ( $func, $type ) = @_;
return #'A'
'P' . _mangle_type( $func, $type->{type} ) if $type->isa('Affix::Type::ArrayRef');
if ( $type->isa('Affix::Type::Pointer') && $type->{type}->isa('Affix::Type::Void') ) {
return $vp++ ? 'S_' : 'Pv';
}
return 'P' . _mangle_type( $func, $type->{type} ) if $type->isa('Affix::Type::Pointer');
lib/Affix.pm view on Meta::CPAN
WChar(), 'w', LongLong(), 'x', ULongLong(), 'y', '_', '', # Calling conventions
};
$types->{$type} // die 'Unknown type: ' . $type;
}
sub Itanium_mangle {
my ( $lib, $name, $affix ) = @_;
@cache = ();
$vp = 0;
my $ret = '_Z' . sprintf $name =~ '::' ? 'N%sE' : '%s',
join( '', ( map { length($_) . $_ } split '::', $name ) );
#~ for my $arg ( scalar @{ $affix->{args} } ? @{ $affix->{args} } : Void() ) {
my @args = scalar @{$affix} ? @{$affix} : Void();
while (@args) {
my $arg = shift @args;
$ret .= _mangle_type( $name, $arg );
if ( $arg eq '_' ) {
shift @args;
push @args, Void() if !@args; # skip calling conventions
}
lib/Affix.pm view on Meta::CPAN
# legacy
sub Rust_legacy_mangle {
my ( $lib, $name, $affix ) = @_;
CORE::state $symbol_cache //= ();
$symbol_cache->{$lib} //= Affix::_list_symbols($lib);
@cache = ();
$vp = 0;
return $name if grep { $name eq $_ } grep { defined $_ } @{ $symbol_cache->{$lib} };
my $ret = qr'^_ZN(?:\d+\w+?)?' . sprintf $name =~ '::' ? '%sE' : '%s17h\w{16}E$',
join( '', ( map { length($_) . $_ } split '::', $name ) );
my @symbols = grep { $_ =~ $ret } grep { defined $_ } @{ $symbol_cache->{$lib} };
return shift @symbols;
}
}
};
1;
__END__
=encoding utf-8
lib/Affix.pm view on Meta::CPAN
my $hash = cast( $ptr, Struct[i => Int, ... ] );
This function will parse a pointer into a given target type.
The source pointer would have normally been obtained from a call to a native
subroutine that returned a pointer, a lvalue pointer to a native subroutine,
or, as part of a C<Struct[ ... ]>.
=head2 C<DumpHex( ... )>
DumpHex( $ptr, $length );
Dumps C<$length> bytes of raw data from a given point in memory.
This is a debugging function that probably shouldn't find its way into your
code and might not be public in the future.
=head1 Types
Raku offers a set of native types with a fixed, and known, representation in
memory but this is Perl so we need to do the work ourselves with a pseudo-type
system. Affix supports the fundamental types (void, int, etc.), aggregates
(struct, array, union), and .
lib/Affix.pm view on Meta::CPAN
model => Str,
year => Int
];
All fundamental and aggregate types may be found inside of a C<Struct>.
=head2 C<ArrayRef[ ... ]>
The elements of the array must pass the additional size constraint.
An array length must be given:
ArrayRef[Int, 5]; # int arr[5]
ArrayRef[Any, 20]; # SV * arr[20]
ArrayRef[Char, 5]; # char arr[5]
ArrayRef[Str, 10]; # char *arr[10]
=head2 C<Union[ ... ]>
A union is a type consisting of a sequence of members with overlapping storage
(as opposed to C<Struct>, which is a type consisting of a sequence of members
lib/Affix.xs view on Meta::CPAN
}
av_push(values, newSVsv(TARGET));
}
sv_inc(current_value);
}
hv_stores(RETVAL_HV, "values", newRV_inc(MUTABLE_SV(values)));
}; break;
case DC_SIGCHAR_ARRAY: { // ArrayRef[Int, 5]
AV *type_size = MUTABLE_AV(SvRV(ST(1)));
SV *type, *size;
size_t array_length, array_sizeof = 0;
bool packed = false;
switch (av_count(type_size)) {
case 1: {
size = newSV(1);
type = *av_fetch(type_size, 0, 0);
if (!(sv_isobject(type) && sv_derived_from(type, "Affix::Type::Base")))
croak("Given type for '%s' is not a subclass of Affix::Type::Base",
SvPV_nolen(type));
size_t offset = 0;
size_t type_sizeof = _sizeof(aTHX_ type);
} break;
case 2: {
array_length = SvUV(*av_fetch(type_size, 1, 0));
if (array_length < 1) croak("Given size %zd is not a positive integer", array_length);
type = *av_fetch(type_size, 0, 0);
if (!(sv_isobject(type) && sv_derived_from(type, "Affix::Type::Base")))
croak("Given type for '%s' is not a subclass of Affix::Type::Base",
SvPV_nolen(type));
size_t offset = 0;
size_t type_sizeof = _sizeof(aTHX_ type);
for (int i = 0; i < array_length; ++i) {
array_sizeof += type_sizeof;
array_sizeof +=
packed ? 0
: padding_needed_for(array_sizeof, AFFIX_ALIGNBYTES > type_sizeof
? type_sizeof
: AFFIX_ALIGNBYTES);
offset = array_sizeof;
}
size = newSVuv(array_length);
} break;
default:
croak("Expected a single type and array length: "
"ArrayRef[Int, 5]");
}
hv_stores(RETVAL_HV, "sizeof", newSVuv(array_sizeof));
hv_stores(RETVAL_HV, "size", size);
hv_stores(RETVAL_HV, "name", newSV(0));
hv_stores(RETVAL_HV, "packed", sv_2mortal(boolSV(packed)));
hv_stores(RETVAL_HV, "type", newSVsv(type));
} break;
case DC_SIGCHAR_CODE: {
AV *fields = newAV_mortal();
t/50_affix_pointers.t view on Meta::CPAN
is $ptr, 1000, '$ptr was changed to 1000';
diag __LINE__;
};
diag __LINE__;
subtest 'Dyn::Call::Pointer with a double' => sub {
diag __LINE__;
my $ptr = calloc( 1, 16 );
{
diag __LINE__;
my $data = pack 'd', 100.04;
memcpy( $ptr, $data, length $data );
}
is dbl_ptr($ptr), 'one hundred and change', 'dbl_ptr($ptr) where $ptr == malloc(...)';
$ptr->dump(16);
diag __LINE__;
my $raw = $ptr->raw(16);
is unpack( 'd', $raw ), 10000, '$ptr was changed to 10000';
free $ptr;
diag __LINE__;
};
diag __LINE__;
subtest 'ref Dyn::Call::Pointer with a double (should croak)' => sub {
diag __LINE__;
my $ptr = calloc( 1, 16 );
{
diag __LINE__;
my $data = pack 'd', 9;
memcpy( $ptr, $data, length $data );
}
diag __LINE__;
is dbl_ptr($ptr), 'nine', 'dbl_ptr($ptr) where $ptr == malloc(...)';
is unpack( 'd', $ptr->raw(16) ),
( $Config{usequadmath} ? 9876.54299999999966530594974756241 :
$Config{uselongdouble} ? 9876.54299999999967 :
9876.543 ), '$ptr is still 9';
diag __LINE__;
DumpHex( $ptr, 16 );
diag __LINE__;
t/50_affix_pointers.t view on Meta::CPAN
diag __LINE__;
50.25;
}
),
-1, 'making call with an undef pointer passes a NULL';
}
diag __LINE__;
{
my $data = pack 'd', 590343.12351; # Test pumping raw, packed data into memory
diag __LINE__;
my $ptr = malloc length($data);
diag __LINE__;
memmove $ptr, $data, length $data;
diag __LINE__;
diag 'allocated ' . length($data) . ' bytes';
diag __LINE__;
is pointer_test(
$ptr,
[ 1 .. 5 ],
5,
sub {
diag __LINE__;
pass('our coderef was called');
is_deeply \@_, [ 4, 8 ], '... and given correct arguments';
50.25;
t/51_affix_sizeof_offsetof.t view on Meta::CPAN
is sizeof( massive() ), wrap( $lib, 's_massive', [], Size_t )->(), 'sizeof(massive)';
}
#diag Dumper $struct7;
is sizeof($struct7), wrap( $lib, 's_struct7', [], Size_t )->(), 'sizeof(struct7)';
is sizeof($struct8), wrap( $lib, 's_struct8', [], Size_t )->(), 'sizeof(struct8)';
};
subtest 'arrays' => sub {
#die sizeof( Struct [ d => Double, c => ArrayRef [ Int, 4 ] ]);
for my $length ( 1 .. 3 ) {
my $array1 = ArrayRef [ Struct [ d => Double, c => ArrayRef [ Int, 4 ] ], $length ];
#diag Dumper $array1;
is sizeof($array1), wrap( $lib, 's_array1', [Int], Size_t )->($length),
'sizeof(array1) [' . $length . ']';
}
};
subtest 'unions' => sub {
my $union1 = Union [ i => Int, d => Float ];
my $union2 = Union [ i => Int, s => $struct1, d => Float ];
my $union3 = Union [ i => Int, s => $struct3, d => Float ];
my $union4 = Union [ i => Int, s => ArrayRef [ $struct1, 5 ], d => Float ];
is sizeof($union1), wrap( $lib, 's_union1', [], Size_t )->(), 'sizeof(union1)';
is sizeof($union2), wrap( $lib, 's_union2', [], Size_t )->(), 'sizeof(union2)';
SKIP: {
t/src/51_affix_sizeof_offsetof.c view on Meta::CPAN
} massive;
DLLEXPORT size_t s_massive() {
return sizeof(massive);
}
//
typedef struct {
double d;
int c[4];
} array_struct;
DLLEXPORT size_t s_array1(int length) {
return sizeof(array_struct[length]);
}
//
typedef union
{
int i;
float d;
} union1;
typedef union
( run in 0.580 second using v1.01-cache-2.11-cpan-65fba6d93b7 )