Affix
view release on metacpan or search on metacpan
This function will parse a pointer into agiventarget type.The source pointer would have normally been obtained from a call to a nativesubroutine 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 agivenpoint in memory.This is a debugging function that probably shouldn't find its way into yourcode and might not be public in the future.# TypesRaku offers a set of native typeswitha fixed, and known, representation inmemory but this is Perl so we need todothe work ourselveswitha pseudo-typesystem. 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 arraylengthmust begiven:```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
diesprintf"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};if($opt{config}->get('osname') eq'MSWin32') {# Use prebuilt libs on Windowsmy$x64=$opt{config}->get('ptrsize') == 8;my$plat=$x64?'64':'86';my%versions;$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">>$Cprintf"CFLAGS=-I${SDKROOT}/include/\n">>$Cprintf"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'exit0;;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 heightforthe 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 by1%\ifnum\qq <#1 \repeat%}% Conditionaliftex4ht 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 rowwithleft 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 notwhenrunning 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 ) & -alignvoid dcVecAppend(DCVecHead* pHead, const void* source, size_tlength);#endif /* DC_VECTOR_H */
dyncall/dynload/dynload_unix.c view on Meta::CPAN
/*fordlopen-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 stringifbuffer big enough, returninglength(without \0) */staticintdl_strlen_strcpy(char* dst, const char* src,intdstSize){intl = strlen(src);if(l < dstSize) /* l+'\0'<= bufSize */strcpy(dst, src);returnl;}/* codefordlGetLibraryPath() is platform specific */
dyncall/dynload/dynload_windows.c view on Meta::CPAN
void dlFreeLibrary(DLLib* pLib){FreeLibrary((HINSTANCE)pLib);}intdlGetLibraryPath(DLLib* pLib, char* sOut,intbufSize){/* get the path name as wide chars, then convert to UTF-8; we need *//* some trial and error to figure out needed wide char stringlength*/wchar_t* ws;intr;/* num chars to alloc temp spacefor, and upper limit, must be both power *//* of 2sforloop to be precise and to test allow testing up to 32768 chars *//* (including \0), which is the extended path ("\\?\...") maximum */static constintMAX_EXT_PATH = 1<<15; /* max extended pathlength(32768) */intnc = 1<<6; /* guess start buffer size, */while(nc <= MAX_EXT_PATH)/*@@@ add testcodeforsuper 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
useYAML();useAffix;affix'./xor_cipher.so','string_crypt_free', [ Pointer [Void] ], Void;substring_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";YAML::Dump($orig);my$encrypted= string_crypt($orig,$key);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) {returnjoin'','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;}subItanium_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($argeq'_') {shift@args;push@args, Void()if!@args;# skip calling conventions}
lib/Affix.pm view on Meta::CPAN
# legacysubRust_legacy_mangle {my($lib,$name,$affix) =@_;CORE::state$symbol_cache//= ();$symbol_cache->{$lib} //= Affix::_list_symbols($lib);@cache= ();$vp= 0;return$nameifgrep{$nameeq$_}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} };returnshift@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 agiventarget type.The source pointer would have normally been obtained from a call to a nativesubroutine 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 yourcode and might not be public in the future.=head1 TypesRaku offers a set of native types with a fixed, and known, representation inmemory but this is Perl so we need to do the work ourselves with a pseudo-typesystem. 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(inti = 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);isunpack('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(...)';isunpack('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 memorydiag __LINE__;my$ptr= malloclength($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 ] ]);formy$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() {returnsizeof(massive);}//typedef struct {double d;intc[4];} array_struct;DLLEXPORT size_t s_array1(intlength) {returnsizeof(array_struct[length]);}//typedef union{inti;float d;} union1;typedef union
( run in 1.282 second using v1.01-cache-2.11-cpan-a9ef4e587e4 )