ext/DynaLoader/dl_cygwin32.xs

   1 /* dl_cygwin32.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 cygwin32
  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 //  Cygwin32 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 // // Includes call a dll function to initialize it's impure_ptr.
  30 #include <stdio.h>
  31 void (*impure_setupptr)(struct _reent *);  // pointer to the impure_setup routine
  32
  33 //#include <windows.h>
  34 #define LOAD_WITH_ALTERED_SEARCH_PATH   (8)
  35 typedef void *HANDLE;
  36 typedef HANDLE HINSTANCE;
  37 #define STDCALL     __attribute__ ((stdcall))
  38 typedef int STDCALL (*FARPROC)();
  39
  40 HINSTANCE
  41 STDCALL
  42 LoadLibraryExA(
  43                char* lpLibFileName,
  44                HANDLE hFile,
  45                unsigned int dwFlags
  46                );
  47 unsigned int
  48 STDCALL
  49 GetLastError(
  50              void
  51              );
  52 FARPROC
  53 STDCALL
  54 GetProcAddress(
  55                HINSTANCE hModule,
  56                char* lpProcName
  57                );
  58
  59 #include <string.h>
  60
  61 #include "EXTERN.h"
  62 #include "perl.h"
  63 #include "XSUB.h"
  64
  65 #include "dlutils.c"    /* SaveError() etc      */
  66
  67 static void
  68 dl_private_init()
  69 {
  70     (void)dl_generic_private_init();
  71 }
  72
  73
  74 MODULE = DynaLoader     PACKAGE = DynaLoader
  75
  76 BOOT:
  77     (void)dl_private_init();
  78
  79 void *
  80 dl_load_file(filename,flags=0)
  81     char *              filename
  82     int                 flags
  83     PREINIT:
  84     CODE:
  85     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
  86
  87     RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
  88
  89     DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
  90     ST(0) = sv_newmortal() ;
  91     if (RETVAL == NULL){
  92         SaveError("%d",GetLastError()) ;
  93     }
  94     else{
  95         // setup the dll's impure_ptr:
  96         impure_setupptr = GetProcAddress(RETVAL, "impure_setup");
  97         if( impure_setupptr == NULL){
  98                 printf(
  99     "Cygwin32 dynaloader error: could not load impure_setup symbol\n");
 100                 RETVAL = NULL;
 101         }
 102         else{
 103                 // setup the DLLs impure_ptr:
 104                 (*impure_setupptr)(_impure_ptr);
 105                 sv_setiv( ST(0), (IV)RETVAL);
 106         }
 107    }
 108
 109
 110
 111 void *
 112 dl_find_symbol(libhandle, symbolname)
 113     void *      libhandle
 114     char *      symbolname
 115     CODE:
 116     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
 117         libhandle, symbolname));
 118     RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
 119     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
 120     ST(0) = sv_newmortal() ;
 121     if (RETVAL == NULL)
 122         SaveError("%d",GetLastError()) ;
 123     else
 124         sv_setiv( ST(0), (IV)RETVAL);
 125
 126
 127 void
 128 dl_undef_symbols()
 129     PPCODE:
 130
 131
 132
 133 # These functions should not need changing on any platform:
 134
 135 void
 136 dl_install_xsub(perl_name, symref, filename="$Package")
 137     char *              perl_name
 138     void *              symref
 139     char *              filename
 140     CODE:
 141     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
 142                 perl_name, symref));
 143     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 144
 145
 146 char *
 147 dl_error()
 148     CODE:
 149     RETVAL = LastError ;
 150     OUTPUT:
 151     RETVAL
 152
 153 # end.