perl5.git.perl.org Git - perl5.git/blame_incremental

... / ...

Commit	Line	Data
	1	/* dlutils.c - handy functions and definitions for dl_*.xs files
	2	*
	3	* Currently this file is simply #included into dl_*.xs/.c files.
	4	* It should really be split into a dlutils.h and dlutils.c
	5	*
	6	* Modified:
	7	* 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
	8	* files when the interpreter exits
	9	*/
	10
	11	#ifndef START_MY_CXT /* Some IDEs try compiling this standalone. */
	12	# include "EXTERN.h"
	13	# include "perl.h"
	14	# include "XSUB.h"
	15	#endif
	16
	17	#ifndef XS_VERSION
	18	# define XS_VERSION "0"
	19	#endif
	20	#define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION
	21
	22	typedef struct {
	23	SV* x_dl_last_error; /* pointer to allocated memory for
	24	last error message */
	25	int x_dl_nonlazy; /* flag for immediate rather than lazy
	26	linking (spots unresolved symbol) */
	27	#ifdef DL_LOADONCEONLY
	28	HV * x_dl_loaded_files; /* only needed on a few systems */
	29	#endif
	30	#ifdef DL_CXT_EXTRA
	31	my_cxtx_t x_dl_cxtx; /* extra platform-specific data */
	32	#endif
	33	#ifdef DEBUGGING
	34	int x_dl_debug; /* value copied from $DynaLoader::dl_debug */
	35	#endif
	36	} my_cxt_t;
	37
	38	START_MY_CXT
	39
	40	#define dl_last_error (SvPVX(MY_CXT.x_dl_last_error))
	41	#define dl_nonlazy (MY_CXT.x_dl_nonlazy)
	42	#ifdef DL_LOADONCEONLY
	43	#define dl_loaded_files (MY_CXT.x_dl_loaded_files)
	44	#endif
	45	#ifdef DL_CXT_EXTRA
	46	#define dl_cxtx (MY_CXT.x_dl_cxtx)
	47	#endif
	48	#ifdef DEBUGGING
	49	#define dl_debug (MY_CXT.x_dl_debug)
	50	#endif
	51
	52	#ifdef DEBUGGING
	53	#define DLDEBUG(level,code) \
	54	STMT_START { \
	55	dMY_CXT; \
	56	if (dl_debug>=level) { code; } \
	57	} STMT_END
	58	#else
	59	#define DLDEBUG(level,code) NOOP
	60	#endif
	61
	62	#ifdef DL_UNLOAD_ALL_AT_EXIT
	63	/* Close all dlopen'd files */
	64	static void
	65	dl_unload_all_files(pTHX_ void *unused)
	66	{
	67	CV *sub;
	68	AV *dl_librefs;
	69	SV *dl_libref;
	70
	71	if ((sub = get_cvs("DynaLoader::dl_unload_file", 0)) != NULL) {
	72	dl_librefs = get_av("DynaLoader::dl_librefs", 0);
	73	while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
	74	dSP;
	75	ENTER;
	76	SAVETMPS;
	77	PUSHMARK(SP);
	78	XPUSHs(sv_2mortal(dl_libref));
	79	PUTBACK;
	80	call_sv((SV*)sub, G_DISCARD \| G_NODEBUG);
	81	FREETMPS;
	82	LEAVE;
	83	}
	84	}
	85	}
	86	#endif
	87
	88	static void
	89	dl_generic_private_init(pTHX) /* called by dl_.xs dl_private_init() /
	90	{
	91	char *perl_dl_nonlazy;
	92	MY_CXT_INIT;
	93
	94	MY_CXT.x_dl_last_error = newSVpvn("", 0);
	95	dl_nonlazy = 0;
	96	#ifdef DL_LOADONCEONLY
	97	dl_loaded_files = NULL;
	98	#endif
	99	#ifdef DEBUGGING
	100	{
	101	SV *sv = get_sv("DynaLoader::dl_debug", 0);
	102	dl_debug = sv ? SvIV(sv) : 0;
	103	}
	104	#endif
	105	if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
	106	dl_nonlazy = atoi(perl_dl_nonlazy);
	107	if (dl_nonlazy)
	108	DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
	109	#ifdef DL_LOADONCEONLY
	110	if (!dl_loaded_files)
	111	dl_loaded_files = newHV(); /* provide cache for dl_.xs if needed /
	112	#endif
	113	#ifdef DL_UNLOAD_ALL_AT_EXIT
	114	call_atexit(&dl_unload_all_files, (void*)0);
	115	#endif
	116	}
	117
	118
	119	#ifndef SYMBIAN
	120	/* SaveError() takes printf style args and saves the result in dl_last_error */
	121	static void
	122	SaveError(pTHX_ const char* pat, ...)
	123	{
	124	dMY_CXT;
	125	va_list args;
	126	SV *msv;
	127	const char *message;
	128	STRLEN len;
	129
	130	/* This code is based on croak/warn, see mess() in util.c */
	131
	132	va_start(args, pat);
	133	msv = vmess(pat, &args);
	134	va_end(args);
	135
	136	message = SvPV(msv,len);
	137	len++; /* include terminating null char */
	138
	139	/* Copy message into dl_last_error (including terminating null char) */
	140	sv_setpvn(MY_CXT.x_dl_last_error, message, len) ;
	141	DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
	142	}
	143	#endif
	144