ghc/interpreter/dynamic.c

   1
   2 /* --------------------------------------------------------------------------
   3  * Dynamic loading (of .dll or .so files) for Hugs
   4  *
   5  * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
   6  * Yale Haskell Group, and the Oregon Graduate Institute of Science and
   7  * Technology, 1994-1999, All rights reserved.  It is distributed as
   8  * free software under the license in the file "License", which is
   9  * included in the distribution.
  10  *
  11  * $RCSfile: dynamic.c,v $
  12  * $Revision: 1.13 $
  13  * $Date: 1999/11/25 10:19:15 $
  14  * ------------------------------------------------------------------------*/
  15
  16 #include "prelude.h"
  17 #include "storage.h"
  18 #include "errors.h"
  19 #include "dynamic.h"
  20 #include "connect.h"
  21
  22 #if HAVE_WINDOWS_H && !defined(__MSDOS__)
  23
  24 #include <windows.h>
  25
  26 void* getDLLSymbol(line,dll0,symbol0) /* load dll and lookup symbol */
  27 Int    line;
  28 String dll0;
  29 String symbol0; {
  30     void*      sym;
  31     char       dll[1000];
  32     char       symbol[100];
  33     ObjectFile instance;
  34
  35     if (strlen(dll0) > 996-strlen(installDir)) {
  36        ERRMSG(line) "Excessively long library name:\n%s\n",dll0
  37        EEND;
  38     }
  39     dll[0] = 0;
  40     if (strcmp("nHandle",dll0)==0) strcat(dll,installDir);
  41     strcat(dll,dll0);
  42     strcat(dll, ".dll");
  43
  44     if (strlen(symbol0) > 96) {
  45        ERRMSG(line) "Excessively long symbol name:\n%s\n",symbol0
  46        EEND;
  47     }
  48     strcpy(&(symbol[1]),symbol0);
  49     symbol[0] = '_';
  50
  51     instance = LoadLibrary(dll);
  52     if (NULL == instance) {
  53         /* GetLastError allegedly provides more detail - in practice,
  54          * it tells you nothing more.
  55          */
  56         ERRMSG(line) "Can't open library \"%s\"", dll
  57         EEND;
  58     }
  59     sym = GetProcAddress(instance,symbol0);
  60     return sym;
  61 }
  62
  63 Bool stdcallAllowed ( void )
  64 {
  65    return TRUE;
  66 }
  67
  68
  69
  70
  71
  72
  73 #elif HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */
  74
  75 #include <stdio.h>
  76 #include <dlfcn.h>
  77
  78 void* getDLLSymbol(line,dll0,symbol)  /* load dll and lookup symbol */
  79 Int    line;
  80 String dll0;
  81 String symbol; {
  82     void*      sym;
  83     char       dll[1000];
  84     ObjectFile instance;
  85     if (strlen(dll0) > 996-strlen(installDir)) {
  86        ERRMSG(line) "Excessively long library name:\n%s\n",dll0
  87        EEND;
  88     }
  89     dll[0] = 0;
  90     if (strcmp("nHandle",dll0)==0) strcat(dll,installDir);
  91     strcat(dll,dll0);
  92     strcat(dll, ".so");
  93 #ifdef RTLD_NOW
  94     instance = dlopen(dll,RTLD_NOW);
  95 #elif defined RTLD_LAZY /* eg SunOS4 doesn't have RTLD_NOW */
  96     instance = dlopen(dll,RTLD_LAZY);
  97 #else /* eg FreeBSD doesn't have RTLD_LAZY */
  98     instance = dlopen(dll,1);
  99 #endif
 100
 101     if (NULL == instance) {
 102         ERRMSG(line) "Can't open library \"%s\":\n      %s\n",dll,dlerror()
 103         EEND;
 104     }
 105     if ((sym = dlsym(instance,symbol)))
 106         return sym;
 107
 108     ERRMSG(line) "Can't find symbol \"%s\" in library \"%s\"",symbol,dll
 109     EEND;
 110 }
 111
 112 Bool stdcallAllowed ( void )
 113 {
 114    return FALSE;
 115 }
 116
 117
 118
 119
 120
 121
 122 #elif HAVE_DL_H /* eg HPUX */
 123
 124 #include <dl.h>
 125
 126 void* getDLLSymbol(line,dll0,symbol)  /* load dll and lookup symbol */
 127 Int    line;
 128 String dll0;
 129 String symbol; {
 130     ObjectFile instance = shl_load(dll,BIND_IMMEDIATE,0L);
 131     void* r;
 132     if (NULL == instance) {
 133         ERRMSG(line) "Error while importing DLL \"%s\"", dll0
 134         EEND;
 135     }
 136     return (0 == shl_findsym(&instance,symbol,TYPE_PROCEDURE,&r)) ? r : 0;
 137 }
 138
 139 Bool stdcallAllowed ( void )
 140 {
 141    return FALSE;
 142 }
 143
 144
 145
 146
 147
 148
 149 #else /* Dynamic loading not available */
 150
 151 void* getDLLSymbol(line,dll0,symbol)  /* load dll and lookup symbol */
 152 Int    line;
 153 String dll0;
 154 String symbol; {
 155 #if 1 /* very little to choose between these options */
 156     return 0;
 157 #else
 158     ERRMSG(line) "This Hugs build does not support dynamic loading\n"
 159     EEND;
 160 #endif
 161 }
 162
 163 Bool stdcallAllowed ( void )
 164 {
 165    return FALSE;
 166 }
 167
 168 #endif /* Dynamic loading not available */
 169