git.oblomov.eu Git - wine/blob - programs/winetest/wine.xs

   1 /* -*-C-*-
   2  * Perl gateway to wine API calls
   3  *
   4  * Copyright 2001 John F Sturtz for Codeweavers
   5  *
   6  * This library is free software; you can redistribute it and/or
   7  * modify it under the terms of the GNU Lesser General Public
   8  * License as published by the Free Software Foundation; either
   9  * version 2.1 of the License, or (at your option) any later version.
  10  *
  11  * This library is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14  * Lesser General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU Lesser General Public
  17  * License along with this library; if not, write to the Free Software
  18  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19  */
  20
  21 #include "config.h"
  22
  23 #include <stdlib.h>
  24 #include <string.h>
  25
  26 #include "windef.h"
  27
  28 #include <EXTERN.h>
  29 #include <perl.h>
  30 #include <XSUB.h>
  31
  32 #undef WORD
  33 #include "winbase.h"
  34
  35 /* API return type constants */
  36 enum ret_type
  37 {
  38     RET_VOID = 0,
  39     RET_INT  = 1,
  40     RET_WORD = 2,
  41     RET_PTR  = 3,
  42     RET_STR  = 4
  43 };
  44
  45 /* max arguments for a function call */
  46 #define MAX_ARGS    16
  47
  48 extern unsigned long perl_call_wine
  49 (
  50     FARPROC        function,
  51     int            n_args,
  52     unsigned long  *args,
  53     unsigned int   *last_error,
  54     int            debug
  55 );
  56
  57 /* Thunk type definitions */
  58
  59 #ifdef __i386__
  60 #pragma pack(1)
  61 struct thunk
  62 {
  63     BYTE    pushl;
  64     BYTE    movl[2];
  65     BYTE    leal_args[3];
  66     BYTE    pushl_args;
  67     BYTE    pushl_addr;
  68     BYTE   *args_ptr;
  69     BYTE    pushl_nb_args;
  70     BYTE    nb_args;
  71     BYTE    pushl_ref;
  72     SV     *code_ref;
  73     BYTE    call;
  74     void   *func;
  75     BYTE    leave;
  76     BYTE    ret;
  77     short   arg_size;
  78     BYTE    arg_types[MAX_ARGS];
  79 };
  80 #pragma pack(4)
  81 #else
  82 #error You must implement the callback thunk for your CPU
  83 #endif
  84
  85 /*--------------------------------------------------------------
  86 | This contains most of the machine instructions necessary to
  87 | implement the thunk.  All the thunk does is turn around and
  88 | call function callback_bridge(), which is defined in
  89 | winetest.c.
  90 |
  91 | The data from this static thunk can just be copied directly
  92 | into the thunk allocated dynamically below.  That fills in
  93 | most of it, but a couple values need to be filled in after
  94 | the allocation, at run time:
  95 |
  96 |     1) The pointer to the thunk's data area, which we
  97 |        don't know yet, because we haven't allocated it
  98 |        yet ...
  99 |
 100 |     2) The address of the function to call.  We know the
 101 |        address of the function [callback_bridge()], but
 102 |        the value filled into the thunk is an address
 103 |        relative to the thunk itself, so we can't fill it
 104 |        in until we've allocated the actual thunk.
 105 --------------------------------------------------------------*/
 106 static const struct thunk thunk_template =
 107 {
 108     /* pushl %ebp        */  0x55,
 109     /* movl %esp,%ebp    */  { 0x89, 0xe5 },
 110     /* leal 8(%ebp),%edx */  { 0x8d, 0x55, 0x08 },
 111     /* pushl %edx        */  0x52,
 112     /* pushl (data addr) */  0x68, NULL,
 113     /* pushl (nb_args)   */  0x6a, 0,
 114     /* pushl (code ref)  */  0x68, NULL,
 115     /* call (func)       */  0xe8, NULL,
 116     /* leave             */  0xc9,
 117     /* ret $arg_size     */  0xc2, 0,
 118     /* arg_types         */  { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }
 119 };
 120
 121
 122 /*----------------------------------------------------------------------
 123 | Function:    convert_value                                           |
 124 | -------------------------------------------------------------------- |
 125 | Purpose:     Convert a C value to a Perl value                       |
 126 |                                                                      |
 127 | Parameters:  type -- constant specifying type of value               |
 128 |              val  -- value to convert                                |
 129 |                                                                      |
 130 | Returns:     Perl SV *                                               |
 131 ----------------------------------------------------------------------*/
 132 static SV *convert_value( enum ret_type type, unsigned long val )
 133 {
 134     switch (type)
 135     {
 136         case RET_VOID: return &PL_sv_undef;
 137         case RET_INT:  return sv_2mortal( newSViv ((int) val ));
 138         case RET_WORD: return sv_2mortal( newSViv ((int) val & 0xffff ));
 139         case RET_PTR:  return sv_2mortal( newSViv ((int) val ));
 140         case RET_STR:  return sv_2mortal( newSVpv ((char *) val, 0 ));
 141     }
 142     croak ("Bad return type %d", type);
 143     return &PL_sv_undef;
 144 }
 145
 146
 147 /*----------------------------------------------------------------------
 148 | Function:    callback_bridge                                         |
 149 | -------------------------------------------------------------------- |
 150 | Purpose:     Central pass-through point for Wine API callbacks       |
 151 |                                                                      |
 152 |     Wine API callback thunks are set up so that they call this       |
 153 |     function, which turns around and calls the user's declared       |
 154 |     Perl callback sub.                                               |
 155 |                                                                      |
 156 | Parameters:  data -- pointer to thunk data area                      |
 157 |              args -- array of args passed from Wine API to callback  |
 158 |                                                                      |
 159 | Returns:     Whatever the Perl sub returns                           |
 160 ----------------------------------------------------------------------*/
 161 static int callback_bridge( SV *callback_ref, int nb_args, BYTE arg_types[], unsigned long args[] )
 162 {
 163     /* Locals */
 164     int  i, n;
 165     SV   *sv;
 166
 167     int  r = 0;
 168
 169     /* Perl/C interface voodoo */
 170     dSP;
 171     ENTER;
 172     SAVETMPS;
 173     PUSHMARK(sp);
 174
 175     /* Push args on stack, according to type */
 176     for (i = 0; i < nb_args; i++)
 177     {
 178         sv = convert_value (arg_types[i], args[i]);
 179         PUSHs (sv);
 180     }
 181     PUTBACK;
 182
 183     /* Call Perl sub */
 184     n = perl_call_sv (callback_ref, G_SCALAR);
 185
 186     /* Nab return value */
 187     SPAGAIN;
 188     if (n == 1)
 189     {
 190         r = POPi;
 191     }
 192     PUTBACK;
 193     FREETMPS;
 194     LEAVE;
 195
 196     /* [todo]  Pass through Perl sub return value */
 197     return (r);
 198 }
 199
 200
 201 /*----------------------------------------------------------------------
 202 | XS module                                                            |
 203 |                                                                      |
 204 |                                                                      |
 205 ----------------------------------------------------------------------*/
 206 MODULE = wine     PACKAGE = wine
 207
 208
 209     # --------------------------------------------------------------------
 210     # Function:    call_wine_API
 211     # --------------------------------------------------------------------
 212     # Purpose:     Call perl_call_wine(), which calls a wine API function
 213     #
 214     # Parameters:  function -- API function to call
 215     #              ret_type -- return type
 216     #              debug    -- debug flag
 217     #              ...      -- args to pass to API function
 218     #
 219     # Returns:     list containing 2 elements: the last error code and the
 220     #              value returned by the API function
 221     # --------------------------------------------------------------------
 222 void
 223 call_wine_API(function, ret_type, debug, ...)
 224     unsigned long function;
 225     int   ret_type;
 226     int   debug;
 227
 228     PROTOTYPE: $$$@
 229
 230     PPCODE:
 231     /*--------------------------------------------------------------
 232     | Begin call_wine_API
 233     --------------------------------------------------------------*/
 234
 235     /* Local types */
 236     struct arg
 237     {
 238         int           ival;
 239         void          *pval;
 240     };
 241
 242     /* Locals */
 243     int            n_fixed = 3;
 244     int            n_args = (items - n_fixed);
 245     struct arg     args[MAX_ARGS+1];
 246     unsigned long  f_args[MAX_ARGS+1];
 247     unsigned int   i, n;
 248     unsigned int   last_error = 0xdeadbeef;
 249     char           *p;
 250     SV             *sv;
 251     unsigned long  r;
 252
 253     if (n_args > MAX_ARGS) croak("Too many arguments");
 254
 255     /*--------------------------------------------------------------
 256     | Prepare function args
 257     --------------------------------------------------------------*/
 258     if (debug > 1)
 259     {
 260         fprintf( stderr, "    [wine.xs/call_wine_API()]\n");
 261     }
 262     for (i = 0; (i < n_args); i++)
 263     {
 264         sv = ST (n_fixed + i);
 265         args[i].pval = NULL;
 266
 267         if (! SvOK (sv))
 268             continue;
 269
 270         /*--------------------------------------------------------------
 271         | Ref
 272         --------------------------------------------------------------*/
 273         if (SvROK (sv))
 274         {
 275             sv = SvRV (sv);
 276
 277             /*--------------------------------------------------------------
 278             | Integer ref -- pass address of value
 279             --------------------------------------------------------------*/
 280             if (SvIOK (sv))
 281             {
 282                 args[i].ival = SvIV (sv);
 283                 f_args[i] = (unsigned long) &(args[i].ival);
 284                 if (debug > 1)
 285                 {
 286                     fprintf( stderr, "        [RV->IV] 0x%lx\n", f_args[i]);
 287                 }
 288             }
 289
 290             /*--------------------------------------------------------------
 291             | Number ref -- convert and pass address of value
 292             --------------------------------------------------------------*/
 293             else if (SvNOK (sv))
 294             {
 295                 args[i].ival = (unsigned long) SvNV (sv);
 296                 f_args[i] = (unsigned long) &(args[i].ival);
 297                 if (debug > 1)
 298                 {
 299                     fprintf( stderr, "        [RV->NV] 0x%lx\n", f_args[i]);
 300                 }
 301             }
 302
 303             /*--------------------------------------------------------------
 304             | String ref -- pass pointer
 305             --------------------------------------------------------------*/
 306             else if (SvPOK (sv))
 307             {
 308                 f_args[i] = (unsigned long) ((char *) SvPV (sv, PL_na));
 309                 if (debug > 1)
 310                 {
 311                     fprintf( stderr, "        [RV->PV] 0x%lx\n", f_args[i]);
 312                 }
 313             }
 314         }
 315
 316         /*--------------------------------------------------------------
 317         | Scalar
 318         --------------------------------------------------------------*/
 319         else
 320         {
 321
 322             /*--------------------------------------------------------------
 323             | Integer -- pass value
 324             --------------------------------------------------------------*/
 325             if (SvIOK (sv))
 326             {
 327                 f_args[i] = (unsigned long) SvIV (sv);
 328                 if (debug > 1)
 329                 {
 330                     fprintf( stderr, "        [IV]     %ld (0x%lx)\n", f_args[i], f_args[i]);
 331                 }
 332             }
 333
 334             /*--------------------------------------------------------------
 335             | Number -- convert and pass value
 336             --------------------------------------------------------------*/
 337             else if (SvNOK (sv))
 338             {
 339                 f_args[i] = (unsigned long) SvNV (sv);
 340                 if (debug > 1)
 341                 {
 342                     fprintf( stderr, "        [NV]     %ld (0x%lx)\n", f_args[i], f_args[i]);
 343                 }
 344             }
 345
 346             /*--------------------------------------------------------------
 347             | String -- pass pointer to copy
 348             --------------------------------------------------------------*/
 349             else if (SvPOK (sv))
 350             {
 351                 p = SvPV (sv, n);
 352                 if ((args[i].pval = malloc( n+2 )))
 353                 {
 354                     memcpy (args[i].pval, p, n);
 355                     ((char *)(args[i].pval))[n] = 0;  /* add final NULL */
 356                     ((char *)(args[i].pval))[n+1] = 0;  /* and another one for Unicode too */
 357                     f_args[i] = (unsigned long) args[i].pval;
 358                     if (debug > 1)
 359                     {
 360                         fprintf( stderr, "        [PV]     0x%lx\n", f_args[i]);
 361                     }
 362                 }
 363             }
 364         }
 365
 366     }  /* end for */
 367
 368     /*--------------------------------------------------------------
 369     | Here we go
 370     --------------------------------------------------------------*/
 371     r = perl_call_wine( (FARPROC)function, n_args, f_args, &last_error, debug );
 372
 373     /*--------------------------------------------------------------
 374     | Handle modified parameter values
 375     |
 376     | There are four possibilities for parameter values:
 377     |
 378     |     1) integer value
 379     |     2) string value
 380     |     3) ref to integer value
 381     |     4) ref to string value
 382     |
 383     | In cases 1 and 2, the intent is that the values won't be
 384     | modified, because they're not passed by ref.  So we leave
 385     | them alone here.
 386     |
 387     | In case 4, the address of the actual string buffer has
 388     | already been passed to the wine API function, which had
 389     | opportunity to modify it if it wanted to.  So again, we
 390     | don't have anything to do here.
 391     |
 392     | The case we need to handle is case 3.  For integers passed
 393     | by ref, we created a local containing the initial value,
 394     | and passed its address to the wine API function, which
 395     | (potentially) modified it.  Now we have to copy the
 396     | (potentially) new value back to the Perl variable passed
 397     | in, using sv_setiv().  (Which will take fewer lines of code
 398     | to do than it took lines of comment to describe ...)
 399     --------------------------------------------------------------*/
 400     for (i = 0; (i < n_args); i++)
 401     {
 402         sv = ST (n_fixed + i);
 403         if (! SvOK (sv))
 404             continue;
 405         if (SvROK (sv) && (sv = SvRV (sv)) && SvIOK (sv))
 406         {
 407             sv_setiv (sv, args[i].ival);
 408         }
 409     }
 410
 411     /*--------------------------------------------------------------
 412     | Put appropriate return value on the stack for Perl to pick
 413     | up
 414     --------------------------------------------------------------*/
 415     EXTEND(SP,2);
 416     if (last_error != 0xdeadbeef) PUSHs(sv_2mortal(newSViv(last_error)));
 417     else PUSHs( &PL_sv_undef );
 418     PUSHs (convert_value (ret_type, r));
 419
 420     /*--------------------------------------------------------------
 421     | Free up allocated memory
 422     --------------------------------------------------------------*/
 423     for (i = 0; (i < n_args); i++)
 424     {
 425         if (args[i].pval) free(args[i].pval);
 426     }
 427
 428
 429     # --------------------------------------------------------------------
 430     # Function:    load_library
 431     # --------------------------------------------------------------------
 432     # Purpose:     Load a Wine library
 433     #
 434     # Parameters:  module   -- module (dll) to load
 435     #
 436     # Returns:     module handle
 437     # --------------------------------------------------------------------
 438 void
 439 load_library(module)
 440     char  *module;
 441     PROTOTYPE: $
 442
 443     PPCODE:
 444     ST(0) = newSViv( (I32)LoadLibraryA(module) );
 445     XSRETURN(1);
 446
 447
 448     # --------------------------------------------------------------------
 449     # Function:    get_proc_address
 450     # --------------------------------------------------------------------
 451     # Purpose:     Retrive a function address
 452     #
 453     # Parameters:  module   -- module handle
 454     # --------------------------------------------------------------------
 455 void
 456 get_proc_address(module,func)
 457     unsigned long module;
 458     char  *func;
 459     PROTOTYPE: $$
 460
 461     PPCODE:
 462     ST(0) = newSViv( (I32)GetProcAddress( (HMODULE)module, func ) );
 463     XSRETURN(1);
 464
 465
 466     # --------------------------------------------------------------------
 467     # Function:    alloc_thunk
 468     # --------------------------------------------------------------------
 469     # Purpose:     Allocate a thunk for a wine API callback
 470     #
 471     #   This is used when a Wine API function is called from Perl, and
 472     #   that API function takes a callback as one of its parameters.
 473     #
 474     #   The Wine API function, of course, must be passed the address of
 475     #   a C function as the callback.  But if the API is called from Perl,
 476     #   we want the user to be able to specify a Perl sub as the callback,
 477     #   and have control returned there each time the callback is called.
 478     #
 479     #   This function takes a code ref to a Perl sub as one of its
 480     #   arguments.  It then creates a unique C function (a thunk) on the
 481     #   fly, which can be passed to the Wine API function as its callback.
 482     #
 483     #   The thunk has its own data area (as thunks are wont to do); one
 484     #   of the things stashed there is aforementioned Perl code ref.  So
 485     #   the sequence of events is as follows:
 486     #
 487     #       1) From Perl, user calls alloc_callback(), passing a ref
 488     #          to a Perl sub to use as the callback.
 489     #
 490     #       2) alloc_callback() calls this routine.  This routine
 491     #          creates a thunk, and stashes the above code ref in
 492     #          it.  This function then returns a pointer to the thunk
 493     #          to Perl.
 494     #
 495     #       3) From Perl, user calls Wine API function.  As the parameter
 496     #          which is supposed to be the address of the callback, the
 497     #          user passes the pointer to the thunk allocated above.
 498     #
 499     #       4) The Wine API function gets called.  It periodically calls
 500     #          the callback, which executes the thunk.
 501     #
 502     #       5) Each time the thunk is executed, it calls callback_bridge()
 503     #          (defined in winetest.c).
 504     #
 505     #       6) callback_bridge() fishes the Perl code ref out of the
 506     #          thunk data area and calls the Perl callback.
 507     #
 508     #   Voila.  The Perl callback gets called each time the Wine API
 509     #   function calls its callback.
 510     #
 511     # Parameters:  [todo]  Parameters ...
 512     #
 513     # Returns:     Pointer to thunk
 514     # --------------------------------------------------------------------
 515 void
 516 alloc_thunk(...)
 517
 518     PPCODE:
 519
 520     /* Locals */
 521     struct thunk *thunk;
 522     int i;
 523
 524     /* Allocate the thunk */
 525     if (!(thunk = malloc( sizeof(*thunk) ))) croak( "Out of memory" );
 526
 527     (*thunk) = thunk_template;
 528     thunk->args_ptr = thunk->arg_types;
 529     thunk->nb_args  = items - 1;
 530     thunk->code_ref = SvRV (ST (0));
 531     thunk->func     = (void *)((char *) callback_bridge - (char *) &thunk->leave);
 532     thunk->arg_size = thunk->nb_args * sizeof(int);
 533
 534     /* Stash callback arg types */
 535     for (i = 1; i < items; i++) thunk->arg_types[i - 1] = SvIV (ST (i));
 536
 537     /*--------------------------------------------------------------
 538     | Push the address of the thunk on the stack for return
 539     |
 540     | [todo]  We need to free up the memory allocated somehow ...
 541     --------------------------------------------------------------*/
 542     ST (0) = newSViv ((I32) thunk);
 543     XSRETURN (1);