-/* -*- mode: hugs-c; -*- */
+
/* --------------------------------------------------------------------------
* Dynamic loading (of .dll or .so files) for Hugs
*
- * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
- * All rights reserved. See NOTICE for details and conditions of use etc...
- * Hugs version 1.4, December 1997
+ * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
+ * Yale Haskell Group, and the Oregon Graduate Institute of Science and
+ * Technology, 1994-1999, All rights reserved. It is distributed as
+ * free software under the license in the file "License", which is
+ * included in the distribution.
*
* $RCSfile: dynamic.c,v $
- * $Revision: 1.2 $
- * $Date: 1998/12/02 13:22:06 $
+ * $Revision: 1.15 $
+ * $Date: 2000/03/23 14:54:21 $
* ------------------------------------------------------------------------*/
-#include "prelude.h"
+#include "hugsbasictypes.h"
#include "storage.h"
#include "errors.h"
-#include "dynamic.h"
+#include "connect.h"
-#if HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */
+#if HAVE_WINDOWS_H && !defined(__MSDOS__)
-#include <stdio.h>
-#include <dlfcn.h>
+#include <windows.h>
+
+void* getDLLSymbol(line,dll0,symbol0) /* load dll and lookup symbol */
+Int line;
+String dll0;
+String symbol0; {
+ void* sym;
+ char dll[1000];
+ char symbol[100];
+ ObjectFile instance;
+
+ if (strlen(dll0) > 996-strlen(installDir)) {
+ ERRMSG(line) "Excessively long library name:\n%s\n",dll0
+ EEND;
+ }
+ dll[0] = 0;
+ if (strcmp("nHandle",dll0)==0) strcat(dll,installDir);
+ strcat(dll,dll0);
+ strcat(dll, ".dll");
+
+ if (strlen(symbol0) > 96) {
+ ERRMSG(line) "Excessively long symbol name:\n%s\n",symbol0
+ EEND;
+ }
+ strcpy(&(symbol[1]),symbol0);
+ symbol[0] = '_';
-ObjectFile loadLibrary(fn)
-String fn; {
- return dlopen(fn,RTLD_NOW | RTLD_GLOBAL);
+ instance = LoadLibrary(dll);
+ if (NULL == instance) {
+ /* GetLastError allegedly provides more detail - in practice,
+ * it tells you nothing more.
+ */
+ ERRMSG(line) "Can't open library \"%s\"", dll
+ EEND;
+ }
+ sym = GetProcAddress(instance,symbol0);
+ return sym;
}
-void* lookupSymbol(file,symbol)
-ObjectFile file;
-String symbol; {
- return dlsym(file,symbol)
+Bool stdcallAllowed ( void )
+{
+ return TRUE;
}
-void* getDLLSymbol(dll,symbol) /* load dll and lookup symbol */
-String dll;
+
+
+
+
+
+#elif HAVE_DLFCN_H /* eg LINUX, SOLARIS, ULTRIX */
+
+#include <stdio.h>
+#include <dlfcn.h>
+
+void* getDLLSymbol(line,dll0,symbol) /* load dll and lookup symbol */
+Int line;
+String dll0;
String symbol; {
+ void* sym;
+ char dll[1000];
+ ObjectFile instance;
+ if (strlen(dll0) > 996-strlen(installDir)) {
+ ERRMSG(line) "Excessively long library name:\n%s\n",dll0
+ EEND;
+ }
+ dll[0] = 0;
+ if (strcmp("nHandle",dll0)==0) strcat(dll,installDir);
+ strcat(dll,dll0);
+ strcat(dll, ".so");
#ifdef RTLD_NOW
- ObjectFile instance = dlopen(dll,RTLD_NOW);
+ instance = dlopen(dll,RTLD_NOW);
#elif defined RTLD_LAZY /* eg SunOS4 doesn't have RTLD_NOW */
- ObjectFile instance = dlopen(dll,RTLD_LAZY);
+ instance = dlopen(dll,RTLD_LAZY);
#else /* eg FreeBSD doesn't have RTLD_LAZY */
- ObjectFile instance = dlopen(dll,1);
+ instance = dlopen(dll,1);
#endif
+
if (NULL == instance) {
- ERRMSG(0) "Error %s while importing DLL \"%s\"", dlerror(), dll
+ ERRMSG(line) "Can't open library \"%s\":\n %s\n",dll,dlerror()
EEND;
}
- return dlsym(instance,symbol);
+ if ((sym = dlsym(instance,symbol)))
+ return sym;
+
+ ERRMSG(line) "Can't find symbol \"%s\" in library \"%s\"",symbol,dll
+ EEND;
}
+Bool stdcallAllowed ( void )
+{
+ return FALSE;
+}
+
+
+
+
+
+
#elif HAVE_DL_H /* eg HPUX */
#include <dl.h>
-void* getDLLSymbol(dll,symbol) /* load dll and lookup symbol */
-String dll;
+void* getDLLSymbol(line,dll0,symbol) /* load dll and lookup symbol */
+Int line;
+String dll0;
String symbol; {
ObjectFile instance = shl_load(dll,BIND_IMMEDIATE,0L);
void* r;
if (NULL == instance) {
- ERRMSG(0) "Error while importing DLL \"%s\"", dll
+ ERRMSG(line) "Error while importing DLL \"%s\"", dll0
EEND;
}
return (0 == shl_findsym(&instance,symbol,TYPE_PROCEDURE,&r)) ? r : 0;
}
-#elif HAVE_WINDOWS_H && !defined(__MSDOS__)
+Bool stdcallAllowed ( void )
+{
+ return FALSE;
+}
-#include <windows.h>
-ObjectFile loadLibrary(fn)
-String fn; {
- return LoadLibrary(fn);
-}
-void* lookupSymbol(file,symbol)
-ObjectFile file;
-String symbol; {
- return GetProcAddress(file,symbol);
-}
-const char *dlerror(void)
-{
- return "<unknown>";
-}
-void* getDLLSymbol(dll,symbol) /* load dll and lookup symbol */
-String dll;
-String symbol; {
- ObjectFile instance = LoadLibrary(dll);
- if (NULL == instance) {
- /* GetLastError allegedly provides more detail - in practice,
- * it tells you nothing more.
- */
- ERRMSG(0) "Error while importing DLL \"%s\"", dll
- EEND;
- }
- return GetProcAddress(instance,symbol);
-}
#else /* Dynamic loading not available */
-void* getDLLSymbol(dll,symbol) /* load dll and lookup symbol */
-String dll;
+void* getDLLSymbol(line,dll0,symbol) /* load dll and lookup symbol */
+Int line;
+String dll0;
String symbol; {
#if 1 /* very little to choose between these options */
return 0;
#else
- ERRMSG(0) "This Hugs build does not support dynamic loading\n"
+ ERRMSG(line) "This Hugs build does not support dynamic loading\n"
EEND;
#endif
}
+Bool stdcallAllowed ( void )
+{
+ return FALSE;
+}
+
#endif /* Dynamic loading not available */