[m-rev.] diff: fix bug in exported procs with foreign_type outputs

[Zoltan Somogyi]

On 25-Jun-2003, Zoltan Somogyi <zs at cs.mu.OZ.AU> wrote:
> compiler/export.m:
> 	Fix a bug. Output arguments of exported predicates are passed by
> 	reference, but the code to return them was assigning the returned value
> 	to the pointer, not the pointed-to storage. The fix is to add the
> 	required indirection.
> 
> tests/hard_coded/foreign_type.{m,exp}:
> 	Expand this test case to act as a regression test for this bug.
> 	Prior to this change, the compiler generated code that core dumped
> 	on the last batch of coordinates.

Here is a fix for a related bug. It was developed together with Fergus,
so it has effectively already been reviewed.

Zoltan.

compiler/mlds_to_c.m:
	Fix a bug: when an output argument of an exported procedure is
	of a foreign type, we used to declare the local variables representing
	the boxed versions of these arguments as type MR_Box *, when the
	correct type is MR_Box.

Index: mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.149
diff -u -b -r1.149 mlds_to_c.m
--- mlds_to_c.m	11 Jun 2003 12:55:28 -0000	1.149
+++ mlds_to_c.m	3 Jul 2003 09:54:57 -0000
@@ -769,14 +769,10 @@
 		Type = mlds__ptr_type(mlds__foreign_type(c(_)))) },
 	{ CForeignTypeInputs = list__filter(IsCForeignType, Parameters) },
 	{ CForeignTypeOutputs = list__filter(IsCForeignTypePtr, Parameters) },
-	io__write_list(CForeignTypeInputs ++ CForeignTypeOutputs, "",
-		(pred(Arg::in, di, uo) is det -->
-			{ Arg = mlds__argument(Name, Type, _GC_TraceCode) },
-			io__write_string("\t"),
-			mlds_output_data_decl_ho(mlds_output_type_prefix,
-				mlds_output_type_suffix,
-				qual(ModuleName, boxed_name(Name)), Type),
-			io__write_string(";\n"))),
+	io__write_list(CForeignTypeInputs, "",
+		mlds_output_pragma_export_input_defns(ModuleName)),
+	io__write_list(CForeignTypeOutputs, "",
+		mlds_output_pragma_export_output_defns(ModuleName)),
 
 	% Declare a local variable or two for the return value, if needed
 	( { RetTypes = [RetType1] } ->
@@ -846,7 +842,7 @@
 			{ QualName = qual(ModuleName, Name) },
 			{ BoxedQualName = qual(ModuleName, boxed_name(Name)) },
 			io__write_string("\tMR_MAYBE_UNBOX_FOREIGN_TYPE("),
-			mlds_output_pragma_export_type(Type),
+			mlds_output_pragma_export_type(pointed_to_type(Type)),
 			io__write_string(", "),
 			mlds_output_fully_qualified_name(BoxedQualName),
 			io__write_string(", *"),
@@ -866,6 +862,37 @@
 		io__write_string("\treturn ret_value;\n")
 	;
 		[]
+	).
+
+:- pred mlds_output_pragma_export_input_defns(mlds_module_name::in,
+	mlds__argument::in, io__state::di, io__state::uo) is det.
+
+mlds_output_pragma_export_input_defns(ModuleName, Arg) -->
+	{ Arg = mlds__argument(Name, Type, _GC_TraceCode) },
+	io__write_string("\t"),
+	mlds_output_data_decl_ho(mlds_output_type_prefix,
+		mlds_output_type_suffix,
+		qual(ModuleName, boxed_name(Name)), Type),
+	io__write_string(";\n").
+
+:- pred mlds_output_pragma_export_output_defns(mlds_module_name::in,
+	mlds__argument::in, io__state::di, io__state::uo) is det.
+
+mlds_output_pragma_export_output_defns(ModuleName, Arg) -->
+	{ Arg = mlds__argument(Name, Type, _GC_TraceCode) },
+	io__write_string("\t"),
+	mlds_output_data_decl_ho(mlds_output_type_prefix,
+		mlds_output_type_suffix,
+		qual(ModuleName, boxed_name(Name)), pointed_to_type(Type)),
+	io__write_string(";\n").
+
+:- func pointed_to_type(mlds__type) = mlds__type.
+
+pointed_to_type(PtrType) =
+	( PtrType = mlds__ptr_type(Type) ->
+		Type
+	;
+		func_error("pointed_to_type: not pointer")
 	).
 
 :- func boxed_name(mlds__entity_name) = mlds__entity_name.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------