forked from Mirrors/wine-wine
Store the function pointer in the %prototypes hash instead of the
function name to avoid looking it up on every call. Fixed callback thunks to use stdcall calling convention.oldstable
Alexandre Julliard
parent
4ea3c26a7d
commit
77c1618d7f
|
|
@ -16,6 +16,8 @@ wine::declare( "kernel32",
|
|||
GlobalGetAtomNameA => "int",
|
||||
GetCurrentThread => "int",
|
||||
GetExitCodeThread => "int",
|
||||
GetModuleHandleA => "int",
|
||||
GetProcAddress => "int",
|
||||
lstrcatA => "ptr"
|
||||
);
|
||||
|
||||
|
|
@ -59,8 +61,12 @@ assert( $ret == 123 );
|
|||
eval { SetLastError(1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7); };
|
||||
assert( $@ =~ /Too many arguments at/ );
|
||||
|
||||
eval { wine::call_wine_API( "kernel32", "SetLastError", 10, $wine::debug, 0); };
|
||||
my $funcptr = GetProcAddress( GetModuleHandleA("kernel32"), "SetLastError" );
|
||||
assert( $funcptr );
|
||||
eval { wine::call_wine_API( $funcptr, 10, $wine::debug, 0); };
|
||||
assert( $@ =~ /Bad return type 10 at/ );
|
||||
|
||||
eval { foobar(1,2,3); };
|
||||
assert( $@ =~ /Function 'foobar' not declared at/ );
|
||||
|
||||
print "OK\n";
|
||||
|
|
|
|||
|
|
@ -34,6 +34,8 @@ bootstrap wine $VERSION;
|
|||
$wine::err = 0;
|
||||
$wine::debug = 0;
|
||||
|
||||
%loaded_modules = ();
|
||||
|
||||
# --------------------------------------------------------------
|
||||
# | Return-type constants |
|
||||
# | |
|
||||
|
|
@ -85,8 +87,7 @@ sub AUTOLOAD
|
|||
# --------------------------------------------------------------
|
||||
if (defined($prototypes{$func}))
|
||||
{
|
||||
my ($module,$ret_type) = @{$prototypes{$func}};
|
||||
return call( $module, $func, $ret_type, $wine::debug, @_ );
|
||||
return call( $func, $wine::debug, @_ );
|
||||
}
|
||||
die "Function '$func' not declared";
|
||||
} # End AUTOLOAD
|
||||
|
|
@ -98,74 +99,41 @@ sub AUTOLOAD
|
|||
# | -------------------------------------------------------------------- |
|
||||
# | Purpose: Call a wine API function |
|
||||
# | |
|
||||
# | Usage: call MODULE, FUNCTION, RET_TYPE, DEBUG, [ARGS ...] |
|
||||
# | Usage: call FUNCTION, DEBUG, [ARGS ...]
|
||||
# | |
|
||||
# | Returns: value returned by API function called |
|
||||
# ------------------------------------------------------------------------
|
||||
sub call
|
||||
{
|
||||
# ----------------------------------------------
|
||||
# | Locals |
|
||||
# ----------------------------------------------
|
||||
my ($module,$function,$ret_type,$debug,@args) = @_;
|
||||
my ($function,$debug,@args) = @_;
|
||||
my ($funcptr,$ret_type) = @{$prototypes{$function}};
|
||||
|
||||
# Begin call
|
||||
|
||||
$ret_type = $return_types{$ret_type};
|
||||
|
||||
# --------------------------------------------------------------
|
||||
# | Debug |
|
||||
# --------------------------------------------------------------
|
||||
if ($debug)
|
||||
{
|
||||
my $z = "[$module.$function() / " . scalar (@args) . " arg(s)]";
|
||||
print STDERR "=== $z ", ("=" x (75 - length ($z))), "\n";
|
||||
print STDERR " [wine.pm/obj->call()]\n";
|
||||
print STDERR "==== [$function() / " . scalar (@args) . " arg(s)]";
|
||||
for (@args)
|
||||
{
|
||||
print STDERR " ", +(ref () ? ("(" . ${$_} . ")") : "$_"), "\n";
|
||||
print STDERR " ", +(ref () ? ("(" . ${$_} . ")") : "$_");
|
||||
}
|
||||
print STDERR " ====\n";
|
||||
}
|
||||
|
||||
# --------------------------------------------------------------
|
||||
# | Now call call_wine_API(), which will turn around and call |
|
||||
# | the appropriate wine API function. Arguments to |
|
||||
# | call_wine_API() are: |
|
||||
# | |
|
||||
# | module_name |
|
||||
# | function_name |
|
||||
# | return_type |
|
||||
# | debug_flag |
|
||||
# | [args to pass through to wine API function] |
|
||||
# --------------------------------------------------------------
|
||||
my ($err,$r) = call_wine_API
|
||||
(
|
||||
$module,
|
||||
$function,
|
||||
$ret_type,
|
||||
$debug,
|
||||
@args
|
||||
);
|
||||
# Now call call_wine_API(), which will turn around and call
|
||||
# the appropriate wine API function.
|
||||
my ($err,$r) = call_wine_API( $funcptr, $ret_type, $debug, @args );
|
||||
|
||||
# --------------------------------------------------------------
|
||||
# | Debug |
|
||||
# --------------------------------------------------------------
|
||||
if ($debug)
|
||||
{
|
||||
my $z = "[$module.$function()] -> ";
|
||||
my $z = "[$function()] -> ";
|
||||
$z .= defined($r) ? sprintf("[0x%x/%d]", $r, $r) : "[void]";
|
||||
if (defined($err)) { $z .= sprintf " err=%d", $err; }
|
||||
print STDERR "=== $z ", ("=" x (75 - length ($z))), "\n";
|
||||
print STDERR "==== $z ====\n";
|
||||
}
|
||||
|
||||
|
||||
# --------------------------------------------------------------
|
||||
# | Pass the return value back |
|
||||
# --------------------------------------------------------------
|
||||
# Pass the return value back
|
||||
$wine::err = $err;
|
||||
return ($r);
|
||||
|
||||
} # End call
|
||||
}
|
||||
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
|
|
@ -188,7 +156,9 @@ sub declare
|
|||
|
||||
foreach $func (keys %list)
|
||||
{
|
||||
$prototypes{$func} = [ $module, $list{$func} ];
|
||||
my $ptr = get_proc_address( $handle, $func ) or die "Could not find '$func' in '$module'";
|
||||
my $ret_type = $return_types{$list{$func}};
|
||||
$prototypes{$func} = [ $ptr, $ret_type ];
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -29,8 +29,7 @@ enum ret_type
|
|||
|
||||
extern unsigned long perl_call_wine
|
||||
(
|
||||
char *module,
|
||||
char *function,
|
||||
FARPROC function,
|
||||
int n_args,
|
||||
unsigned long *args,
|
||||
unsigned int *last_error,
|
||||
|
|
@ -57,6 +56,7 @@ struct thunk
|
|||
void *func;
|
||||
BYTE leave;
|
||||
BYTE ret;
|
||||
short arg_size;
|
||||
BYTE arg_types[MAX_ARGS];
|
||||
};
|
||||
#pragma pack(4)
|
||||
|
|
@ -96,7 +96,7 @@ static const struct thunk thunk_template =
|
|||
/* pushl (code ref) */ 0x68, NULL,
|
||||
/* call (func) */ 0xe8, NULL,
|
||||
/* leave */ 0xc9,
|
||||
/* ret */ 0xc3,
|
||||
/* ret $arg_size */ 0xc2, 0,
|
||||
/* arg_types */ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }
|
||||
};
|
||||
|
||||
|
|
@ -194,8 +194,7 @@ MODULE = wine PACKAGE = wine
|
|||
# --------------------------------------------------------------------
|
||||
# Purpose: Call perl_call_wine(), which calls a wine API function
|
||||
#
|
||||
# Parameters: module -- module (dll) to get function from
|
||||
# function -- API function to call
|
||||
# Parameters: function -- API function to call
|
||||
# ret_type -- return type
|
||||
# debug -- debug flag
|
||||
# ... -- args to pass to API function
|
||||
|
|
@ -204,13 +203,12 @@ MODULE = wine PACKAGE = wine
|
|||
# value returned by the API function
|
||||
# --------------------------------------------------------------------
|
||||
void
|
||||
call_wine_API(module, function, ret_type, debug, ...)
|
||||
char *module;
|
||||
char *function;
|
||||
call_wine_API(function, ret_type, debug, ...)
|
||||
unsigned long function;
|
||||
int ret_type;
|
||||
int debug;
|
||||
|
||||
PROTOTYPE: $$$$@
|
||||
PROTOTYPE: $$$@
|
||||
|
||||
PPCODE:
|
||||
/*--------------------------------------------------------------
|
||||
|
|
@ -225,7 +223,7 @@ call_wine_API(module, function, ret_type, debug, ...)
|
|||
};
|
||||
|
||||
/* Locals */
|
||||
int n_fixed = 4;
|
||||
int n_fixed = 3;
|
||||
int n_args = (items - n_fixed);
|
||||
struct arg args[MAX_ARGS+1];
|
||||
unsigned long f_args[MAX_ARGS+1];
|
||||
|
|
@ -240,7 +238,7 @@ call_wine_API(module, function, ret_type, debug, ...)
|
|||
/*--------------------------------------------------------------
|
||||
| Prepare function args
|
||||
--------------------------------------------------------------*/
|
||||
if (debug)
|
||||
if (debug > 1)
|
||||
{
|
||||
fprintf( stderr, " [wine.xs/call_wine_API()]\n");
|
||||
}
|
||||
|
|
@ -266,7 +264,7 @@ call_wine_API(module, function, ret_type, debug, ...)
|
|||
{
|
||||
args[i].ival = SvIV (sv);
|
||||
f_args[i] = (unsigned long) &(args[i].ival);
|
||||
if (debug)
|
||||
if (debug > 1)
|
||||
{
|
||||
fprintf( stderr, " [RV->IV] 0x%lx\n", f_args[i]);
|
||||
}
|
||||
|
|
@ -279,7 +277,7 @@ call_wine_API(module, function, ret_type, debug, ...)
|
|||
{
|
||||
args[i].ival = (unsigned long) SvNV (sv);
|
||||
f_args[i] = (unsigned long) &(args[i].ival);
|
||||
if (debug)
|
||||
if (debug > 1)
|
||||
{
|
||||
fprintf( stderr, " [RV->NV] 0x%lx\n", f_args[i]);
|
||||
}
|
||||
|
|
@ -291,7 +289,7 @@ call_wine_API(module, function, ret_type, debug, ...)
|
|||
else if (SvPOK (sv))
|
||||
{
|
||||
f_args[i] = (unsigned long) ((char *) SvPV (sv, PL_na));
|
||||
if (debug)
|
||||
if (debug > 1)
|
||||
{
|
||||
fprintf( stderr, " [RV->PV] 0x%lx\n", f_args[i]);
|
||||
}
|
||||
|
|
@ -310,7 +308,7 @@ call_wine_API(module, function, ret_type, debug, ...)
|
|||
if (SvIOK (sv))
|
||||
{
|
||||
f_args[i] = (unsigned long) SvIV (sv);
|
||||
if (debug)
|
||||
if (debug > 1)
|
||||
{
|
||||
fprintf( stderr, " [IV] %ld (0x%lx)\n", f_args[i], f_args[i]);
|
||||
}
|
||||
|
|
@ -322,7 +320,7 @@ call_wine_API(module, function, ret_type, debug, ...)
|
|||
else if (SvNOK (sv))
|
||||
{
|
||||
f_args[i] = (unsigned long) SvNV (sv);
|
||||
if (debug)
|
||||
if (debug > 1)
|
||||
{
|
||||
fprintf( stderr, " [NV] %ld (0x%lx)\n", f_args[i], f_args[i]);
|
||||
}
|
||||
|
|
@ -340,7 +338,7 @@ call_wine_API(module, function, ret_type, debug, ...)
|
|||
((char *)(args[i].pval))[n] = 0; /* add final NULL */
|
||||
((char *)(args[i].pval))[n+1] = 0; /* and another one for Unicode too */
|
||||
f_args[i] = (unsigned long) args[i].pval;
|
||||
if (debug)
|
||||
if (debug > 1)
|
||||
{
|
||||
fprintf( stderr, " [PV] 0x%lx\n", f_args[i]);
|
||||
}
|
||||
|
|
@ -353,15 +351,7 @@ call_wine_API(module, function, ret_type, debug, ...)
|
|||
/*--------------------------------------------------------------
|
||||
| Here we go
|
||||
--------------------------------------------------------------*/
|
||||
r = perl_call_wine
|
||||
(
|
||||
module,
|
||||
function,
|
||||
n_args,
|
||||
f_args,
|
||||
&last_error,
|
||||
debug
|
||||
);
|
||||
r = perl_call_wine( (FARPROC)function, n_args, f_args, &last_error, debug );
|
||||
|
||||
/*--------------------------------------------------------------
|
||||
| Handle modified parameter values
|
||||
|
|
@ -438,6 +428,24 @@ load_library(module)
|
|||
XSRETURN(1);
|
||||
|
||||
|
||||
# --------------------------------------------------------------------
|
||||
# Function: get_proc_address
|
||||
# --------------------------------------------------------------------
|
||||
# Purpose: Retrive a function address
|
||||
#
|
||||
# Parameters: module -- module handle
|
||||
# --------------------------------------------------------------------
|
||||
void
|
||||
get_proc_address(module,func)
|
||||
unsigned long module;
|
||||
char *func;
|
||||
PROTOTYPE: $$
|
||||
|
||||
PPCODE:
|
||||
ST(0) = newSViv( (I32)GetProcAddress( (HMODULE)module, func ) );
|
||||
XSRETURN(1);
|
||||
|
||||
|
||||
# --------------------------------------------------------------------
|
||||
# Function: alloc_thunk
|
||||
# --------------------------------------------------------------------
|
||||
|
|
@ -504,6 +512,7 @@ alloc_thunk(...)
|
|||
thunk->nb_args = items - 1;
|
||||
thunk->code_ref = SvRV (ST (0));
|
||||
thunk->func = (void *)((char *) callback_bridge - (char *) &thunk->leave);
|
||||
thunk->arg_size = thunk->nb_args * sizeof(int);
|
||||
|
||||
/* Stash callback arg types */
|
||||
for (i = 1; i < items; i++) thunk->arg_types[i - 1] = SvIV (ST (i));
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
* Perl interpreter for running Wine tests
|
||||
*/
|
||||
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
|
||||
#include "windef.h"
|
||||
|
|
@ -10,6 +11,8 @@
|
|||
#include <EXTERN.h>
|
||||
#include <perl.h>
|
||||
|
||||
static FARPROC pGetLastError;
|
||||
|
||||
/*----------------------------------------------------------------------
|
||||
| Function: call_wine_func |
|
||||
| -------------------------------------------------------------------- |
|
||||
|
|
@ -82,74 +85,41 @@ static unsigned long call_wine_func
|
|||
|
||||
|
||||
/*----------------------------------------------------------------------
|
||||
| Function: perl_call_wine |
|
||||
| -------------------------------------------------------------------- |
|
||||
| Purpose: Fetch and call a wine API function from a library |
|
||||
| |
|
||||
| Parameters: |
|
||||
| |
|
||||
| module -- module in function (ostensibly) resides |
|
||||
| function -- function name |
|
||||
| n_args -- number of args |
|
||||
| args -- args |
|
||||
| Function: perl_call_wine
|
||||
| --------------------------------------------------------------------
|
||||
| Purpose: Fetch and call a wine API function from a library
|
||||
|
|
||||
| Parameters:
|
||||
|
|
||||
| proc -- function address
|
||||
| n_args -- number of args
|
||||
| args -- args
|
||||
| last_error -- returns the last error code
|
||||
| debug -- debug flag |
|
||||
| |
|
||||
| Returns: Return value from API function called |
|
||||
| debug -- debug flag
|
||||
|
|
||||
| Returns: Return value from API function called
|
||||
----------------------------------------------------------------------*/
|
||||
unsigned long perl_call_wine
|
||||
(
|
||||
char *module,
|
||||
char *function,
|
||||
FARPROC proc,
|
||||
int n_args,
|
||||
unsigned long *args,
|
||||
unsigned int *last_error,
|
||||
int debug
|
||||
)
|
||||
{
|
||||
/* Locals */
|
||||
HMODULE hmod;
|
||||
FARPROC proc;
|
||||
int i;
|
||||
unsigned long ret, error, old_error;
|
||||
unsigned long ret;
|
||||
DWORD error, old_error;
|
||||
|
||||
static FARPROC pGetLastError;
|
||||
|
||||
/*--------------------------------------------------------------
|
||||
| Debug
|
||||
--------------------------------------------------------------*/
|
||||
if (debug)
|
||||
{
|
||||
fprintf(stderr," perl_call_wine(");
|
||||
for (i = 0; (i < n_args); i++)
|
||||
fprintf( stderr, "0x%lx%c", args[i], (i < n_args-1) ? ',' : ')' );
|
||||
fputc( '\n', stderr );
|
||||
int i;
|
||||
fprintf(stderr," perl_call_wine(func=%p", proc);
|
||||
for (i = 0; i < n_args; i++) fprintf( stderr, ",0x%lx", args[i] );
|
||||
fprintf( stderr, ")\n" );
|
||||
}
|
||||
|
||||
/*--------------------------------------------------------------
|
||||
| See if we can load specified module
|
||||
--------------------------------------------------------------*/
|
||||
if (!(hmod = GetModuleHandleA(module)))
|
||||
{
|
||||
fprintf( stderr, "GetModuleHandleA(%s) failed\n", module);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
/*--------------------------------------------------------------
|
||||
| See if we can get address of specified function from it
|
||||
--------------------------------------------------------------*/
|
||||
if ((proc = GetProcAddress (hmod, function)) == NULL)
|
||||
{
|
||||
fprintf (stderr, " GetProcAddress(%s.%s) failed\n", module, function);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
/*--------------------------------------------------------------
|
||||
| Righty then; call the function ...
|
||||
--------------------------------------------------------------*/
|
||||
if (!pGetLastError)
|
||||
pGetLastError = GetProcAddress( GetModuleHandleA("kernel32"), "GetLastError" );
|
||||
|
||||
/* special case to allow testing GetLastError without messing up the last error code */
|
||||
if (proc == pGetLastError)
|
||||
ret = call_wine_func (proc, n_args, args);
|
||||
else
|
||||
|
|
@ -180,6 +150,9 @@ int main( int argc, char **argv, char **envp )
|
|||
|
||||
envp = environ; /* envp is not valid (yet) in Winelib */
|
||||
|
||||
pGetLastError = GetProcAddress( GetModuleHandleA("kernel32"), "GetLastError" );
|
||||
assert( pGetLastError );
|
||||
|
||||
if (!(perl = perl_alloc ()))
|
||||
{
|
||||
fprintf( stderr, "Could not allocate perl interpreter\n" );
|
||||
|
|
|
|||
Loading…
Reference in New Issue