<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># See the bottom of this file for the POD documentation.  Search for the
# string '=head'.

#######################################################################
#
# Win32::API::Callback - Perl Win32 API Import Facility
#
# Author: Aldo Calpini &lt;dada@perl.it&gt;
# Author: Daniel Dragan &lt;bulkdd@cpan.org&gt;
# Maintainer: Cosimo Streppone &lt;cosimo@cpan.org&gt;
#
#######################################################################

package Win32::API::Callback;
use strict;
use warnings;
use vars qw( $VERSION $Stage2FuncPtrPkd );

$VERSION = '0.84';

#require XSLoader;    # to dynuhlode the module. #already loaded by Win32::API
#use Data::Dumper;

use Win32::API qw ( WriteMemory ) ;

BEGIN {
    #there is supposed to be 64 bit IVs on 32 bit perl compatibility here
    #but it is untested
    *IVSIZE = *Win32::API::IVSIZE;
    #what kind of stack processing/calling convention/machine code we needed
    eval "sub ISX64 () { ".(Win32::API::PTRSIZE() == 8 ?  1 : 0)." }";
    eval 'sub OPV () {'.$].'}';
    sub OPV();
    sub CONTEXT_XMM0();
    sub CONTEXT_RAX();
    *IsBadStringPtr = *Win32::API::IsBadStringPtr;
    sub PTRSIZE ();
    *PTRSIZE = *Win32::API::PTRSIZE;
    sub PTRLET ();
    *PTRLET = *Win32::API::Type::pointer_pack_type;
    if(OPV &lt;= 5.008000){ #don't have unpackstring in C
        eval('sub _CallUnpack {return unpack($_[0], $_[1]);}');
    }
    *DEBUGCONST = *Win32::API::DEBUGCONST;
    *DEBUG = *Win32::API::DEBUG;
}
#######################################################################
# dynamically load in the API extension module.
#
XSLoader::load 'Win32::API::Callback', $VERSION;

#######################################################################
# PUBLIC METHODS
#
sub new {
    my ($class, $proc, $in, $out, $callconvention) = @_;
    my $self = bless {}, $class; #about croak/die safety, can safely bless here,
    #a ::Callback has no DESTROY, it has no resources to release, there is a HeapBlock obj
    #stored in the ::Callback hash, but the HeapBlock destroys on its own
    # printf "(PM)Callback::new: got proc='%s', in='%s', out='%s'\n", $proc, $in, $out;

    $self-&gt;{intypes} = []; #XS requires this, do not remove
    if (ref($in) eq 'ARRAY') {
        foreach (@$in) {
            push(@{$self-&gt;{intypes}}, $_);
        }
    }
    else {
        my @in = split '', $in;
        foreach (@in) {
            push(@{$self-&gt;{intypes}}, $_);
        }
    }
    $self-&gt;{inbytes} = 0;
    foreach(@{$self-&gt;{intypes}}){ #calc how long the c stack is
        if($_ eq 'Q' or $_ eq 'q' or $_ eq 'D' or $_ eq 'd'){
            $self-&gt;{inbytes} += 8; #always 8
        }
        else{
            $self-&gt;{inbytes} += PTRSIZE; #4 or 8
        }
    }
    $self-&gt;{outtype} = $out;
    $self-&gt;{out} = Win32::API-&gt;type_to_num($out);
    $self-&gt;{sub} = $proc;
    $self-&gt;{cdecl} = Win32::API::calltype_to_num($callconvention);

    DEBUG "(PM)Callback::new: calling CallbackCreate($self)...\n" if DEBUGCONST;
    my $hproc = MakeCB($self);

    DEBUG "(PM)Callback::new: hproc=$hproc\n" if DEBUGCONST;

    $self-&gt;{code} = $hproc;

    #### cast the spell
    return $self;
}

sub MakeStruct {
    my ($self, $n, $addr) = @_;
    DEBUG "(PM)Win32::API::Callback::MakeStruct: got self='$self'\n" if DEBUGCONST;
    my $struct = Win32::API::Struct-&gt;new($self-&gt;{intypes}-&gt;[$n]);
    $struct-&gt;FromMemory($addr);
    return $struct;
}

#this was rewritten in XS, and is broken b/c it doesn't work on 32bit Perl with Quads
#sub MakeParamArr { #on x64, never do "$i++;       $packedparam .= $arr-&gt;[$i];"
#    #on x86, structs and over word size params appears on the stack,
#    #on x64 anything over the size of a "word" is passed by pointer
#    #nothing takes more than 8 bytes per parameter on x64
#    #there is no way to formally specify a pass by copy struct in ::Callback
#    #this only matters on x86, a work around is a bunch of N/I parameters,
#    #repack them as Js, then concat them, and you have the original pass by copy
#    #x86 struct
#    my ($self, $arr)  = @_;
#    my ($i, @pass_arr) = (0);
#    for(@{$self-&gt;{intypes}}){ #elements of intypes are not 1 to 1 with stack params
#        my ($typeletter, $packedparam, $finalParam, $unpackletter)  = ($_, $arr-&gt;[$i]);
#        
#        #structs don't work, this is broken code from old version
#        #$self-&gt;{intypes} is letters types not C prototype params
#        #C prototype support would have to exist for MakeStruct to work
#        if(    $typeletter eq 'S' || $typeletter eq 's'){
#            die "Win32::API::Callback::MakeParamArr type letter \"S\" and struct support not implemented";
#            #push(@pass_arr, MakeStruct($self, $i, $packedparam));
#        }elsif($typeletter eq 'I'){
#            $unpackletter = 'I', goto UNPACK;
#        }elsif($typeletter eq 'i'){
#            $unpackletter = 'i', goto UNPACK;
#        }elsif($typeletter eq 'f' || $typeletter eq 'F'){
#            $unpackletter = 'f', goto UNPACK;
#        }
#        elsif($typeletter eq 'd' || $typeletter eq 'D'){
#            if(IVSIZE == 4){ #need more data, 32 bit machine
#                $packedparam .= $arr-&gt;[++$i];
#            }
#            $unpackletter = 'd', goto UNPACK;
#        }
#        elsif($typeletter eq 'N' || $typeletter eq 'L' #on x64, J is 8 bytes
#               || (IVSIZE == 8 ? $typeletter eq 'Q': 0)){
#            $unpackletter = 'J', goto UNPACK;
#        }elsif($typeletter eq 'n' || $typeletter eq 'l'
#               || (IVSIZE == 8 ? $typeletter eq 'q': 0)){
#            $unpackletter = 'j', goto UNPACK;
#        }elsif(IVSIZE == 4 &amp;&amp; ($typeletter eq 'q' || $typeletter eq 'Q')){
#            #need more data, 32 bit machine
#            $finalParam = $packedparam . $arr-&gt;[++$i];
#        }elsif($typeletter eq 'p' || $typeletter eq 'P'){
#            if(!IsBadStringPtr($arr-&gt;[$i], ~0)){ #P letter is terrible design
#                $unpackletter = 'p', goto UNPACK;
#            }#else undef
#        }
#        else{ die "Win32::API::Callback::MakeParamArr unknown in type letter $typeletter";}
#        goto GOTPARAM;
#        UNPACK:
#        $finalParam = unpack($unpackletter, $packedparam);
#        GOTPARAM:
#        $i++;
#        push(@pass_arr, $finalParam);
#    }
#    return \@pass_arr;
#}

#on x64
#void RunCB($self, $EBP_ESP, $retval)
#on x86
#void RunCB($self, $EBP_ESP, $retval, $unwindcount, $F_or_D)
if(! ISX64 ) {
*RunCB  = sub {#32 bits
    my $self = $_[0];
    my (@pass_arr, $return, $typeletter, $inbytes, @arr);
    $inbytes = $self-&gt;{inbytes};
    #first is ebp copy then ret address
    $inbytes += PTRSIZE * 2;
    my $paramcount = $inbytes / PTRSIZE ;
    my $stackstr = unpack('P'.$inbytes, pack(PTRLET, $_[1]));
    #pack () were added in 5.7.2
    if (OPV &gt; 5.007002) {
        @arr = unpack("(a[".PTRLET."])[$paramcount]",$stackstr);
    } else {
        #letter can not be used for size, must be numeric on 5.6
        @arr = unpack(("a4") x $paramcount,$stackstr);
    }
    shift @arr, shift @arr; #remove ebp copy and ret address
    $paramcount -= 2;
    $return = &amp;{$self-&gt;{sub}}(@{MakeParamArr($self, \@arr)});
    
    #now the return type
    $typeletter = $self-&gt;{outtype};
    #float_or_double flag, its always used
    #float is default for faster copy of probably unused value
    $_[4] = 0;
    #its all the same in memory
    if($typeletter eq 'n' || $typeletter eq 'N'
          || $typeletter eq 'l' || $typeletter eq 'L'
          || $typeletter eq 'i' || $typeletter eq 'I'){
        $_[2] = pack(PTRLET, $return);
    }elsif($typeletter eq 'q' || $typeletter eq 'Q'){
        if(IVSIZE == 4){
            if($self-&gt;{'UseMI64'} || ref($return)){ #un/signed meaningless
                $_[2] = Math::Int64::int64_to_native($return);
            }
            else{
                warn("Win32::API::Callback::RunCB return value for return type Q is under 8 bytes long")
                if length($return) &lt; 8;
                $_[2] = $return.''; #$return should be a 8 byte string
                #will be garbage padded in XS if &lt; 8, but must be a string, not a IV or under
            }
        }
        else{
            $_[2] = pack($typeletter, $return);
        }
    }elsif($typeletter eq 'f' || $typeletter eq 'F' ){
        $_[2] = pack('f', $return);
    }elsif($typeletter eq 'd' || $typeletter eq 'D' ){
        $_[2] = pack('d', $return);
        $_[4] = 1; #use double
    }else { #return null
        $_[2] = "\x00" x 8;
    }
    
    if(! $self-&gt;{cdecl}){
        $_[3] = PTRSIZE * $paramcount; #stack rewind amount in bytes
    }
    else{$_[3] = 0;}
};
}
else{ #64 bits
*RunCB  = sub {
    my $self = $_[0];
    my (@pass_arr, $return, $typeletter);
    my $paramcount = $self-&gt;{inbytes} / IVSIZE;
    my $stack_ptr = unpack('P[J]', pack('J', ($_[1]+CONTEXT_RAX())));
    my $stack_str = unpack('P['.$self-&gt;{inbytes}.']', $stack_ptr);
    my @stack_arr = unpack("(a[J])[$paramcount]",$stack_str);
    #not very efficient, todo search for f/F/d/D in new() not here
    my $XMMStr = unpack('P['.(4 * 16).']',  pack('J', ($_[1]+CONTEXT_XMM0())));
    #print Dumper([unpack('(H[32])[4]', $XMMStr)]);
    my @XMM = unpack('(a[16])[4]', $XMMStr);
    #assume registers are copied to shadow stack space already
    #because of ... prototype, so only XMM registers need to be fetched.
    #Limitation, vararg funcs on x64 get floating points in normal registers
    #not XMMs, so a vararg function taking floats and doubles in the first 4
    #parameters isn't supported
    if($paramcount){
        for(0..($paramcount &gt; 4 ? 4 : $paramcount)-1){
            my $typeletter = ${$self-&gt;{intypes}}[$_];
            if($typeletter eq 'f' || $typeletter eq 'F' || $typeletter eq 'd'
               || $typeletter eq 'D'){
        #x64 calling convention does not use the high 64 bits of a XMM register
        #although right here the high 64 bits are in @XMM elements
        #J on x64 is 8 bytes, a double will not corrupt, this is unreachable on x86
        #note we are copying 16 bytes elements to @stack_arr, @stack_arr is
        #normally 8 byte elements, unpack ignores the excess bytes later
                $stack_arr[$_] =  $XMM[$_];
            }
        }
    }
    #print Dumper(\@stack_arr);
    #print Dumper(\@XMM);
    $return = &amp;{$self-&gt;{sub}}(@{MakeParamArr($self, \@stack_arr)});
    
    #now the return type
    $typeletter = $self-&gt;{outtype};
    #its all the same in memory
    if($typeletter eq 'n' || $typeletter eq 'N'
          || $typeletter eq 'l' || $typeletter eq 'L'
          || $typeletter eq 'i' || $typeletter eq 'I'
          || $typeletter eq 'q' || $typeletter eq 'Q'){
        $_[2] = pack('J', $return);
    }
    elsif($typeletter eq 'f' || $typeletter eq 'F' ){
        $_[2] = pack('f', $return);
    }
    elsif($typeletter eq 'd' || $typeletter eq 'D' ){
        $_[2] = pack('d', $return);
    }
    else { #return null
        $_[2] = pack('J', 0);
    }
};
}

sub MakeCB{
    
    my $self = $_[0];
    #this x86 function does not corrupt the callstack in a debugger since it
    #uses ebp and saves ebp on the stack, the function won't have a pretty
    #name though
    my $code =  (!ISX64) ? ('' #parenthesis required to constant fold
    ."\x55" #          push    ebp
    ."\x8B\xEC" #      mov     ebp, esp
    ."\x83\xEC\x0C"#   sub     esp, 0Ch
    ."\x8D\x45\xFC" #  lea     eax, [ebp+FuncRtnCxtVar]
    ."\x50"#           push    eax
    ."\x8D\x45\xF4"#   lea     eax, [ebp+retval]
    ."\x50"#           push    eax
    ."\x8B\xC5"#       mov     eax,ebp 
    ."\x50"#           push    eax
    ."\xB8").PackedRVTarget($self)#B8 mov imm32 to eax, a HV * winds up here
    .("\x50"#           push    eax
    ."\xB8").$Stage2FuncPtrPkd # mov     eax, 0C0DE0001h
    .("\xFF\xD0"#       call    eax
    #since ST(0) is volatile, we don't care if we fill it with garbage
    ."\x80\x7D\xFE\x00"#cmp    [ebp+FuncRtnCxtVar.F_Or_D], 0
    ."\xDD\xD8"#       fstp    st(0) pop a FP reg to make space on FPU stack
    ."\x74\x05"#       jz      5 bytes
    ."\xDD\x45\xF4"#   fld     qword ptr [ebp+retval] (double)
    ."\xEB\x03"#       jmp     3 bytes
    ."\xD9\x45\xF4"#   fld     dword ptr [ebp+retval] (float)
    #rewind sp to entry sp, no pop push after this point
    ."\x83\xC4\x24"#   add     esp, 24h
    ."\x8B\x45\xF4"#   mov     eax, dword ptr [ebp+retval]
    #edx might be garbage, we don't care, caller only looks at volatile
    #registers that the caller's prototype says the caller does
    ."\x8B\x55\xF8"#   mov     edx, dword ptr [ebp+retval+4]
    #can't use retn op, it requires a immediate count, our count is in a register
    #only one register available now, this will be complicated
    ."\x0F\xB7\x4D\xFC"#movzx  ecx, word ptr [ebp+FuncRtnCxtVar.unwind_len]
    ."\x01\xCC"#       add     esp, ecx , might be zero or more
    ."\x8B\x4D\x04"#   mov     ecx, dword ptr [ebp+4] ret address
    ."\x8B\x6D\x00"#   mov     ebp, dword ptr [ebp+0] restore BP
    ."\xFF\xE1")#       jmp     ecx


    #begin x64 part
    #these packs don't constant fold in &lt; 5.17 :-(
    #they are here for readability
    :(''.pack('C', 0b01000000 #REX base
            | 0b00001000 #REX.W
            | 0b00000001 #REX.B
    ).pack('C', 0xB8+2) #mov to r10 register
    .PackedRVTarget($self)
    .pack('C', 0b01000000 #REX base
            | 0b00001000 #REX.W
    ).pack('C', 0xB8) #mov to rax register
    .$Stage2FuncPtrPkd
    ."\xFF\xE0");#       jmp     rax
#making a full function in Perl in x64 was removed because RtlAddFunctionTable
#has no effect on VS 2008 debugger, it is a bug in VS 2008, in WinDbg the C callstack
#is correct with RtlAddFunctionTable, and broken without RtlAddFunctionTable
#in VS 2008, the C callstack was always broken since WinDbg and VS 2008 both
#*only* use Unwind Tables on x64 to calculate C callstacks, they do not, I think,
#use 32 bit style EBP/RBP walking, x64 VC almost never uses BP addressing anyway.
#The easiest fix was to not have dynamic machine code in the callstack at all,
#which is what I did. Having good C callstacks in a debugger with ::API and
#::Callback are a good goal.
#
##--- c:\documents and settings\administrator\desktop\w32api\callback\callback.c -
#    $code .= "\x4C\x8B\xDC";#         mov         r11,rsp
#    $code .= "\x49\x89\x4B\x08";#      mov         qword ptr [r11+8],rcx 
#    $code .= "\x49\x89\x53\x10";#      mov         qword ptr [r11+10h],rdx 
#    $code .= "\x4D\x89\x43\x18";#      mov         qword ptr [r11+18h],r8 
#    $code .= "\x4D\x89\x4B\x20";#      mov         qword ptr [r11+20h],r9 
#    $code .= "\x48\x83\xEC\x78";#      sub         rsp,78h 
#    #void (*LPerlCallback)(SV *, void *, unsigned __int64 *, void *) =
#    #( void (*)(SV *, void *, unsigned __int64 *, void *)) 0xC0DE00FFFF000001;
#    #__m128 arr [4];
#    #__m128 retval;
##     arr[0].m128_u64[0] = 0xFFFF00000000FF10;
##00000000022D1017 48 B8 10 FF 00 00 00 00 FF FF mov         rax,0FFFF00000000FF10h 
##arr[0].m128_u64[1] = 0xFFFF00000000FF11;
##     arr[1].m128_u64[0] = 0xFFFF00000000FF20;
##     arr[1].m128_u64[1] = 0xFFFF00000000FF21;
##     arr[2].m128_u64[0] = 0xFFFF00000000FF30;
##     arr[2].m128_u64[1] = 0xFFFF00000000FF31;
##     arr[3].m128_u64[0] = 0xFFFF00000000FF40;
##     arr[3].m128_u64[1] = 0xFFFF00000000FF41;
#
##    LPerlCallback((SV *)0xC0DE00FFFF000002, (void*) arr, (unsigned __int64 *)&amp;retval,
##                  (DWORD_PTR)&amp;a);
##00000000022D1021 4D 8D 4B 08      lea         r9,[r11+8] #no 4th param
#    $code .= "\x4D\x8D\x43\xA8";#      lea         r8,[r11-58h] #&amp;retval param
##00000000022D1029 49 89 43 B8      mov         qword ptr [r11-48h],rax 
##00000000022D102D 48 B8 11 FF 00 00 00 00 FF FF mov         rax,0FFFF00000000FF11h 
#    $code .= "\x49\x8D\x53\xB8";#     lea         rdx,[r11-48h] #arr param
##00000000022D103B 49 89 43 C0      mov         qword ptr [r11-40h],rax 
##00000000022D103F 48 B8 20 FF 00 00 00 00 FF FF mov         rax,0FFFF00000000FF20h 
##00000000022D1049 48 B9 02 00 00 FF FF 00 DE C0 mov         rcx,0C0DE00FFFF000002h
#    $code .= "\x48\xB9".PackedRVTarget($self);# mov         rcx, the HV *
##00000000022D1053 49 89 43 C8      mov         qword ptr [r11-38h],rax 
##00000000022D1057 48 B8 21 FF 00 00 00 00 FF FF mov         rax,0FFFF00000000FF21h 
##00000000022D1061 49 89 43 D0      mov         qword ptr [r11-30h],rax 
##00000000022D1065 48 B8 30 FF 00 00 00 00 FF FF mov         rax,0FFFF00000000FF30h 
##00000000022D106F 49 89 43 D8      mov         qword ptr [r11-28h],rax 
##00000000022D1073 48 B8 31 FF 00 00 00 00 FF FF mov         rax,0FFFF00000000FF31h 
##00000000022D107D 49 89 43 E0      mov         qword ptr [r11-20h],rax 
##00000000022D1081 48 B8 40 FF 00 00 00 00 FF FF mov         rax,0FFFF00000000FF40h 
##00000000022D108B 49 89 43 E8      mov         qword ptr [r11-18h],rax 
##00000000022D108F 48 B8 41 FF 00 00 00 00 FF FF mov         rax,0FFFF00000000FF41h 
##00000000022D1099 49 89 43 F0      mov         qword ptr [r11-10h],rax 
##00000000022D109D 48 B8 01 00 00 FF FF 00 DE C0 mov         rax,0C0DE00FFFF000001h
#    $code .= "\x48\xB8".$Stage2FuncPtrPkd; # mov         rax,0C0DE00FFFF000001h 
#    $code .= "\xFF\xD0";#            call        rax  
##    return *(void **)&amp;retval;
#    $code .= "\x48\x8B\x44\x24\x20";#   mov         rax,qword ptr [retval] 
##}
#    $code .= "\x48\x83\xC4\x78";#      add         rsp,78h 
#    $code .= "\xC3";#              ret              

#$self-&gt;{codestr} = $code; #save memory
#32 bit perl doesn't use DEP in my testing, but use executable heap to be safe
#a Win32::API::Callback::HeapBlock is a ref to scalar, that scalar has the void *
my $ptr = ${($self-&gt;{codeExecAlloc} = Win32::API::Callback::HeapBlock-&gt;new(length($code)))};
WriteMemory($ptr, $code, length($code));
return $ptr;
}


1;

__END__

#######################################################################
# DOCUMENTATION
#

=head1 NAME

Win32::API::Callback - Callback support for Win32::API

=head1 SYNOPSIS

  use Win32::API;
  use Win32::API::Callback;

  my $callback = Win32::API::Callback-&gt;new(
    sub { my($a, $b) = @_; return $a+$b; },
    "NN", "N",
  );

  Win32::API-&gt;Import(
      'mydll', 'two_integers_cb', 'KNN', 'N',
  );

  $sum = two_integers_cb( $callback, 3, 2 );


=head1 FOREWORDS

=over 4

=item *
Support for this module is B&lt;highly experimental&gt; at this point.

=item *
I won't be surprised if it doesn't work for you.

=item *
Feedback is very appreciated.

=item *
Documentation is in the work. Either see the SYNOPSIS above
or the samples in the F&lt;samples&gt; or the tests in the F&lt;t&gt; directory.

=back

=head1 USAGE

Win32::API::Callback uses a subset of the type letters of Win32::API. C Prototype
interface isn't supported. Not all the type letters of Win32::API are supported
in Win32::API::Callback.

=over 4

=item C&lt;I&gt;: 
value is an unsigned integer (unsigned int)

=item C&lt;i&gt;: 
value is an signed integer (signed int or int)

=item C&lt;N&gt;: 
value is a unsigned pointer sized number (unsigned long)

=item C&lt;n&gt;: 
value is a signed pointer sized number (signed long or long)

=item C&lt;Q&gt;: 
value is a unsigned 64 bit integer number (unsigned long long, unsigned __int64)
See next item for details.

=item C&lt;q&gt;: 
value is a signed 64 bit integer number (long long, __int64)
If your perl has 'Q'/'q' quads support for L&lt;pack&gt; then Win32::API's 'q'
is a normal perl numeric scalar. All 64 bit Perls have quad support. Almost no
32 bit Perls have quad support. On 32 bit Perls, without quad support,
Win32::API::Callback's 'q'/'Q' letter is a packed 8 byte string.
So C&lt;0x8000000050000000&gt; from a perl with native Quad support
would be written as C&lt;"\x00\x00\x00\x50\x00\x00\x00\x80"&gt; on a 32 bit
Perl without Quad support. To improve the use of 64 bit integers with
Win32::API::Callback on a 32 bit Perl without Quad support, there is
a per Win32::API::Callback object setting called L&lt;Win32::API/UseMI64&gt;
that causes all quads to be accepted as, and returned as L&lt;Math::Int64&gt;
objects. 4 to 8 byte long pass by copy/return type C aggregate types
are very rare in Windows, but they are supported as "in" and return
types by using 'q'/'Q' on 32 and 64 bits. Converting between the C aggregate
and its representation as a quad is up to the reader. For "out" in
Win32::API::Callback (not "in"), if the argument is a reference, it will
automatically be treated as a Math::Int64 object without having to
previously call this function.

=item C&lt;F&gt;: 
value is a floating point number (float)

=item C&lt;D&gt;: 
value is a double precision number (double)

=item C&lt;Unimplemented types&gt;:
Unimplemented in Win32::API::Callback types such as shorts, chars, and
smaller than "machine word size" (32/64bit) numbers can be processed
by specifying N, then masking off the high bytes.
For example, to get a char, specify N, then do C&lt;$numeric_char = $_[2] &amp; 0xFF;&gt;
in your Perl callback sub. To get a short, specify N, then do
C&lt;$numeric_char = $_[2] &amp; 0xFFFF;&gt; in your Perl callback sub.

=back

=head2 FUNCTIONS

=head3 new

    $CallbackObj = Win32::API::Callback-&gt;new( sub { print "hello world";},
                                            'NDF', 'Q', '__cdecl');
    $CallbackObj = Win32::API::Callback-&gt;new( sub { print "hello world";},
                                            $in, $out);

Creates and returns a new Win32::API::Callback object. Calling convention
parameter is optional.  Calling convention parameter has same behaviour as
Win32::API's calling convention parameter. C prototype parsing of Win32::API
is not available with Win32::API::Callback. If the C caller assumes the
callback has vararg parameters, and the platform is 64 bits/x64, in the first 4
parameters, if they are floats or doubles they will be garbage. Note there is
no way to create a Win32::API::Callback callback with a vararg prototype.
A workaround is to put "enough" Ns as the in types, and stop looking at the @_
slices in your Perl sub callback after a certain count. Usually the first
parameter will somehow indicate how many additional stack parameters you are
receiving. The Ns in @_ will eventually become garbage, technically they are
the return address, saved registers, and C stack allocated variables of the
caller. They are effectivly garbage for your vararg callback. All vararg
callbacks on 32 bits must supply a calling convention, and it must be '__cdecl'
or 'WINAPIV'.

=head2 METHODS

=head3 UseMI64

See L&lt;Win32::API/UseMI64&gt;.

=head1 KNOWN ISSUES

=over 4

=item *

Callback is safe across a Win32 psuedo-fork. Callback is not safe across a
Cygwin fork. On Cygwin, in the child process of the fork, a Segmentation Fault
will happen if the Win32::API::Callback callback is is called.

=back

=head1 SEE ALSO

L&lt;Win32::API::Callback::IATPatch&gt;

=head1 AUTHOR

Aldo Calpini ( I&lt;dada@perl.it&gt; ).
Daniel Dragan ( I&lt;bulkdd@cpan.org&gt; ).

=head1 MAINTAINER

Cosimo Streppone ( I&lt;cosimo@cpan.org&gt; ).

=cut
</pre></body></html>