[m-rev.] diff: fix the bug reported by Michael Day
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Apr 20 14:03:46 AEST 2006
This is for both branches.
Zoltan.
Fix a bug reported by Michael Day. The bug was that when frameopt wanted
to find out whether a block of instructions referred to stack variables,
it did not look past pragma_c_code LLDS instructions. As a result, the
generated code included a (redundant) assignment to a stack variable
in a section of code that, after frameopt, did not have a stack frame
anymore. It therefore overwrote part of its caller's stack frame, which
caused a crash.
compiler/opt_util.m:
Fix the auxiliary predicate used by frameopt.
tests/hard_coded/prince_frameopt.{m,exp}:
tests/hard_coded/prince_frameopt_css.m:
tests/hard_coded/prince_frameopt_css.style.m:
The new test case (a three module program).
tests/hard_coded/Mmakefile:
tests/hard_coded/Mercury.options:
Enable the new test case, and compile it with the options required
to show the bug if it exists.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.145
diff -u -r1.145 opt_util.m
--- compiler/opt_util.m 10 Apr 2006 04:28:21 -0000 1.145
+++ compiler/opt_util.m 19 Apr 2006 10:15:28 -0000
@@ -741,137 +741,166 @@
).
block_refers_stackvars([], no).
-block_refers_stackvars([Uinstr0 - _ | Instrs0], Need) :-
+block_refers_stackvars([Instr | Instrs], Refers) :-
+ instr_refers_stackvars(Instr, InstrRefers),
+ (
+ InstrRefers = yes,
+ Refers = yes
+ ;
+ InstrRefers = no,
+ block_refers_stackvars(Instrs, Refers)
+ ).
+
+:- pred instr_refers_stackvars(instruction::in, bool::out) is det.
+
+instr_refers_stackvars(Uinstr0 - _, Refers) :-
(
Uinstr0 = comment(_),
- block_refers_stackvars(Instrs0, Need)
+ Refers = no
;
Uinstr0 = livevals(_),
- block_refers_stackvars(Instrs0, Need)
+ Refers = no
;
Uinstr0 = block(_, _, BlockInstrs),
- block_refers_stackvars(BlockInstrs, Need)
+ block_refers_stackvars(BlockInstrs, Refers)
;
Uinstr0 = assign(Lval, Rval),
- lval_refers_stackvars(Lval, Use1),
- rval_refers_stackvars(Rval, Use2),
- bool.or(Use1, Use2, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ lval_refers_stackvars(Lval, Refers1),
+ rval_refers_stackvars(Rval, Refers2),
+ bool.or(Refers1, Refers2, Refers)
;
Uinstr0 = call(_, _, _, _, _, _),
- Need = no
+ Refers = no
;
Uinstr0 = mkframe(_, _),
- Need = no
+ Refers = no
;
Uinstr0 = label(_),
- Need = no
+ Refers = no
;
Uinstr0 = goto(_),
- Need = no
+ Refers = no
;
Uinstr0 = computed_goto(Rval, _),
- rval_refers_stackvars(Rval, Use),
- Need = Use
+ rval_refers_stackvars(Rval, Refers)
;
Uinstr0 = c_code(_, _),
- Need = no
+ Refers = no
;
Uinstr0 = if_val(Rval, _),
- rval_refers_stackvars(Rval, Use),
- Need = Use
+ rval_refers_stackvars(Rval, Refers)
;
Uinstr0 = save_maxfr(Lval),
- lval_refers_stackvars(Lval, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ lval_refers_stackvars(Lval, Refers)
;
Uinstr0 = restore_maxfr(Lval),
- lval_refers_stackvars(Lval, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ lval_refers_stackvars(Lval, Refers)
;
Uinstr0 = incr_hp(Lval, _, _, Rval, _),
- lval_refers_stackvars(Lval, Use1),
- rval_refers_stackvars(Rval, Use2),
- bool.or(Use1, Use2, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ lval_refers_stackvars(Lval, Refers1),
+ rval_refers_stackvars(Rval, Refers2),
+ bool.or(Refers1, Refers2, Refers)
;
Uinstr0 = mark_hp(Lval),
- lval_refers_stackvars(Lval, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ lval_refers_stackvars(Lval, Refers)
;
Uinstr0 = restore_hp(Rval),
- rval_refers_stackvars(Rval, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ rval_refers_stackvars(Rval, Refers)
;
Uinstr0 = free_heap(Rval),
- rval_refers_stackvars(Rval, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ rval_refers_stackvars(Rval, Refers)
;
Uinstr0 = store_ticket(Lval),
- lval_refers_stackvars(Lval, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ lval_refers_stackvars(Lval, Refers)
;
Uinstr0 = reset_ticket(Rval, _Reason),
- rval_refers_stackvars(Rval, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ rval_refers_stackvars(Rval, Refers)
;
Uinstr0 = discard_ticket,
- block_refers_stackvars(Instrs0, Need)
+ Refers = no
;
Uinstr0 = prune_ticket,
- block_refers_stackvars(Instrs0, Need)
+ Refers = no
;
Uinstr0 = mark_ticket_stack(Lval),
- lval_refers_stackvars(Lval, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ lval_refers_stackvars(Lval, Refers)
;
Uinstr0 = prune_tickets_to(Rval),
- rval_refers_stackvars(Rval, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ rval_refers_stackvars(Rval, Refers)
;
% handled specially
Uinstr0 = incr_sp(_, _),
- Need = no
+ Refers = no
;
% handled specially
Uinstr0 = decr_sp(_),
- Need = no
+ Refers = no
;
% handled specially
Uinstr0 = decr_sp_and_return(_),
- Need = no
+ Refers = no
;
- Uinstr0 = pragma_c(_, _, _, _, _, _, _, _, _),
- Need = no
+ Uinstr0 = pragma_c(_, Components, _, _, _, _, _, _, _),
+ bool.or_list(list.map(pragma_c_component_refers_stackvars, Components),
+ Refers)
;
Uinstr0 = init_sync_term(Lval, _),
- lval_refers_stackvars(Lval, Need)
+ lval_refers_stackvars(Lval, Refers)
;
Uinstr0 = fork(_, _, _),
- Need = no
+ Refers = no
;
Uinstr0 = join_and_terminate(Lval),
- lval_refers_stackvars(Lval, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ lval_refers_stackvars(Lval, Refers)
;
Uinstr0 = join_and_continue(Lval, _),
- lval_refers_stackvars(Lval, Use),
- need_if_use_or_refers_stackvars(Use, Instrs0, Need)
+ lval_refers_stackvars(Lval, Refers)
).
- % This is to make block_refers_stackvars tail recursive.
-:- pragma inline(need_if_use_or_refers_stackvars/3).
+:- func pragma_c_component_refers_stackvars(pragma_c_component) = bool.
+
+pragma_c_component_refers_stackvars(Component) = Refers :-
+ (
+ Component = pragma_c_inputs(Inputs),
+ bool.or_list(list.map(pragma_c_input_refers_stackvars, Inputs),
+ Refers)
+ ;
+ Component = pragma_c_outputs(Outputs),
+ bool.or_list(list.map(pragma_c_output_refers_stackvars, Outputs),
+ Refers)
+ ;
+ ( Component = pragma_c_user_code(_, _)
+ ; Component = pragma_c_raw_code(_, _, _)
+ ; Component = pragma_c_fail_to(_)
+ ; Component = pragma_c_noop
+ ),
+ Refers = no
+ ).
+
+:- func pragma_c_input_refers_stackvars(pragma_c_input) = bool.
+
+pragma_c_input_refers_stackvars(Input) = Refers :-
+ Input = pragma_c_input(_Name, _Type, IsDummy, _OrigType, Rval,
+ _MaybeForeign, _BoxPolicy),
+ (
+ IsDummy = yes,
+ Refers = no
+ ;
+ IsDummy = no,
+ rval_refers_stackvars(Rval, Refers)
+ ).
-:- pred need_if_use_or_refers_stackvars(bool::in, list(instruction)::in,
- bool::out) is det.
+:- func pragma_c_output_refers_stackvars(pragma_c_output) = bool.
-need_if_use_or_refers_stackvars(Use, Instrs, Need) :-
+pragma_c_output_refers_stackvars(Input) = Refers :-
+ Input = pragma_c_output(Lval, _Type, IsDummy, _OrigType, _Name,
+ _MaybeForeign, _BoxPolicy),
(
- Use = yes,
- Need = yes
+ IsDummy = yes,
+ Refers = no
;
- Use = no,
- block_refers_stackvars(Instrs, Need)
+ IsDummy = no,
+ lval_refers_stackvars(Lval, Refers)
).
filter_out_labels([], []).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mercury.options,v
retrieving revision 1.17
diff -u -r1.17 Mercury.options
--- tests/hard_coded/Mercury.options 7 Apr 2006 01:29:28 -0000 1.17
+++ tests/hard_coded/Mercury.options 19 Apr 2006 10:48:47 -0000
@@ -37,6 +37,9 @@
MCFLAGS-loop_inv_test0 = --loop-invariants --trace-optimized
MCFLAGS-loop_inv_test1 = --loop-invariants --trace-optimized
MCFLAGS-loop_inv_test2 = --loop-invariants --trace-optimized
+MCFLAGS-prince_frameopt = --intermodule-optimization -O5
+MCFLAGS-prince_frameopt_css = --intermodule-optimization -O5
+MCFLAGS-prince_frameopt_css.style = --intermodule-optimization -O5
MCFLAGS-puzzle_detism_bug = --trace-optimized --inlining
MCFLAGS-no_inline_builtins = --no-inline-builtins
MCFLAGS-no_warn_singleton = --halt-at-warn
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.284
diff -u -r1.284 Mmakefile
--- tests/hard_coded/Mmakefile 7 Apr 2006 01:32:57 -0000 1.284
+++ tests/hard_coded/Mmakefile 19 Apr 2006 10:27:22 -0000
@@ -147,6 +147,7 @@
pragma_import \
pragma_inline \
pretty_printing \
+ prince_frameopt \
promise_equivalent_clauses \
promise_equivalent_solutions_test \
promise_equiv_with_svars \
Index: tests/hard_coded/prince_frameopt.exp
===================================================================
RCS file: tests/hard_coded/prince_frameopt.exp
diff -N tests/hard_coded/prince_frameopt.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/prince_frameopt.exp 19 Apr 2006 10:42:41 -0000
@@ -0,0 +1,3 @@
+About to crash
+[max_width(value(percent(100.000000000000)))]
+Done
Index: tests/hard_coded/prince_frameopt.m
===================================================================
RCS file: tests/hard_coded/prince_frameopt.m
diff -N tests/hard_coded/prince_frameopt.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/prince_frameopt.m 19 Apr 2006 10:26:50 -0000
@@ -0,0 +1,34 @@
+% Versions of the compiler up to April 19, 2006 had a bug that caused this
+% program to crash. The bug was that when frameopt wanted to find out whether
+% a block of instructions referred to stack variables, it did not look past
+% pragma_c_code LLDS instructions. As a result, the generated code included
+% a (redundant) assignment to a stack variable in a section of code that,
+% after frameopt, did not have a stack frame anymore. It therefore overwrote
+% part of its caller's stack frame, which caused a crash.
+%
+% The bug showed up in YesLogic's Prince, and was isolated to this test case
+% by Michael Day. The bug actually occurred when optimizing get_max_width in
+% prince_frameopt_css.style.m.
+
+:- module prince_frameopt.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io, io).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module string.
+
+:- import_module prince_frameopt_css.
+:- import_module prince_frameopt_css.style.
+
+main(!IO) :-
+ write_string("About to crash\n", !IO),
+ PRules = new_prules,
+ write(PRules, !IO),
+ nl(!IO),
+ write_string("Done\n", !IO).
Index: tests/hard_coded/prince_frameopt_css.m
===================================================================
RCS file: tests/hard_coded/prince_frameopt_css.m
diff -N tests/hard_coded/prince_frameopt_css.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/prince_frameopt_css.m 19 Apr 2006 10:22:50 -0000
@@ -0,0 +1,38 @@
+:- module prince_frameopt_css.
+
+:- interface.
+
+:- import_module string, int, float.
+
+:- include_module prince_frameopt_css.style.
+
+:- type length
+ ---> absolute(float).
+
+:- type value
+ ---> ident(string)
+ ; percent(number).
+
+:- type number
+ ---> int(int)
+ ; float(float).
+
+:- func get_length(value) = length is det.
+:- func get_percent(value) = float is semidet.
+
+:- implementation.
+
+get_length(V) = L :-
+ ( if V = ident("zero") then
+ L = absolute(0.0)
+ else
+ L = absolute(1.0)
+ ).
+
+get_percent(percent(N0)) = N :-
+ (
+ N0 = int(N1),
+ N = float(N1)
+ ;
+ N0 = float(N)
+ ).
Index: tests/hard_coded/prince_frameopt_css.style.m
===================================================================
RCS file: tests/hard_coded/prince_frameopt_css.style.m
diff -N tests/hard_coded/prince_frameopt_css.style.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/prince_frameopt_css.style.m 19 Apr 2006 10:23:15 -0000
@@ -0,0 +1,39 @@
+:- module prince_frameopt_css.style.
+
+:- interface.
+
+:- import_module list.
+
+:- func new_prules = list(property).
+
+:- type property
+ ---> max_width(spec(max_width)).
+
+:- type max_width
+ ---> length(length)
+ ; percent(float).
+
+:- type spec(T)
+ ---> inherit
+ ; value(T).
+
+:- implementation.
+
+:- func get_max_width(value) = max_width is det.
+
+get_max_width(V) =
+ ( if get_percent(V) = W then
+ percent(W)
+ else
+ length(get_length(V))
+ ).
+
+:- func spec((func(value) = T), value) = spec(T).
+:- mode spec((func(in) = out is det), in) = out is det.
+
+spec(F, V) =
+ ( if V = ident("inherit") then inherit
+ else value(F(V))
+ ).
+
+new_prules = [max_width(spec(get_max_width, percent(int(100))))].
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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