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

... / ...

Commit	Line	Data
	1	#include "dlfcn.h"
	2	#include "string.h"
	3	#include "stdio.h"
	4
	5	#define INCL_BASE
	6	#include <os2.h>
	7	#include <float.h>
	8	#include <stdlib.h>
	9
	10	static ULONG retcode;
	11	static char fail[300];
	12
	13	static ULONG dllHandle;
	14	static int handle_found;
	15	static int handle_loaded;
	16	#ifdef PERL_CORE
	17
	18	#include "EXTERN.h"
	19	#include "perl.h"
	20
	21	#else
	22
	23	char *os2error(int rc);
	24
	25	#endif
	26
	27	#ifdef DLOPEN_INITTERM
	28	unsigned long _DLL_InitTerm(unsigned long modHandle, unsigned long flag)
	29	{
	30	switch (flag) {
	31	case 0: /* INIT */
	32	/* Save handle */
	33	dllHandle = modHandle;
	34	handle_found = 1;
	35	return TRUE;
	36
	37	case 1: /* TERM */
	38	handle_found = 0;
	39	dllHandle = (unsigned long)NULLHANDLE;
	40	return TRUE;
	41	}
	42
	43	return FALSE;
	44	}
	45
	46	#endif
	47
	48	HMODULE
	49	find_myself(void)
	50	{
	51
	52	static APIRET APIENTRY (pDosQueryModFromEIP) (HMODULE hmod, ULONG * obj, ULONG BufLen, PCHAR Buf,
	53	ULONG * Offset, ULONG Address);
	54	HMODULE doscalls_h, mod;
	55	static int failed;
	56	ULONG obj, offset, rc;
	57	char buf[260];
	58
	59	if (failed)
	60	return 0;
	61	failed = 1;
	62	doscalls_h = (HMODULE)dlopen("DOSCALLS",0);
	63	if (!doscalls_h)
	64	return 0;
	65	/* {&doscalls_handle, NULL, 360}, / / DosQueryModFromEIP */
	66	rc = DosQueryProcAddr(doscalls_h, 360, 0, (PFN*)&pDosQueryModFromEIP);
	67	if (rc)
	68	return 0;
	69	rc = pDosQueryModFromEIP(&mod, &obj, sizeof(buf), buf, &offset, (ULONG)dlopen);
	70	if (rc)
	71	return 0;
	72	failed = 0;
	73	handle_found = 1;
	74	dllHandle = mod;
	75	return mod;
	76	}
	77
	78	void *
	79	dlopen(const char *path, int mode)
	80	{
	81	HMODULE handle;
	82	char tmp[260];
	83	const char beg, dot;
	84	ULONG rc;
	85	unsigned fpflag = _control87(0,0);
	86
	87	fail[0] = 0;
	88	if (!path) { /* Our own handle. */
	89	if (handle_found \|\| find_myself()) {
	90	char dllname[260];
	91
	92	if (handle_loaded)
	93	return (void*)dllHandle;
	94	rc = DosQueryModuleName(dllHandle, sizeof(dllname), dllname);
	95	if (rc) {
	96	strcpy(fail, "can't find my DLL name by the handle");
	97	retcode = rc;
	98	return 0;
	99	}
	100	rc = DosLoadModule(fail, sizeof fail, dllname, &handle);
	101	if (rc) {
	102	strcpy(fail, "can't load my own DLL");
	103	retcode = rc;
	104	return 0;
	105	}
	106	handle_loaded = 1;
	107	goto ret;
	108	}
	109	retcode = ERROR_MOD_NOT_FOUND;
	110	strcpy(fail, "can't load from myself: compiled without -DDLOPEN_INITTERM");
	111	return 0;
	112	}
	113	if ((rc = DosLoadModule(fail, sizeof fail, (char*)path, &handle)) == 0)
	114	goto ret;
	115
	116	retcode = rc;
	117
	118	if (strlen(path) >= sizeof(tmp))
	119	return NULL;
	120
	121	/* Not found. Check for non-FAT name and try truncated name. */
	122	/* Don't know if this helps though... */
	123	for (beg = dot = path + strlen(path);
	124	beg > path && !strchr(":/\\", *(beg-1));
	125	beg--)
	126	if (*beg == '.')
	127	dot = beg;
	128	if (dot - beg > 8) {
	129	int n = beg+8-path;
	130
	131	memmove(tmp, path, n);
	132	memmove(tmp+n, dot, strlen(dot)+1);
	133	if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0)
	134	goto ret;
	135	}
	136	handle = 0;
	137
	138	ret:
	139	_control87(fpflag, MCW_EM); /* Some modules reset FP flags on load */
	140	return (void *)handle;
	141	}
	142
	143	#define ERROR_WRONG_PROCTYPE 0xffffffff
	144
	145	void *
	146	dlsym(void handle, const char symbol)
	147	{
	148	ULONG rc, type;
	149	PFN addr;
	150
	151	fail[0] = 0;
	152	rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr);
	153	if (rc == 0) {
	154	rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type);
	155	if (rc == 0 && type == PT_32BIT)
	156	return (void *)addr;
	157	rc = ERROR_WRONG_PROCTYPE;
	158	}
	159	retcode = rc;
	160	return NULL;
	161	}
	162
	163	char *
	164	dlerror(void)
	165	{
	166	static char buf[700];
	167	ULONG len;
	168	char *err;
	169
	170	if (retcode == 0)
	171	return NULL;
	172	if (retcode == ERROR_WRONG_PROCTYPE)
	173	err = "Wrong procedure type";
	174	else
	175	err = os2error(retcode);
	176	len = strlen(err);
	177	if (len > sizeof(buf) - 1)
	178	len = sizeof(buf) - 1;
	179	strncpy(buf, err, len+1);
	180	if (fail[0] && len + strlen(fail) < sizeof(buf) - 100)
	181	sprintf(buf + len, ", possible problematic module: '%s'", fail);
	182	retcode = 0;
	183	return buf;
	184	}
	185
	186	int
	187	dlclose(void *handle)
	188	{
	189	ULONG rc;
	190
	191	if ((rc = DosFreeModule((HMODULE)handle)) == 0) return 0;
	192
	193	retcode = rc;
	194	return 2;
	195	}