[m-dev.] diff: fix LLDS back-end `pragma export' bug

[Fergus Henderson]

Estimated hours taken: 2

compiler/export.m:
	Fix a bug that broke `pragma export' of imported procedures in
	some grades, e.g. `none.*'.  It was declaring such procedures
	using `Declare_Entry' rather than `Declare_Static'.
	This bug broke the tests/hard_coded/pragma_export test case.

Workspace: /home/mercury0/fjh/mercury
Index: compiler/export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.39
diff -u -d -r1.39 export.m
--- compiler/export.m	2000/11/17 17:47:07	1.39
+++ compiler/export.m	2000/11/22 14:49:56
@@ -92,7 +92,7 @@
 export__get_foreign_export_decls_2(_Preds, [], []).
 export__get_foreign_export_decls_2(Preds, [E|ExportedProcs], C_ExportDecls) :-
 	E = pragma_exported_proc(PredId, ProcId, C_Function, _Ctxt),
-	get_export_info(Preds, PredId, ProcId, _Exported, C_RetType,
+	get_export_info(Preds, PredId, ProcId, _HowToDeclare, C_RetType,
 		_DeclareReturnVal, _FailureAction, _SuccessAction,
 		HeadArgInfoTypes),
 	get_argument_declarations(HeadArgInfoTypes, no, ArgDecls),
@@ -196,7 +196,7 @@
 export__to_c(_Preds, [], _Module, []).
 export__to_c(Preds, [E|ExportedProcs], Module, ExportedProcsCode) :-
 	E = pragma_exported_proc(PredId, ProcId, C_Function, _Ctxt),
-	get_export_info(Preds, PredId, ProcId, Exported,
+	get_export_info(Preds, PredId, ProcId, DeclareString,
 		C_RetType, MaybeDeclareRetval, MaybeFail, MaybeSucceed,
 		ArgInfoTypes),
 	get_argument_declarations(ArgInfoTypes, yes, ArgDecls),
@@ -209,12 +209,6 @@
 	code_util__make_proc_label(Module, PredId, ProcId, ProcLabel),
 	llds_out__get_proc_label(ProcLabel, yes, ProcLabelString),
 
-	( Exported = yes ->
-		DeclareString = "Declare_entry"
-	;
-		DeclareString = "Declare_static"
-	),
-
 	string__append_list([	"\n",
 				DeclareString, "(", ProcLabelString, ");\n",
 				"\n",
@@ -254,24 +248,34 @@
 	ExportedProcsCode = [Code|TheRest].
 
 
-	% get_export_info(Preds, PredId, ProcId,
+	% get_export_info(Preds, PredId, ProcId, DeclareString,
 	%		C_RetType, MaybeDeclareRetval, MaybeFail, MaybeSuccess,
 	%		ArgInfoTypes):
-	%	Figure out the C return type, the actions on success
-	%	and failure, and the argument locations/modes/types
-	%	for a given procedure.
-:- pred get_export_info(pred_table, pred_id, proc_id, bool,
+	%	For a given procedure, figure out the information about
+	%	that procedure that is needed to export it:
+	%	- how to declare the procedure's entry label,
+	%	- the C return type, and the C declaration for the variable
+	%	  holding the return value (if any),
+	%	- the actions on success and failure, and
+	%	- the argument locations/modes/types.
+
+:- pred get_export_info(pred_table, pred_id, proc_id, string,
 			string, string, string, string,
 			assoc_list(arg_info, type)).
 :- mode get_export_info(in, in, in, out, out, out, out, out, out) is det.
 
-get_export_info(Preds, PredId, ProcId, Exported, C_RetType,
+get_export_info(Preds, PredId, ProcId, HowToDeclareLabel, C_RetType,
 		MaybeDeclareRetval, MaybeFail, MaybeSucceed, ArgInfoTypes) :-
 	map__lookup(Preds, PredId, PredInfo),
-	( procedure_is_exported(PredInfo, ProcId) ->
-		Exported = yes
+	pred_info_import_status(PredInfo, Status),
+	(
+		( procedure_is_exported(PredInfo, ProcId)
+		; status_defined_in_this_module(Status, no)
+		)
+	->
+		HowToDeclareLabel = "Declare_entry"
 	;
-		Exported = no
+		HowToDeclareLabel = "Declare_static"
 	),
 	pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
 	pred_info_procedures(PredInfo, ProcTable),

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