From 77c1618d7f81f0439ff5c5de216d75c8937e8560 Mon Sep 17 00:00:00 2001
From: Alexandre Julliard <julliard@winehq.org>
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
@@ -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));
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 <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" );
-- 
GitLab