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 #ifdef __GNUC__
  22 #define Win32_Winsock
  23 #endif
  24 #include <windows.h>
  25 #include <string.h>
  26
  27 #include "EXTERN.h"
  28 #include "perl.h"
  29 #include "XSUB.h"
  30
  31 #include "dlutils.c"    /* SaveError() etc      */
  32
  33 static void
  34 dl_private_init(void)
  35 {
  36     (void)dl_generic_private_init();
  37 }
  38
  39 static int
  40 dl_static_linked(char *filename)
  41 {
  42     char **p;
  43     for (p = staticlinkmodules; *p;p++) {
  44         if (strstr(filename, *p)) return 1;
  45     };
  46     return 0;
  47 }
  48
  49 MODULE = DynaLoader     PACKAGE = DynaLoader
  50
  51 BOOT:
  52     (void)dl_private_init();
  53
  54 void *
  55 dl_load_file(filename,flags=0)
  56     char *              filename
  57     int                 flags
  58     PREINIT:
  59     CODE:
  60     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
  61     if (dl_static_linked(filename) == 0)
  62         RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
  63     else
  64         RETVAL = (void*) GetModuleHandle(NULL);
  65     DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
  66     ST(0) = sv_newmortal() ;
  67     if (RETVAL == NULL)
  68         SaveError("%d",GetLastError()) ;
  69     else
  70         sv_setiv( ST(0), (IV)RETVAL);
  71
  72
  73 void *
  74 dl_find_symbol(libhandle, symbolname)
  75     void *      libhandle
  76     char *      symbolname
  77     CODE:
  78     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
  79                       libhandle, symbolname));
  80     RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
  81     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
  82     ST(0) = sv_newmortal() ;
  83     if (RETVAL == NULL)
  84         SaveError("%d",GetLastError()) ;
  85     else
  86         sv_setiv( ST(0), (IV)RETVAL);
  87
  88
  89 void
  90 dl_undef_symbols()
  91     PPCODE:
  92
  93
  94
  95 # These functions should not need changing on any platform:
  96
  97 void
  98 dl_install_xsub(perl_name, symref, filename="$Package")
  99     char *              perl_name
 100     void *              symref
 101     char *              filename
 102     CODE:
 103     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
 104                       perl_name, symref));
 105     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV*))symref, filename)));
 106
 107
 108 char *
 109 dl_error()
 110     CODE:
 111     RETVAL = LastError ;
 112     OUTPUT:
 113     RETVAL
 114
 115 # end.