source: trunk/third/perl/os2/dl_os2.c @ 10724

Revision 10724, 1.3 KB checked in by ghudson, 27 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r10723, which included commits to RCS files with non-trunk default branches.
Line 
1#include "dlfcn.h"
2
3#define INCL_BASE
4#include <os2.h>
5
6static ULONG retcode;
7
8void *
9dlopen(char *path, int mode)
10{
11        HMODULE handle;
12        char tmp[260], *beg, *dot;
13        char fail[300];
14        ULONG rc;
15
16        if ((rc = DosLoadModule(fail, sizeof fail, path, &handle)) == 0)
17                return (void *)handle;
18
19        retcode = rc;
20
21        /* Not found. Check for non-FAT name and try truncated name. */
22        /* Don't know if this helps though... */
23        for (beg = dot = path + strlen(path);
24             beg > path && !strchr(":/\\", *(beg-1));
25             beg--)
26                if (*beg == '.')
27                        dot = beg;
28        if (dot - beg > 8) {
29                int n = beg+8-path;
30                memmove(tmp, path, n);
31                memmove(tmp+n, dot, strlen(dot)+1);
32                if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0)
33                        return (void *)handle;
34        }
35
36        return NULL;
37}
38
39void *
40dlsym(void *handle, char *symbol)
41{
42        ULONG rc, type;
43        PFN addr;
44
45        rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr);
46        if (rc == 0) {
47                rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type);
48                if (rc == 0 && type == PT_32BIT)
49                        return (void *)addr;
50                rc = ERROR_CALL_NOT_IMPLEMENTED;
51        }
52        retcode = rc;
53        return NULL;
54}
55
56char *
57dlerror(void)
58{
59        static char buf[300];
60        ULONG len;
61
62        if (retcode == 0)
63                return NULL;
64        if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, retcode, "OSO001.MSG", &len))
65                sprintf(buf, "OS/2 system error code %d", retcode);
66        else
67                buf[len] = '\0';
68        retcode = 0;
69        return buf;
70}
71
Note: See TracBrowser for help on using the repository browser.