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