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