[m-rev.] for review: Java unreachable code removal
Michael Wybrow
mjwybrow at students.cs.mu.oz.au
Sat Feb 16 10:40:39 AEDT 2002
For review by Fergus.
===================================================================
Estimated hours taken: 15
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.130
diff -u -r1.130 handle_options.m
--- handle_options.m 13 Feb 2002 04:30:56 -0000 1.130
+++ handle_options.m 15 Feb 2002 00:33:26 -0000
@@ -309,20 +309,16 @@
% Generating Java implies high-level code, turning off nested functions,
% using copy-out for both det and nondet output arguments,
- % using no tags, not optimizing tailcalls, no static ground terms and
- % store nondet environments on the heap.
+ % using no tags, no static ground terms and store nondet environments
+ % on the heap.
% XXX no static ground terms should be eliminated in a later
% version.
- % 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.
( { Target = java } ->
globals__io_set_option(highlevel_code, bool(yes)),
globals__io_set_option(highlevel_data, bool(yes)),
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 15 Feb 2002 23:30:20 -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 `JumpType') 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.
@@ -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, _JumpType),
indent_line(Context, Indent),
io__write_string("}\n") % end the function
).
@@ -1780,33 +1789,56 @@
% Code to output statements
%
+ % This type is used by many of the output_stmt style predicates to
+ % pass back the jump type of the current instruction being output.
+ % The idea here is that we know the previous instruction was an
+ % unconditional jump then we do not want to output the next intruction
+ % as it will be unreachable. We require both `jump_return' and
+ % `jump_break' since return statements cause all code following them
+ % until the end of the current method to be unreachable, whereas
+ % break/continue statements cause only code until then end of the
+ % innermost loop to be unreachable.
+:- type jump_type
+ ---> jump_return
+ ; jump_break % Used for both `break' and `continue'.
+ ; not_jump
+ .
+
:- 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_type,
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(_, _, [], not_jump) --> [].
+output_statements(Indent, FuncInfo, [Statement|Statements], JumpType) -->
+ output_statement(Indent, FuncInfo, Statement, StmtJumpType),
+ ( { StmtJumpType = not_jump } ->
+ output_statements(Indent, FuncInfo, Statements, JumpType)
+ ;
+ % The last statement was an unconditional jump so don't ouput
+ % any more statements from the current list.
+ { JumpType = StmtJumpType }
+ ).
-:- pred output_statement(indent, func_info, mlds__statement,
+:- pred output_statement(indent, func_info, mlds__statement, jump_type,
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),
+ JumpType) -->
output_context(Context),
- output_stmt(Indent, FuncInfo, Statement, Context).
+ output_stmt(Indent, FuncInfo, Statement, Context, JumpType).
-:- pred output_stmt(indent, func_info, mlds__stmt, mlds__context,
+:- pred output_stmt(indent, func_info, mlds__stmt, mlds__context, jump_type,
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, JumpType) -->
indent_line(Indent),
io__write_string("{\n"),
( { Defns \= [] } ->
@@ -1818,33 +1850,46 @@
;
[]
),
- output_statements(Indent + 1, FuncInfo, Statements),
+ output_statements(Indent + 1, FuncInfo, Statements, JumpType),
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), _, JumpType) -->
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) -->
+ output_statement(Indent + 1, FuncInfo, Statement, _StmtJumpType),
+ % We cannot be sure that this while loop will ever get executed. For
+ % this reason, even if we encountered a return statement in it's body,
+ % the while statement can not be considered an unconditional jump.
+ { JumpType = not_jump }.
+output_stmt(Indent, FuncInfo, while(Cond, Statement, yes), Context,
+ JumpType) -->
indent_line(Indent),
io__write_string("do\n"),
- output_statement(Indent + 1, FuncInfo, Statement),
+ output_statement(Indent + 1, FuncInfo, Statement, StmtJumpType),
indent_line(Context, Indent),
io__write_string("while ("),
output_rval(Cond),
- io__write_string(");\n").
+ io__write_string(");\n"),
+ ( { StmtJumpType = jump_return } ->
+ % We will always execute the body of this `do' statement once,
+ % so if it contains a `return' statement we can consider the
+ % `do' statement itself to be an unconditional jump.
+ { JumpType = jump_return }
+ ;
+ { JumpType = not_jump }
+ ).
%
% selection (if-then-else)
%
output_stmt(Indent, FuncInfo, if_then_else(Cond, Then0, MaybeElse),
- Context) -->
+ Context, JumpType) -->
%
% we need to take care to avoid problems caused by the
% dangling else ambiguity
@@ -1876,53 +1921,80 @@
io__write_string("if ("),
output_rval(Cond),
io__write_string(")\n"),
- output_statement(Indent + 1, FuncInfo, Then),
+ output_statement(Indent + 1, FuncInfo, Then, ThenJumpType),
( { MaybeElse = yes(Else) } ->
indent_line(Context, Indent),
io__write_string("else\n"),
- output_statement(Indent + 1, FuncInfo, Else)
+ output_statement(Indent + 1, FuncInfo, Else, ElseJumpType),
+ (
+ { ThenJumpType = ElseJumpType }
+ ->
+ % If the `then' and the `else' have the same jump type
+ % then we can consider the entire `if' to have that
+ % jump type.
+ { JumpType = ThenJumpType }
+ ;
+ ( { ThenJumpType = not_jump }
+ ; { ElseJumpType = not_jump }
+ )
+ ->
+ % If either the `then' or `else' do not contain an
+ % unconditional jump, then the entire `if' cannot be
+ % considered an unconditional jump.
+ { JumpType = not_jump }
+ ;
+ % This is simply the remaining case.
+ { JumpType = jump_break }
+
+ )
;
- []
+ { JumpType = ThenJumpType }
).
-
+
+
%
% selection (switch)
%
output_stmt(Indent, FuncInfo, switch(_Type, Val, _Range, Cases, Default),
- Context) -->
+ Context, JumpType) -->
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,
+ JumpType),
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, not_jump) -->
{ 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,
+ not_jump) -->
{ unexpected(this_file,
"output_stmt: gotos not supported in Java.") }.
-output_stmt(Indent, _FuncInfo, goto(break), _Context) -->
- indent_line(Indent),
- io__write_string("break;\n").
-output_stmt(Indent, _FuncInfo, goto(continue), _Context) -->
+output_stmt(Indent, _FuncInfo, goto(break), _Context, JumpType) -->
indent_line(Indent),
- io__write_string("continue;\n").
-output_stmt(_Indent, _FuncInfo, computed_goto(_Expr, _Labels), _Context) -->
+ io__write_string("break;\n"),
+ { JumpType = jump_break }.
+output_stmt(Indent, _FuncInfo, goto(continue), _Context, JumpType) -->
+ indent_line(Indent),
+ io__write_string("continue;\n"),
+ { JumpType = jump_break }.
+output_stmt(_Indent, _FuncInfo, computed_goto(_Expr, _Labels),
+ _Context, not_jump) -->
{ 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, JumpType) -->
{ Call = call(Signature, FuncRval, MaybeObject, CallArgs,
Results, _IsTailCall) },
{ CallerFuncInfo = func_info(_Name, _Params) },
@@ -2046,7 +2118,8 @@
% ),
%
indent_line(Indent),
- io__write_string("}\n").
+ io__write_string("}\n"),
+ { JumpType = not_jump }.
:- pred output_args_as_array(list(mlds__rval), list(mlds__type),
@@ -2078,7 +2151,7 @@
).
-output_stmt(Indent, FuncInfo, return(Results0), _Context) -->
+output_stmt(Indent, FuncInfo, return(Results0), _Context, JumpType) -->
%
% 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 +2166,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 +2183,27 @@
(pred((Type - Result)::in, di, uo) is det -->
output_boxed_rval(Type, Result))),
io__write_string("};\n")
- ).
+ ),
+ { JumpType = jump_return }.
-output_stmt(Indent, _FuncInfo, do_commit(Ref), _) -->
+output_stmt(Indent, _FuncInfo, do_commit(Ref), _, JumpType) -->
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"),
+ % If this is caught then execution could continue from the next
+ % statement so we cannot consider this to be an unconditional jump.
+ { JumpType = not_jump }.
-output_stmt(Indent, FuncInfo, try_commit(_Ref, Stmt, Handler), _) -->
+output_stmt(Indent, FuncInfo, try_commit(_Ref, Stmt, Handler), _, JumpType) -->
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, _TryJumpType),
indent_line(Indent),
io__write_string("}\n"),
indent_line(Indent),
@@ -2133,9 +2211,10 @@
indent_line(Indent),
io__write_string("{\n"),
indent_line(Indent + 1),
- output_statement(Indent + 1, FuncInfo, Handler),
+ output_statement(Indent + 1, FuncInfo, Handler, _CatchJumpType),
indent_line(Indent),
- io__write_string("}\n").
+ io__write_string("}\n"),
+ { JumpType = not_jump }.
@@ -2212,16 +2291,44 @@
% Extra code for outputting switch statements
%
+:- pred output_switch_cases(indent, func_info, mlds__context,
+ list(mlds__switch_case), mlds__switch_default, jump_type,
+ 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, JumpType) -->
+ output_switch_default(Indent, FuncInfo, Context, Default, JumpType).
+output_switch_cases(Indent, FuncInfo, Context, [Case|Cases], Default,
+ JumpType) -->
+ output_switch_case(Indent, FuncInfo, Context, Case, CaseJumpType),
+ output_switch_cases(Indent, FuncInfo, Context, Cases, Default,
+ CasesJumpType),
+ (
+ { CaseJumpType = jump_return },
+ { CasesJumpType = jump_return }
+ ->
+ { JumpType = jump_return }
+ ;
+ { JumpType = not_jump }
+ ).
+
+
:- 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_type, 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, JumpType) -->
{ 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, StmtJumpType),
+ ( { StmtJumpType = not_jump } ->
+ indent_line(Context, Indent + 1),
+ io__write_string("break;\n"),
+ { JumpType = jump_break }
+ ;
+ % Don't output `break' since it would be unreachable.
+ { JumpType = StmtJumpType }
+ ).
:- pred output_case_cond(indent, mlds__context, mlds__case_match_cond,
io__state, io__state).
@@ -2237,20 +2344,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_type, 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_do_nothing,
+ jump_return) -->
[].
-output_switch_default(Indent, FuncInfo, Context, default_case(Statement)) -->
+output_switch_default(Indent, FuncInfo, Context, default_case(Statement),
+ JumpType) -->
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, JumpType).
+output_switch_default(Indent, _FuncInfo, Context, default_is_unreachable,
+ JumpType) -->
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.
+ { JumpType = jump_return }.
%-----------------------------------------------------------------------------%A
@@ -2264,8 +2377,9 @@
%
% atomic statements
%
-output_stmt(Indent, FuncInfo, atomic(AtomicStatement), Context) -->
- output_atomic_stmt(Indent, FuncInfo, AtomicStatement, Context).
+output_stmt(Indent, FuncInfo, atomic(AtomicStatement), Context, JumpType) -->
+ output_atomic_stmt(Indent, FuncInfo, AtomicStatement, Context),
+ { JumpType = not_jump }.
:- 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