This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH 5.6.1] $^E on OS/2
[perl5.git] / os2 / dl_os2.c
1 #include "dlfcn.h"
2 #include "string.h"
3 #include "stdio.h"
4
5 #define INCL_BASE
6 #include <os2.h>
7
8 static ULONG retcode;
9 static char fail[300];
10
11 char *os2error(int rc);
12
13 void *
14 dlopen(char *path, int mode)
15 {
16         HMODULE handle;
17         char tmp[260], *beg, *dot;
18         ULONG rc;
19
20         fail[0] = 0;
21         if ((rc = DosLoadModule(fail, sizeof fail, path, &handle)) == 0)
22                 return (void *)handle;
23
24         retcode = rc;
25
26         /* Not found. Check for non-FAT name and try truncated name. */
27         /* Don't know if this helps though... */
28         for (beg = dot = path + strlen(path);
29              beg > path && !strchr(":/\\", *(beg-1));
30              beg--)
31                 if (*beg == '.')
32                         dot = beg;
33         if (dot - beg > 8) {
34                 int n = beg+8-path;
35                 memmove(tmp, path, n);
36                 memmove(tmp+n, dot, strlen(dot)+1);
37                 if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0)
38                         return (void *)handle;
39         }
40
41         return NULL;
42 }
43
44 void *
45 dlsym(void *handle, char *symbol)
46 {
47         ULONG rc, type;
48         PFN addr;
49
50         fail[0] = 0;
51         rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr);
52         if (rc == 0) {
53                 rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type);
54                 if (rc == 0 && type == PT_32BIT)
55                         return (void *)addr;
56                 rc = ERROR_CALL_NOT_IMPLEMENTED;
57         }
58         retcode = rc;
59         return NULL;
60 }
61
62 char *
63 dlerror(void)
64 {
65         static char buf[700];
66         ULONG len;
67         char *err;
68
69         if (retcode == 0)
70                 return NULL;
71         err = os2error(retcode);
72         len = strlen(err);
73         if (len > sizeof(buf) - 1)
74             len = sizeof(buf) - 1;
75         strncpy(buf, err, len+1);
76         if (fail[0] && len < 300)
77             sprintf(buf + len, ", possible problematic module: '%s'", fail);
78         retcode = 0;
79         return buf;
80 }
81
82 int
83 dlclose(void *handle)
84 {
85         ULONG rc;
86
87         if ((rc = DosFreeModule((HMODULE)handle)) == 0) return 0;
88
89         retcode = rc;
90         return 2;
91 }