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