[m-rev.] for review: Java unreachable code removal Mk.2

Michael Wybrow mjwybrow at students.cs.mu.oz.au
Wed Feb 20 12:06:05 AEDT 2002


For review by Fergus.


===================================================================

Estimated hours taken: 30
Branches: main

Do not generate unreachable code in the Java back-end, and re-enable 
optimized tailcalls which were previously generating unreachable code.


mercury/compiler/handle_options.m:
	Enable optimized tailcalls when compiling to Java.

mercury/compiler/mlds_to_java.m:
	Prevent generation of unreachable code when compiling to Java.


Index: handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.131
diff -u -r1.131 handle_options.m
--- handle_options.m	19 Feb 2002 06:21:44 -0000	1.131
+++ handle_options.m	19 Feb 2002 23:34:20 -0000
@@ -357,11 +357,6 @@
 	%	  pointers.
 	%   - store nondet environments on the heap
 	%         Because Java has no way of allocating structs on the stack.
-	%   - not optimizing tailcalls
-	%         XXX Optimized tailcalls currently cause compilation errors
-	%             in the Java back-end because javac is unwilling to
-	%             compile unreachable code they generate.
-	%	      For this reason they have been disabled.
 	%   - no static ground terms
 	%         XXX Previously static ground terms used to not work with
 	%             --high-level-data.  But this has been (mostly?) fixed now.
@@ -377,7 +372,6 @@
 		globals__io_set_option(gcc_nested_functions, bool(no)),
 		globals__io_set_option(nondet_copy_out, bool(yes)),
 		globals__io_set_option(det_copy_out, bool(yes)),
-		globals__io_set_option(optimize_tailcalls, bool(no)),
 		globals__io_set_option(num_tag_bits, int(0)),
 		globals__io_set_option(static_ground_terms, bool(no)),
 		globals__io_set_option(put_nondet_env_on_heap, bool(yes))
Index: mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.23
diff -u -r1.23 mlds_to_java.m
--- mlds_to_java.m	15 Feb 2002 08:17:15 -0000	1.23
+++ mlds_to_java.m	20 Feb 2002 00:52:07 -0000
@@ -19,12 +19,12 @@
 %	higher order functions
 %	multidet and nondet predicates
 %	test tests/benchmarks/*.m
+%	generate optimized tailcalls
 % TODO: 
 %	General code cleanup
 %	handle static ground terms
 %	RTTI (requires static ground terms)
 %	generate names of classes etc. correctly (mostly same as IL backend)
-%	generate optimized tailcalls
 %
 %	handle foreign code written in Java
 %	handle foreign code written in C 
@@ -33,6 +33,15 @@
 %       To avoid namespace conflicts all Java names must be fully qualified.
 %	e.g. The classname `String' must be qualified as `java.lang.String'
 %	     to avoid conflicting with `mercury.String'.
+%
+%	There is currently some code threaded through the output predicates
+%	(usually a variable called `JumpInfo') which keeps track of, and
+%	removes unreachable code. Ideally this would be done as an MLDS->MLDS
+%	transformation, preferably in a seperate module. Unfortunately this
+%	is not possible due to the fact that the back-end generates `break'
+%	statements for cases in switches as they are output, meaning that we
+%	can't remove them in a pass over the MLDS. 
+%
 %-----------------------------------------------------------------------------%
 
 :- module mlds_to_java.
@@ -67,7 +76,7 @@
 :- import_module builtin_ops.
 :- import_module prog_data, prog_out, type_util, error_util.
 
-:- import_module bool, int, string, library, list.
+:- import_module bool, int, string, library, list, set.
 :- import_module assoc_list, term, std_util, require.
 
 %-----------------------------------------------------------------------------%
@@ -339,16 +348,16 @@
 	{ find_pointer_addressed_methods(Defns0, [], CodeAddrs0) },
 	{ CodeAddrs = list__sort_and_remove_dups(CodeAddrs0) },
 	%
-	% Output transformed MLDS as Java source.  
-	%
-	output_src_start(Indent, ModuleName, Imports, Defns1), 
-	%
 	% Create wrappers in MLDS for all pointer addressed methods.
 	% 
 	{ generate_code_addr_wrappers(Indent + 1, CodeAddrs, [], 
 			WrapperDefns) },
-	{ Defns1 = WrapperDefns ++ Defns0 }, 
-	{ list__filter(defn_is_rtti_data, Defns1, _RttiDefns, NonRttiDefns) },
+	{ Defns = WrapperDefns ++ Defns0 }, 
+	%
+	% Output transformed MLDS as Java source.  
+	%
+	output_src_start(Indent, ModuleName, Imports, Defns), 
+	{ list__filter(defn_is_rtti_data, Defns, _RttiDefns, NonRttiDefns) },
 	% XXX Need to output RTTI data at this point.
 	{ CtorData = none },  % Not a constructor.
 	output_defns(Indent + 1, MLDS_ModuleName, CtorData, NonRttiDefns),
@@ -1376,7 +1385,7 @@
 		indent_line(Context, Indent),
 		io__write_string("{\n"),
 		{ FuncInfo = func_info(Name, Signature) },
-		output_statement(Indent + 1, FuncInfo, Body),
+		output_statement(Indent + 1, FuncInfo, Body, _JumpInfo),
 		indent_line(Context, Indent),
 		io__write_string("}\n")	% end the function
 	).
@@ -1780,33 +1789,66 @@
 % Code to output statements
 %
 
+	% These types are used by many of the output_stmt style predicates to
+	% pass back completetion information for previous statements.
+	% In general we only output the current statement if the previous 
+	% statement could complete normally.
+	% We keep a set of jump types since some statements (like an
+	% if-then-else) could potentially break, and also complete. 
+:- type jump_info == set__set(jump_type).
+
+:- type jump_type
+	--->	can_break
+	;	can_continue
+	;	can_return
+	;	can_throw
+	;	can_complete
+	.
+
+
 :- type func_info
 	--->	func_info(mlds__qualified_entity_name, mlds__func_params).
 
-:- pred output_statements(indent, func_info, list(mlds__statement),
+:- pred output_statements(indent, func_info, list(mlds__statement), jump_info,
 		io__state, io__state).
-:- mode output_statements(in, in, in, di, uo) is det.
+:- mode output_statements(in, in, in, out, di, uo) is det.
 
-output_statements(Indent, FuncInfo, Statements) -->
-	list__foldl(output_statement(Indent, FuncInfo),
-			Statements).
+output_statements(_, _, [], set__make_singleton_set(can_complete)) --> [].
+output_statements(Indent, FuncInfo, [Statement|Statements], JumpInfo) -->
+	output_statement(Indent, FuncInfo, Statement, StmtJumpInfo),
+	( { set__member(can_complete, StmtJumpInfo) } ->
+		output_statements(Indent, FuncInfo, Statements, StmtsJumpInfo),
+		{ JumpInfo0 = set__union(StmtJumpInfo, StmtsJumpInfo) },
+		( { set__member(can_complete, StmtsJumpInfo) } ->
+			{ JumpInfo = JumpInfo0 }
+		;
+			% If the last statement could not complete normally
+			% the current block can no longer complete normally.
+			{ JumpInfo = set__delete(JumpInfo0, can_complete) }
+		)
+	;
+		% Don't output any more statements from the current list since
+		% the preceeding statement cannot complete.
+		{ JumpInfo = StmtJumpInfo }
+	).
 
-:- pred output_statement(indent, func_info, mlds__statement,
+:- pred output_statement(indent, func_info, mlds__statement, jump_info,
 		io__state, io__state).
-:- mode output_statement(in, in, in, di, uo) is det.
+:- mode output_statement(in, in, in, out, di, uo) is det.
 
-output_statement(Indent, FuncInfo, mlds__statement(Statement, Context)) -->
+output_statement(Indent, FuncInfo, mlds__statement(Statement, Context),
+		JumpInfo) -->
 	output_context(Context),
-	output_stmt(Indent, FuncInfo, Statement, Context).
+	output_stmt(Indent, FuncInfo, Statement, Context, JumpInfo).
 
-:- pred output_stmt(indent, func_info, mlds__stmt, mlds__context,
+:- pred output_stmt(indent, func_info, mlds__stmt, mlds__context, jump_info,
 		io__state, io__state).
-:- mode output_stmt(in, in, in, in, di, uo) is det.
+:- mode output_stmt(in, in, in, in, out, di, uo) is det.
 
 	%
 	% sequence
 	%
-output_stmt(Indent, FuncInfo, block(Defns, Statements), Context) -->
+output_stmt(Indent, FuncInfo, block(Defns, Statements), Context, JumpInfo) -->
 	indent_line(Indent),
 	io__write_string("{\n"),
 	( { Defns \= [] } ->
@@ -1818,33 +1860,70 @@
 	;
 		[]
 	),
-	output_statements(Indent + 1, FuncInfo, Statements),
+	output_statements(Indent + 1, FuncInfo, Statements, JumpInfo),
 	indent_line(Context, Indent),
 	io__write_string("}\n").
 
 	%
 	% iteration
 	%
-output_stmt(Indent, FuncInfo, while(Cond, Statement, no), _) -->
+output_stmt(Indent, FuncInfo, while(Cond, Statement, no), _, JumpInfo) -->
 	indent_line(Indent),
 	io__write_string("while ("),
 	output_rval(Cond),
 	io__write_string(")\n"),
-	output_statement(Indent + 1, FuncInfo, Statement).
-output_stmt(Indent, FuncInfo, while(Cond, Statement, yes), Context) -->
+	% The contained statement is reachable iff the while statement is 
+	% reachable and the condition expression is not a constant expression
+	% whose value is false.
+	( { Cond = const(false) } ->
+		indent_line(Indent),
+		io__write_string("{  /* Unreachable code */  }\n"),
+		{ JumpInfo = set__make_singleton_set(can_complete) }
+	;	
+		output_statement(Indent + 1, FuncInfo, Statement,
+				StmtJumpInfo),
+		{ JumpInfo = while_jump_info(Cond, StmtJumpInfo) }
+	).
+output_stmt(Indent, FuncInfo, while(Cond, Statement, yes), Context, 
+		JumpInfo) -->
 	indent_line(Indent),
 	io__write_string("do\n"),
-	output_statement(Indent + 1, FuncInfo, Statement),
+	output_statement(Indent + 1, FuncInfo, Statement, StmtJumpInfo),
 	indent_line(Context, Indent),
 	io__write_string("while ("),
 	output_rval(Cond),
-	io__write_string(");\n").
+	io__write_string(");\n"),
+	{ JumpInfo = while_jump_info(Cond, StmtJumpInfo) }.
+
+
+	% Returns a set of jump_types that describes whether the while 
+	% statement can complete normally.
+:- func while_jump_info(mlds__rval, jump_info) = jump_info.
+:- mode while_jump_info(in, in) = out is det.
+
+while_jump_info(Cond, BlockJumpInfo) = JumpInfo :-
+	% A while statement cannot complete normally if its condition
+	% expression is a constant expression with value true, and it
+	% doesn't contain a reachable break statement that exits the
+	% while statement.
+	(
+		Cond = mlds__const(mlds__true),
+		not set__member(can_break, BlockJumpInfo)
+	->
+		% Cannot complete normally
+		JumpInfo = set__init
+	;
+		JumpInfo0 = set__delete(BlockJumpInfo, can_continue),
+		JumpInfo1 = set__delete(JumpInfo0, can_break),
+		JumpInfo  = set__insert(JumpInfo1, can_complete)
+	).
+
 
 	%
 	% selection (if-then-else)
 	%
 output_stmt(Indent, FuncInfo, if_then_else(Cond, Then0, MaybeElse),
-		Context) -->
+		Context, JumpInfo) -->
 	%
 	% we need to take care to avoid problems caused by the
 	% dangling else ambiguity
@@ -1876,55 +1955,67 @@
 	io__write_string("if ("),
 	output_rval(Cond),
 	io__write_string(")\n"),
-	output_statement(Indent + 1, FuncInfo, Then),
+	output_statement(Indent + 1, FuncInfo, Then, ThenJumpInfo),
 	( { MaybeElse = yes(Else) } ->
 		indent_line(Context, Indent),
 		io__write_string("else\n"),
-		output_statement(Indent + 1, FuncInfo, Else)
-	;
-		[]
+		output_statement(Indent + 1, FuncInfo, Else, ElseJumpInfo),
+		% An if-then-else statement can complete normally iff the 
+		% then-statement can complete normally or the else-statement
+		% can complete normally.
+		{ JumpInfo = set__union(ThenJumpInfo, ElseJumpInfo) }
+	;
+		% An if-then statement can complete normally iff it is 
+		% reachable.
+		{ JumpInfo = set__make_singleton_set(can_complete) }
 	).
-
+	
+	
 
 	%
 	% selection (switch)
 	%
 output_stmt(Indent, FuncInfo, switch(_Type, Val, _Range, Cases, Default),
-		Context) -->
+		Context, JumpInfo) -->
 	indent_line(Context, Indent),
 	io__write_string("switch ("),
 	output_rval_maybe_with_enum(Val),
 	io__write_string(") {\n"),
-	list__foldl(output_switch_case(Indent + 1, FuncInfo, Context), Cases),
-	output_switch_default(Indent + 1, FuncInfo, Context, Default),
+	output_switch_cases(Indent + 1, FuncInfo, Context, Cases, Default,
+			JumpInfo),
 	indent_line(Context, Indent),
 	io__write_string("}\n").
-	
+
+
 	%
 	% transfer of control
 	% 
-output_stmt(_Indent, _FuncInfo, label(_LabelName), _Context) --> 
+output_stmt(_Indent, _FuncInfo, label(_LabelName), _Context, set__init) --> 
 	{ unexpected(this_file, 
 		"output_stmt: labels not supported in Java.") }.
-output_stmt(_Indent, _FuncInfo, goto(label(_LabelName)), _Context) --> 
+output_stmt(_Indent, _FuncInfo, goto(label(_LabelName)), _Context,
+		set__init) --> 
 	{ unexpected(this_file,
 		"output_stmt: gotos not supported in Java.") }.
-output_stmt(Indent, _FuncInfo, goto(break), _Context) --> 
+output_stmt(Indent, _FuncInfo, goto(break), _Context, JumpInfo) --> 
 	indent_line(Indent),
-	io__write_string("break;\n").
-output_stmt(Indent, _FuncInfo, goto(continue), _Context) --> 
-	indent_line(Indent),
-	io__write_string("continue;\n").
-output_stmt(_Indent, _FuncInfo, computed_goto(_Expr, _Labels), _Context) --> 
+	io__write_string("break;\n"),
+	{ JumpInfo = set__make_singleton_set(can_break) }.
+output_stmt(Indent, _FuncInfo, goto(continue), _Context, JumpInfo) --> 
+	indent_line(Indent),
+	io__write_string("continue;\n"),
+	{ JumpInfo = set__make_singleton_set(can_continue) }.
+output_stmt(_Indent, _FuncInfo, computed_goto(_Expr, _Labels), _Context,
+		set__init) --> 
 	{ unexpected(this_file, 
 		"output_stmt: computed gotos not supported in Java.") }.
 	
 	%
 	% function call/return
 	%
-output_stmt(Indent, CallerFuncInfo, Call, Context) -->
+output_stmt(Indent, CallerFuncInfo, Call, Context, JumpInfo) -->
 	{ Call = call(Signature, FuncRval, MaybeObject, CallArgs,
-		Results, _IsTailCall) },
+		Results, IsTailCall) },
 	{ CallerFuncInfo = func_info(_Name, _Params) },
 	{ Signature = mlds__func_signature(ArgTypes, RetTypes) },
 	indent_line(Indent),
@@ -2035,16 +2126,13 @@
 	;
 		[]
 	),
-	% XXX Is this needed? If present, it causes compiler errors for a
-	%     couple of files in the benchmarks directory.  -mjwybrow
-	%
-	% ( { IsTailCall = tail_call, Results = [] } ->
-	%	indent_line(Context, Indent + 1),
-	%	io__write_string("return;\n")
-	% ;
-	%	[]
-	% ),
-	%
+	( { IsTailCall = tail_call, Results = [] } ->
+		indent_line(Context, Indent + 1),
+		io__write_string("return;\n"),
+		{ JumpInfo = set__make_singleton_set(can_return) }
+	;
+		{ JumpInfo = set__make_singleton_set(can_complete) }
+	),
 	indent_line(Indent),
 	io__write_string("}\n").
 
@@ -2078,7 +2166,7 @@
 	).
 
 
-output_stmt(Indent, FuncInfo, return(Results0), _Context) -->
+output_stmt(Indent, FuncInfo, return(Results0), _Context, JumpInfo) -->
 	%
 	% XXX It's not right to just remove the dummy variables like this,
 	%     but currently they do not seem to be included in the ReturnTypes
@@ -2093,7 +2181,8 @@
 	% 
 	{ Results = remove_dummy_vars(Results0) },
 	( { Results = [] } ->
-		[]
+		indent_line(Indent),
+		io__write_string("return;\n")
 	; { Results = [Rval] } ->
 		indent_line(Indent),
 		io__write_string("return "),
@@ -2109,23 +2198,25 @@
 			(pred((Type - Result)::in, di, uo) is det -->
 				output_boxed_rval(Type, Result))),
 		io__write_string("};\n")
-	).
+	),
+	{ JumpInfo = set__make_singleton_set(can_return) }.
 
-output_stmt(Indent, _FuncInfo, do_commit(Ref), _) -->
+output_stmt(Indent, _FuncInfo, do_commit(Ref), _, JumpInfo) -->
 	indent_line(Indent),
 	output_rval(Ref),
 	io__write_string(" = new mercury.runtime.Commit();\n"),
 	indent_line(Indent),
 	io__write_string("throw "),
 	output_rval(Ref),
-	io__write_string(";\n").
+	io__write_string(";\n"),
+	{ JumpInfo = set__make_singleton_set(can_throw) }.
 
-output_stmt(Indent, FuncInfo, try_commit(_Ref, Stmt, Handler), _) -->
+output_stmt(Indent, FuncInfo, try_commit(_Ref, Stmt, Handler), _, JumpInfo) -->
 	indent_line(Indent),
 	io__write_string("try\n"),
 	indent_line(Indent),
 	io__write_string("{\n"),
-	output_statement(Indent + 1, FuncInfo, Stmt),
+	output_statement(Indent + 1, FuncInfo, Stmt, TryJumpInfo0),
 	indent_line(Indent),
 	io__write_string("}\n"),
 	indent_line(Indent),
@@ -2133,9 +2224,11 @@
 	indent_line(Indent),
 	io__write_string("{\n"),
 	indent_line(Indent + 1),
-	output_statement(Indent + 1, FuncInfo, Handler),
+	output_statement(Indent + 1, FuncInfo, Handler, CatchJumpInfo),
 	indent_line(Indent),
-	io__write_string("}\n").
+	io__write_string("}\n"),
+	{ TryJumpInfo = set__delete(TryJumpInfo0, can_throw) },
+	{ JumpInfo = set__union(TryJumpInfo, CatchJumpInfo) }.
 
 
 
@@ -2212,16 +2305,44 @@
 % Extra code for outputting switch statements
 %
 
+:- pred output_switch_cases(indent, func_info, mlds__context,
+		list(mlds__switch_case), mlds__switch_default, jump_info,
+		io__state, io__state).
+:- mode output_switch_cases(in, in, in, in, in, out, di, uo) is det.
+
+output_switch_cases(Indent, FuncInfo, Context, [], Default, JumpInfo) -->
+	output_switch_default(Indent, FuncInfo, Context, Default, JumpInfo).
+output_switch_cases(Indent, FuncInfo, Context, [Case|Cases], Default,
+		JumpInfo) -->
+	output_switch_case(Indent, FuncInfo, Context, Case, CaseJumpInfo0),
+	output_switch_cases(Indent, FuncInfo, Context, Cases, Default, 
+			CasesJumpInfo),
+	( { set__member(can_break, CaseJumpInfo0) } ->
+		{ CaseJumpInfo1 = set__delete(CaseJumpInfo0, can_break) },
+		{ CaseJumpInfo = set__insert(CaseJumpInfo1, can_complete) }
+	;
+		{ CaseJumpInfo = CaseJumpInfo0 }
+	),
+	{ JumpInfo = set__union(CaseJumpInfo, CasesJumpInfo) }.
+
+
 :- pred output_switch_case(indent, func_info, mlds__context,
-		mlds__switch_case, io__state, io__state).
-:- mode output_switch_case(in, in, in, in, di, uo) is det.
+		mlds__switch_case, jump_info, io__state, io__state).
+:- mode output_switch_case(in, in, in, in, out, di, uo) is det.
 
-output_switch_case(Indent, FuncInfo, Context, Case) -->
+output_switch_case(Indent, FuncInfo, Context, Case, JumpInfo) -->
 	{ Case = (Conds - Statement) },
 	list__foldl(output_case_cond(Indent, Context), Conds),
-	output_statement(Indent + 1, FuncInfo, Statement),
-	indent_line(Context, Indent + 1),
-	io__write_string("break;\n").
+	output_statement(Indent + 1, FuncInfo, Statement, StmtJumpInfo),
+	( { set__member(can_complete, StmtJumpInfo) } ->
+		indent_line(Context, Indent + 1),
+		io__write_string("break;\n"),
+		{ JumpInfo0 = set__delete(StmtJumpInfo, can_complete) },
+		{ JumpInfo = set__insert(JumpInfo0, can_break) }
+	;
+		% Don't output `break' since it would be unreachable.
+		{ JumpInfo = StmtJumpInfo }
+	).
 
 :- pred output_case_cond(indent, mlds__context, mlds__case_match_cond, 
 		io__state, io__state).
@@ -2237,20 +2358,26 @@
 		"output_case_cond: cannot match ranges in Java cases") }.
 
 :- pred output_switch_default(indent, func_info, mlds__context,
-		mlds__switch_default, io__state, io__state).
-:- mode output_switch_default(in, in, in, in, di, uo) is det.
+		mlds__switch_default, jump_info, io__state, io__state).
+:- mode output_switch_default(in, in, in, in, out, di, uo) is det.
 
-output_switch_default(_Indent, _FuncInfo, _Context, default_do_nothing) --> 
-	[].
-output_switch_default(Indent, FuncInfo, Context, default_case(Statement)) -->
+output_switch_default(_Indent, _FuncInfo, _Context, default_do_nothing,
+		JumpInfo) -->
+	{ JumpInfo = set__make_singleton_set(can_complete) }.
+output_switch_default(Indent, FuncInfo, Context, default_case(Statement),
+		JumpInfo) -->
 	indent_line(Context, Indent),
 	io__write_string("default:\n"),
-	output_statement(Indent + 1, FuncInfo, Statement).
-output_switch_default(Indent, _FuncInfo, Context, default_is_unreachable) -->
+	output_statement(Indent + 1, FuncInfo, Statement, JumpInfo).
+output_switch_default(Indent, _FuncInfo, Context, default_is_unreachable,
+		JumpInfo) -->
 	indent_line(Context, Indent),
 	io__write_string("default: /*NOTREACHED*/\n"), 
 	indent_line(Context, Indent + 1),
-	io__write_string("throw new mercury.runtime.UnreachableDefault();\n").
+	io__write_string("throw new mercury.runtime.UnreachableDefault();\n"),
+	% This exception will never be caught so statements following it are
+	% unreachable.
+	{ JumpInfo = set__make_singleton_set(can_throw) }.
 
 %-----------------------------------------------------------------------------%
 
@@ -2264,8 +2391,9 @@
 	%
 	% atomic statements
 	%
-output_stmt(Indent, FuncInfo, atomic(AtomicStatement), Context) -->
-	output_atomic_stmt(Indent, FuncInfo, AtomicStatement, Context).
+output_stmt(Indent, FuncInfo, atomic(AtomicStatement), Context, JumpInfo) -->
+	output_atomic_stmt(Indent, FuncInfo, AtomicStatement, Context),
+	{ JumpInfo = set__make_singleton_set(can_complete) }.
 
 :- pred output_atomic_stmt(indent, func_info,
 		mlds__atomic_statement, mlds__context, io__state, io__state).

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



More information about the reviews mailing list