This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
02ca2efd4624c7ad6a2c2204401ff515c4b92c6c
[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 void *
12 dlopen(char *path, int mode)
13 {
14         HMODULE handle;
15         char tmp[260], *beg, *dot;
16         ULONG rc;
17
18         fail[0] = 0;
19         if ((rc = DosLoadModule(fail, sizeof fail, path, &handle)) == 0)
20                 return (void *)handle;
21
22         retcode = rc;
23
24         /* Not found. Check for non-FAT name and try truncated name. */
25         /* Don't know if this helps though... */
26         for (beg = dot = path + strlen(path);
27              beg > path && !strchr(":/\\", *(beg-1));
28              beg--)
29                 if (*beg == '.')
30                         dot = beg;
31         if (dot - beg > 8) {
32                 int n = beg+8-path;
33                 memmove(tmp, path, n);
34                 memmove(tmp+n, dot, strlen(dot)+1);
35                 if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0)
36                         return (void *)handle;
37         }
38
39         return NULL;
40 }
41
42 void *
43 dlsym(void *handle, char *symbol)
44 {
45         ULONG rc, type;
46         PFN addr;
47
48         fail[0] = 0;
49         rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr);
50         if (rc == 0) {
51                 rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type);
52                 if (rc == 0 && type == PT_32BIT)
53                         return (void *)addr;
54                 rc = ERROR_CALL_NOT_IMPLEMENTED;
55         }
56         retcode = rc;
57         return NULL;
58 }
59
60 char *
61 dlerror(void)
62 {
63         static char buf[700];
64         ULONG len;
65
66         if (retcode == 0)
67                 return NULL;
68         if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, retcode,
69                           "OSO001.MSG", &len)) {
70                 if (fail[0])
71                   sprintf(buf, 
72 "OS/2 system error code %lu, possible problematic module: '%s'",
73                           retcode, fail);
74                 else
75                   sprintf(buf, "OS/2 system error code %lu", retcode);
76         } else {
77                 buf[len] = '\0';
78                 if (len && buf[len - 1] == '\n')
79                         buf[--len] = 0;
80                 if (len && buf[len - 1] == '\r')
81                         buf[--len] = 0;
82                 if (len && buf[len - 1] == '.')
83                         buf[--len] = 0;
84                 if (fail[0] && len < 300)
85                   sprintf(buf + len, ", possible problematic module: '%s'",
86                           fail);
87         }
88         retcode = 0;
89         return buf;
90 }
91
92 int
93 dlclose(void *handle)
94 {
95         ULONG rc;
96
97         if ((rc = DosFreeModule((HMODULE)handle)) == 0) return 0;
98
99         retcode = rc;
100         return 2;
101 }