[m-dev.] for review: fix dl.m for HL grades

[Fergus Henderson]

On 11-Jan-2001, Tyson Dowd <trd at cs.mu.OZ.AU> wrote:
> On 11-Jan-2001, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> > Estimated hours taken: 3
> > 
> > extras/dynamic_linking/dl.m:
> > 	Fix a bug with the building of closures for the MLDS back-end:
> > 	the wrapper procedure in the closure gets passed the closure
> > 	as an extra argument, so we can't just use the address return
> > 	from dlsym() in the closure.  Instead, we need to put the
> > 	address of a wrapper procedure in the closure, and have the
> > 	wrapper procedure call the real procedure, passing it all
> > 	the arguments passed to the wrapper *except* for the closure
> > 	argument.
> 
> You should also add the test case (dl_test.m and hello.m) which actually
> uses this code.

Done.  I just forgot to include those bits in the log that I posted.

> > +**
> > +** XXX This will also fail for calling conventions where the callee pops the
> > +** arguments.  To handle that right, we'd need different wrappers for
> > +** each different number of arguments.  (Doing that would also be slightly
> > +** more efficient, so it may worth doing...)
> > +**
> > +** There is a library called `ffcall' which we could use
> > +** to do this in a more portable manner.
> 
> It's called `libffi'
> 
> http://sources.redhat.com/libffi/
> 
> (unless you found another one).

Yes, I found another one.  I'll mention them both.

Here's a revised log message, and diffs for the files
that I forgot in the previous one.

----------

Estimated hours taken: 2.5

extras/dynamic_linking/dl.m:
	Fix a bug with the building of closures for the MLDS back-end:
	the wrapper procedure in the closure gets passed the closure
	as an extra argument, so we can't just use the address return
	from dlsym() in the closure.  Instead, we need to put the
	address of a wrapper procedure in the closure, and have the
	wrapper procedure call the real procedure, passing it all
	the arguments passed to the wrapper *except* for the closure
	argument.

extras/dynamic_linking/Mmakefile:
extras/dynamic_linking/dl_test.m:
extras/dynamic_linking/dl_test2.m:
extras/dynamic_linking/dl_test.exp:
extras/dynamic_linking/dl_test2.exp:
	Move the test case that the MLDS grades don't handle into a
	separate file.  Add a new test for passing integer arguments.

Workspace: /home/pgrad/fjh/ws/gcc/mercury
Index: extras/dynamic_linking/dl_test2.exp
===================================================================
RCS file: dl_test2.exp
diff -N dl_test2.exp
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ dl_test2.exp	Thu Jan 11 13:35:49 2001
@@ -0,0 +1 @@
+1.0 + 2.0 + 3.0 = 6.000000
Index: extras/dynamic_linking/dl_test2.m
===================================================================
RCS file: dl_test2.m
diff -N dl_test2.m
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ dl_test2.m	Thu Jan 11 13:32:27 2001
@@ -0,0 +1,84 @@
+% Example program using dynamic linking.
+% This example tests calling functions with floating point arguments.
+
+% This module loads in the object code for the module `hello'
+% from the file `libhello.so', looks up the address of the
+% function add3/3 in that module, and then calls that procedure.
+
+% This source file is hereby placed in the public domain.  -fjh (the author).
+
+:- module dl_test2.
+:- interface.
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module dl, name_mangle, string, list.
+
+main -->
+	%
+	% Load in the object code for the module `hello' from
+	% the file `libhello.so'.
+	%
+	dl__open("./libhello.so", lazy, local, MaybeHandle),
+	(	
+		{ MaybeHandle = error(Msg) },
+		print("dlopen failed: "), print(Msg), nl
+	;
+		{ MaybeHandle = ok(Handle) },
+
+		{ Add3Proc = mercury_proc(function, unqualified("hello"),
+					"add3", 3, 0) },
+		dl__mercury_sym(Handle, Add3Proc, MaybeAdd3),
+		(
+			{ MaybeAdd3 = error(Msg3) },
+			print("dlsym failed: "), print(Msg3), nl
+		;
+			{ MaybeAdd3 = ok(Add3Func0) },
+			%
+			% Cast the higher-order term that we obtained
+			% to the correct higher-order inst.
+			%
+			{ wrapper(Add3Func) =
+				inst_cast_add3(wrapper(Add3Func0)) },
+			%
+			% Call the procedure whose address
+			% we just obtained.
+			%
+			{ Sum = Add3Func(1.0, 2.0, 3.0) },
+			io__format("1.0 + 2.0 + 3.0 = %f\n", [f(Sum)])
+		),
+
+
+		%
+		% unload the object code in the libhello.so file
+		%
+		dl__close(Handle, Result),
+		(
+			{ Result = error(CloseMsg) },
+			print("dlclose failed: "), print(CloseMsg), nl
+		;
+			{ Result = ok }
+		)
+	).
+
+%
+% dl__mercury_sym returns a higher-order term with inst `ground'.
+% We need to cast it to the right higher-order inst, which for the
+% `add3' function is `func(in, in, in) = out is det', before we can actually
+% call it.  The function inst_cast_add3/1 defined below does that.
+%
+% Note that for arguments of function type, the function type
+% normally gets automatically propagated into the inst.
+% We use a wrapper type to avoid that.
+
+:- type add3 == (func(float, float, float) = float).
+:- type add3_wrapper ---> wrapper(add3).
+:- inst add3_wrapper ---> wrapper(func(in, in, in) = out is det).
+
+:- func inst_cast_add3(add3_wrapper) = add3_wrapper.
+:- mode inst_cast_add3(in) = out(add3_wrapper) is det.
+:- pragma c_code(inst_cast_add3(X::in) = (Y::out(add3_wrapper)),
+	[will_not_call_mercury, thread_safe], "Y = X").
+
Index: extras/dynamic_linking/dl_test.exp
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/dynamic_linking/dl_test.exp,v
retrieving revision 1.2
diff -u -d -r1.2 dl_test.exp
--- extras/dynamic_linking/dl_test.exp	2000/12/18 14:11:26	1.2
+++ extras/dynamic_linking/dl_test.exp	2001/01/11 02:35:46
@@ -1,2 +1,2 @@
 Hello, world
-1.0 + 2.0 + 3.0 = 6.000000
+1 + 2 + 3 = 6
Index: extras/dynamic_linking/dl_test.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/dynamic_linking/dl_test.m,v
retrieving revision 1.3
diff -u -d -r1.3 dl_test.m
--- extras/dynamic_linking/dl_test.m	2000/12/18 16:13:55	1.3
+++ extras/dynamic_linking/dl_test.m	2001/01/11 02:32:54
@@ -49,29 +49,28 @@
 			HelloPred
 		),
 
-		{ Add3Proc = mercury_proc(function, unqualified("hello"),
-					"add3", 3, 0) },
-		dl__mercury_sym(Handle, Add3Proc, MaybeAdd3),
+		{ Add3IntProc = mercury_proc(function, unqualified("hello"),
+					"add3int", 3, 0) },
+		dl__mercury_sym(Handle, Add3IntProc, MaybeAdd3Int),
 		(
-			{ MaybeAdd3 = error(Msg2) },
+			{ MaybeAdd3Int = error(Msg2) },
 			print("dlsym failed: "), print(Msg2), nl
 		;
-			{ MaybeAdd3 = ok(Add3Func0) },
+			{ MaybeAdd3Int = ok(Add3IntFunc0) },
 			%
 			% Cast the higher-order term that we obtained
 			% to the correct higher-order inst.
 			%
-			{ wrapper(Add3Func) =
-				inst_cast_add3(wrapper(Add3Func0)) },
+			{ wrapper(Add3IntFunc) =
+				inst_cast_add3int(wrapper(Add3IntFunc0)) },
 			%
 			% Call the procedure whose address
 			% we just obtained.
 			%
-			{ Sum = Add3Func(1.0, 2.0, 3.0) },
-			io__format("1.0 + 2.0 + 3.0 = %f\n", [f(Sum)])
+			{ SumInt = Add3IntFunc(1, 2, 3) },
+			io__format("1 + 2 + 3 = %d\n", [i(SumInt)])
 		),
 
-
 		%
 		% unload the object code in the libhello.so file
 		%
@@ -99,17 +98,17 @@
 :- pragma c_code(inst_cast(X::in) = (Y::out(io_pred)),
 	[will_not_call_mercury, thread_safe], "Y = X").
 
-% Likewise for `add3'.
+% Likewise for `add3int'.
 % Note that for arguments of function type, the function type
 % normally gets automatically propagated into the inst.
 % We use a wrapper type to avoid that.
 
-:- type add3 == (func(float, float, float) = float).
-:- type add3_wrapper ---> wrapper(add3).
-:- inst add3_wrapper ---> wrapper(func(in, in, in) = out is det).
+:- type add3int == (func(int, int, int) = int).
+:- type add3int_wrapper ---> wrapper(add3int).
+:- inst add3int_wrapper ---> wrapper(func(in, in, in) = out is det).
 
-:- func inst_cast_add3(add3_wrapper) = add3_wrapper.
-:- mode inst_cast_add3(in) = out(add3_wrapper) is det.
-:- pragma c_code(inst_cast_add3(X::in) = (Y::out(add3_wrapper)),
+:- func inst_cast_add3int(add3int_wrapper) = add3int_wrapper.
+:- mode inst_cast_add3int(in) = out(add3int_wrapper) is det.
+:- pragma c_code(inst_cast_add3int(X::in) = (Y::out(add3int_wrapper)),
 	[will_not_call_mercury, thread_safe], "Y = X").
 
Index: extras/dynamic_linking/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/dynamic_linking/Mmakefile,v
retrieving revision 1.4
diff -u -d -r1.4 Mmakefile
--- extras/dynamic_linking/Mmakefile	2000/11/21 23:52:28	1.4
+++ extras/dynamic_linking/Mmakefile	2001/01/11 02:39:25
@@ -18,9 +18,20 @@
 MLFLAGS += --no-strip
 
 main_target: libdl
-depend: dl.depend dl_test.depend hello.depend
+depend: dl.depend dl_test.depend dl_test2.depend hello.depend
 
 .PHONY: check
-check:	dl_test libhello.so
+check:	dl_test.res libhello.so
+
+# The dl_test2 test case only works in non-hl* grades.
+ifeq "$(findstring hl,$(GRADE))" ""
+check: dl_test2.res
+endif
+
+dl_test.res: dl_test dl_test.exp
 	./dl_test > dl_test.out
 	diff -c dl_test.out dl_test.exp
+
+dl_test2.res: dl_test2 dl_test2.exp
+	./dl_test2 > dl_test2.out
+	diff -c dl_test2.out dl_test2.exp

-- 
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
--------------------------------------------------------------------------