win32/dl_win32.xs

   1 /* dl_win32.xs
   2  *
   3  * Platform:    Win32 (Windows NT/Windows 95)
   4  * Author:      Wei-Yuen Tan (wyt@hip.com)
   5  * Created:     A warm day in June, 1995
   6  *
   7  * Modified:
   8  *    August 23rd 1995 - rewritten after losing everything when I
   9  *                       wiped off my NT partition (eek!)
  10  */
  11
  12 /* Porting notes:
  13
  14 I merely took Paul's dl_dlopen.xs, took out extraneous stuff and
  15 replaced the appropriate SunOS calls with the corresponding Win32
  16 calls.
  17
  18 */
  19
  20 #define WIN32_LEAN_AND_MEAN
  21 #include <windows.h>
  22 #include <string.h>
  23
  24 #include "EXTERN.h"
  25 #include "perl.h"
  26 #include "XSUB.h"
  27
  28 #include "dlutils.c"    /* SaveError() etc      */
  29
  30 static void
  31 dl_private_init()
  32 {
  33     (void)dl_generic_private_init();
  34 }
  35
  36 static int
  37 dl_static_linked(char *filename)
  38 {
  39         char **p;
  40     for (p = staticlinkmodules; *p;p++) {
  41                 if (strstr(filename, *p)) return 1;
  42                 };
  43         return 0;
  44 }
  45
  46 MODULE = DynaLoader     PACKAGE = DynaLoader
  47
  48 BOOT:
  49     (void)dl_private_init();
  50
  51 void *
  52 dl_load_file(filename,flags=0)
  53     char *              filename
  54     int                 flags
  55     PREINIT:
  56     CODE:
  57     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
  58         if (dl_static_linked(filename) == 0)
  59         RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
  60         else
  61                 RETVAL = (void*) GetModuleHandle(NULL);
  62     DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
  63     ST(0) = sv_newmortal() ;
  64     if (RETVAL == NULL)
  65         SaveError("%d",GetLastError()) ;
  66     else
  67         sv_setiv( ST(0), (IV)RETVAL);
  68
  69
  70 void *
  71 dl_find_symbol(libhandle, symbolname)
  72     void *      libhandle
  73     char *      symbolname
  74     CODE:
  75     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
  76         libhandle, symbolname));
  77     RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
  78     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
  79     ST(0) = sv_newmortal() ;
  80     if (RETVAL == NULL)
  81         SaveError("%d",GetLastError()) ;
  82     else
  83         sv_setiv( ST(0), (IV)RETVAL);
  84
  85
  86 void
  87 dl_undef_symbols()
  88     PPCODE:
  89
  90
  91
  92 # These functions should not need changing on any platform:
  93
  94 void
  95 dl_install_xsub(perl_name, symref, filename="$Package")
  96     char *              perl_name
  97     void *              symref
  98     char *              filename
  99     CODE:
 100     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
 101                 perl_name, symref));
 102     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 103
 104
 105 char *
 106 dl_error()
 107     CODE:
 108     RETVAL = LastError ;
 109     OUTPUT:
 110     RETVAL
 111
 112 # end.