ext/DynaLoader/dl_cygwin.xs

   1 /* dl_cygwin.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 /* Modified from the original dl_win32.xs to work with cygwin
  12    -John Cerney 3/26/97
  13 */
  14 /* Porting notes:
  15
  16 I merely took Paul's dl_dlopen.xs, took out extraneous stuff and
  17 replaced the appropriate SunOS calls with the corresponding Win32
  18 calls.
  19
  20 */
  21
  22 #define WIN32_LEAN_AND_MEAN
  23 // Defines from windows needed for this function only. Can't include full
  24 //  Cygwin windows headers because of problems with CONTEXT redefinition
  25 //  Removed logic to tell not dynamically load static modules. It is assumed that all
  26 //   modules are dynamically built. This should be similar to the behavoir on sunOS.
  27 //   Leaving in the logic would have required changes to the standard perlmain.c code
  28 //
  29 #include <stdio.h>
  30
  31 //#include <windows.h>
  32 #define LOAD_WITH_ALTERED_SEARCH_PATH   (8)
  33 typedef void *HANDLE;
  34 typedef HANDLE HINSTANCE;
  35 #define STDCALL     __attribute__ ((stdcall))
  36 typedef int STDCALL (*FARPROC)();
  37 #define MAX_PATH        260
  38
  39 HINSTANCE
  40 STDCALL
  41 LoadLibraryExA(
  42                char* lpLibFileName,
  43                HANDLE hFile,
  44                unsigned int dwFlags
  45                );
  46 unsigned int
  47 STDCALL
  48 GetLastError(
  49              void
  50              );
  51 FARPROC
  52 STDCALL
  53 GetProcAddress(
  54                HINSTANCE hModule,
  55                char* lpProcName
  56                );
  57
  58 #include <string.h>
  59
  60 #include "EXTERN.h"
  61 #include "perl.h"
  62 #include "XSUB.h"
  63
  64 #include "dlutils.c"    /* SaveError() etc      */
  65
  66 static void
  67 dl_private_init(pTHX)
  68 {
  69     (void)dl_generic_private_init(aTHX);
  70 }
  71
  72
  73 MODULE = DynaLoader     PACKAGE = DynaLoader
  74
  75 BOOT:
  76     (void)dl_private_init(aTHX);
  77
  78 void *
  79 dl_load_file(filename,flags=0)
  80     char *              filename
  81     int                 flags
  82     PREINIT:
  83     CODE:
  84     {
  85     char        win32_path[MAX_PATH];
  86     cygwin_conv_to_full_win32_path(filename, win32_path);
  87     filename = win32_path;
  88
  89     DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
  90
  91     RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
  92
  93     DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", RETVAL));
  94     ST(0) = sv_newmortal() ;
  95     if (RETVAL == NULL){
  96         SaveError(aTHX_ "%d",GetLastError()) ;
  97     } else {
  98         sv_setiv( ST(0), PTR2IV(RETVAL) );
  99     }
 100    }
 101
 102
 103
 104 void *
 105 dl_find_symbol(libhandle, symbolname)
 106     void *      libhandle
 107     char *      symbolname
 108     CODE:
 109     DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
 110         libhandle, symbolname));
 111     RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
 112     DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref = %x\n", RETVAL));
 113     ST(0) = sv_newmortal() ;
 114     if (RETVAL == NULL)
 115         SaveError(aTHX_ "%d",GetLastError()) ;
 116     else
 117         sv_setiv( ST(0), PTR2IV(RETVAL));
 118
 119
 120 void
 121 dl_undef_symbols()
 122     PPCODE:
 123
 124
 125
 126 # These functions should not need changing on any platform:
 127
 128 void
 129 dl_install_xsub(perl_name, symref, filename="$Package")
 130     char *              perl_name
 131     void *              symref
 132     char *              filename
 133     CODE:
 134     DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
 135                 perl_name, symref));
 136     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
 137                                         (void(*)(pTHX_ CV *))symref,
 138                                         filename)));
 139
 140
 141 char *
 142 dl_error()
 143     CODE:
 144     RETVAL = LastError ;
 145     OUTPUT:
 146     RETVAL
 147
 148 # end.