[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