[m-dev.] diff: MLDS back-end bug fixes

Fergus Henderson fjh at cs.mu.OZ.AU
Fri May 12 07:09:48 AEST 2000
Previous message: [m-dev.] trivial diff: fix browser default depth
Next message: [m-dev.] MLDS back-end bootstrapped!
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Estimated hours taken: 12

Fix several bugs in the MLDS back-end:
- a bug in tail recursion optimization
- a bug that lead to duplicate field names in environment structs
- a few miscellaneous fixes for runtime/mercury.{h,c}.

compiler/mlds_to_c.m:
	Fix a bug with tail recursion optimization:
	for the tail recursive call `p(H1, H2) :- ... p(H2, H1) ...',
	it was generating code of the form 

		void p(MR_Word H1, MR_Word H2) {
			for(;;) {
				...
				{
				H1 = H2;
				H2 = H1;
				continue;
				}
				...
			}
		}

	which clobbered the value of H1.  The fix was to change
	it to generate code which assigns the new arguments to
	temporary local variables before assigning them to the
	headvars:

		void p(MR_Word H1, MR_Word H2) {
			for(;;) {
				...
				{
				MR_Word H1__tmp_copy = H2;
				MR_Word H2__tmp_copy = H1;
				H1 = H1__tmp_copy;
				H2 = H2__tmp_copy;
				continue;
				...
			}
		}

compiler/ml_code_util.m:
	Add a new function ml_gen_mlds_var_decl/4, for use by
	mlds_to_c.m for the tempoaries it now generates when handling
	tail recursion.

compiler/ml_call_gen.m:
	Ensure that the temporary conversion variables generated by
	ml_gen_box_or_unbox_lval all have distinct names, by including
	a sequence number in the name.  This is needed because
	ml_elim_nested.m assumes that all variables defined in a
	function have different names; if two variables are defined in
	different scopes with the same name, then when ml_elim_nested
	hoists them out, this leads to a duplicate field name in the
	environment struct.

compiler/ml_code_util.m:
	Add a new counter field to the ml_gen_info and a new predicate
	ml_gen_info_new_conv_var for accessing it, for use by
	ml_gen_box_or_unbox_lval in ml_call_gen.m.

runtime/mercury.c:
	Add definitions for some functions declared `extern inline'
	in runtime/mercury_heap.h.

runtime/mercury.h:
	- Delete some unnecessary `#ifdef ... #define ... #endif' guards;
	  everything in this file is already protected by the
	  `#ifndef MERCURY_H' guard at the top of the file.
	- Increase the fixed limit here on the arity of types from 5 to 10,
	  since some files in the compiler directory use higher-order
	  types with arities greater than 5.
	- Add a macro version of MR_box_float(), using gcc's `({...})'
	  extension.

Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.8
diff -u -d -r1.8 ml_call_gen.m
--- compiler/ml_call_gen.m	2000/05/10 18:06:51	1.8
+++ compiler/ml_call_gen.m	2000/05/11 04:45:08
@@ -564,7 +564,9 @@
 		%
 
 		% generate a declaration for the fresh variable
-		{ ArgVarName = string__append("conv_", VarName) },
+		ml_gen_info_new_conv_var(ConvVarNum),
+		{ string__format("conv%d_%s", [i(ConvVarNum), s(VarName)],
+			ArgVarName) },
 		{ ArgVarDecl = ml_gen_var_decl(ArgVarName, CalleeType,
 			mlds__make_context(Context)) },
 		{ ConvDecls = [ArgVarDecl] },
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.10
diff -u -d -r1.10 ml_code_util.m
--- compiler/ml_code_util.m	2000/05/10 18:06:52	1.10
+++ compiler/ml_code_util.m	2000/05/11 18:52:19
@@ -197,6 +197,12 @@
 :- func ml_gen_mlds_var_decl(mlds__data_name, mlds__type, mlds__context) =
 	mlds__defn.
 
+	% Generate a declaration for an MLDS variable, given its MLDS type
+	% and initializer.
+	%
+:- func ml_gen_mlds_var_decl(mlds__data_name, mlds__type, mlds__initializer,
+	mlds__context) = mlds__defn.
+
 %-----------------------------------------------------------------------------%
 %
 % Routines for handling success and failure
@@ -412,6 +418,16 @@
 		ml_gen_info, ml_gen_info).
 :- mode ml_gen_info_new_cond_var(out, in, out) is det.
 
+	% Generate a new `conv' variable number.
+	% This is used to give unique names to the local
+	% variables generated by ml_gen_box_or_unbox_lval,
+	% which are used to handle boxing/unboxing
+	% argument conversions.
+:- type conv_seq == int.
+:- pred ml_gen_info_new_conv_var(conv_seq,
+		ml_gen_info, ml_gen_info).
+:- mode ml_gen_info_new_conv_var(out, in, out) is det.
+
 	%
 	% A success continuation specifies the (rval for the variable
 	% holding the address of the) function that a nondet procedure
@@ -1000,9 +1016,16 @@
 
 	% Generate a declaration for an MLDS variable, given its MLDS type.
 	%
-ml_gen_mlds_var_decl(DataName, MLDS_Type, Context) = MLDS_Defn :-
+ml_gen_mlds_var_decl(DataName, MLDS_Type, Context) = 
+	ml_gen_mlds_var_decl(DataName, MLDS_Type, no_initializer, Context).
+	
+
+	% Generate a declaration for an MLDS variable, given its MLDS type
+	% and initializer.
+	%
+ml_gen_mlds_var_decl(DataName, MLDS_Type, Initializer, Context) = MLDS_Defn :-
 	Name = data(DataName),
-	Defn = data(MLDS_Type, no_initializer),
+	Defn = data(MLDS_Type, Initializer),
 	DeclFlags = ml_gen_var_decl_flags,
 	MLDS_Defn = mlds__defn(Name, Context, DeclFlags, Defn).
 
@@ -1241,6 +1264,7 @@
 			func_label :: mlds__func_sequence_num,
 			commit_label :: commit_sequence_num,
 			cond_var :: cond_seq,
+			conv_var :: conv_seq,
 			success_cont_stack :: stack(success_cont),
 				% definitions of functions or global
 				% constants which should be inserted
@@ -1260,7 +1284,8 @@
 		VarTypes),
 	FuncLabelCounter = 0,
 	CommitLabelCounter = 0,
-	SucceededVarCounter = 0,
+	CondVarCounter = 0,
+	ConvVarCounter = 0,
 	stack__init(SuccContStack),
 	ExtraDefns = [],
 	MLDSGenInfo = ml_gen_info(
@@ -1272,7 +1297,8 @@
 			OutputVars,
 			FuncLabelCounter,
 			CommitLabelCounter,
-			SucceededVarCounter,
+			CondVarCounter,
+			ConvVarCounter,
 			SuccContStack,
 			ExtraDefns
 		).
@@ -1308,6 +1334,9 @@
 
 ml_gen_info_new_cond_var(CondVar, Info, Info^cond_var := CondVar) :-
 	CondVar = Info^cond_var + 1.
+
+ml_gen_info_new_conv_var(ConvVar, Info, Info^conv_var := ConvVar) :-
+	ConvVar = Info^conv_var + 1.
 
 ml_gen_info_push_success_cont(SuccCont, Info,
 	Info^success_cont_stack :=
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.30
diff -u -d -r1.30 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/05/10 18:06:55	1.30
+++ compiler/mlds_to_c.m	2000/05/11 21:01:51
@@ -36,7 +36,9 @@
 				% llds_out__make_base_typeclass_info_name.
 :- import_module rtti.		% for rtti__addr_to_string.
 :- import_module rtti_to_mlds.	% for mlds_rtti_type_name.
-:- import_module hlds_pred.	% for `pred_proc_id'.
+:- import_module hlds_pred.	% for pred_proc_id.
+:- import_module ml_code_util.	% for ml_gen_mlds_var_decl, which is used by
+				% the code that handles tail recursion.
 :- import_module globals, options, passes_aux.
 :- import_module builtin_ops, c_util, modules.
 :- import_module prog_data, prog_out.
@@ -1350,24 +1352,54 @@
 	{ error("mlds_output_assign_args: length mismatch") }.
 mlds_output_assign_args(_, _, _, [], []) --> [].
 mlds_output_assign_args(Indent, ModuleName, Context,
-		[Name - _Type | Rest], [Arg | Args]) -->
+		[Name - Type | Rest], [Arg | Args]) -->
+	%
+	% extract the variable name
+	%
+	{ Name = data(var(VarName1)) ->
+		VarName = VarName1
+	;
+		error("mlds_output_assign_args: arg is not a variable!")
+	},
 	(
 		%
 		% don't bother assigning a variable to itself
 		%
-		{ Name = data(var(VarName)) },
-		{ QualVarName = qual(ModuleName, VarName) },
-		{ Arg = lval(var(QualVarName)) }
+		{ Arg = lval(var(qual(ModuleName, VarName))) }
 	->
-		[]
+		mlds_output_assign_args(Indent, ModuleName, Context, Rest, Args)
 	;
+		% Declare a temporary variable, initialized it to the arg,
+		% recursively process the remaining args,
+		% and then assign the temporary to the parameter:
+		%
+		%	SomeType argN__tmp_copy = new_argN_value;
+		%	...
+		%	new_argN_value = argN_tmp_copy;
+		%
+		% The temporaries are needed for the case where
+		% we are e.g. assigning v1, v2 to v2, v1;
+		% they ensure that we don't try to reference the old value of
+		% a parameter after it has already been clobbered by the
+		% new value.
+
+		{ string__append(VarName, "__tmp_copy", TempName) },
+		{ QualTempName = qual(ModuleName, data(var(TempName))) },
+		{ Initializer = init_obj(Arg) },
+		{ TempDefn = ml_gen_mlds_var_decl(var(TempName), Type,
+			Initializer, Context) },
+		mlds_output_defn(Indent, ModuleName, TempDefn),
+
+		mlds_output_assign_args(Indent, ModuleName, Context, Rest, Args),
+
 		mlds_indent(Context, Indent),
 		mlds_output_fully_qualified_name(qual(ModuleName, Name)),
 		io__write_string(" = "),
-		mlds_output_rval(Arg),
+		mlds_output_fully_qualified_name(QualTempName),
 		io__write_string(";\n")
-	),
-	mlds_output_assign_args(Indent, ModuleName, Context, Rest, Args).
+	).
+
+%-----------------------------------------------------------------------------%
 
 	%
 	% exception handling
Index: runtime/mercury.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.c,v
retrieving revision 1.4
diff -u -d -r1.4 mercury.c
--- runtime/mercury.c	2000/05/08 16:11:05	1.4
+++ runtime/mercury.c	2000/05/11 16:50:32
@@ -770,6 +770,41 @@
 
 /*---------------------------------------------------------------------------*/
 
+#ifdef __GNUC__
+
+/* provide definitions for functions declared `extern inline' */
+
+Word
+create1(Word w1) 
+{
+	Word *p = (Word *) MR_new_object(Word, 1 * sizeof(Word), "create1");
+	p[0] = w1;
+	return (Word) p;
+}
+
+Word
+create2(Word w1, Word w2) 
+{
+	Word *p = (Word *) MR_new_object(Word, 2 * sizeof(Word), "create2");
+	p[0] = w1;
+	p[1] = w2;
+	return (Word) p;
+}
+
+Word
+create3(Word w1, Word w2, Word w3) 
+{
+	Word *p = (Word *) MR_new_object(Word, 3 * sizeof(Word), "create3");
+	p[0] = w1;
+	p[1] = w2;
+	p[2] = w3;
+	return (Word) p;
+}
+
+#endif
+
+/*---------------------------------------------------------------------------*/
+
 /*
 ** XXX this is a hack to work-around the current lack of
 ** support for `pragma export'.
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.8
diff -u -d -r1.8 mercury.h
--- runtime/mercury.h	2000/05/10 18:09:45	1.8
+++ runtime/mercury.h	2000/05/11 05:14:41
@@ -96,75 +96,58 @@
 /*
 ** XXX Currently we hard-code the declarations of the first
 ** five of these type-info struct types; this imposes a fixed
-** limit of 5 on the arity of types.  (If this is exceeded,
-** you'll get an undeclared type error in the generated C code.)
+** limit of 10 on the arity of types.  (If this is exceeded,
+** you'll get a parse error in the generated C code, due to
+** an undeclared type.)
 ** Note that the code for compare and unify in runtime/mercury.c
 ** also has a fixed limit of 5 on the arity of types.
 ** Fortunately types with a high arity tend not to be used very
 ** often, so this is probably OK for now...
 */
 
-#ifndef MR_HO_PseudoTypeInfo_Struct1_GUARD
-#define MR_HO_PseudoTypeInfo_Struct1_GUARD
 MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct1, 1);
-#endif
-
-#ifndef MR_HO_PseudoTypeInfo_Struct2_GUARD
-#define MR_HO_PseudoTypeInfo_Struct2_GUARD
 MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct2, 2);
-#endif
-
-#ifndef MR_HO_PseudoTypeInfo_Struct3_GUARD
-#define MR_HO_PseudoTypeInfo_Struct3_GUARD
 MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct3, 3);
-#endif
-
-#ifndef MR_HO_PseudoTypeInfo_Struct4_GUARD
-#define MR_HO_PseudoTypeInfo_Struct4_GUARD
 MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct4, 4);
-#endif
-
-#ifndef MR_HO_PseudoTypeInfo_Struct5_GUARD
-#define MR_HO_PseudoTypeInfo_Struct5_GUARD
 MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct5, 5);
-#endif
+MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct6, 6);
+MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct7, 7);
+MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct8, 8);
+MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct9, 9);
+MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct10, 10);
 
-#ifndef MR_FO_PseudoTypeInfo_Struct1_GUARD
-#define MR_FO_PseudoTypeInfo_Struct1_GUARD
 MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct1, 1);
-#endif
-
-#ifndef MR_FO_PseudoTypeInfo_Struct2_GUARD
-#define MR_FO_PseudoTypeInfo_Struct2_GUARD
 MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct2, 2);
-#endif
-
-#ifndef MR_FO_PseudoTypeInfo_Struct3_GUARD
-#define MR_FO_PseudoTypeInfo_Struct3_GUARD
 MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct3, 3);
-#endif
-
-#ifndef MR_FO_PseudoTypeInfo_Struct4_GUARD
-#define MR_FO_PseudoTypeInfo_Struct4_GUARD
 MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct4, 4);
-#endif
-
-#ifndef MR_FO_PseudoTypeInfo_Struct5_GUARD
-#define MR_FO_PseudoTypeInfo_Struct5_GUARD
 MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct5, 5);
-#endif
+MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct6, 6);
+MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct7, 7);
+MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct8, 8);
+MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct9, 9);
+MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct10, 10);
 
 typedef struct MR_HO_PseudoTypeInfo_Struct1 MR_HO_PseudoTypeInfo_Struct1;
 typedef struct MR_HO_PseudoTypeInfo_Struct2 MR_HO_PseudoTypeInfo_Struct2;
 typedef struct MR_HO_PseudoTypeInfo_Struct3 MR_HO_PseudoTypeInfo_Struct3;
 typedef struct MR_HO_PseudoTypeInfo_Struct4 MR_HO_PseudoTypeInfo_Struct4;
 typedef struct MR_HO_PseudoTypeInfo_Struct5 MR_HO_PseudoTypeInfo_Struct5;
+typedef struct MR_HO_PseudoTypeInfo_Struct6 MR_HO_PseudoTypeInfo_Struct6;
+typedef struct MR_HO_PseudoTypeInfo_Struct7 MR_HO_PseudoTypeInfo_Struct7;
+typedef struct MR_HO_PseudoTypeInfo_Struct8 MR_HO_PseudoTypeInfo_Struct8;
+typedef struct MR_HO_PseudoTypeInfo_Struct9 MR_HO_PseudoTypeInfo_Struct9;
+typedef struct MR_HO_PseudoTypeInfo_Struct10 MR_HO_PseudoTypeInfo_Struct10;
 
 typedef struct MR_FO_PseudoTypeInfo_Struct1 MR_FO_PseudoTypeInfo_Struct1;
 typedef struct MR_FO_PseudoTypeInfo_Struct2 MR_FO_PseudoTypeInfo_Struct2;
 typedef struct MR_FO_PseudoTypeInfo_Struct3 MR_FO_PseudoTypeInfo_Struct3;
 typedef struct MR_FO_PseudoTypeInfo_Struct4 MR_FO_PseudoTypeInfo_Struct4;
 typedef struct MR_FO_PseudoTypeInfo_Struct5 MR_FO_PseudoTypeInfo_Struct5;
+typedef struct MR_FO_PseudoTypeInfo_Struct6 MR_FO_PseudoTypeInfo_Struct6;
+typedef struct MR_FO_PseudoTypeInfo_Struct7 MR_FO_PseudoTypeInfo_Struct7;
+typedef struct MR_FO_PseudoTypeInfo_Struct8 MR_FO_PseudoTypeInfo_Struct8;
+typedef struct MR_FO_PseudoTypeInfo_Struct9 MR_FO_PseudoTypeInfo_Struct9;
+typedef struct MR_FO_PseudoTypeInfo_Struct10 MR_FO_PseudoTypeInfo_Struct10;
 
 /*---------------------------------------------------------------------------*/
 /*
@@ -290,15 +273,24 @@
 ** XXX we should optimize the case where sizeof(MR_Float) == sizeof(MR_Box)
 */ 
 
-MR_EXTERN_INLINE MR_Box MR_box_float(MR_Float f);
+#if defined(__GNUC__) && !defined(MR_AVOID_MACROS)
+  #define MR_box_float(f) ({						\
+	MR_Float *MR_box_float_ptr = (MR_Float *)			\
+		MR_new_object(MR_Float, sizeof(MR_Float), "float");	\
+	*MR_box_float_ptr = (f);					\
+	/* return */ (MR_Box) MR_box_float_ptr;				\
+  })
+#else
+  MR_EXTERN_INLINE MR_Box MR_box_float(MR_Float f);
 
-MR_EXTERN_INLINE MR_Box
-MR_box_float(MR_Float f) {
+  MR_EXTERN_INLINE MR_Box
+  MR_box_float(MR_Float f) {
 	MR_Float *ptr = (MR_Float *)
 		MR_new_object(MR_Float, sizeof(MR_Float), "float");
 	*ptr = f;
 	return (MR_Box) ptr;
-}
+  }
+#endif
 
 #ifdef MR_AVOID_MACROS
   MR_EXTERN_INLINE MR_Float MR_unbox_float(MR_Box b);

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>  |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3        |     -- 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
--------------------------------------------------------------------------
Previous message: [m-dev.] trivial diff: fix browser default depth
Next message: [m-dev.] MLDS back-end bootstrapped!
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
More information about the developers mailing list