Skip to content
Snippets Groups Projects
Commit 77c1618d authored by Alexandre Julliard's avatar Alexandre Julliard
Browse files

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
No related branches found
No related tags found
No related merge requests found
......@@ -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) = @_;
# 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 ];
}
}
......
......@@ -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 );
}
/*--------------------------------------------------------------
| 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" );
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment