[m-dev.] for review: frameopt bug fix
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Nov 11 19:20:54 AEDT 1999
For review by anyone who knows about frameopt.
Fix a bug in frameopt reported by Serge Varennes on April 15, 1999.
The bug was that frameopt recognized that a procedure did not need a
stack frame, and deleted the frame setup code, but did not redirect the
failure branches inside inlined model_semi pragma_c instructions,
so that they still led to code that deallocated the (now nonexistent)
stack frame. This meant that calls to this procedure violated the
invariant which says that calls leave MR_sp unchanged.
compiler/llds.m:
Add a new pragma C component (pragma_c_fail_to) that represents the
branch to a label on failure of a model_semi piece of C code, instead
of handling this by generating a string containing the C code that
branches to this label. Record the failure label as a new field
in pragma_c instructions.
The point of this change is that it makes it possible to substitute
the failure label in frameopt.
Add also a pragma_c_noop component to make the generated code somewhat
better optimizable.
compiler/pragma_c_gen.m:
Generate the new LLDS components.
compiler/llds_out.m:
Output the new LLDS components.
Move a predicate declaration away from the middle of another predicate.
compiler/frameopt.m:
Perform substitutions on pragma C code labels that occur only in
in pragma_c_fail_to components.
If a pragma_c instruction has any other references to labels, we now
assume that the block containing the instruction needs a stack frame,
since those labels can't be substituted with their non-teardown
parallels if this block is moved to a context without a stack frame.
compiler/basic_block.m:
compiler/dupelim.m:
compiler/frameopt.m:
compiler/opt_util.m:
Both basic_block.m and dupelim.m had code that substantially
duplicated code in frameopt.m. This change factors out the differences
among the versions and moves the unified predicates to opt_util.m.
compiler/code_gen.m:
compiler/code_info.m:
compiler/dupelim.m:
compiler/livemap.m:
compiler/llds_common.m:
compiler/middle_rec.m:
compiler/opt_debug.m:
compiler/trace.m:
compiler/value_number.m:
compiler/vn_*.m:
Trivial updates to conform to the changes in llds.m.
tests/hard_coded/frameopt_pragma_redirect.{m,exp}:
A new test case that exhibits the problem. (It is not the original
test cases submitted by Serge Varennes, because that code depended
on non-standard functions in ieeefp.h.)
tests/hard_coded/Mmakefile:
Enable the new test case.
Zoltan.
cvs diff: Diffing .
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/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/basic_block.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/basic_block.m,v
retrieving revision 1.7
diff -u -b -r1.7 basic_block.m
--- basic_block.m 1998/07/29 08:52:45 1.7
+++ basic_block.m 1999/11/11 02:27:24
@@ -142,57 +142,6 @@
).
%-----------------------------------------------------------------------------%
-
- % Given an instruction, find the set of labels to which it can cause
- % control to transfer. In the case of calls, this includes transfer
- % via return from the called procedure.
-
-:- pred possible_targets(instr::in, list(label)::out) is det.
-
-possible_targets(comment(_), []).
-possible_targets(livevals(_), []).
-possible_targets(block(_, _, _), _) :-
- error("block in possible_targets").
-possible_targets(assign(_, _), []).
-possible_targets(call(_, ReturnAddr, _, _), Labels) :-
- ( ReturnAddr = label(Label) ->
- Labels = [Label]
- ;
- Labels = []
- ).
-possible_targets(mkframe(_, _), []).
-possible_targets(label(_), []).
-possible_targets(goto(CodeAddr), Targets) :-
- ( CodeAddr = label(Label) ->
- Targets = [Label]
- ;
- Targets = []
- ).
-possible_targets(computed_goto(_, Targets), Targets).
-possible_targets(c_code(_), []).
-possible_targets(if_val(_, CodeAddr), Targets) :-
- ( CodeAddr = label(Label) ->
- Targets = [Label]
- ;
- Targets = []
- ).
-possible_targets(incr_hp(_, _, _, _), []).
-possible_targets(mark_hp(_), []).
-possible_targets(restore_hp(_), []).
-possible_targets(store_ticket(_), []).
-possible_targets(reset_ticket(_, _), []).
-possible_targets(discard_ticket, []).
-possible_targets(mark_ticket_stack(_), []).
-possible_targets(discard_tickets_to(_), []).
-possible_targets(incr_sp(_, _), []).
-possible_targets(decr_sp(_), []).
-possible_targets(init_sync_term(_, _), []).
-possible_targets(fork(P, C, _), [P, C]).
-possible_targets(join_and_terminate(_), []).
-possible_targets(join_and_continue(_, L), [L]).
-possible_targets(pragma_c(_, _, _, _, _), []).
-
-%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
flatten_basic_blocks([], _, []).
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.68
diff -u -b -r1.68 code_gen.m
--- code_gen.m 1999/10/25 03:48:38 1.68
+++ code_gen.m 1999/11/11 02:00:40
@@ -569,7 +569,7 @@
mkframe(NondetFrameInfo, OutsideResumeAddress)
- "Allocate stack frame",
pragma_c([], DefineComponents,
- will_not_call_mercury, no, no)
+ will_not_call_mercury, no, no, no)
- ""
]) },
{ NondetPragma = yes }
@@ -656,7 +656,7 @@
{ UndefComponents = [pragma_c_raw_code(UndefStr)] },
{ UndefCode = node([
pragma_c([], UndefComponents,
- will_not_call_mercury, no, no)
+ will_not_call_mercury, no, no, no)
- ""
]) },
{ RestoreDeallocCode = empty }, % always empty for nondet code
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.242
diff -u -b -r1.242 code_info.m
--- code_info.m 1999/10/08 02:55:23 1.242
+++ code_info.m 1999/11/11 01:51:47
@@ -1758,7 +1758,7 @@
],
MarkCode = node([
pragma_c([], Components, will_not_call_mercury,
- no, no) - ""
+ no, no, no) - ""
])
;
UseMinimalModel = no,
@@ -1834,8 +1834,8 @@
pragma_c_raw_code("\tMR_commit_cut();\n")
],
CutCode = node([
- pragma_c([], Components,
- will_not_call_mercury, no, no)
+ pragma_c([], Components, will_not_call_mercury,
+ no, no, no)
- "commit for temp frame hijack"
])
;
Index: compiler/dupelim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dupelim.m,v
retrieving revision 1.42
diff -u -b -r1.42 dupelim.m
--- dupelim.m 1999/08/24 08:51:56 1.42
+++ dupelim.m 1999/11/11 03:11:01
@@ -83,7 +83,8 @@
process_clusters(Clusters, LabelSeq0, LabelSeq,
BlockMap0, BlockMap, ReplMap0, ReplMap),
flatten_basic_blocks(LabelSeq, BlockMap, Instrs1),
- dupelim__replace_labels_instr_list(Instrs1, ReplMap, Instrs2),
+ opt_util__replace_labels_instruction_list(Instrs1,
+ ReplMap, yes, Instrs2),
list__append(Comments, Instrs2, Instrs)
).
@@ -114,8 +115,8 @@
),
AddPragmaReferredLabels = lambda(
[Instr::in, FoldFixed0::in, FoldFixed::out] is det, (
- ( Instr = pragma_c(_, _, _, yes(PragmaLabel), _) - _ ->
- set__insert(FoldFixed0, PragmaLabel, FoldFixed)
+ ( Instr = pragma_c(_, _, _, yes(FixedLabel), _, _) - _ ->
+ set__insert(FoldFixed0, FixedLabel, FoldFixed)
;
FoldFixed = FoldFixed0
)
@@ -366,7 +367,7 @@
standardize_lval(Lval1, Lval),
Instr = join_and_continue(Lval, N)
;
- Instr1 = pragma_c(_, _, _, _, _),
+ Instr1 = pragma_c(_, _, _, _, _, _),
Instr = Instr1
).
@@ -635,7 +636,7 @@
Instr2 = Instr1,
Instr = Instr1
;
- Instr1 = pragma_c(_, _, _, _, _),
+ Instr1 = pragma_c(_, _, _, _, _, _),
Instr2 = Instr1,
Instr = Instr1
).
@@ -761,230 +762,6 @@
Rval1 = mem_addr(_),
Rval2 = Rval1,
Rval = Rval1
- ).
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
- % The code in this section is concerned with replacing all references
- % to one given label with a reference to another given label.
-
-:- pred dupelim__replace_labels_instr_list(list(instruction)::in,
- map(label, label)::in, list(instruction)::out) is det.
-
-dupelim__replace_labels_instr_list([], _ReplMap, []).
-dupelim__replace_labels_instr_list([Instr0 - Comment | Instrs0],
- ReplMap, [Instr - Comment | Instrs]) :-
- dupelim__replace_labels_instr(Instr0, ReplMap, Instr),
- dupelim__replace_labels_instr_list(Instrs0, ReplMap, Instrs).
-
-:- pred dupelim__replace_labels_instr(instr::in, map(label, label)::in,
- instr::out) is det.
-
-dupelim__replace_labels_instr(comment(Comment), _, comment(Comment)).
-dupelim__replace_labels_instr(livevals(Livevals), _, livevals(Livevals)).
-dupelim__replace_labels_instr(block(R, F, Instrs0), ReplMap,
- block(R, F, Instrs)) :-
- dupelim__replace_labels_instr_list(Instrs0, ReplMap, Instrs).
-dupelim__replace_labels_instr(assign(Lval0, Rval0), ReplMap,
- assign(Lval, Rval)) :-
- dupelim__replace_labels_lval(Lval0, ReplMap, Lval),
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_instr(call(Target, Return0, LiveInfo, CM),
- ReplMap, call(Target, Return, LiveInfo, CM)) :-
- dupelim__replace_labels_code_addr(Return0, ReplMap, Return).
-dupelim__replace_labels_instr(mkframe(NondetFrameInfo, Redoip0), ReplMap,
- mkframe(NondetFrameInfo, Redoip)) :-
- dupelim__replace_labels_code_addr(Redoip0, ReplMap, Redoip).
-dupelim__replace_labels_instr(label(Label), ReplMap, label(Label)) :-
- ( map__search(ReplMap, Label, _) ->
- error("found eliminated label in dupelim__replace_labels_instr")
- ;
- true
- ).
-dupelim__replace_labels_instr(goto(Target0), ReplMap, goto(Target)) :-
- dupelim__replace_labels_code_addr(Target0, ReplMap, Target).
-dupelim__replace_labels_instr(computed_goto(Rval0, Labels0), ReplMap,
- computed_goto(Rval, Labels)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval),
- dupelim__replace_labels_label_list(Labels0, ReplMap, Labels).
-dupelim__replace_labels_instr(c_code(Code), _, c_code(Code)).
-dupelim__replace_labels_instr(if_val(Rval0, Target0), ReplMap,
- if_val(Rval, Target)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval),
- dupelim__replace_labels_code_addr(Target0, ReplMap, Target).
-dupelim__replace_labels_instr(incr_hp(Lval0, MaybeTag, Rval0, Msg), ReplMap,
- incr_hp(Lval, MaybeTag, Rval, Msg)) :-
- dupelim__replace_labels_lval(Lval0, ReplMap, Lval),
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_instr(mark_hp(Lval0), ReplMap, mark_hp(Lval)) :-
- dupelim__replace_labels_lval(Lval0, ReplMap, Lval).
-dupelim__replace_labels_instr(restore_hp(Rval0), ReplMap, restore_hp(Rval)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_instr(store_ticket(Lval0), ReplMap,
- store_ticket(Lval)) :-
- dupelim__replace_labels_lval(Lval0, ReplMap, Lval).
-dupelim__replace_labels_instr(reset_ticket(Rval0, Reason), ReplMap,
- reset_ticket(Rval, Reason)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_instr(discard_ticket, _, discard_ticket).
-dupelim__replace_labels_instr(mark_ticket_stack(Lval0), ReplMap,
- mark_ticket_stack(Lval)) :-
- dupelim__replace_labels_lval(Lval0, ReplMap, Lval).
-dupelim__replace_labels_instr(discard_tickets_to(Rval0), ReplMap,
- discard_tickets_to(Rval)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_instr(incr_sp(Size, Msg), _, incr_sp(Size, Msg)).
-dupelim__replace_labels_instr(decr_sp(Size), _, decr_sp(Size)).
-dupelim__replace_labels_instr(init_sync_term(T, N), _, init_sync_term(T, N)).
-dupelim__replace_labels_instr(fork(Child0, Parent0, SlotCount), Replmap,
- fork(Child, Parent, SlotCount)) :-
- dupelim__replace_labels_label(Child0, Replmap, Child),
- dupelim__replace_labels_label(Parent0, Replmap, Parent).
-dupelim__replace_labels_instr(join_and_terminate(Lval0), Replmap, join_and_terminate(Lval)) :-
- dupelim__replace_labels_lval(Lval0, Replmap, Lval).
-dupelim__replace_labels_instr(join_and_continue(Lval0, Label0),
- Replmap, join_and_continue(Lval, Label)) :-
- dupelim__replace_labels_label(Label0, Replmap, Label),
- dupelim__replace_labels_lval(Lval0, Replmap, Lval).
-
-:- pred dupelim__replace_labels_lval(lval, map(label, label), lval).
-:- mode dupelim__replace_labels_lval(in, in, out) is det.
-
-dupelim__replace_labels_instr(pragma_c(A,B,C,D,E), ReplMap,
- pragma_c(A,B,C,D,E)) :-
- (
- D = no
- ;
- D = yes(Label0),
- dupelim__replace_labels_label(Label0, ReplMap, Label),
- % We cannot replace the label in the C code string
- % itself.
- require(unify(Label0, Label), "trying to replace Mercury label in C code")
- ).
-
-dupelim__replace_labels_lval(reg(RegType, RegNum), _, reg(RegType, RegNum)).
-dupelim__replace_labels_lval(stackvar(N), _, stackvar(N)).
-dupelim__replace_labels_lval(framevar(N), _, framevar(N)).
-dupelim__replace_labels_lval(succip, _, succip).
-dupelim__replace_labels_lval(maxfr, _, maxfr).
-dupelim__replace_labels_lval(curfr, _, curfr).
-dupelim__replace_labels_lval(succip(Rval0), ReplMap, succip(Rval)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_lval(redoip(Rval0), ReplMap, redoip(Rval)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_lval(redofr(Rval0), ReplMap, redofr(Rval)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_lval(succfr(Rval0), ReplMap, succfr(Rval)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_lval(prevfr(Rval0), ReplMap, prevfr(Rval)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_lval(hp, _, hp).
-dupelim__replace_labels_lval(sp, _, sp).
-dupelim__replace_labels_lval(field(Tag, Base0, Offset0), ReplMap,
- field(Tag, Base, Offset)) :-
- dupelim__replace_labels_rval(Base0, ReplMap, Base),
- dupelim__replace_labels_rval(Offset0, ReplMap, Offset).
-dupelim__replace_labels_lval(lvar(Var), _, lvar(Var)).
-dupelim__replace_labels_lval(temp(Type, Num), _, temp(Type, Num)).
-dupelim__replace_labels_lval(mem_ref(Rval0), ReplMap, mem_ref(Rval)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-
-:- pred dupelim__replace_labels_rval(rval::in, map(label, label)::in,
- rval::out) is det.
-
-dupelim__replace_labels_rval(lval(Lval0), ReplMap, lval(Lval)) :-
- dupelim__replace_labels_lval(Lval0, ReplMap, Lval).
-dupelim__replace_labels_rval(var(Var), _, var(Var)).
-dupelim__replace_labels_rval(create(Tag, Rvals, ArgTypes, StatDyn, N, Msg), _,
- create(Tag, Rvals, ArgTypes, StatDyn, N, Msg)).
-dupelim__replace_labels_rval(mkword(Tag, Rval0), ReplMap, mkword(Tag, Rval)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_rval(const(Const0), ReplMap, const(Const)) :-
- dupelim__replace_labels_rval_const(Const0, ReplMap, Const).
-dupelim__replace_labels_rval(unop(Op, Rval0), ReplMap, unop(Op, Rval)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-dupelim__replace_labels_rval(binop(Op, LRval0, RRval0), ReplMap,
- binop(Op, LRval, RRval)) :-
- dupelim__replace_labels_rval(LRval0, ReplMap, LRval),
- dupelim__replace_labels_rval(RRval0, ReplMap, RRval).
-dupelim__replace_labels_rval(mem_addr(MemRef0), ReplMap, mem_addr(MemRef)) :-
- dupelim__replace_labels_mem_ref(MemRef0, ReplMap, MemRef).
-
-:- pred dupelim__replace_labels_mem_ref(mem_ref::in, map(label, label)::in,
- mem_ref::out) is det.
-
-dupelim__replace_labels_mem_ref(stackvar_ref(N), _, stackvar_ref(N)).
-dupelim__replace_labels_mem_ref(framevar_ref(N), _, framevar_ref(N)).
-dupelim__replace_labels_mem_ref(heap_ref(Rval0, Tag, N), ReplMap,
- heap_ref(Rval, Tag, N)) :-
- dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
-
-:- pred dupelim__replace_labels_rval_const(rval_const::in,
- map(label, label)::in, rval_const::out) is det.
-
-dupelim__replace_labels_rval_const(true, _, true).
-dupelim__replace_labels_rval_const(false, _, false).
-dupelim__replace_labels_rval_const(int_const(N), _, int_const(N)).
-dupelim__replace_labels_rval_const(float_const(N), _, float_const(N)).
-dupelim__replace_labels_rval_const(string_const(S), _, string_const(S)).
-dupelim__replace_labels_rval_const(multi_string_const(L, S), _,
- multi_string_const(L, S)).
-dupelim__replace_labels_rval_const(code_addr_const(Addr0), ReplMap,
- code_addr_const(Addr)) :-
- dupelim__replace_labels_code_addr(Addr0, ReplMap, Addr).
-dupelim__replace_labels_rval_const(data_addr_const(DataAddr), _,
- data_addr_const(DataAddr)).
-dupelim__replace_labels_rval_const(label_entry(Label), _, label_entry(Label)).
-
-:- pred dupelim__replace_labels_code_addr(code_addr::in, map(label, label)::in,
- code_addr::out) is det.
-
-dupelim__replace_labels_code_addr(label(Label0), ReplMap, label(Label)) :-
- dupelim__replace_labels_label(Label0, ReplMap, Label).
-dupelim__replace_labels_code_addr(imported(Proc), _, imported(Proc)).
-dupelim__replace_labels_code_addr(succip, _, succip).
-dupelim__replace_labels_code_addr(do_succeed(Last), _, do_succeed(Last)).
-dupelim__replace_labels_code_addr(do_redo, _, do_redo).
-dupelim__replace_labels_code_addr(do_fail, _, do_fail).
-dupelim__replace_labels_code_addr(do_trace_redo_fail_shallow, _,
- do_trace_redo_fail_shallow).
-dupelim__replace_labels_code_addr(do_trace_redo_fail_deep, _,
- do_trace_redo_fail_deep).
-dupelim__replace_labels_code_addr(do_call_closure, _, do_call_closure).
-dupelim__replace_labels_code_addr(do_call_class_method, _,
- do_call_class_method).
-dupelim__replace_labels_code_addr(do_det_aditi_call, _, do_det_aditi_call).
-dupelim__replace_labels_code_addr(do_semidet_aditi_call, _,
- do_semidet_aditi_call).
-dupelim__replace_labels_code_addr(do_nondet_aditi_call, _,
- do_nondet_aditi_call).
-dupelim__replace_labels_code_addr(do_aditi_insert, _, do_aditi_insert).
-dupelim__replace_labels_code_addr(do_aditi_delete, _, do_aditi_delete).
-dupelim__replace_labels_code_addr(do_aditi_bulk_insert, _,
- do_aditi_bulk_insert).
-dupelim__replace_labels_code_addr(do_aditi_bulk_delete, _,
- do_aditi_bulk_delete).
-dupelim__replace_labels_code_addr(do_aditi_modify, _, do_aditi_modify).
-dupelim__replace_labels_code_addr(do_not_reached, _, do_not_reached).
-
-:- pred dupelim__replace_labels_label_list(list(label)::in,
- map(label, label)::in, list(label)::out) is det.
-
-dupelim__replace_labels_label_list([], _ReplMap, []).
-dupelim__replace_labels_label_list([Label0 | Labels0], ReplMap,
- [Label | Labels]) :-
- dupelim__replace_labels_label(Label0, ReplMap, Label),
- dupelim__replace_labels_label_list(Labels0, ReplMap, Labels).
-
-:- pred dupelim__replace_labels_label(label::in, map(label, label)::in,
- label::out) is det.
-
-dupelim__replace_labels_label(Label0, ReplMap, Label) :-
- ( map__search(ReplMap, Label0, NewLabel) ->
- Label = NewLabel
- ;
- Label = Label0
).
%-----------------------------------------------------------------------------%
Index: compiler/frameopt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/frameopt.m,v
retrieving revision 1.72
diff -u -b -r1.72 frameopt.m
--- frameopt.m 1998/07/29 08:53:02 1.72
+++ frameopt.m 1999/11/11 03:08:07
@@ -174,7 +174,8 @@
:- type block_map == map(label, block_info).
-:- type block_info ---> block_info(
+:- type block_info
+ ---> block_info(
label,
% The label of the first instr.
list(instruction),
@@ -188,22 +189,22 @@
block_type
).
-:- type block_type ---> setup % This is a block containing
+:- type block_type
+ ---> setup % This is a block containing
% only setup instructions.
- ; ordinary(bool) % This block does not contain
- % setup or teardown. The bool
- % says whether the code in the
- % block needs a stack frame.
- ; teardown(list(instruction), list(instruction),
- instruction).
+ ; ordinary(bool) % This block does not contain setup or
+ % teardown. The bool says whether the code
+ % in the block needs a stack frame.
+ ; teardown(
% This block contains stack
% teardown and goto code.
- % The three args give
- % (1) the instr that restores
- % succip (if any),
- % (2) the livevals instr
- % before the goto (if any),
- % (3) the goto instr
+ list(instruction),
+ % the instr that restores succip (if any),
+ list(instruction),
+ % the livevals instr before the goto (if any),
+ instruction
+ % the goto instr
+ ).
%-----------------------------------------------------------------------------%
@@ -537,11 +538,13 @@
;
Uinstr = c_code(_)
;
- Uinstr = pragma_c(_, _,
- MayCallMercury, _, NeedStack),
+ Uinstr = pragma_c(_, _, MayCallMercury,
+ MaybeFixed, _, NeedStack),
(
MayCallMercury = may_call_mercury
;
+ MaybeFixed = yes(_)
+ ;
NeedStack = yes
)
)
@@ -649,62 +652,6 @@
same_label_ref(local(ProcLabel), local(ProcLabel)).
same_label_ref(c_local(ProcLabel), c_local(ProcLabel)).
- % Given an instruction, find the set of labels to which it can cause
- % control to transfer. In the case of calls, this includes transfer
- % via return from the called procedure.
-
-:- pred possible_targets(instr::in, list(label)::out) is det.
-
-possible_targets(comment(_), []).
-possible_targets(livevals(_), []).
-possible_targets(block(_, _, _), _) :-
- error("block in possible_targets").
-possible_targets(assign(_, _), []).
-possible_targets(call(_, ReturnAddr, _, _), Labels) :-
- ( ReturnAddr = label(Label) ->
- Labels = [Label]
- ;
- Labels = []
- ).
-possible_targets(mkframe(_, _), []).
-possible_targets(label(_), []).
-possible_targets(goto(CodeAddr), Targets) :-
- ( CodeAddr = label(Label) ->
- Targets = [Label]
- ;
- Targets = []
- ).
-possible_targets(computed_goto(_, Targets), Targets).
-possible_targets(c_code(_), []).
-possible_targets(if_val(_, CodeAddr), Targets) :-
- ( CodeAddr = label(Label) ->
- Targets = [Label]
- ;
- Targets = []
- ).
-possible_targets(incr_hp(_, _, _, _), []).
-possible_targets(mark_hp(_), []).
-possible_targets(restore_hp(_), []).
-possible_targets(store_ticket(_), []).
-possible_targets(reset_ticket(_, _), []).
-possible_targets(discard_ticket, []).
-possible_targets(mark_ticket_stack(_), []).
-possible_targets(discard_tickets_to(_), []).
-possible_targets(incr_sp(_, _), []).
-possible_targets(decr_sp(_), []).
-possible_targets(init_sync_term(_, _), []).
-possible_targets(fork(Child, Parent, _), [Child, Parent]).
-possible_targets(join_and_terminate(_), []).
-possible_targets(join_and_continue(_, Label), [Label]).
-possible_targets(pragma_c(_, _, _, MaybeLabel, _), List) :-
- (
- MaybeLabel = no,
- List = []
- ;
- MaybeLabel = yes(Label),
- List = [Label]
- ).
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -721,7 +668,7 @@
Uinstr = call(_, _, _, _)
;
% Only may_call_mercury pragma_c's can clobber succip.
- Uinstr = pragma_c(_, _, may_call_mercury, _, _)
+ Uinstr = pragma_c(_, _, may_call_mercury, _, _, _)
)
->
CanClobberSuccip = yes
@@ -1114,9 +1061,11 @@
BlockInfo0 = block_info(_, Instrs0, SideLabels0,
MaybeFallThrough0, Type),
mark_parallels_for_teardown(SideLabels0, SideLabels,
- LabelMap, BlockMap0, ProcLabel, N0, N1, ParMap0, ParMap1),
+ AssocLabelMap, BlockMap0, ProcLabel, N0, N1, ParMap0, ParMap1),
pick_last(Instrs0, PrevInstrs, LastInstr0),
- substitute_labels(LastInstr0, LabelMap, LastInstr),
+ map__from_assoc_list(AssocLabelMap, LabelMap),
+ opt_util__replace_labels_instruction(LastInstr0, LabelMap, no,
+ LastInstr),
list__append(PrevInstrs, [LastInstr], Instrs),
(
MaybeFallThrough0 = yes(FallThrough),
@@ -1196,7 +1145,7 @@
% parallels, allocating labels for them if they haven't been allocated
% already. We return both the updated list of labels and the
% substitution (represented as an association list) that will have
- % to applied to the jumpting instruction.
+ % to applied to the jumping instruction.
:- pred mark_parallels_for_teardown(list(label)::in, list(label)::out,
assoc_list(label)::out, block_map::in,
@@ -1240,105 +1189,6 @@
Label = NewParallel,
N is N0 + 1,
map__det_insert(ParMap0, Label0, NewParallel, ParMap)
- ).
-
-%-----------------------------------------------------------------------------%
-
- % Given an instruction, substitute the labels in it
- % according to the given association list.
- % The substitution is not performed for instruction components
- % which treat the label merely as data.
-
-:- pred substitute_labels(instruction::in, assoc_list(label)::in,
- instruction::out) is det.
-
-substitute_labels(Uinstr0 - Comment, LabelMap, Uinstr - Comment) :-
- substitute_labels_instr(Uinstr0, LabelMap, Uinstr).
-
-:- pred substitute_labels_instr(instr::in, assoc_list(label)::in,
- instr::out) is det.
-
-substitute_labels_instr(comment(Comment), _, comment(Comment)).
-substitute_labels_instr(livevals(LiveVals), _, livevals(LiveVals)).
-substitute_labels_instr(block(_, _, _), _, _) :-
- error("block in substitute_labels_instr").
-substitute_labels_instr(assign(Lval, Rval), _, assign(Lval, Rval)).
-substitute_labels_instr(call(Target, ReturnAddr0, LiveInfo, Model), LabelMap,
- call(Target, ReturnAddr, LiveInfo, Model)) :-
- (
- ReturnAddr0 = label(Label0),
- assoc_list__search(LabelMap, Label0, Label)
- ->
- ReturnAddr = label(Label)
- ;
- ReturnAddr = ReturnAddr0
- ).
-substitute_labels_instr(mkframe(NondetFrameInfo, Redoip), _,
- mkframe(NondetFrameInfo, Redoip)).
-substitute_labels_instr(label(_), _, _) :-
- error("label in substitute_labels_instr").
-substitute_labels_instr(goto(CodeAddr0), LabelMap, goto(CodeAddr)) :-
- (
- CodeAddr0 = label(Label0),
- assoc_list__search(LabelMap, Label0, Label)
- ->
- CodeAddr = label(Label)
- ;
- CodeAddr = CodeAddr0
- ).
-substitute_labels_instr(computed_goto(Rval, Targets0), LabelMap,
- computed_goto(Rval, Targets)) :-
- substitute_labels_list(Targets0, LabelMap, Targets).
-substitute_labels_instr(c_code(Code), _, c_code(Code)).
-substitute_labels_instr(if_val(Rval, CodeAddr0), LabelMap,
- if_val(Rval, CodeAddr)) :-
- (
- CodeAddr0 = label(Label0),
- assoc_list__search(LabelMap, Label0, Label)
- ->
- CodeAddr = label(Label)
- ;
- CodeAddr = CodeAddr0
- ).
-substitute_labels_instr(incr_hp(Lval, Tag, Rval, Msg), _,
- incr_hp(Lval, Tag, Rval, Msg)).
-substitute_labels_instr(mark_hp(Lval), _, mark_hp(Lval)).
-substitute_labels_instr(restore_hp(Rval), _, restore_hp(Rval)).
-substitute_labels_instr(store_ticket(Lval), _, store_ticket(Lval)).
-substitute_labels_instr(reset_ticket(Rval, Rsn), _, reset_ticket(Rval, Rsn)).
-substitute_labels_instr(discard_ticket, _, discard_ticket).
-substitute_labels_instr(mark_ticket_stack(Lval), _, mark_ticket_stack(Lval)).
-substitute_labels_instr(discard_tickets_to(Rval), _, discard_tickets_to(Rval)).
-substitute_labels_instr(incr_sp(Size, Name), _, incr_sp(Size, Name)).
-substitute_labels_instr(decr_sp(Size), _, decr_sp(Size)).
-substitute_labels_instr(init_sync_term(T, N), _, init_sync_term(T, N)).
-substitute_labels_instr(fork(Child0, Parent0, Lval), LabelMap,
- fork(Child, Parent, Lval)) :-
- substitute_label(LabelMap, Child0, Child),
- substitute_label(LabelMap, Parent0, Parent).
-substitute_labels_instr(join_and_terminate(Lval), _LabelMap, join_and_terminate(Lval)).
-substitute_labels_instr(join_and_continue(Lval, Label0), LabelMap,
- join_and_continue(Lval, Label)) :-
- substitute_label(LabelMap, Label0, Label).
-substitute_labels_instr(pragma_c(A, B, C, D, E), _, pragma_c(A, B, C, D, E)).
-
-:- pred substitute_labels_list(list(label)::in, assoc_list(label)::in,
- list(label)::out) is det.
-
-substitute_labels_list([], _, []).
-substitute_labels_list([Label0 | Labels0], LabelMap, [Label | Labels]) :-
- substitute_label(LabelMap, Label0, Label),
- substitute_labels_list(Labels0, LabelMap, Labels).
-
-:- pred substitute_label(assoc_list(label)::in, label::in, label::out) is det.
-
-substitute_label(LabelMap, Label0, Label) :-
- (
- assoc_list__search(LabelMap, Label0, Label1)
- ->
- Label = Label1
- ;
- Label = Label0
).
%-----------------------------------------------------------------------------%
Index: compiler/livemap.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/livemap.m,v
retrieving revision 1.43
diff -u -b -r1.43 livemap.m
--- livemap.m 1999/08/24 08:51:59 1.43
+++ livemap.m 1999/11/11 02:00:59
@@ -356,7 +356,7 @@
DontValueNumber = yes
;
% XXX we shouldn't just give up here
- Uinstr0 = pragma_c(_, _, _, _, _),
+ Uinstr0 = pragma_c(_, _, _, _, _, _),
Livemap = Livemap0,
Livevals = Livevals0,
Instrs = Instrs0,
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.251
diff -u -b -r1.251 llds.m
--- llds.m 1999/10/08 02:55:30 1.251
+++ llds.m 1999/11/11 01:49:52
@@ -360,7 +360,8 @@
% Decrement the det stack pointer.
; pragma_c(list(pragma_c_decl), list(pragma_c_component),
- may_call_mercury, maybe(label), bool)
+ may_call_mercury, maybe(label), maybe(label),
+ bool)
% The first argument says what local variable
% declarations are required for the following
% components, which in turn can specify how
@@ -382,9 +383,16 @@
% refer to a Mercury label. If they do, we must
% prevent the label from being optimized away.
% To make it known to labelopt, we mention it in
- % the fourth arg.
+ % the fourth or the fifth arg. The fourth argument
+ % may give the name of a label whose name is fixed
+ % (e.g. because it embedded in raw C code or because it
+ % has associated an label layout structure), while
+ % the fifth may give the name of a label that can
+ % be changed (because it is not mentioned in C code
+ % and has no associated layout structure, being
+ % mentioned only in pragma_c_fail_to components).
%
- % The fifth argument says whether the contents
+ % The sixth argument says whether the contents
% of the pragma C code can refer to stack slots.
% User-written shouldn't refer to stack slots,
% the question is whether the compiler-generated
@@ -495,7 +503,9 @@
---> pragma_c_inputs(list(pragma_c_input))
; pragma_c_outputs(list(pragma_c_output))
; pragma_c_user_code(maybe(prog_context), string)
- ; pragma_c_raw_code(string).
+ ; pragma_c_raw_code(string)
+ ; pragma_c_fail_to(label)
+ ; pragma_c_noop.
% A pragma_c_input represents the code that initializes one
% of the input variables for a pragma_c instruction.
Index: compiler/llds_common.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_common.m,v
retrieving revision 1.23
diff -u -b -r1.23 llds_common.m
--- llds_common.m 1999/04/30 08:23:49 1.23
+++ llds_common.m 1999/11/11 02:31:57
@@ -263,7 +263,7 @@
Instr = Instr0,
Info = Info0
;
- Instr0 = pragma_c(_, _, _, _, _),
+ Instr0 = pragma_c(_, _, _, _, _, _),
Instr = Instr0,
Info = Info0
).
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.129
diff -u -b -r1.129 llds_out.m
--- llds_out.m 1999/11/04 04:21:00 1.129
+++ llds_out.m 1999/11/11 04:35:45
@@ -1324,18 +1324,8 @@
output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet).
output_instruction_decls(incr_sp(_, _), DeclSet, DeclSet) --> [].
output_instruction_decls(decr_sp(_), DeclSet, DeclSet) --> [].
-output_instruction_decls(pragma_c(_, Comps, _, _, _), DeclSet0, DeclSet) -->
+output_instruction_decls(pragma_c(_, Comps, _, _, _, _), DeclSet0, DeclSet) -->
output_pragma_c_component_list_decls(Comps, DeclSet0, DeclSet).
-
-:- pred output_pragma_c_component_list_decls(list(pragma_c_component),
- decl_set, decl_set, io__state, io__state).
-:- mode output_pragma_c_component_list_decls(in, in, out, di, uo) is det.
-
-output_pragma_c_component_list_decls([], DeclSet, DeclSet) --> [].
-output_pragma_c_component_list_decls([Component | Components],
- DeclSet0, DeclSet) -->
- output_pragma_c_component_decls(Component, DeclSet0, DeclSet1),
- output_pragma_c_component_list_decls(Components, DeclSet1, DeclSet).
output_instruction_decls(init_sync_term(Lval, _), DeclSet0, DeclSet) -->
output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
output_instruction_decls(fork(Child, Parent, _), DeclSet0, DeclSet) -->
@@ -1347,17 +1337,30 @@
output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet1),
output_code_addr_decls(label(Label), "", "", 0, _, DeclSet1, DeclSet).
+:- pred output_pragma_c_component_list_decls(list(pragma_c_component),
+ decl_set, decl_set, io__state, io__state).
+:- mode output_pragma_c_component_list_decls(in, in, out, di, uo) is det.
+
+output_pragma_c_component_list_decls([], DeclSet, DeclSet) --> [].
+output_pragma_c_component_list_decls([Component | Components],
+ DeclSet0, DeclSet) -->
+ output_pragma_c_component_decls(Component, DeclSet0, DeclSet1),
+ output_pragma_c_component_list_decls(Components, DeclSet1, DeclSet).
+
:- pred output_pragma_c_component_decls(pragma_c_component,
decl_set, decl_set, io__state, io__state).
:- mode output_pragma_c_component_decls(in, in, out, di, uo) is det.
output_pragma_c_component_decls(pragma_c_inputs(Inputs), DeclSet0, DeclSet) -->
output_pragma_input_rval_decls(Inputs, DeclSet0, DeclSet).
-output_pragma_c_component_decls(pragma_c_outputs(Outputs), DeclSet0, DeclSet) -->
+output_pragma_c_component_decls(pragma_c_outputs(Outputs), DeclSet0, DeclSet)
+ -->
output_pragma_output_lval_decls(Outputs, DeclSet0, DeclSet).
output_pragma_c_component_decls(pragma_c_raw_code(_), DeclSet, DeclSet) --> [].
output_pragma_c_component_decls(pragma_c_user_code(_, _), DeclSet, DeclSet)
--> [].
+output_pragma_c_component_decls(pragma_c_fail_to(_), DeclSet, DeclSet) --> [].
+output_pragma_c_component_decls(pragma_c_noop, DeclSet, DeclSet) --> [].
%-----------------------------------------------------------------------------%
@@ -1646,7 +1649,7 @@
io__write_int(N),
io__write_string(");\n").
-output_instruction(pragma_c(Decls, Components, _, _, _), _) -->
+output_instruction(pragma_c(Decls, Components, _, _, _, _), _) -->
io__write_string("\t{\n"),
output_pragma_decls(Decls),
output_pragma_c_components(Components),
@@ -1716,6 +1719,11 @@
).
output_pragma_c_component(pragma_c_raw_code(C_Code)) -->
io__write_string(C_Code).
+output_pragma_c_component(pragma_c_fail_to(Label)) -->
+ io__write_string("if (!r1) GOTO_LABEL("),
+ output_label(Label),
+ io__write_string(");\n").
+output_pragma_c_component(pragma_c_noop) --> [].
% Output the local variable declarations at the top of the
% pragma_c_code code.
@@ -2645,8 +2653,7 @@
{ N = N0 },
{ DeclSet = DeclSet0 }
;
- { decl_set_insert(DeclSet0, code_addr(CodeAddress),
- DeclSet) },
+ { decl_set_insert(DeclSet0, code_addr(CodeAddress), DeclSet) },
need_code_addr_decls(CodeAddress, NeedDecl),
( { NeedDecl = yes } ->
output_indent(FirstIndent, LaterIndent, N0),
@@ -3722,14 +3729,14 @@
io__write_string("(Float) "),
io__write_float(FloatVal).
output_rval_const(string_const(String)) -->
- io__write_string("string_const("""),
+ io__write_string("MR_string_const("""),
output_c_quoted_string(String),
{ string__length(String, StringLength) },
io__write_string(""", "),
io__write_int(StringLength),
io__write_string(")").
output_rval_const(multi_string_const(Length, String)) -->
- io__write_string("string_const("""),
+ io__write_string("MR_string_const("""),
output_c_quoted_multi_string(Length, String),
io__write_string(""", "),
io__write_int(Length),
@@ -3794,14 +3801,14 @@
output_rval_static_const(float_const(FloatVal)) -->
io__write_float(FloatVal).
output_rval_static_const(string_const(String)) -->
- io__write_string("string_const("""),
+ io__write_string("MR_string_const("""),
output_c_quoted_string(String),
{ string__length(String, StringLength) },
io__write_string(""", "),
io__write_int(StringLength),
io__write_string(")").
output_rval_static_const(multi_string_const(Length, String)) -->
- io__write_string("string_const("""),
+ io__write_string("MR_string_const("""),
output_c_quoted_multi_string(Length, String),
io__write_string(""", "),
io__write_int(Length),
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.78
diff -u -b -r1.78 middle_rec.m
--- middle_rec.m 1999/08/13 01:43:06 1.78
+++ middle_rec.m 1999/11/11 02:32:28
@@ -424,7 +424,7 @@
middle_rec__find_used_registers_rval(Rval, Used0, Used).
middle_rec__find_used_registers_instr(incr_sp(_, _), Used, Used).
middle_rec__find_used_registers_instr(decr_sp(_), Used, Used).
-middle_rec__find_used_registers_instr(pragma_c(_, Components, _, _, _),
+middle_rec__find_used_registers_instr(pragma_c(_, Components, _, _, _, _),
Used0, Used) :-
middle_rec__find_used_registers_components(Components, Used0, Used).
middle_rec__find_used_registers_instr(init_sync_term(Lval, _), Used0, Used) :-
@@ -454,6 +454,8 @@
insert_pragma_c_output_registers(Out, Used0, Used).
middle_rec__find_used_registers_component(pragma_c_user_code(_, _), Used, Used).
middle_rec__find_used_registers_component(pragma_c_raw_code(_), Used, Used).
+middle_rec__find_used_registers_component(pragma_c_fail_to(_), Used, Used).
+middle_rec__find_used_registers_component(pragma_c_noop, Used, Used).
:- pred middle_rec__find_used_registers_lvals(list(lval), set(int), set(int)).
:- mode middle_rec__find_used_registers_lvals(in, di, uo) is det.
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.95
diff -u -b -r1.95 opt_debug.m
--- opt_debug.m 1999/08/24 08:52:03 1.95
+++ opt_debug.m 1999/11/11 02:36:08
@@ -956,7 +956,7 @@
opt_debug__dump_label(Label, LabelStr),
string__append_list(["join(", LvalStr, ", ", LabelStr, ")"], Str).
% XXX should probably give more info than this
-opt_debug__dump_instr(pragma_c(_, Comps, _, _, _), Str) :-
+opt_debug__dump_instr(pragma_c(_, Comps, _, _, _, _), Str) :-
opt_debug__dump_components(Comps, C_str),
string__append_list(["pragma_c(", C_str, ")"], Str).
@@ -976,6 +976,10 @@
opt_debug__dump_component(pragma_c_outputs(_), "").
opt_debug__dump_component(pragma_c_user_code(_, Code), Code).
opt_debug__dump_component(pragma_c_raw_code(Code), Code).
+opt_debug__dump_component(pragma_c_fail_to(Label), Code) :-
+ opt_debug__dump_label(Label, LabelStr),
+ string__append_list(["fail to ", LabelStr], Code).
+opt_debug__dump_component(pragma_c_noop, "").
opt_debug__dump_fullinstr(Uinstr - Comment, Str) :-
opt_debug__dump_instr(Uinstr, U_str),
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.102
diff -u -b -r1.102 opt_util.m
--- opt_util.m 1999/08/24 08:52:03 1.102
+++ opt_util.m 1999/11/11 03:07:16
@@ -213,6 +213,13 @@
list(label), list(code_addr)).
:- mode opt_util__instr_list_labels(in, out, out) is det.
+ % Given an instruction, find the set of labels to which it can cause
+ % control to transfer. In the case of calls, this includes transfer
+ % via return from the called procedure.
+
+:- pred opt_util__possible_targets(instr, list(label)).
+:- mode opt_util__possible_targets(in, out) is det.
+
% Find a label number that does not occur in the instruction list,
% starting the search at a given number.
@@ -299,6 +306,20 @@
:- pred opt_util__propagate_livevals(list(instruction), list(instruction)).
:- mode opt_util__propagate_livevals(in, out) is det.
+ % Replace references to one set of labels with references
+ % to another set, in one instruction or a list of instructions.
+ % Control references are always replaced; references that treat the
+ % label as data are replaced iff the third argument is set to "yes".
+
+:- pred opt_util__replace_labels_instr(instr::in, map(label, label)::in,
+ bool::in, instr::out) is det.
+
+:- pred opt_util__replace_labels_instruction(instruction::in,
+ map(label, label)::in, bool::in, instruction::out) is det.
+
+:- pred opt_util__replace_labels_instruction_list(list(instruction)::in,
+ map(label, label)::in, bool::in, list(instruction)::out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -869,7 +890,7 @@
Uinstr0 = decr_sp(_),
Need = no
;
- Uinstr0 = pragma_c(_, _, _, _, _),
+ Uinstr0 = pragma_c(_, _, _, _, _, _),
Need = no
;
Uinstr0 = init_sync_term(Lval, _),
@@ -994,7 +1015,7 @@
opt_util__can_instr_branch_away(fork(_, _, _), yes).
opt_util__can_instr_branch_away(join_and_terminate(_), no).
opt_util__can_instr_branch_away(join_and_continue(_, _), yes).
-opt_util__can_instr_branch_away(pragma_c(_, Comps, _, _, _), BranchAway) :-
+opt_util__can_instr_branch_away(pragma_c(_, Comps, _, _, _, _), BranchAway) :-
opt_util__can_components_branch_away(Comps, BranchAway).
:- pred opt_util__can_components_branch_away(list(pragma_c_component), bool).
@@ -1027,8 +1048,10 @@
opt_util__can_component_branch_away(pragma_c_inputs(_), no).
opt_util__can_component_branch_away(pragma_c_outputs(_), no).
opt_util__can_component_branch_away(pragma_c_raw_code(Code), CanBranchAway) :-
- ( Code = "" -> CanBranchAway = yes ; CanBranchAway = no ).
+ ( Code = "" -> CanBranchAway = no ; CanBranchAway = yes ).
opt_util__can_component_branch_away(pragma_c_user_code(_, _), no).
+opt_util__can_component_branch_away(pragma_c_fail_to(_), yes).
+opt_util__can_component_branch_away(pragma_c_noop, no).
opt_util__can_instr_fall_through(comment(_), yes).
opt_util__can_instr_fall_through(livevals(_), yes).
@@ -1056,7 +1079,7 @@
opt_util__can_instr_fall_through(fork(_, _, _), no).
opt_util__can_instr_fall_through(join_and_terminate(_), no).
opt_util__can_instr_fall_through(join_and_continue(_, _), no).
-opt_util__can_instr_fall_through(pragma_c(_, _, _, _, _), yes).
+opt_util__can_instr_fall_through(pragma_c(_, _, _, _, _, _), yes).
% Check whether an instruction sequence can possibly fall through
% to the next instruction without using its label.
@@ -1100,7 +1123,7 @@
opt_util__can_use_livevals(fork(_, _, _), no).
opt_util__can_use_livevals(join_and_terminate(_), no).
opt_util__can_use_livevals(join_and_continue(_, _), no).
-opt_util__can_use_livevals(pragma_c(_, _, _, _, _), no).
+opt_util__can_use_livevals(pragma_c(_, _, _, _, _, _), no).
% determine all the labels and code_addresses that are referenced by Instr
@@ -1161,12 +1184,78 @@
opt_util__instr_labels_2(fork(Child, Parent, _), [Child, Parent], []).
opt_util__instr_labels_2(join_and_terminate(_), [], []).
opt_util__instr_labels_2(join_and_continue(_, Label), [Label], []).
-opt_util__instr_labels_2(pragma_c(_, _, _, MaybeLabel, _), Labels, []) :-
- ( MaybeLabel = yes(Label) ->
+opt_util__instr_labels_2(pragma_c(_, _, _, MaybeFixLabel, MaybeSubLabel, _),
+ Labels, []) :-
+ ( MaybeFixLabel = yes(FixLabel) ->
+ ( MaybeSubLabel = yes(SubLabel) ->
+ Labels = [FixLabel, SubLabel]
+ ;
+ Labels = [FixLabel]
+ )
+ ;
+ ( MaybeSubLabel = yes(SubLabel) ->
+ Labels = [SubLabel]
+ ;
+ Labels = []
+ )
+ ).
+
+opt_util__possible_targets(comment(_), []).
+opt_util__possible_targets(livevals(_), []).
+opt_util__possible_targets(block(_, _, _), _) :-
+ error("block in possible_targets").
+opt_util__possible_targets(assign(_, _), []).
+opt_util__possible_targets(call(_, ReturnAddr, _, _), Labels) :-
+ ( ReturnAddr = label(Label) ->
Labels = [Label]
;
Labels = []
).
+opt_util__possible_targets(mkframe(_, _), []).
+opt_util__possible_targets(label(_), []).
+opt_util__possible_targets(goto(CodeAddr), Targets) :-
+ ( CodeAddr = label(Label) ->
+ Targets = [Label]
+ ;
+ Targets = []
+ ).
+opt_util__possible_targets(computed_goto(_, Targets), Targets).
+opt_util__possible_targets(c_code(_), []).
+opt_util__possible_targets(if_val(_, CodeAddr), Targets) :-
+ ( CodeAddr = label(Label) ->
+ Targets = [Label]
+ ;
+ Targets = []
+ ).
+opt_util__possible_targets(incr_hp(_, _, _, _), []).
+opt_util__possible_targets(mark_hp(_), []).
+opt_util__possible_targets(restore_hp(_), []).
+opt_util__possible_targets(store_ticket(_), []).
+opt_util__possible_targets(reset_ticket(_, _), []).
+opt_util__possible_targets(discard_ticket, []).
+opt_util__possible_targets(mark_ticket_stack(_), []).
+opt_util__possible_targets(discard_tickets_to(_), []).
+opt_util__possible_targets(incr_sp(_, _), []).
+opt_util__possible_targets(decr_sp(_), []).
+opt_util__possible_targets(init_sync_term(_, _), []).
+opt_util__possible_targets(fork(Child, Parent, _), [Child, Parent]).
+opt_util__possible_targets(join_and_terminate(_), []).
+opt_util__possible_targets(join_and_continue(_, L), [L]).
+opt_util__possible_targets(pragma_c(_, _, _, MaybeFixLabel, MaybeSubLabel, _),
+ Labels) :-
+ ( MaybeFixLabel = yes(FixLabel) ->
+ ( MaybeSubLabel = yes(SubLabel) ->
+ Labels = [FixLabel, SubLabel]
+ ;
+ Labels = [FixLabel]
+ )
+ ;
+ ( MaybeSubLabel = yes(SubLabel) ->
+ Labels = [SubLabel]
+ ;
+ Labels = []
+ )
+ ).
:- pred opt_util__instr_rvals_and_lvals(instr, list(rval), list(lval)).
:- mode opt_util__instr_rvals_and_lvals(in, out, out) is det.
@@ -1199,8 +1288,8 @@
opt_util__instr_rvals_and_lvals(fork(_, _, _), [], []).
opt_util__instr_rvals_and_lvals(join_and_terminate(Lval), [], [Lval]).
opt_util__instr_rvals_and_lvals(join_and_continue(Lval, _), [], [Lval]).
-opt_util__instr_rvals_and_lvals(pragma_c(_, Comps, _, _, _), Rvals, Lvals) :-
- pragma_c_components_get_rvals_and_lvals(Comps, Rvals, Lvals).
+opt_util__instr_rvals_and_lvals(pragma_c(_, Cs, _, _, _, _), Rvals, Lvals) :-
+ pragma_c_components_get_rvals_and_lvals(Cs, Rvals, Lvals).
% extract the rvals and lvals from the pragma_c_components
:- pred pragma_c_components_get_rvals_and_lvals(list(pragma_c_component),
@@ -1231,6 +1320,10 @@
Rvals, Rvals, Lvals, Lvals).
pragma_c_component_get_rvals_and_lvals(pragma_c_raw_code(_),
Rvals, Rvals, Lvals, Lvals).
+pragma_c_component_get_rvals_and_lvals(pragma_c_fail_to(_),
+ Rvals, Rvals, Lvals, Lvals).
+pragma_c_component_get_rvals_and_lvals(pragma_c_noop,
+ Rvals, Rvals, Lvals, Lvals).
% extract the rvals from the pragma_c_input
:- pred pragma_c_inputs_get_rvals(list(pragma_c_input), list(rval)).
@@ -1340,7 +1433,7 @@
opt_util__count_temps_lval(Lval, R0, R, F0, F).
opt_util__count_temps_instr(join_and_continue(Lval, _), R0, R, F0, F) :-
opt_util__count_temps_lval(Lval, R0, R, F0, F).
-opt_util__count_temps_instr(pragma_c(_, _, _, _, _), R, R, F, F).
+opt_util__count_temps_instr(pragma_c(_, _, _, _, _, _), R, R, F, F).
:- pred opt_util__count_temps_lval(lval, int, int, int, int).
:- mode opt_util__count_temps_lval(in, in, out, in, out) is det.
@@ -1447,7 +1540,7 @@
opt_util__touches_nondet_ctrl_lval(Lval, Touch)
; Uinstr = restore_hp(Rval) ->
opt_util__touches_nondet_ctrl_rval(Rval, Touch)
- ; Uinstr = pragma_c(_, Components, _, _, _) ->
+ ; Uinstr = pragma_c(_, Components, _, _, _, _) ->
opt_util__touches_nondet_ctrl_components(Components, Touch)
;
Touch = yes
@@ -1529,6 +1622,8 @@
opt_util__touches_nondet_ctrl_component(pragma_c_outputs(_), no).
opt_util__touches_nondet_ctrl_component(pragma_c_raw_code(_), no).
opt_util__touches_nondet_ctrl_component(pragma_c_user_code(_, _), yes).
+opt_util__touches_nondet_ctrl_component(pragma_c_fail_to(_), no).
+opt_util__touches_nondet_ctrl_component(pragma_c_noop, no).
%-----------------------------------------------------------------------------%
@@ -1622,4 +1717,333 @@
),
opt_util__propagate_livevals_2(Instrs0, Livevals, Instrs).
+%-----------------------------------------------------------------------------%
+
+ % The code in this section is concerned with replacing all references
+ % to one given label with a reference to another given label.
+
+opt_util__replace_labels_instruction_list([], _, _, []).
+opt_util__replace_labels_instruction_list([Instr0 | Instrs0], ReplMap,
+ ReplData, [Instr | Instrs]) :-
+ opt_util__replace_labels_instruction(Instr0, ReplMap, ReplData, Instr),
+ opt_util__replace_labels_instruction_list(Instrs0, ReplMap, ReplData,
+ Instrs).
+
+opt_util__replace_labels_instruction(Instr0 - Comment, ReplMap, ReplData,
+ Instr - Comment) :-
+ opt_util__replace_labels_instr(Instr0, ReplMap, ReplData, Instr).
+
+opt_util__replace_labels_instr(comment(Comment), _, _, comment(Comment)).
+opt_util__replace_labels_instr(livevals(Livevals), _, _, livevals(Livevals)).
+opt_util__replace_labels_instr(block(R, F, Instrs0), ReplMap, ReplData,
+ block(R, F, Instrs)) :-
+ opt_util__replace_labels_instruction_list(Instrs0, ReplMap, ReplData,
+ Instrs).
+opt_util__replace_labels_instr(assign(Lval0, Rval0), ReplMap, ReplData,
+ assign(Lval, Rval)) :-
+ (
+ ReplData = yes,
+ opt_util__replace_labels_lval(Lval0, ReplMap, Lval),
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval)
+ ;
+ ReplData = no,
+ Lval = Lval0,
+ Rval = Rval0
+ ).
+opt_util__replace_labels_instr(call(Target, Return0, LiveInfo, CM),
+ ReplMap, _, call(Target, Return, LiveInfo, CM)) :-
+ opt_util__replace_labels_code_addr(Return0, ReplMap, Return).
+opt_util__replace_labels_instr(mkframe(NondetFrameInfo, Redoip0), ReplMap,
+ ReplData, mkframe(NondetFrameInfo, Redoip)) :-
+ (
+ ReplData = yes,
+ opt_util__replace_labels_code_addr(Redoip0, ReplMap, Redoip)
+ ;
+ ReplData = no,
+ Redoip = Redoip0
+ ).
+opt_util__replace_labels_instr(label(Label), ReplMap, _, label(Label)) :-
+ ( map__search(ReplMap, Label, _) ->
+ error("eliminated label in opt_util__replace_labels_instr")
+ ;
+ true
+ ).
+opt_util__replace_labels_instr(goto(Target0), ReplMap, _, goto(Target)) :-
+ opt_util__replace_labels_code_addr(Target0, ReplMap, Target).
+opt_util__replace_labels_instr(computed_goto(Rval0, Labels0), ReplMap,
+ ReplData, computed_goto(Rval, Labels)) :-
+ (
+ ReplData = yes,
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval)
+ ;
+ ReplData = no,
+ Rval = Rval0
+ ),
+ opt_util__replace_labels_label_list(Labels0, ReplMap, Labels).
+opt_util__replace_labels_instr(c_code(Code), _, _, c_code(Code)).
+opt_util__replace_labels_instr(if_val(Rval0, Target0), ReplMap, ReplData,
+ if_val(Rval, Target)) :-
+ (
+ ReplData = yes,
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval)
+ ;
+ ReplData = no,
+ Rval = Rval0
+ ),
+ opt_util__replace_labels_code_addr(Target0, ReplMap, Target).
+opt_util__replace_labels_instr(incr_hp(Lval0, MaybeTag, Rval0, Msg), ReplMap,
+ ReplData, incr_hp(Lval, MaybeTag, Rval, Msg)) :-
+ (
+ ReplData = yes,
+ opt_util__replace_labels_lval(Lval0, ReplMap, Lval),
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval)
+ ;
+ ReplData = no,
+ Lval = Lval0,
+ Rval = Rval0
+ ).
+opt_util__replace_labels_instr(mark_hp(Lval0), ReplMap, ReplData,
+ mark_hp(Lval)) :-
+ (
+ ReplData = yes,
+ opt_util__replace_labels_lval(Lval0, ReplMap, Lval)
+ ;
+ ReplData = no,
+ Lval = Lval0
+ ).
+opt_util__replace_labels_instr(restore_hp(Rval0), ReplMap, ReplData,
+ restore_hp(Rval)) :-
+ (
+ ReplData = yes,
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval)
+ ;
+ ReplData = no,
+ Rval = Rval0
+ ).
+opt_util__replace_labels_instr(store_ticket(Lval0), ReplMap, ReplData,
+ store_ticket(Lval)) :-
+ (
+ ReplData = yes,
+ opt_util__replace_labels_lval(Lval0, ReplMap, Lval)
+ ;
+ ReplData = no,
+ Lval = Lval0
+ ).
+opt_util__replace_labels_instr(reset_ticket(Rval0, Reason), ReplMap, ReplData,
+ reset_ticket(Rval, Reason)) :-
+ (
+ ReplData = yes,
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval)
+ ;
+ ReplData = no,
+ Rval = Rval0
+ ).
+opt_util__replace_labels_instr(discard_ticket, _, _, discard_ticket).
+opt_util__replace_labels_instr(mark_ticket_stack(Lval0), ReplMap, ReplData,
+ mark_ticket_stack(Lval)) :-
+ (
+ ReplData = yes,
+ opt_util__replace_labels_lval(Lval0, ReplMap, Lval)
+ ;
+ ReplData = no,
+ Lval = Lval0
+ ).
+opt_util__replace_labels_instr(discard_tickets_to(Rval0), ReplMap, ReplData,
+ discard_tickets_to(Rval)) :-
+ (
+ ReplData = yes,
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval)
+ ;
+ ReplData = no,
+ Rval = Rval0
+ ).
+opt_util__replace_labels_instr(incr_sp(Size, Msg), _, _, incr_sp(Size, Msg)).
+opt_util__replace_labels_instr(decr_sp(Size), _, _, decr_sp(Size)).
+opt_util__replace_labels_instr(init_sync_term(T, N), _, _,
+ init_sync_term(T, N)).
+opt_util__replace_labels_instr(fork(Child0, Parent0, SlotCount), Replmap, _,
+ fork(Child, Parent, SlotCount)) :-
+ opt_util__replace_labels_label(Child0, Replmap, Child),
+ opt_util__replace_labels_label(Parent0, Replmap, Parent).
+opt_util__replace_labels_instr(join_and_terminate(Lval0), Replmap, _,
+ join_and_terminate(Lval)) :-
+ opt_util__replace_labels_lval(Lval0, Replmap, Lval).
+opt_util__replace_labels_instr(join_and_continue(Lval0, Label0),
+ Replmap, _, join_and_continue(Lval, Label)) :-
+ opt_util__replace_labels_label(Label0, Replmap, Label),
+ opt_util__replace_labels_lval(Lval0, Replmap, Lval).
+opt_util__replace_labels_instr(pragma_c(A, Comps0, C, MaybeFix, MaybeSub0, F),
+ ReplMap, _, pragma_c(A, Comps, C, MaybeFix, MaybeSub, F)) :-
+ (
+ MaybeFix = no
+ ;
+ MaybeFix = yes(FixLabel0),
+ opt_util__replace_labels_label(FixLabel0, ReplMap, FixLabel),
+ % We cannot replace the label in the C code string
+ % itself.
+ require(unify(FixLabel0, FixLabel),
+ "trying to replace Mercury label in C code")
+ ),
+ (
+ MaybeSub0 = no,
+ MaybeSub = no,
+ Comps = Comps0
+ ;
+ MaybeSub0 = yes(SubLabel0),
+ opt_util__replace_labels_label(SubLabel0, ReplMap, SubLabel),
+ MaybeSub = yes(SubLabel),
+ opt_util__replace_labels_comps(Comps0, ReplMap, Comps)
+ ).
+
+:- pred opt_util__replace_labels_comps(list(pragma_c_component),
+ map(label, label), list(pragma_c_component)).
+:- mode opt_util__replace_labels_comps(in, in, out) is det.
+
+opt_util__replace_labels_comps([], _, []).
+opt_util__replace_labels_comps([Comp0 | Comps0], ReplMap, [Comp | Comps]) :-
+ opt_util__replace_labels_comp(Comp0, ReplMap, Comp),
+ opt_util__replace_labels_comps(Comps0, ReplMap, Comps).
+
+:- pred opt_util__replace_labels_comp(pragma_c_component,
+ map(label, label), pragma_c_component).
+:- mode opt_util__replace_labels_comp(in, in, out) is det.
+
+opt_util__replace_labels_comp(pragma_c_inputs(A), _, pragma_c_inputs(A)).
+opt_util__replace_labels_comp(pragma_c_outputs(A), _, pragma_c_outputs(A)).
+opt_util__replace_labels_comp(pragma_c_user_code(A, B), _,
+ pragma_c_user_code(A, B)).
+opt_util__replace_labels_comp(pragma_c_raw_code(A), _, pragma_c_raw_code(A)).
+opt_util__replace_labels_comp(pragma_c_fail_to(Label0), ReplMap,
+ pragma_c_fail_to(Label)) :-
+ opt_util__replace_labels_label(Label0, ReplMap, Label).
+opt_util__replace_labels_comp(pragma_c_noop, _, pragma_c_noop).
+
+:- pred opt_util__replace_labels_lval(lval, map(label, label), lval).
+:- mode opt_util__replace_labels_lval(in, in, out) is det.
+
+opt_util__replace_labels_lval(reg(RegType, RegNum), _, reg(RegType, RegNum)).
+opt_util__replace_labels_lval(stackvar(N), _, stackvar(N)).
+opt_util__replace_labels_lval(framevar(N), _, framevar(N)).
+opt_util__replace_labels_lval(succip, _, succip).
+opt_util__replace_labels_lval(maxfr, _, maxfr).
+opt_util__replace_labels_lval(curfr, _, curfr).
+opt_util__replace_labels_lval(succip(Rval0), ReplMap, succip(Rval)) :-
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval).
+opt_util__replace_labels_lval(redoip(Rval0), ReplMap, redoip(Rval)) :-
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval).
+opt_util__replace_labels_lval(redofr(Rval0), ReplMap, redofr(Rval)) :-
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval).
+opt_util__replace_labels_lval(succfr(Rval0), ReplMap, succfr(Rval)) :-
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval).
+opt_util__replace_labels_lval(prevfr(Rval0), ReplMap, prevfr(Rval)) :-
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval).
+opt_util__replace_labels_lval(hp, _, hp).
+opt_util__replace_labels_lval(sp, _, sp).
+opt_util__replace_labels_lval(field(Tag, Base0, Offset0), ReplMap,
+ field(Tag, Base, Offset)) :-
+ opt_util__replace_labels_rval(Base0, ReplMap, Base),
+ opt_util__replace_labels_rval(Offset0, ReplMap, Offset).
+opt_util__replace_labels_lval(lvar(Var), _, lvar(Var)).
+opt_util__replace_labels_lval(temp(Type, Num), _, temp(Type, Num)).
+opt_util__replace_labels_lval(mem_ref(Rval0), ReplMap, mem_ref(Rval)) :-
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval).
+
+:- pred opt_util__replace_labels_rval(rval::in, map(label, label)::in,
+ rval::out) is det.
+
+opt_util__replace_labels_rval(lval(Lval0), ReplMap, lval(Lval)) :-
+ opt_util__replace_labels_lval(Lval0, ReplMap, Lval).
+opt_util__replace_labels_rval(var(Var), _, var(Var)).
+opt_util__replace_labels_rval(create(Tag, Rvals, ArgTypes, StatDyn, N, Msg), _,
+ create(Tag, Rvals, ArgTypes, StatDyn, N, Msg)).
+opt_util__replace_labels_rval(mkword(Tag, Rval0), ReplMap, mkword(Tag, Rval)) :-
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval).
+opt_util__replace_labels_rval(const(Const0), ReplMap, const(Const)) :-
+ opt_util__replace_labels_rval_const(Const0, ReplMap, Const).
+opt_util__replace_labels_rval(unop(Op, Rval0), ReplMap, unop(Op, Rval)) :-
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval).
+opt_util__replace_labels_rval(binop(Op, LRval0, RRval0), ReplMap,
+ binop(Op, LRval, RRval)) :-
+ opt_util__replace_labels_rval(LRval0, ReplMap, LRval),
+ opt_util__replace_labels_rval(RRval0, ReplMap, RRval).
+opt_util__replace_labels_rval(mem_addr(MemRef0), ReplMap, mem_addr(MemRef)) :-
+ opt_util__replace_labels_mem_ref(MemRef0, ReplMap, MemRef).
+
+:- pred opt_util__replace_labels_mem_ref(mem_ref::in, map(label, label)::in,
+ mem_ref::out) is det.
+
+opt_util__replace_labels_mem_ref(stackvar_ref(N), _, stackvar_ref(N)).
+opt_util__replace_labels_mem_ref(framevar_ref(N), _, framevar_ref(N)).
+opt_util__replace_labels_mem_ref(heap_ref(Rval0, Tag, N), ReplMap,
+ heap_ref(Rval, Tag, N)) :-
+ opt_util__replace_labels_rval(Rval0, ReplMap, Rval).
+
+:- pred opt_util__replace_labels_rval_const(rval_const::in,
+ map(label, label)::in, rval_const::out) is det.
+
+opt_util__replace_labels_rval_const(true, _, true).
+opt_util__replace_labels_rval_const(false, _, false).
+opt_util__replace_labels_rval_const(int_const(N), _, int_const(N)).
+opt_util__replace_labels_rval_const(float_const(N), _, float_const(N)).
+opt_util__replace_labels_rval_const(string_const(S), _, string_const(S)).
+opt_util__replace_labels_rval_const(multi_string_const(L, S), _,
+ multi_string_const(L, S)).
+opt_util__replace_labels_rval_const(code_addr_const(Addr0), ReplMap,
+ code_addr_const(Addr)) :-
+ opt_util__replace_labels_code_addr(Addr0, ReplMap, Addr).
+opt_util__replace_labels_rval_const(data_addr_const(DataAddr), _,
+ data_addr_const(DataAddr)).
+opt_util__replace_labels_rval_const(label_entry(Label), _, label_entry(Label)).
+
+:- pred opt_util__replace_labels_code_addr(code_addr::in, map(label, label)::in,
+ code_addr::out) is det.
+
+opt_util__replace_labels_code_addr(label(Label0), ReplMap, label(Label)) :-
+ opt_util__replace_labels_label(Label0, ReplMap, Label).
+opt_util__replace_labels_code_addr(imported(Proc), _, imported(Proc)).
+opt_util__replace_labels_code_addr(succip, _, succip).
+opt_util__replace_labels_code_addr(do_succeed(Last), _, do_succeed(Last)).
+opt_util__replace_labels_code_addr(do_redo, _, do_redo).
+opt_util__replace_labels_code_addr(do_fail, _, do_fail).
+opt_util__replace_labels_code_addr(do_trace_redo_fail_shallow, _,
+ do_trace_redo_fail_shallow).
+opt_util__replace_labels_code_addr(do_trace_redo_fail_deep, _,
+ do_trace_redo_fail_deep).
+opt_util__replace_labels_code_addr(do_call_closure, _, do_call_closure).
+opt_util__replace_labels_code_addr(do_call_class_method, _,
+ do_call_class_method).
+opt_util__replace_labels_code_addr(do_det_aditi_call, _, do_det_aditi_call).
+opt_util__replace_labels_code_addr(do_semidet_aditi_call, _,
+ do_semidet_aditi_call).
+opt_util__replace_labels_code_addr(do_nondet_aditi_call, _,
+ do_nondet_aditi_call).
+opt_util__replace_labels_code_addr(do_aditi_insert, _, do_aditi_insert).
+opt_util__replace_labels_code_addr(do_aditi_delete, _, do_aditi_delete).
+opt_util__replace_labels_code_addr(do_aditi_bulk_insert, _,
+ do_aditi_bulk_insert).
+opt_util__replace_labels_code_addr(do_aditi_bulk_delete, _,
+ do_aditi_bulk_delete).
+opt_util__replace_labels_code_addr(do_aditi_modify, _, do_aditi_modify).
+opt_util__replace_labels_code_addr(do_not_reached, _, do_not_reached).
+
+:- pred opt_util__replace_labels_label_list(list(label)::in,
+ map(label, label)::in, list(label)::out) is det.
+
+opt_util__replace_labels_label_list([], _ReplMap, []).
+opt_util__replace_labels_label_list([Label0 | Labels0], ReplMap,
+ [Label | Labels]) :-
+ opt_util__replace_labels_label(Label0, ReplMap, Label),
+ opt_util__replace_labels_label_list(Labels0, ReplMap, Labels).
+
+:- pred opt_util__replace_labels_label(label::in, map(label, label)::in,
+ label::out) is det.
+
+opt_util__replace_labels_label(Label0, ReplMap, Label) :-
+ ( map__search(ReplMap, Label0, NewLabel) ->
+ Label = NewLabel
+ ;
+ Label = Label0
+ ).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.31
diff -u -b -r1.31 pragma_c_gen.m
--- pragma_c_gen.m 1999/10/01 20:17:32 1.31
+++ pragma_c_gen.m 1999/11/11 01:51:19
@@ -439,13 +439,10 @@
%
( { CodeModel = model_semi } ->
code_info__get_next_label(FailLabel),
- { llds_out__get_label(FailLabel, yes, FailLabelStr) },
- { string__format("\tif (!r1) GOTO_LABEL(%s);\n",
- [s(FailLabelStr)], CheckR1_String) },
- { CheckR1_Comp = pragma_c_raw_code(CheckR1_String) },
+ { CheckR1_Comp = pragma_c_fail_to(FailLabel) },
{ MaybeFailLabel = yes(FailLabel) }
;
- { CheckR1_Comp = pragma_c_raw_code("") },
+ { CheckR1_Comp = pragma_c_noop },
{ MaybeFailLabel = no }
),
@@ -455,7 +452,7 @@
% #endif
%
{ MayCallMercury = will_not_call_mercury ->
- RestoreRegsComp = pragma_c_raw_code("")
+ RestoreRegsComp = pragma_c_noop
;
RestoreRegsComp = pragma_c_raw_code(
"#ifndef CONSERVATIVE_GC\n\trestore_registers();\n#endif\n"
@@ -488,7 +485,8 @@
CheckR1_Comp, RestoreRegsComp,
OutputComp, ProcLabelHashUndef] },
{ PragmaCCode = node([
- pragma_c(Decls, Components, MayCallMercury, MaybeFailLabel, no)
+ pragma_c(Decls, Components, MayCallMercury, no,
+ MaybeFailLabel, no)
- "Pragma C inclusion"
]) },
@@ -744,7 +742,7 @@
],
CallBlockCode = node([
pragma_c(CallDecls, CallComponents,
- MayCallMercury, no, yes)
+ MayCallMercury, no, no, yes)
- "Call and shared pragma C inclusion"
]),
@@ -773,7 +771,7 @@
],
RetryBlockCode = node([
pragma_c(RetryDecls, RetryComponents,
- MayCallMercury, no, yes)
+ MayCallMercury, no, no, yes)
- "Retry and shared pragma C inclusion"
]),
@@ -830,7 +828,7 @@
],
CallBlockCode = node([
pragma_c(CallDecls, CallComponents,
- MayCallMercury, yes(SharedLabel), yes)
+ MayCallMercury, yes(SharedLabel), no, yes)
- "Call pragma C inclusion"
]),
@@ -859,7 +857,7 @@
],
RetryBlockCode = node([
pragma_c(RetryDecls, RetryComponents,
- MayCallMercury, yes(SharedLabel), yes)
+ MayCallMercury, yes(SharedLabel), no, yes)
- "Retry pragma C inclusion"
]),
@@ -887,7 +885,7 @@
],
SharedBlockCode = node([
pragma_c(SharedDecls, SharedComponents,
- MayCallMercury, no, yes)
+ MayCallMercury, no, no, yes)
- "Shared pragma C inclusion"
]),
Index: compiler/trace.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trace.m,v
retrieving revision 1.24
diff -u -b -r1.24 trace.m
--- trace.m 1999/10/08 02:55:42 1.24
+++ trace.m 1999/11/11 02:22:44
@@ -421,7 +421,7 @@
),
TraceCode = node([
pragma_c([], [pragma_c_raw_code(TraceStmt)],
- will_not_call_mercury, no, yes) - ""
+ will_not_call_mercury, no, no, yes) - ""
])
}.
@@ -650,7 +650,7 @@
% by another label, and this way we can
% eliminate this other label.
pragma_c([], [pragma_c_raw_code(TraceStmt)],
- may_call_mercury, yes(Label), yes)
+ may_call_mercury, yes(Label), no, yes)
- ""
]),
Code = tree(ProduceCode, TraceCode)
Index: compiler/value_number.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/value_number.m,v
retrieving revision 1.98
diff -u -b -r1.98 value_number.m
--- value_number.m 1999/07/10 07:19:55 1.98
+++ value_number.m 1999/11/11 02:21:57
@@ -1101,7 +1101,7 @@
value_number__boundary_instr(fork(_, _, _), yes).
value_number__boundary_instr(join_and_terminate(_), yes).
value_number__boundary_instr(join_and_continue(_, _), yes).
-value_number__boundary_instr(pragma_c(_, _, _, _, _), yes).
+value_number__boundary_instr(pragma_c(_, _, _, _, _, _), yes).
%-----------------------------------------------------------------------------%
Index: compiler/vn_block.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_block.m,v
retrieving revision 1.59
diff -u -b -r1.59 vn_block.m
--- vn_block.m 1999/07/10 07:19:55 1.59
+++ vn_block.m 1999/11/11 02:21:46
@@ -360,7 +360,7 @@
vn_block__new_ctrl_node(vn_decr_sp(N), Livemap,
Params, VnTables0, VnTables,
Liveset0, Liveset, Tuple0, Tuple).
-vn_block__handle_instr(pragma_c(_, _, _, _, _),
+vn_block__handle_instr(pragma_c(_, _, _, _, _, _),
_Livemap, _Params, VnTables, VnTables, Liveset, Liveset,
SeenIncr, SeenIncr, Tuple, Tuple) :-
error("value numbering not supported for pragma_c").
@@ -918,7 +918,7 @@
vn_block__is_ctrl_instr(fork(_, _, _), yes).
vn_block__is_ctrl_instr(join_and_terminate(_), yes).
vn_block__is_ctrl_instr(join_and_continue(_, _), yes).
-vn_block__is_ctrl_instr(pragma_c(_, _, _, _, _), no).
+vn_block__is_ctrl_instr(pragma_c(_, _, _, _, _, _), no).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/vn_cost.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_cost.m,v
retrieving revision 1.37
diff -u -b -r1.37 vn_cost.m
--- vn_cost.m 1999/07/10 07:19:55 1.37
+++ vn_cost.m 1999/11/11 02:21:34
@@ -178,7 +178,7 @@
Uinstr = decr_sp(_),
Cost = 0
;
- Uinstr = pragma_c(_, _, _, _, _),
+ Uinstr = pragma_c(_, _, _, _, _, _),
error("pragma_c found in vn_block_cost")
;
Uinstr = init_sync_term(_, _),
Index: compiler/vn_filter.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_filter.m,v
retrieving revision 1.21
diff -u -b -r1.21 vn_filter.m
--- vn_filter.m 1999/04/30 06:20:00 1.21
+++ vn_filter.m 1999/11/11 02:21:27
@@ -153,7 +153,7 @@
vn_filter__user_instr(discard_tickets_to(Rval), yes(Rval)).
vn_filter__user_instr(incr_sp(_, _), no).
vn_filter__user_instr(decr_sp(_), no).
-vn_filter__user_instr(pragma_c(_, _, _, _, _), _):-
+vn_filter__user_instr(pragma_c(_, _, _, _, _, _), _):-
error("inappropriate instruction in vn__filter").
vn_filter__user_instr(init_sync_term(_, _), _):-
error("init_sync_term instruction in vn__filter").
@@ -221,7 +221,7 @@
error("non-user instruction in vn_filter__replace_in_user_instr").
vn_filter__replace_in_user_instr(decr_sp(_), _, _, _) :-
error("non-user instruction in vn_filter__replace_in_user_instr").
-vn_filter__replace_in_user_instr(pragma_c(_, _, _, _, _), _, _, _):-
+vn_filter__replace_in_user_instr(pragma_c(_, _, _, _, _, _), _, _, _):-
error("inappropriate instruction in vn__filter").
vn_filter__replace_in_user_instr(init_sync_term(_, _), _, _, _):-
error("init_sync_term instruction in vn__filter").
@@ -260,7 +260,7 @@
vn_filter__defining_instr(discard_tickets_to(_), no).
vn_filter__defining_instr(incr_sp(_, _), no).
vn_filter__defining_instr(decr_sp(_), no).
-vn_filter__defining_instr(pragma_c(_, _, _, _, _), _):-
+vn_filter__defining_instr(pragma_c(_, _, _, _, _, _), _):-
error("inappropriate instruction in vn__filter").
vn_filter__defining_instr(init_sync_term(_, _), _):-
error("init_sync_term instruction in vn__filter").
@@ -334,7 +334,7 @@
error("join_and_terminate instruction in vn_filter__replace_in_defining_instr").
vn_filter__replace_in_defining_instr(join_and_continue(_, _), _, _, _):-
error("join_and_continue instruction in vn_filter__replace_in_defining_instr").
-vn_filter__replace_in_defining_instr(pragma_c(_, _, _, _, _), _, _, _):-
+vn_filter__replace_in_defining_instr(pragma_c(_, _, _, _, _, _), _, _, _):-
error("inappropriate instruction in vn__filter").
% vn_filter__replace_in_lval(Lval0, Old, New, Lval):
Index: compiler/vn_verify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_verify.m,v
retrieving revision 1.21
diff -u -b -r1.21 vn_verify.m
--- vn_verify.m 1999/07/10 07:19:56 1.21
+++ vn_verify.m 1999/11/11 02:21:07
@@ -370,7 +370,7 @@
NoDeref = NoDeref0,
Tested = Tested0
;
- Instr = pragma_c(_, _, _, _, _),
+ Instr = pragma_c(_, _, _, _, _, _),
error("found c_code in vn_verify__tags_instr")
).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
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/dynamic_linking
cvs diff: Diffing extras/exceptions
cvs diff: Diffing extras/graphics
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/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing library
cvs diff: Diffing profiler
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 scripts
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/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.71
diff -u -b -r1.71 Mmakefile
--- Mmakefile 1999/10/28 00:57:09 1.71
+++ Mmakefile 1999/11/11 04:04:48
@@ -47,6 +47,7 @@
float_map \
float_reg \
float_rounding_bug \
+ frameopt_pragma_redirect \
free_free_mode \
func_and_pred \
func_ctor_ambig \
Index: tests/hard_coded/frameopt_pragma_redirect.exp
===================================================================
RCS file: frameopt_pragma_redirect.exp
diff -N frameopt_pragma_redirect.exp
--- /dev/null Thu Mar 4 04:20:11 1999
+++ frameopt_pragma_redirect.exp Thu Nov 11 15:05:25 1999
@@ -0,0 +1 @@
+25 - 30
Index: tests/hard_coded/frameopt_pragma_redirect.m
===================================================================
RCS file: frameopt_pragma_redirect.m
diff -N frameopt_pragma_redirect.m
--- /dev/null Thu Mar 4 04:20:11 1999
+++ frameopt_pragma_redirect.m Thu Nov 11 15:12:25 1999
@@ -0,0 +1,67 @@
+% This is a regression test. Many versions of the compiler prior to
+% nov 11, 1999 generated incorrect code for the check_interval predicate.
+% The bug was that frameopt recognized that check_interval did not need a
+% stack frame, and deleted the frame setup code, but did not redirect the
+% failure branches inside the inlined model_semi pragma_c instructions,
+% so that they still led to code that deallocated the (now nonexistent)
+% stack frame. This meant that calls to check_interval violated the
+% invariant which says that calls leave MR_sp unchanged.
+
+:- module frameopt_pragma_redirect.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module std_util, list, int, require.
+
+:- type interval == pair(int).
+
+:- pred add_interval_list(list(interval), interval).
+:- mode add_interval_list(in, out) is det.
+
+add_interval_list([], (0 - 0)).
+add_interval_list([I | Is], SumI) :-
+ check_interval(I),
+ add_interval_list(Is, SumI0),
+ add_intervals(I, SumI0, SumI).
+
+:- pred add_intervals(interval, interval, interval).
+:- mode add_intervals(in, in, out) is det.
+
+add_intervals(S1 - E1, S2 - E2, S - E) :-
+ S = S1 + S2,
+ E = E1 + E2.
+
+:- pred check_interval(interval).
+:- mode check_interval(in) is det.
+
+:- pragma no_inline(check_interval/1).
+
+check_interval(S - E) :-
+ ( is_invalid(S) ->
+ error("Found an invalid interval 1!")
+ ; is_invalid(E) ->
+ error("Found an invalid interval 2!")
+ ;
+ true
+ ).
+
+:- pred is_invalid(int).
+:- mode is_invalid(in) is semidet.
+
+:- pragma inline(is_invalid/1).
+
+:- pragma c_code(is_invalid(X :: in),
+ [will_not_call_mercury, thread_safe],
+ "SUCCESS_INDICATOR = X > 50;").
+
+main -->
+ { add_interval_list([1 - 2, 3 - 4, 5 - 6, 7 - 8, 9 - 10], I) },
+ write(I),
+ nl.
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing trial
cvs diff: Diffing util
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list