From 77c1618d7f81f0439ff5c5de216d75c8937e8560 Mon Sep 17 00:00:00 2001 From: Alexandre Julliard Date: Mon, 9 Apr 2001 18:49:14 +0000 Subject: [PATCH] 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. --- programs/winetest/test.pl | 8 ++++- programs/winetest/wine.pm | 68 +++++++++++--------------------------- programs/winetest/wine.xs | 61 +++++++++++++++++++--------------- programs/winetest/winetest.c | 79 +++++++++++++++----------------------------- 4 files changed, 87 insertions(+), 129 deletions(-) diff --git a/programs/winetest/test.pl b/programs/winetest/test.pl index 89cce691b83..2b67384d74f 100644 --- a/programs/winetest/test.pl +++ b/programs/winetest/test.pl @@ -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"; diff --git a/programs/winetest/wine.pm b/programs/winetest/wine.pm index 9845e6c9179..3b13c2ea8cd 100644 --- a/programs/winetest/wine.pm +++ b/programs/winetest/wine.pm @@ -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 ]; } } diff --git a/programs/winetest/wine.xs b/programs/winetest/wine.xs index df5663dffc5..fcb2345ed71 100644 --- a/programs/winetest/wine.xs +++ b/programs/winetest/wine.xs @@ -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)); diff --git a/programs/winetest/winetest.c b/programs/winetest/winetest.c index 8e7b233531f..0543f0b58c8 100644 --- a/programs/winetest/winetest.c +++ b/programs/winetest/winetest.c @@ -2,6 +2,7 @@ * Perl interpreter for running Wine tests */ +#include #include #include "windef.h" @@ -10,6 +11,8 @@ #include #include +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" ); -- 2.11.4.GIT