[p5sagit/p5-mst-13.2.git] / win32 / dl_win32.xs

/* dl_win32.xs
 * 
 * Platform:	Win32 (Windows NT/Windows 95)
 * Author:	Wei-Yuen Tan (wyt@hip.com)
 * Created:	A warm day in June, 1995
 *
 * Modified:
 *    August 23rd 1995 - rewritten after losing everything when I
 *                       wiped off my NT partition (eek!)
 */

/* Porting notes:

I merely took Paul's dl_dlopen.xs, took out extraneous stuff and
replaced the appropriate SunOS calls with the corresponding Win32
calls.

*/

#define WIN32_LEAN_AND_MEAN
#ifdef __GNUC__
#define Win32_Winsock
#endif
#include <windows.h>
#include <string.h>

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "dlutils.c"	/* SaveError() etc	*/

static void
dl_private_init(void)
{
    (void)dl_generic_private_init();
}

static int
dl_static_linked(char *filename)
{
    char **p;
    for (p = staticlinkmodules; *p;p++) {
	if (strstr(filename, *p)) return 1;
    };
    return 0;
}

MODULE = DynaLoader	PACKAGE = DynaLoader

BOOT:
    (void)dl_private_init();

void *
dl_load_file(filename,flags=0)
    char *		filename
    int			flags
    PREINIT:
    CODE:
    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename));
    if (dl_static_linked(filename) == 0)
	RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
    else
	RETVAL = (void*) GetModuleHandle(NULL);
    DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
    ST(0) = sv_newmortal() ;
    if (RETVAL == NULL)
	SaveError("%d",GetLastError()) ;
    else
	sv_setiv( ST(0), (IV)RETVAL);


void *
dl_find_symbol(libhandle, symbolname)
    void *	libhandle
    char *	symbolname
    CODE:
    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
		      libhandle, symbolname));
    RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"  symbolref = %x\n", RETVAL));
    ST(0) = sv_newmortal() ;
    if (RETVAL == NULL)
	SaveError("%d",GetLastError()) ;
    else
	sv_setiv( ST(0), (IV)RETVAL);


void
dl_undef_symbols()
    PPCODE:


# These functions should not need changing on any platform:

void
dl_install_xsub(perl_name, symref, filename="$Package")
    char *		perl_name
    void *		symref 
    char *		filename
    CODE:
    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
		      perl_name, symref));
    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV*))symref, filename)));


char *
dl_error()
    CODE:
    RETVAL = LastError ;
    OUTPUT:
    RETVAL

# end.
Commit	Line	Data
0a753a76	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
a835ef8a	21	#ifdef __GNUC__
	22	#define Win32_Winsock
	23	#endif
0a753a76	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
c31fac66	34	dl_private_init(void)
0a753a76	35	{
	36	(void)dl_generic_private_init();
	37	}
	38
	39	static int
	40	dl_static_linked(char *filename)
	41	{
68dc0745	42	char **p;
0a753a76	43	for (p = staticlinkmodules; *p;p++) {
68dc0745	44	if (strstr(filename, *p)) return 1;
	45	};
	46	return 0;
0a753a76	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:
76e3520e	60	DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename));
68dc0745	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);
76e3520e	65	DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
0a753a76	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:
76e3520e	78	DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
68dc0745	79	libhandle, symbolname));
0a753a76	80	RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
76e3520e	81	DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL));
0a753a76	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:
76e3520e	103	DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
68dc0745	104	perl_name, symref));
68dc0745	105	ST(0)=sv_2mortal(newRV((SV)newXS(perl_name, (void()(CV*))symref, filename)));
0a753a76	106
	107
	108	char *
	109	dl_error()
	110	CODE:
	111	RETVAL = LastError ;
	112	OUTPUT:
	113	RETVAL
	114
	115	# end.