Skip to content

W
wine-winehq
Commit 77c1618d authored by Alexandre Julliard's avatar Alexandre Julliard
Browse files
Options

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
Hide whitespace changes
Inline Side-by-side
Showing with 87 additions and 129 deletions
programs/winetest/test.pl
View file @ 77c1618d
......@@ -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";
programs/winetest/wine.pm
View file @ 77c1618d
......@@ -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) = @_;
# Begin call
my ($function,$debug,@args) = @_;
my ($funcptr,$ret_type) = @{$prototypes{$function}};
$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 ];
}
}
......
programs/winetest/wine.xs
View file @ 77c1618d
......@@ -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
......@@ -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
# --------------------------------------------------------------------
# Purpose: Allocate a thunk for a wine API callback
......@@ -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));
......
programs/winetest/winetest.c
View file @ 77c1618d
......@@ -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 );
}
/*--------------------------------------------------------------
| See if we can load specified module
--------------------------------------------------------------*/
if (!(hmod = GetModuleHandleA(module)))
{
fprintf( stderr, "GetModuleHandleA(%s) failed\n", module);
exit(1);
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 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" );
......
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