This queue is for tickets about the Win32-API CPAN distribution.

Report information
The Basics
Id:
24685
Status:
resolved
Worked:
40.02 hours (2,401 minutes)
Users:
COSIMO: 80.02 hours (4,801 minutes)
Priority:
Low/Low
Queue:

People
Owner:
cosimo [...] cpan.org
Requestors:
cosimo [...] cpan.org
Cc:
MWHAYCRAFT+win32api [...] gmail.com
AdminCc:
itsme [...] xs4all.nl

BugTracker
Severity:
Wishlist
Broken in:
(no value)
Fixed in:
(no value)



CC: MWHAYCRAFT+win32api@gmail.com
Subject: Add support for __cdecl function call
Extracted from the email by Matthew Haycraft: ----8<----------- Greetings Cosimo, I recently tried to use Win32::API to call a __cdecl function from a dll. That's when I realized that this modules only supports __stdcall functions. A quick search and I found: http://cpanratings.perl.org/dist/Win32-API which pointed me to: http://www.xs4all.nl/~itsme/projects/perl/ Which has a modified version of 0.41 that allows an additional parameter to the new method to specify __stdcall or __cdecl calling method. This appears to be the difference between my perl script crashing and successfully calling __cdecl functions from a third party dll. Is is possible that you could incorporate functionality like this? The author of the branch above also mentioned a possibility of adding a feature to catch calling a method by the wrong calling protocol. Any interest in adding such a feature? TIA for a reponce, Matthew Haycraft
Subject: Win32-API-0.41-wj2.patch
diff -durw Win32-API-0.41/API.pm Win32-API-0.41-wj/API.pm --- Win32-API-0.41/API.pm 2003-03-10 17:15:44.000000000 +0100 +++ Win32-API-0.41-wj/API.pm 2004-03-24 14:29:44.755429500 +0100 @@ -52,7 +52,7 @@ # PUBLIC METHODS # sub new { - my($class, $dll, $proc, $in, $out) = @_; + my($class, $dll, $proc, $in, $out, $callconvention) = @_; my $hdll; my $self = {}; @@ -74,7 +74,7 @@ #### determine if we have a prototype or not if( (not defined $in) and (not defined $out) ) { - ($proc, $self->{in}, $self->{intypes}, $self->{out}) = parse_prototype( $proc ); + ($proc, $self->{in}, $self->{intypes}, $self->{out}, $self->{cdecl}) = parse_prototype( $proc ); return undef unless $proc; $self->{proto} = 1; } else { @@ -90,6 +90,7 @@ } } $self->{out} = type_to_num($out); + $self->{cdecl} = calltype_to_num($callconvention); } #### first try to import the function of given name... @@ -125,8 +126,8 @@ } sub Import { - my($class, $dll, $proc, $in, $out) = @_; - $Imported{"$dll:$proc"} = Win32::API->new($dll, $proc, $in, $out) or return 0; + my($class, $dll, $proc, $in, $out, $callconvention) = @_; + $Imported{"$dll:$proc"} = Win32::API->new($dll, $proc, $in, $out, $callconvention) or return 0; my $P = (caller)[0]; eval qq( sub ${P}::$Imported{"$dll:$proc"}->{procname} { \$Win32::API::Imported{"$dll:$proc"}->Call(\@_); } @@ -152,6 +153,20 @@ } } +sub calltype_to_num { + my $type = shift; + + if (!$type || $type eq "__stdcall") { + return 0; + } + elsif ($type eq "_cdecl") { + return 1; + } + else { + warn "unknown calling convention: '$type'"; + return 0; + } +} sub type_to_num { my $type = shift; my $out = shift; @@ -209,10 +224,11 @@ my @in_params = (); my @in_types = (); - if($proto =~ /^\s*(\S+)\s+(\S+)\s*\(([^\)]*)\)/) { + if($proto =~ /^\s*(\S+)(?:\s+(\w+))?\s+(\S+)\s*\(([^\)]*)\)/) { my $ret = $1; - my $proc = $2; - my $params = $3; + my $callconvention= $2; + my $proc = $3; + my $params = $4; $params =~ s/^\s+//; $params =~ s/\s+$//; @@ -261,17 +277,17 @@ $ret, Win32::API::Type->packing( $ret ), type_to_num('P'); - return ( $proc, \@in_params, \@in_types, type_to_num('P') ); + return ( $proc, \@in_params, \@in_types, type_to_num('P'), calltype_to_num($callconvention) ); } else { DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n", $ret, Win32::API::Type->packing( $ret ), type_to_num( Win32::API::Type->packing( $ret ) ); - return ( $proc, \@in_params, \@in_types, type_to_num(Win32::API::Type->packing($ret)) ); + return ( $proc, \@in_params, \@in_types, type_to_num(Win32::API::Type->packing($ret)), calltype_to_num($callconvention) ); } } else { warn "Win32::API::parse_prototype: WARNING unknown output parameter type '$ret'"; - return ( $proc, \@in_params, \@in_types, type_to_num('I') ); + return ( $proc, \@in_params, \@in_types, type_to_num('I'), calltype_to_num($callconvention) ); } } else { @@ -441,6 +457,10 @@ =item 4. The type of the value returned by the function. +=item 5. +And optionally you can specify the calling convention, this defaults to +'__stdcall', alternatively you can specify '_cdecl'. + =back To better explain their meaning, let's suppose that we diff -durw Win32-API-0.41/API.xs Win32-API-0.41-wj/API.xs --- Win32-API-0.41/API.xs 2003-03-07 12:19:16.000000000 +0100 +++ Win32-API-0.41-wj/API.xs 2004-03-24 13:00:05.899898400 +0100 @@ -235,6 +235,7 @@ SV** obj_out; SV** obj_intypes; SV** in_type; + SV** call_type; AV* inlist; AV* intypes; @@ -244,6 +245,8 @@ SV** code; int nin, tin, tout, i; + BOOL c_call; + int words_pushed; BOOL has_proto = FALSE; obj = (HV*) SvRV(api); @@ -266,6 +269,9 @@ nin = av_len(inlist); tout = SvIV(*obj_out); + call_type = hv_fetch(obj, "cdecl", 5, FALSE); + c_call = call_type ? SvTRUE(*call_type) : FALSE; + if(items-1 != nin+1) { croak("Wrong number of parameters: expected %d, got %d.\n", nin+1, items-1); } @@ -466,6 +472,7 @@ } } + words_pushed = 0; /* #### PUSH THE PARAMETER ON THE (ASSEMBLER) STACK #### */ for(i = nin; i >= 0; i--) { switch(params[i].t) { @@ -479,6 +486,7 @@ mov eax, dword ptr pParam push eax } + words_pushed++; break; case T_POINTERPOINTER: ppParam = params[i].b; @@ -489,6 +497,7 @@ mov eax, dword ptr ppParam push eax } + words_pushed++; break; case T_NUMBER: case T_CHAR: @@ -500,6 +509,7 @@ mov eax, lParam push eax } + words_pushed++; break; case T_FLOAT: fParam = params[i].f; @@ -510,6 +520,7 @@ mov eax, fParam push eax } + words_pushed++; break; case T_DOUBLE: dParam = params[i].d; @@ -522,6 +533,8 @@ mov eax, dword ptr [dParam] push eax } + words_pushed++; + words_pushed++; break; case T_CODE: lParam = params[i].l; @@ -532,6 +545,7 @@ mov eax, lParam push eax } + words_pushed++; break; } } @@ -606,6 +620,14 @@ ApiFunctionVoid(); break; } + if (c_call) { + // cleanup stack for _cdecl type functions. + _asm { + mov eax, dword ptr words_pushed + shl eax, 2 + add esp, eax + } + } /* #### THIRD PASS: postfix pointers/structures #### */ for(i = 0; i <= nin; i++) { if(params[i].t == T_POINTER && has_proto) { diff -durw Win32-API-0.41/API_test_dll/API_test.cpp Win32-API-0.41-wj/API_test_dll/API_test.cpp --- Win32-API-0.41/API_test_dll/API_test.cpp 2002-10-24 13:36:44.000000000 +0200 +++ Win32-API-0.41-wj/API_test_dll/API_test.cpp 2004-03-24 15:08:55.692929500 +0100 @@ -130,3 +130,17 @@ printf("do_callback: returning %ld\n", r); return r; } \ No newline at end of file + +API_TEST_API int __stdcall int_to_str(int a, char *buf, int buflen) +{ + return _snprintf(buf, buflen, "%d", a); +} + +API_TEST_API int _cdecl c_call_sum_int(int a, int b) { + return a + b; +} + +API_TEST_API int _cdecl c_call_sum_int_dbl(int a, double b) { + return a + b; +} + diff -durw Win32-API-0.41/API_test_dll/API_test.def Win32-API-0.41-wj/API_test_dll/API_test.def --- Win32-API-0.41/API_test_dll/API_test.def 2002-10-24 11:40:35.000000000 +0200 +++ Win32-API-0.41-wj/API_test_dll/API_test.def 2004-03-24 15:09:43.052304500 +0100 @@ -11,3 +11,6 @@ dump_struct mangle_simple_struct do_callback + int_to_str + c_call_sum_int + c_call_sum_int_dbl diff -durw Win32-API-0.41/API_test_dll/API_test.h Win32-API-0.41-wj/API_test_dll/API_test.h --- Win32-API-0.41/API_test_dll/API_test.h 2002-10-24 13:36:32.000000000 +0200 +++ Win32-API-0.41-wj/API_test_dll/API_test.h 2004-03-24 15:09:44.927304500 +0100 @@ -33,3 +33,8 @@ API_TEST_API void __stdcall dump_struct(simple_struct *x); API_TEST_API int __stdcall mangle_simple_struct(simple_struct *x); +API_TEST_API int __stdcall int_to_str(int a, char *buf, int buflen); + +API_TEST_API int c_call_sum_int(int a, int b); +API_TEST_API int c_call_sum_int_dbl(int a, double b); + diff -durw Win32-API-0.41/Callback/Callback.xs Win32-API-0.41-wj/Callback/Callback.xs --- Win32-API-0.41/Callback/Callback.xs 2003-03-07 12:10:38.000000000 +0100 +++ Win32-API-0.41-wj/Callback/Callback.xs 2004-03-24 14:09:04.567929500 +0100 @@ -481,7 +481,9 @@ done = TRUE; } - if(cursor >= (unsigned char *) PerformCallback) { + // this test only works if the compiler does not reorder the functions in the output. + if((unsigned char *) CallbackTemplate < (unsigned char *) PerformCallback + && cursor >= (unsigned char *) PerformCallback) { checkpoint_DONE = distance; done = TRUE; } @@ -636,7 +638,7 @@ } else if(*(cursor+0) == 0xC7 && *(cursor+1) == 0x45 - && *(cursor+2) == 0xEC + && (*(cursor+2) == 0xFC || *(cursor+2) == 0xEC) && *((int*)(cursor+3)) == 0xC0DE0003 ) { #ifdef WIN32_API_DEBUG @@ -686,7 +688,7 @@ } else if(*(cursor+0) == 0xC7 && *(cursor+1) == 0x45 - && *(cursor+2) == 0xEC + && (*(cursor+2) == 0xFC || *(cursor+2) == 0xEC) && *((int*)(cursor+3)) == 0xC0DE0003 ) { #ifdef WIN32_API_DEBUG @@ -737,7 +739,7 @@ } else if(*(cursor+0) == 0xC7 && *(cursor+1) == 0x45 - && *(cursor+2) == 0xEC + && (*(cursor+2) == 0xFC || *(cursor+2) == 0xEC) && *((int*)(cursor+3)) == 0xC0DE0003 ) { #ifdef WIN32_API_DEBUG diff -durw Win32-API-0.41/t/00_API.t Win32-API-0.41-wj/t/00_API.t --- Win32-API-0.41/t/00_API.t 2003-03-10 17:36:58.000000000 +0100 +++ Win32-API-0.41-wj/t/00_API.t 2004-03-24 15:11:48.411679500 +0100 @@ -16,7 +16,7 @@ ######################### We start with some black magic to print on failure. -BEGIN { $| = 1; print "1..11\n"; } +BEGIN { $| = 1; print "1..16\n"; } END {print "not ok 1\n" unless $loaded;} use Win32::API; $loaded = 1; @@ -113,3 +113,36 @@ my $char = "a"; print "" . ($function->Call($string, $char) eq "aph" ? "" : "not ") . "ok $t\n"; $t++; + +#### 12: sum integers and double via _cdecl function +$function = new Win32::API($test_dll, 'int _cdecl c_call_sum_int(int a, int b)'); +defined($function) or die "not ok $t\t$^E\n"; +print "" . ($function->Call(2, 3) == 5 ? "" : "not ") . "ok $t\n"; +$t++; + +#### 13: sum integers and double via _cdecl function +$function = new Win32::API($test_dll, 'int _cdecl c_call_sum_int_dbl(int a, double b)'); +defined($function) or die "not ok $t\t$^E\n"; +print "" . ($function->Call(2, 3) == 5 ? "" : "not ") . "ok $t\n"; +$t++; + +#### 14: sum integers and double via _cdecl function, no prototype +$function = new Win32::API($test_dll, 'c_call_sum_int', 'II', 'I', '_cdecl'); +defined($function) or die "not ok $t\t$^E\n"; +print "" . ($function->Call(2, 3) == 5 ? "" : "not ") . "ok $t\n"; +$t++; + +#### 15: sum 2 integers, no prototype +$function = new Win32::API($test_dll, 'sum_integers', 'II', 'I'); +defined($function) or die "not ok $t\t$^E\n"; +print "" . ($function->Call(2, 3) == 5 ? "" : "not ") . "ok $t\n"; +$t++; + +#### 16: convert integer to string +$function = new Win32::API($test_dll, 'int_to_str', 'IPI', 'I'); +defined($function) or die "not ok $t\t$^E\n"; +my $buf= " " x 16; +print "" . ( ($function->Call(12345, $buf, length($buf)) == 5 && $buf =~ /^12345\x00 +$/ ) ? "" : "not ") . "ok $t\n"; +$t++; + +
RT-Send-CC: Aldo Calpini <dada@perl.it>
I'm trying to integrate the patch into Win32::API 0.46 distribution. But I'm stuck on this little inlined asm code. Can anyone teach me how to write the __GNUC__ equivalent? + if (c_call) { + // cleanup stack for _cdecl type functions. + _asm { + mov eax, dword ptr words_pushed + shl eax, 2 + add esp, eax + } + }
From: itsme@xs4all.nl
On Wed Feb 28 07:56:45 2007, COSIMO wrote:
Show quoted text
> I'm trying to integrate the patch into Win32::API 0.46 distribution. > But I'm stuck on this little inlined asm code. > Can anyone teach me how to write the __GNUC__ equivalent? > > + if (c_call) { > + // cleanup stack for _cdecl type functions. > + _asm { > + mov eax, dword ptr words_pushed > + shl eax, 2 > + add esp, eax > + } > + }
I attached a file with examples how to create gcc inline asm. willem
// this is a little example file showing how MS asm relates to GCC asm // typedef double ApiDouble(void); void tst() { int words_pushed; char *pParam; double dParam; ApiDouble *ApiFunctionDouble; double dReturn; #ifdef __GNUC__ asm ( "movl %0, %%eax\n" "pushl %%eax\n" : /* no output */ : "m" (pParam) /* input */ : "%eax" /* modified registers */ ); asm ( "movl %1, %%eax\n" "pushl %%eax\n" "movl %0, %%eax\n" "pushl %%eax\n" : /* no output */ : "m" (dParam), /* input */ "m" (((long*)&dParam)[1]) : "%eax" /* modified registers */ ); asm ( "call *%0\n" "fstp %1\n" : /* no output */ : "m" (ApiFunctionDouble), /* input */ "m" (dReturn) : "%eax", "%ebx", "%ecx", "%edx" /* modified registers */ ); asm ( "movl %0, %%eax\n" "shll $2, %%eax\n" "addl %%eax, %%esp\n" : /* no output */ : "m" (words_pushed) /* input */ : "%eax" /* modified registers */ ); #else _asm { mov eax, dword ptr pParam push eax } _asm { mov eax, dword ptr [dParam + 4] push eax mov eax, dword ptr [dParam] push eax } _asm { call dword ptr [ApiFunctionDouble] fstp qword ptr [dReturn] } _asm { mov eax, dword ptr words_pushed shl eax, 2 add esp, eax } #endif }
Added support for cdecl function calls in Win32::API v0.48. Soon at your local CPAN mirror.
Added support for cdecl function calls in Win32::API v0.48. Soon at your local CPAN mirror.
Subject: Re: [rt.cpan.org #24685] Add support for __cdecl function call
Date: Wed, 20 Feb 2008 23:04:23 -0500
To: bug-Win32-API@rt.cpan.org
From: "Matthew Haycraft" <MWHAYCRAFT+win32api@gmail.com>
Great!  Thank you for merging this feature in!

On Wed, Feb 20, 2008 at 4:04 PM, Cosimo Streppone via RT <bug-Win32-API@rt.cpan.org> wrote:
Show quoted text

<URL: http://rt.cpan.org/Ticket/Display.html?id=24685 >

Added support for cdecl function calls in Win32::API v0.48.
Soon at your local CPAN mirror.




This service runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.