Commit 77c1618d authored by Alexandre Julliard's avatar Alexandre Julliard

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