[m-rev.] for post-commit review by anyone: fix bug #28
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Nov 19 17:34:56 AEDT 2007
Fix bug #28 in Mantis. The only substantive change is to code_info.m; the
changes to the other compiler modules are cosmetic only.
compiler/code_info.m:
Fix bug #28 in Mantis. The problem was with the code that generated the
annotation giving the set of live lvalues at calls: it didn't delete
from the set the registers used for passing dummy arguments, such as
I/O states. A recursive call for an I/O predicate would thus compute
the correct set of live lvalues at the start of the predicate body
(in the case of the test case, {r1}), but the wrong set at the
recursive call ((in the case of the test case, {r1,r2}, with r2
being the register assigned to hold the I/O state argument). The bug
was an abort caused by a sanity check looking for this kind of
mismatch.
compiler/c_util.m:
Make two predicates into functions to make them easier to use.
compiler/opt_debug.m:
Use those functions.
compiler/ml_code_gen.m:
compiler/pragma_c_gen.m:
Conform to the change to c_util.
compiler/jumpopt.m:
Delete unnecessary module qualifications.
tests/valid/testxmlreader.m:
tests/valid/xmlreader.m:
A regression test for this bug. It is in valid rather than hard_coded
because it cannot be made executable without libraries that not all
machines have, and which it would be inappropriate to add to the test
suite itself.
tests/valid/Mmakefile:
Enable the new test case.
Zoltan.
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/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/c_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/c_util.m,v
retrieving revision 1.38
diff -u -b -r1.38 c_util.m
--- compiler/c_util.m 9 Aug 2007 06:05:36 -0000 1.38
+++ compiler/c_util.m 19 Nov 2007 03:45:01 -0000
@@ -72,13 +72,13 @@
% C string literal. This doesn't actually add the enclosing double quotes
% -- that is the caller's responsibility.
%
-:- pred quote_string(string::in, string::out) is det.
+:- func quote_string(string) = string.
% Convert a character to a form that is suitably escaped for use as a
% C character literal. This doesn't actually add the enclosing single
% quotes -- that is the caller's responsibility.
%
-:- pred quote_char(char::in, string::out) is det.
+:- func quote_char(char) = string.
%-----------------------------------------------------------------------------%
%
@@ -261,14 +261,14 @@
).
output_quoted_char(Char, !IO) :-
- quote_char(Char, EscapedChars),
- io.write_string(EscapedChars, !IO).
+ EscapedCharStr = quote_char(Char),
+ io.write_string(EscapedCharStr, !IO).
-quote_char(Char, QuotedChar) :-
- quote_one_char(Char, [], RevQuotedChar),
- string.from_rev_char_list(RevQuotedChar, QuotedChar).
+quote_char(Char) = QuotedCharStr :-
+ quote_one_char(Char, [], RevQuotedCharStr),
+ string.from_rev_char_list(RevQuotedCharStr, QuotedCharStr).
-quote_string(String, QuotedString) :-
+quote_string(String) = QuotedString :-
string.foldl(quote_one_char, String, [], RevQuotedChars),
string.from_rev_char_list(RevQuotedChars, QuotedString).
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.351
diff -u -b -r1.351 code_info.m
--- compiler/code_info.m 9 Oct 2007 07:59:45 -0000 1.351
+++ compiler/code_info.m 19 Nov 2007 04:14:21 -0000
@@ -3801,6 +3801,7 @@
Detism = goal_info_get_determinism(GoalInfo),
get_opt_no_return_calls(!.CI, OptNoReturnCalls),
get_module_info(!.CI, ModuleInfo),
+ VarTypes = get_var_types(!.CI),
(
Detism = detism_erroneous,
OptNoReturnCalls = yes
@@ -3828,19 +3829,26 @@
),
StackVarLocs = ForwardVarLocs
),
- VarTypes = get_var_types(!.CI),
list.filter(valid_stack_slot(ModuleInfo, VarTypes), StackVarLocs,
RealStackVarLocs, DummyStackVarLocs)
),
get_var_locn_info(!.CI, VarLocnInfo0),
- var_arg_info_to_lval(InArgInfos, InArgLocs),
- list.append(RealStackVarLocs, InArgLocs, AllRealLocs),
+ list.filter(key_var_is_of_dummy_type(ModuleInfo, VarTypes), InArgInfos,
+ _DummyInArgInfos, RealInArgInfos),
+ var_arg_info_to_lval(RealInArgInfos, RealInArgLocs),
+ list.append(RealStackVarLocs, RealInArgLocs, AllRealLocs),
var_locn_place_vars(ModuleInfo, DummyStackVarLocs ++ AllRealLocs, Code,
VarLocnInfo0, VarLocnInfo),
set_var_locn_info(VarLocnInfo, !CI),
assoc_list.values(AllRealLocs, LiveLocList),
set.list_to_set(LiveLocList, LiveLocs).
+:- pred key_var_is_of_dummy_type(module_info::in, vartypes::in,
+ pair(prog_var, arg_info)::in) is semidet.
+
+key_var_is_of_dummy_type(ModuleInfo, VarTypes, Var - _ArgInfo) :-
+ var_is_of_dummy_type(ModuleInfo, VarTypes, Var).
+
:- pred valid_stack_slot(module_info::in, vartypes::in,
pair(prog_var, lval)::in) is semidet.
Index: compiler/jumpopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/jumpopt.m,v
retrieving revision 1.107
diff -u -b -r1.107 jumpopt.m
--- compiler/jumpopt.m 11 Oct 2007 11:45:17 -0000 1.107
+++ compiler/jumpopt.m 19 Nov 2007 03:45:01 -0000
@@ -383,7 +383,7 @@
MayAlterRtti = may_alter_rtti,
not set.member(RetLabel, LayoutLabels)
->
- jumpopt.final_dest(Instrmap, RetLabel, DestLabel,
+ final_dest(Instrmap, RetLabel, DestLabel,
RetInstr, _DestInstr),
( RetLabel = DestLabel ->
NewInstrs = [Instr0]
@@ -424,7 +424,7 @@
% Replace a jump to a det epilog with the epilog.
map.search(Procmap, TargetLabel, Between0)
->
- jumpopt.adjust_livevals(PrevInstr, Between0, Between),
+ adjust_livevals(PrevInstr, Between0, Between),
NewInstrs = Between ++
[llds_instr(goto(code_succip), "shortcircuit")],
NewRemain = specified(NewInstrs, Instrs0)
@@ -432,7 +432,7 @@
% Replace a jump to a semidet epilog with the epilog.
map.search(Sdprocmap, TargetLabel, Between0)
->
- jumpopt.adjust_livevals(PrevInstr, Between0, Between),
+ adjust_livevals(PrevInstr, Between0, Between),
NewInstrs = Between ++
[llds_instr(goto(code_succip), "shortcircuit")],
NewRemain = specified(NewInstrs, Instrs0)
@@ -440,7 +440,7 @@
% Replace a jump to a nondet epilog with the epilog.
map.search(Succmap, TargetLabel, BetweenIncl0)
->
- jumpopt.adjust_livevals(PrevInstr, BetweenIncl0, NewInstrs),
+ adjust_livevals(PrevInstr, BetweenIncl0, NewInstrs),
NewRemain = specified(NewInstrs, Instrs0)
;
% Replace a jump to a non-epilog block with the
@@ -459,13 +459,13 @@
% are short-circuited everywhere.
Fulljumpopt = yes,
map.search(Instrmap, TargetLabel, TargetInstr),
- jumpopt.final_dest(Instrmap, TargetLabel, DestLabel,
+ final_dest(Instrmap, TargetLabel, DestLabel,
TargetInstr, _DestInstr),
map.search(Blockmap, DestLabel, Block),
block_may_be_duplicated(Block) = yes
->
opt_util.filter_out_labels(Block, FilteredBlock),
- jumpopt.adjust_livevals(PrevInstr, FilteredBlock,
+ adjust_livevals(PrevInstr, FilteredBlock,
AdjustedBlock),
% Block may end with a goto to DestLabel. We avoid
% infinite expansion in such cases by removing
@@ -481,7 +481,7 @@
% Short-circuit the goto.
map.search(Instrmap, TargetLabel, TargetInstr)
->
- jumpopt.final_dest(Instrmap, TargetLabel, DestLabel,
+ final_dest(Instrmap, TargetLabel, DestLabel,
TargetInstr, DestInstr),
DestInstr = llds_instr(UdestInstr, _Destcomment),
Shorted = "shortcircuited jump: " ++ Comment0,
@@ -499,8 +499,8 @@
)
),
( map.search(Lvalmap, DestLabel, yes(Lvalinstr)) ->
- jumpopt.adjust_livevals(PrevInstr,
- [Lvalinstr | NewInstrs0], NewInstrs)
+ adjust_livevals(PrevInstr, [Lvalinstr | NewInstrs0],
+ NewInstrs)
;
NewInstrs = NewInstrs0
),
@@ -514,7 +514,7 @@
;
Uinstr0 = computed_goto(Index, LabelList0),
% Short-circuit all the destination labels.
- jumpopt.short_labels(Instrmap, LabelList0, LabelList),
+ short_labels(Instrmap, LabelList0, LabelList),
( LabelList = LabelList0 ->
NewRemain = usual_case
;
@@ -616,7 +616,7 @@
;
map.search(Instrmap, TargetLabel, TargetInstr)
->
- jumpopt.final_dest(Instrmap, TargetLabel, DestLabel,
+ final_dest(Instrmap, TargetLabel, DestLabel,
TargetInstr, _DestInstr),
(
% Attempt to transform code such as
@@ -683,7 +683,7 @@
;
Uinstr0 = assign(Lval, Rval0),
% Any labels mentioned in Rval0 should be short-circuited.
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval),
+ short_labels_rval(Instrmap, Rval0, Rval),
( Rval = Rval0 ->
NewRemain = usual_case
;
@@ -694,7 +694,7 @@
;
Uinstr0 = keep_assign(Lval, Rval0),
% Any labels mentioned in Rval0 should be short-circuited.
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval),
+ short_labels_rval(Instrmap, Rval0, Rval),
( Rval = Rval0 ->
NewRemain = usual_case
;
@@ -705,7 +705,7 @@
;
Uinstr0 = mkframe(FrameInfo, Redoip),
( Redoip = yes(code_label(Label0)) ->
- jumpopt.short_label(Instrmap, Label0, Label),
+ short_label(Instrmap, Label0, Label),
( Label = Label0 ->
NewRemain = usual_case
;
@@ -898,24 +898,23 @@
:- func redirect_comment(string) = string.
-redirect_comment(Comment0) = string.append(Comment0, " (redirected return)").
-
-% We avoid generating statements that redefine the value of a location
-% by comparing its old contents for non-equality with zero.
-%
-% The reason is that code such as r1 = !r1 causes gcc 2.7 on SPARCs to
-% abort with an internal error.
-%
-% Apparently this is the only place where the Mercury compiler generates
-% assignments like that, otherwise we might need a more general work-around
-% that worked for code generated by other parts of the compiler as well.
-%
-% (It is likely that the problem would occur if bool_not was ever inlined
-% into a procedure where the value being complemented was already known to
-% be false.)
+redirect_comment(Comment) = Comment ++ " (redirected return)".
-:- pred needs_workaround(lval, rval).
-:- mode needs_workaround(in, in) is semidet.
+ % We avoid generating statements that redefine the value of a location
+ % by comparing its old contents for non-equality with zero.
+ %
+ % The reason is that code such as r1 = !r1 causes gcc 2.7 on SPARCs to
+ % abort with an internal error.
+ %
+ % Apparently this is the only place where the Mercury compiler generates
+ % assignments like that, otherwise we might need a more general work-around
+ % that worked for code generated by other parts of the compiler as well.
+ %
+ % (It is likely that the problem would occur if bool_not was ever inlined
+ % into a procedure where the value being complemented was already known to
+ % be false.)
+ %
+:- pred needs_workaround(lval::in, rval::in) is semidet.
needs_workaround(Lval, Cond) :-
(
@@ -936,10 +935,10 @@
)
).
-:- pred jumpopt.adjust_livevals(instr::in, list(instruction)::in,
+:- pred adjust_livevals(instr::in, list(instruction)::in,
list(instruction)::out) is det.
-jumpopt.adjust_livevals(PrevInstr, Instrs0, Instrs) :-
+adjust_livevals(PrevInstr, Instrs0, Instrs) :-
(
PrevInstr = livevals(PrevLivevals),
opt_util.skip_comments(Instrs0, Instrs1),
@@ -960,39 +959,37 @@
% Short-circuit the given label by following any gotos at the
% labelled instruction or by falling through consecutive labels.
%
-:- pred jumpopt.short_label(instrmap::in, label::in, label::out) is det.
+:- pred short_label(instrmap::in, label::in, label::out) is det.
-jumpopt.short_label(Instrmap, Label0, Label) :-
+short_label(Instrmap, Label0, Label) :-
( map.search(Instrmap, Label0, Instr0) ->
- jumpopt.final_dest(Instrmap, Label0, Label, Instr0, _Instr)
+ final_dest(Instrmap, Label0, Label, Instr0, _Instr)
;
Label = Label0
).
-:- pred jumpopt.short_labels(instrmap::in, list(label)::in, list(label)::out)
- is det.
+:- pred short_labels(instrmap::in, list(label)::in, list(label)::out) is det.
-jumpopt.short_labels(_Instrmap, [], []).
-jumpopt.short_labels(Instrmap, [Label0 | Labels0], [Label | Labels]) :-
- jumpopt.short_label(Instrmap, Label0, Label),
- jumpopt.short_labels(Instrmap, Labels0, Labels).
+short_labels(_Instrmap, [], []).
+short_labels(Instrmap, [Label0 | Labels0], [Label | Labels]) :-
+ short_label(Instrmap, Label0, Label),
+ short_labels(Instrmap, Labels0, Labels).
%-----------------------------------------------------------------------------%
% Find the final destination of a given instruction at a given label.
% We follow gotos as well as consecutive labels.
%
-:- pred jumpopt.final_dest(instrmap::in, label::in, label::out,
- instruction::in, instruction::out) is det.
+:- pred final_dest(instrmap::in, label::in, label::out, instruction::in,
+ instruction::out) is det.
-jumpopt.final_dest(Instrmap, SrcLabel, DestLabel, SrcInstr, DestInstr) :-
- jumpopt.final_dest_2(Instrmap, [], SrcLabel, DestLabel,
- SrcInstr, DestInstr).
+final_dest(Instrmap, SrcLabel, DestLabel, SrcInstr, DestInstr) :-
+ final_dest_2(Instrmap, [], SrcLabel, DestLabel, SrcInstr, DestInstr).
-:- pred jumpopt.final_dest_2(instrmap::in, list(label)::in,
+:- pred final_dest_2(instrmap::in, list(label)::in,
label::in, label::out, instruction::in, instruction::out) is det.
-jumpopt.final_dest_2(Instrmap, LabelsSofar, SrcLabel, DestLabel,
+final_dest_2(Instrmap, LabelsSofar, SrcLabel, DestLabel,
SrcInstr, DestInstr) :-
(
SrcInstr = llds_instr(SrcUinstr, _Comment),
@@ -1004,7 +1001,7 @@
map.search(Instrmap, TargetLabel, TargetInstr),
\+ list.member(SrcLabel, LabelsSofar)
->
- jumpopt.final_dest_2(Instrmap, [SrcLabel | LabelsSofar],
+ final_dest_2(Instrmap, [SrcLabel | LabelsSofar],
TargetLabel, DestLabel, TargetInstr, DestInstr)
;
DestLabel = SrcLabel,
@@ -1013,99 +1010,98 @@
%-----------------------------------------------------------------------------%
-:- pred jumpopt.short_labels_rval(instrmap::in, rval::in, rval::out) is det.
+:- pred short_labels_rval(instrmap::in, rval::in, rval::out) is det.
-jumpopt.short_labels_rval(Instrmap, lval(Lval0), lval(Lval)) :-
- jumpopt.short_labels_lval(Instrmap, Lval0, Lval).
-jumpopt.short_labels_rval(_, var(_), _) :-
+short_labels_rval(Instrmap, lval(Lval0), lval(Lval)) :-
+ short_labels_lval(Instrmap, Lval0, Lval).
+short_labels_rval(_, var(_), _) :-
unexpected(this_file, "var rval in short_labels_rval").
-jumpopt.short_labels_rval(Instrmap, mkword(Tag, Rval0), mkword(Tag, Rval)) :-
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_rval(Instrmap, const(Const0), const(Const)) :-
- jumpopt.short_labels_const(Instrmap, Const0, Const).
-jumpopt.short_labels_rval(Instrmap, unop(Op, Rval0), unop(Op, Rval)) :-
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_rval(Instrmap, binop(Op, LRval0, RRval0),
+short_labels_rval(Instrmap, mkword(Tag, Rval0), mkword(Tag, Rval)) :-
+ short_labels_rval(Instrmap, Rval0, Rval).
+short_labels_rval(Instrmap, const(Const0), const(Const)) :-
+ short_labels_const(Instrmap, Const0, Const).
+short_labels_rval(Instrmap, unop(Op, Rval0), unop(Op, Rval)) :-
+ short_labels_rval(Instrmap, Rval0, Rval).
+short_labels_rval(Instrmap, binop(Op, LRval0, RRval0),
binop(Op, LRval, RRval)) :-
- jumpopt.short_labels_rval(Instrmap, LRval0, LRval),
- jumpopt.short_labels_rval(Instrmap, RRval0, RRval).
-jumpopt.short_labels_rval(_, mem_addr(MemRef), mem_addr(MemRef)).
+ short_labels_rval(Instrmap, LRval0, LRval),
+ short_labels_rval(Instrmap, RRval0, RRval).
+short_labels_rval(_, mem_addr(MemRef), mem_addr(MemRef)).
-:- pred jumpopt.short_labels_const(instrmap::in,
+:- pred short_labels_const(instrmap::in,
rval_const::in, rval_const::out) is det.
-jumpopt.short_labels_const(_, llconst_true, llconst_true).
-jumpopt.short_labels_const(_, llconst_false, llconst_false).
-jumpopt.short_labels_const(_, llconst_int(I), llconst_int(I)).
-jumpopt.short_labels_const(_, llconst_foreign(V, T), llconst_foreign(V, T)).
-jumpopt.short_labels_const(_, llconst_float(F), llconst_float(F)).
-jumpopt.short_labels_const(_, llconst_string(S), llconst_string(S)).
-jumpopt.short_labels_const(_, llconst_multi_string(S),
- llconst_multi_string(S)).
-jumpopt.short_labels_const(Instrmap, llconst_code_addr(CodeAddr0),
+short_labels_const(_, llconst_true, llconst_true).
+short_labels_const(_, llconst_false, llconst_false).
+short_labels_const(_, llconst_int(I), llconst_int(I)).
+short_labels_const(_, llconst_foreign(V, T), llconst_foreign(V, T)).
+short_labels_const(_, llconst_float(F), llconst_float(F)).
+short_labels_const(_, llconst_string(S), llconst_string(S)).
+short_labels_const(_, llconst_multi_string(S), llconst_multi_string(S)).
+short_labels_const(Instrmap, llconst_code_addr(CodeAddr0),
llconst_code_addr(CodeAddr)) :-
( CodeAddr0 = code_label(Label0) ->
- jumpopt.short_label(Instrmap, Label0, Label),
+ short_label(Instrmap, Label0, Label),
CodeAddr = code_label(Label)
;
CodeAddr = CodeAddr0
).
-jumpopt.short_labels_const(_, llconst_data_addr(D, O),
+short_labels_const(_, llconst_data_addr(D, O),
llconst_data_addr(D, O)).
-:- pred jumpopt.short_labels_maybe_rvals(instrmap::in, list(maybe(rval))::in,
+:- pred short_labels_maybe_rvals(instrmap::in, list(maybe(rval))::in,
list(maybe(rval))::out) is det.
-jumpopt.short_labels_maybe_rvals(_, [], []).
-jumpopt.short_labels_maybe_rvals(Instrmap, [MaybeRval0 | MaybeRvals0],
+short_labels_maybe_rvals(_, [], []).
+short_labels_maybe_rvals(Instrmap, [MaybeRval0 | MaybeRvals0],
[MaybeRval | MaybeRvals]) :-
- jumpopt.short_labels_maybe_rval(Instrmap, MaybeRval0, MaybeRval),
- jumpopt.short_labels_maybe_rvals(Instrmap, MaybeRvals0, MaybeRvals).
+ short_labels_maybe_rval(Instrmap, MaybeRval0, MaybeRval),
+ short_labels_maybe_rvals(Instrmap, MaybeRvals0, MaybeRvals).
-:- pred jumpopt.short_labels_maybe_rval(instrmap::in,
+:- pred short_labels_maybe_rval(instrmap::in,
maybe(rval)::in, maybe(rval)::out) is det.
-jumpopt.short_labels_maybe_rval(Instrmap, MaybeRval0, MaybeRval) :-
+short_labels_maybe_rval(Instrmap, MaybeRval0, MaybeRval) :-
(
MaybeRval0 = no,
MaybeRval = no
;
MaybeRval0 = yes(Rval0),
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval),
+ short_labels_rval(Instrmap, Rval0, Rval),
MaybeRval = yes(Rval)
).
-:- pred jumpopt.short_labels_lval(instrmap::in, lval::in, lval::out) is det.
+:- pred short_labels_lval(instrmap::in, lval::in, lval::out) is det.
-jumpopt.short_labels_lval(_, reg(T, N), reg(T, N)).
-jumpopt.short_labels_lval(_, succip, succip).
-jumpopt.short_labels_lval(_, maxfr, maxfr).
-jumpopt.short_labels_lval(_, curfr, curfr).
-jumpopt.short_labels_lval(_, hp, hp).
-jumpopt.short_labels_lval(_, sp, sp).
-jumpopt.short_labels_lval(_, parent_sp, parent_sp).
-jumpopt.short_labels_lval(_, temp(T, N), temp(T, N)).
-jumpopt.short_labels_lval(_, stackvar(N), stackvar(N)).
-jumpopt.short_labels_lval(_, parent_stackvar(N), parent_stackvar(N)).
-jumpopt.short_labels_lval(_, framevar(N), framevar(N)).
-jumpopt.short_labels_lval(_, global_var_ref(Var), global_var_ref(Var)).
-jumpopt.short_labels_lval(Instrmap, succip_slot(Rval0), succip_slot(Rval)) :-
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_lval(Instrmap, redoip_slot(Rval0), redoip_slot(Rval)) :-
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_lval(Instrmap, redofr_slot(Rval0), redofr_slot(Rval)) :-
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_lval(Instrmap, succfr_slot(Rval0), succfr_slot(Rval)) :-
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_lval(Instrmap, prevfr_slot(Rval0), prevfr_slot(Rval)) :-
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_lval(Instrmap, field(Tag, Rval0, Field0),
+short_labels_lval(_, reg(T, N), reg(T, N)).
+short_labels_lval(_, succip, succip).
+short_labels_lval(_, maxfr, maxfr).
+short_labels_lval(_, curfr, curfr).
+short_labels_lval(_, hp, hp).
+short_labels_lval(_, sp, sp).
+short_labels_lval(_, parent_sp, parent_sp).
+short_labels_lval(_, temp(T, N), temp(T, N)).
+short_labels_lval(_, stackvar(N), stackvar(N)).
+short_labels_lval(_, parent_stackvar(N), parent_stackvar(N)).
+short_labels_lval(_, framevar(N), framevar(N)).
+short_labels_lval(_, global_var_ref(Var), global_var_ref(Var)).
+short_labels_lval(Instrmap, succip_slot(Rval0), succip_slot(Rval)) :-
+ short_labels_rval(Instrmap, Rval0, Rval).
+short_labels_lval(Instrmap, redoip_slot(Rval0), redoip_slot(Rval)) :-
+ short_labels_rval(Instrmap, Rval0, Rval).
+short_labels_lval(Instrmap, redofr_slot(Rval0), redofr_slot(Rval)) :-
+ short_labels_rval(Instrmap, Rval0, Rval).
+short_labels_lval(Instrmap, succfr_slot(Rval0), succfr_slot(Rval)) :-
+ short_labels_rval(Instrmap, Rval0, Rval).
+short_labels_lval(Instrmap, prevfr_slot(Rval0), prevfr_slot(Rval)) :-
+ short_labels_rval(Instrmap, Rval0, Rval).
+short_labels_lval(Instrmap, field(Tag, Rval0, Field0),
field(Tag, Rval, Field)) :-
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval),
- jumpopt.short_labels_rval(Instrmap, Field0, Field).
-jumpopt.short_labels_lval(Instrmap, mem_ref(Rval0), mem_ref(Rval)) :-
- jumpopt.short_labels_rval(Instrmap, Rval0, Rval).
-jumpopt.short_labels_lval(_, lvar(_), _) :-
+ short_labels_rval(Instrmap, Rval0, Rval),
+ short_labels_rval(Instrmap, Field0, Field).
+short_labels_lval(Instrmap, mem_ref(Rval0), mem_ref(Rval)) :-
+ short_labels_rval(Instrmap, Rval0, Rval).
+short_labels_lval(_, lvar(_), _) :-
unexpected(this_file, "lvar lval in short_labels_lval").
:- pred short_foreign_proc_component(instrmap::in,
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.205
diff -u -b -r1.205 ml_code_gen.m
--- compiler/ml_code_gen.m 21 Aug 2007 15:50:40 -0000 1.205
+++ compiler/ml_code_gen.m 19 Nov 2007 03:45:02 -0000
@@ -3057,7 +3057,7 @@
->
module_info_pred_info(ModuleInfo, PredId, PredInfo),
Name = pred_info_name(PredInfo),
- c_util.quote_string(Name, MangledName),
+ MangledName = c_util.quote_string(Name),
string.append_list(["\tMR_OBTAIN_GLOBAL_LOCK(""",
MangledName, """);\n"], ObtainLock),
string.append_list(["\tMR_RELEASE_GLOBAL_LOCK(""",
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.199
diff -u -b -r1.199 opt_debug.m
--- compiler/opt_debug.m 11 Oct 2007 11:45:19 -0000 1.199
+++ compiler/opt_debug.m 19 Nov 2007 03:45:02 -0000
@@ -312,7 +312,7 @@
dump_const(_, llconst_float(F)) =
float_to_string(F).
dump_const(_, llconst_string(S)) =
- """" ++ S ++ """".
+ """" ++ quote_string(S) ++ """".
dump_const(_, llconst_multi_string(_S)) =
"multi_string(...)".
dump_const(MaybeProcLabel, llconst_code_addr(CodeAddr)) =
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.108
diff -u -b -r1.108 pragma_c_gen.m
--- compiler/pragma_c_gen.m 13 Aug 2007 01:27:45 -0000 1.108
+++ compiler/pragma_c_gen.m 19 Nov 2007 03:45:02 -0000
@@ -553,7 +553,7 @@
ThreadSafe = proc_not_thread_safe,
module_info_pred_info(ModuleInfo, PredId, PredInfo),
Name = pred_info_name(PredInfo),
- c_util.quote_string(Name, MangledName),
+ MangledName = c_util.quote_string(Name),
ObtainLockStr = "\tMR_OBTAIN_GLOBAL_LOCK("""
++ MangledName ++ """);\n",
ObtainLock = foreign_proc_raw_code(cannot_branch_away,
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/base64
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/fixed
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_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
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/log4m
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/mopenssl
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/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
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/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/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
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 ssdb
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
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/par_conj
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
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.200
diff -u -b -r1.200 Mmakefile
--- tests/valid/Mmakefile 1 Nov 2007 01:07:26 -0000 1.200
+++ tests/valid/Mmakefile 19 Nov 2007 04:19:18 -0000
@@ -210,6 +210,7 @@
switches \
tabled_for_io \
tabled_io \
+ testxmlreader \
trace_goal_reorder \
transitive_instance \
tricky_assert2 \
Index: tests/valid/testxmlreader.m
===================================================================
RCS file: tests/valid/testxmlreader.m
diff -N tests/valid/testxmlreader.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/testxmlreader.m 19 Nov 2007 04:19:38 -0000
@@ -0,0 +1,62 @@
+% vim: ts=4 sw=4 et ft=mercury
+%
+% This is a regression test for bug #28 in Mantis.
+
+:- module testxmlreader.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list, maybe, require, string, int.
+:- import_module xmlreader.
+
+main(!IO) :-
+ io.command_line_arguments(Args, !IO),
+ ( Args = [TFN] ->
+ FN = TFN
+ ;
+ error("usage: testxmlreader file.xml")
+ ),
+ xmlreader.open_file(FN, MayR, !IO),
+ (
+ MayR = yes(R),
+ dump_all_and_close(R, !IO)
+ ;
+ MayR = no,
+ error("Cannot read '" ++ FN ++ "'.")
+ ).
+
+:- pred dump_all_and_close(xmlreader::di, io::di, io::uo) is det.
+
+dump_all_and_close(R, !IO) :-
+ read(E, R, R2),
+ (
+ E = eof,
+ close_reader(R2, !IO)
+ ;
+ E = error(Err),
+ close_reader(R2, !IO),
+ error("Parsing error: "++int_to_string(Err))
+ ;
+ E = node(D, T, N, Empty, MV),
+ (
+ MV = yes(V),
+ ( length(V) > 40 ->
+ UseV = string.left(V, 40)
+ ;
+ UseV = V
+ )
+ ;
+ MV = no,
+ UseV = ""
+ ),
+ io.format("%d %d %s %s %s\n",
+ [i(D), i(T), s(N), s(string(Empty)), s(UseV)], !IO),
+ dump_all_and_close(R2, !IO),
+ % io.write_string("", !IO), % prevent tail recursion
+ true
+ ).
Index: tests/valid/xmlreader.m
===================================================================
RCS file: tests/valid/xmlreader.m
diff -N tests/valid/xmlreader.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/xmlreader.m 19 Nov 2007 06:16:09 -0000
@@ -0,0 +1,142 @@
+% vim: ts=4 sw=4 et ft=mercury
+:- module xmlreader.
+% Binding to xmlReader by Daniel Veillard
+:- interface.
+:- import_module io.
+:- import_module maybe, string, bool.
+
+:- type xmlreader.
+
+:- pred open_file(string::in, maybe(xmlreader)::uo, io::di, io::uo) is det.
+
+:- pred close_reader(xmlreader::di, io::di, io::uo) is det.
+
+:- type evt
+ ---> node(
+ depth :: int,
+ nodetype :: int,
+ name :: string,
+ is_empty :: bool,
+ value :: maybe(string)
+ )
+ ; error(int)
+ ; eof.
+
+:- pred read(evt::out, xmlreader::di, xmlreader::uo) is det.
+
+:- implementation.
+
+:- pragma foreign_decl(c, "
+/*
+#include <stdio.h>
+#include <libxml/xmlreader.h>
+*/
+").
+
+:- pragma foreign_type("C", xmlreader, "xmlTextReaderPtr",
+ [can_pass_as_mercury_type]).
+
+:- initialise c_init_xml_reader/2.
+
+:- pred c_init_xml_reader(io::di, io::uo) is det.
+
+:- pragma foreign_proc(c,
+ c_init_xml_reader(IIO::di, OIO::uo),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ /*
+ ** this initialize the library and check potential ABI mismatches
+ ** between the version it was compiled for and the actual shared
+ ** library used.
+ LIBXML_TEST_VERSION
+ */
+ LIBXML_TEST_VERSION = 1;
+
+ MR_update_io(IIO, OIO);
+").
+
+open_file(FN, MayReader, !IO) :-
+ c_open_file(FN, OK, Rdr, !IO),
+ ( OK = yes ->
+ MayReader = unsafe_promise_unique(yes(Rdr))
+ ;
+ MayReader = unsafe_promise_unique(no)
+ ).
+
+:- pred c_open_file(string::in, bool::out, xmlreader::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc(c,
+ c_open_file(FN::in, OK::out, Rdr::out, IIO::di, OIO::uo),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ /*
+ Rdr = xmlReaderForFile(FN, NULL, 0);
+ */
+ if (Rdr == NULL) {
+ OK = 0;
+ } else {
+ OK = 1;
+ }
+
+ MR_update_io(IIO, OIO);
+").
+
+:- pragma foreign_proc(c,
+ close_reader(Rdr::di, IIO::di, OIO::uo),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ /*
+ xmlFreeTextReader(Rdr);
+ */
+ MR_update_io(IIO, OIO);
+").
+
+read(Evt, !Rdr) :-
+ c_read(Ret, !Rdr),
+ ( Ret = 1 ->
+ c_get(Depth, NodeType, Name, Empty, GotVal, Val, !Rdr),
+ ( GotVal = yes ->
+ MayVal = yes(Val)
+ ;
+ MayVal = no
+ ),
+ Evt = node(Depth, NodeType, Name, Empty, MayVal)
+ ; Ret = 0 ->
+ Evt = eof
+ ;
+ Evt = error(Ret)
+ ).
+
+:- pred c_read(int::out, xmlreader::di, xmlreader::uo) is det.
+
+:- pragma foreign_proc(c,
+ c_read(Ret::out, IRdr::di, ORdr::uo),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ /*
+ Ret = xmlTextReaderRead(IRdr);
+ */
+ ORdr = IRdr;
+").
+
+:- pred c_get(int::out, int::out, string::out, bool::out,
+ bool::out, string::out, xmlreader::di, xmlreader::uo) is det.
+
+:- pragma foreign_proc(c,
+ c_get(Depth::out, NodeType::out, Name::out, Empty::out, GotVal::out,
+ Val::out, IRdr::di, ORdr::uo),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ /*
+ Name = xmlTextReaderConstName(IRdr);
+ if (Name == NULL)
+ Name = BAD_CAST ""--"";
+ Val = xmlTextReaderConstValue(IRdr);
+ Depth = xmlTextReaderDepth(IRdr);
+ NodeType = xmlTextReaderNodeType(IRdr);
+ Empty = xmlTextReaderIsEmptyElement(IRdr);
+ GotVal = xmlTextReaderHasValue(IRdr);
+ ORdr = IRdr;
+ */
+").
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 messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list