[m-rev.] for review: hlc.agc bug fix

[Fergus Henderson]

Estimated hours taken: 4
Branches: main

Fix a bug with accurate GC.

compiler/mlds.m:
	Rename the `is_tail_call' enumeration as `call_kind',
	rename the `call' alternative as `ordinary_call', and
	and add a new alternative `no_return_call'.

compiler/ml_call_gen.m:
	Use `no_return_call' rather than `tail_call' for calls to
	procecures with determinism `erroneous'.

compiler/ml_elim_nested.m:
	Fix a bug: when adding code to unchain the stack frame before
	tail calls, add a `return' statement after each tail call, to
	ensure that we don't try to unchain the stack frame twice.
	But don't do this for calls marked `no_return_call', since
	it's not needed in that case.  (This is mandatory, not just
	an optimization: we can't construct a proper return statement
	for no_return_calls, since the return values in a `no_return_call'
	might not match the return types of the caller.)

compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_java.m:
compiler/ml_util.m:
compiler/ml_tailcall.m:
compiler/ml_code_gen.m:
compiler/ml_code_util.m:
	Minor changes to handle the new `no_return_call' alternative
	and the renaming of `call' as `ordinary_call'.

Workspace: /home/ceres/fjh/mercury
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.33
diff -u -d -r1.33 ml_call_gen.m
--- compiler/ml_call_gen.m	20 Mar 2002 12:36:44 -0000	1.33
+++ compiler/ml_call_gen.m	2 Apr 2002 14:55:30 -0000
@@ -451,14 +451,15 @@
 	% build the MLDS call statement
 	%
 	% if the called procedure has determinism `erroneous'
-	% then it's always safe to make this call a tail call.
+	% then mark it as never returning
+	% (this will ensure that it gets treated as a tail call)
 	{ Detism = erroneous ->
-		CallOrTailcall = tail_call
+		CallKind = no_return_call
 	;
-		CallOrTailcall = call
+		CallKind = ordinary_call
 	},
 	{ MLDS_Stmt = call(Signature, FuncRval, ObjectRval, ArgRvals, RetLvals,
-			CallOrTailcall) },
+			CallKind) },
 	{ MLDS_Statement = mlds__statement(MLDS_Stmt,
 			mlds__make_context(Context)) },
 	{ MLDS_Statements = [MLDS_Statement] }.
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.111
diff -u -d -r1.111 ml_code_gen.m
--- compiler/ml_code_gen.m	20 Mar 2002 12:36:45 -0000	1.111
+++ compiler/ml_code_gen.m	2 Apr 2002 14:58:56 -0000
@@ -1861,9 +1861,9 @@
 		),
 		{ RetTypes = [] },
 		{ Signature = mlds__func_signature(ArgTypes, RetTypes) },
-		{ CallOrTailcall = call },
+		{ CallKind = ordinary_call },
 		{ CallStmt = call(Signature, CommitFuncLabelRval, no,
-			ArgRvals, [], CallOrTailcall) },
+			ArgRvals, [], CallKind) },
 		{ CallStatement = mlds__statement(CallStmt,
 			mlds__make_context(Context)) },
 		% Package it all up
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.60
diff -u -d -r1.60 ml_code_util.m
--- compiler/ml_code_util.m	27 Mar 2002 15:24:18 -0000	1.60
+++ compiler/ml_code_util.m	2 Apr 2002 15:00:17 -0000
@@ -1928,9 +1928,9 @@
 	{ Signature = mlds__func_signature(ArgTypes, RetTypes) },
 	{ ObjectRval = no },
 	{ RetLvals = [] },
-	{ CallOrTailcall = call },
+	{ CallKind = ordinary_call },
 	{ MLDS_Stmt = call(Signature, FuncRval, ObjectRval, ArgRvals, RetLvals,
-			CallOrTailcall) },
+			CallKind) },
 	{ MLDS_Statement = mlds__statement(MLDS_Stmt,
 			mlds__make_context(Context)) }.
 
@@ -1959,7 +1959,7 @@
 	{ Signature = mlds__func_signature(ArgTypes, RetTypes) },
 	{ ObjectRval = no },
 	{ RetLvals = [] },
-	{ CallOrTailcall = call },
+	{ CallKind = ordinary_call },
 
 	{ MLDS_Context = mlds__make_context(Context) },
 	=(MLDSGenInfo),
@@ -1997,7 +1997,7 @@
 			Rets) },
 
 	{ InnerMLDS_Stmt = call(Signature, InnerFuncRval, ObjectRval, 
-			InnerArgRvals, RetLvals, CallOrTailcall) },
+			InnerArgRvals, RetLvals, CallKind) },
 	{ InnerMLDS_Statement = statement(InnerMLDS_Stmt, MLDS_Context) },
 
 	ml_gen_label_func(1, InnerFuncParams, Context, 
@@ -2019,7 +2019,7 @@
 
 		% Put it inside a block where we call it.
 		MLDS_Stmt = call(ProxySignature, ProxyFuncRval, ObjectRval,
-			ProxyArgRvals, RetLvals, CallOrTailcall),
+			ProxyArgRvals, RetLvals, CallKind),
 		MLDS_Statement = mlds__statement(
 			block([Defn], [statement(MLDS_Stmt, MLDS_Context)]), 
 			MLDS_Context)
@@ -2317,7 +2317,7 @@
 	{ CastVarAddr = unop(cast(CPointerType), mem_addr(VarLval)) },
 	{ MLDS_TraceStatement = mlds__statement(
 		call(Signature, FuncAddr, no,	
-			[TypeInfoRval, CastVarAddr], [], call
+			[TypeInfoRval, CastVarAddr], [], ordinary_call
 		), mlds__make_context(Context)) }.
 
 	% Generate HLDS code to construct the type_info for this type.
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.56
diff -u -d -r1.56 ml_elim_nested.m
--- compiler/ml_elim_nested.m	27 Mar 2002 15:24:19 -0000	1.56
+++ compiler/ml_elim_nested.m	2 Apr 2002 15:04:40 -0000
@@ -2223,14 +2223,9 @@
 		{ Stmt0 = computed_goto(_Rval, _Labels) },
 		{ Stmt = Stmt0 }
 	;
-		{ Stmt0 = call(_Sig, _Func, _Obj, _Args, _RetLvals, TailCall) },
-		( { TailCall = tail_call } ->
-			=(ElimInfo),
-			{ Stmt = prepend_unchain_frame(Stmt0, Context,
-				ElimInfo) }
-		;
-			{ Stmt = Stmt0 }
-		)
+		{ Stmt0 = call(_Sig, _Func, _Obj, _Args, RetLvals, CallKind) },
+		add_unchain_stack_to_call(Stmt0, RetLvals, CallKind, Context,
+			Stmt)
 	;
 		{ Stmt0 = return(_Rvals) },
 		=(ElimInfo),
@@ -2245,6 +2240,36 @@
 		{ Stmt = try_commit(Ref, Statement, Handler) }
 	;
 		{ Stmt0 = atomic(_AtomicStmt0) },
+		{ Stmt = Stmt0 }
+	).
+
+:- pred add_unchain_stack_to_call(mlds__stmt, list(mlds__lval),
+		mlds__call_kind, mlds__context, mlds__stmt,
+		elim_info, elim_info).
+:- mode add_unchain_stack_to_call(in, in, in, in, out, in, out) is det.
+add_unchain_stack_to_call(Stmt0, RetLvals, CallKind, Context, Stmt) -->
+	(
+		{ CallKind = no_return_call },
+		% For no-return calls, we just unchain the stack
+		% frame before the call.
+		=(ElimInfo),
+		{ Stmt = prepend_unchain_frame(Stmt0, Context, ElimInfo) }
+	;
+		{ CallKind = tail_call },
+		% For tail calls, we unchain the stack frame before the call,
+		% and then we insert a return statement after the call.
+		% The return statement is needed ensure that the code doesn't
+		% fall through (past the tail call) and then try to unchain
+		% the already-unchained stack frame.
+		=(ElimInfo),
+		{ UnchainFrame = ml_gen_unchain_frame(Context, ElimInfo) },
+		{ Statement0 = mlds__statement(Stmt0, Context) },
+		{ RetRvals = list__map(func(Rval) = lval(Rval), RetLvals) },
+		{ RetStmt = return(RetRvals) },
+		{ RetStatement = mlds__statement(RetStmt, Context) },
+		{ Stmt = block([], [UnchainFrame, Statement0, RetStatement]) }
+	;
+		{ CallKind = ordinary_call },
 		{ Stmt = Stmt0 }
 	).
 
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.16
diff -u -d -r1.16 ml_tailcall.m
--- compiler/ml_tailcall.m	20 Mar 2002 12:36:47 -0000	1.16
+++ compiler/ml_tailcall.m	2 Apr 2002 14:56:18 -0000
@@ -49,7 +49,8 @@
 % any backend support for them.
 %
 % Note that ml_call_gen.m will also mark calls to procedures with determinism
-% `erroneous' as tail calls when it generates them.
+% `erroneous' as `no_return_call's (a special case of tail calls)
+% when it generates them.
 
 %-----------------------------------------------------------------------------%
 
@@ -274,11 +275,12 @@
 		Stmt0 = computed_goto(_, _),
 		Stmt = Stmt0
 	;
-		Stmt0 = call(Sig, Func, Obj, Args, ReturnLvals, _TailCall0),
+		Stmt0 = call(Sig, Func, Obj, Args, ReturnLvals, CallKind0),
 		%
 		% check if we can mark this call as a tail call
 		%
 		(
+			CallKind0 = ordinary_call,
 			%
 			% we must be in a tail position
 			%
@@ -297,9 +299,9 @@
 			check_rvals(Args, Locals)
 		->
 			% mark this call as a tail call
-			TailCall = tail_call,
+			CallKind = tail_call,
 			Stmt = call(Sig, Func, Obj, Args, ReturnLvals,
-					TailCall)
+					CallKind)
 		;
 			% leave this call unchanged
 			Stmt = Stmt0
@@ -606,8 +608,8 @@
 	% nondeterministically find a non-tail call
 	statement_contains_statement(Statement, SubStatement),
 	SubStatement = mlds__statement(SubStmt, Context),
-	SubStmt = call(_CallSig, Func, _This, _Args, _RetVals, IsTailCall),
-	IsTailCall = call,
+	SubStmt = call(_CallSig, Func, _This, _Args, _RetVals, CallKind),
+	CallKind = ordinary_call,
 	% check if this call is a directly recursive call
 	Func = const(code_addr_const(CodeAddr)),
 	( CodeAddr = proc(QualProcLabel, _Sig), MaybeSeqNum = no
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.18
diff -u -d -r1.18 ml_util.m
--- compiler/ml_util.m	20 Mar 2002 12:36:48 -0000	1.18
+++ compiler/ml_util.m	2 Apr 2002 14:54:08 -0000
@@ -162,11 +162,11 @@
 
 can_optimize_tailcall(Name, Call) :-
 	Call = call(_Signature, FuncRval, MaybeObject, _CallArgs,
-		_Results, IsTailCall),
+		_Results, CallKind),
 	%
 	% check if this call can be optimized as a tail call
 	%
-	IsTailCall = tail_call,
+	( CallKind = tail_call ; CallKind = no_return_call ),
 
 	%
 	% check if the callee adddress is the same as
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.87
diff -u -d -r1.87 mlds.m
--- compiler/mlds.m	20 Mar 2002 12:36:48 -0000	1.87
+++ compiler/mlds.m	2 Apr 2002 14:31:08 -0000
@@ -917,7 +917,7 @@
 			list(mlds__rval),	% ordinary function arguments
 			list(mlds__lval),	% places to store the
 						% function return value(s)
-			is_tail_call		% indicates whether this
+			call_kind		% indicates whether this
 						% call is a tail call
 		)
 
@@ -1075,9 +1075,24 @@
 % Extra info for calls
 %
 
-:- type is_tail_call
-	--->	tail_call	% a tail call
-	;	call		% just an ordinary call
+	% The `call_kind' type indicates whether a call is a tail call
+	% and whether the call is know to never return.
+	%
+	% Marking a call as a tail_call is intended as a hint to
+	% the target language that this call can be implemented
+	% by removing the caller's stack frame and jumping to the
+	% destination, rather than a normal call.
+	% However, the target code generator need not obey this hint;
+	% it is permitted for the target code generator to ignore the
+	% hint and generate code which does not remove the caller's
+	% stack frame and/or which falls through to the following
+	% statement.
+	% 
+:- type call_kind
+	--->	no_return_call	% a call that never returns
+				% (this is a special case of a tail call)
+	;	tail_call	% a tail call
+	;	ordinary_call	% just an ordinary call
 	.
 
 %-----------------------------------------------------------------------------%
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.123
diff -u -d -r1.123 mlds_to_c.m
--- compiler/mlds_to_c.m	20 Mar 2002 12:36:49 -0000	1.123
+++ compiler/mlds_to_c.m	2 Apr 2002 14:37:56 -0000
@@ -2216,7 +2216,8 @@
 	% the call -- see below.
 	%
 	% Note that it's only safe to add such a return statement if
-	% the calling procedure has the same argument types as the callee.
+	% the calling procedure has the same return types as the callee,
+	% or if the calling procedure has no return value.
 	% (Calls where the types are different can be marked as tail calls
 	% if they are known to never return.)
 	%
@@ -2224,7 +2225,7 @@
 	{ Signature = mlds__func_signature(_, RetTypes) },
 	{ CallerSignature = mlds__func_signature(_, CallerRetTypes) },
 	(
-		{ IsTailCall = tail_call },
+		{ IsTailCall = tail_call ; IsTailCall = no_return_call },
 		{ Results \= [] },
 		{ RetTypes = CallerRetTypes }
 	->
@@ -2253,9 +2254,8 @@
 	io__write_string(");\n"),
 
 	(
-		{ IsTailCall = tail_call },
-		{ Results = [] },
-		{ RetTypes = CallerRetTypes }
+		{ IsTailCall = tail_call ; IsTailCall = no_return_call },
+		{ CallerRetTypes = [] }
 	->
 		mlds_indent(Context, Indent + 1),
 		io__write_string("return;\n")
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.67
diff -u -d -r1.67 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m	31 Mar 2002 08:03:25 -0000	1.67
+++ compiler/mlds_to_gcc.m	2 Apr 2002 14:35:09 -0000
@@ -2489,14 +2489,22 @@
 	%
 gen_stmt(DefnInfo, Call, _) -->
 	{ Call = call(_Signature, FuncRval, MaybeObject, CallArgs,
-		Results, IsTailCall) },
+		Results, CallKind) },
 	{ require(unify(MaybeObject, no), this_file ++ ": method call") },
 	build_args(CallArgs, DefnInfo, GCC_ArgList),
 	build_rval(FuncRval, DefnInfo, GCC_FuncRval),
+	{
+		CallKind = no_return_call,
+		IsTailCall = yes
+	;
+		CallKind = tail_call,
+		IsTailCall = yes
+	;
+		CallKind = ordinary_call,
+		IsTailCall = no
+	},
 	% XXX GCC currently ignores the tail call boolean
-	{ IsTailCallBool = (IsTailCall = tail_call -> yes ; no) },
-	gcc__build_call_expr(GCC_FuncRval, GCC_ArgList, IsTailCallBool,
-		GCC_Call),
+	gcc__build_call_expr(GCC_FuncRval, GCC_ArgList, IsTailCall, GCC_Call),
 	( { Results = [ResultLval] } ->
 		build_lval(ResultLval, DefnInfo, GCC_ResultExpr),
 		gcc__gen_assign(GCC_ResultExpr, GCC_Call)
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.110
diff -u -d -r1.110 mlds_to_il.m
--- compiler/mlds_to_il.m	20 Mar 2002 12:36:51 -0000	1.110
+++ compiler/mlds_to_il.m	2 Apr 2002 15:01:26 -0000
@@ -1329,7 +1329,7 @@
 		% XXX should we look for tail calls?
 	CallStatement = statement(
 		call(Signature, CodeRval, no, ArgRvals, ReturnLvals,
-			call), Context),
+			ordinary_call), Context),
 	ReturnStatement = statement(return(ReturnRvals), Context),
 
 	Statement = statement(mlds__block(ReturnVarDecls,
@@ -1563,7 +1563,7 @@
 	atomic_statement_to_il(Atomic, AtomicInstrs),
 	{ Instrs = tree(context_node(Context), AtomicInstrs) }.
 
-statement_to_il(statement(call(Sig, Function, _This, Args, Returns, IsTail), 
+statement_to_il(statement(call(Sig, Function, _This, Args, Returns, CallKind), 
 		Context), Instrs) -->
 	VerifiableCode =^ verifiable_code,
 	ByRefTailCalls =^ il_byref_tailcalls,
@@ -1574,7 +1574,7 @@
 	CallerSig =^ signature,
 	{ CallerSig = signature(_, CallerReturnParam, _) },
 	(
-		{ IsTail = tail_call },
+		{ CallKind = tail_call ; CallKind = no_return_call },
 		% if --verifiable-code is enabled,
 		% and the arguments contain one or more byrefs,
 		% then don't emit the "tail." prefix,
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.26
diff -u -d -r1.26 mlds_to_java.m
--- compiler/mlds_to_java.m	20 Mar 2002 12:36:52 -0000	1.26
+++ compiler/mlds_to_java.m	2 Apr 2002 14:58:00 -0000
@@ -762,7 +762,7 @@
 		CallRetLvals = [ReturnLval]
 	),
 	Call = mlds__call(OrigFuncSignature, CallRval, no, CallArgs,
-			CallRetLvals, call),
+			CallRetLvals, ordinary_call),
 	CallStatement = mlds__statement(Call, Context),
 	%
 	% Create a return statement that returns the result of the call to the

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------