Skip Menu |

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

Report information
The Basics
Id: 24685
Status: resolved
Worked: 40 hours (2401 min)
Priority: 0/
Queue: Win32-API

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

Bug Information
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. > >