for review: bug fix for semidet pragma c_code [repost]

[Fergus Henderson]

Hi,

Apparently majordomo was down today, so I'm reposting these.

-----Forwarded message from Fergus Henderson <fjh at cs.mu.OZ.AU>-----

Message-ID: <19980115121834.53396 at murlibobo.cs.mu.OZ.AU>
Date: Thu, 15 Jan 1998 12:18:34 +1100
From: Fergus Henderson <fjh at cs.mu.OZ.AU>
To: Mercury Developers <mercury-developers at cs.mu.OZ.AU>
Subject: for review: bug fix for semidet pragma c_code

Zoltan, can you please review this one?

--------------------

Fix a bug where semidet pragma c_codes didn't work in non-gc grades.

compiler/pragma_c_gen.m:
	Fix the above-mentioned bug.  The problem was that in the following
	code fragment
		{ <the c code itself> }
		#ifndef CONSERVATIVE_GC
		  restore_registers();
		#endif
	the C code would assign to SUCCESS_INDICATOR, which is #defined
	to `r1', and then the call to restore_registers() would clobber r1.

	In the process of fixing the bug, reorganize the code for
	generating ordinary (det/semi) pragma_c so that it more closely
	matches the layout of the code it generates, and add a few comments.

tests/hard_coded/Mmakefile:
	Re-enable the `pragma_import' test which uncovered this bug.

cvs diff  compiler/pragma_c_gen.m tests/hard_coded/Mmakefile
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.12
diff -u -r1.12 pragma_c_gen.m
--- pragma_c_gen.m	1998/01/13 10:13:22	1.12
+++ pragma_c_gen.m	1998/01/14 16:16:25
@@ -46,23 +46,29 @@
 % must be able to fit into the middle of a procedure, since such
 % pragma_c_codes can be inlined. This code is of the following form:
 %
-% <save live variables onto the stack> /* see note (1) below */
-% {
+%    <save live variables onto the stack> /* see note (1) below */
+%    {
 %	<declaration of one local variable for each arg>
 %	<assignment of input values from registers to local variables>
 %	save_registers(); /* see notes (1) and (2) below */
 %	{ <the c code itself> }
+%	<for semidet code, check of r1>
 %	#ifndef CONSERVATIVE_GC
 %	  restore_registers(); /* see notes (1) and (3) below */
 %	#endif
 %	<assignment of the output values from local variables to registers>
-% }
+%    }
+%
+% In the case of a semidet pragma c_code, the above is followed by
 %
-% In the case of a semidet pragma c_code, this is followed by
+%    goto skip_label;
+%    fail_label:
+%    <code to fail>
+%    skip_label:
 %
-%	if (r1) goto label;
-%	<code to fail>
-%	label:
+% and the <check of r1> is of the form
+%
+%	if (!r1) GOTO_LABEL(fail_label);
 %
 % The code we generate for nondet pragma_c_code assumes that this code is
 % the only thing between the procedure prolog and epilog; such pragma_c_codes
@@ -300,13 +306,17 @@
 pragma_c_gen__ordinary_pragma_c_code(CodeModel, MayCallMercury,
 		PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
 		C_Code, Context, Code) -->
+	%
 	% First we need to get a list of input and output arguments
+	%
 	code_info__get_pred_proc_arginfo(PredId, ProcId, ArgInfos),
 	{ make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes, ArgInfos, Args) },
 	{ pragma_select_in_args(Args, InArgs) },
 	{ pragma_select_out_args(Args, OutArgs) },
-	{ make_pragma_decls(Args, Decls) },
 
+	%
+	% Generate code to <save live variables on stack>
+	%
 	( { MayCallMercury = will_not_call_mercury } ->
 		{ SaveVarsCode = empty }
 	;
@@ -322,86 +332,141 @@
 		call_gen__save_variables(OutArgsSet, SaveVarsCode)
 	),
 
+	%
+	% Generate the values of input variables.
+	% (NB we need to be careful that the rvals generated here
+	% remain valid below.)
+	%
 	get_pragma_input_vars(InArgs, InputDescs, InputVarsCode),
+
+	%
+	% For semidet pragma c_code, we have to move anything that is
+	% currently in r1 elsewhere, so that the C code can assign to
+	% SUCCESS_INDICATOR without clobbering anything important.
+	%
 	( { CodeModel = model_semi } ->
-		% We have to clear r1 for C code that gets inlined
-		% so that it is safe to assign to SUCCESS_INDICATOR.
-		code_info__clear_r1(ShuffleR1_Code),
-
-		( { MayCallMercury = will_not_call_mercury } ->
-			[]
-		;
-			% the C code may call Mercury code which clobbers
-			% the regs
-			code_info__clear_all_registers
-		),
+		code_info__clear_r1(ShuffleR1_Code)
+	;
+		{ ShuffleR1_Code = empty }
+	),
 
-		% C code goes here
+	%
+	% Generate <declaration of one local variable for each arg>
+	%
+	{ make_pragma_decls(Args, Decls) },
 
-		code_info__get_next_label(SkipLabel),
-		code_info__generate_failure(FailCode),
-		{ TestCode = node([
-			if_val(lval(reg(r, 1)), label(SkipLabel)) -
-				"Test for success of pragma_c_code"
-		]) },
-		{ SkipLabelCode = node([
-			label(SkipLabel) - ""
-		]) },
-		{ CheckFailureCode =
-			tree(TestCode,
-			tree(FailCode,
-			     SkipLabelCode))
-		},
+	%
+	% <assignment of input values from registers to local vars>
+	%
+	{ InputComp = pragma_c_inputs(InputDescs) },
 
-		code_info__lock_reg(reg(r, 1)),
-		pragma_acquire_regs(OutArgs, Regs),
-		code_info__unlock_reg(reg(r, 1))
+	%
+	% save_registers(); /* see notes (1) and (2) above */
+	%
+	{ MayCallMercury = will_not_call_mercury ->
+		SaveRegsComp = pragma_c_raw_code("")
 	;
-		{ ShuffleR1_Code = empty },
-
-		% c code goes here
-
-		( { MayCallMercury = will_not_call_mercury } ->
-			[]
-		;
-			% the C code may call Mercury code which clobbers
-			% the regs
-			code_info__clear_all_registers
-		),
+		SaveRegsComp = pragma_c_raw_code(
+			"\tsave_registers();\n"
+		)
+	},
 
-		{ CheckFailureCode = empty },
+	%
+	% <The C code itself>
+	%
+	{ C_Code_Comp = pragma_c_user_code(Context, C_Code) },
 
-		pragma_acquire_regs(OutArgs, Regs)
+	%
+	% <for semidet code, check of r1>
+	%
+	( { CodeModel = model_semi } ->
+		code_info__get_next_label(FailLabel),
+		{ llds_out__get_label(FailLabel, yes, FailLabelStr) },
+                { string__format("\tif (!r1) GOTO_LABEL(%s);\n",
+				[s(FailLabelStr)], CheckR1_String) },
+		{ CheckR1_Comp = pragma_c_raw_code(CheckR1_String) },
+		{ MaybeFailLabel = yes(FailLabel) }
+	;
+		{ CheckR1_Comp = pragma_c_raw_code("") },
+		{ MaybeFailLabel = no }
 	),
-	place_pragma_output_args_in_regs(OutArgs, Regs, OutputDescs),
 
-	{ C_Code_Comp = pragma_c_user_code(Context, C_Code) },
+	%
+	% #ifndef CONSERVATIVE_GC
+	%   restore_registers(); /* see notes (1) and (3) above */
+	% #endif
+	%
 	{ MayCallMercury = will_not_call_mercury ->
-		WrappedComp = [C_Code_Comp]
+		RestoreRegsComp = pragma_c_raw_code("")
 	;
-		SaveRegsComp = pragma_c_raw_code(
-			"\tsave_registers();\n"
-		),
 		RestoreRegsComp = pragma_c_raw_code(
-		"#ifndef CONSERVATIVE_GC\n\trestore_registers();\n#endif\n"
-		),
-		WrappedComp = [SaveRegsComp, C_Code_Comp, RestoreRegsComp]
+		    "#ifndef CONSERVATIVE_GC\n\trestore_registers();\n#endif\n"
+		)
 	},
-	{ InputComp = pragma_c_inputs(InputDescs) },
+
+	%
+	% The C code may have called Mercury code which clobbered the regs,
+	% in which case we need to tell the code_info that they have been
+	% clobbered.
+	%
+	( { MayCallMercury = will_not_call_mercury } ->
+		[]
+	;
+		code_info__clear_all_registers
+	),
+
+	%
+	% <assignment of the output values from local variables to registers>
+	%
+	pragma_acquire_regs(OutArgs, Regs),
+	place_pragma_output_args_in_regs(OutArgs, Regs, OutputDescs),
 	{ OutputComp = pragma_c_outputs(OutputDescs) },
-	{ list__append([InputComp | WrappedComp], [OutputComp], Components) },
 
+	%
+	% join all the components of the pragma_c together
+	%
+	{ Components = [InputComp, SaveRegsComp, C_Code_Comp,
+			CheckR1_Comp, RestoreRegsComp, OutputComp] },
 	{ PragmaCCode = node([
-		pragma_c(Decls, Components, MayCallMercury, no) -
+		pragma_c(Decls, Components, MayCallMercury, MaybeFailLabel) -
 			"Pragma C inclusion"
 	]) },
 
+	%
+	% for semidet code, we need to insert the failure handling code here:
+	%
+	%	goto skip_label;
+	%	fail_label:
+	%	<code to fail>
+	%	skip_label:
+	%
+	( { MaybeFailLabel = yes(TheFailLabel) } ->
+		code_info__get_next_label(SkipLabel),
+		code_info__generate_failure(FailCode),
+		{ GotoSkipLabelCode = node([
+			goto(label(SkipLabel)) - "Skip past failure code"
+		]) },
+		{ SkipLabelCode = node([ label(SkipLabel) - "" ]) },
+		{ FailLabelCode = node([ label(TheFailLabel) - "" ]) },
+		{ FailureCode =
+			tree(GotoSkipLabelCode,
+			tree(FailLabelCode,
+			tree(FailCode,
+			     SkipLabelCode)))
+		}
+	;
+		{ FailureCode = empty }
+	),
+
+	%
+	% join all code fragments together
+	%
 	{ Code =
 		tree(SaveVarsCode,
 		tree(InputVarsCode,
 		tree(ShuffleR1_Code, 
 		tree(PragmaCCode,
-		     CheckFailureCode))))
+		     FailureCode))))
 	}.
 
 %---------------------------------------------------------------------------%
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.6
diff -u -r1.6 Mmakefile
--- Mmakefile	1998/01/14 02:16:28	1.6
+++ Mmakefile	1998/01/14 16:24:08
@@ -70,10 +70,6 @@
 MCFLAGS-ho_order	=	--optimize-higher-order
 MCFLAGS-no_fully_strict	=	--no-fully-strict
 
-# XXX the `pragma_import' test does not yet work in non-gc grades
-
-GRADEFLAGS-pragma_import =	--gc conservative
-
 # no_fully_strict is expected to fail (it calls error/1)
 # so we need to ignore the exit status (hence the leading `-')
 no_fully_strict.out: no_fully_strict
-- 
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.

-----End of forwarded message-----
-----Forwarded message from Fergus Henderson <fjh at cs.mu.OZ.AU>-----

Message-ID: <19980115153033.58494 at murlibobo.cs.mu.OZ.AU>
Date: Thu, 15 Jan 1998 15:30:33 +1100
From: Fergus Henderson <fjh at cs.mu.OZ.AU>
To: Mercury Developers <mercury-developers at cs.mu.OZ.AU>
Subject: Re: for review: bug fix for semidet pragma c_code
References: <19980115121834.53396 at murlibobo.cs.mu.OZ.AU>
In-Reply-To: <19980115121834.53396 at murlibobo.cs.mu.OZ.AU>; from Fergus Henderson on Thu, Jan 15, 1998 at 12:18:34PM +1100

On 15-Jan-1998, I wrote:
> Zoltan, can you please review this one?
> 
> --------------------
> 
> Fix a bug where semidet pragma c_codes didn't work in non-gc grades.

More testing revealed that this bug fix happened to trigger another bug.

compiler/dupelim.m:
	Fix a bug in dupelim__build_maps: a lambda expression was using
	the same variable name (`Label') as the code outside it,
	resulting in it accidentally capturing that variable rather
	than being a fresh variable.

Index: dupelim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dupelim.m,v
retrieving revision 1.30
diff -u -u -r1.30 dupelim.m
--- dupelim.m	1998/01/13 10:11:50	1.30
+++ dupelim.m	1998/01/15 04:21:17
@@ -114,8 +114,8 @@
 	),
 	AddPragmaReferredLabels = lambda(
 		[Instr::in, FoldFixed0::in, FoldFixed::out] is det, (
-		( Instr = pragma_c(_, _, _, yes(Label)) - _ ->
-			set__insert(FoldFixed0, Label, FoldFixed)
+		( Instr = pragma_c(_, _, _, yes(PragmaLabel)) - _ ->
+			set__insert(FoldFixed0, PragmaLabel, FoldFixed)
 		;
 			FoldFixed = FoldFixed0
 		)

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

-----End of forwarded message-----
-----Forwarded message from Fergus Henderson <fjh at cs.mu.OZ.AU>-----

Message-ID: <19980115175214.45729 at murlibobo.cs.mu.OZ.AU>
Date: Thu, 15 Jan 1998 17:52:14 +1100
From: Fergus Henderson <fjh at cs.mu.OZ.AU>
To: Mercury Developers <mercury-developers at cs.mu.OZ.AU>
Subject: Re: for review: bug fix for semidet pragma c_code
References: <19980115121834.53396 at murlibobo.cs.mu.OZ.AU> <19980115153033.58494 at murlibobo.cs.mu.OZ.AU>
In-Reply-To: <19980115153033.58494 at murlibobo.cs.mu.OZ.AU>; from Fergus Henderson on Thu, Jan 15, 1998 at 03:30:33PM +1100

On 15-Jan-1998, I wrote:
> On 15-Jan-1998, I wrote:
> > 
> > Fix a bug where semidet pragma c_codes didn't work in non-gc grades.
> 
> More testing revealed that this bug fix happened to trigger another bug.

... and another one.

compiler/frameopt.m:
	Fix a bug in possible_targets/2: the possible targets for
	a `pragma_c' instruction include the label, if it has one.

compiler/opt_util.m:
	Update the comments for component_can_branch_away/2
	to reflect the fact that pragma_c_raw_code components for
	semidet pragma c_codes can branch away.  Also check for the
	special case of an empty string in pragma_c_raw_code.

cvs diff  compiler/frameopt.m compiler/opt_util.m
Index: compiler/frameopt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/frameopt.m,v
retrieving revision 1.67
diff -u -r1.67 frameopt.m
--- frameopt.m	1998/01/13 10:12:01	1.67
+++ frameopt.m	1998/01/15 06:40:17
@@ -687,7 +687,14 @@
 possible_targets(discard_tickets_to(_), []).
 possible_targets(incr_sp(_, _), []).
 possible_targets(decr_sp(_), []).
-possible_targets(pragma_c(_, _, _, _), []).
+possible_targets(pragma_c(_, _, _, MaybeLabel), List) :-
+	(	
+		MaybeLabel = no,
+		List = []
+	;
+		MaybeLabel = yes(Label),
+		List = [Label]
+	).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.88
diff -u -r1.88 opt_util.m
--- opt_util.m	1998/01/13 10:13:08	1.88
+++ opt_util.m	1998/01/15 06:45:02
@@ -1012,6 +1012,8 @@
 	% The input and output components get expanded to straight line code.
 	% Some of the raw_code components we generate for nondet pragma C codes
 	% invoke succeed(), which definitely does branch away.
+	% Also the raw_code components for semidet pragma C codes can
+	% branch to a label on failure.
 	% User-written C code cannot branch away because users do not know
 	% how to do that. (They can call other functions, but those functions
 	% will return, so control will still go to the instruction following
@@ -1021,7 +1023,8 @@
 
 opt_util__can_component_branch_away(pragma_c_inputs(_), no).
 opt_util__can_component_branch_away(pragma_c_outputs(_), no).
-opt_util__can_component_branch_away(pragma_c_raw_code(_), yes).
+opt_util__can_component_branch_away(pragma_c_raw_code(Code), CanBranchAway) :-
+	( Code = "" -> CanBranchAway = yes ; CanBranchAway = no ).
 opt_util__can_component_branch_away(pragma_c_user_code(_, _), no).
 
 opt_util__can_instr_fall_through(comment(_), yes).
-- 
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.

-----End of forwarded message-----

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