[m-dev.] diff: update extras/dynamic_linking

[Fergus Henderson]

Estimated hours taken: 0.25

extras/dynamic_linking/Mmakefile:
	Add the appropriate flags to use shared libraries
	(since on Linux this is not the default).
	Link in `-ldl'.

extras/dynamic_linking/dl.m:
	Apply some bug fixes that were previously applied to browser/mdb.m.
	(XXX we really ought to fix this code duplication problem...)

Workspace: /home/pgrad/fjh/ws/hg
Index: extras/dynamic_linking/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/dynamic_linking/Mmakefile,v
retrieving revision 1.1
diff -u -d -r1.1 Mmakefile
--- extras/dynamic_linking/Mmakefile	1998/12/06 06:15:14	1.1
+++ extras/dynamic_linking/Mmakefile	2000/11/21 07:37:25
@@ -1,6 +1,13 @@
+# Use shared libraries, since they're needed for dynamic linking
+MGNUCFLAGS = --pic-reg
+MLFLAGS = --shared
+
+# Link in the `-ldl' library (this may not be needed on some systems)
+#MLLIBS = -ldl
+
 # enable C-level debugging
 CFLAGS = -g
-MLFLAGS = --no-strip
+MLFLAGS += --no-strip
 
 main_target: libdl
 depend: dl.depend dl_test.depend hello.depend

Index: extras/dynamic_linking/dl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/dynamic_linking/dl.m,v
retrieving revision 1.1
diff -u -d -r1.1 dl.m
--- extras/dynamic_linking/dl.m	1998/12/06 06:15:15	1.1
+++ extras/dynamic_linking/dl.m	2000/11/21 07:25:52
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1998 The University of Melbourne.
+% Copyright (C) 1998-2000 The University of Melbourne.
 % This file may only be copied under the terms of the GNU Library General
 % Public License - see the file COPYING.LIB in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -55,8 +55,13 @@
 :- implementation.
 :- import_module std_util, require, string, list.
 
-:- pragma c_header_code("#include <stdio.h>").
-:- pragma c_header_code("#include <dlfcn.h>").
+:- pragma c_header_code("
+	#include <stdio.h>
+	#include ""mercury_conf.h""
+#ifdef HAVE_DLFCN_H
+	#include <dlfcn.h>
+#endif
+").
 
 :- type handle ---> handle(c_pointer).
 
@@ -85,15 +90,36 @@
 :- pragma c_code(dlopen(FileName::in, Mode::in, Scope::in, Result::out,
 		_IO0::di, _IO::uo), [], "
 {
+#if defined(HAVE_DLFCN_H) && defined(HAVE_DLOPEN) \
+ && defined(RTLD_NOW) && defined(RTLD_LAZY)
 	int mode = (Mode ? RTLD_NOW : RTLD_LAZY);
 	/* not all systems have RTLD_GLOBAL */
 	#ifdef RTLD_GLOBAL
 	  if (Scope) mode |= RTLD_GLOBAL;
 	#endif
-	Result = (Word) dlopen(FileName, mode);
+	Result = (MR_Word) dlopen(FileName, mode);
+#else
+	Result = (MR_Word) NULL;
+#endif
 }").
 
-:- type closure ---> closure(int, c_pointer).
+:- type closure_layout
+	--->	closure_layout(
+			int,
+			string,
+			string,
+			string,
+			int,
+			int,
+			int
+		).
+
+:- type closure
+	--->	closure(
+			closure_layout,
+			c_pointer,
+			int
+		).
 
 mercury_sym(Handle, MercuryProc0, Result) -->
 	{ check_proc_spec_matches_result_type(Result, _,
@@ -109,7 +135,9 @@
 		% convert the procedure address to a closure
 		%
 		NumCurriedInputArgs = 0,
-		Closure = closure(NumCurriedInputArgs, Address),
+		ClosureLayout = closure_layout(0, "unknown", "unknown",
+			"unknown", -1, -1, -1),
+		Closure = closure(ClosureLayout, Address, NumCurriedInputArgs),
 		private_builtin__unsafe_type_cast(Closure, Value),
 		Result = ok(Value)
 	}.
@@ -176,16 +204,28 @@
 :- pragma c_code(dlsym(Handle::in, Name::in, Pointer::out,
 	_IO0::di, _IO::uo), [will_not_call_mercury], "
 {
-	Pointer = (Word) dlsym((void *) Handle, Name);
+#if defined(HAVE_DLFCN_H) && defined(HAVE_DLSYM)
+	Pointer = (MR_Word) dlsym((void *) Handle, Name);
+#else
+	Pointer = (MR_Word) NULL;
+#endif
 }").
 
 :- pred dlerror(string::out, io__state::di, io__state::uo) is det.
 :- pragma c_code(dlerror(ErrorMsg::out, _IO0::di, _IO::uo),
 	[will_not_call_mercury], "
 {
-	const char *msg = dlerror();
+	const char *msg;
+
+#if defined(HAVE_DLFCN_H) && defined(HAVE_DLERROR)
+	msg = dlerror();
 	if (msg == NULL) msg = """";
-	make_aligned_string_copy(ErrorMsg, msg);
+#else
+	MR_make_aligned_string(msg, ""sorry, not implemented: ""
+		""dynamic linking not supported on this platform"");
+#endif
+
+	MR_make_aligned_string_copy(ErrorMsg, msg);
 }").
 
 close(handle(Handle), Result) -->
@@ -193,6 +233,14 @@
 	dlerror(ErrorMsg),
 	{ Result = (if ErrorMsg = "" then ok else error(ErrorMsg)) }.
 
+/*
+** Note that dlclose() may call finalization code (e.g. destructors for global
+** variables in C++) which may end up calling Mercury, so it's not safe
+** to declare this as `will_not_call_mercury'.
+*/
 :- pred dlclose(c_pointer::in, io__state::di, io__state::uo) is det.
-:- pragma c_code(dlclose(Handle::in, _IO0::di, _IO::uo),
-	[will_not_call_mercury], "dlclose((void *)Handle)").
+:- pragma c_code(dlclose(Handle::in, _IO0::di, _IO::uo), [], "
+#if defined(HAVE_DLFCN_H) && defined(HAVE_DLCLOSE)
+	dlclose((void *)Handle)
+#endif
+").
-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------