perl/os2/dl_os2.c
<<
>>
Prefs
   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
  10static ULONG retcode;
  11static char fail[300];
  12
  13static ULONG dllHandle;
  14static int handle_found;
  15static int handle_loaded;
  16#ifdef PERL_CORE
  17
  18#include "EXTERN.h"
  19#include "perl.h"
  20
  21#else
  22
  23char *os2error(int rc);
  24
  25#endif
  26
  27#ifdef DLOPEN_INITTERM
  28unsigned 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
  48HMODULE
  49find_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
  78void *
  79dlopen(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
 145void *
 146dlsym(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
 163char *
 164dlerror(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
 186int
 187dlclose(void *handle)
 188{
 189        ULONG rc;
 190
 191        if ((rc = DosFreeModule((HMODULE)handle)) == 0) return 0;
 192
 193        retcode = rc;
 194        return 2;
 195}
 196
lxr.linux.no kindly hosted by Redpill Linpro AS, provider of Linux consulting and operations services since 1995.